pete286/game.jor

: 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/ ;
: <ratio ( range ratio -- v )
  swap >fix fix* <fix ;
: >range ( start end -- start range ) over - ;
: <range ( start range -- start end ) over + ;
: lerpr ( start end ratio ) r> >range r< <ratio + ;
: lerpn ( start1 end1 start2 end2 val )
  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