( life day 14.05.2001 )

\ Conway's Game of Life

needs off>disp offscreen
needs plot graphics
needs random rnd
"os_events"

80 constant width
60 constant height

100 constant density
20  constant threshold

: world 
   create
     width height * allot
   does> ( x y addr ) swap width w* + +
;

world new
world old

: processEvt
  0 (ekey) drop
;

: doWorld ( xt )
   height 0 
   do width 0 
      do
        dup i j rot execute
      loop
      ProcessEvt
   loop drop
;

: print
   height 0 
   do width 0 
      do
        i j new c@ .
      loop
      cr
   loop
;

api: WinDrawRectangle

: cdraw ( x y )
   2* swap 2* swap 2 dup
   _rect rect!
   _rect >abs 0 WinDrawRectangle
;

: drawCell ( x y -- )
   2dup new c@ 0xf0 and
   if cdraw
   else 2drop
   then
;

: draw
  toOffWin
  WinEraseWindow
  ['] drawCell doWorld
  toDispWin
  0 0 160 140 Off>Disp
;

: ClearNew
   0 0 new height width * erase
;

: next
\ new -> old
   0 0 new
   0 0 old
   width height *
   cmove
;

: c+! ( c addr -- )
    tuck c@ + swap c!
;

: checkX
    swap dup 0< 
    if width + 
    else dup width = if drop 0 then
    then swap
;

: worldAddr ( x y -- addr )
    dup 0< 
    if height + 
       checkX
    else dup height = if drop 0 then
       checkX
    then new
;

: n+! ( addr c -- )
    over c@ + swap c!
;

: IncNeighbors ( x y c -- )
    >r 
    1- swap 1- swap
    over 1+ over
    over 1+ over
    2dup 1+ 
    2dup 1+
    over 1- over
    over 1- over
    2dup 1-
    worldAddr r@ n+!
    worldAddr r@ n+!
    worldAddr r@ n+!
    worldAddr r@ n+!  
    worldAddr r@ n+!
    worldAddr r@ n+!
    worldAddr r@ n+!
    worldAddr r> n+!
;

: growAge ( x y )
    new dup c@ 0xf0 and
    0xf0 <
    if 0x10 swap c+! else drop then
;

: born ( x y )
   2dup growAge
   1 IncNeighbors
;

: die ( x y )
   2dup new dup c@
   0xf and swap c!
   -1 IncNeighbors
;

: lifeCycle ( x y )
   2dup old c@
   dup 0xf0 and
   if \ alive
     0xf and dup 2 = swap 3 = or
     if growAge
     else die
     then
   else
     0xf and 3 =
     if born 
     else 2drop
     then
   then
;
   
: cycle
   ['] lifeCycle doWorld
;

: rndCell ( x y )
   density choose 
   threshold < 
   if born 
   else 2drop
   then
;

: ChooseLife
   ClearNew
   ['] rndCell  doWorld
;

: step
  begin
    0 150 atScreen
    TimGetTicks
    draw next cycle
    TimGetTicks swap - .
  again
;

: go
  width 2* height 2*
  initOffScr
  ChooseLife step
;

go