Mein Ansatz zu Conways Game of Life

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Benutzeravatar
PureUser1966
Beiträge: 29
Registriert: 02.02.2017 21:03
Wohnort: Cologne / Germany

Mein Ansatz zu Conways Game of Life

Beitrag von PureUser1966 »

Hallo,
anbei einmal mein Ansatz von Conways Game of Life.

Wollt ich immer mal bauen und nehme diesen Ansatz jetzt um es
später auf dem C64 umzusetzen.

Viel Spaß damit..




Code: Alles auswählen

; --------------------------
; GameOfLife.pb
; started 14-04-2019
; (c) by duke/ radwar
; --------------------------


Declare		CreateGameGadgets()
Declare		InitSystem()
Declare		InitGrid()
Declare		DrawGeneration()
Declare.i	CountNeighbors(iX.i, iY.i)
Declare		CalcNextStep()




Enumeration
	#DEAD	=	0
	#ALIVE	=	1	
EndEnumeration



; ID's
Enumeration
	#GAMEWINDOW = 10
	#GAMETIMER
	#GAD_CONTAINER_1					; Button Container
	#GAD_BUTTON_1						; Reset Game of Life
	#GAD_BUTTON_2						; Step
	#GAD_STRING_1						; grid xsize
	#GAD_STRING_2						; grid ysize
	#GAD_STRING_3						; generation
	#GAD_STRING_4						; cells alive
	#GAD_STRING_5						; cells dead
	#GAD_TEXT_1							;
	#GAD_TEXT_2							;
	#GAD_TEXT_4							; cells alive text
	#GAD_TEXT_5							; cells dead text
	#GAD_CHECK_1						; Grid ON/OFF	
	#GAD_CHECK_2						; Automatic steps
	#GAD_TRACKBAR						; Trackbar gadget for timer value
	#GAD_CANVAS_01						; main drawing canvas gadget
	
	
EndEnumeration

; variables

Global.i	iQuit			=	0		; event signal
Global.i	iEvent			=	0		; event number
Global.i	iTimerDelay		=	25		; ms
Global.i	iBlockSize		=	10		; block size
Global.i	iArrayXSize		=	0		; array size
Global.i	iArrayYSize		=	0		; array size
Global.i	iGeneration		=	0		; number of cell generation
Global.i	iGridFlag 		=	0		; 1 = grid on / 0 = grid off

Global.i	Dim	MyArray(iArrayXSize, iArrayYSize)
Global.i	Dim	WorkArray(iArrayXSize, iArrayYSize)


EnableExplicit						; The magic one


If OpenWindow(#GAMEWINDOW, 500, 200, 1600, 800,"Conway's 'Game of Life' - Code by duke/Radwar - written 15.04.2019", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Maximize)
	
	iArrayXSize = WindowWidth(#GAMEWINDOW, #PB_Window_InnerCoordinate) / iBlockSize
	iArrayYSize = (WindowHeight(#GAMEWINDOW, #PB_Window_InnerCoordinate) - 50) / iBlockSize
	iArrayYSize - 5
	; pre init (clear) both arrays
	Dim MyArray(iArrayXSize, iArrayYSize)	
	Dim WorkArray(iArrayXSize, iArrayYSize)	
	
	
	CreateGameGadgets()
	InitSystem()
	InitGrid()
	
	Repeat
		iEvent = WaitWindowEvent()
		Select iEvent
			Case #PB_Event_Timer
				Select EventTimer()
					Case #GAMETIMER
						CalcNextStep()
						If iGeneration = 3000
							InitGrid()	
						EndIf
						
				EndSelect
				
				
			Case #PB_Event_Gadget
				Select EventGadget()
						
					Case #GAD_BUTTON_1
						InitGrid()
					Case #GAD_BUTTON_2
						CalcNextStep()		
					Case #GAD_CHECK_1
						If GetGadgetState(#GAD_CHECK_1) = #PB_Checkbox_Checked
							iGridFlag = 1
						Else	
							iGridFlag = 0
						EndIf
						DrawGeneration()						
					Case #GAD_CHECK_2
						If GetGadgetState(#GAD_CHECK_2) = #PB_Checkbox_Checked
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
						    AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
						Else	
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
						EndIf
					Case #GAD_TRACKBAR
						iTimerDelay = GetGadgetState(#GAD_TRACKBAR)
						If GetGadgetState(#GAD_CHECK_2) = #PB_Checkbox_Checked
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
						    AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
						EndIf
				EndSelect
		EndSelect
		
		
		
		If iEvent = #PB_Event_CloseWindow  ; If the user has pressed on the close button
			iQuit = 1
		EndIf
	
	Until iQuit = 1


EndIf



Procedure	CreateGameGadgets()
	Protected.i		iXpos=0, iYpos=0, iWidth=0, iHeight=0, iFlags=0
	Protected.s		sMsg	=	""
	Protected.i		iGadget	=	0
	
	iXpos		=	1
	iYpos		=	1
	iWidth		=	WindowWidth(#GAMEWINDOW, #PB_Window_InnerCoordinate) -1
	iHeight		=	50
	iFlags		=	#PB_Container_Raised
	iGadget 	=	#GAD_CONTAINER_1
	ContainerGadget(iGadget, ixPos, iyPos, iWidth, iHeight, iFlags) 
	
	iXpos		=	1
	iYpos		=	1
	iWidth		=	80
	iHeight		=	42
	iFlags		=	#PB_Button_MultiLine
	sMsg		=	"Reset GoL"
	iGadget		=	#GAD_BUTTON_1
	ButtonGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	82
	iYpos		=	1
	iWidth		=	80
	iHeight		=	42
	iFlags		=	#PB_Button_MultiLine
	sMsg		=	"Next Step"
	iGadget		=	#GAD_BUTTON_2
	ButtonGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	
	iXpos		=	GadgetX(#GAD_BUTTON_2) + GadgetWidth(#GAD_BUTTON_2) + 10
	iYpos		=	10
	iWidth		=	100
	iHeight		=	20
	iFlags		=	#PB_String_Numeric | #PB_Text_Center | #PB_String_ReadOnly
	sMsg		=	Str(iGeneration)
	iGadget		=	#GAD_STRING_3
	StringGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	
	iXpos		=	GadgetX(#GAD_STRING_3) + GadgetWidth(#GAD_STRING_3) + 10
	iYpos		=	10
	iWidth		=	100
	iHeight		=	20
	iFlags		=	0
	sMsg		=	"Grid on/off"
	iGadget		=	#GAD_CHECK_1
	CheckBoxGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	SetGadgetState(iGadget, #PB_Checkbox_Unchecked)	
	
	iXpos		=	GadgetX(#GAD_CHECK_1) + GadgetWidth(#GAD_CHECK_1) + 10
	iYpos		=	10
	iWidth		=	100
	iHeight		=	20
	iFlags		=	0
	sMsg		=	"Automode "
	iGadget		=	#GAD_CHECK_2
	CheckBoxGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	SetGadgetState(iGadget, #PB_Checkbox_Checked)	
	
	
	iXpos		=	GadgetX(#GAD_CHECK_2) + GadgetWidth(#GAD_CHECK_2) + 10
	iYpos		=	1
	iWidth		=	70
	iHeight		=	20
	iFlags		=	#PB_Text_Right
	sMsg		=	"Cells alive"
	iGadget		=	#GAD_TEXT_4
	TextGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	GadgetX(#GAD_TEXT_4) + GadgetWidth(#GAD_TEXT_4) + 10
	iYpos		=	1
	iWidth		=	100
	iHeight		=	20
	iFlags		=	#PB_String_Numeric | #PB_Text_Center | #PB_String_ReadOnly
	sMsg		=	""
	iGadget		=	#GAD_STRING_4
	StringGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	
	iXpos		=	GadgetX(#GAD_CHECK_2) + GadgetWidth(#GAD_CHECK_2) + 10
	iYpos		=	25
	iWidth		=	70
	iHeight		=	20
	iFlags		=	#PB_Text_Right
	sMsg		=	"Cells dead"
	iGadget		=	#GAD_TEXT_5
	TextGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	GadgetX(#GAD_TEXT_5) + GadgetWidth(#GAD_TEXT_5) + 10
	iYpos		=	22
	iWidth		=	100
	iHeight		=	20
	iFlags		=	#PB_String_Numeric | #PB_Text_Center | #PB_String_ReadOnly
	sMsg		=	""
	iGadget		=	#GAD_STRING_5
	StringGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	GadgetX(#GAD_STRING_5) + GadgetWidth(#GAD_STRING_5) + 10
	iYpos		=	5
	iWidth		=	200
	iHeight		=	30
	iFlags		=	#PB_TrackBar_Ticks
	iGadget		=	#GAD_TRACKBAR
	TrackBarGadget(iGadget, ixPos, iyPos, iWidth, iHeight, 1, 500, iFlags) 
	SetGadgetState(iGadget,iTimerDelay)
	
	
	iXpos		=	GadgetWidth(#GAD_CONTAINER_1, #PB_Gadget_ActualSize) - 50
	iYpos		=	10
	iWidth		=	40
	iHeight		=	20
	iFlags		=	#PB_String_Numeric | #PB_Text_Center | #PB_String_ReadOnly
	sMsg		=	Str(iArrayYSize)
	iGadget		=	#GAD_STRING_2
	StringGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	GadgetX(#GAD_STRING_2, #PB_Gadget_ContainerCoordinate) - 20
	iYpos		=	15
	iWidth		=	20
	iHeight		=	20
	iFlags		=	#PB_Text_Center
	sMsg		=	"Y"
	iGadget		=	#GAD_TEXT_2
	TextGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	GadgetWidth(#GAD_CONTAINER_1, #PB_Gadget_ActualSize) - 120
	iYpos		=	10
	iWidth		=	40
	iHeight		=	20
	iFlags		=	#PB_String_Numeric | #PB_Text_Center | #PB_String_ReadOnly
	sMsg		=	Str(iArrayXSize)
	iGadget		=	#GAD_STRING_1
	StringGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	iXpos		=	GadgetX(#GAD_STRING_1, #PB_Gadget_ContainerCoordinate) - 20
	iYpos		=	15
	iWidth		=	20
	iHeight		=	20
	iFlags		=	#PB_Text_Center
	sMsg		=	"X"
	iGadget		=	#GAD_TEXT_1
	TextGadget(iGadget, ixPos, iyPos, iWidth, iHeight, sMsg, iFlags) 
	
	CloseGadgetList()
	
	
	
	iWidth		=	(iArrayXSize * iBlockSize)
	iHeight		=	(iArrayYSize * iBlockSize)
	
	iWidth		=	WindowWidth(#GAMEWINDOW, #PB_Window_InnerCoordinate)
	iHeight		=	WindowHeight(#GAMEWINDOW, #PB_Window_InnerCoordinate) - 50
	
	
	iXpos		=	0
	iypos		=	0 + 50
	iflags		=	0
	CanvasGadget(#GAD_CANVAS_01, iXpos, iYpos, iWidth, iHeight, iFlags)
	
	
EndProcedure


Procedure	InitSystem()
	
	AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
	
EndProcedure



Procedure	InitGrid()
	
	Protected.i	iLoopX=0, iLoopY=0
	Protected.i	iValue=0
	
	; randomly fill array with values (0/1)	
	For iLoopY = 0 To iArrayYSize-1
		For iLoopX = 0 To iArrayXSize-1
			ivalue = Random(1,0)
			MyArray(iLoopX, iLoopY) = iValue
		Next iLoopX
	Next iLoopY	
	
	; reset generation value (for output reason only...)	
	iGeneration =	0
	SetGadgetText(#GAD_STRING_3, Str(iGeneration))
	; draw the first generation to screen
	DrawGeneration()	
	
EndProcedure



Procedure DrawGeneration()
	
	Protected.i	icurX=0, icurY=0
	Protected.i	iLoopX=0, iLoopY=0	
	
	If StartDrawing(CanvasOutput(#GAD_CANVAS_01))
		; clear canvas gadget with color
		Box(0,0,iBlockSize*iArrayXSize, iBlockSize*iArrayYSize, $000000)
		
		If iBlockSize >= 4 And iGridFlag = 1
			icurX = 0
			icurY = 0
			; draw the gridlines
			For iLoopX = 0 To iArrayYSize -1
				Line(icurX, icurY, iBlockSize*iArrayXSize, 1, $ff0000)
				icurY + iBlockSize
			Next iLoopX
			
			icurX = 0
			icurY = 0
			For iLoopY = 0 To iArrayXSize -1
				Line(icurX, icurY, 1, iBlockSize*iArrayYSize, $ff0000)
				icurX + iBlockSize
			Next iLoopY
		EndIf		
		
		
		
		For iLoopY = 0 To iArrayYSize-1
			For iLoopX = 0 To iArrayXSize-1
				icurX = iLoopX*iBlockSize	
				If MyArray(iLoopX, iLoopY) = 1
;					Box(icurX, icurY, iBlockSize,iBlockSize, RGB(Random(255),Random(255),Random(255)))
;					Box(icurX, icurY, iBlockSize,iBlockSize, RGB(0,0,0))
					Circle(icurX+(iBlockSize/2), icurY+(iBlockSize/2), iBlockSize/2, $ffffff)
				EndIf
			Next iLoopX
			icurY + iBlockSize
		Next iLoopY		
		
		
		StopDrawing()	
	EndIf
	
	
EndProcedure



Procedure	CalcNextStep()
	
	Protected.i	iLoopX = 0, iLoopY = 0
	Protected.i	iCellsAlive
	Protected.i	iNumCells = iArrayXSize*iArrayYSize	
	
	; -------------------------------------------------------------------------------------------------------
	; implementation of the GoL Rules
	; -------------------------------
	; Regel 1:
	;   Eine tote Zelle mit genau drei lebenden Nachbarn wird in der Folgegeneration neu geboren.
	; Regel 2:
	;   Lebende Zellen mit weniger als zwei lebenden Nachbarn sterben in der Folgegeneration an Einsamkeit.
	; Regel 3:
	;   Eine lebende Zelle mit zwei oder drei lebenden Nachbarn bleibt in der Folgegeneration am Leben.
	; Regel 4:
	;   Lebende Zellen mit mehr als drei lebenden Nachbarn sterben in der Folgegeneration an Überbevölkerung.
	; -------------------------------------------------------------------------------------------------------
	
	; first clear work array
	
	Dim WorkArray(iArrayXSize, iArrayYSize)
	
	
	
	
	iCellsAlive = 0
	
	; Rules
	For iLoopY = 0 To iArrayYSize-1
		For iLoopX = 0 To iArrayXSize-1
			Select MyArray(iLoopX, iLoopY)
				Case #DEAD
					If CountNeighbors(iLoopX, iLoopY) = 3
						WorkArray(iLoopX, iLoopY) = #ALIVE				; Rule 1
						iCellsAlive + 1
					EndIf
				Case #ALIVE
					Select CountNeighbors(iLoopX, iLoopY)
						Case 0, 1
							WorkArray(iLoopX, iLoopY) = #DEAD			; Rule 2
						Case 2, 3							
							WorkArray(iLoopX, iLoopY) = #ALIVE			; Rule 3
							iCellsAlive + 1
						Case 4, 5, 6, 7, 8		
							WorkArray(iLoopX, iLoopY) = #DEAD			; Rule 4
					EndSelect
			EndSelect
		Next iLoopX
	Next iLoopY
	
	
	CopyArray(WorkArray(), MyArray())
	DrawGeneration()
	
	iGeneration + 1
	SetGadgetText(#GAD_STRING_3, Str(iGeneration))
	SetGadgetText(#GAD_STRING_4, Str(iCellsAlive))	
	SetGadgetText(#GAD_STRING_5, Str(iNumCells-iCellsAlive))	
	
	
EndProcedure




Procedure.i CountNeighbors(iX.i, iY.i)
	
	
	; 00000000000000000000000  Werte ALLER Nachbarzellen(N) der Zelle (Z)
	; 00000000NNN000000000000  aufaddieren.
	; 00000000NZN000000000000  Dabei wird vorausgesetzt, das deren Inhalt
	; 00000000NNN000000000000  nur 0 (=tot) oder 1 (=lebendig) sein darf!
	; 00000000000000000000000  Vom Ergebnis dann noch den Inhalt von  (Z)
	; 00000000000000000000000  abziehen , da Z ja  die Ausgangszelle, und
	; 00000000000000000000000  somit KEIN Nachbar ist!
	
	; modulo trick nutzen um die Ränder gleich mit zu begrenzen.
	
	
	Protected.i	iResult = 0;
	Protected.i	iLoopX, iLoopY
	Protected.i	iRow, iCol
	
	For iLoopY = -1 To 1 Step 1	
		For iLoopX = -1 To 1 Step 1
			iCol = (iX + iLoopX + iArrayXSize) % iArrayXSize
			iRow = (iY + iLoopY + iArrayYSize) % iArrayYSize
			iResult + MyArray(iCol, iRow)
		Next iLoopX
	Next iLoopY	
	
	iResult - MyArray(iX, iY)				; eigene (Ausgangszelle) inhalt noch abziehen!
	ProcedureReturn iResult
	
	
EndProcedure








move.w #$7fff, $dff09a
ILLEGAL
Benutzeravatar
PureUser1966
Beiträge: 29
Registriert: 02.02.2017 21:03
Wohnort: Cologne / Germany

Re: Mein Ansatz zu Conways Game of Life

Beitrag von PureUser1966 »

Habe es noch etwas überarbeitet..

Code: Alles auswählen

; --------------------------
; Conway's GameOfLife
; started:   14.04.2019
; last bits: 19.04.2019
; (c) by duke / radwar
; --------------------------

EnableExplicit										; The magic one


; Program declarations ----------------------------------------------------------------------------
Declare		CreateGameGadgets()
Declare		InitSystem()
Declare		InitGrid()
Declare		DrawGeneration()
Declare.i	CountNeighbors(iX.i, iY.i)
Declare		CalcNextStep()



; Enumerations ------------------------------------------------------------------------------------
Enumeration
	#DEAD			=	0							; Cell is dead (inactive, not visible)
	#ALIVE			=	1							; Cell is alive (active, visible)
	#BLOCKSIZE		=	10
	#TIMERDELAY		=	50
	#TEXTHEIGHT		=	24
	#TEXTHEIGHT2	=	12
EndEnumeration

; Window- Font- and Gadget ID's
Enumeration
	#GAMEWINDOW = 10								; Window ID
	#GAMETIMER										; Timer ID
	#FONT_ID_01										; Font ID for Textoutput
	#FONT_ID_02										; Font ID for Textoutput
	#GAD_CANVAS_01									; GAD  main drawing canvas
	#GAD_POPUPMENU_01								; MENU Popupmenu Main ID
	#GAD_POPUPMENU_01_COL01							; Popupmenu Entry - Color selection 1 						- Bind on key CTRL-F1 
	#GAD_POPUPMENU_01_COL02							; Popupmenu Entry - Color selection 2 						- Bind on key CTRL-F2 
	#GAD_POPUPMENU_01_COL03							; Popupmenu Entry - Color selection 3 						- Bind on key CTRL-F3 
	#GAD_POPUPMENU_01_COL04							; Popupmenu Entry - Color selection 4 						- Bind on key CTRL-F4 
	#GAD_POPUPMENU_01_COL05							; Popupmenu Entry - Color selection 5 						- Bind on key CTRL-F5 
	#GAD_POPUPMENU_01_COL06							; Popupmenu Entry - Color selection 6 	 					- Bind on key CTRL-F6
	#GAD_POPUPMENU_01_CLEAR							; Popupmenu Entry - Clears complete Data from array			- Bind on key CTRL-C
	#GAD_POPUPMENU_01_RESTART						; Popupmenu Entry - Restarts GoL with new Random Data	 	- Bind on key CTRL-R
	#GAD_POPUPMENU_01_AUTOMODE						; Popupmenu Entry - Automode on/off 						- Bind on key CTRL-A
	#GAD_POPUPMENU_01_NEXTSTEP						; Popupmenu Entry - Calculates next Generation 				- Bind on key CTRL-N
	#GAD_POPUPMENU_01_GRID							; Popupmenu Entry - Toggles Grid on/off 					- Bind on key CTRL-G
	#GAD_POPUPMENU_01_TEXT							; Popupmenu Entry - Toggles Text Mode on/off 				- Bind on key CTRL-T
	#GAD_POPUPMENU_01_HELP							; Popupmenu Entry - Toggles Text Mode on/off 				- Bind on key CTRL-T
	#GAD_POPUPMENU_01_WORLDRESET					; Popupmenu Entry - Reset flag for 3000 generation loop		- Bind on key CTRL-W
	#GAD_POPUPMENU_01_MODE							; Popupmenu Entry - GfxMode 0 = circle, 1 = square     		- Bind on key CTRL-M
	#GAD_POPUPMENU_01_PLUS							; Popupmenu Entry - increment timer delay					- Bind on key CTRL-+
	#GAD_POPUPMENU_01_MINUS							; Popupmenu Entry - decrement timer delay					- Bind on key CTRL--
	#GAD_POPUPMENU_01_RANDOMPIXEL					; Popupmenu Entry - create 10 random pixel every frame      - Bind on key CTRL-P
EndEnumeration

; Variables ---------------------------------------------------------------------------------------

Global.l	lBGColor		=	$aaaaaa				; Background color
Global.l	lPenColor		=	$444444				; pen color for Cells
Global.l	lGridColor		=	$000000				; grid color
Global.l	lTextPenColor	=	$00ffff				; text color for info text output

Global.i	iQuit			=	0					; event signal
Global.i	iEvent			=	0					; event number
Global.i	iTimerDelay		=	#TIMERDELAY			; ms
Global.i	iBlockSize		=	#BLOCKSIZE			; block size
Global.i	iArrayXSize		=	0					; array size
Global.i	iArrayYSize		=	0					; array size
Global.i	iGeneration		=	0					; number of cell generation
Global.i	iGridFlag 		=	0					; 1 = grid on / 0 = grid off
Global.i	iMouseXPos		=	0					; current mouse x position inside canvas gadget
Global.i	iMouseYPos		=	0					; current mouse y position inside canvas gadget
Global.i	icurX			=	0					; generated x cellpos in array (calculated from mousepos)
Global.i	icurY			=	0					; generated Y cellpos in array (calculated from mousepos)
Global.i	iCellsAlive		=	0					; number of cells currently alive
Global.i	iResetFlag		=	1					; reset to random world after 3000 generations
Global.i	iTextFlag		=	1					; 1 = text on / 0 = text off
Global.i	iHelpFlag 		=	0					; 1 = help on / 0 = help off
Global.i	iAutoMode		=	1					; 1 = automode on, 0 = automode off
Global.i	iRandomPixel	=	0					; 1 = create 10 random cells every generation / 0 = do not!
Global.i	iGfxMode		=	0					; 0 = circle / 1 = square
Global.l	lCellsBorn		=	0					; number of cells born
Global.l	lCellsDied		=	0					; number of cells died


Global.i	Dim	MyArray(iArrayXSize, iArrayYSize)	; main array
Global.i	Dim	WorkArray(iArrayXSize, iArrayYSize)	; work array for next generation


; Code --------------------------------------------------------------------------------------------

If OpenWindow(#GAMEWINDOW, 500, 200, 1600, 800,"Conway's 'Game of Life' - Code by duke / Radwar - written 15.04.2019", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Maximize)
	
	iArrayXSize = WindowWidth (#GAMEWINDOW, #PB_Window_InnerCoordinate) / iBlockSize
	iArrayYSize = WindowHeight(#GAMEWINDOW, #PB_Window_InnerCoordinate) / iBlockSize
	
	; pre init (clear) both arrays
	Dim MyArray(iArrayXSize, iArrayYSize)	
	Dim WorkArray(iArrayXSize, iArrayYSize)	
	
	CreateGameGadgets()
	InitSystem()
	InitGrid()
	
	Repeat
		iEvent = WaitWindowEvent()
		Select iEvent
			Case #PB_Event_Timer
				Select EventTimer()
					Case #GAMETIMER
						CalcNextStep()
						
						If iGeneration = 3000 And iResetFlag = 1
							InitGrid()	
						EndIf
						
						
				EndSelect
				
			Case #PB_Event_Menu
				Select EventMenu()
					Case #GAD_POPUPMENU_01_COL01		
						lBGColor		=	$000000
						lPenColor		=	$ffffff
						lGridColor		=	$ff0000						
						lTextPenColor	=	$0000ff	
					Case #GAD_POPUPMENU_01_COL02
						lBGColor		=	$ffffff
						lPenColor		=	$000000
						lGridColor		=	$ff0000						
						lTextPenColor	=	$0000ff	
					Case #GAD_POPUPMENU_01_COL03		
						lBGColor		=	$00ffff
						lPenColor		=	$ff0000
						lGridColor		=	$000000
						lTextPenColor	=	$000000
					Case #GAD_POPUPMENU_01_COL04		
						lBGColor		=	$ff0000
						lPenColor		=	$00ffff
						lGridColor		=	$000000
						lTextPenColor	=	$0000ff
					Case #GAD_POPUPMENU_01_COL05
						lBGColor		=	$444444
						lPenColor		=	$cccccc
						lGridColor		=	$000000
						lTextPenColor	=	$0000ff
					Case #GAD_POPUPMENU_01_COL06		
						lBGColor		=	$cccccc
						lPenColor		=	$444444
						lGridColor		=	$000000
						lTextPenColor	=	$0000ff
					Case #GAD_POPUPMENU_01_CLEAR
						Dim MyArray(iArrayXSize, iArrayYSize)
						Dim WorkArray(iArrayXSize, iArrayYSize)
						lCellsBorn	=	0
						lCellsDied	=	0
						iGeneration	=	0
						
					Case #GAD_POPUPMENU_01_RESTART
						InitGrid()
					Case #GAD_POPUPMENU_01_AUTOMODE
						If iAutoMode = 1
							iAutoMode = 0
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
							SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_AUTOMODE, 0)
						    DisableMenuItem(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_NEXTSTEP, 0)
						Else
							iAutoMode = 1
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
						    AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
						    SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_AUTOMODE, 1)
						    DisableMenuItem(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_NEXTSTEP, 1)
						EndIf
					Case #GAD_POPUPMENU_01_NEXTSTEP		
						If iAutoMode = 0
							CalcNextStep()
						EndIf
					Case #GAD_POPUPMENU_01_GRID
						Select iGridFlag
							Case 0
								iGridFlag = 1
							    SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_GRID, 1)
							Case 1
								iGridFlag = 0
							    SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_GRID, 0)								
						EndSelect
					Case #GAD_POPUPMENU_01_WORLDRESET
						Select iResetFlag
							Case 0
								iResetFlag = 1
							    SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_WORLDRESET, 1)
							Case 1
								iResetFlag = 0
							    SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_WORLDRESET, 0)								
						EndSelect
						
					Case #GAD_POPUPMENU_01_TEXT
						Select iTextFlag
							Case 0
								iTextFlag = 1
							Case 1
								iTextFlag = 0
						EndSelect
						
					Case #GAD_POPUPMENU_01_HELP
						Select iHelpFlag
							Case 0
								iHelpFlag = 1
							Case 1
								iHelpFlag = 0
								
						EndSelect
					Case #GAD_POPUPMENU_01_MODE
						Select iGfxMode
							Case 0
								iGfxMode = 1
							Case 1
								iGfxMode = 0
						EndSelect
					Case #GAD_POPUPMENU_01_PLUS
						If iTimerDelay < 200
							iTimerDelay + 10
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
							AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
						EndIf
					Case #GAD_POPUPMENU_01_MINUS
						If iTimerDelay > 15
							iTimerDelay - 10
							RemoveWindowTimer(#GAMEWINDOW, #GAMETIMER)	
							AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
						EndIf
					Case #GAD_POPUPMENU_01_RANDOMPIXEL
						Select iRandomPixel
							Case 0
								iRandomPixel = 1
								SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_RANDOMPIXEL, 1)
							Case 1
								iRandomPixel = 0
								SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_RANDOMPIXEL, 0)
						EndSelect
				EndSelect
				
				
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #GAD_CANVAS_01
						Select EventType()
					        Case #PB_EventType_RightClick       ; rechte Maustaste wurde gedrückt =>
					        	DisplayPopupMenu(#GAD_POPUPMENU_01, WindowID(#GAMEWINDOW))
							Case #PB_EventType_MouseMove
								iMouseXPos = GetGadgetAttribute(#GAD_CANVAS_01, #PB_Canvas_MouseX) / iBlockSize
								iMouseYPos = GetGadgetAttribute(#GAD_CANVAS_01, #PB_Canvas_MouseY) / iBlockSize
							Case #PB_EventType_LeftButtonDown
								; activate CELL under Mousecursor
								MyArray(iMouseXPos, iMouseYPos) = #ALIVE
								icurX = iMouseXPos*iBlockSize	
								icurY = iMouseYPos*iBlockSize
								lCellsBorn + 1
								If StartDrawing(CanvasOutput(#GAD_CANVAS_01))
									If iGfxMode = 0
										Circle(icurX+(iBlockSize/2), icurY+(iBlockSize/2), iBlockSize/2, lPenColor)
									Else
										Box(icurX, icurY, iBlockSize, iBlockSize, lPenColor)
									EndIf
									StopDrawing()							
								EndIf
								
								
								
						EndSelect
						
				EndSelect
		EndSelect
		
		
		
		If iEvent = #PB_Event_CloseWindow  ; If the user has pressed on the close button
			iQuit = 1
		EndIf
	
	Until iQuit = 1


EndIf



Procedure	CreateGameGadgets()
	Protected.i		iXpos=0, iYpos=0, iWidth=0, iHeight=0, iFlags=0
	Protected.s		sMsg	=	""
	Protected.i		iGadget	=	0
	
	
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_R, #GAD_POPUPMENU_01_RESTART)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_C, #GAD_POPUPMENU_01_CLEAR)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_A, #GAD_POPUPMENU_01_AUTOMODE)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_N, #GAD_POPUPMENU_01_NEXTSTEP)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_G, #GAD_POPUPMENU_01_GRID)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_W, #GAD_POPUPMENU_01_WORLDRESET)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_T, #GAD_POPUPMENU_01_TEXT)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_H, #GAD_POPUPMENU_01_HELP)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_M, #GAD_POPUPMENU_01_MODE)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_X, #GAD_POPUPMENU_01_PLUS)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_Y, #GAD_POPUPMENU_01_MINUS)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_P, #GAD_POPUPMENU_01_RANDOMPIXEL)
	
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_F1, #GAD_POPUPMENU_01_COL01)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_F2, #GAD_POPUPMENU_01_COL02)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_F3, #GAD_POPUPMENU_01_COL03)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_F4, #GAD_POPUPMENU_01_COL04)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_F5, #GAD_POPUPMENU_01_COL05)
	AddKeyboardShortcut(#GAMEWINDOW, #PB_Shortcut_Control | #PB_Shortcut_F6, #GAD_POPUPMENU_01_COL06)
	
	If CreatePopupMenu(#GAD_POPUPMENU_01)
		MenuItem(#GAD_POPUPMENU_01_CLEAR,		"Clear world" + Chr(9) + "<CTRL-C>")
		MenuItem(#GAD_POPUPMENU_01_RESTART, 	"Restart random world" + Chr(9) + "<CTRL-R>")
		MenuBar()
		MenuItem(#GAD_POPUPMENU_01_AUTOMODE, 	"Toggle Automode" + Chr(9) + "<CTRL-A>")
			SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_AUTOMODE, 1)
		MenuItem(#GAD_POPUPMENU_01_NEXTSTEP, 	"Step" + Chr(9) + "<CTRL-N>")
		    DisableMenuItem(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_NEXTSTEP, 1)
		MenuBar()
		MenuItem(#GAD_POPUPMENU_01_GRID, 		"Toggle Grid" + Chr(9) + "<CTRL-G>")
		MenuItem(#GAD_POPUPMENU_01_TEXT, 		"Toggle Textmode" + Chr(9) + "<CTRL-T>")
		MenuItem(#GAD_POPUPMENU_01_WORLDRESET,	"Reset World after 3000 generations" + Chr(9) + "<CTRL-W>")
			SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_WORLDRESET, 1)
		MenuItem(#GAD_POPUPMENU_01_MODE,		"Change gfxmode" + Chr(9) + "<CTRL-M>")
		MenuItem(#GAD_POPUPMENU_01_RANDOMPIXEL,	"Create 10 random cells every generation" + Chr(9) + "<CTRL-P>")
			SetMenuItemState(#GAD_POPUPMENU_01, #GAD_POPUPMENU_01_RANDOMPIXEL, iRandomPixel)
		MenuBar()
		MenuItem(#GAD_POPUPMENU_01_PLUS,		"Increment Timervalue" + Chr(9) + "<CTRL-X>")
		
		OpenSubMenu("Colors")
			MenuItem(#GAD_POPUPMENU_01_COL01, "Black / White" + Chr(9) + "<CTRL-F1>")
			MenuItem(#GAD_POPUPMENU_01_COL02, "White / Black" + Chr(9) + "<CTRL-F2>")
			MenuBar()
			MenuItem(#GAD_POPUPMENU_01_COL03, "Yellow / Blue" + Chr(9) + "<CTRL-F3>")
			MenuItem(#GAD_POPUPMENU_01_COL04, "Blue / Yellow" + Chr(9) + "<CTRL-F4>")
			MenuBar()
			MenuItem(#GAD_POPUPMENU_01_COL05, "Dark gray / Light gray" + Chr(9) + "<CTRL-F5>")
			MenuItem(#GAD_POPUPMENU_01_COL06, "Light gray / Dark gray" + Chr(9) + "<CTRL-F6>")
		CloseSubMenu()
    EndIf
	
	
	
	iWidth		=	(iArrayXSize * iBlockSize)
	iHeight		=	(iArrayYSize * iBlockSize)
	
	iWidth		=	WindowWidth(#GAMEWINDOW, #PB_Window_InnerCoordinate)
	iHeight		=	WindowHeight(#GAMEWINDOW, #PB_Window_InnerCoordinate) 
	
	
	iXpos		=	0
	iypos		=	0
	iflags		=	0
	CanvasGadget(#GAD_CANVAS_01, iXpos, iYpos, iWidth, iHeight, iFlags)
	SetGadgetAttribute(#GAD_CANVAS_01, #PB_Canvas_Cursor, #PB_Cursor_Cross)
	
EndProcedure


Procedure	InitSystem()
	
	If LoadFont(#FONT_ID_01,"FixedSys", #TEXTHEIGHT)
	EndIf
	If LoadFont(#FONT_ID_02,"FixedSys", #TEXTHEIGHT2)
	EndIf
	
	
	
	AddWindowTimer(#GAMEWINDOW, #GAMETIMER, iTimerDelay)
	
EndProcedure



Procedure	InitGrid()
	
	Protected.i	iLoopX=0, iLoopY=0
	Protected.i	iValue=0
	
 	; randomly fill array with values (0/1)	
 	For iLoopY = 0 To iArrayYSize-1
 		For iLoopX = 0 To iArrayXSize-1
 			ivalue = Random(1,0)
 			lCellsBorn = iValue
 			MyArray(iLoopX, iLoopY) = iValue
 		Next iLoopX
 	Next iLoopY	
	
	
	
	; reset generation value (for output reason only...)	
 	iGeneration =	0
 	lCellsBorn	=	0
 	lCellsDied	=	0
 	iTimerDelay =	#TIMERDELAY
	; draw the first generation to screen
	DrawGeneration()	
	
EndProcedure



Procedure DrawGeneration()
	
	Protected.i	icurX=0, icurY=0
	Protected.i	iLoopX=0, iLoopY=0	
	Protected.i	iTextYPos	=	10
	Protected.s	sHelpMsg	=	""
	
	
	If StartDrawing(CanvasOutput(#GAD_CANVAS_01))
		; clear canvas gadget with color
		Box(0,0,iBlockSize*iArrayXSize+1, iBlockSize*iArrayYSize+1, lBGColor)
		
		
		DrawingMode(#PB_2DDrawing_Default)
		; eventually draw the gridlines
		If iBlockSize >= 4 And iGridFlag = 1
			icurX = 0
			icurY = 0
			; draw the gridlines
			For iLoopX = 0 To iArrayYSize -1
				Line(icurX, icurY, iBlockSize*iArrayXSize, 1, lGridColor)
				icurY + iBlockSize
			Next iLoopX
			
			icurX = 0
			icurY = 0
			For iLoopY = 0 To iArrayXSize -1
				Line(icurX, icurY, 1, iBlockSize*iArrayYSize, lGridColor)
				icurX + iBlockSize
			Next iLoopY
		EndIf		
		
		
		; draw living cells only		
		For iLoopY = 0 To iArrayYSize-1
			For iLoopX = 0 To iArrayXSize-1
				icurX = iLoopX*iBlockSize	
				If MyArray(iLoopX, iLoopY) = 1
					If iGfxMode = 0
						Circle(icurX+(iBlockSize/2), icurY+(iBlockSize/2), iBlockSize/2, lPenColor)
					Else
						Box(icurX, icurY, iBlockSize, iBlockSize, lPenColor)
					EndIf
				EndIf
			Next iLoopX
			icurY + iBlockSize
		Next iLoopY		
		
		If iTextFlag = 1
			; draw some text
			DrawingMode(#PB_2DDrawing_Transparent)
			DrawingFont(FontID(#FONT_ID_01))
			DrawText(10, iTextYPos + (0*(#TEXTHEIGHT+1)), "H Cells:      " + RSet(Str(iArrayXSize),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (1*(#TEXTHEIGHT+1)), "V Cells:      " + RSet(Str(iArrayYSize),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (2*(#TEXTHEIGHT+1)), "Cells:        " + RSet(Str(iArrayXSize*iArrayYSize),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (3*(#TEXTHEIGHT+1)), "Cells alive:  " + RSet(Str(iCellsAlive),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (4*(#TEXTHEIGHT+1)), "Cells dead:   " + RSet(Str((iArrayXSize*iArrayYSize)-iCellsAlive),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (5*(#TEXTHEIGHT+1)), "Cells born:   " + RSet(Str(lCellsBorn),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (6*(#TEXTHEIGHT+1)), "Cells died:   " + RSet(Str(lCellsDied),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (7*(#TEXTHEIGHT+1)), "Generation:   " + RSet(Str(iGeneration),8," "), lTextPenColor, lBGColor)
			DrawText(10, iTextYPos + (8*(#TEXTHEIGHT+1)), "Timer:        " + RSet(Str(iTimerDelay),8," "), lTextPenColor, lBGColor)
			If iRandomPixel = 1
				DrawText(10, iTextYPos + (9*(#TEXTHEIGHT+1)), "Random cells: " + RSet("ON",8," "), lTextPenColor, lBGColor)
			Else
				DrawText(10, iTextYPos + (9*(#TEXTHEIGHT+1)), "Random cells: " + RSet("OFF",8," "), lTextPenColor, lBGColor)
			EndIf
			If iResetFlag = 1
				DrawText(10, iTextYPos + (10*(#TEXTHEIGHT+1)), "Auto restart: " + RSet("ON",8," "), lTextPenColor, lBGColor)
			Else
				DrawText(10, iTextYPos + (10*(#TEXTHEIGHT+1)), "Auto restart: " + RSet("OFF",8," "), lTextPenColor, lBGColor)
			EndIf
			
		EndIf		

		DrawingMode(#PB_2DDrawing_Transparent)
		DrawingFont(FontID(#FONT_ID_02))
		If iHelpFlag = 1		
			sHelpMsg = "Clear world.....................<CTRL-C>"
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			icurY = 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Restart random world............<CTRL-R>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Toggle autogeneration...........<CTRL-A>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Next step.......................<CTRL-N>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Toggle grid.....................<CTRL-G>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Toggle textinfo.................<CTRL-T>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Reset after 3000 gen............<CTRL-W>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Change cell gfx.................<CTRL-M>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Toggle random cell generation...<CTRL-P>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Increment timer value...........<CTRL-X>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Decrement timer value...........<CTRL-Y>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Color swap...........<CTRL-F1>-<CTRL-F6>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Activate cell under mouse..........<LMB>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "Toggle help.....................<CTRL-H>"
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			
			
			icurY + (2*#TEXTHEIGHT2+1)
			sHelpMsg = "Conway's Rules: (https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life)                         "
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + (2*#TEXTHEIGHT2+1)
			sHelpMsg = "1.) Any live cell With fewer than two live neighbours dies, As If by underpopulation.           "
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "2.) Any live cell with two or three live neighbours lives on to the next generation.            "
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "3.) Any live cell with more than three live neighbours dies, as if by overpopulation.           "
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			icurY + #TEXTHEIGHT2+1
			sHelpMsg = "4.) Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction."
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
			
			
			
			
		Else	
			sHelpMsg = "Show key commands...............<CTRL-H>"
			icurX = (iArrayXSize*iBlockSize) - TextWidth(sHelpMsg) - 10
			icurY = 10
			DrawText(icurX, icurY, sHelpMsg, lTextPenColor, lBGColor)
		EndIf		
		
		
		
		StopDrawing()	
	EndIf
	
	
EndProcedure



Procedure	CalcNextStep()
	
	Protected.i	iLoopX = 0, iLoopY = 0
	Protected.i	iNumCells = iArrayXSize*iArrayYSize	
	Protected.i	iValueX = 0
	Protected.i	iValueY = 0
	
	
	; -------------------------------------------------------------------------------------------------------
	; implementation of the GoL Rules
	; -------------------------------
	; Regel 1:
	;   Eine tote Zelle mit genau drei lebenden Nachbarn wird in der Folgegeneration neu geboren.
	; Regel 2:
	;   Lebende Zellen mit weniger als zwei lebenden Nachbarn sterben in der Folgegeneration an Einsamkeit.
	; Regel 3:
	;   Eine lebende Zelle mit zwei oder drei lebenden Nachbarn bleibt in der Folgegeneration am Leben.
	; Regel 4:
	;   Lebende Zellen mit mehr als drei lebenden Nachbarn sterben in der Folgegeneration an Überbevölkerung.
	; -------------------------------------------------------------------------------------------------------
	
	; first clear work array
	
	Dim WorkArray(iArrayXSize, iArrayYSize)
	
	iCellsAlive = 0
	
	; Rules
	For iLoopY = 0 To iArrayYSize-1
		For iLoopX = 0 To iArrayXSize-1
			Select MyArray(iLoopX, iLoopY)
				Case #DEAD
					If CountNeighbors(iLoopX, iLoopY) = 3
						WorkArray(iLoopX, iLoopY) = #ALIVE				; Rule 1
						iCellsAlive + 1
						lCellsBorn	+1
					EndIf
				Case #ALIVE
					Select CountNeighbors(iLoopX, iLoopY)
						Case 0, 1
							WorkArray(iLoopX, iLoopY) = #DEAD			; Rule 2
							lCellsDied + 1
						Case 2, 3							
							WorkArray(iLoopX, iLoopY) = #ALIVE			; Rule 3
							iCellsAlive + 1
						Case 4, 5, 6, 7, 8		
							WorkArray(iLoopX, iLoopY) = #DEAD			; Rule 4
							lCellsDied + 1
					EndSelect
			EndSelect
		Next iLoopX
	Next iLoopY
	
	
	
	
	; random cell generation
	If iRandomPixel = 1
		For iLoopX = 0 To 9
			iValueX = Random(iArrayXSize-1, 0)
			iValueY = Random(iArrayYSize-1, 0)
			WorkArray(iValueX, iValueY) = 1
		Next iLoopX
		lCellsBorn + 10	
	EndIf
	
	
	
	
	
	CopyArray(WorkArray(), MyArray())
	DrawGeneration()
	
	iGeneration + 1
	
	
EndProcedure




Procedure.i CountNeighbors(iX.i, iY.i)
	
	Protected.i		iResult = 0;
	Protected.i		iLoopX, iLoopY
	Protected.i		iRow, iCol
	
	; -------------------------------------------------------------------
	; 00000000000000000000000  Werte ALLER Nachbarzellen(N) der Zelle (Z)
	; 00000000NNN000000000000  aufaddieren.
	; 00000000NZN000000000000  Dabei wird vorausgesetzt, das deren Inhalt
	; 00000000NNN000000000000  nur 0 (=tot) oder 1 (=lebendig) sein darf!
	; 00000000000000000000000  Vom Ergebnis dann noch den Inhalt von  (Z)
	; 00000000000000000000000  abziehen , da Z ja  die Ausgangszelle, und
	; 00000000000000000000000  somit KEIN Nachbar ist!
	
	; -------------------------------------------------------------------
	; modulo trick nutzen um die Ränder gleich mit zu begrenzen.
	; Beispiel hierfür:
	; -------------------------------------------------------------------
	; Bspl 1:
	; iX 			=	4
	; iLoopX		=	8
	; iArrayXSize	=	80
	; Formel (innerhalb der loop):
	; iRow 			=	(4 + 8 + 80)	% 80
	; iRow 			=	(92)			% 80
	; iRow 			=	12
	; -------------------------------------------------
	; Bspl 2:
	; iX 			=	0  (Linker Rand)
	; iLoopX		=	-1	Linker 'Nachbar'
	; iArrayXSize	=	80
	; Formel (innerhalb der loop):
	; iRow 			=	(0 + (-1) + 80)	% 80
	; iRow 			=	(79)			% 80
	; iRow 			=	79	Ergebnis also rechter Rand. Somit läuft was
	;						links rausgeht, rechts wieder rein (und umgekehrt).
	;						Das gilt exakt auch so für oben und unten...
	; --------------------------------------------------------------------------
	
	
	
	For iLoopY = -1 To 1 Step 1	
		For iLoopX = -1 To 1 Step 1
			iRow = (iX + iLoopX + iArrayXSize) % iArrayXSize
			iCol = (iY + iLoopY + iArrayYSize) % iArrayYSize
			iResult + MyArray(iRow, iCol)
		Next iLoopX
	Next iLoopY	
	
	iResult - MyArray(iX, iY)				; Eigenen (Ausgangszellen-) inhalt noch abziehen!
	ProcedureReturn iResult
	
	
EndProcedure




move.w #$7fff, $dff09a
ILLEGAL
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Mein Ansatz zu Conways Game of Life

Beitrag von berie »

Ich habe vor ca. 2 Jahren mal was zusammengebaut, ihr könnt mein "Conway's Game Of Life" von meinem OneDrive herunterladen. Da es ein ganzes Projekt ist, habe ich es gezippt.
https://1drv.ms/u/s!AsQlV3TauzA6bydoKy7iRLMXYVk

Die Conway-Patterns gibt es hier: http://www.conwaylife.com/wiki/Main_Page
Runterscrollen bis zu "Download Pattern collection".

Es ist nicht dokumentiert und nur schwach kommentiert, allerdings haben einige Gadgets ToolTips.
formerly known as bizzl
Benutzeravatar
PureUser1966
Beiträge: 29
Registriert: 02.02.2017 21:03
Wohnort: Cologne / Germany

Re: Mein Ansatz zu Conways Game of Life

Beitrag von PureUser1966 »

Sehr gut, interessant was du da gebaut hast.
Vor allem mit dem RLE Import. Werd ich bei mir auch einbauen.

Wie findest du mein Programm ?
move.w #$7fff, $dff09a
ILLEGAL
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Mein Ansatz zu Conways Game of Life

Beitrag von berie »

Hallo PowerUser1966,

ist das 1966 dein Geburtsjahr? Dann bin ich 2 Jahre älter als du.

Dein Programm ist mir irgendwie zu hektisch und unübersichtlich - bei mir kann man die Geschwindigkeit einstellen und es sieht "aufgeräumter" aus.

Was mir an deinem Programm sehr gut gefällt, ist deine Darstellung der lebenden Zellen und dass die Simulation ohne irgendwelches Schicki-Micki drumrum läuft.
Bei mir hast du ja die vielen Gadgets auf der rechten Seite.

Vielleicht integriere ich zusätzlich einen Fullscreen- oder wenigstens einen Fullwindow-Modus, so dass man die Simulation ohne störendes Beiwerk (also ohne Gadgets und Statusanzeigen) laufen lassen kann.

Vielen Dank für Dein Feedback und frohe, friedliche und ruhige Ostertage wünsche ich Dir und allen Usern hier im Forum.
formerly known as bizzl
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Mein Ansatz zu Conways Game of Life

Beitrag von STARGÅTE »

Mir gefallen beide Codes recht gut, jeder hat seine vor und nachteile. :allright:

Wie ich sehe nutzt ihr beide eine periodische Randbedingung (was rechts rausläuft kommt links wieder rein).
Ist diese Art der Welt üblich, oder wäre auch eine unendliche Welt denkbar?
Klar bei einer unendliche Welt kann man nicht mehr ein einfaches 2D-Array nutzen, da das zu groß wird und zu viele Felder abgefragt werden müssen, dort musste man dann anfangen Cluster oder Chunks zu verwalten.

Ansonsten wäre es noch gut, wenn man bestimmte Muster direkt auswählen und in die Welt setzen kann:
z.B. eine Gleiterkanone, usw.

berie bietet ja schon diesen RLE Import, aber n Vorschau oder so wäre schon cooler.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Mein Ansatz zu Conways Game of Life

Beitrag von berie »

Mir gefallen beide Codes recht gut, jeder hat seine vor und nachteile. :allright:

Wie ich sehe nutzt ihr beide eine periodische Randbedingung (was rechts rausläuft kommt links wieder rein).
Ist diese Art der Welt üblich, oder wäre auch eine unendliche Welt denkbar?
Klar bei einer unendliche Welt kann man nicht mehr ein einfaches 2D-Array nutzen, da das zu groß wird und zu viele Felder abgefragt werden müssen, dort musste man dann anfangen Cluster oder Chunks zu verwalten.

Ansonsten wäre es noch gut, wenn man bestimmte Muster direkt auswählen und in die Welt setzen kann:
z.B. eine Gleiterkanone, usw.

berie bietet ja schon diesen RLE Import, aber n Vorschau oder so wäre schon cooler.
Die Idee mit der Vorschau gefällt mir gut, bin am überlegen, wie ich das umsetze.
formerly known as bizzl
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: Mein Ansatz zu Conways Game of Life

Beitrag von NicTheQuick »

Es gibt hier noch einen schönen Algorithmus um das Game wesentlich schneller zu machen: http://www.drdobbs.com/jvm/an-algorithm ... 478?pgno=1
Dazu noch ein Video: https://www.youtube.com/watch?v=l228ARRYkNE

Also wer Bock hat, baut es doch mal ein. :wink:
Bild
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Mein Ansatz zu Conways Game of Life

Beitrag von berie »

Danke für den Tipp, NicTheQuick.

Ich werde mich da mal einlesen - obwohl ich mit Rekursionen eigentlich ziemlich auf Kriegsfuss stehe.

Bin immer noch am überlegen, wie ich die Idee mit der Vorschau umsetze.

Melde mich wieder, wenn es was Neues gibt - wird aber dauern, da ich beruflich zur Zeit sehr eingespannt bin, außerdem muss ich mich wieder in meinen Quelltext einarbeiten, das Projekt schläft seit ungefär 2 Jahren.

Trotzdem vielen Dank für eure Anregungen.
formerly known as bizzl
Antworten