: blah ' seremit task-emit ! ' log-emit task-echo ! ; : 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 1 const ^ESC 28 const ^ENTER 29 const ^CTRL 56 const ^ALT 57 const ^SPACE 72 const ^UP 75 const ^LEFT 77 const ^RIGHT 80 const ^DOWN : wait-key ( k -- ) begin dup key-pressed not while suspend repeat drop ; : udelta ( u u -- u ) 2dup u> if swap -1 swap - + 1 + else swap - then ; : sleep ( count -- ) ticks swap begin over ticks udelta over u< while suspend repeat drop drop ; defer tick defer draw : defentity var 2 cells allot ; : entity.x ; : entity.y cell + ; : entity.dir 2 cells + ; 0 const W 1 const E 2 const N 3 const S : defsprite ( s n e w ) b, b, b, b, here 4 - const ; : sprindex ( sprite dir ) + b@ ; 3 1 0 2 defsprite s_car defentity player 100 player entity.x ! 100 player entity.y ! : tick-player 0 ^LEFT key-down if 3 - W player entity.dir ! then ^RIGHT key-down if 3 + E player entity.dir ! then player entity.x +! 0 ^UP key-down if 3 - N player entity.dir ! then ^DOWN key-down if 3 + S player entity.dir ! then player entity.y +! ; : draw-player player entity.x @ player entity.y @ s_car player entity.dir @ sprindex draw-sprite ; : full-draw player entity.x @ 152 - player entity.y @ 92 - scroll draw-player 50 50 0 draw-sprite 600 600 2 draw-sprite draw-screen ; ' tick-player is tick ' full-draw is draw