GAMEOFLIFE

I commented my changes
'$Checking:On
'Cls
Randomize Timer
Screen 12


Color 10
_Title "GAME OF LIFE." ' this puts into title bar so always shows what this is


' yuck   ?????????????????? you want this border to always start at co1 and end at co2 it seems...
' the following is unitelligible to first time user
'Input "FIRST COORDINATE OF GRID: ", CO1
'Input "ENTER SECOND COORDINATE OF GRID: ", CO2
'Input "SET COLOR (0 TO 15) : ", COL

'set up a square section of screen for border 10 to 110, by 10 to 110
co1 = 10: co2 = 110: col = 15
Dim OLDGEN(co2 - co1, co2 - co1) As Integer 'DECLARING  OLD GEN ARRAY
Dim NEWGEN(co2 - co1, co2 - co1) As Integer 'DECLARING NEW GENERATION ARRAY


'Cls


' since this glider goes right and down change 70's to 30's so can watch longer
OLDGEN(35, 35) = 1 ' THE FOLLOWING ARE THE COORDINATES FOR A GLIDER
OLDGEN(35, 36) = 1
OLDGEN(35, 37) = 1
OLDGEN(34, 37) = 1
OLDGEN(33, 36) = 1


For I = 1 To (co2 - co1) 'DISPLAYING THE OLD GENERATION ARRAY (GLIDER...)
   For J = 1 To (co2 - co1)
       If OLDGEN(I, J) > 0 Then
           PSet (J + co1, I + co1), col
       End If
   Next
Next

' you never set TRUE = 1 or -1 or <> 0 ????
'Do While TRUE 'INFINITE OUTER LOOP REPEATING THE WHOLE ALGORITHM
Do
   ' starting from cleared screen
   ' redraw boundary for each loop
   Line (co1, co1 - 1)-(co2 + 1, co2 + 1), 15, B 'THE FRAME OF THE WHOLE AUTOTMATE

   ' loop through every cell
   For I = 1 To (co2 - co1)
       For J = 1 To (co2 - co1)

           COUNTER = 0 'INITIALIZING COUNTER reset for every cell!!!!!!!!!!!!!!
           If ((J + 1) < (co2 - co1)) And ((I + 1) < (co2 - co1)) Then 'SEE IF CELL IS NOT ON BORDER, AND IF NOT
               If OLDGEN(I - 1, J - 1) > 0 Then 'CHECKING NEIGHBOURS AND INCREMENTING
                   COUNTER = COUNTER + 1 'COUNTER FOR EACH "LIVING" CELL
               End If

               If OLDGEN(I - 1, J) > 0 Then
                   COUNTER = COUNTER + 1
               End If

               If OLDGEN(I - 1, J + 1) > 0 Then
                   COUNTER = COUNTER + 1
               End If

               If OLDGEN(I, J - 1) > 0 Then
                   COUNTER = COUNTER + 1
               End If

               If OLDGEN(I, J + 1) > 0 Then
                   COUNTER = COUNTER + 1
               End If

               If OLDGEN(I + 1, J - 1) > 0 Then
                   COUNTER = COUNTER + 1
               End If

               If OLDGEN(I + 1, J) > 0 Then
                   COUNTER = COUNTER + 1
               End If

               If OLDGEN(I + 1, J + 1) > 0 Then
                   COUNTER = COUNTER + 1
               End If
           End If

           ' Life rules birth
           If (OLDGEN(I, J) > 0) And ((COUNTER = 2) Or (COUNTER = 3)) Then 'IF THE CELL
               NEWGEN(I, J) = 1 ' IS ALIVE AND HAS 2 OR 3 NEIGHBOURS IT WILL BE ALIVE IN THE
           End If 'NEXT STEP TOO. SO FILL NEWGEN ARRAY WITH A 1.

           ' Life rules survival
           If (OLDGEN(I, J) = 0) And (COUNTER = 3) Then 'IF THE CELL IS DEAD AND HAS 3
               NEWGEN(I, J) = 1 'NEIGHBOURS, IT WILL BE ALIVE IN THE NEXT STEP.FILL NEWGEN
           End If ' WITH A 1.
       Next
   Next

   For I = 1 To (co2 - co1) ' DISPLAY THE NEW GENERATION
       For J = 1 To (co2 - co1)
           If NEWGEN(I, J) > 0 Then
               PSet (J + co1, I + co1), col
           End If
       Next
   Next

   ' clear array for next generation
   For I = 1 To (co2 - co1)
       For J = 1 To (co2 - co1)
           OLDGEN(I, J) = NEWGEN(I, J) 'SET OLDGEN ARRAY TO NEWGEN ARRAY
           NEWGEN(I, J) = 0 'REINITIALIZE NEWGEN TO 0
       Next
   Next

   _Display ' draw everything at once in this loop

   _Limit 10 ' slow enough to see the glider glide

   Cls ' after pause above, now erase and start over for next generation
Loop


That's great bplus is there any chance of you putting some of your wonderful graphics to make the program much better!?

Now I have an even better idea would it be possible to make a 3D version ?

Conway's Game of Life in QBasic

github.com/fwenzel/conway.bas?tab=readme-ov-file


DECLARE SUB indicateCycle ()

DECLARE SUB detectEmpty ()

DECLARE SUB seedGame ()

DECLARE SUB drawPoint (x AS INTEGER, y AS INTEGER, col AS INTEGER)

DECLARE SUB evolveGame ()

DECLARE SUB drawGame ()



'Globals

gamewidth = 20

gameheight = 20

defaultcolor = 15  'white

scale = 4  'n-times zoom



'game array is an adjacency list of sorts:

'game(line, idx) = column

'if game(15, idx) = 0, no other active tiles in this line.

DIM game(gamewidth, gameheight) AS INTEGER





'Off we go!

SCREEN 13

seedGame

drawGame

WHILE INKEY$ = ""

   indicateCycle

   evolveGame

   detectEmpty

WEND



SUB detectEmpty

'detect if game is empty. Reseed if so.

SHARED gameheight

SHARED game() AS INTEGER



FOR y = 1 TO gameheight

   'If there's an active cell, we're done here.

   IF game(y, 1) <> 0 THEN EXIT SUB

NEXT y



'No live cells, apparently. So reseed.

seedGame



END SUB



SUB drawGame

'Draw game, from scratch.

SHARED gamewidth, gameheight, defaultcolor

SHARED game() AS INTEGER



FOR y = 1 TO gameheight

   FOR i = 1 TO gamewidth

       'skip if we are done with this line.

       x = game(y, i)

       IF x = 0 THEN GOTO drawContY



       drawPoint INT(x), INT(y), INT(defaultcolor)

   NEXT i



drawContY:

NEXT y

END SUB



SUB drawPoint (x AS INTEGER, y AS INTEGER, col AS INTEGER)

SHARED scale



FOR xs = 0 TO scale - 1

   FOR ys = 0 TO scale - 1

       PSET ((x - 1) * scale + xs, (y - 1) * scale + ys), col

   NEXT ys

NEXT xs



END SUB



SUB evolveGame

SHARED gamewidth, gameheight

SHARED game() AS INTEGER

SHARED defaultcolor



DIM neighbors(gamewidth, gameheight) AS INTEGER



'Calculate neighbors.

FOR y = 1 TO gameheight

   FOR i = 1 TO gamewidth

       x = game(y, i)

       'Skip if we're done with this line.

       IF x = 0 THEN GOTO evolveContY



       FOR nx = x - 1 TO x + 1

           FOR ny = y - 1 TO y + 1

               IF nx <> 0 AND ny <> 0 AND nx <> gamewidth + 1 AND ny <> gamewidth + 1 THEN

                   IF nx = x AND ny = y THEN

                       'Mark as active cell.

                       neighbors(x, y) = neighbors(x, y) + 10

                   ELSE

                       'Count neighbors.

                       neighbors(nx, ny) = neighbors(nx, ny) + 1

                   END IF

               END IF

           NEXT ny

       NEXT nx

   NEXT i



evolveContY:

NEXT y





'Determine live cells for next step based on neighbors.

FOR y = 1 TO gameheight

   idx = 1  'build adjacency list.



   FOR x = 1 TO gamewidth

       'Previously dead with 3 neighbors, or:

       'prev. live with 2 or 3 neighbors.

       IF neighbors(x, y) = 3 OR neighbors(x, y) = 12 OR neighbors(x, y) = 13 THEN

           game(y, idx) = x

           idx = idx + 1

         

           'Draw the cell.

           drawPoint INT(x), INT(y), INT(defaultcolor)

       ELSEIF neighbors(x, y) >= 10 THEN

           'Blank out previously active cell.

           drawPoint INT(x), INT(y), 0  'black

       END IF



       neighbors(x, y) = 0

   NEXT x



   'Mark end of adjacency list.

   IF idx <= gamewidth THEN

       game(y, idx) = 0

   END IF

NEXT y



END SUB



SUB indicateCycle

'Cycle indicator, flips once per evolution.

SHARED gamewidth, gameheight



STATIC cycle



'Draw cycle indicator to see things happening

'even when they are stable.

drawPoint gamewidth + 1, gameheight + 1, INT(cycle)

IF cycle > 0 THEN

   cycle = 0  'black

ELSE

   cycle = 14  'yellow

END IF



END SUB



SUB seedGame

'Add some randomized live cells.

SHARED gamewidth, gameheight

SHARED game() AS INTEGER



RANDOMIZE TIMER



'Fill up to 20% of the board.

livecells = INT(RND * gamewidth * gameheight / 5) + 1



'Remember our position in the game array

DIM gameidx(gameheight) AS INTEGER



FOR i = 1 TO livecells

   DO

       position = INT(RND * gamewidth * gameheight) + 1

       y = position MOD gamewidth

   LOOP UNTIL gameidx(y) + 1 < gamewidth  'Don't overfill a line.

   x = INT(position / gamewidth)



   game(y, gameidx(y) + 1) = x



   'Move to the next spot in this line.

   gameidx(y) = gameidx(y) + 1

NEXT i



END SUB




Heres another:



_Title "Quick Conway Life" ' b+ 2023-1-15
Screen _NewImage(710, 710, 32)
DefLng A-Z
Dim g(69, 69)

For y = 1 To 68 'seed g()
   For x = 1 To 68
       If Rnd < .33 Then g(x, y) = 1
   Next
Next

While _KeyDown(27) = 0
   ReDim ng(69, 69)
   Cls
   gen = gen + 1
   Print "Gen"; gen
   For y = 1 To 68
       For x = 1 To 68
           nc = g(x - 1, y - 1) + g(x, y - 1) + g(x + 1, y - 1) + g(x - 1, y) + g(x + 1, y) + g(x - 1, y + 1) + g(x, y + 1) + g(x + 1, y + 1)
           If g(x, y) Then
               Line (x * 10, y * 10)-Step(10, 10), &HFFFFFFFF, BF
               Line (x * 10, y * 10)-Step(10, 10), &HFF000000, B
               If nc = 2 Or nc = 3 Then ng(x, y) = 1
           Else
               If nc = 3 Then ng(x, y) = 1
           End If
       Next
   Next
   For y = 1 To 68 'transfer ng to g and erase
       For x = 1 To 68
           g(x, y) = ng(x, y)
       Next
   Next
   _Limit 10
Wend

found here qb64.boards.net/thread/224/basic-computer-games

and another version in same link

Option _Explicit
_Title "Mandala Life trans from sb, press key for next screen" 'b+ 2023-01-15
'Mandala life.bas SmallBASIC (not MS) B+ for Bpf 2015-03-25
Screen _NewImage(600, 600, 12)
Dim As Long an, s, bigblock, g, x, y, pc, lc, cl
an = 60: s = 10: bigblock = 600: g = 0
Dim As Long a(1 To an, 1 To an), ng(1 To an, 1 To an), ls(1 To an, 1 To an)
Dim r$

While _KeyDown(27) = 0
   If g Mod 2 = 0 Then ' keep a pulsing border
       For x = 1 To an
           a(x, 1) = 1: a(x, an) = 1: a(1, x) = 1: a(an, x) = 1
       Next
   End If
   For x = 2 To an - 1
       For y = 2 To an - 1
           pc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
           ls(x, y) = pc: r$ = _Trim$(Str$(pc))
           If a(x, y) Then
               If InStr("2346", r$) Then ng(x, y) = 1 Else ng(x, y) = 0
           Else 'birth?
               If InStr("34", r$) Then ng(x, y) = 1 Else ng(x, y) = 0
           End If
       Next
   Next
   Line (1, 1)-(bigblock, bigblock), 15, BF
   For y = 1 To an
       For x = 1 To an
           If a(x, y) Then
               Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s, s), 0, BF
           Else
               lc = ls(x, y)
               Select Case lc
                   Case 0: cl = 15 'br white
                   Case 1: cl = 11 'cyan
                   Case 2: cl = 7 'low white, br gray
                   Case 3: cl = 10 'light green
                   Case 4: cl = 9 'blue
                   Case 5: cl = 13 'violet
                   Case 6: cl = 12 'br red
                   Case 7: cl = 4 'dark red
                   Case 8: cl = 1 'indigo
               End Select
               Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s, s), cl, BF
           End If
       Next
   Next
   For y = 1 To an
       For x = 1 To an
           a(x, y) = ng(x, y)
       Next
   Next
   g = g + 1
   If g > 60 Then Sleep
Wend



In fact there is 3 pages in that link discussing how to do Conways Game of Life in QB64 with a bunch of variations.

Update: no then than link starts that stupid game called Cube but here is another How to on Conways Game of Life I posted:
friends-of-basic.freeforums.net/thread/287/make-version-conways-game-life

Very interesting Stuff bplus,I never knew so many other people had the same interests

And yes! the 3D Version idea came to me the more I looked at it,how I imagine that game would be as an example inside a 3D Cube it could be a simple version to start with inside an 8x8 Cube then if all that works then just size it up!
So what you would get is Life starting in 4 different places at the same time! (1 on each of the 4 sides ? Not sure about that! maybe 2 versions one that plays 4 life starts anywhere (in the Cube) and one as before) and then colliding into each other etc. and following the normal Life rules,it would get very hectic very soon!

Nice! just when you think it's going to die out a little glider flies out and reactivates a satabilized section and off we go again!

Wow! bplus Just goes to show how people think alike after looking at a new way of doing something!

The modern generation feel quite smart with some of the ideas we come up with,and yes we are! who would of thought it would ever be possible to fit a billion + transistors on a Microchip like we are now doing,which could well be our greatest achievement,invention in the last 100,1000 + years ? Can you imagine going back in time with one of those Chips when the first Transistors were Valves,and saying to them one day we will fit a billion + of those on something the size of a postage stamp!

But we have had great ideas in the past going way back that have baffled Scientist as to how they done it,one example I found the other day was a 4th-century glass Vase they found which changed colour when light shone on it,"The dichroic effect is achieved by making the glass with tiny proportions of nanoparticles of gold and silver dispersed in colloidal form throughout the glass material"
Now modern scientists have used the idea to make some other Hi-tech image scanning plates,I think that is the correct word? to look at things in more detail,well something like that it's way above me,below is the link...

Lycurgus Cup...

en.wikipedia.org/wiki/Lycurgus_Cup





A.R.B