Game of Life!

[Cobalt]

Well more to say a Simulation of life. but made you look anyway! :D
see the original article I used to make this BASIC version: https://fiftyexamples.readthedocs.io/en/latest/life.html

I was actually looking for a way to simulate the solar system, the Sun and 9 planets orbiting at correctly scaled speeds and approx distances(so that Earth orbits 248x for 1 orbit of Pluto and ect...), A program I once had back in the early 90s out of a book from the library. thus about 26-27years later I can't recall the name of the book and the only copies of the program I have were foolishly encrypted by my 13-14 y/o self. The program titled in the book as 'Orbit'.

anyway, here is life.

Code: QB64: [Select]

1. 'so called Game of Life, though not a real game.
2. 'Based on mathematician, John H. Conway's 1970 simulation that he called
3. 'the Game of Life. There is no winning or losing, just experimenting.
4. 'Cells are kept alive with 2-3 living cells around them
5. 'Cells are brought to life if there are 3 live cells around
6. 'Cells Die of loneliness if there are 1-0 live cells around
7. 'Cells are smoothered if there are 4 or more live cells around.
8.  
9.  
10. SCREEN _NEWIMAGE(640, 480, 32): CLS: RANDOMIZE TIMER
11. Mix& = _NEWIMAGE(640, 480, 32)
12. Cell& = _NEWIMAGE(640, 480, 32)
13. _DELAY .15
14. _TITLE "Game Of Life? V0.1"
15. _SCREENMOVE 20, 20
16.  
17. CONST TRUE = -1, FALSE = NOT TRUE
18. CONST Blue = _RGB32(0, 16, 224), Black = _RGB32(8, 8, 8), White = _RGB32(240, 240, 240)
19. CONST MaxX = 50 'number of columns 127 max
20. CONST SX = 500 'size of board in pixels X, 510 max(cause instruction area)
21. CONST MaxY = 30 'number of rows 127 max
22. CONST SY = 470 'size of board in pixels Y,480 max(screen size limitation)
23. CONST Pass = 85 'random chance of life 0-100%(0=All live, 100=all dead, I know its backwards)
24.  
25. DIM SHARED Board(MaxX, MaxY) AS _BYTE, Speed!
26. T1& = _FREETIMER
27. ON TIMER(T1&, .05) AgeBoard
28. _DEST Cell&
29. ClearBoard Board()
30. MakeRandom Board()
31. Speed! = .25
32.  
33. DO
34.  Nul = _MOUSEINPUT
35.  '--------------------INPUT-------------------------
36.  KBD$ = UCASE$(INKEY$)
37.  SELECT CASE KBD$
38.   CASE CHR$(27)
39.    ExitFlag%% = TRUE
40.   CASE "A" 'Turn on Automatic cycle
41.    TIMER(T1&) ON
42.    Auto = TRUE
43.   CASE "S" 'Step 1 turn/Turn off Automatic cycle
44.    IF Auto THEN TIMER(T1&) OFF: Auto = FALSE
45.    AgeBoard
46.   CASE "C" 'Clear Board/Turn off Automatic Cycle
47.    IF Auto THEN TIMER(T1&) OFF: Auto = FALSE
48.    ClearBoard Board()
49.   CASE "F" 'random Fill board grid/Turn off Automatic Cycle
50.    IF Auto THEN TIMER(T1&) OFF: Auto = FALSE
51.    MakeRandom Board()
52.   CASE "Q"
53.    Speed! = Speed! + .05
54.    IF Speed! >= 1.5 THEN Speed! = 1.5
55.   CASE "P"
56.    Speed! = Speed! - .05
57.    IF Speed! <= .05 THEN Speed! = .05
58.  END SELECT
59.  '-------------------------------------------------------
60.  
61.  '----------------------MOUSE----------------------------
62.  IF _MOUSEBUTTON(1) THEN
63.   CheckCell _MOUSEX, _MOUSEY, Board()
64.  END IF
65.  '-------------------------------------------------------
66.  
67.  '--------------------Display----------------------------
68.  DrawGrid MaxX, MaxY
69.  DrawCells Board()
70.  _PUTIMAGE , Cell&, Mix&
71.  _PUTIMAGE , Mix&, _DISPLAY
72.  _PRINTSTRING (520, 10), "A-automatic", _DISPLAY
73.  _PRINTSTRING (520, 30), "S-Step by Step", _DISPLAY
74.  _PRINTSTRING (520, 50), "C-Clear Board", _DISPLAY
75.  _PRINTSTRING (520, 70), "F-Random Fill", _DISPLAY
76.  _PRINTSTRING (520, 90), "Q-Slower cycles", _DISPLAY
77.  _PRINTSTRING (520, 110), "P-Faster cycles", _DISPLAY
78.  _PRINTSTRING (520, 130), "Speed:" + STR$(Speed!) + " sec   ", _DISPLAY
79.  IF Auto THEN _PRINTSTRING (520, 150), "Auto:  ON", _DISPLAY ELSE _PRINTSTRING (520, 150), "Auto: OFF", _DISPLAY
80.  _PRINTSTRING (520, 200), "Or select cells", _DISPLAY
81.  _PRINTSTRING (520, 220), "with the mouse", _DISPLAY
82.  '-------------------------------------------------------
83.  IF Auto THEN _DELAY Speed! ELSE _DELAY .016
84.  DO: LOOP WHILE _MOUSEINPUT
85. LOOP UNTIL ExitFlag%% = TRUE
86.  
87. SUB AgeBoard ()
88.  FOR x%% = 0 TO MaxX
89.   FOR y%% = 0 TO MaxY
90.  
91.    Live%% = Check_Live(x%%, y%%) 'how many cells around the current one are alive?
92.    IF Live%% = 3 AND (NOT Board(x%%, y%%)) THEN GiveLife x%%, y%% 'just right for NEW life!
93.    IF Live%% <= 1 AND Board(x%%, y%%) THEN TakeLife x%%, y%% 'not enough friends
94.    IF Live%% >= 4 AND Board(x%%, y%%) THEN TakeLife x%%, y%% 'TOO many friends
95.  
96.  NEXT y%%, x%%
97. END SUB
98.  
99. SUB ClearBoard (B() AS _BYTE)
100.  FOR x%% = 0 TO MaxX
101.   FOR y%% = 0 TO MaxY
102.    B(x%%, y%%) = FALSE
103.  NEXT y%%, x%%
104. END SUB
105.  
106. SUB MakeRandom (B() AS _BYTE)
107.  FOR x%% = 0 TO MaxX
108.   FOR y%% = 0 TO MaxY
109.    IF INT(RND * 100) > Pass%% THEN B(x%%, y%%) = TRUE
110.  NEXT y%%, x%%
111. END SUB
112.  
113. FUNCTION ToggleCell (X%%, Y%%, B() AS _BYTE)
114.  ToggleCell = NOT B(X%%, Y%%)
115. END FUNCTION
116.  
117. FUNCTION Check_Live%% (X%%, Y%%)
118.  Result%% = 0
119.  StartX%% = 0: StartY%% = 0
120.  EndX%% = 0: EndY%% = 0
121.  'check that current cells neighbors are within the grid array
122.  IF X%% - 1 > LBOUND(Board, 1) THEN StartX%% = X%% - 1 ELSE StartX%% = X%%
123.  IF Y%% - 1 > LBOUND(Board, 2) THEN StartY%% = Y%% - 1 ELSE StartY%% = Y%%
124.  IF X%% + 1 <= UBOUND(Board, 1) THEN EndX%% = X%% + 1 ELSE EndX%% = X%%
125.  IF Y%% + 1 <= UBOUND(Board, 2) THEN EndY%% = Y%% + 1 ELSE EndY%% = Y%%
126.  FOR Ix%% = StartX%% TO EndX%%
127.   FOR Iy%% = StartY%% TO EndY%%
128.    'dont bother with current cell being checked so dont process it
129.    IF Ix%% = X%% AND Iy%% = Y%% THEN ELSE IF Board(Ix%%, Iy%%) THEN Result%% = Result%% + 1
130.   NEXT
131.  NEXT
132.  'return the number of live cells around current cell
133.  Check_Live = Result%%
134. END FUNCTION
135.  
136. SUB GiveLife (X%%, Y%%)
137.  Board(X%%, Y%%) = ToggleCell(X%%, Y%%, Board())
138. END SUB
139.  
140. SUB TakeLife (X%%, Y%%)
141.  Board(X%%, Y%%) = ToggleCell(X%%, Y%%, Board())
142. END SUB
143.  
144. SUB DrawGrid (X%%, Y%%)
145.  ScaleY = SY \ MaxY
146.  ScaleX = SX \ MaxX
147.  LINE (0, 0)-(SX, SY), White, B
148.  FOR Ix% = 0 TO SX STEP ScaleX
149.   LINE (Ix%, 0)-(Ix%, SY), White
150.  NEXT
151.  FOR Iy% = 0 TO SY STEP ScaleY
152.   LINE (0, Iy%)-(SX, Iy%), White
153.  NEXT
154. END SUB
155.  
156. SUB DrawCells (B() AS _BYTE)
157.  ScaleY = SY \ MaxY
158.  ScaleX = SX \ MaxX
159.  FOR X%% = 0 TO MaxX - 1
160.   FOR Y%% = 0 TO MaxY
161.    IF B(X%%, Y%%) THEN LINE (1 + X%% * ScaleX, 1 + Y%% * ScaleY)-STEP(ScaleX - 1, ScaleY - 1), Blue, BF ELSE LINE (1 + X%% * ScaleX, 1 + Y%% * ScaleY)-STEP(ScaleX - 2, ScaleY - 2), Black, BF
162.  NEXT Y%%, X%%
163. END SUB
164.  
165. SUB CheckCell (X%, Y%, B() AS _BYTE)
166.  ScaleY = SY \ MaxY
167.  ScaleX = SX \ MaxX
168.  MX%% = X% \ ScaleX
169.  MY%% = Y% \ ScaleY
170.  B(MX%%, MY%%) = ToggleCell(MX%%, MY%%, B())
171.  _DELAY .15
172. END SUB
173.  

It does have a small issue I have not figured out yet, you can end up with a block of 9 in the upper left corner that never changes. Not sure what is causing that yet. Once another cell around that area is live it starts to react though.

A very simple program that could be made a lot more complex, could even give a max life time so that if a cell is live too long it dies too, or just random life where random cells just spring to life. almost endless possibilities.

[bplus]

Hi Cobalt,

So that's what you wanted that TIMER code for!

Am I missing something, I can't seem to get anything to go?

Meanwhile you might enjoy for comparison, a Quick Life sampler I made for .net some time ago (actually it is two codes combined, a basic life sampler and a favorite variation of mine):

Update: I did post it here https://www.qb64.org/forum/index.php?topic=129.0

[Cobalt]

Am I missing something, I can't seem to get anything to go?

Should just be able to press 'a' for automatic or 's' for step-by-step.

[bplus]

When I press "a", it just toggles Auto: ON

[Cobalt]

but the grid doesn't change?

[bplus]

No nothing else is happening, for me v 1.3, could you be using one of Steve's QB64 versions?

Well if it works for someone else, I hope they let us know.

[Cobalt]

do any of the other keys work? 'c' clear the grid, 'f' generate new random? not using anything special. builds with my very old 1.1b82 from Nov of 2017.

oh in 1.3 the grid is blank.. what did somebody break?  you should be seeing blue blocks in the grid. but I'm guessing you don't. not a clue. like i said works fine in 1.1 build82.

[bplus]

Well I'll B+

 

What did they break?

[Cobalt]

I don't know, works on 1.1 and 1.2(as Bplus shows) but fails to show any blue cells in 1.3!


See in Picture, NO blue cells, where are my Blue cells in QB64 1.3?!?

[bplus]

Hi Colbalt,

A little trick I learned doing Life code about a million times:

To run through the neighbor counts of a board n x n, use an oversized array, say neighborCounts(0 to n + 1, 0 to n + 1) then the two FOR loops to count the neighbors just do so from 1 to n

For y = 1 to n
   For x = 1 to n
      neighborCounts(x, y) = the sum of the 8 neighbor cells that surround (x, y) cell
next : next

This allows the neighbor count part to take place without any worries about cells on the edge, you never do counts for those cells and you should not display them either.

[Cobalt]

Yeah, I was trying to use parts of QB64 that I've never used before, like UBOUND and LBOUND, and make the SUBs and FUNCTIONS independent of the main code so I didn't have any DIM SHARED, course that didn't work.

This was kind of like a Great Experiment on my part. Though why it doesn't seem to work in 1.3 I still don't know.

[bplus]

Was the timer part of the Great Experiment? Are you in love with it?, because you can do plenty without.

Here is core stripped down version of Life, I like to use line seeds for symmetric generations so this runs through 68 of these. Whenever a seed runs down just press spacebar, if you want to quit press escape:

Code: QB64: [Select]

1. OPTION _EXPLICIT '   by bplus  2019-09-20
2. DEFINT A-Z '         strip Quick Life down to bare essentials
3. _TITLE "Core Life: press spacebar when stabilized, esc to quit"
4. CONST xmax = 700, ymax = 700, n = 140, s = 5
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 360, 20
7. DIM g, x, y, r, nc 'nc is neighbor count
8. DIM a(0 TO n + 1, 0 TO n + 1), ng(0 TO n + 1, 0 TO n + 1) 'a() is Life array, ng() is next generation
9. COLOR &HFFFFFF00, &HFF080021: r = 68
10. DO 'seed for Conway's Life Classic
11.     CLS
12.     g = 0: r = r - 1: IF r = 1 THEN r = 68
13.     FOR y = 0 TO n + 1
14.         FOR x = 0 TO n + 1 'for symmetric line blocks
15.             IF y = n / 2 AND x > r AND x < (n + 1 - r) THEN a(x, y) = 1 ELSE a(x, y) = 0
16.         NEXT
17.     NEXT
18.     WHILE INKEY$ <> " " AND _KEYDOWN(27) = 0 'run life until spacebar detected
19.         FOR x = 1 TO n
20.             FOR y = 1 TO n
21.                 nc = 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)
22.                 IF a(x, y) THEN ' a is alive Classic Conway's Life Rules for survival
23.                     IF nc = 2 OR nc = 3 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
24.                 ELSE 'birth?
25.                     IF nc = 3 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
26.                 END IF
27.             NEXT
28.         NEXT
29.         CLS
30.         FOR y = 1 TO n
31.             FOR x = 1 TO n
32.                 IF a(x, y) THEN 'this separates into individual cells for Classic look
33.                     LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s - 2, s - 2), &HFFFFFFFF, BF
34.                 END IF
35.             NEXT
36.         NEXT
37.         LOCATE 1, 1: PRINT "Seed:"; r; "  Gen:"; g
38.         _DISPLAY
39.         FOR y = 1 TO n
40.             FOR x = 1 TO n
41.                 a(x, y) = ng(x, y) 'load a() with next generation data
42.             NEXT
43.         NEXT
44.         g = g + 1
45.         _DISPLAY
46.         _LIMIT 10
47.     WEND
48. LOOP UNTIL _KEYDOWN(27)
49. CLS: END
50.  
51.  

BTW seed #65 is a stable regenerating structure I've not seen before!

[FellippeHeitor]

Here's a fix for it to work with vanilla 1.3. Turn this:

Code: QB64: [Select]

1. CONST Blue = _RGB32(0, 16, 224), Black = _RGB32(8, 8, 8), White = _RGB32(240, 240, 240)

into:

Code: QB64: [Select]

1. CONST Blue = _RGB32(0, 16, 224)
2. CONST Black = _RGB32(8, 8, 8)
3. CONST White = _RGB32(240, 240, 240)

We've discussed in another topic (https://www.qb64.org/forum/index.php?topic=1335.msg105344#msg105344) how consts have been hit hard recently, and that's why your blue cells weren't showing. They were being painted transparent.

I think Steve already has a fix for this in the works in his custom version. It'll probably make it to our next update. (I could be wrong... it's been discussed quite a while back)

[bplus]

Well there is a mystery solved, speaking of transparent... one tiny change and

Code: QB64: [Select]

1. OPTION _EXPLICIT '   by bplus  2019-09-20
2. DEFINT A-Z '         strip Quick Life down to bare essentials
3. _TITLE "Core Life: press spacebar when stabilized, esc to quit"
4. CONST xmax = 700, ymax = 700, n = 140, s = 5
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 360, 20
7. DIM g, x, y, r, nc 'nc is neighbor count
8. DIM a(0 TO n + 1, 0 TO n + 1), ng(0 TO n + 1, 0 TO n + 1) 'a() is Life array, ng() is next generation
9. COLOR &HFFFFFF00, &HFF080021: r = 68
10. DO 'seed for Conway's Life Classic
11.     CLS
12.     g = 0: r = r - 1: IF r = 1 THEN r = 68
13.     FOR y = 0 TO n + 1
14.         FOR x = 0 TO n + 1 'for symmetric line blocks
15.             IF y = n / 2 AND x > r AND x < (n + 1 - r) THEN a(x, y) = 1 ELSE a(x, y) = 0
16.         NEXT
17.     NEXT
18.     WHILE INKEY$ <> " " AND _KEYDOWN(27) = 0 'run life until spacebar detected
19.         FOR x = 1 TO n
20.             FOR y = 1 TO n
21.                 nc = 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)
22.                 IF a(x, y) THEN ' a is alive Classic Conway's Life Rules for survival
23.                     IF nc = 2 OR nc = 3 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
24.                 ELSE 'birth?
25.                     IF nc = 3 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
26.                 END IF
27.             NEXT
28.         NEXT
29.         LINE (0, 0)-STEP(xmax, ymax), &H11080021, BF
30.         FOR y = 1 TO n
31.             FOR x = 1 TO n
32.                 IF a(x, y) THEN 'this separates into individual cells for Classic look
33.                     LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s - 2, s - 2), &HFFFFFFFF, BF
34.                 END IF
35.             NEXT
36.         NEXT
37.         LOCATE 1, 1: PRINT "Seed:"; r; "  Gen:"; g
38.         _DISPLAY
39.         FOR y = 1 TO n
40.             FOR x = 1 TO n
41.                 a(x, y) = ng(x, y) 'load a() with next generation data
42.             NEXT
43.         NEXT
44.         g = g + 1
45.         _DISPLAY
46.         _LIMIT 10
47.     WEND
48. LOOP UNTIL _KEYDOWN(27)
49. CLS: END
50.  
51.  

[Cobalt]

We've discussed in another topic (https://www.qb64.org/forum/index.php?topic=1335.msg105344#msg105344) how consts have been hit hard recently, and that's why your blue cells weren't showing. They were being painted transparent.

Whats really bad is I commented on that topic, and had completely forgotten already! Although maybe I already thought it had been fixed?