119 lines
3.1 KiB
Plaintext
Executable file
119 lines
3.1 KiB
Plaintext
Executable file
-1 const EVNOP
|
|
0 const EVTICK
|
|
1 const EVTOUCH
|
|
2 const EVUNTOUCH
|
|
3 const EVACT
|
|
4 const EVDEACT
|
|
5 const EVTOG
|
|
6 const EVHACK
|
|
|
|
: world>tile 4 >> swap 4 >> swap ; userword
|
|
: tile>world 4 << swap 4 << swap ; userword
|
|
|
|
: +pos ( x1 y1 x2 y2 -- x y )
|
|
<rot + >rot + swap ; userword
|
|
|
|
: -pos ( x1 y1 x2 y2 -- x y )
|
|
negate swap negate swap +pos ; userword
|
|
|
|
: allotentity ( x y dir anim -- ) ' drop , , , tile>world , , ;
|
|
: defentity ( x y dir anim -- ) array allotentity ;
|
|
|
|
var _responder
|
|
: responder _responder @ ;
|
|
: entity.user 5 cells + ;
|
|
: entity.x 4 cells + ;
|
|
: entity.y 3 cells + ;
|
|
: entity.dir 2 cells + ;
|
|
: entity>sprite cell + @ execute ;
|
|
: entity>do ( entity event )
|
|
swap dup if
|
|
responder >rot
|
|
dup _responder !
|
|
@ execute
|
|
_responder !
|
|
else drop drop then ;
|
|
|
|
: entity>pos dup entity.x @ swap entity.y @ ; userword
|
|
: entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ; userword
|
|
|
|
: deflistener array ' drop , ;
|
|
: evproxy ( ev entity -- ev ) over entity>do ;
|
|
|
|
0 const W
|
|
1 const E
|
|
2 const N
|
|
3 const S
|
|
4 const NODIR
|
|
|
|
: dir>pos ( dir -- dx dy )
|
|
dup W = if drop -1 0 ret then
|
|
dup E = if drop 1 0 ret then
|
|
dup N = if drop 0 -1 ret then
|
|
S = if 0 1 else 0 0 then ;
|
|
|
|
: pos>dir ( dx dy -- dir )
|
|
dup 0 < if drop drop N else
|
|
0 > if drop S else
|
|
dup 0 < if drop W else
|
|
0 > if E else NODIR then then then then ;
|
|
|
|
: facing ( x1 y1 x2 y2 -- dir ) -pos pos>dir ;
|
|
: face ( e1 e2 -- )
|
|
over swap entity>pos <rot entity>pos facing swap entity.dir ! ;
|
|
|
|
: 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 ;
|
|
|
|
: frame ( s n e w ) b, b, b, b, ;
|
|
array frames
|
|
( 0: gord stand ) 5 7 9 11 frame
|
|
( 1: gord walk ) 6 8 10 12 frame
|
|
( 2: jaye stand ) 30 32 34 36 frame
|
|
( 3: jaye walk ) 31 33 35 37 frame
|
|
( 4: duck ) 44 45 44 45 frame
|
|
( 5: rexx stand ) 15 16 17 18 frame
|
|
|
|
: sprindex ( dir frame ) 2 << frames + + b@ ;
|
|
: defstatic ( frame -- ) create b, does> b@ sprindex ;
|
|
: defsingle ( sprindex -- ) create b, does> swap drop b@ ;
|
|
: lookup-frame ( anim -- val )
|
|
dup dup 1 + b@ swap b@ ( a count tpf )
|
|
ticks swap / swap % ( a index )
|
|
2 + + b@ ;
|
|
|
|
: defanim ( frame... framecount ticks-per-frame -- )
|
|
create b, dup b, 0 for b, next
|
|
does> ( dir a -- ) lookup-frame sprindex ;
|
|
: defmulti ( sprindex... framecount ticks-per-frame -- )
|
|
create b, dup b, 0 for b, next
|
|
does> ( dir a -- ) swap drop lookup-frame ;
|
|
|
|
var neut-chuck
|
|
|
|
-1 defsingle {blank}
|
|
0 defsingle {gord-floor}
|
|
1 defsingle {gord-sit}
|
|
0 defstatic {gord-stand}
|
|
0 1 2 5 defanim {gord-walk}
|
|
2 defstatic {jaye-stand}
|
|
2 3 2 5 defanim {jaye-walk}
|
|
4 defstatic {duck}
|
|
13 14 2 5 defmulti {neut-real}
|
|
19 20 2 5 defmulti {libb}
|
|
5 defstatic {rexx}
|
|
21 defsingle {chuck}
|
|
: {neut} neut-chuck @ if {chuck} else {neut-real} then ;
|
|
|
|
: sprite-bob ( x y sprindex -- x y sprindex )
|
|
dup 13 >= over 21 <= and if
|
|
>rot 2dup + ticks + 40 % 20 < if 1 + then <rot
|
|
then ;
|