pete286/game.jor

156 lines
3.6 KiB
Plaintext
Raw Normal View History

2019-02-18 01:14:56 +00:00
( 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
2019-02-18 01:14:56 +00:00
( T I C K )
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
defer player
1 const MOVING
2 const DRIVING
4 const NOCLIP
: player.driving? player.state DRIVING f@ ;
: {player}
player.driving? if {car}
else player.state MOVING f@ if {pete-walk}
else {pete-stand} then then ;
: player.canmove? ( x y -- )
player.state NOCLIP f@ not if
player.driving? if DRIVABLE else WALKABLE then mapflag?
else drop drop 1 then ;
2019-02-18 01:14:56 +00:00
2019-03-03 01:03:34 +00:00
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 ;
2019-02-18 01:14:56 +00:00
: move-player
2019-03-03 01:03:34 +00:00
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 ;
: 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 ;
2019-03-03 01:03:34 +00:00
defer player-touch ( x y -- b )
: touch-begin begin 2dup search >rot drop drop 1 - ;
: touched? if 2 else 1 then ;
: touched-more? if 2 else 0 then ;
: touch-next ' touched-more? , ' yield , ; immediate
: touch-last ' touched? , ' yield , ; immediate
: ;touch [ ' touch-last , ' [ , ] ; immediate
2019-03-03 01:03:34 +00:00
: 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
2019-03-03 01:03:34 +00:00
: try-move-player
player entity-dst check-player-touch not if move-player then ;
: 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 ;
2019-03-03 01:03:34 +00:00
2019-03-14 00:43:38 +00:00
var q-level
var q-player.x
var q-player.y
: queue-level q-level ! q-player.y ! q-player.x ! ;
2019-03-03 01:03:34 +00:00
player :tick
2019-02-18 01:14:56 +00:00
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
2019-03-03 01:03:34 +00:00
if ' try-move-player JOB send then
;entity
( S T U F F )
: reset-level
:| player yield 0 |; ' entities redefine
:| drop drop 0 |; ' player-touch redefine ;
: mode-move
entities each EVTICK entity>do more
2019-02-18 01:14:56 +00:00
tick-mapedit
tick-debounce
2019-03-14 00:43:38 +00:00
q-level @ dup if
0 q-level !
reset-level
loadlevel
2019-03-14 00:43:38 +00:00
q-player.x @ q-player.y @ tile>world player entity.pos!
else drop then ;
2019-02-18 01:14:56 +00:00
' mode-move MODE-MOVE !
2019-02-18 01:14:56 +00:00
' tick-debounce MODE-WAIT !
: draw-entity
r> r@ entity.x @ r@ entity.y @
r@ entity.dir @ r< entity>sprite
2019-02-11 00:17:58 +00:00
draw-sprite ;
var showmouse
1 showmouse !
2019-02-11 00:17:58 +00:00
: full-draw
player entity.x @ 152 -
player entity.y @ 92 -
scroll
entities each draw-entity more
showmouse @ if
mouseworldpos 4 draw-sprite
then
draw-screen
draw-footer ;
2019-02-11 00:17:58 +00:00
:noname
reset-level
MODE-MOVE @ ' tick redefine
' full-draw ' draw redefine
; ' onload redefine