Animation support, per-tile map walkability flags

defs.jor

@@ -19,6 +19,7 @@ s" jorth.log" open seekend deactivate const LOGFILE
 : defer word new-word $DOCOLON , ' noop , ' ret , ;
 : redefine ( cp cpdeferred ) cell + ! ;
 
+: array word new-word $DOVAR , ;
 : create word new-word $DOCREATE , 0 , ;
 
 : finishcreate ( ipfirst -- )

game.jor

@@ -35,10 +35,11 @@ REPL start-repl
 defer tick
 defer draw
 
-: defentity var 2 cells allot ;
+: defentity ( x y dir anim -- ) array , , , , ;
-: entity.x ;
+: entity.x 3 cells + ;
-: entity.y cell + ;
+: entity.y 2 cells + ;
-: entity.dir 2 cells + ;
+: entity.dir cell + ;
+: entity.anim ;
 
 0 const W
 1 const E
@@ -51,15 +52,42 @@ defer draw
   N = if 0 -1
       else 0 1 then ;
 
-: defsprite ( s n e w ) b, b, b, b, here 4 - const ;
+: frame ( s n e w ) b, b, b, b, ;
-: sprindex ( sprite dir ) + b@ ;
+array frames
+( 0: car ) 3 1 0 2 frame
+( 1: pete stand ) 5 7 7 5 frame
+( 2: pete walk ) 6 8 8 6 frame
 
-3 1 0 2 defsprite s_car
+: sprindex ( dir frame ) 2 << frames + + b@ ;
+: defstatic ( frame -- ) create b, does> b@ sprindex ;
+: defanim ( frame... framecount ticks-per-frame -- )
+  create b, dup b, 0 for b, next
+  does> ( dir a -- )
+    dup dup 1 + b@ swap b@ ( dir a count tpf )
+    ticks swap / swap % ( dir a index )
+    2 + + b@ sprindex ;
 
-defentity player
+0 defstatic {car}
+1 defstatic {pete-stand}
+1 2 2 5 defanim {pete-walk}
 
-128 player entity.x !
+: ~ -1 ^ ;
-128 player entity.y !
+var player.state
+: f! ( b v flag -- )
+  r> dup @ ( b v val r: flag )
+  <rot if r< | else r< ~ & then ( v newval )
+  swap ! ;
+: f@ ( v flag -- ) swap @ & ;
+
+1 const MOVING
+2 const DRIVING
+
+: {player}
+  player.state DRIVING f@ if {car}
+  else player.state MOVING f@ if {pete-walk}
+  else {pete-stand} then then ;
+
+128 128 N ' {player} defentity player
 
 ( timer + lerping )
 : clamp0 ( range val -- i )
@@ -133,6 +161,8 @@ WHITE text-color !
 : hide-footer 0 10 footer-y move-to ;
 
 : footer-wait show-footer ^ENTER wait-key ;
+
+( todo: generic say" that handles newlines, gradual text display )
 : say1 ( s -- ) clear text1 footer-wait ;
 : say2 ( s1 s2 -- ) clear text1 text0 footer-wait ;
 : say3 ( s1 s2 s3 -- ) clear text2 text1 text0 footer-wait ;
@@ -164,9 +194,28 @@ var tileselect
 8 const MAXTILE
 
 : mouseworldpos mousepos scrollpos +pos ;
-: mousetile mouseworldpos 4 >> swap 4 >> swap ;
+: world>tile 4 >> swap 4 >> swap ;
+: mousetile mouseworldpos world>tile ;
 : tile ( x y -- ptr ) mapsize drop * + map + ;
 
+1 const WALKABLE
+2 const DRIVABLE
+
+array tileflags
+( grass )    WALKABLE b,
+( dirt )     WALKABLE b,
+( water )    0 b,
+( pavement ) WALKABLE DRIVABLE | b,
+( brick )    0 b,
+( forest )   0 b,
+( roof )     0 b,
+( brick )    0 b,
+( window )   0 b,
+
+: mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ;
+: walkable? ( x y -- b ) WALKABLE mapflag? ;
+: drivable? ( x y -- b ) DRIVABLE mapflag? ;
+
 : tick-mapedit
   tileselect @
   ^< key-pressed if 1 - then
@@ -219,12 +268,19 @@ task const JOB
 JOB listen-for-jobs
 
 ( T I C K )
+: player.canmove? ( x y -- )
+  player.state DRIVING f@ if DRIVABLE else WALKABLE then mapflag? ;
 
 : move-player
   player entity.dir @ dir>pos
-  dup if swap drop player entity.y ( d v -- )
+  2dup player entity.x @ player entity.y @ world>tile +pos
+  player.canmove? if
+    1 player.state MOVING f!
+    dup if swap drop player entity.y ( d v -- )
       else drop player entity.x then
-  swap 16 * over @ + 4 <rot move-to ;
+    swap 16 * over @ + 4 <rot move-to
+    0 player.state MOVING f!
+  else drop drop then ;
 
 : tick-player
   0 ^LEFT key-down if drop 1 W player entity.dir ! then
@@ -235,7 +291,8 @@ JOB listen-for-jobs
 
 : hello-world
   s" Hello, world!" say1
-  s" How are you" s" today?" say2 ;
+  s" How are you" s" today?" say2
+  player.state DRIVING f@ not player.state DRIVING f! ;
 
 : mode-move
   tick-player
@@ -248,10 +305,9 @@ JOB listen-for-jobs
 ' mode-move MODE-MOVE !
 ' tick-debounce MODE-WAIT !
 
-: draw-player
+: draw-entity
-  player entity.x @
+  r> r@ entity.x @ r@ entity.y @
-  player entity.y @
+  r@ entity.dir @ r< entity.anim @ execute
-  s_car player entity.dir @ sprindex
   draw-sprite ;
 
 : full-draw
@@ -259,9 +315,7 @@ JOB listen-for-jobs
   player entity.y @ 92 -
   scroll
 
-  draw-player
+  player draw-entity
-  48 64 0 draw-sprite
-  640 640 2 draw-sprite
   mouseworldpos 4 draw-sprite
   draw-screen
   draw-footer ;

jorth.c

@@ -80,6 +80,7 @@ BINOP(f_add, i, +)
 BINOP(f_sub, i, -)
 BINOP(f_mul, i, *)
 BINOP(f_div, i, /)
+BINOP(f_mod, i, %)
 BINOP(f_eq, i, ==)
 BINOP(f_neq, i, !=)
 BINOP(f_ge, i, >=)
@@ -871,6 +872,7 @@ void f_init() {
   CDEF("-", f_sub);
   CDEF("*", f_mul);
   CDEF("/", f_div);
+  CDEF("%", f_mod);
   CDEF("=0", f_eq0);
   CDEF("not", f_not);
   CDEF("=", f_eq);
@@ -951,6 +953,7 @@ void f_init() {
   CDEF("rstacksize", f_rstacksize);
   CDEF("task-user-size", f_taskusersize);
   PCONST("$DOCREATE", f_docreate);
+  PCONST("$DOVAR", f_dovar);
 
   PUSHS("boot.jor");
   f_open();