Game of life

[Unseen Machine]

Made with AI assistance as always...R resets the game, space starts and pauses it....mouse to set the blocks

Code: (Select All)

' Neuro-Life: Glitch-Free Architect (2026)

' Fixes flickering by forcing hardware-software buffer synchronization.



$RESIZE:ON

SCREEN _NEWIMAGE(800, 600, 32)

_TITLE "Neuro-Life Pro: Glitch-Free 2026"



_AUTODISPLAY ' Force initial sync

CONST CELL_SIZE = 10

CONST GRID_W = 80

CONST GRID_H = 60



DIM SHARED grid(GRID_W, GRID_H) AS INTEGER

DIM SHARED nextG(GRID_W, GRID_H) AS INTEGER

DIM SHARED age(GRID_W, GRID_H) AS SINGLE

DIM SHARED ghost(GRID_W, GRID_H) AS SINGLE



DIM SHARED isRunning, gen AS LONG: isRunning = 0



' --- MAIN LOOP ---

DO

  _LIMIT 60 ' Frame-rate lock to prevent CPU/GPU racing

  CLS



  ' Handle input FIRST

  HandleInput



  ' Only evolve if not paused

  IF isRunning THEN UpdateLife



  ' Draw everything to the hidden buffer

  DrawWorld



  ' Flip the buffer to the screen all at once

  _DISPLAY

LOOP UNTIL _KEYDOWN(27)



SUB HandleInput

  ' Process all waiting mouse events at once to prevent input lag glitches

  WHILE _MOUSEINPUT: WEND



  k& = _KEYHIT

  SELECT CASE k&

    CASE 32: isRunning = NOT isRunning

    CASE 114, 82:

      isRunning = 0: gen = 0

      FOR x = 0 TO GRID_W: FOR y = 0 TO GRID_H

          grid(x, y) = 0: age(x, y) = 0: ghost(x, y) = 0: nextG(x, y) = 0

      NEXT: NEXT

  END SELECT



  mx = _MOUSEX \ CELL_SIZE: my = _MOUSEY \ CELL_SIZE

  IF mx >= 0 AND mx < GRID_W AND my >= 0 AND my < GRID_H THEN

    IF _MOUSEBUTTON(1) THEN grid(mx, my) = 1: ghost(mx, my) = 0: age(mx, my) = 0

    IF _MOUSEBUTTON(2) THEN grid(mx, my) = 0: ghost(mx, my) = 0

  END IF

END SUB



SUB UpdateLife

  gen = gen + 1

  FOR x = 0 TO GRID_W - 1: FOR y = 0 TO GRID_H - 1

      n = 0

      FOR nx = -1 TO 1: FOR ny = -1 TO 1

          IF nx = 0 AND ny = 0 THEN _CONTINUE

          tx = (x + nx + GRID_W) MOD GRID_W

          ty = (y + ny + GRID_H) MOD GRID_H

          IF grid(tx, ty) = 1 THEN n = n + 1

      NEXT: NEXT



      IF grid(x, y) = 1 THEN

        IF n = 2 OR n = 3 THEN

          nextG(x, y) = 1: age(x, y) = age(x, y) + 0.1

        ELSE

          nextG(x, y) = 0: ghost(x, y) = 1.0

        END IF

      ELSE

        IF n = 3 THEN nextG(x, y) = 1: age(x, y) = 0 ELSE nextG(x, y) = 0

      END IF

  NEXT: NEXT



  ' Quick memory-safe buffer swap

  FOR x = 0 TO GRID_W: FOR y = 0 TO GRID_H

      grid(x, y) = nextG(x, y)

      IF ghost(x, y) > 0 THEN ghost(x, y) = ghost(x, y) - 0.04

  NEXT: NEXT

END SUB



SUB DrawWorld

  ' Permanent Grid Lines

  FOR x = 0 TO GRID_W: LINE (x * CELL_SIZE, 0)-(x * CELL_SIZE, 600), _RGB32(45, 45, 45): NEXT

  FOR y = 0 TO GRID_H: LINE (0, y * CELL_SIZE)-(800, y * CELL_SIZE), _RGB32(45, 45, 45): NEXT



  FOR x = 0 TO GRID_W - 1: FOR y = 0 TO GRID_H - 1

      cx = x * CELL_SIZE: cy = y * CELL_SIZE



      ' Draw Ghosts

      IF ghost(x, y) > 0 AND isRunning THEN

        LINE (cx + 1, cy + 1)-STEP(CELL_SIZE - 2, CELL_SIZE - 2), _RGBA32(100, 0, 200, ghost(x, y) * 100), BF

      END IF



      ' Draw Cells

      IF grid(x, y) = 1 THEN

        IF NOT isRunning THEN

          ' Architect Mode - No fading, solid neon

          LINE (cx + 1, cy + 1)-STEP(CELL_SIZE - 2, CELL_SIZE - 2), _RGB32(0, 255, 255), BF

        ELSE

          ' Evolution colors

          r = age(x, y) * 20: IF r > 255 THEN r = 255

          g = 255 - (age(x, y) * 10): IF g < 100 THEN g = 100

          b = 200 + (age(x, y) * 15): IF b > 255 THEN b = 255

          LINE (cx + 1, cy + 1)-STEP(CELL_SIZE - 2, CELL_SIZE - 2), _RGB32(r, g, b), BF

        END IF

      END IF

  NEXT: NEXT



  ' HUD

  LINE (0, 0)-(800, 25), _RGBA32(0, 0, 0, 220), BF

  IF NOT isRunning THEN

    COLOR _RGB32(255, 255, 0): msg$ = "[ ARCHITECT MODE ] - Space to Play"

  ELSE

    COLOR _RGB32(0, 255, 0): msg$ = "[ SIMULATION RUNNING ] - Gen:" + STR$(gen)

  END IF

  _PRINTSTRING (400 - (LEN(msg$) * 4), 5), msg$

END SUB

Unseen

[bplus]

Dont know what the ghost business is about but interesting to see how it worked around the array edges AND avoid handling negs with MOD with standard torus trick, using Mods, instead of infinite plane AND adding gridw/h to keep MODs positive. Coloring with age might be interesting if the code were slowed to human comprehension level enough to appreciate.

First fix slow down the sim, 2nd allow a mistake when clicking in live cells at start, click cell on click, again and it's off.

AI +1, if it weren't simply copy/pasted from someone else code.

[ahenry3068]

Working on my Own version at the moment (WITHOUT AI !!).

I did a Very slow version in Commodore BASIC on the X16.

Lets see what I can come up with in QB64PE.

[bplus]

Working on my Own version at the moment (WITHOUT AI !!).

I did a Very slow version in Commodore BASIC on the X16.

Lets see what I can come up with in QB64PE.

How do you intend on handling the array boundries when doing the neighbor counts?

just curious, it effects design of the space or environment of growth: finite plane, infinite plane (theorectically), torus are most common choices I know.

BTW torus is when new life all the way up top starts again from bottom and all the way right starts again from left and vice versi (using MOD as this AI version does).

[ahenry3068]

Working on my Own version at the moment (WITHOUT AI !!).

I did a Very slow version in Commodore BASIC on the X16.

Lets see what I can come up with in QB64PE.

How do you intend on handling the array boundries when doing the neighbor counts?

just curious, it effects design of the space or environment of growth: finite plane, infinite plane (theorectically), torus are most common choices I know.

    I'm not much of theorist.    My grid is going to wrap around.   So I guess you might call that Torus ???

[bplus]

Yeah I am not much of theorist myself but BIG fan of Conway's Game of Life since '90's on a 486 DOS machine, possibly in GW Basic, QB4.5 for sure. That's when/where I learned about torus geometry or is it topology to handle the array edges.

[ahenry3068]

Yeah I am not much of theorist myself but BIG fan of Conway's Game of Life since '90's on a 486 DOS machine, possibly in GW Basic, QB4.5 for sure. That's when/where I learned about torus geometry or is it topology to handle the array edges.

   My X16 Version (In Commodore BASIC 2.0  ) is HERE: https://cx16forum.com/forum/viewtopic.ph...326#p28326

[ahenry3068]

Ok.   This is SECOND ITERATION !    Not sure I got the rules or algorithm right.

OK FIXED NOW !!!!

(Might be the Random number generator !!! ??? )

Code: (Select All)

Option _Explicit



Type GRIDTYPE

    WID As Long

    HEI As Long

    CellWidth As Long

    CellHeight As Long

    NumCells As Long

End Type



Type CellType

    IsAlive As Integer

    Row As Long

    Col As Long

    Parent As GRIDTYPE

End Type



Dim Shared MyScreen As Long



Dim Shared MYGRID As GRIDTYPE

Dim Shared NumberOfCells As Long

ReDim Shared TheCells1(0 To 1) As CellType

ReDim Shared TheCells2(0 To 1) As CellType



MYGRID.WID = 94

MYGRID.HEI = 68

MYGRID.CellWidth = 10

MYGRID.CellHeight = 10



_Title "Conways GAME OF LIFE "

InitGrid



Do

    UpdateGeneration TheCells1(), TheCells2()

    DRAWGRID TheCells2()

    _Delay .2

    UpdateGeneration TheCells2(), TheCells1()

    DRAWGRID TheCells1()

    _Delay .2

Loop Until InKey$ = Chr$(27)





Sleep

End









Sub UpdateGeneration (InCells() As CellType, OutCells() As CellType)

    Dim i As Long

    Dim CellPointer As Long

    Dim RowAbove As Long

    Dim RowBelow As Long

    Dim ColLeft As Long

    Dim ColRight As Long

    Dim NRow As Long

    Dim NCol As Long

    Dim Neighbors(0 To 7) As CellType



    CellPointer = 0

    For i = 0 To UBound(InCells)

        If InCells(i).Row = 0 Then

            RowAbove = InCells(i).Parent.HEI - 1

        Else

            RowAbove = InCells(i).Row - 1

        End If



        If InCells(i).Row = InCells(i).Parent.HEI - 1 Then

            RowBelow = 0

        Else

            RowBelow = InCells(i).Row + 1

        End If



        If InCells(i).Col = 0 Then

            ColLeft = InCells(i).Parent.WID - 1

        Else

            ColLeft = InCells(i).Col - 1

        End If



        If InCells(i).Col = InCells(i).Parent.WID - 1 Then

            ColRight = 0

        Else

            ColRight = InCells(i).Col + 1

        End If



        Neighbors(0) = InCells((RowAbove * MYGRID.WID) + ColLeft)

        Neighbors(1) = InCells((RowAbove * MYGRID.WID) + InCells(i).Col)

        Neighbors(2) = InCells((RowAbove * MYGRID.WID) + ColRight)



        Neighbors(3) = InCells((InCells(i).Row * MYGRID.WID) + ColLeft)

        Neighbors(4) = InCells((InCells(i).Row * MYGRID.WID) + ColRight)



        Neighbors(5) = InCells((RowBelow * MYGRID.WID) + ColLeft)

        Neighbors(6) = InCells((RowBelow * MYGRID.WID) + InCells(i).Col)

        Neighbors(7) = InCells((RowBelow * MYGRID.WID) + ColRight)

        OutCells(i).IsAlive = IsAlive(InCells(i), Neighbors())

    Next

End Sub



Function IsAlive (CellIn As CellType, CellNeighbors() As CellType)

    Dim LifeCount As Integer

    Dim i As Long

    LifeCount = 0

    For i = 0 To 7

        If CellNeighbors(i).IsAlive Then

            LifeCount = LifeCount + 1

        End If

    Next

    If CellIn.IsAlive And (LifeCount > 1 And LifeCount < 4) Then

        IsAlive = _TRUE

        Exit Function

    End If

    If CellIn.IsAlive And (LifeCount > 3) Then

        IsAlive = _FALSE

        Exit Function

    End If

    If Not (CellIn.IsAlive) And (LifeCount = 3) Then

        IsAlive = _TRUE

        Exit Function

    End If

    IsAlive = _FALSE

End Function



Sub InitGrid

    Dim I As Long

    Dim GRow As Long

    Dim GCol As Long

    Dim CellPointer As Long

    Randomize Timer

    CellPointer = 0

    NumberOfCells = MYGRID.WID * MYGRID.HEI

    ReDim TheCells1(0 To NumberOfCells - 1) As CellType

    ReDim TheCells2(0 To NumberOfCells - 1) As CellType





    For GRow = 0 To MYGRID.HEI - 1

        For GCol = 0 To MYGRID.WID - 1

            TheCells1(CellPointer).Row = GRow

            TheCells1(CellPointer).Col = GCol

            TheCells2(CellPointer).Row = GRow

            TheCells2(CellPointer).Col = GCol

            TheCells1(CellPointer).Parent = MYGRID

            TheCells2(CellPointer).Parent = MYGRID



            If (Int(Rnd * 100) + 1) < 25 Then

                TheCells1(CellPointer).IsAlive = _TRUE

            Else

                TheCells1(CellPointer).IsAlive = _FALSE

            End If

            CellPointer = CellPointer + 1

        Next

    Next

    MyScreen = _NewImage(MYGRID.WID * MYGRID.CellWidth, MYGRID.HEI * MYGRID.CellHeight, 32)

    Screen MyScreen

    For I = 0 To NumberOfCells - 1

        DrawCell TheCells1(I)

    Next

End Sub



Sub DRAWGRID (Cells() As CellType)

    Dim i As Long

    For i = 0 To UBound(Cells)

        DrawCell Cells(i)

    Next

    _Display

End Sub







Sub DrawCell (Cell As CellType)

    Dim CellColor As Long

    Dim X As Long

    Dim Y As Long

    Dim X2 As Long

    Dim Y2 As Long

    If Cell.IsAlive Then

        CellColor = _RGB32(22, 188, 28, 255)

    Else

        CellColor = _RGB32(50, 13, 23)

    End If

    X = (Cell.Col * Cell.Parent.CellWidth)

    Y = (Cell.Row * Cell.Parent.CellHeight)

    X2 = X + Cell.Parent.CellWidth

    Y2 = Y + Cell.Parent.CellHeight

    Line (X, Y)-(X2, Y2), _RGB32(165, 185, 185, 255), BF

    Line (X + 1, Y + 1)-(X2 - 1, Y2 - 1), CellColor, BF

End Sub

  I also need to set up USER selection of Grid  Not just random !

---

[Unseen Machine]

Dont know what the ghost business is about but interesting to see how it worked around the array edges AND avoid handling negs with MOD with standard torus trick, using Mods, instead of infinite plane AND adding gridw/h to keep MODs positive. Coloring with age might be interesting if the code were slowed to human comprehension level enough to appreciate.

First fix slow down the sim, 2nd allow a mistake when clicking in live cells at start, click cell on click, again and it's off.

AI +1, if it weren't simply copy/pasted from someone else code.

I liked the ghosting thingy...

Right click to delete blocks and as for speed, change the _LIMIT

I laid out the structure, ai filled it in...I will not apologise for using AI...its awesome at simple things like this so why not use it. I perfectly happy being an architect and letting minions build!

Unseen

[bplus]

Feedback:
Works fine! I am seeing: blinkers, floaters, "rocks" 2x2's looks like normal life.

Here is my most recent version modified rules for 3D sim:

Code: (Select All)

_Title "3D per Parallelism test Game of Life - hold enter to reset" ' started Parallelism b+ 2024-02-20
'  "parallelism suggests a connection of meaning through an echo of form"
' 2024-02-21 Pyramid 2 screw around with pyramid numbers fix projection formula
' 2024-02-21 now test cubes with DrawCube sub
' 2024-02-21 return to Pyramid 2 and fix that according to how this Project sub works.
' 2024-02-22 test Game of Life code from thisversion of DrawCube
'            Ah! apply some tips I learned with 3D Rendering of Game of Life

Dim Shared As Long SW, SH: SW = 720: SH = 720
Screen _NewImage(SW, SH, 32)
_ScreenMove 280, 0
Randomize Timer

Type XYZ
    As Single x, y, z
End Type
Type XY
    As Single x, y
End Type
Dim Shared PC: PC = .35 ' or something  PC = Parallel Constant
Window (-15, 35)-(35, -15) ' setup for 3D

' setup for Game of Life
Dim As Integer xmin, xmax, ymin, ymax, zmin, zmax
xmin = 1: xmax = 30: ymin = 1: ymax = 30: zmin = 1: zmax = 30
Dim As Integer x, y, z, r, g, b, mm, xx, yy, zz, rr, gg, bb, gen
Color &HFFDDDDFF, &HFF000000

ResetStart:
gen = 0
ReDim As Integer U(xmin To xmax, ymin To ymax, zmin To zmax), U2(xmin To xmax, ymin To ymax, zmin To zmax)
'For z = zmin + 10 To zmax - 10
'    For x = xmin + 10 To xmax - 10
'        For y = ymin + 10 To ymax - 10
'            If Rnd > .9 Then U(x, y, z) = 1
'Next y, x, z

'try a blinker
U(14, 15, 15) = 1: U(15, 15, 15) = 1: U(16, 15, 15) = 1
rr = Rnd * 50 + 50: gg = Rnd * 50 + 50: bb = Rnd * 50 + 50

Do
    Cls
    _PrintString (10, 10), "Generation:" + Str$(gen) + "  press any for next, escape to quit... "
    r = rr: g = gg: b = bb
    For z = zmin + 1 To zmax - 1
        r = r * 1.04: g = g * 1.04: b = b * 1.04
        For x = xmin + 1 To xmax - 1
            For y = ymin + 1 To ymax - 1
                If U(x, y, z) = 1 Then
                    drawCube x, y, z, .9, _RGB32(r, g, b)
                End If
        Next y, x
        _Display
        _Limit 30
    Next z
    _Display
    Sleep
    If _KeyDown(13) Then Cls: _Delay .5: GoTo ResetStart
    For z = zmin + 1 To zmax - 1
        For x = xmin + 1 To xmax - 1
            For y = ymin + 1 To ymax - 1
                mm = 0
                For xx = x - 1 To x + 1
                    For yy = y - 1 To y + 1
                        For zz = z - 1 To z + 1
                            If x = xx And y = yy And z = zz Then
                            Else
                                If U(xx, yy, zz) = 1 Then mm = mm + 1
                            End If
                Next zz, yy, xx
                If (mm > 1) And (mm < 4) Then ' neighbors for birth
                    U2(x, y, z) = 1
                ElseIf U(x, y, z) = 1 And mm = 3 Then ' neighbors to survive
                    U2(x, y, z) = 1
                Else
                    U2(x, y, z) = 0
                End If
        Next y, x
    Next z

    For z = zmin + 1 To zmax - 1
        For x = xmin + 1 To xmax - 1
            For y = ymin + 1 To ymax - 1
                U(x, y, z) = U2(x, y, z)
    Next y, x, z
    gen = gen + 1
Loop Until _KeyDown(27)

Sub drawCube (cx, cy, cz, side, colr~&) 'draw a cube on screen from an xyz() 3D array
    Dim As Integer i, r, g, b
    Dim sd2, lx, rx, ty, by, fz, bz
    Dim c2 As _Unsigned Long
    r = _Red32(colr~&): g = _Green32(colr~&): b = _Blue32(colr~&)
    ReDim corners(0 To 7) As XYZ
    sd2 = side / 2
    rx = cx + sd2: lx = cx - sd2
    ty = cy + sd2: by = cy - sd2
    fz = cz + sd2: bz = cz - sd2
    'bck face
    corners(0).x = lx: corners(0).y = ty: corners(0).z = bz
    corners(1).x = rx: corners(1).y = ty: corners(1).z = bz
    corners(2).x = rx: corners(2).y = by: corners(2).z = bz
    corners(3).x = lx: corners(3).y = by: corners(3).z = bz
    'frt face
    corners(4).x = lx: corners(4).y = ty: corners(4).z = fz
    corners(5).x = rx: corners(5).y = ty: corners(5).z = fz
    corners(6).x = rx: corners(6).y = by: corners(6).z = fz
    corners(7).x = lx: corners(7).y = by: corners(7).z = fz

    ReDim xy(0 To 7) As XY
    For i = 0 To 7
        Project corners(i), xy(i) ' take a corner x,y,z and convert to screen coordinates x,y
    Next

    'debug
    'back face
    'Line (xy(0).x, xy(0).y)-(xy(1).x, xy(1).y), &HFFFF0000
    'Line (xy(1).x, xy(1).y)-(xy(2).x, xy(2).y), colr~&
    'Line (xy(2).x, xy(2).y)-(xy(3).x, xy(3).y), colr~&
    'Line (xy(3).x, xy(3).y)-(xy(0).x, xy(0).y), colr~&

    'front face
    'Line (xy(4).x, xy(4).y)-(xy(5).x, xy(5).y), colr~&
    'Line (xy(5).x, xy(5).y)-(xy(6).x, xy(6).y), colr~&
    'Line (xy(6).x, xy(6).y)-(xy(7).x, xy(7).y), colr~&
    'Line (xy(7).x, xy(7).y)-(xy(4).x, xy(4).y), colr~&

    ' top face
    c2 = _RGB32(.85 * r, .85 * g, .85 * b)
    FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(4).x, 0), PMap(xy(4).y, 1), c2
    FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), c2

    ' right face
    c2 = _RGB32(.6 * r, .6 * g, .6 * b)
    FillTriangle PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), c2
    FillTriangle PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), c2

    ' front face
    FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), colr~&
    FillTriangle PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(4).x, 0), PMap(xy(4).y, 1), colr~&

End Sub

' steves latest version to check out, seems to be working OK
Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    $Checking:Off
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    $Checking:On
End Sub

' here I am working with a Window so Screen obeys right hand rule so as z increases
' the image x, y plane is closer to the eye/camera so is bigger
' but should be distance squared
' thankyou vince '2024-02  the bigger the Z the closer it is to the eye the greater the image
Sub Project (pIN As XYZ, pOut As XY) 'M2SPP = Model (3D) 2 Screen Per Parallelism
    pOut.x = pIN.x - PC * pIN.z
    pOut.y = pIN.y - PC * pIN.z
End Sub

Starts as 1x1x3 "blinker" in 2D Life (Gen 9):