Mein Ansatz zu Conways Game of Life
Verfasst: 15.04.2019 22:20
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..
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