Game of Life

Übersicht

BlitzBasic

Codearchiv

	TOONY Betreff: Game of Life	Di, Sep 28, 2004 17:52 Antworten mit Zitat
Nach Original Game of Life regeln von John Conway Programmiert von Toony BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] ;Nach Original Game of Life regeln von John Conway ;Programmiert von Toony Const fsize=5 Dim map(200,200) Dim nmap(200,200) Graphics 640,480,16,0 SetBuffer BackBuffer() Repeat Cls For x=0 To 640 Step fsize For y=0 To 480 Step fsize ;Plot x,y If MouseX() > x If MouseX() < x+fsize xpos=(x/fsize)+1 If MouseY() > y If MouseY() < y+fsize ypos=(y/fsize)+1 axpos=(x/fsize)+1 aypos=(y/fsize)+1 If map(axpos,aypos)=1 Then Oval axposfsize-fsize,ayposfsize-fsize,fsize,fsize If MouseDown(1) Then map(xpos,ypos)=1 Next Next Text 0,0,"Klicke mit der Maus, um Zellen zu Aktiviren!" Text 0,12 ,"Drücke Return, wenn du Fertig bist!" Oval MouseX()-5,MouseY()-5,11,11,0 Flip Until KeyHit(28) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Repeat Cls Delay 100 ;WaitKey() round=round+1 For x=2 To 130 For y=2 To 100 c=0 If map(x,y)=0 Then If map(x-1,y)=1 Then c=c+1 If map(x+1,y)=1 Then c=c+1 If map(x,y-1)=1 Then c=c+1 If map(x,y+1)=1 Then c=c+1 If map(x-1,y-1)=1 Then c=c+1 If map(x+1,y+2)=1 Then c=c+1 If map(x+1,y-1)=1 Then c=c+1 If map(x-1,y+1)=1 Then c=c+1 If c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 End If If map(x,y)=1 Then If map(x-1,y)=1 Then c=c+1 If map(x+1,y)=1 Then c=c+1 If map(x,y-1)=1 Then c=c+1 If map(x,y+1)=1 Then c=c+1 If map(x-1,y-1)=1 Then c=c+1 If map(x+1,y+2)=1 Then c=c+1 If map(x+1,y-1)=1 Then c=c+1 If map(x-1,y+1)=1 Then c=c+1 If c=2 Or c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 End If Next Next For x=2 To 130 For y=2 To 100 If nmap(x,y)=1 Then Oval xfsize-fsize,yfsize-fsize,fsize,fsize map(x,y)=nmap(x,y) nmap(x,y)=0 Next Next Text 0,0,"ESC ZUM BEENDEN" Text 0,12,Round Oval MouseX()-5,MouseY()-5,11,11,0 Flip 0 Until KeyHit(1) End

TOONY

Betreff: Game of Life

Di, Sep 28, 2004 17:52
Antworten mit Zitat

Nach Original Game of Life regeln von John Conway
Programmiert von Toony

BlitzBasic:


;Nach Original Game of Life regeln von John Conway 
;Programmiert von Toony

Const fsize=5
Dim map(200,200)
Dim nmap(200,200)

Graphics 640,480,16,0


SetBuffer BackBuffer()

Repeat
Cls

For x=0 To 640 Step fsize
For y=0 To 480 Step fsize
;Plot x,y
If MouseX() > x If MouseX() < x+fsize xpos=(x/fsize)+1
If MouseY() > y If MouseY() < y+fsize ypos=(y/fsize)+1
axpos=(x/fsize)+1
aypos=(y/fsize)+1
If map(axpos,aypos)=1 Then Oval axpos*fsize-fsize,aypos*fsize-fsize,fsize,fsize
If MouseDown(1) Then map(xpos,ypos)=1
Next
Next

Text 0,0,"Klicke mit der Maus, um Zellen zu Aktiviren!"
Text 0,12 ,"Drücke Return, wenn du Fertig bist!"
Oval MouseX()-5,MouseY()-5,11,11,0

Flip
Until KeyHit(28)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Repeat
Cls
Delay 100
;WaitKey()
round=round+1


For x=2 To 130
For y=2 To 100
c=0

If map(x,y)=0 Then 
If map(x-1,y)=1 Then c=c+1
If map(x+1,y)=1 Then c=c+1
If map(x,y-1)=1 Then c=c+1
If map(x,y+1)=1 Then c=c+1
If map(x-1,y-1)=1 Then c=c+1
If map(x+1,y+2)=1 Then c=c+1
If map(x+1,y-1)=1 Then c=c+1
If map(x-1,y+1)=1 Then c=c+1
If c=3 Then nmap(x,y)=1 Else nmap(x,y)=0
End If 

If map(x,y)=1 Then 
If map(x-1,y)=1 Then c=c+1
If map(x+1,y)=1 Then c=c+1
If map(x,y-1)=1 Then c=c+1
If map(x,y+1)=1 Then c=c+1
If map(x-1,y-1)=1 Then c=c+1
If map(x+1,y+2)=1 Then c=c+1
If map(x+1,y-1)=1 Then c=c+1
If map(x-1,y+1)=1 Then c=c+1
If c=2 Or c=3 Then nmap(x,y)=1 Else nmap(x,y)=0
End If 


Next
Next

For x=2 To 130
For y=2 To 100
If nmap(x,y)=1 Then Oval x*fsize-fsize,y*fsize-fsize,fsize,fsize
map(x,y)=nmap(x,y)
nmap(x,y)=0
Next
Next

Text 0,0,"ESC ZUM BEENDEN" 
Text 0,12,Round
Oval MouseX()-5,MouseY()-5,11,11,0

Flip 0
Until KeyHit(1)

End

	Ctuchik	Di, Sep 28, 2004 18:09 Antworten mit Zitat
Da hat sich der Fehlerteufel eingeschlichen: BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] If map(x+1,y+2)=1 Then c=c+1 Da muss bei beiden malen ne 1 statt ner 2 hin! So sollte es gehen (ungetestet): BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] ;Nach Original Game of Life regeln von John Conway ;Programmiert von Toony Const fsize=5 Dim map(200,200) Dim nmap(200,200) Graphics 640,480,16,0 SetBuffer BackBuffer() Repeat Cls For x=0 To 640 Step fsize For y=0 To 480 Step fsize ;Plot x,y If MouseX() > x If MouseX() < x+fsize xpos=(x/fsize)+1 If MouseY() > y If MouseY() < y+fsize ypos=(y/fsize)+1 axpos=(x/fsize)+1 aypos=(y/fsize)+1 If map(axpos,aypos)=1 Then Oval axposfsize-fsize,ayposfsize-fsize,fsize,fsize If MouseDown(1) Then map(xpos,ypos)=1 Next Next Text 0,0,"Klicke mit der Maus, um Zellen zu Aktiviren!" Text 0,12 ,"Drücke Return, wenn du Fertig bist!" Oval MouseX()-5,MouseY()-5,11,11,0 Flip Until KeyHit(28) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Repeat Cls Delay 100 ;WaitKey() round=round+1 For x=2 To 130 For y=2 To 100 c=0 If map(x-1,y)=1 Then c=c+1 If map(x+1,y)=1 Then c=c+1 If map(x,y-1)=1 Then c=c+1 If map(x,y+1)=1 Then c=c+1 If map(x-1,y-1)=1 Then c=c+1 If map(x+1,y+1)=1 Then c=c+1 If map(x+1,y-1)=1 Then c=c+1 If map(x-1,y+1)=1 Then c=c+1 If map(x,y)=0 Then If c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 End If If map(x,y)=1 Then If c=2 Or c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 End If Next Next For x=2 To 130 For y=2 To 100 If nmap(x,y)=1 Then Oval xfsize-fsize,yfsize-fsize,fsize,fsize map(x,y)=nmap(x,y) nmap(x,y)=0 Next Next Text 0,0,"ESC ZUM BEENDEN" Text 0,12,Round Oval MouseX()-5,MouseY()-5,11,11,0 Flip 0 Until KeyHit(1) End
Zu den Nebenwirkungen gehören trockener Mund, Übelkeit, Erbrechen, Harnstau, schmerzhafter rektaler Juckreiz, Halluzinationen, Demenz, Psychose, Koma, Tod und Mundgeruch! Magie eignet sich nicht für alle! Fraget euren Arzt oder Apotheker!

Ctuchik

Di, Sep 28, 2004 18:09
Antworten mit Zitat

Da hat sich der Fehlerteufel eingeschlichen:

BlitzBasic:


If map(x+1,y+2)=1 Then c=c+1

Da muss bei beiden malen ne 1 statt ner 2 hin!

So sollte es gehen (ungetestet):

BlitzBasic:


;Nach Original Game of Life regeln von John Conway 
;Programmiert von Toony 

Const fsize=5 
Dim map(200,200) 
Dim nmap(200,200) 

Graphics 640,480,16,0 


SetBuffer BackBuffer() 

Repeat 
Cls 

For x=0 To 640 Step fsize 
For y=0 To 480 Step fsize 
;Plot x,y 
If MouseX() > x If MouseX() < x+fsize xpos=(x/fsize)+1 
If MouseY() > y If MouseY() < y+fsize ypos=(y/fsize)+1 
axpos=(x/fsize)+1 
aypos=(y/fsize)+1 
If map(axpos,aypos)=1 Then Oval axpos*fsize-fsize,aypos*fsize-fsize,fsize,fsize 
If MouseDown(1) Then map(xpos,ypos)=1 
Next 
Next 

Text 0,0,"Klicke mit der Maus, um Zellen zu Aktiviren!" 
Text 0,12 ,"Drücke Return, wenn du Fertig bist!" 
Oval MouseX()-5,MouseY()-5,11,11,0 

Flip 
Until KeyHit(28) 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

Repeat 
Cls 
Delay 100 
;WaitKey() 
round=round+1 


For x=2 To 130 
For y=2 To 100 
c=0 

If map(x-1,y)=1 Then c=c+1 
If map(x+1,y)=1 Then c=c+1 
If map(x,y-1)=1 Then c=c+1 
If map(x,y+1)=1 Then c=c+1 
If map(x-1,y-1)=1 Then c=c+1 
If map(x+1,y+1)=1 Then c=c+1 
If map(x+1,y-1)=1 Then c=c+1 
If map(x-1,y+1)=1 Then c=c+1 

If map(x,y)=0 Then 
If c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 
End If 

If map(x,y)=1 Then 
If c=2 Or c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 
End If 


Next 
Next 

For x=2 To 130 
For y=2 To 100 
If nmap(x,y)=1 Then Oval x*fsize-fsize,y*fsize-fsize,fsize,fsize 
map(x,y)=nmap(x,y) 
nmap(x,y)=0 
Next 
Next 

Text 0,0,"ESC ZUM BEENDEN" 
Text 0,12,Round 
Oval MouseX()-5,MouseY()-5,11,11,0 

Flip 0 
Until KeyHit(1) 

End

Zu den Nebenwirkungen gehören trockener Mund, Übelkeit, Erbrechen, Harnstau, schmerzhafter rektaler Juckreiz, Halluzinationen, Demenz, Psychose, Koma, Tod und Mundgeruch!
Magie eignet sich nicht für alle!
Fraget euren Arzt oder Apotheker!

	sbrog	Mi, Sep 29, 2004 21:03 Antworten mit Zitat
Was ist denn das ?

sbrog

Mi, Sep 29, 2004 21:03
Antworten mit Zitat

Was ist denn das ?

	Timo	Mi, Sep 29, 2004 21:17 Antworten mit Zitat
irgendwie check ich das nicht... was soll den passieren wenn man Enter drückt? Irgendwie sieht das nur so aus als würden sich die Punkte anziehen.. ein paar verschwinden, aber warum - k.a. kann mir einer das spiel / programm erklären? gg

Timo

Mi, Sep 29, 2004 21:17
Antworten mit Zitat

irgendwie check ich das nicht... was soll den passieren wenn man Enter drückt? Irgendwie sieht das nur so aus als würden sich die Punkte anziehen.. ein paar verschwinden, aber warum - k.a.
kann mir einer das spiel / programm erklären? *gg*

	Blatolo	Mi, Sep 29, 2004 21:25 Antworten mit Zitat
Hab grad ein bisschen gegoogelt: http://www.math.com/students/w.../life.html

Blatolo

Mi, Sep 29, 2004 21:25
Antworten mit Zitat

Hab grad ein bisschen gegoogelt:
http://www.math.com/students/w.../life.html

	Travis	Mi, Sep 29, 2004 21:26 Antworten mit Zitat
Schöne Umsetzung. Habe schon mal was davon gehört. Du solltest aber noch eine Resetfunktion einbauen. PS: Man kann den Code auch einrücken
www.funforge.org Ich hasse WASD-Steuerung. Man kann alles sagen, man muss es nur vernünftig begründen können.

Travis

Mi, Sep 29, 2004 21:26
Antworten mit Zitat

Schöne Umsetzung. Habe schon mal was davon gehört. Du solltest aber noch eine Resetfunktion einbauen.

PS: Man kann den Code auch einrücken Wink

www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

	TOONY	Mi, Sep 29, 2004 22:20 Antworten mit Zitat
Neue Version mit Reset und man kann während des spiels neue Zellen aktivieren. Sinn / Zweck dieser anwendung ist es die Zellen so zu aktivieren, dass Sie möglichst lange am leben bleiben! Wenn eine Zelle 3 Nachbarzellen hat, wird sie aktiviert. Wenn eine Aktive Zelle 2 oder 3 Nachbarzellen hat bleibt sie am leben. Trifft nichts davon zu stirbt die Zelle! Würde es jemanden interessienen wenn ich eine Online Bestenliste mache? (BlitzBasic schickt die Punkte dann zu meinem Server, der daraus eine Top Liste macht!)..... BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] ;Nach Original Game of Life regeln von John Conway ;Programmiert von Toony Const fsize=5 Dim map(200,200) Dim nmap(200,200) Graphics 640,480,16,2 .redraw For a= 0 To 200 For b= 0 To 200 map(a,b)=0 nmap(a,b)=0 Next Next .draw bef=0 SetBuffer BackBuffer() Repeat Cls For x=0 To 640 Step fsize For y=0 To 480 Step fsize ;Plot x,y If MouseX() > x If MouseX() < x+fsize xpos=(x/fsize)+1 If MouseY() > y If MouseY() < y+fsize ypos=(y/fsize)+1 axpos=(x/fsize)+1 aypos=(y/fsize)+1 If map(axpos,aypos)=1 Then Oval axposfsize-fsize,ayposfsize-fsize,fsize,fsize If MouseDown(1) Then map(xpos,ypos)=1 Next Next Text 0,0,"Klicke mit der Maus, um Zellen zu Aktiviren!" Text 0,12 ,"Drücke Return, wenn du Fertig bist!" Oval MouseX()-5,MouseY()-5,11,11,0 Flip Until KeyHit(28) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Repeat Cls Delay 100 ;WaitKey() round=round+1 For x=2 To 130 For y=2 To 100 c=0 If map(x-1,y)=1 Then c=c+1 If map(x+1,y)=1 Then c=c+1 If map(x,y-1)=1 Then c=c+1 If map(x,y+1)=1 Then c=c+1 If map(x-1,y-1)=1 Then c=c+1 If map(x+1,y+1)=1 Then c=c+1 If map(x+1,y-1)=1 Then c=c+1 If map(x-1,y+1)=1 Then c=c+1 If map(x,y)=0 Then If c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 End If If map(x,y)=1 Then If c=2 Or c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 End If Next Next For x=2 To 130 For y=2 To 100 If nmap(x,y)=1 Then Oval xfsize-fsize,yfsize-fsize,fsize,fsize map(x,y)=nmap(x,y) nmap(x,y)=0 Next Next Text 0,0,"ESC ZUM BEENDEN" Text 0,12,"F1 um weitere Zellen zu aktivieren" Text 0,24,"F2 zum Reseten und neuen Versuch Starten" Text 0,36,"RUNDE: "+Round Oval MouseX()-5,MouseY()-5,11,11,0 Flip 0 If KeyHit(1) bef=1 If KeyHit(59) bef=2 If KeyHit(60) bef=3 Until bef<>0 If bef=2 Goto draw If bef=3 Goto redraw End

TOONY

Mi, Sep 29, 2004 22:20
Antworten mit Zitat

Neue Version mit Reset und man kann während des spiels neue Zellen aktivieren.

Sinn / Zweck dieser anwendung ist es die Zellen so zu aktivieren, dass
Sie möglichst lange am leben bleiben!

Wenn eine Zelle 3 Nachbarzellen hat, wird sie aktiviert.
Wenn eine Aktive Zelle 2 oder 3 Nachbarzellen hat bleibt sie am leben.
Trifft nichts davon zu stirbt die Zelle!

Würde es jemanden interessienen wenn ich eine Online Bestenliste mache? (BlitzBasic schickt die Punkte dann zu meinem Server, der daraus eine Top Liste macht!).....

BlitzBasic:


;Nach Original Game of Life regeln von John Conway 
;Programmiert von Toony 

Const fsize=5 
Dim map(200,200) 
Dim nmap(200,200) 

Graphics 640,480,16,2
.redraw
For a= 0 To 200
For b= 0 To 200
map(a,b)=0
nmap(a,b)=0
Next
Next

.draw
bef=0
SetBuffer BackBuffer() 

Repeat 
Cls 

For x=0 To 640 Step fsize 
For y=0 To 480 Step fsize 
;Plot x,y 
If MouseX() > x If MouseX() < x+fsize xpos=(x/fsize)+1 
If MouseY() > y If MouseY() < y+fsize ypos=(y/fsize)+1 
axpos=(x/fsize)+1 
aypos=(y/fsize)+1 
If map(axpos,aypos)=1 Then Oval axpos*fsize-fsize,aypos*fsize-fsize,fsize,fsize 
If MouseDown(1) Then map(xpos,ypos)=1 
Next 
Next 

Text 0,0,"Klicke mit der Maus, um Zellen zu Aktiviren!" 
Text 0,12 ,"Drücke Return, wenn du Fertig bist!" 
Oval MouseX()-5,MouseY()-5,11,11,0 

Flip 
Until KeyHit(28) 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

Repeat 
Cls 
Delay 100 
;WaitKey() 
round=round+1 


For x=2 To 130 
For y=2 To 100 
c=0 

If map(x-1,y)=1 Then c=c+1 
If map(x+1,y)=1 Then c=c+1 
If map(x,y-1)=1 Then c=c+1 
If map(x,y+1)=1 Then c=c+1 
If map(x-1,y-1)=1 Then c=c+1 
If map(x+1,y+1)=1 Then c=c+1 
If map(x+1,y-1)=1 Then c=c+1 
If map(x-1,y+1)=1 Then c=c+1 

If map(x,y)=0 Then 
If c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 
End If 

If map(x,y)=1 Then 
If c=2 Or c=3 Then nmap(x,y)=1 Else nmap(x,y)=0 
End If 


Next 
Next 

For x=2 To 130 
For y=2 To 100 
If nmap(x,y)=1 Then Oval x*fsize-fsize,y*fsize-fsize,fsize,fsize 
map(x,y)=nmap(x,y) 
nmap(x,y)=0 
Next 
Next 

Text 0,0,"ESC ZUM BEENDEN" 
Text 0,12,"F1 um weitere Zellen zu aktivieren" 
Text 0,24,"F2 zum Reseten und neuen Versuch Starten" 
Text 0,36,"RUNDE: "+Round 


Oval MouseX()-5,MouseY()-5,11,11,0 

Flip 0 

If KeyHit(1) bef=1
If KeyHit(59) bef=2
If KeyHit(60) bef=3

Until bef<>0

If bef=2 Goto draw
If bef=3 Goto redraw

End

	Blatolo	Do, Sep 30, 2004 6:45 Antworten mit Zitat
Wie willst du denn dabei Punkte vergebn? Etwa danach wie lange sich noch etwas bewegt? Aber meistens kommen am ende noch Blinker raus und die bewegen sich nunmal. Oder man macht einfach etwas dass sich periodisch wiederholt und lässt es sehr lange an

Blatolo

Do, Sep 30, 2004 6:45
Antworten mit Zitat

Wie willst du denn dabei Punkte vergebn?
Etwa danach wie lange sich noch etwas bewegt?
Aber meistens kommen am ende noch Blinker raus und die bewegen sich nunmal.
Oder man macht einfach etwas dass sich periodisch wiederholt und lässt es sehr lange an

	TOONY	Do, Sep 30, 2004 9:58 Antworten mit Zitat
das problem ist in der neuen version gelößt. ich lade die heut abend hoch!

TOONY

Do, Sep 30, 2004 9:58
Antworten mit Zitat

das problem ist in der neuen version gelößt.
ich lade die heut abend hoch!

Übersicht

BlitzBasic

Codearchiv

Nach Oben

BlitzBasic Portal

Game of Life

Betreff: Game of Life