Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Thunderbird Methuselah (Game of Life)
#1
             
click each image to zoom in

CONWAY'S GAME OF LIFE
 Just a quick conversion to N7 

 Reference :
 "Thunderbird" methuselah evolution in the Game of Life
 https://rosettacode.org/wiki/Conway%27s_...e#BASIC256


Code:
'==============================================================
' CONWAY'S GAME OF LIFE
' Just a quick conversion to N7 
'
' Reference :
' "Thunderbird" methuselah evolution in the Game of Life
' https://rosettacode.org/wiki/Conway%27s_Game_of_Life#BASIC256
'==============================================================

'set window
#win32
set window "Game of Life",236,140,true
set redraw off

'color definition
black   = [0,0,0]
white   = [255,255,255]
purple  = [128,0,128]
green   = [0,255,0]
red     = [255,0,0]
yellow  = [255,255,0]

X = 59 ; Y = 35 ; H = 4

c = dim(X,Y)
cn = dim(X,Y)
cl = dim(X,Y)

'Thunderbird methuselah pattern
c[X/2-1][Y/3+1] = 1
c[X/2][Y/3+1]   = 1 
c[X/2+1][Y/3+1] = 1   
c[X/2][Y/3+3]   = 1
c[X/2][Y/3+4]   = 1
c[X/2][Y/3+5]   = 1

'initial value
s = 0
start = 1

'main loop
do
    'clear screen
    set color black
    cls
   
    alive = 0 
    stable = 1
    s = s + 1
   
    for y = 0 to Y-1
        for x = 0 to X-1
            xm1 = (x-1+X)%X
            xp1 = (x+1+X)%X
            ym1 = (y-1+Y)%Y
            yp1 = (y+1+Y)%Y
            cn[x][y] = c[xm1][y] + c[xp1][y]
            cn[x][y] = c[xm1][ym1] + c[x][ym1] + c[xp1][ym1] + cn[x][y]
            cn[x][y] = c[xm1][yp1] + c[x][yp1] + c[xp1][yp1] + cn[x][y]
           
            if c[x][y] = 1 then
                if cn[x][y] < 2 or cn[x][y] > 3 then
                    cn[x][y] = 0
                else
                    cn[x][y] = 1
                    alive = alive + 1
                endif
            else
                if cn[x][y] = 3 then
                    cn[x][y] = 1
                    alive = alive + 1
                else
                    cn[x][y] = 0
                endif
            endif
           
            if c[x][y] then
                if cn[x][y] then
                    if cl[x][y] then
                        set color purple        # adult
                    endif
                    if not cl[x][y] then
                        set color green         # newborn
                    endif
                else
                    if cl[x][y] then
                        set color red           # old
                    endif
                    if not cl[x][y] then
                        set color yellow        # shortlived
                    endif
                endif
               
                draw rect x*H,y*H,H,H,true
               
            endif
           
        next
    next
   
    redraw
    fwait 10
   
    # Copy arrays
    for i = 0 to X-1
        for j = 0 to Y-1
            if cl[i][j]<>cn[i][j] then stable = 0
            cl[i][j] = c[i][j]
            c[i][j] = cn[i][j]
        next
    next   
   
    if start then
        set color white
        set caret width()/2, height()-15
        center "Press Enter to Continue"
        redraw
        do;wait 1;until keydown(KEY_RETURN,true)
        start = false
    endif   
   
until not alive or stable

'final message
set color white
set caret width()/2,height()-15
if not alive then
    center "Died in "+s+" iterations"
else
    center "Stabilized in "+(s-2)+" iterations"   
endif
redraw

'Escape to quit
do;wait 1;until keydown(KEY_ESCAPE,true)
Reply


Messages In This Thread
Thunderbird Methuselah (Game of Life) - by 1micha.elok - 01-17-2025, 11:22 AM

Forum Jump:


Users browsing this thread: 2 Guest(s)