Hexagonal Life

[bplus]

Same set of rules as Conway's Life played out with Hexagonal Cells that have 6 neighbors to count, it seems to have a space filling and stabilizing nature for small seed starts:

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus started 2019-09-23 from Hex Minesweeper Custom Field
2. DEFINT A-Z
3. CONST cellR = 20 ' which makes the following constant
4. CONST xspacing! = 2 * cellR * COS(_D2R(30))
5. CONST yspacing! = cellR * (1 + SIN(_D2R(30)))
6.  
7. TYPE cell
8.     x AS INTEGER
9.     y AS INTEGER
10.     L AS INTEGER
11. END TYPE
12.  
13. DIM SHARED xmax, ymax, Xarrd, Yarrd 'set all this in customField sub
14.  
15.  
16. '      note: To preserve symmetry when cells hit boundries with a symmetric seed started in middle:
17. '            y should be odd for 1 cell center x axis, on a shorter inner row
18. '            If x is odd then one cell is marked in center.
19. '            If x is even the left one of two center cells will be marked, toggle the one to right also (for symmetric seed).
20.  
21. Xarrd = 21 ' the top left cell has been hacked to duplicate the top right cell, to preserve symmetric seeds through a run
22.  
23. Yarrd = 21 'y should always be odd top preserve symmetry of center symmetric seed
24.  
25. xmax = (Xarrd + 2) * xspacing!: ymax = (Yarrd + 2) * yspacing!
26.  
27. SCREEN _NEWIMAGE(xmax, ymax, 32)
28. _SCREENMOVE (1280 - xmax) / 2 + 60, (760 - ymax) / 2
29. RANDOMIZE TIMER
30. DIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS cell, ng(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS INTEGER 'oversize the board to make it easy to count
31. DIM x, y, xoffset!, xStop, nc, c, r, mb, kh&
32.  
33. DO
34.     _TITLE "Hexagon Life: Left Click to Toggle Cells On/Off, Right Click to Start Run, Escape to Quit"
35.     ' set x, y for cells and mark ceter cell(s)
36.     FOR y = 1 TO Yarrd
37.         IF y MOD 2 = 0 THEN
38.             xoffset! = .5 * xspacing!: xStop = Xarrd - 1
39.         ELSE
40.             xoffset! = 0: xStop = Xarrd
41.         END IF
42.         FOR x = 1 TO xStop
43.             b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing!
44.             b(x, y).y = y * yspacing! + .5 * yspacing!
45.             IF x = INT(Xarrd / 2 + .5) AND y = INT(Yarrd / 2 + .5) THEN b(x, y).L = 1 ELSE b(x, y).L = 0 'mark middle cell
46.             showCell x, y
47.         NEXT
48.     NEXT
49.     _DISPLAY
50.  
51.     'setup seed by toggling cells on and off
52.     WHILE mb <> 2
53.         kh& = _KEYHIT
54.         IF kh& = 27 THEN EXIT DO
55.         mb = 0: c = 0: r = 0
56.         getCell c, r, mb
57.         IF mb = 1 THEN
58.             b(c, r).L = 1 - b(c, r).L
59.             showCell c, r
60.         END IF
61.         _DISPLAY
62.         _LIMIT 60
63.     WEND
64.     mb = 0
65.     _TITLE "Hexagon Life: Spacebar to Restart/Reseed, Escape to Quit"
66.     WHILE kh& <> 32 AND kh& <> 27
67.         kh& = _KEYHIT
68.         'count the neighbors
69.         FOR y = 1 TO Yarrd
70.             IF y MOD 2 = 0 THEN
71.                 xoffset! = .5 * xspacing!: xStop = Xarrd - 1
72.             ELSE
73.                 xoffset! = 0: xStop = Xarrd
74.             END IF
75.             FOR x = 1 TO xStop
76.                 '2 sets of neighbors depending if x offset or not
77.                 IF xoffset! > .05 THEN
78.                     nc = b(x, y - 1).L + b(x + 1, y - 1).L + b(x - 1, y).L
79.                     nc = nc + b(x + 1, y).L + b(x, y + 1).L + b(x + 1, y + 1).L
80.                 ELSE
81.                     nc = b(x - 1, y - 1).L + b(x, y - 1).L + b(x - 1, y).L
82.                     nc = nc + b(x + 1, y).L + b(x - 1, y + 1).L + b(x, y + 1).L
83.                 END IF
84.                 IF (nc = 3 AND b(x, y).L = 1) OR nc = 2 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
85.             NEXT
86.         NEXT
87.         LINE (0, 0)-(xmax, ymax), &H44000000, BF
88.         FOR y = 1 TO Yarrd 'transfer data from ng to b().l and show cell
89.             IF y MOD 2 = 0 THEN
90.                 xStop = Xarrd - 1
91.             ELSE
92.                 xStop = Xarrd
93.             END IF
94.             FOR x = 1 TO xStop
95.                 b(x, y).L = ng(x, y)
96.                 showCell x, y
97.             NEXT
98.             'fix symmetry for top left corner, match x at other end for bi-lat symmetry
99.             b(1, 1).L = b(Xarrd, 1).L
100.             showCell 1, 1
101.         NEXT
102.         _DISPLAY
103.         _LIMIT 1
104.     WEND
105.     IF kh& = 27 THEN EXIT DO
106.     kh& = 0
107. LOOP
108.  
109. SUB showCell (c, r)
110.     DIM da, x!, y!, lastx!, lasty!, clr AS _UNSIGNED LONG
111.     IF r MOD 2 = 0 THEN
112.         IF c < 1 OR c > Xarrd - 1 THEN EXIT SUB
113.     ELSE
114.         IF c < 1 OR c > Xarrd THEN EXIT SUB
115.     END IF
116.     IF r < 1 OR r > Yarrd THEN EXIT SUB
117.     IF b(c, r).L = 1 THEN clr = &HFFFFFFFF ELSE clr = &HFF000000
118.     lastx! = b(c, r).x + cellR * COS(_D2R(-30))
119.     lasty! = b(c, r).y + cellR * SIN(_D2R(-30))
120.     FOR da = 30 TO 330 STEP 60
121.         x! = b(c, r).x + cellR * COS(_D2R(da))
122.         y! = b(c, r).y + cellR * SIN(_D2R(da))
123.         LINE (lastx!, lasty!)-(x!, y!), &HFFFF00FF
124.         lastx! = x!: lasty! = y!
125.     NEXT
126.     PAINT (b(c, r).x, b(c, r).y), clr, &HFFFF00FF
127.     'debug
128.     'cText b(c, r).x, b(c, r).y, 16, &HFF888888, STR$(c) + "," + STR$(r)
129. END SUB
130.  
131. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
132.     DIM m, mx, my, mb1, mb2, r, c
133.     WHILE _MOUSEINPUT: WEND
134.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
135.     IF mb1 THEN mbNum = 1
136.     IF mb2 THEN mbNum = 2
137.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
138.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
139.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
140.             mx = _MOUSEX: my = _MOUSEY
141.             'LOCATE 1, 1: PRINT SPACE$(50)
142.             'LOCATE 1, 1: PRINT mx, my, .5 * xspacing!
143.             _DISPLAY
144.         WEND
145.         FOR r = 1 TO Yarrd
146.             FOR c = 1 TO Xarrd
147.                 IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xspacing! THEN
148.                     returnCol = c: returnRow = r: EXIT SUB
149.                 END IF
150.             NEXT
151.         NEXT
152.         mbNum = 0 'still here then clicked wrong
153.     END IF
154. END SUB
155.  
156. 'debug
157. SUB cText (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
158.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
159.     fg = _DEFAULTCOLOR
160.     'screen snapshot
161.     cur& = _DEST
162.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
163.     _DEST I&
164.     COLOR K, _RGBA32(0, 0, 0, 0)
165.     _PRINTSTRING (0, 0), txt$
166.     mult = textHeight / 16
167.     xlen = LEN(txt$) * 8 * mult
168.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
169.     COLOR fg
170.     _FREEIMAGE I&
171. END SUB
172.  
173.  

If you had enjoyed exploring Conway's Life, you'll like exploring this one too I think. In a way I find this Life version more robust.

I am a lover of symmetry so this code has been hacked a little to keep a symmetric seed start symmetric throughout the run, bilateral left/right in particular.

[TempodiBasic]

Very fine Bplus!
About rules IMHO you must adapt!  A square has 8 neighbour , an exagon seems to have 6 neighbour so tolerance for life is 2 and overpopulation is  3-6 while solitude is 0-1, bring to life is 2.

[Jack002]

Very cool! now on to 3d hex life, 4d hex life. Really nice job B+

[bplus]

Thanks guys,

TempodiBasic, for me sticking to Conway's rules makes sense, 2 is birth or survival and 3 is survival.
I think I tried 1 for survival as opposed to 3 but that was when I was getting code to run, I will test again.
(A quick check) Oh yeah! looks interesting too, thanks! I will play around with that some more.

Jack002, my backlog of 3D work is #1 Battleship, maybe with Subs... airplanes too?
#2 The thing STxAxTIC suggested, flying through space with orbiting spheres
#3 Hexagon Life... hmm don't hold your breath ;)

PS line 87 is useless as I redraw all cells on each loop, I just noticed it still in there today. It was a carry over from experimenting with code.

[SierraKen]

Pretty cool B+, would be a good simulator for a Biology course.

[bplus]

Hi Ken,

I've a feeling that math teachers would be far more receptive to this than biology teachers.

[Jack002]

This makes me think of the game Othello. There have also been some basic programs that imitate that as well.

[bplus]

This makes me think of the game Othello. There have also been some basic programs that imitate that as well.

Othello, not same as Reversi of which I have a copy qbguy's which comes from QB samples according to first line in it. But this version starts with 4 in middle as Othello is supposed to...
Well that is played on square board with square cells moving one piece at a time.

Not like Life "Game" which is not a game in the same sense as these human games with winners and losers and with player skill or luck.

Yeah bplus rather play inhuman games with the gods or aliens take your pick ;-))

[Jack002]

I love this game. I keep playing it and playing it. Hex shapes seem more pleasing to the eye than the square ones.

[bplus]

Here is the colorized version using neighbor counts to decide the colors, yellow are neighbor counts of 1 = survival using TempodiBasic rules which are better I think than my first post. White are cells with 2 neighbors = birth or survival.

Turns out I confused Conway's Life rules, there it was 3 neighbors for birth or survival and 2 for survival.

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus started 2019-09-23 from Hex Minesweeper Custom Field
2. '2019-09-25 post with original Life Rules
3. '2019-09-27 OK let's try some more color!
4.  
5. DEFINT A-Z
6. CONST cellR = 10 ' which makes the following constant
7. CONST xspacing! = 2 * cellR * COS(_D2R(30))
8. CONST yspacing! = cellR * (1 + SIN(_D2R(30)))
9.  
10. TYPE cell
11.     x AS INTEGER
12.     y AS INTEGER
13.     L AS INTEGER
14. END TYPE
15. DIM SHARED k(6) AS _UNSIGNED LONG
16. k(0) = &HFF000000: k(1) = &HFFFFFF00: k(2) = &HFFFFFFFF: k(3) = &HFF00BBBB: k(4) = &HFF008800: k(5) = &HFF000066: k(6) = &HFFFF0000
17. DIM SHARED xmax, ymax, Xarrd, Yarrd 'set all this in customField sub
18.  
19.  
20. '      note: To preserve symmetry when cells hit boundries with a symmetric seed started in middle:
21. '            y should be odd for 1 cell center x axis, on a shorter inner row
22. '            If x is odd then one cell is marked in center.
23. '            If x is even the left one of two center cells will be marked, toggle the one to right also.
24.  
25. Xarrd = 41 ' the top left cell has been hacked to duplicate the top right cell, to preserve symmetric seeds through a run
26.  
27. Yarrd = 41 'y should always be odd top preserve symmetry of center symmetric seed
28.  
29. xmax = (Xarrd + 2) * xspacing!: ymax = (Yarrd + 2) * yspacing!
30.  
31. SCREEN _NEWIMAGE(xmax, ymax, 32)
32. _SCREENMOVE (1280 - xmax) / 2 + 60, (760 - ymax) / 2
33. RANDOMIZE TIMER
34. DIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS cell, ng(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS INTEGER 'oversize the board to make it easy to count
35.  
36. DIM x, y, xoffset!, xStop, nc, c, r, mb, kh&
37.  
38. DO
39.     _TITLE "Hexagon Life: Left Click to Toggle Cells On/Off, Right Click to Start Run, Escape to Quit"
40.     ' set x, y for cells and mark ceter cell(s)
41.     FOR y = 1 TO Yarrd
42.         IF y MOD 2 = 0 THEN
43.             xoffset! = .5 * xspacing!: xStop = Xarrd - 1
44.         ELSE
45.             xoffset! = 0: xStop = Xarrd
46.         END IF
47.         FOR x = 1 TO xStop
48.             b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing!
49.             b(x, y).y = y * yspacing! + .5 * yspacing!
50.             IF x = INT(Xarrd / 2 + .5) AND y = INT(Yarrd / 2 + .5) THEN b(x, y).L = 1 ELSE b(x, y).L = 0 'mark middle cell
51.             showCell x, y, 7
52.         NEXT
53.     NEXT
54.     _DISPLAY
55.  
56.     'setup seed by toggling cells on and off
57.     WHILE mb <> 2
58.         kh& = _KEYHIT
59.         IF kh& = 27 THEN EXIT DO
60.         mb = 0: c = 0: r = 0
61.         getCell c, r, mb
62.         IF mb = 1 THEN
63.             b(c, r).L = 1 - b(c, r).L
64.             showCell c, r, 7
65.         END IF
66.         _DISPLAY
67.         _LIMIT 60
68.     WEND
69.     mb = 0
70.     _TITLE "Hexagon Life: Spacebar to Restart/Reseed, Escape to Quit"
71.     WHILE kh& <> 32 AND kh& <> 27
72.         kh& = _KEYHIT
73.         'count the neighbors
74.         FOR y = 1 TO Yarrd
75.             IF y MOD 2 = 0 THEN
76.                 xoffset! = .5 * xspacing!: xStop = Xarrd - 1
77.             ELSE
78.                 xoffset! = 0: xStop = Xarrd
79.             END IF
80.             FOR x = 1 TO xStop
81.                 '2 sets of neighbors depending if x offset or not
82.                 IF xoffset! > .05 THEN
83.                     nc = b(x, y - 1).L + b(x + 1, y - 1).L + b(x - 1, y).L
84.                     nc = nc + b(x + 1, y).L + b(x, y + 1).L + b(x + 1, y + 1).L
85.                 ELSE
86.                     nc = b(x - 1, y - 1).L + b(x, y - 1).L + b(x - 1, y).L
87.                     nc = nc + b(x + 1, y).L + b(x - 1, y + 1).L + b(x, y + 1).L
88.                 END IF
89.                 'originally tested and posted( 9/25/2019) here only 2 neighbors for birth in Classic Life it takes 3
90.                 'IF (nc = 3 AND b(x, y).L = 1) OR nc = 2 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
91.  
92.                 'TempodiBasic suggested this survival if 1 survival or surviaval and birth for 2 neighbors
93.                 IF (nc = 1 AND b(x, y).L = 1) OR nc = 2 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
94.  
95.                 ' my first test for TempodiBasic, I mistakenly ran this which is good too!
96.                 'IF (nc = 3 AND b(x, y).L = 1) OR nc = 1 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
97.  
98.                 showCell x, y, nc
99.                 IF x = Xarrd AND y = 1 THEN showCell 1, 1, nc
100.             NEXT
101.         NEXT
102.  
103.         'redraw all cells so no CLS
104.         FOR y = 1 TO Yarrd 'transfer data from ng to b().l and show cell
105.             IF y MOD 2 = 0 THEN
106.                 xStop = Xarrd - 1
107.             ELSE
108.                 xStop = Xarrd
109.             END IF
110.             FOR x = 1 TO xStop
111.                 b(x, y).L = ng(x, y)
112.                 'showCell x, y
113.             NEXT
114.             'fix symmetry for top left corner, match x at other end for bi-lat symmetry
115.             b(1, 1).L = b(Xarrd, 1).L
116.             'showCell 1, 1
117.         NEXT
118.         _DISPLAY
119.         _LIMIT 2
120.     WEND
121.     IF kh& = 27 THEN EXIT DO
122.     kh& = 0
123. LOOP
124.  
125. SUB showCell (c, r, kNum)
126.     DIM da, x!, y!, lastx!, lasty!, clr AS _UNSIGNED LONG
127.     IF r MOD 2 = 0 THEN
128.         IF c < 1 OR c > Xarrd - 1 THEN EXIT SUB
129.     ELSE
130.         IF c < 1 OR c > Xarrd THEN EXIT SUB
131.     END IF
132.     IF r < 1 OR r > Yarrd THEN EXIT SUB
133.  
134.     IF kNum = 7 THEN
135.         IF b(c, r).L = 1 THEN clr = &HFFFFFFFF ELSE clr = &HFF000000
136.     ELSE
137.         clr = k(kNum)
138.     END IF
139.     lastx! = b(c, r).x + cellR * COS(_D2R(-30))
140.     lasty! = b(c, r).y + cellR * SIN(_D2R(-30))
141.     FOR da = 30 TO 330 STEP 60
142.         x! = b(c, r).x + cellR * COS(_D2R(da))
143.         y! = b(c, r).y + cellR * SIN(_D2R(da))
144.         IF kNum < 7 THEN LINE (lastx!, lasty!)-(x!, y!), clr ELSE LINE (lastx!, lasty!)-(x!, y!), &HFF440044
145.         lastx! = x!: lasty! = y!
146.     NEXT
147.     IF kNum < 7 THEN PAINT (b(c, r).x, b(c, r).y), clr, clr ELSE PAINT (b(c, r).x, b(c, r).y), clr, &HFF440044
148.  
149.     'debug
150.     'cText b(c, r).x, b(c, r).y, 16, &HFF888888, STR$(c) + "," + STR$(r)
151. END SUB
152.  
153. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
154.     DIM m, mx, my, mb1, mb2, r, c
155.     WHILE _MOUSEINPUT: WEND
156.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
157.     IF mb1 THEN mbNum = 1
158.     IF mb2 THEN mbNum = 2
159.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
160.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
161.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
162.             mx = _MOUSEX: my = _MOUSEY
163.             'LOCATE 1, 1: PRINT SPACE$(50)
164.             'LOCATE 1, 1: PRINT mx, my, .5 * xspacing!
165.             _DISPLAY
166.         WEND
167.         FOR r = 1 TO Yarrd
168.             FOR c = 1 TO Xarrd
169.                 IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xspacing! THEN
170.                     returnCol = c: returnRow = r: EXIT SUB
171.                 END IF
172.             NEXT
173.         NEXT
174.         mbNum = 0 'still here then clicked wrong
175.     END IF
176. END SUB
177.  
178. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
179.     DIM a&
180.     a& = _NEWIMAGE(1, 1, 32)
181.     _DEST a&
182.     PSET (0, 0), K
183.     _DEST 0
184.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
185.     _FREEIMAGE a& '<<< this is important!
186. END SUB
187.  
188. 'debug
189. SUB cText (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
190.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
191.     fg = _DEFAULTCOLOR
192.     'screen snapshot
193.     cur& = _DEST
194.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
195.     _DEST I&
196.     COLOR K, _RGBA32(0, 0, 0, 0)
197.     _PRINTSTRING (0, 0), txt$
198.     mult = textHeight / 16
199.     xlen = LEN(txt$) * 8 * mult
200.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
201.     COLOR fg
202.     _FREEIMAGE I&
203. END SUB
204.  
205.  

I just watched an episode of Ancient Aliens "The Guardian of the Badlands" jeez these people see faces everywhere and I have been abducted and programmed to share with you this code ;-))

 

BTW I have ftri code in to fix the messy lines and paint jobs but haven't gotten to it yet.

[bplus]

Cleaned up the Hexagon drawing, changed colors and spent sometime trying to figure out how I seeded the previous screen shot?? stumped on that one!

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus started 2019-09-23 from Hex Minesweeper Custom Field
2. '2019-09-25 post with original Life Rules
3. '2019-09-27 OK let's try some more color!
4. '2019-09-28 fix hexagon fills by not using PAINT
5.  
6. CONST cellR = 10 ' which makes the following constant
7. CONST xSpacing = 2 * cellR * COS(_D2R(30))
8. CONST ySpacing = cellR * (1 + SIN(_D2R(30)))
9.  
10. TYPE cell
11.     x AS INTEGER
12.     y AS INTEGER
13.     L AS INTEGER
14. END TYPE
15. DIM SHARED k(6) AS _UNSIGNED LONG
16. k(0) = &HFF000000: k(1) = &HFFFFFF88: k(2) = &HFFDDDDFF: k(3) = &HFF550033: k(4) = &HFF005500: k(5) = &HFF000044: k(6) = &HFFFF0000
17. DIM SHARED xmax AS INTEGER, ymax AS INTEGER, Xarrd AS INTEGER, Yarrd AS INTEGER 'set all this in customField sub
18.  
19.  
20. '      note: To preserve symmetry when cells hit boundries with a symmetric seed started in middle:
21. '            y should be odd for 1 center row
22. '            x should be equal to or less than y
23. '            If int(x/2 + .5) is even then the right one of two center cells is marked else the one center cell is marked
24. '
25.  
26. Xarrd = 41 ' the top left cell has been hacked to duplicate the top right cell, to preserve symmetric seeds through a run
27.  
28. Yarrd = 41 'y should always be odd top preserve symmetry of center symmetric seed
29.  
30. xmax = (Xarrd + 2) * xSpacing: ymax = (Yarrd + 2) * ySpacing
31.  
32. SCREEN _NEWIMAGE(xmax, ymax, 32)
33. _SCREENMOVE (1280 - xmax) / 2 + 60, (760 - ymax) / 2
34. RANDOMIZE TIMER
35. DIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS cell, ng(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS INTEGER 'oversize the board to make it easy to count
36.  
37. DIM x AS INTEGER, y AS INTEGER, xoffset, xStop AS INTEGER, nc AS INTEGER, c AS INTEGER, r AS INTEGER, mb AS INTEGER, kh&
38.  
39. DO
40.     _TITLE "Hexagon Life: Left Click to Toggle Cells On/Off, Right Click to Start Run, Escape to Quit"
41.     ' set x, y for cells and mark ceter cell(s)
42.     FOR y = 1 TO Yarrd
43.         IF y MOD 2 = 0 THEN
44.             xoffset = .5 * xSpacing: xStop = Xarrd - 1
45.         ELSE
46.             xoffset = 0: xStop = Xarrd
47.         END IF
48.         FOR x = 1 TO xStop
49.             b(x, y).x = x * xSpacing + xoffset + .5 * xSpacing
50.             b(x, y).y = y * ySpacing + .5 * ySpacing
51.             IF x = INT(Xarrd / 2 + .5) AND y = INT(Yarrd / 2 + .5) THEN b(x, y).L = 1 ELSE b(x, y).L = 0 'mark middle cell
52.             showCell x, y, 7
53.         NEXT
54.     NEXT
55.     _DISPLAY
56.  
57.     'setup seed by toggling cells on and off
58.     WHILE mb <> 2
59.         kh& = _KEYHIT
60.         IF kh& = 27 THEN EXIT DO
61.         mb = 0: c = 0: r = 0
62.         getCell c, r, mb
63.         IF mb = 1 THEN
64.             b(c, r).L = 1 - b(c, r).L
65.             showCell c, r, 7
66.         END IF
67.         _DISPLAY
68.         _LIMIT 60
69.     WEND
70.     mb = 0
71.     _TITLE "Hexagon Life: Spacebar to Restart/Reseed, Escape to Quit"
72.     WHILE kh& <> 32 AND kh& <> 27
73.         kh& = _KEYHIT
74.         'count the neighbors
75.         FOR y = 1 TO Yarrd
76.             IF y MOD 2 = 0 THEN
77.                 xoffset = .5 * xSpacing: xStop = Xarrd - 1
78.             ELSE
79.                 xoffset = 0: xStop = Xarrd
80.             END IF
81.             FOR x = 1 TO xStop
82.                 '2 sets of neighbors depending if x offset or not
83.                 IF xoffset > .05 THEN
84.                     nc = b(x, y - 1).L + b(x + 1, y - 1).L + b(x - 1, y).L
85.                     nc = nc + b(x + 1, y).L + b(x, y + 1).L + b(x + 1, y + 1).L
86.                 ELSE
87.                     nc = b(x - 1, y - 1).L + b(x, y - 1).L + b(x - 1, y).L
88.                     nc = nc + b(x + 1, y).L + b(x - 1, y + 1).L + b(x, y + 1).L
89.                 END IF
90.                 'originally tested and posted( 9/25/2019) here only 2 neighbors for birth in Classic Life it takes 3
91.                 'IF (nc = 3 AND b(x, y).L = 1) OR nc = 2 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
92.  
93.                 'TempodiBasic suggested this survival if 1 survival or surviaval and birth for 2 neighbors
94.                 IF (nc = 1 AND b(x, y).L = 1) OR nc = 2 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
95.  
96.                 ' my first test for TempodiBasic, I mistakenly ran this which is good too!
97.                 'IF (nc = 3 AND b(x, y).L = 1) OR nc = 1 THEN ng(x, y) = 1 ELSE ng(x, y) = 0
98.  
99.                 showCell x, y, nc
100.                 IF x = Xarrd AND y = 1 THEN showCell 1, 1, nc
101.             NEXT
102.         NEXT
103.  
104.         'redraw all cells so no CLS
105.         FOR y = 1 TO Yarrd 'transfer data from ng to b().l and show cell
106.             IF y MOD 2 = 0 THEN
107.                 xStop = Xarrd - 1
108.             ELSE
109.                 xStop = Xarrd
110.             END IF
111.             FOR x = 1 TO xStop
112.                 b(x, y).L = ng(x, y)
113.                 'showCell x, y
114.             NEXT
115.             'fix symmetry for top left corner, match x at other end for bi-lat symmetry
116.             b(1, 1).L = b(Xarrd, 1).L
117.             'showCell 1, 1
118.         NEXT
119.         _DISPLAY
120.         _LIMIT 1
121.     WEND
122.     IF kh& = 27 THEN EXIT DO
123.     kh& = 0
124. LOOP
125.  
126. SUB showCell (c AS INTEGER, r AS INTEGER, kNum AS INTEGER)
127.     DIM clr AS _UNSIGNED LONG
128.     IF r MOD 2 = 0 THEN
129.         IF c < 1 OR c > Xarrd - 1 THEN EXIT SUB
130.     ELSE
131.         IF c < 1 OR c > Xarrd THEN EXIT SUB
132.     END IF
133.     IF r < 1 OR r > Yarrd THEN EXIT SUB
134.     IF kNum = 7 THEN
135.         IF b(c, r).L = 1 THEN clr = &HFFFFFFFF ELSE clr = &HFF000000
136.     ELSE
137.         clr = k(kNum)
138.     END IF
139.     IF kNum < 7 THEN
140.         fHexH b(c, r).x, b(c, r).y, cellR, clr
141.         hexH b(c, r).x, b(c, r).y, cellR, &HFF000000
142.     ELSE
143.         fHexH b(c, r).x, b(c, r).y, cellR, clr
144.         hexH b(c, r).x, b(c, r).y, cellR, &HFF440044
145.     END IF
146. END SUB
147.  
148. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
149.     DIM m, mx, my, mb1, mb2, r AS INTEGER, c AS INTEGER
150.     WHILE _MOUSEINPUT: WEND
151.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
152.     IF mb1 THEN mbNum = 1
153.     IF mb2 THEN mbNum = 2
154.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
155.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
156.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
157.             mx = _MOUSEX: my = _MOUSEY
158.             'LOCATE 1, 1: PRINT SPACE$(50)
159.             'LOCATE 1, 1: PRINT mx, my, .5 * xSpacing
160.             _DISPLAY
161.         WEND
162.         FOR r = 1 TO Yarrd
163.             FOR c = 1 TO Xarrd
164.                 IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xSpacing THEN
165.                     'LOCATE 1, 1: PRINT SPACE$(50)
166.                     'LOCATE 1, 1: PRINT c, r
167.                     returnCol = c: returnRow = r: EXIT SUB
168.                 END IF
169.             NEXT
170.         NEXT
171.         mbNum = 0 'still here then clicked wrong
172.     END IF
173. END SUB
174.  
175. 'draw Hexagon Outline that can be packed Horizontally, flat edge to flat edge
176. SUB hexH (xOrigin AS SINGLE, yOrigin AS SINGLE, radius AS SINGLE, c AS _UNSIGNED LONG)
177.     DIM polyAngle AS SINGLE, aOff AS SINGLE, x1 AS SINGLE, y1 AS SINGLE, i AS INTEGER, x2 AS SINGLE, y2 AS SINGLE
178.     polyAngle = _PI(2) / 6: aOff = _PI / 2
179.     x1 = xOrigin + radius * COS(polyAngle + aOff)
180.     y1 = yOrigin + radius * SIN(polyAngle + aOff)
181.     FOR i = 2 TO 7
182.         x2 = xOrigin + radius * COS(i * polyAngle + aOff)
183.         y2 = yOrigin + radius * SIN(i * polyAngle + aOff)
184.         LINE (x1, y1)-(x2, y2), c
185.         x1 = x2: y1 = y2
186.     NEXT
187. END SUB
188.  
189. 'draw filled Hexagon that can be packed Horizontally, flat edge to flat edge
190. 'uses SUB fTri
191. SUB fHexH (xOrigin AS SINGLE, yOrigin AS SINGLE, radius AS SINGLE, c AS _UNSIGNED LONG)
192.     DIM polyAngle AS SINGLE, aOff AS SINGLE, x1 AS SINGLE, y1 AS SINGLE, i AS INTEGER, x2 AS SINGLE, y2 AS SINGLE
193.     polyAngle = _PI(2) / 6: aOff = _PI / 2
194.     x1 = xOrigin + radius * COS(polyAngle + aOff)
195.     y1 = yOrigin + radius * SIN(polyAngle + aOff)
196.     FOR i = 2 TO 7
197.         x2 = xOrigin + radius * COS(i * polyAngle + aOff)
198.         y2 = yOrigin + radius * SIN(i * polyAngle + aOff)
199.         fTri xOrigin, yOrigin, x1, y1, x2, y2, c
200.         x1 = x2: y1 = y2
201.     NEXT
202. END SUB
203.  
204. SUB fTri (x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, K AS _UNSIGNED LONG)
205.     DIM a&
206.     a& = _NEWIMAGE(1, 1, 32)
207.     _DEST a&
208.     PSET (0, 0), K
209.     _DEST 0
210.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
211.     _FREEIMAGE a& '<<< this is important!
212. END SUB
213.  
214.  

[TempodiBasic]

Hi Bplus I think that both the model with original rules both that you have coded following my suggestion suffer of overpopulation!

However I find 2 seed for the same permanent entity!

 

[bplus]

Yeah, I don't know how well explored Hexagon Life is compared to Classic Conway Life action at the boundary lines is not as neat as with Classic because of 6 way symmetry versus 4 way of Classic so maybe the playing field needs to be hexagonal also? How about Hexagonal arrays to hold the data also!?!

But you might run into some of the same problems if the square or rectangular cells were stagger-stacked like bricks.

I wonder if there exist a set of rules for Hexagonal Life that would yield the equivalent of a glider gun or something equally as amazing. I have noticed that stable blinkers usually cycle in multiples of 3, like the one TempodiBasic is showing.

[bplus]

Face maker seeds,

[SierraKen]

LOL this one is much better! After around 30 seconds or so it filled the entire screen. :) You also might want to add in the _TITLE "Generations: "+g  where g is how many times they multiply. Really cool. Or you can use a different word than Generations.