diff --git a/game.exe b/game.exe index f615d95..956badc 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index 546e3df..0968b20 100755 --- a/game.jor +++ b/game.jor @@ -13,6 +13,8 @@ REPL start-repl 1 const ^ESC 28 const ^ENTER 29 const ^CTRL +51 const ^< +52 const ^> 56 const ^ALT 57 const ^SPACE 72 const ^UP @@ -43,6 +45,12 @@ defer draw 2 const N 3 const S +: dir>pos ( dir -- dx dy ) + dup W = if drop -1 0 ret then + dup E = if drop 1 0 ret then + N = if 0 -1 + else 0 1 then ; + : defsprite ( s n e w ) b, b, b, b, here 4 - const ; : sprindex ( sprite dir ) + b@ ; @@ -50,8 +58,8 @@ defer draw defentity player -100 player entity.x ! -100 player entity.y ! +128 player entity.x ! +128 player entity.y ! ( timer + lerping ) : clamp0 ( range val -- i ) @@ -59,9 +67,8 @@ defentity player dup 0 <= if drop drop 0 else swap drop then then ; : >ratio ( range value -- f ) - over swap clamp0 >fix swap >fix fix/ ; -: fix fix* ratio ; +: range ( start end -- start range ) over - ; : >range r< ? ) +var move-timer +var move-speed -: move-footer-to ( ytarget -- ) - footer-y @ swap ( from to -- ) - footer-timer now! +: move-to ( p target speed -- ) + move-speed ! swap dup r> @ swap ( from to -- ) + move-timer now! begin - 2dup 10 footer-timer lerp ( from to now -- ) - dup footer-y ! + 2dup move-speed @ move-timer lerp ( from to now -- ) + dup r< dup r> ! over != ( from to -- ) while suspend - repeat drop drop ; + repeat drop drop r< drop ; -: show-footer 24 move-footer-to ; -: hide-footer 0 move-footer-to ; +: show-footer footer-y 24 10 move-to ; +: hide-footer footer-y 0 10 move-to ; : say1 ( s -- ) clear text1 show-footer ^ENTER wait-key ; : say2 ( s1 s2 -- ) clear text2 text1 show-footer ^ENTER wait-key ; -( T I C K ) +( M O U S E ) -: tick-player - 0 ^LEFT key-down if 3 - W player entity.dir ! then - ^RIGHT key-down if 3 + E player entity.dir ! then - player entity.x +! - 0 ^UP key-down if 3 - N player entity.dir ! then - ^DOWN key-down if 3 + S player entity.dir ! then - player entity.y +! ; +var prevbutton +: tick-debounce + mousebuttons prevbutton ! ; +1 const MOUSEL +: mousedown ( button -- bool ) mousebuttons & ; +: clicked ( button -- bool ) + dup mousedown not swap + prevbutton @ & and ; + +( M A P ) +: +pos ( x1 y1 x2 y2 -- x y ) + rot + rot rot + swap ; + +var tileselect +3 const MAXTILE + +: mouseworldpos mousepos scrollpos +pos ; +: mousetile mouseworldpos 4 >> swap 4 >> swap ; +: tile ( x y -- ptr ) mapsize drop * + map + ; + +: tick-mapedit + tileselect @ + ^< key-pressed if 1 - then + ^> key-pressed if 1 + then + dup 0 < if drop MAXTILE then + dup MAXTILE > if drop 0 then + tileselect ! + + MOUSEL mousedown if tileselect @ mousetile tile b! then ; + + +( J O B ) var MODE-MOVE var MODE-WAIT -( J O B ) : listen-for-jobs activate blah begin receive MODE-WAIT @ ' tick redefine @@ -131,15 +164,35 @@ var MODE-WAIT task const JOB JOB listen-for-jobs -: hello-world s" Hello, world!" say1 s" How are you" s" today?" say2 ; +( T I C K ) + +: move-player + player entity.dir @ dir>pos + dup if swap drop player entity.y ( d v -- ) + else drop player entity.x then + swap 16 * over @ + 5 move-to ; + +: tick-player + 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 + if ' move-player JOB send then ; + +: hello-world + s" Hello, world!" say1 + s" How are you" s" today?" say2 ; : mode-move tick-player + tick-mapedit ^SPACE key-pressed if ' hello-world JOB send - then ; + then + tick-debounce ; + ' mode-move MODE-MOVE ! -' noop MODE-WAIT ! +' tick-debounce MODE-WAIT ! : draw-player player entity.x @ @@ -153,8 +206,9 @@ JOB listen-for-jobs scroll draw-player - 50 50 0 draw-sprite - 600 600 2 draw-sprite + 48 64 0 draw-sprite + 640 640 2 draw-sprite + mouseworldpos 4 draw-sprite draw-screen draw-footer ; diff --git a/game.prj b/game.prj index 17f475b..9889ef2 100755 Binary files a/game.prj and b/game.prj differ diff --git a/jorth.c b/jorth.c index a57464b..19f81a9 100755 --- a/jorth.c +++ b/jorth.c @@ -96,18 +96,15 @@ BINOP(f_bitxor, u, ^) BINOP(f_shr, u, >>) BINOP(f_shl, u, <<) -void f_itofix() { - TOP().i = TOP().i << FIX_FRACTIONAL_BITS; -} -void f_fixtoi() { - TOP().i = TOP().i >> FIX_FRACTIONAL_BITS; -} -void f_fixmul() { - ST1().i = ((long)ST1().i * (long)TOP().i) / (1 << FIX_FRACTIONAL_BITS); +#define RATIO_FRACTIONAL_BITS 14 + +void f_toratio() { // a/b ( a b -- r ) + ST1().i = ((long)ST1().i * (1 << RATIO_FRACTIONAL_BITS)) / TOP().i; DROP(1); } -void f_fixdiv() { - ST1().i = ((long)ST1().i * (1 << FIX_FRACTIONAL_BITS)) / TOP().i; + +void f_fromratio() { // a*r ( a r -- b ) + ST1().i = ((long)ST1().i * (long)TOP().i) / (1 << RATIO_FRACTIONAL_BITS); DROP(1); } @@ -813,10 +810,8 @@ void f_init() { CDEF("^", f_bitxor); CDEF("<<", f_shl); CDEF(">>", f_shr); - CDEF(">fix", f_itofix); - CDEF("ratio", f_toratio); + CDEF("*