neuttower/entity.jor

113 lines
3 KiB
Plaintext
Raw Normal View History

2020-02-18 01:43:11 +00:00
-1 const EVNOP
0 const EVTICK
1 const EVTOUCH
2 const EVUNTOUCH
3 const EVACT
4 const EVDEACT
5 const EVTOG
2020-02-02 23:33:07 +00:00
: 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 + ;
2020-02-02 23:33:07 +00:00
: 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 ;
2020-02-02 23:33:07 +00:00
: 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 ;
2020-02-02 23:33:07 +00:00
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 ! ;
2020-02-02 23:33:07 +00:00
: 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
2020-02-18 01:43:11 +00:00
( 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
2020-02-02 23:33:07 +00:00
: 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 ;
-1 defsingle {blank}
0 defsingle {gord-floor}
1 defsingle {gord-sit}
2020-02-18 01:43:11 +00:00
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}
2020-02-02 23:33:07 +00:00
13 14 2 5 defmulti {neut}
2020-02-18 01:43:11 +00:00
5 defstatic {rexx}
2020-02-02 23:33:07 +00:00
: sprite-bob ( x y sprindex -- x y sprindex )
2020-02-18 01:43:11 +00:00
dup 13 >= over 18 <= and if
2020-02-02 23:33:07 +00:00
>rot 2dup + ticks + 40 % 20 < if 1 + then <rot
then ;