Code archives/Algorithms/Conway's Life Algorithm

This code has been declared by its author to be Public Domain code.

Download source code

Conway's Life Algorithm by Gary B2005
This is a small, fast implementation of Conway's life algorithm.
I have well documented it, and I am fairly pleased with it.
It could be made heaps faster with an external DLL, but then it wouldn't be all Blitz Code would it :)
I hope that someone finds it useful.
; Conway's Game of Life
; Coded by Gary Barnes - The Control Key (June 2005)
; I did it because I could, and it was interesting.
; A little raw, but optimised for speed
; It isn't very fancy and could stand tarting up a little
; Still it fair blitzters along given that it is updating 
; 960,000 array elements And 480,000 pixels Each display redraw

; Maybe someone will find it useful, or at least mildly interesting

Global w = 800
Global h = 600 ; size of a board (increase the size If you like)


Graphics w,h
SetBuffer BackBuffer() 


Dim tG(w,h)			; this generation
Dim nG(w,h)			; next generation

h=h-1				; set height for life array - 1 less than the screen height to avoid boundary problems
w=w-1				; set width - look above

SeedRnd MilliSecs()	; reset the random number generator	

Color 255,255,255	; set the colour of the writepixel fast routine for later
Plot 0,0
tcol = ReadPixel(0,0)

ClsColor 0,0,64		; I liked white on blue, change it at will

Repeat				; main program loop
   For y = 1 To H	; seed this generation array randomly
       For x = 1 To W
           z = Rnd(1,10)	; change from 10 to whatever you like - 2 is too crowded 
           If z = 1 Then tG(x,y) = 1 ; between 10 and 50 odd gives a pleasing result
       Next
   Next

   Repeat
      If Rnd(0,99) > 90 Then		; sets a 10% chance of reseeding a small part of the current generation matrix
         rsx = Rnd(10,w-20)
         rsy = Rnd(10,h-20)
  
         For p = 0 To 9				; do it 10 times 
             rx = Rnd(rsx,rsx+5)
             ry = Rnd(rsy,rsy+5)
             tg(rx,ry) = 1
         Next 
      EndIf
      Gosub paintscreen				; draw it
      dummy = GetKey()				; get something from the keyboard buffer
      If dummy = 32 Then WaitKey()	; it is space so pause the program
      If dummy = 27 Then End 		; it is escape so stop
   Forever 
Forever

End

.PaintScreen
For y = 1 To H
    For x = 1 To W
        sum = 0 
        sum = sum + tg(x-1,y-1) + tg(x,y-1) + tg(x+1,y-1) 	; life needs to know how many neighbours a cell has
        sum = sum + tg(x-1,y)   + tg(x+1,y) 				; this routine just adds up the number of occupied cells
        sum = sum + tg(x-1,y+1) + tg(x,y+1) + tg(x+1,Y+1)   ; around the one of interest - tg(x,y)
        Select sum                                          ; implement the algorithm
               Case 2  : If tg(x,y) = 1 Then ng(x,y) = 1 	; if the cell is alive and it has two neighbours it stays alive
               Case 3  : ng(x,y) = 1                        ; if any cell has three neighbours it bursts into life or stays alive   
               Default : ng(x,y) = 0						; for any other sum, the cells dies if it is alive
        End Select											; that is it - life game all done
	Next
Next


Cls															; clear the screen as we only write pixels if we have to
LockBuffer													; as the little routine is optimised for speed
For y = 1 To H
    For x = 1 To W
        If tg(x,y) > 0 Then WritePixelFast x,y,tcol
        tg(x,y) = ng(x,y)									; copy the next generation to the current generation to display later
    Next
Next
UnlockBuffer	; you have to lock then unlock the screen buffer otherwise writepixelfast won't work !
Flip			; all done display the new page and return						

Return

Comments

Gary B2005
Hi Group
I have revisited the code and this version is smaller and faster than the version above.
Of course it compiles to the same size.
I hope you enjoy the newer version.

; Conway's Game of Life
; Coded by Gary Barnes - The Control Key (June 2005)
; Smaller and faster than the previous version

Global w = 800
Global h = 600

Graphics w,h
SetBuffer BackBuffer()

Dim tG(w,h)
Dim nG(w,h)

h=h-1
w=w-1

SeedRnd MilliSecs()
Color 255,255,255
Plot 0,0
tcol = ReadPixel(0,0)
ClsColor 0,0,64

For y = 1 To H
For x = 1 To W
z = Rnd(1,10)
If z = 1 Then tG(x,y) = 1
Next
Next

Repeat
If Rnd(0,99) > 90 Then
rsx = Rnd(10,w-20)
rsy = Rnd(10,h-20)

For p = 0 To 9
rx = Rnd(rsx,rsx+5)
ry = Rnd(rsy,rsy+5)
tg(rx,ry) = 1
Next
EndIf

Cls
LockBuffer
For y = 1 To H
For x = 1 To W
sum = 0
sum = sum + tg(x-1,y-1) + tg(x,y-1) + tg(x+1,y-1) + tg(x-1,y) + tg(x+1,y) + tg(x-1,y+1) + tg(x,y+1) + tg(x+1,Y+1)
If sum = 2 Then ng(x,y) = tg(x,y)
If sum = 3 Then ng(x,y) = 1
If tg(x,y) > 0 Then WritePixelFast x,y,tcol
Next
Next
UnlockBuffer
Flip

For y = 1 To H
For x = 1 To W
tg(x,y) = ng(x,y)
Next
Next
Dim nG(w,h)

dummy = GetKey()
If dummy > 0 Then
If dummy = 32 Then WaitKey()
If dummy = 27 Then End
EndIf
Forever
End


Rck2005



I added comments and modifications for user interaction to this one, directions are at top


Subirenihil2006
Nice! :)


Code Archives Forum