Another Problem

Blitz3D Forums/Blitz3D Programming/Another Problem

Amanda Dearheart

(Posted 2012) [#1]

I'm not sure if the logic in this game is working correctly, Check out the Evaluate function

for anyone that knows John Conway's game of life, if a cell has 2 or 3 neighbors, he survives, but if he has 4 or 1, he dies.

From playtesting experiences, the function doesn't seem to be working correctly!


Dim a(10, 10)
Dim b(10, 10)

Dim Cpy$(4)   ;    used for copyright info in DisplayTitle function

Global cellB, cellR, cellY, blank  ; main graphic images
Global Screen_Width = 1024
Global Screen_Height = 768
Global Title                ; handle for title graphic

; so far the main functions in the game

Game

end


Function StartUp()
	
	Graphics 1024, 768, 32
	SetBuffer BackBuffer()
	
End Function

Function LoadGraphics()
	
	Title = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\life.jpg")
	
	cellB = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\cell black.jpg")
	cellR = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\cell red.jpg")
	cellY = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\cell yellow.jpg")
	blank = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\blank.jpg")
	
	
	Zero = LoadFont("Saved by Zero",18,False,True,False)
	SetFont Zero
	
End Function

Function Game()
	
	StartUp
	LoadGraphics
	demo = DisplayTitle()
	SetPattern(demo)
	
	Main(demo)
	
	;EndGame
		
End Function

Function DisplayTitle()

	Iw = ImageWidth(Title)
	CenterX = Screen_Width/2 - Iw/2
	DrawImage Title, CenterX, 0

	Cpy$(1) = "Adapted by Amanda Dearheart"
	Cpy$(2) = "Based on Life by John Conway"
	Cpy$(3) = "(C) 2013 Crazy Scorpion"
	For M = 1 to 3
		
		Tw = Len(Cpy$(M))
		CenterX = Screen_Width/2 - Tw * 6
		y3 = 400 + (M * 25)
		Text CenterX, y3, Cpy$(M)
	Next
	Flip
	
	d = TimerPause(5000, True)
	cls
	
	Return d
End Function

Function SetPattern(demostate)
	
	if demostate = True then
		SeedRnd MilliSecs()
		For x = 2 to 9
				For y = 0 to 9
					a(x, y) = rnd(0, 1)
					if a(x, y) = 1 then PlaceImage(cellY, x, y)
					;b(x, y) = a(x, y)
				Next	
		Next
	Else
		done = False
		Repeat
			;Mx = MouseX()
			;My = MouseY()
			PlaceImage(cellY, MouseX(), MouseY())
			Flip
			if done = True then exit
		Forever
	End if
	
End Function

Function Main(demostate)

	if demostate = true then
		
		Repeat

			if KeyHit(1) then exit
			
			G = G + 1   ;   used for  generation

			GenCon(100, 420, G)
		
			Evaluate
			
				
			Flip

		Forever
			
	EndIf
	
End Function

Function EndGame()
	
End Function

Function GenCon(Top, Left, value)
	
	Gen$ = "Generation " + str(value)  
	viewport Left, Top, 200, 40
			
	cls
	Text Left, Top, Gen$
			
	viewport 0, 0, Screen_Width, Screen_Height
	
End Function

Function Evaluate()

	For x = 2 to 9
		For y = 2 to 9
			c = 0
			if a(x - 1,y - 1) = 1 then c = c + 1
			if a(x - 1, y) = 1 then c = c + 1
			if a(x - 1, y + 1)= 1 then c = c + 1
			if a(x, y - 1) = 1 then c = c + 1
			if a(x, y + 1) = 1 then c = c + 1
			if a(x + 1, y - 1) = 1 then c = c + 1
			if a(x + 1, y) = 1 then c = c + 1
			if a(x + 1, y + 1) = 1 then c = c + 1
			if a(x, y) = 1 and (c <> 3 and c <> 2) then b(x, y) = 0
			if a(x, y) = 0 and c = 3 then b(x, y) = 1

			
			if b(x, y) = 1 then PlaceImage(cellY, x, y)
			if b(x, y) = 0 then PlaceImage(blank, x, y)
			
		Next 
	Next  
	
End Function

Function PlaceImage(Image, x, y)
		 
	 x3 = 300 + (x * 35)   ;  100  - y start of grid, 35 - width of image
	 y3 = 200 + (y * 35)   ;  100  - y start of grid, 35 - width of image
	 DrawBlock Image, x3, y3, 0
	 Flip
	 
End Function

Function Debugcon(Msg1$, Msg2$ = "empty", Msg3$ = "empty too")
	
	viewport 800, 500, 200, 200
	ClsColor 0, 0, 255
	Cls
	Text 800, 500, Msg1$
	Text 800, 530, Msg2$
	Text 800, 560, Msg3$
	viewport 0, 0, Screen_Width, Screen_Height	 
	
End Function

Function TimerPause(time# = 5000, TrapKM = False)
	
	now = MilliSecs()
	demo = True
	While MilliSecs() < now + time#
		if TrapKM = True then
			kb = GetKey()
			mb = GetMouse()
		EndIf
		
		if kb > 0 or mb > 0  then demo = False : exit
	Wend
	
	Return demo
	
End Function

_PJ_	(Posted 2012) [#2]


		done = False
		Repeat
			;Mx = MouseX()
			;My = MouseY()
			PlaceImage(cellY, MouseX(), MouseY())
			Flip
			If done = True Then Exit
		Forever

Here, there's no way for 'done' to become True, so the loop repeats forever.

There may be other issues, too, but I've not yet had a good look through it all

Midimaster

(Posted 2012) [#3]

first of all...

I will demonstate you to use the command DEBUGLOG to find your bugs. DEBUGLOG offers you the chance to see variable values during the game. This gives you the chance to evaluate, whether things are as you expected them.

You have to switch on the menu "Program - Debug enable" in the Blitz-IDE. This will open two windows during run.

Now write your first DEBUGLOG into the PlaceImage() Function to watch the X3 and Y3 variables:

Function PlaceImage(Image, x, y)
	 x3 = 300 + (x * 35)   ;  100  - y start of grid, 35 - width of image
	 y3 = 200 + (y * 35)   ;  100  - y start of grid, 35 - width of image
	 DrawBlock Image, x3, y3, 0
DebugLog x3 + "    " + y3		 
	 
End Function

Now run the game and see the coordinates of X and Y in the debugger windows. Where you try to paint your cells? Outside the screen?

Because of missing images it is not easy for people to run your code on their machines. So I'll modify the code by replacing images by rects...

Function LoadGraphics()
	
	;Title = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\life.jpg")
	Color 0,0,255
	Title=CreateImage(135,35)
	Rect 0,0,136,36
	GrabImage Title,0,0

	
	;cellB = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\cell black.jpg")
	;cellR = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\cell red.jpg")
	;cellY = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\cell yellow.jpg")
	;blank = LoadImage("C:\Documents and Settings\HP_Administrator\My Documents\workspace\life\media\blank.jpg")
	
	Color 5,5,5
	cellB=CreateImage(35,35)
	Rect 0,0,36,36
	GrabImage cellB,0,0

	Color 255,0,0
	cellR=CreateImage(35,35)
	Rect 0,0,36,36
	GrabImage cellR,0,0

	Color 255,255,0
	CellY=CreateImage(35,35)
	Rect 0,0,36,36
	GrabImage cellY,0,0

	Color 0,255,0
	blank=CreateImage(35,35)
	Rect 0,0,36,36
	GrabImage blank,0,0
.....

to be continued......

As PJ wrote you need a chance to exit the REPEAT-loop in SetPattern()

For a first test I would suggest this:

		Repeat
			Mx = MouseX()
			My = MouseY()
			PlaceImage(cellY, MouseX(), MouseY())
			Flip 0
		Until KeyHit(1)

KeyHit(1) exit the function when pressing the ESC key.

It is never a good idea to have multiple FLIPs in your code. Remove the FLIP inside PlaceImage(). You dont need it!

Function PlaceImage(Image, x, y)
	 	 x3 = 300 + (x * 35)
	 y3 = 200 + (y * 35)   
	 DrawBlock Image, x3, y3, 0
DebugLog x3 + " " + y3

Last edited 2012

Floyd

(Posted 2012) [#4]

It looks okay to me except that after calculating the next generation b() from the current one a() you forgot to copy b() into a().

And for the sake of simplicity there is no need for all those Ifs to determine the number of neighbors. Every cell is 0 or 1 so to determine the number of 1s you just add them.

Here's a simplified version with no media, so other people can run it.

Dim a(101, 101)
Dim b(101, 101)

StartUp
SetPattern
While Not KeyDown(1)
	Evaluate
	ShowBoard
	Flip 
	Cls
	Delay 150
Wend



Function StartUp()
	
	Graphics 750, 750, 0, 2
	SetBuffer BackBuffer()
	Color 200, 200, 0
	
End Function

Function SetPattern()
	
		SeedRnd MilliSecs()
		For x = 1 To 100
				For y = 1 To 100
					a(x, y) = Rand(0, 1)
				Next	
		Next
	
End Function

Function Evaluate()

	For x = 1 To 100
		For y = 1 To 100
			c = a(x-1,y-1)+a(x-1,y)+a(x-1,y+1)+a(x,y-1)+a(x,y+1)+a(x+1,y-1)+a(x+1,y)+a(x+1,y+1)
			If a(x, y) = 1 And (c <> 3 And c <> 2) Then b(x, y) = 0
			If a(x, y) = 0 And c = 3 Then b(x, y) = 1
		Next 
	Next  
	
	For x = 1 To 100
		For y = 1 To 100
				a(x,y) = b(x,y)
		Next
	Next
	
End Function

Function ShowBoard()
		 
	For x = 1 To 100
		For y = 1 To 100
			If a(x,y)
				Rect 25+7*x, 25+7*y, 5, 5
			End If
		Next
	Next 
	 
End Function