snake.fs

: not ( b -- b ) true xor ;
: myrand ( a b -- r ) over - utime + swap mod + ;

: snake-size 200 ;
: xdim 50 ;
: ydim 20 ;

create snake snake-size cells 2 * allot
create apple 2 cells allot
variable head
variable length
variable direction

: segment ( seg -- adr ) head @ + snake-size mod cells 2 * snake + ;
: pos+ ( x1 y1 x2 y2 -- x y ) rot + -rot + swap ;
: point= 2@ rot 2@ rot = -rot = and ;

: head* ( -- x y ) 0 segment ;
: move-head! ( -- ) head @ 1 - snake-size mod head ! ;
: grow! ( -- ) 1 length +! ;

: eat-apple! ( -- )  1 xdim myrand 1 ydim myrand apple 2! grow! ;
: step! ( xdiff ydiff -- ) head* 2@ move-head! pos+ head* 2! ;

: left  -1  0 ;
: right  1  0 ;
: down   0  1 ;
: up     0 -1 ;

: wall? ( -- bool ) head* 2@ 1 ydim within swap 1 xdim within and not ;
: crossing? ( -- bool ) false length @ 1 ?do i segment head* point= or loop ;
: apple? ( -- bool ) head* apple point= ;
: dead? wall? crossing? or ;

: draw-frame ( -- ) 0 0 at-xy xdim 0 ?do ." +" loop
 ydim 0 ?do xdim i at-xy ." +" cr ." +" loop xdim 0 ?do ." +" loop cr ;
: draw-snake ( -- ) length @ 0 ?do i segment 2@ at-xy ." #" loop ;
: draw-apple ( -- ) apple 2@ at-xy ." Q" ;

: render page draw-snake draw-apple draw-frame cr length @ . ;

: newgame!
  0 head ! xdim 2 / ydim 2 / snake 2! 3 3 apple 2! 3 length !
  ['] up direction ! left step! left step! left step! left step! ;

: gameloop
begin render 200 ms
key? if key
   dup 97 = if ['] left else
   dup 119 = if ['] up else
   dup 100 = if ['] right else
   dup 115 = if ['] down else direction @
   then then then then
  direction ! drop then
direction perform step!
apple? if eat-apple! then
dead? until ." *** GAME OVER ***" ;

create asciiart 365 cells allot

: fill 32
39  80  56 100 111  98  56  89  96  32 111  56  56  56 111  32 111  56  56  56 111  32 111  56  56  56 111  32  39  80  56 100 111  98  56  89  96  32  32  32  39  80  56 100 111 111  98  56  56  56 111  32
56  56  56  32  32  32  56  56  56  32  32  56  56  56  32  32  32  56  56  56  32  32  32  56  56  56  32  32 111  46  32  32  32  32  56  56  56  32  39  56  56 100  32  32  32  32  32  56  56  56  32  32
56  56  56  32  32  32  56  56  56  32  32  56  56  56  32  32  32  56  56  56  32  32  32  56  56  56  32  32  56  56  56 111 111 111  56  56  56  32  56  56  56  32  32  32  32  32  32  56  56  56  32  32
98  56  56  96  32  39  56  56 100  32  32  98  56  56  89  34  80  98  56  56  89  34  80  56  56  56  96  32  98  56  56  96  32  39  56  56 100  32  56  56  56  32  32  32  32  32  32  56  56  56  32  32
32  46 111 111 111 111 111  46  32  32  32  32  46 111 111  46  32  32  46 111 111  46  32  46 111 111 111  32  32  46 111 111 111 111 111  46  32  32  56  56  56  32  32  32  32  32  32  56  56  56  32  32
32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  98  56  89  96  32  32  32  39  56  56  56  96  32
32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  46 111 111 111 111 111 111 111 111 111 111  32
365 0 ?do asciiart i cells + ! loop ;

: demo fill page 1500 1 ?do 2 ms 0 52 myrand 0 7 myrand 2dup at-xy 52 * + cells asciiart + @ emit loop
                 7 0 ?do 52 0 ?do 2 ms i j 2dup at-xy 52 * + cells asciiart + @ emit loop loop ;

newgame!
demo
." Snake in Forth"
3000 ms
gameloop