( 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 : 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.driving? player.state DRIVING f@ ; : player.canmove? ( x y -- ) player.driving? 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 ; : leaving? ( x y dir -- b ) dup N = if drop swap drop 0 < else dup W = if drop drop 0 < else S = if swap drop mapsize swap drop >= else drop mapsize drop >= then then then ; defer player-touch ( x y -- b ) : touch-begin begin 2dup search >rot drop drop 1 - ; : touched? if 2 else 1 then ; : touched-more? if 2 else 0 then ; : touch-next ' touched-more? , ' yield , ; immediate : touch-last ' touched? , ' yield , ; immediate : ;touch [ ' touch-last , ' [ , ] ; immediate : check-player-touch ( x y -- b ) touch-begin entity-at dup if EVTOUCH entity>do 1 then touch-next player-touch touch-next out-of-bounds touch-next player.canmove? not ;touch : try-move-player player entity-dst check-player-touch not if move-player then ; : check-entity-touch touch-begin entity-at touch-next out-of-bounds touch-next WALKABLE mapflag? ;touch : try-move-entity ( e -- ) dup entity-dst check-entity-touch not if move-entity then ; var q-level var q-player.x var q-player.y : queue-level q-level ! q-player.y ! q-player.x ! ; 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 fnot! ; : mode-move entities each EVTICK entity>do more tick-mapedit ^SPACE key-pressed if ' hello-world JOB send then tick-debounce q-level @ dup if 0 q-level ! loadlevel q-player.x @ q-player.y @ tile>world player entity.pos! else drop then ; ' 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 ; : reset-level :| player yield 0 |; ' entities redefine :| drop drop 0 |; ' player-touch redefine ; :noname reset-level MODE-MOVE @ ' tick redefine ' full-draw ' draw redefine ; ' onload redefine