; ------------------------
; - Schneefall by Travis -
; --------------------------------
; - Simulation von Schneeflocken -
; ---------------------------------------

Graphics 640, 480, 16, 1
SetBuffer BackBuffer()

Type flocke
 Field x, y, speed, status
End Type

Font1 = LoadFont("Verdana", 42, 1, 0, 0)
SetFont font1

Anzahl = 400 ; anzahl aktiver Schneeflocken


; -------- Hauptschleife --------
Timer = MilliSecs()
Repeat
Cls

If Aktiv < Anzahl And MilliSecs() - Timer > Rnd(20,40) Then
 Timer = MilliSecs()
 NewFlocke
EndIf




; Aktive und passive Flocken ermitteln
aktiv = 0: passiv = 0
For f.flocke = Each flocke
 If f\Status = 1 Then aktiv = aktiv + 1
 If f\Status = 0 Then passiv = passiv + 1
Next


; Statistikausgabe
;Text 0,0, "A " + aktiv
;Text 0,30, "P " + passiv


; Bildschirmgrafik
Color 100,100,150
Text 120,200, "Schneefall by Travis"
Rect 0,400, 640, 488,1 ; Boden


; Flocken zeichnen
  LockBuffer BackBuffer()
  For f.flocke = Each flocke
  Color 255,255,255
  If f\x > 0 And f\x < 640 Then WritePixelFast f\x, f\y , $ffffff
  Next
  UnlockBuffer BackBuffer()


; Flocken prüfen und bewegen
For f.flocke = Each flocke

 If f\status = 1 ; Nur aktive Flocken prüfen

  unter=ReadPixel(f\x,f\y+1)        ; Pixel unter der Flocke prüfen
  ur=(unter And $FF0000)/$10000
  ug=(unter And $FF00)/$100
  ub=unter And $FF

  If ur=0 And ug=0 And ub=0 Then    ; Wenn frei, dann dorthin bewegen
   f\y = f\y + f\speed: Goto NextFlocke
  EndIf

  links=ReadPixel(f\x-1,f\y+1)      ; Pixel links unter der Flocke prüfen
  lr=(links And $FF0000)/$10000
  lg=(links And $FF00)/$100
  lb=links And $FF

  If lr=0 And lg=0 And lb=0 Then    ; Wenn frei, dann dorthin bewegen
   f\y = f\y + f\speed
   f\x = f\x - f\speed: Goto NextFlocke
  EndIf

  rechts=ReadPixel(f\x+1,f\y+1)     ; Pixel rechts unter der Flocke prüfen
  rr=(rechts And $FF0000)/$10000
  rg=(rechts And $FF00)/$100
  rb=rechts And $FF

  If rr=0 And rg=0 And rb = 0 Then  ; Wenn frei, dann dorthin bewegen
   f\y = f\y + f\speed
   f\x = f\x + f\speed: Goto NextFlocke
  Else
   f\Status = 0: NewFlocke          ; Flocke deaktivieren (Flocke liegt auf Boden)
  EndIf

 EndIf

 .NextFlocke
 If f\x > 640 Or f\x < 0 Then Delete f ; Flocken außerhalb Bildschirm löschen

Next


Flip 0
Until KeyHit(1)
End
; -------- Ende Hauptschleife --------



; --- Schneeflocke erstellen ---
Function NewFlocke()
 f.flocke = New flocke
 f\x = Rnd(0,640)
 f\y = 0
 f\speed = 1
 f\status = 1
End Function

; ------------------------
; - Schneefall by Travis -
; --------------------------------
; - Simulation von Schneeflocken -
; ---------------------------------------

; - Jan_ schraubt mit!
Graphics 640, 480, 16, 1
SetBuffer BackBuffer()

Type flocke
Field x, y, speed, status
End Type

Font1 = LoadFont("Verdana", 42, 1, 0, 0)
SetFont font1

Anzahl = 400 ; anzahl aktiver Schneeflocken


; -------- Hauptschleife --------
Timer = MilliSecs()
Repeat
Cls

If Aktiv < Anzahl And MilliSecs() - Timer > Rnd(20,40) Then
Timer = MilliSecs()
NewFlocke
EndIf




; Aktive und passive Flocken ermitteln
aktiv = 0: passiv = 0
For f.flocke = Each flocke
If f\Status = 1 Then aktiv = aktiv + 1
If f\Status = 0 Then passiv = passiv + 1
Next


; Statistikausgabe
;Text 0,0, "A " + aktiv
;Text 0,30, "P " + passiv


; Bildschirmgrafik
Color 100,100,150
Text 120,200, "Schneefall by Travis"
Rect 0,400, 640, 488,1 ; Boden


; Flocken zeichnen
LockBuffer BackBuffer()
For f.flocke = Each flocke
Color 255,255,255
If f\x > 0 And f\x < 640 Then WritePixelFast f\x, f\y , $ffffff
Next
UnlockBuffer BackBuffer()


; Flocken prüfen und bewegen
For f.flocke = Each flocke

If f\status = 1 ; Nur aktive Flocken prüfen

unter=ReadPixel(f\x,f\y+1) ; Pixel unter der Flocke prüfen
ur=(unter And $FF0000)/$10000
ug=(unter And $FF00)/$100
ub=unter And $FF

If ur=0 And ug=0 And ub=0 Then ; Wenn frei, dann dorthin bewegen
f\y = f\y + f\speed: Goto NextFlocke
EndIf

links=ReadPixel(f\x-1,f\y+1) ; Pixel links unter der Flocke prüfen
lr=(links And $FF0000)/$10000
lg=(links And $FF00)/$100
lb=links And $FF

If lr=0 And lg=0 And lb=0 Then ; Wenn frei, dann dorthin bewegen
If Rand(0,10) = 1 Then
f\Status = 0
Else
f\y = f\y + f\speed
f\x = f\x - f\speed: Goto NextFlocke
End If
EndIf

rechts=ReadPixel(f\x+1,f\y+1) ; Pixel rechts unter der Flocke prüfen
rr=(rechts And $FF0000)/$10000
rg=(rechts And $FF00)/$100
rb=rechts And $FF

If rr=0 And rg=0 And rb = 0 Then ; Wenn frei, dann dorthin bewegen
If Rand(0,10) = 1 Then
f\Status = 0
Else
f\y = f\y + f\speed
f\x = f\x + f\speed: Goto NextFlocke
End If
Else
f\Status = 0: NewFlocke ; Flocke deaktivieren (Flocke liegt auf Boden)
EndIf

EndIf

.NextFlocke

Next


Flip 1
Until KeyHit(1)
End
; -------- Ende Hauptschleife --------



; --- Schneeflocke erstellen ---
Function NewFlocke()
f.flocke = New flocke
f\x = Rnd(0,640)
f\y = 0
f\speed = 1
f\status = 1
End Function

; ------------------------
; - Schneefall by Travis -
; --------------------------------
; - Simulation von Schneeflocken -
; ---------------------------------------


Graphics 640, 480, 16, 1
SetBuffer BackBuffer()
AppTitle "Schneefall by Travis"


Type flocke
 Field x#, y#, speed#, farbe, status
End Type

Font1 = LoadFont("Verdana", 42, 1, 0, 0)
Font2 = LoadFont("Arial", 12, 0, 0, 0)

SeedRnd MilliSecs()

Global Anzahl = 400 ; Anzahl aktiver Schneeflocken
       Info = 1     ; Infos einblenden
       VSync = 1

; Aktive Flocken sind alle Flocken, die sich bewegen und sich auf dem
; Bildschirm befinden.
; Passive Flocken sind alle Flocken, die sich nicht bewegen, oder sich
; außerhalb des Bildschirms befinden

; Status aktualisieren. Damit Schneeflocken, die in der Luft aufeinander
; treffen sich nicht gegenseitig deaktivieren, werden alle Flocken
; regelmäßig reaktiviert.


; -------- Hauptschleife --------
Timer = MilliSecs()  ; Timer für Flocken
Timer2 = MilliSecs() ; Timer für Wind
Timer3 = MilliSecs() ; Timer für Statusaktualisierung
Repeat
Cls

If KeyHit(59) Then Info = Info Xor 1:          ; F1 - Infos ein/aus
If KeyHit(60) Then VSync = VSync Xor 1         ; F2 - VSync ein/aus
If KeyHit(61) Then AktStatus = AktStatus Xor 1 ; F3 - Flockenstatus aktualisieren
If KeyDown(62) Then NewFlocke                  ; F4 - Neue Flocken
If KeyDown(63) Then wind# = 0                  ; F5 - Wind neutral


; FramesPerSecond
 syszeit = MilliSecs()
 If syszeit > fpszeit + 1000
  fps = fpsct: fpszeit = syszeit: fpsct=0
 Else
  fpsct = fpsct+1
 EndIf


; Status aktualisieren
If AktStatus = 1 Then
 If MilliSecs() - Timer3 > 1000 Then
  Timer3 = MilliSecs()
  For f.flocke = Each flocke
   f\status = 1
  Next
 EndIf
EndIf


; Windstärke ändern
If MilliSecs() - Timer2 > Rnd(2000,4000) Then
 Timer2 = MilliSecs()
 Wind# = Wind# + Rnd(-.1, .1)
 If wind# > 1 Then wind# = 1
 If wind# < -1 Then wind# = - 1
EndIf


; Neue Flocken erstellen
If Aktiv < Anzahl Then ; (AND MilliSecs() - Timer > Rnd(10,20))
 Timer = MilliSecs()
 NewFlocke
EndIf


; Aktive und passive Flocken ermitteln
aktiv = 0: passiv = 0
For f.flocke = Each flocke
 If f\Status = 1 And f\x > 0 And f\x < 640 Then aktiv = aktiv + 1
 If f\Status = 0 Or f\x < 0 Or f\x > 640 Then passiv = passiv + 1
Next


; Bildschirmgrafik
SetFont Font1
Color 100,100,150
Text 120,200, "Schneefall by Travis"
Rect 0,400, 640, 488,1 ; Boden


; Flocken zeichnen
LockBuffer BackBuffer()
 For f.flocke = Each flocke
  If f\x# > 0 And f\x# < 640 And f\y > 0 Then WritePixelFast f\x#, f\y# , f\farbe ; aktive Flocken zeichnen
 Next
UnlockBuffer BackBuffer()


; Flocken prüfen und bewegen
For f.flocke = Each flocke

 If f\status = 1 ; Nur aktive Flocken prüfen
 
  unter=ReadPixel(f\x#+wind#,f\y#+f\speed#)               ; Pixel unter der Flocke prüfen
  ur=(unter And $FF0000)/$10000                       ; Wind wird berücksichtigt
  ug=(unter And $FF00)/$100
  ub=unter And $FF

  If ur=0 And ug=0 And ub=0 Then                          ; Wenn frei, dann dorthin bewegen
   f\x# = f\x# + wind#
   f\y# = f\y# + f\speed#: Goto NextFlocke
  EndIf

  links=ReadPixel(f\x#-f\speed#+wind#,f\y#+f\speed)       ; Pixel links unter der Flocke prüfen
  lr=(links And $FF0000)/$10000
  lg=(links And $FF00)/$100
  lb=links And $FF

  If lr=0 And lg=0 And lb=0 Then                          ; Wenn frei, dann dorthin bewegen
   f\y# = f\y# + f\speed#
   f\x# = f\x# - f\speed# + wind: Goto NextFlocke
  EndIf

  rechts=ReadPixel(f\x#+f\speed#+wind#,f\y#+f\speed#)     ; Pixel rechts unter der Flocke prüfen
  rr=(rechts And $FF0000)/$10000
  rg=(rechts And $FF00)/$100
  rb=rechts And $FF

  If rr=0 And rg=0 And rb = 0 Then                        ; Wenn frei, dann dorthin bewegen
   f\y# = f\y# + f\speed#
   f\x# = f\x# + f\speed# + wind: Goto NextFlocke
  Else
   f\Status = 0                                           ; Flocke deaktivieren (Flocke liegt auf Boden)
  EndIf

 EndIf

 .NextFlocke
 If f\y > 600 Then Delete f

Next


; Statistikausgabe
If Info = 1
 SetFont Font2
 Color 0,0,100
 Rect 0,0, 85, 105, 1
 Color 255,255,255
 Text 4,2, "Aktiv:  " + aktiv
 Text 4,15, "Passiv: " + passiv
 Text 4,30, "Wind:   " + LSet(wind, 15)
 Text 4,45, "----------------"
 Text 4,60, "FPS:    " + fps
 Text 4,75, "F2 - VSync:  " + vsync
 Text 4,90, "F3 - AktSt:  " + aktStatus
EndIf


Flip VSync
Until KeyHit(1)
End
; -------- Ende Hauptschleife --------



; --- Schneeflocke erstellen ---
Function NewFlocke()
 f.flocke = New flocke
 f\x# = Rnd(-150,790) ; 150 Pixel über Bild hinaus (Wind bläßt Pixel seitlich rein!)
 f\y# = 1
 f\speed# = Rnd(.5, 1)
 col = Rnd(150,255)
 f\farbe = alpha*$1000000 + col*$10000 + col*$100 + col
 f\status = 1
End Function