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