Conway's Game of Life: Difference between revisions

Line 10,704:

You can run this online [http://phix.x10.mx/p2js/conways_game_of_life.htm here].

-- demo\rosetta\Conways_Game_of_Life.exw

--

-- demo\rosetta\Conways_Game_of_Life.exw

-- =====================================

--

with javascript_semantics

include pGUI.e

~~Ihandle~~ ~~dlg~~, ~~canvas,~~ ~~<span~~ ~~style=~~"~~color: #000000;">hTimer~~

constant title = "Conway's Game of Life"

~~cdCanvas~~ ~~cddbuffer~~, ~~cdcanvas~~

Ihandle dlg, canvas

Ihandln hTimer = NULL

cdCanvas cddbuffer

sequence c = {}, -- cells

cn, -- new cells

cl -- last cells

procedure draw(integer what)

integer lx = length(c)

integer x = floor(length(c)/2)+1,

~~integer~~ ly = length(c[1])

y = floor(length(c[1])/2)

integer x = floor(lx/2)

integer y = floor(ly/2)

switch what do

case ' ' : -- Clear

case ' ': c = sq_mul(c,0) -- Clear

c = ~~sq_mul~~(c,0)

case '+': c[x][y-1..y+1] = repeat(1,3) -- Blinker

case '+' : -- ~~Blinker~~

case 'G': { c[x+1,y+4],

~~<span~~ ~~style="color:~~ ~~#0000FF;">{~~c[x-1,y],c[~~<span~~ ~~style="color:~~ ~~#000000;">x<span~~ ~~style="color:~~ ~~#0000FF;">,<span~~ ~~style="color:~~ ~~#000000;">y<span~~ ~~style="color:~~ ~~#0000FF;">],~~c[x+1,y~~]} = {~~1,1,1,1}

c[x+2,y+2], c[x+2,y+4],

c[x+3,y+3], c[x+3,y+4]} = repeat(1,5) -- Glider

case 'G' : -- Glider

{ c[x+1,y+4],

case 'T': {c[x-1,y+1],c[x,y+1],c[x+1,y+1],

c[x+2,y+2], c[x+2,y+4],

c[x ,y+3],c[x,y+4],c[x ,y+5]} = repeat(1,6) -- Thunderbird

c~~<span~~ ~~style="color: #0000FF;">[~~x~~+3~~~~<span~~ ~~style="color: #0000FF;">,~~y~~<span~~ ~~style="color: #0000FF;">+~~3~~],c[~~x~~<span~~ ~~style="color: #0000FF;">+~~3~~<span~~ ~~style="color: #0000FF;">,~~y+~~4]} = {1~~,1,1~~<span~~ ~~style="color: #0000FF;">,~~1,1}

case 'X': for i=0 to min(x,y)-1 do

{c[x-i,y+i],c[x+i,y+i],

case 'T' : -- Thunderbird

~~<span~~ ~~style="color:~~ ~~#0000FF;">{~~c[x-1,y+1],c[x,y+1],c[x+1,y+1],

c[x-i,y-i],c[x+i,y-i]} = repeat(1,4) -- Cross

end for

c[x,y+3],c[x,y+4],c[x,y+5]} = {1,1,1,1,1,1}

case 'X' : -- Cross

for x=2 to lx-1 do

y = floor(ly*x/lx)

if y>1 then

{c[x,y],c[x,ly-y]} = {1,1}

end if

end for

end switch

end procedure

atom t0 = time()

atom t1 = time()+1

integer fps = 0

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)

~~integer~~ ~~{~~~~width~~, ~~height}~~ = <span~~ style~~="color~~: ~~#7060A8~~;">~~IupGetIntInt<~~/~~span>(<~~/~~span>canvas, "DRAWSIZE")

function redraw_cb(Ihandle /*ih*/)

integer ~~colour~~, ~~cnxy~~, ~~live~~, ~~alive~~ = 0

integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE"),

-- limit to 10K cells (performance target of 10fps)

if length(c)!=height

-- n here is the cell size in pixels (min of 1x1)

or length(c[1])!=width then

c = ~~repeat~~(~~repeat~~(0,height),~~width~~)

n = ceil(sqrt(width*height/10000)),

cn = c

w = floor(width/n)+2, -- (see cx below)

cl = c

h = floor(height/n)+2,

alive = 0

-- keep w, h odd for symmetry (plus I suspect the

-- "Cross" code above may now crash without this)

w -= even(w)

h -= even(h)

if length(c)!=w

or length(c[1])!=h then

c = repeat(repeat(0,h),w)

cn = deep_copy(c)

cl = deep_copy(c)

draw('X')

if hTimer!=NULL then

IupStoreAttribute(hTimer, "RUN", "YES")

end if

cdCanvasActivate(cddbuffer)

--

for y=2 to height-1 do

-- There is a "dead border" of 1 cell all around the edge of c (etc) which

for x=2 to width-1 do

-- we never display or update. If we have got this right/an exact fit, then

integer xm1 = x-1, xp1 = x+1,

-- w*n should be exactly 2n too wide, whereas in the worst case there is an

ym1 = y-1, yp1 = y+1

-- (2n-1) pixel border, which we split between left and right, ditto cy.

cnxy = c[xm1,ym1] + c[x,ym1] + c[xp1,ym1] +

--

c[xm1,y] + c[xp1,y] +

c~~<span~~ ~~style="color: #0000FF;">[~~~~xm1~~~~<span~~ ~~style="color: #0000FF;">,yp1~~~~] +~~ c[x,~~yp1~~] ~~+~~ c[~~xp1~~,~~yp1~~]

integer cx = n+floor((width-w*n)/2)

if c[x,y]=1 ~~then~~

for x=2 to w-1 do

~~live~~ = (~~cnxy~~>=2 ~~and~~ ~~cnxy~~<=3)

integer cy = n+floor((height-h*n)/2)

for y=2 to h-1 do

else

~~live~~ = (~~cnxy~~=3)

integer cxy = c[x,y],

~~end~~ if

clxy = cl[x,y],

cnxy = -cxy

for i=x-1 to x+1 do

for j=y-1 to y+1 do

cnxy += c[i,j]

end for

integer live = iff(cxy?cnxy>=2 and cnxy<=3:cnxy==3),

colour = iff(live?iff(cxy?iff(clxy?CD_PURPLE -- adult

:CD_GREEN) -- newborn

:iff(clxy?CD_RED -- old

:CD_YELLOW)) -- shortlived

:CD_BLACK)

cn[x,y] = live

alive += live

if ~~live~~ ~~then~~

cdCanvasSetForeground(cddbuffer,colour)

if c[x,y] ~~then~~

cdCanvasBox(cddbuffer, cx, cx+n-1, cy, cy+n-1)

~~colour~~ = ~~iff(~~cl[x,y]?CD_PURPLE -- adult

cy += n

:CD_GREEN) -- newborn

else

colour = iff(cl[x,y]?CD_RED -- old

:CD_YELLOW) -- shortlived

end if

else

colour = CD_BLACK

end if

cdCanvasPixel(cddbuffer, x, y, colour)

end for

cx += n

end for

cdCanvasFlush(cddbuffer)

Line 10,787:

Line 10,803:

IupStoreAttribute(hTimer, "RUN", "NO")

IupStoreAttribute(dlg, "TITLE", "died")

-- elsif cl=cn then -- (made blinker stable)

elsif c=cn then

IupStoreAttribute(hTimer, "RUN", "NO")

Line 10,793:

Line 10,808:

else

cl = c

c = cn

c = deep_copy(cn)

~~IupSetStrAttribute(~~~~dlg,~~ ~~"TITLE"~~~~, "%3.2f",~~ ~~{time()-~~~~t0})~~

fps += 1

if time()>=t1 then

IupSetStrAttribute(dlg,"TITLE","%s (%d FPS)",{title,fps})

t1 = time()+1

fps = 0

end if

return IUP_DEFAULT

end function

function map_cb(Ihandle ih)

cdcanvas = cdCreateCanvas(CD_IUP, ih)

cdCanvas cdcanvas = cdCreateCanvas(CD_IUP, ih)

cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)

cdCanvasSetBackground(cddbuffer, CD_WHITE)

Line 10,806:

Line 10,826:

return IUP_DEFAULT

end function

function key_cb(Ihandle /*ih*/, atom c)

if c=K_ESC then return IUP_CLOSE end if -- (standard practice for me)

if c=K_F5 then return IUP_DEFAULT end if -- (let browser reload work)

if find(c," ") then draw(' ') -- Clear

elsif find(c,"+bB") then draw('+') -- Blinker

Line 10,815:

Line 10,837:

end if

IupStoreAttribute(hTimer, "RUN", "YES")

IupStoreAttribute(dlg, "TITLE", "Life")

if c=K_ESC then return IUP_CLOSE end if

return IUP_CONTINUE

end function

function timer_cb(Ihandle /*ih*/)

IupUpdate(canvas)

return IUP_IGNORE

end function

procedure main()

IupOpen()

canvas = IupCanvas("RASTERSIZE=390x390")

canvas = ~~IupCanvas~~(~~NULL~~)

IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),

~~<span~~ ~~style="color:~~ ~~#7060A8;">IupSetAttribute~~~~(canvas~~, ~~"RASTERSIZE"~~, "~~200x200~~")~~ -- initial size~~

"ACTION", Icallback("redraw_cb")})

~~IupSetCallback~~(~~canvas~~, ~~"MAP_CB"~~, ~~Icallback~~("~~map_cb~~"))

dlg = IupDialog(canvas,`TITLE="%s", MINSIZE=350x55`, {title})

-- (above MINSIZE prevents the title from getting squished)

dlg = ~~IupDialog~~(~~canvas~~)

IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))

~~IupSetAttribute~~(dlg~~, "TITLE", "Conway's Game of Life"~~)

IupShow(dlg)

~~IupSetCallback~~(~~dlg~~, "~~K_ANY~~", ~~Icallback("key_cb"~~))

IupSetAttribute(canvas,"RASTERSIZE",NULL)

-- hTimer = IupTimer(Icallback("timer_cb"),40) -- 25fps (maybe)

IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

hTimer = IupTimer(Icallback("timer_cb"),100) -- 10fps

hTimer = IupTimer(Icallback("timer_cb"), 30)

IupMap(dlg)

IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation

IupShowXY(dlg,IUP_CENTER,IUP_CENTER)

if platform()!=JS then

IupMainLoop()

Line 10,847:

Line 10,862:

end if

end procedure

main()