diff --git a/defs.jor b/defs.jor index 368f252..a3578c6 100755 --- a/defs.jor +++ b/defs.jor @@ -8,15 +8,25 @@ s" jorth.log" open seekend deactivate const LOGFILE : 3dup r> 2dup r@ >rot r< ; : 4dup r> r> 2dup r@ >rot rswap r@ >rot r< r< swap ; +: 2= ( a b c d -- a=c&b=d ) + r> dup @ ( b v val r: flag ) + if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ; diff --git a/game.exe b/game.exe index a4f94c5..9b27587 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index 99f0752..4a68fe5 100755 --- a/game.jor +++ b/game.jor @@ -35,11 +35,12 @@ REPL start-repl defer tick defer draw -: defentity ( x y dir anim -- ) array , , , , ; -: entity.x 3 cells + ; -: entity.y 2 cells + ; -: entity.dir cell + ; -: entity.anim ; +: defentity ( x y dir anim do -- ) array , , , 4 << , 4 << , ; +: entity.x 4 cells + ; +: entity.y 3 cells + ; +: entity.dir 2 cells + ; +: entity>sprite cell + @ execute ; +: entity>do ( entity event ) swap @ execute ; 0 const W 1 const E @@ -55,8 +56,8 @@ defer draw : 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 +( 1: pete stand ) 11 9 7 5 frame +( 2: pete walk ) 12 10 8 6 frame : sprindex ( dir frame ) 2 << frames + + b@ ; : defstatic ( frame -- ) create b, does> b@ sprindex ; @@ -71,24 +72,6 @@ array frames 1 defstatic {pete-stand} 1 2 2 5 defanim {pete-walk} -: ~ -1 ^ ; -var player.state -: f! ( b v flag -- ) - r> dup @ ( b v val r: flag ) - if drop 0 then tileselect ! - MOUSEL mousedown if tileselect @ mousetile tile b! then ; + MOUSEL mousedown if tileselect @ mousetile tile b! then + MOUSER clicked if mouseworldpos world>tile swap . . then ; : copy-mapseg ( neww oldw y -- ) r> ( oldw neww r: y ) @@ -268,19 +253,54 @@ task const JOB JOB listen-for-jobs ( T I C K ) +defer entities + +0 const EVTICK +1 const EVTOUCH + +: entity-at ( x y -- entity|0 ) + 0 >rot + entities each r> 2dup ( 0 x y x y r:e ) + r@ entity.x @ r@ entity.y @ world>tile 2= ( 0 x y eq r:e ) + if rot break ( e x y ) + else rdrop then ( 0 x y ) + more drop drop ; + +( P L A Y E R ) +var player.state +defer player + +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 ; + : player.canmove? ( x y -- ) player.state DRIVING f@ if DRIVABLE else WALKABLE then mapflag? ; +: move-entity ( e -- ) + dup entity.dir @ dir>pos ( e dx dy ) + dup if swap drop swap entity.y + else drop swap entity.x then + swap 16 * over @ + 4 pos - 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 tile +pos ( x y ) + 2dup entity-at r> player.canmove? if r< ( entity ) + ( touch entity if exists ) + dup if + EVTOUCH entity>do + else drop + ( move the player ) + 1 player.state MOVING f! + player move-entity + 0 player.state MOVING f! + then + else rdrop then ; : tick-player 0 ^LEFT key-down if drop 1 W player entity.dir ! then @@ -289,13 +309,20 @@ JOB listen-for-jobs ^DOWN key-down if drop 1 S player entity.dir ! then if ' move-player JOB send then ; +: think-player + EVTICK = if tick-player then ; + +12 9 N ' {player} ' think-player defentity _player +' _player ' player redefine + +( S T U F F ) : hello-world s" Hello, world!" say1 s" How are you" s" today?" say2 player.state DRIVING f@ not player.state DRIVING f! ; : mode-move - tick-player + entities each EVTICK entity>do more tick-mapedit ^SPACE key-pressed if ' hello-world JOB send @@ -307,7 +334,7 @@ JOB listen-for-jobs : draw-entity r> r@ entity.x @ r@ entity.y @ - r@ entity.dir @ r< entity.anim @ execute + r@ entity.dir @ r< entity>sprite draw-sprite ; : full-draw @@ -315,7 +342,7 @@ JOB listen-for-jobs player entity.y @ 92 - scroll - player draw-entity + entities each draw-entity more mouseworldpos 4 draw-sprite draw-screen draw-footer ; @@ -323,4 +350,16 @@ JOB listen-for-jobs MODE-MOVE @ ' tick redefine ' full-draw ' draw redefine +( P E T E ) + +8 8 E ' {car} +:noname EVTOUCH = if pete s" What an old rustbucket." say1 then ; +defentity car + +:noname + player yield + car yield + 0 ; +' entities redefine + s" pete.map" load-map diff --git a/game.prj b/game.prj index 8264656..7ff771f 100755 Binary files a/game.prj and b/game.prj differ diff --git a/jorth.c b/jorth.c index 6ccee50..f92a222 100755 --- a/jorth.c +++ b/jorth.c @@ -460,8 +460,12 @@ void f_docolon() { f_colonloop(); } +void f_dodeferred() { + W = *(W.p + 1); + f_colondispatch(); +} + // this version of f_execute can be run from a colon word -// (though not currently from the interpreter?) void f_execute() { W = TOP(); DROP(1); @@ -954,6 +958,7 @@ void f_init() { CDEF("task-user-size", f_taskusersize); PCONST("$DOCREATE", f_docreate); PCONST("$DOVAR", f_dovar); + PCONST("$DODEFERRED", f_dodeferred); PUSHS("boot.jor"); f_open(); diff --git a/sprite.tif b/sprite.tif index cb23187..06864af 100755 Binary files a/sprite.tif and b/sprite.tif differ