pete286/game.jor

: 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 drop r< >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 move-to ;

: move-player
  1 player.state MOVING f!
  player move-entity
  0 player.state MOVING f! ;

: out-of-bounds ( x y -- b )
  2dup 0 < swap 0 < or >rot mapsize ( b x y w h )
  <rot <= >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