neuttower/entity.jor

115 lines
3.2 KiB
Plaintext
Executable file

0 const EVTICK
1 const EVTOUCH
: 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
: defentity ( x y dir anim -- ) array ' drop , , , tile>world , , ;
: entity.x 4 cells + ;
: entity.y 3 cells + ;
: entity.dir 2 cells + ;
: entity>sprite cell + @ execute ;
: entity>do ( entity event ) swap @ execute ;
: entity>pos dup entity.x @ swap entity.y @ ; userword
: entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ; userword
var entity-defstate
: entitydo-ev ( [cp ifhere] ev -- )
entity-defstate @ if swap [ ' then , ]
else 1 entity-defstate ! :noname swap then
' dup , lit ' = , [ ' if , ] ;
: :touch EVTOUCH entitydo-ev ; immediate
: :tick EVTICK entitydo-ev ; immediate
: ;entity ( entity cp ifhere -- )
[ ' then , ] ' drop , [ ' ; , ]
0 entity-defstate ! swap ! ; immediate
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 ;
: 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: car ) 3 1 0 2 frame
( 1: pete stand ) 11 9 7 5 frame
( 2: pete walk ) 12 10 8 6 frame
( 3: mary stand ) 17 20 22 24 frame
( 4: mary walk ) 19 21 23 25 frame
( 5: car lights ) 29 27 26 28 frame
( 6: jeanne stand ) 30 32 34 36 frame
( 7: jeanne walk ) 31 33 35 37 frame
( 8: boat w/ pete ) 42 41 40 39 frame
( 9: duck ) 44 45 44 45 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 ;
0 defstatic {car}
5 defstatic {car-lit}
1 defstatic {pete-stand}
1 2 2 5 defanim {pete-walk}
13 defsingle {pete-table}
14 defsingle {chair}
15 defsingle {pete-bed}
16 defsingle {horse}
3 defstatic {mary}
3 4 2 5 defanim {mary-walk}
6 defstatic {jeanne}
6 7 2 5 defanim {jeanne-walk}
18 defsingle {phone}
38 defsingle {fridge}
43 defsingle {boat}
8 defstatic {boat-pete}
9 defstatic {duck}
46 defsingle {aliem}
13 14 2 5 defmulti {neut}
: sprite-bob ( x y sprindex -- x y sprindex )
dup 13 >= over 14 <= and if
>rot 2dup + ticks + 40 % 20 < if 1 + then <rot
then ;