Aktuelle Zeit: 17.06.2019 21:14

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 9 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 15.04.2019 22:20 
Offline
Benutzeravatar

Registriert: 02.02.2017 21:03
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:
; --------------------------
; 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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 19.04.2019 18:49 
Offline
Benutzeravatar

Registriert: 02.02.2017 21:03
Habe es noch etwas überarbeitet..

Code:
; --------------------------
; 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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 19.04.2019 22:19 
Offline

Registriert: 17.01.2018 08:52
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 20.04.2019 23:04 
Offline
Benutzeravatar

Registriert: 02.02.2017 21:03
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 21.04.2019 02:13 
Offline

Registriert: 17.01.2018 08:52
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 21.04.2019 09:53 
Online
Kommando SG1
Benutzeravatar

Registriert: 01.11.2005 13:34
Wohnort: Glienicke
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.

_________________
Bild
 
BildBildBild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 23.04.2019 18:50 
Offline

Registriert: 17.01.2018 08:52
Zitat:
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 25.04.2019 10:07 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
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:

_________________
Freakscorner.de - Der Bastelkeller | Neustes Video: Neje DK - 1 Watt Laser Engraver
Ubuntu Gnome 18.04.1 LTS x64, PureBasic 5.60 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mein Ansatz zu Conways Game of Life
BeitragVerfasst: 25.04.2019 18:56 
Offline

Registriert: 17.01.2018 08:52
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


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 9 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye