Graphics 1024,768,32

SetBuffer BackBuffer()










Const dimens=200      ;<-----------Diesen Wert verändern um die Rasterung des Feldes zu verändern!






;Zwischenspeicher-Types

Type zellenhinzu
   Field x,y
End Type


Type zellenweg
   Field x,y
End Type




SeedRnd(MilliSecs())



Dim feld (dimens+1,dimens+1)



Global n
Global zellehinzu.zellenhinzu
Global zelleweg.zellenweg



Local x,y






   
For n=0 To (dimens/3)^2         ;<----spielt hierdran rum um die Dichte der Startzellen zu verändern!
      
   feld(Rand(1,dimens),Rand(1,dimens))=1
   Next
      
   
   
   
   Repeat
      
      simulation
      zeichne
      
   Until KeyHit(1)
   
   
   
   
   
   


















Function simulation()
   
   Local x,y
   
   
   ; zuerst wird gecheckt, ob neue Zellen entstehen können.
   For x=0 To dimens
      
      For y=0 To dimens
         
         If feld(x,y)=0 Then
            
         
            n=0
            
            If x-1>0 Then If feld(x-1,y)=1 Then n=n+1      ;links
            If x+1<dimens+1 Then If feld(x+1,y)=1 Then n=n+1      ;rechts
            
            If y-1>0 Then If feld(x,y-1)=1 Then n=n+1      ;oben
            If y+1<dimens+1 Then If feld(x,y+1)=1 Then n=n+1      ;unten
            
            If x-1>0 And y-1>0 Then If feld(x-1,y-1)=1 Then n=n+1   ;links oben
            If x+1<dimens+1 And y-1>0 Then If feld(x+1,y-1)=1 Then n=n+1   ;rechts oben
            
            If x-1>0 And y+1<dimens+1 Then If feld(x-1,y+1)=1 Then n=n+1   ;links unten
            If x+1<dimens+1 And y+1<dimens+1 Then If feld(x+1,y+1)=1 Then n=n+1   ;rechts unten
            
            
            
            If n=3 Then neuezelle(x,y)
            
         Else   ;Entfernen armer einsamer Zellen
            
            
            n=0
            
            If x-1>0 Then If feld(x-1,y)=1 Then n=n+1      ;links
            If x+1<dimens+1 Then If feld(x+1,y)=1 Then n=n+1      ;rechts
            
            If y-1>0 Then If feld(x,y-1)=1 Then n=n+1      ;oben
            If y+1<dimens+1 Then If feld(x,y+1)=1 Then n=n+1      ;unten
            
            If x-1>0 And y-1>0 Then If feld(x-1,y-1)=1 Then n=n+1   ;links oben
            If x+1<dimens+1 And y-1>0 Then If feld(x+1,y-1)=1 Then n=n+1   ;rechts oben
            
            If x-1>0 And y+1<dimens+1 Then If feld(x-1,y+1)=1 Then n=n+1   ;links unten
            If x+1<dimens+1 And y+1<dimens+1 Then If feld(x+1,y+1)=1 Then n=n+1   ;rechts unten
            
            
            
            If n<2 Or n>3 Then entfernezelle(x,y)
            
         End If
         
            
      Next
   Next
      
   
   
   For zelleweg=Each zellenweg
      feld(zelleweg\x,zelleweg\y)=0
      Delete zelleweg
   Next
   
   For zellehinzu=Each zellenhinzu
      feld(zellehinzu\x,zellehinzu\y)=1
      Delete zellehinzu
   Next
   
      
   


End Function

   
Function zeichne()
   
   Local x,y
   
   Cls
   
   ;Rect 1,1,700,700,0
   
   
   
   For x=0 To dimens
      
      For y=0 To dimens
         
         If feld(x,y)=1 Then Oval x*700/dimens,y*700/dimens,700/dimens,700/dimens,1
         
      Next
   Next
   
   
   Text 512,740,"John Conway's GAME OF LIFE, coded by Felix Müller aka. Wave",1
   Flip
   
End Function


Function neuezelle(x,y)
   zellehinzu=New zellenhinzu
   zellehinzu\x=x
   zellehinzu\y=y
End Function

Function entfernezelle(x,y)
   zelleweg=New zellenweg
   zelleweg\x=x
   zelleweg\y=y
End Function