diff --git a/defs.jor b/defs.jor index 4d8b011..368f252 100755 --- a/defs.jor +++ b/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 -- ) diff --git a/game.exe b/game.exe index 781709d..a4f94c5 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index 91431c4..99f0752 100755 --- a/game.jor +++ b/game.jor @@ -35,10 +35,11 @@ REPL start-repl defer tick defer draw -: defentity var 2 cells allot ; -: entity.x ; -: entity.y cell + ; -: entity.dir 2 cells + ; +: defentity ( x y dir anim -- ) array , , , , ; +: entity.x 3 cells + ; +: entity.y 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 ; -: sprindex ( sprite dir ) + b@ ; +: frame ( s n e w ) b, b, b, 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 ! -128 player entity.y ! +: ~ -1 ^ ; +var player.state +: f! ( b v flag -- ) + r> dup @ ( b v val r: flag ) + > 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 r@ entity.x @ r@ entity.y @ + r@ entity.dir @ r< entity.anim @ execute draw-sprite ; : full-draw @@ -259,9 +315,7 @@ JOB listen-for-jobs player entity.y @ 92 - scroll - draw-player - 48 64 0 draw-sprite - 640 640 2 draw-sprite + player draw-entity mouseworldpos 4 draw-sprite draw-screen draw-footer ; diff --git a/game.prj b/game.prj index fd09030..8264656 100755 Binary files a/game.prj and b/game.prj differ diff --git a/jorth.c b/jorth.c index 5f80dbb..6ccee50 100755 --- a/jorth.c +++ b/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(); diff --git a/sprite.tif b/sprite.tif index 9915569..cb23187 100755 Binary files a/sprite.tif and b/sprite.tif differ