: blah ' seremit task-emit ! ' log-emit task-echo ! ; blah ' seremit task-emit ! : 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 ! ( timer + lerping ) : clamp0 ( range val -- i ) 2dup <= if drop else dup 0 <= if drop drop 0 else swap drop then then ; : >ratio ( range value -- f ) over swap clamp0 >fix swap >fix fix/ ; : fix fix* range ( start end -- start range ) over - ; : >range r< >range r< rot - >ratio lerpr ; : lerp ( start end duration timer -- i ) @ ticks udelta ( start end duration delta ) >ratio lerpr ; : triggered ( duration timer -- b ) dup r> @ ticks udelta ( duration delta ) 2dup <= if drop r< +! 1 else drop drop 0 then ; : now! ( timer -- ) ticks swap ! ; : 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 +! ; var MODE-TRAVEL var MODE-TEXT var split-timer : enter-mode-text split-timer now! MODE-TEXT @ ' tick redefine ; : mode-travel tick-player ^SPACE key-pressed if enter-mode-text then ; ' mode-travel MODE-TRAVEL ! : mode-text-hide 24 0 10 split-timer lerp dup split-screen 0 = if ' mode-travel ' tick redefine then ; : mode-text-show 0 24 10 split-timer lerp split-screen ^SPACE key-pressed if split-timer now! ' mode-text-hide ' tick redefine then ; ' mode-text-show MODE-TEXT ! : 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 ; MODE-TRAVEL @ ' tick redefine ' full-draw ' draw redefine