diff --git a/defs.jor b/defs.jor index 8b161a3..360ce80 100755 --- a/defs.jor +++ b/defs.jor @@ -8,8 +8,9 @@ s" jorth.log" open const LOGFILE : 2dup over over ; : noop ; + : defer word new-word docolon , ' noop , ' ret , ; -: is ( cp -- ) word lookup drop cell + ! ; +: redefine ( cp cpdeferred ) cell + ! ; : decompile word lookup if 1 begin ( cp i ) diff --git a/game.exe b/game.exe index 99625a7..89f507c 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index 6bba236..cbbc587 100755 --- a/game.jor +++ b/game.jor @@ -1,6 +1,8 @@ : blah ' seremit task-emit ! ' log-emit task-echo ! ; +blah +' seremit task-emit ! : start-repl activate blah s" .:: J O R T H ( jean forth) ::." type cr @@ -51,6 +53,30 @@ defentity player 100 player entity.x ! 100 player entity.y ! +( timer + lerping ) +: clamp0 ( range val -- i ) + 2dup <= if drop else + dup 0 <= if drop drop 0 else + swap drop then then ; +: >ratio ( range value -- f ) + over swap clamp0 >fix swap >fix fix/ ; +: fix fix* range ( start end -- start range ) over - ; +: >range r< >range r< rot - >ratio lerpr ; +: lerp ( start end duration timer -- i ) + @ ticks udelta ( start end duration delta ) + >ratio lerpr ; + +: triggered ( duration timer -- b ) + dup r> @ ticks udelta ( duration delta ) + 2dup <= if drop r< +! 1 else drop drop 0 then ; + +: now! ( timer -- ) ticks swap ! ; + : tick-player 0 ^LEFT key-down if 3 - W player entity.dir ! then ^RIGHT key-down if 3 + E player entity.dir ! then @@ -59,6 +85,33 @@ defentity player ^DOWN key-down if 3 + S player entity.dir ! then player entity.y +! ; +var MODE-TRAVEL +var MODE-TEXT +var split-timer + +: enter-mode-text + split-timer now! + MODE-TEXT @ ' tick redefine ; + +: mode-travel + tick-player + ^SPACE key-pressed if + enter-mode-text + then ; +' mode-travel MODE-TRAVEL ! + +: mode-text-hide + 24 0 10 split-timer lerp dup split-screen + 0 = if ' mode-travel ' tick redefine then ; + +: mode-text-show + 0 24 10 split-timer lerp split-screen + ^SPACE key-pressed if + split-timer now! + ' mode-text-hide ' tick redefine + then ; +' mode-text-show MODE-TEXT ! + : draw-player player entity.x @ player entity.y @ @@ -75,5 +128,5 @@ defentity player 600 600 2 draw-sprite draw-screen ; -' tick-player is tick -' full-draw is draw +MODE-TRAVEL @ ' tick redefine +' full-draw ' draw redefine diff --git a/game.prj b/game.prj index de0d414..dca032a 100755 Binary files a/game.prj and b/game.prj differ diff --git a/jorth.c b/jorth.c index a7cd066..a57464b 100755 --- a/jorth.c +++ b/jorth.c @@ -93,6 +93,23 @@ BINOP(f_or, u, ||) BINOP(f_bitand, u, &) BINOP(f_bitor, u, |) 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); + DROP(1); +} +void f_fixdiv() { + ST1().i = ((long)ST1().i * (1 << FIX_FRACTIONAL_BITS)) / TOP().i; + DROP(1); +} void f_eq0() { TOP().i = (TOP().i == 0); @@ -217,13 +234,13 @@ void f_word() { int key = ' '; int ibuf = 0; - while (key == ' ' || key == '\n' || key == '\r') { + while (key == ' ' || key == '\t' || key == '\n' || key == '\r') { f_key(); key = TOP().i; DROP(1); } - while (key != ' ' && key != '\n' && key != '\r' && key != 0) { + while (key != ' ' && key != '\t' && key != '\n' && key != '\r' && key != 0) { buf[ibuf++] = key; f_key(); key = TOP().i; @@ -794,6 +811,12 @@ void f_init() { CDEF("&", f_bitand); CDEF("|", f_bitor); CDEF("^", f_bitxor); + CDEF("<<", f_shl); + CDEF(">>", f_shr); + CDEF(">fix", f_itofix); + CDEF("