pete286/game.jor

var MODE-MOVE
var MODE-WAIT


( T I C K )
defer party
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 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 userword
var player.prevdir

1 const MOVING userword
2 const DRIVING userword
4 const BOATING userword
8 const NOCLIP userword
16 const ISMARY userword
32 const ISJEANNE userword

: noclip player.state NOCLIP fnot! ; userword

: player.driving? player.state DRIVING f@ ; userword
: player.boating? player.state BOATING f@ ; userword

: :playerwalk create , , does>
  player.state MOVING f@ not if cell + then @ execute ;

' {mary} ' {mary-walk} :playerwalk {pmary}
' {pete-stand} ' {pete-walk} :playerwalk {ppete}
' {jeanne} ' {jeanne-walk} :playerwalk {pjeanne}

: {player}
  player.driving? if {car-drive}
  else player.boating? if {boat-pete}
  else
      player.state ISMARY f@ if {pmary}
      else player.state ISJEANNE f@ if {pjeanne}
      else {ppete} then then
  then then ;

: player.canmove? ( x y -- )
  player.state NOCLIP f@ not if
  player.driving? if DRIVABLE else
  player.boating? if BOATABLE else WALKABLE then then mapflag?
  else drop drop 1 then ;

12 9 N ' {player} defentity player

: sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ;
: move-player
  :| 1 player.state MOVING f!
     player move-entity
     0 player.state MOVING f!
  |; sched
  player.prevdir @ party each
    dup player != if
      dup entity.dir @ >r
      dup >rot entity.dir !
      sched-move-entity <r
    else entity.dir @ player.prevdir ! then more drop ;

: 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 ;

: 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 each 2dup more >rot drop drop ;
: touch-next dup if rdrop done then drop rswap ;
: touch-last ' done , ; 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 ;

: follow ( e -- )
  player entity>pos <rot entity.pos! NODIR player.prevdir ! ;

: 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 ! ; userword

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 sched then
;entity

( S T U F F )
: reset-level
  :| done |; ' entities redefine
  :| drop drop 0 |; ' player-touch redefine ; userword

: mode-move
  entities each EVTICK entity>do more
  party each EVTICK entity>do more
  tick-mapedit jiles
  tick-debounce
  q-level @ dup if
    0 q-level !
    reset-level
    loadlevel
    q-player.x @ q-player.y @ tile>world player entity.pos!
    party each follow more
  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
  sprite-bob draw-sprite ;

var showmouse
1 showmouse !
var glitchlevel

: full-draw
  player entity.x @ 152 -
  player entity.y @ 92 -
  scroll

  entities each draw-entity more
  party each draw-entity more

  showmouse @ if
    mouseworldpos 4 draw-sprite
  then
  glitchlevel @ glitch
  draw-screen
  draw-footer ;

16 18 W ' {horse} defentity p_chuck
16 18 W ' {pjeanne} defentity p_jeanne

:noname
  reset-level
  MODE-MOVE @ ' tick redefine
  ' full-draw ' draw redefine
  :| player yield
     player.state ISMARY f@ if p_jeanne yield then
     CHUCK-FOLLOW flag@ if p_chuck yield then
  done |; ' party redefine
  :| MODE-WAIT @ ' tick redefine |; ' any-job-started redefine
  :| MODE-MOVE @ ' tick redefine hide-footer |; ' all-jobs-complete redefine
; ' onload redefine