2D Schneefall
Übersicht BlitzBasic Codearchiv
TravisBetreff: 2D Schneefall |
Di, Feb 03, 2004 14:14 Antworten mit Zitat |
|
---|---|---|
Von einem alten QuickBasic Programm inspiriert, habe ich maleine Schneefallsimulation entwickelt.
Code: [AUSKLAPPEN] ; ------------------------ ; - 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 |
||
www.funforge.org
Ich hasse WASD-Steuerung. Man kann alles sagen, man muss es nur vernünftig begründen können. |
Mr.Keks |
Di, Feb 03, 2004 14:24 Antworten mit Zitat |
|
---|---|---|
ich finde es ja schön, dass du hier soviele lustige codes postest, aber du solltest sie mal etwas optimieren... speziel zu nennen wäre, dass du nicht zig mal denselben type mit for-each-next durchgehen musst.... es reicht wirklich, wenn du dafür nur eine schleife schreibst und in der alles erledigt
https://www.blitzforum.de/viewtopic.php?t=303 <- da hatten wir das doch schonmal... |
||
MrKeks.net |
Jan_Ehemaliger Admin |
Di, Feb 03, 2004 14:26 Antworten mit Zitat |
|
---|---|---|
Gefällt mir, aber so besser:
Code: [AUSKLAPPEN] ; ------------------------
; - 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 |
||
between angels and insects |
Mr.Keks |
Di, Feb 03, 2004 14:34 Antworten mit Zitat |
|
---|---|---|
och, das ließe sich auch noch optimieren, aber ich mache gerade was anderes... | ||
MrKeks.net |
soli |
Mi, Feb 04, 2004 0:26 Antworten mit Zitat |
|
---|---|---|
Die Flocken fallen arg gleichmässig.
Was ist mit Wind, und Unterschiede in der Fallgeschwindigkeit? |
||
solitaire |
Travis |
Mi, Feb 04, 2004 22:11 Antworten mit Zitat |
|
---|---|---|
Gute Idee. 8) Ich habe das mal hinzugefügt. Außerdem hat jetzt jede Schneeflocke einen unterschiedlichen Farbton, so dass die Schneehaufen etwas realistischer Wirken. Außerdem gibt's jetzt ein Infofenster, daß Windstärke und Flockenzahl anzeigt.
F1 = Info an/aus F2 = VSync an/aus F3 = Flockenstatus aktualisieren (siehe Quelltext) F4 = Zusätzliche Schneeflocken (Taste gedrückt halten) F5 = Kein Wind (Taste gedrückt halten) Edit: Neuste Version Code: [AUSKLAPPEN] ; ------------------------ ; - 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 |
||
www.funforge.org
Ich hasse WASD-Steuerung. Man kann alles sagen, man muss es nur vernünftig begründen können. |
Übersicht BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group