: blah ' seremit task-emit ! ; blah : start-repl activate blah s" .:: J O R T H ( jean forth) ::." type cr begin receive loadstring s" ok" type cr again ; task const REPL REPL start-repl defer tick defer draw :noname s" input.jor" loadfile s" entity.jor" loadfile s" timer.jor" loadfile s" footer.jor" loadfile s" map.jor" loadfile ; execute ( J O B ) var MODE-MOVE var MODE-WAIT : listen-for-jobs activate blah begin receive MODE-WAIT @ ' tick redefine execute hide-footer MODE-MOVE @ ' tick redefine again ; task const JOB JOB listen-for-jobs ( T I C K ) defer entities :noname 0 ; ' entities redefine : 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? ; 12 9 N ' {player} defentity player : entity-dst ( e -- x y ) r> r@ entity.dir @ dir>pos r@ entity.x @ r< entity.y @ world>tile +pos ; : 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 rot mapsize ( b x y w h ) rot ( b b x w ) >= or or ; : no-touch drop drop 0 ; defer player-touch ( x y -- b ) ' no-touch ' player-touch redefine : check-player-touch ( x y -- b ) 2dup entity-at dup if EVTOUCH entity>do drop drop 1 else drop 2dup player-touch if drop drop 1 else 2dup out-of-bounds if drop drop 1 else player.canmove? if 0 else 1 then then then then ; : try-move-player player entity-dst check-player-touch not if move-player then ; : check-entity-touch ( x y -- b ) 2dup entity-at if drop drop 1 else 2dup out-of-bounds if 1 else WALKABLE mapflag? if 0 else 1 then then then ; : try-move-entity ( e -- ) dup entity-dst check-entity-touch not if move-entity then ; player :tick 0 ^LEFT key-down if drop 1 W player entity.dir ! then ^RIGHT key-down if drop 1 E player entity.dir ! then ^UP key-down if drop 1 N player entity.dir ! then ^DOWN key-down if drop 1 S player entity.dir ! then if ' try-move-player JOB send then ;entity ( S T U F F ) : hello-world player.state DRIVING f@ not player.state DRIVING f! ; : mode-move entities each EVTICK entity>do more tick-mapedit ^SPACE key-pressed if ' hello-world JOB send then tick-debounce ; ' mode-move MODE-MOVE ! ' tick-debounce MODE-WAIT ! : draw-entity r> r@ entity.x @ r@ entity.y @ r@ entity.dir @ r< entity>sprite draw-sprite ; : full-draw player entity.x @ 152 - player entity.y @ 92 - scroll entities each draw-entity more mouseworldpos 4 draw-sprite draw-screen draw-footer ; MODE-MOVE @ ' tick redefine ' full-draw ' draw redefine :noname s" pete.jor" loadfile ; ' onload redefine