Conway's Game of Life

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

Conway's Game of Life by DarkNature

2004

The Game of Life is not your typical computer game. It is a 'cellular automaton', and was invented by Cambridge mathematician John Conway.

The Rules

For a space that is 'populated':
* Each cell with one or no neighbors dies, as if by loneliness.

* Each cell with four or more neighbors dies, as if by overpopulation.

* Each cell with two or three neighbors survives.
For a space that is 'empty' or 'unpopulated'

* Each cell with three neighbors becomes populated.

AppTitle "Life! by DarkNature"

Graphics 800,600,16,2
SetBuffer BackBuffer()

Global sWidth=GraphicsWidth()
Global sHeight=GraphicsHeight()
Global bWidth=65
Global bHeight=55
Global tSize=10
Global xoff=110
Global yoff=20
Global started=False
Global population=0
Global generation=0
Global font=LoadFont("tahoma",12,0,0,0)

Dim b0(bwidth,bheight)
Dim b1(bwidth,bheight)

SeedRnd(MilliSecs())

Function randomize()
	
	setup()
	
	prob=Rnd(60,80)
	For y=0 To bheight-1
		For x=0 To bwidth-1
			live=Rnd(100)
			If live>prob
				live=1
				population=population+1
			Else live=0
			End If
			b0(x,y)=live
		Next
	Next

End Function

Function setup()

	population=0
	generation=0

	For y=0 To bheight-1
		For x=0 To bwidth-1
			live=Rnd(0,100)
			b0(x,y)=0
			b1(x,y)=0
		Next
	Next

End Function

Function switchem()

	For y=0 To bheight-1
		For x=0 To bwidth-1
			b0(x,y)=b1(x,y)
		Next
	Next

End Function

Function drawboard()
	
	Color 0,0,70
	Rect xoff+10,yoff+10,bwidth*tsize,bheight*tsize

	Color 50,50,50
	Rect xoff,yoff,bwidth*tsize,bheight*tsize

	population=0
	
	For y=0 To bheight-1
		For x=0 To bwidth-1
		
			Local alive=False
		
			If b0(x,y)=1
				alive=True
				population=population+1
			End If
			
			Color 150,150,150
			Rect xoff+x*tsize,yoff+y*tsize,tsize,tsize,alive
						
		Next
	Next
	
	SetFont(font)
	Color 255,255,0
	Text 15,30,"Population: "+population
	Text 15,40,"Generation: "+generation
	Text 15,65,"c:clear r:random"
	Text 15,75,"space bar:start"

End Function

Function live()

	For y=0 To bheight-1
		For x=0 To bwidth-1
			
			ncount=0
			For y1=y-1 To y+1
				For x1=x-1 To x+1
					If (x1>=0 And x1<=bwidth-1) And (y1>=0 And y<=bheight-1)
						If (Not(x1=x And y1=y))
							If b0(x1,y1)=1 ncount=ncount+1
						End If
					End If
				Next
			Next
			
			If ncount=3 And b0(x,y)=0 b1(x,y)=1
			If ncount=2 b1(x,y)=b0(x,y)
			If ncount<2 Or ncount>3 And b0(x,y)=1 b1(x,y)=0		
		Next
	Next
	
	generation=generation+1

End Function

Function trackmouse()

	mx=MouseX()
	my=MouseY()
	x=(mx-xoff)/tsize
	y=(my-yoff)/tsize
		
	If mx>=xoff And x<=bwidth-1 And my>=yoff And y<=bheight-1
	
		If (MouseHit(1) And started=False)
			b0(x,y)=Not b0(x,y)
			b1(x,y)=b0(x,y)
		End If
	
	End If
	
	If (mx>=xoff And x<=bwidth-1) And (my>=yoff And y<=bheight-1)
		Color 255,255,0
		Rect xoff+x*tsize,yoff+y*tsize,tsize,tsize,0
	End If
				
End Function

setup()
t=CreateTimer(30)
ClsColor 0,0,100
timenow=MilliSecs()
While Not KeyHit(1)

	Cls
	
	drawboard()
	
	If KeyHit(46)
		started=False
		setup()
	End If

	If KeyHit(19)
		started=False
		randomize()
	End If

	
	If KeyHit(57) started=Not started
		
	If started
		If MilliSecs()>timenow+150
			live()
			switchem()
			timenow=MilliSecs()
		End If
	End If
	
	trackmouse()
	
	Flip
	
	WaitTimer(t)

Wend
End

Comments

churchaxe

2004

wow, DarkNature, that's really great! I've read about this game many years ago - now I'll find out about the fate of the r-pentomino at last...

Beeps

2004

:)

oo*
*o*
o**

Code Archives Forum