Animation support, per-tile map walkability flags

This commit is contained in:
Jeremy Penner 2019-02-26 21:44:22 -05:00
parent 114d1ff804
commit e55b30ba1d
6 changed files with 79 additions and 21 deletions

View file

@ -19,6 +19,7 @@ s" jorth.log" open seekend deactivate const LOGFILE
: defer word new-word $DOCOLON , ' noop , ' ret , ; : defer word new-word $DOCOLON , ' noop , ' ret , ;
: redefine ( cp cpdeferred ) cell + ! ; : redefine ( cp cpdeferred ) cell + ! ;
: array word new-word $DOVAR , ;
: create word new-word $DOCREATE , 0 , ; : create word new-word $DOCREATE , 0 , ;
: finishcreate ( ipfirst -- ) : finishcreate ( ipfirst -- )

BIN
game.exe

Binary file not shown.

View file

@ -35,10 +35,11 @@ REPL start-repl
defer tick defer tick
defer draw defer draw
: defentity var 2 cells allot ; : defentity ( x y dir anim -- ) array , , , , ;
: entity.x ; : entity.x 3 cells + ;
: entity.y cell + ; : entity.y 2 cells + ;
: entity.dir 2 cells + ; : entity.dir cell + ;
: entity.anim ;
0 const W 0 const W
1 const E 1 const E
@ -51,15 +52,42 @@ defer draw
N = if 0 -1 N = if 0 -1
else 0 1 then ; else 0 1 then ;
: defsprite ( s n e w ) b, b, b, b, here 4 - const ; : frame ( s n e w ) b, b, b, b, ;
: sprindex ( sprite dir ) + b@ ; array frames
( 0: car ) 3 1 0 2 frame
( 1: pete stand ) 5 7 7 5 frame
( 2: pete walk ) 6 8 8 6 frame
3 1 0 2 defsprite s_car : sprindex ( dir frame ) 2 << frames + + b@ ;
: defstatic ( frame -- ) create b, does> b@ sprindex ;
: defanim ( frame... framecount ticks-per-frame -- )
create b, dup b, 0 for b, next
does> ( dir a -- )
dup dup 1 + b@ swap b@ ( dir a count tpf )
ticks swap / swap % ( dir a index )
2 + + b@ sprindex ;
defentity player 0 defstatic {car}
1 defstatic {pete-stand}
1 2 2 5 defanim {pete-walk}
128 player entity.x ! : ~ -1 ^ ;
128 player entity.y ! var player.state
: f! ( b v flag -- )
r> dup @ ( b v val r: flag )
<rot if r< | else r< ~ & then ( v newval )
swap ! ;
: f@ ( v flag -- ) swap @ & ;
1 const MOVING
2 const DRIVING
: {player}
player.state DRIVING f@ if {car}
else player.state MOVING f@ if {pete-walk}
else {pete-stand} then then ;
128 128 N ' {player} defentity player
( timer + lerping ) ( timer + lerping )
: clamp0 ( range val -- i ) : clamp0 ( range val -- i )
@ -133,6 +161,8 @@ WHITE text-color !
: hide-footer 0 10 footer-y move-to ; : hide-footer 0 10 footer-y move-to ;
: footer-wait show-footer ^ENTER wait-key ; : footer-wait show-footer ^ENTER wait-key ;
( todo: generic say" that handles newlines, gradual text display )
: say1 ( s -- ) clear text1 footer-wait ; : say1 ( s -- ) clear text1 footer-wait ;
: say2 ( s1 s2 -- ) clear text1 text0 footer-wait ; : say2 ( s1 s2 -- ) clear text1 text0 footer-wait ;
: say3 ( s1 s2 s3 -- ) clear text2 text1 text0 footer-wait ; : say3 ( s1 s2 s3 -- ) clear text2 text1 text0 footer-wait ;
@ -164,9 +194,28 @@ var tileselect
8 const MAXTILE 8 const MAXTILE
: mouseworldpos mousepos scrollpos +pos ; : mouseworldpos mousepos scrollpos +pos ;
: mousetile mouseworldpos 4 >> swap 4 >> swap ; : world>tile 4 >> swap 4 >> swap ;
: mousetile mouseworldpos world>tile ;
: tile ( x y -- ptr ) mapsize drop * + map + ; : tile ( x y -- ptr ) mapsize drop * + map + ;
1 const WALKABLE
2 const DRIVABLE
array tileflags
( grass ) WALKABLE b,
( dirt ) WALKABLE b,
( water ) 0 b,
( pavement ) WALKABLE DRIVABLE | b,
( brick ) 0 b,
( forest ) 0 b,
( roof ) 0 b,
( brick ) 0 b,
( window ) 0 b,
: mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ;
: walkable? ( x y -- b ) WALKABLE mapflag? ;
: drivable? ( x y -- b ) DRIVABLE mapflag? ;
: tick-mapedit : tick-mapedit
tileselect @ tileselect @
^< key-pressed if 1 - then ^< key-pressed if 1 - then
@ -219,12 +268,19 @@ task const JOB
JOB listen-for-jobs JOB listen-for-jobs
( T I C K ) ( T I C K )
: player.canmove? ( x y -- )
player.state DRIVING f@ if DRIVABLE else WALKABLE then mapflag? ;
: move-player : move-player
player entity.dir @ dir>pos player entity.dir @ dir>pos
dup if swap drop player entity.y ( d v -- ) 2dup player entity.x @ player entity.y @ world>tile +pos
player.canmove? if
1 player.state MOVING f!
dup if swap drop player entity.y ( d v -- )
else drop player entity.x then else drop player entity.x then
swap 16 * over @ + 4 <rot move-to ; swap 16 * over @ + 4 <rot move-to
0 player.state MOVING f!
else drop drop then ;
: tick-player : tick-player
0 ^LEFT key-down if drop 1 W player entity.dir ! then 0 ^LEFT key-down if drop 1 W player entity.dir ! then
@ -235,7 +291,8 @@ JOB listen-for-jobs
: hello-world : hello-world
s" Hello, world!" say1 s" Hello, world!" say1
s" How are you" s" today?" say2 ; s" How are you" s" today?" say2
player.state DRIVING f@ not player.state DRIVING f! ;
: mode-move : mode-move
tick-player tick-player
@ -248,10 +305,9 @@ JOB listen-for-jobs
' mode-move MODE-MOVE ! ' mode-move MODE-MOVE !
' tick-debounce MODE-WAIT ! ' tick-debounce MODE-WAIT !
: draw-player : draw-entity
player entity.x @ r> r@ entity.x @ r@ entity.y @
player entity.y @ r@ entity.dir @ r< entity.anim @ execute
s_car player entity.dir @ sprindex
draw-sprite ; draw-sprite ;
: full-draw : full-draw
@ -259,9 +315,7 @@ JOB listen-for-jobs
player entity.y @ 92 - player entity.y @ 92 -
scroll scroll
draw-player player draw-entity
48 64 0 draw-sprite
640 640 2 draw-sprite
mouseworldpos 4 draw-sprite mouseworldpos 4 draw-sprite
draw-screen draw-screen
draw-footer ; draw-footer ;

BIN
game.prj

Binary file not shown.

View file

@ -80,6 +80,7 @@ BINOP(f_add, i, +)
BINOP(f_sub, i, -) BINOP(f_sub, i, -)
BINOP(f_mul, i, *) BINOP(f_mul, i, *)
BINOP(f_div, i, /) BINOP(f_div, i, /)
BINOP(f_mod, i, %)
BINOP(f_eq, i, ==) BINOP(f_eq, i, ==)
BINOP(f_neq, i, !=) BINOP(f_neq, i, !=)
BINOP(f_ge, i, >=) BINOP(f_ge, i, >=)
@ -871,6 +872,7 @@ void f_init() {
CDEF("-", f_sub); CDEF("-", f_sub);
CDEF("*", f_mul); CDEF("*", f_mul);
CDEF("/", f_div); CDEF("/", f_div);
CDEF("%", f_mod);
CDEF("=0", f_eq0); CDEF("=0", f_eq0);
CDEF("not", f_not); CDEF("not", f_not);
CDEF("=", f_eq); CDEF("=", f_eq);
@ -951,6 +953,7 @@ void f_init() {
CDEF("rstacksize", f_rstacksize); CDEF("rstacksize", f_rstacksize);
CDEF("task-user-size", f_taskusersize); CDEF("task-user-size", f_taskusersize);
PCONST("$DOCREATE", f_docreate); PCONST("$DOCREATE", f_docreate);
PCONST("$DOVAR", f_dovar);
PUSHS("boot.jor"); PUSHS("boot.jor");
f_open(); f_open();

Binary file not shown.