Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on September 25, 2019, 09:01:12 am

Title: Hexagonal Life
Post by: bplus on September 25, 2019, 09:01:12 am
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
  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
  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.  
  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
  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)
  130.  
  131. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
  132.     DIM m, mx, my, mb1, mb2, r, c
  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
  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&
  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.
Title: Re: Hexagonal Life
Post by: TempodiBasic on September 25, 2019, 10:01:55 am
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.
Title: Re: Hexagonal Life
Post by: Jack002 on September 25, 2019, 10:13:41 am
Very cool! now on to 3d hex life, 4d hex life. Really nice job B+
Title: Re: Hexagonal Life
Post by: bplus on September 25, 2019, 03:40:54 pm
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.
Title: Re: Hexagonal Life
Post by: SierraKen on September 25, 2019, 03:59:06 pm
Pretty cool B+, would be a good simulator for a Biology course.
Title: Re: Hexagonal Life
Post by: bplus on September 25, 2019, 06:26:55 pm
Hi Ken,

I've a feeling that math teachers would be far more receptive to this than biology teachers.
Title: Re: Hexagonal Life
Post by: Jack002 on September 26, 2019, 11:12:59 am
This makes me think of the game Othello. There have also been some basic programs that imitate that as well.
Title: Re: Hexagonal Life
Post by: bplus on September 26, 2019, 11:35:32 am
Quote from: Jack002 on September 26, 2019, 11:12:59 am
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 ;-))
Title: Re: Hexagonal Life
Post by: Jack002 on September 27, 2019, 08:49:36 pm
I love this game. I keep playing it and playing it. Hex shapes seem more pleasing to the eye than the square ones.
Title: Re: Hexagonal Life
Post by: bplus on September 27, 2019, 10:18:03 pm
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
  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
  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.  
  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
  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)
  152.  
  153. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
  154.     DIM m, mx, my, mb1, mb2, r, c
  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
  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!
  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&
  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.
Title: Re: Hexagonal Life
Post by: bplus on September 28, 2019, 04:26:32 pm
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
  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
  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.  
  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
  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
  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
  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
  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
  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
  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!
  213.  
  214.  
 [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Hexagonal Life
Post by: TempodiBasic on September 29, 2019, 03:18:50 pm
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!

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Hexagonal Life
Post by: bplus on September 30, 2019, 11:03:07 am
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.
Title: Re: Hexagonal Life
Post by: bplus on September 30, 2019, 12:00:18 pm
Face maker seeds,

Title: Re: Hexagonal Life
Post by: SierraKen on September 30, 2019, 03:33:30 pm
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.
Title: Re: Hexagonal Life
Post by: bplus on September 30, 2019, 04:21:46 pm
Quote from: SierraKen on September 30, 2019, 03:33:30 pm
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.

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

Ha! I am finding faces everywhere today (not exactly human but...) ;-))


Title: Re: Hexagonal Life
Post by: TempodiBasic on September 30, 2019, 05:30:01 pm
Yes you can find so many faces... but too fast to be catched by a screenshot

here more permanent blinker
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Text Only | Text with Attachments