diff --git a/blart.map b/blart.map deleted file mode 100755 index e69de29..0000000 diff --git a/boot.jim b/boot.jim index 27ecbc0..819658e 100755 Binary files a/boot.jim and b/boot.jim differ diff --git a/defs.jim b/defs.jim index 7ed7c39..58c6fd0 100755 Binary files a/defs.jim and b/defs.jim differ diff --git a/defs.jor b/defs.jor index cd1bca0..16fedce 100755 --- a/defs.jor +++ b/defs.jor @@ -56,6 +56,15 @@ : min ( x y -- x|y ) 2dup > if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ; +: checkpoint ( cp -- ) + create here 4 cells + , latest , tasks , , + does> dup @ here! + dup cell + @ latest! + dup 2 cells + @ tasks! + 3 cells + @ execute ; + +: intern create latest wordname , does> @ ; + : decompile word lookup if 1 begin ( cp i ) 2dup cells + @ ( cp i @cp+i ) @@ -85,7 +94,7 @@ dup .wordin s" : " type dup task-sp @ over task-stack ( task stackLim stack ) begin 2dup > while dup @ . cell + repeat - cr drop drop more ; + cr drop drop more ; : doactivate ( task ip -- ) over task-ip ! diff --git a/entity.jim b/entity.jim index d6f167e..92d2958 100755 Binary files a/entity.jim and b/entity.jim differ diff --git a/entity.jor b/entity.jor index bcec31b..998a2af 100755 --- a/entity.jor +++ b/entity.jor @@ -1,7 +1,10 @@ 0 const EVTICK 1 const EVTOUCH -: defentity ( x y dir anim -- ) array ' drop , , , 4 << , 4 << , ; +: world>tile 4 >> swap 4 >> swap ; +: tile>world 4 << swap 4 << swap ; + +: defentity ( x y dir anim -- ) array ' drop , , , tile>world , , ; : entity.x 4 cells + ; : entity.y 3 cells + ; : entity.dir 2 cells + ; diff --git a/footer.jim b/footer.jim index 3d22b00..7e22044 100755 Binary files a/footer.jim and b/footer.jim differ diff --git a/forp.exe b/forp.exe deleted file mode 100755 index 577e287..0000000 Binary files a/forp.exe and /dev/null differ diff --git a/game.exe b/game.exe index feec981..e579c3f 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jim b/game.jim index 9b17b5c..805e31b 100755 Binary files a/game.jim and b/game.jim differ diff --git a/game.jor b/game.jor index ba5c97d..857b9a2 100755 --- a/game.jor +++ b/game.jor @@ -15,7 +15,6 @@ JOB listen-for-jobs ( T I C K ) defer entities -:noname 0 ; ' entities redefine : entity-at ( x y -- entity|0 ) 0 >rot @@ -69,9 +68,7 @@ defer player S = if swap drop mapsize swap drop >= else drop mapsize drop >= then then then ; -: no-touch drop drop 0 ; defer player-touch ( x y -- b ) -' no-touch ' player-touch redefine : check-player-touch ( x y -- b ) 2dup entity-at dup if EVTOUCH entity>do drop drop 1 else drop @@ -90,6 +87,9 @@ defer player-touch ( x y -- b ) : try-move-entity ( e -- ) dup entity-dst check-entity-touch not if move-entity then ; +var queued-level +: queue-level queued-level ! ; + player :tick 0 ^LEFT key-down if drop 1 W player entity.dir ! then ^RIGHT key-down if drop 1 E player entity.dir ! then @@ -108,7 +108,11 @@ player :tick ^SPACE key-pressed if ' hello-world JOB send then - tick-debounce ; + tick-debounce + queued-level @ dup if + 0 queue-level + loadlevel + else drop then ; ' mode-move MODE-MOVE ! ' tick-debounce MODE-WAIT ! @@ -128,7 +132,12 @@ player :tick draw-screen draw-footer ; +: reset-level + :| player yield 0 |; ' entities redefine + :| drop drop 0 |; ' player-touch redefine ; + :noname -MODE-MOVE @ ' tick redefine -' full-draw ' draw redefine + reset-level + MODE-MOVE @ ' tick redefine + ' full-draw ' draw redefine ; ' onload redefine \ No newline at end of file diff --git a/game.prj b/game.prj index ac99acb..ff5b3ae 100755 Binary files a/game.prj and b/game.prj differ diff --git a/gameboot.jor b/gameboot.jor index 2080b7a..8140a93 100755 --- a/gameboot.jor +++ b/gameboot.jor @@ -9,6 +9,7 @@ REPL start-repl defer tick defer draw +defer loadlevel :noname s" input.jor" loadfile @@ -17,6 +18,12 @@ s" timer.jor" loadfile s" footer.jor" loadfile s" map.jor" loadfile s" game.jor" loadfile +; execute -s" pete.jor" loadfile -; ' onload redefine +intern pete.jor +intern petehous.jor + +:noname loadfile ; checkpoint _loadlevel +' _loadlevel ' loadlevel redefine + +pete.jor loadlevel diff --git a/input.jim b/input.jim index 6c9b75f..4a26a3e 100755 Binary files a/input.jim and b/input.jim differ diff --git a/jorth.c b/jorth.c index e402a0e..ece3d7f 100755 --- a/jorth.c +++ b/jorth.c @@ -1,3 +1,5 @@ +#define TRACE + #include #include #include "jorth.h" @@ -29,6 +31,9 @@ cell *RUNNING = (cell*)mem; cell *TASKS = (cell*)mem; cell *stack = ((cell*)mem) + STACK_OFFSET; cell *rstack = ((cell*)mem) + RSTACK_OFFSET; +#ifdef TRACE +int TRACING = 0; +#endif #define QUIET (*(RUNNING + TASK_USER_QUIET)) @@ -432,6 +437,7 @@ void f_cdef() { // func name -- } void f_docolon(); +void f_revlookup(); // C code must always call a colon word through f_cexecute() void f_cexecute() { @@ -449,9 +455,35 @@ void f_cexecute() { IP = oldIP; } +#ifdef TRACE +void f_traceon() { + TRACING = 1; +} +void f_traceoff() { + TRACING = 0; +} +#endif + void f_colondispatch() { cell codeptr; +#ifdef TRACE + static int printing = 0; + if (TRACING && !printing) { + printing = 1; + PUSHCP(W.p); + f_revlookup(); + if (TOP().s) { + f_puts(); + PUSHU(' '); + f_emit(); + } else { + TOP().p = W.p; + f_dot(); + } + printing = 0; + } +#endif codeptr = *W.p; if (codeptr.f == f_docolon) { RPUSH(IP); @@ -1076,6 +1108,10 @@ void f_init() { PCONST("$DOCREATE", f_docreate); PCONST("$DOVAR", f_dovar); PCONST("$DODEFERRED", f_dodeferred); +#ifdef TRACE + CDEF("traceon", f_traceon); + CDEF("traceoff", f_traceoff); +#endif f_loadfile_cterp("boot.jor"); f_loadfile("defs.jor"); diff --git a/map.jim b/map.jim index c61b8e5..5350678 100755 Binary files a/map.jim and b/map.jim differ diff --git a/map.jor b/map.jor index 20cc6fd..e86a0a0 100755 --- a/map.jor +++ b/map.jor @@ -3,10 +3,8 @@ rot + swap ; var tileselect -8 const MAXTILE - +: invalidate-map mapsize mapsize! ; : mouseworldpos mousepos scrollpos +pos ; -: world>tile 4 >> swap 4 >> swap ; : mousetile mouseworldpos world>tile ; : tile ( x y -- ptr ) mapsize drop * + map + ; @@ -14,15 +12,25 @@ var tileselect 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, +( 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, +( carpet ) WALKABLE b, +( wallpaper ) 0 b, +( tile ) WALKABLE b, +( door ) 0 b, +( cabinet ) 0 b, +( fridge ) 0 b, +( countertop ) 0 b, +( sink ) 0 b, + +here tileflags - 1 - const MAXTILE : mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ; : walkable? ( x y -- b ) WALKABLE mapflag? ; @@ -36,8 +44,11 @@ array tileflags dup MAXTILE > if drop 0 then tileselect ! - MOUSEL mousedown if tileselect @ mousetile tile b! then - MOUSER clicked if mouseworldpos world>tile swap . . then ; + MOUSEL mousedown if tileselect @ mousetile tile b! invalidate-map then + MOUSER clicked if + mouseworldpos world>tile + 2dup tile b@ dup tileselect ! . + swap . . cr then ; : copy-mapseg ( neww oldw y -- ) r> ( oldw neww r: y ) @@ -64,3 +75,6 @@ array tileflags 2dup * map fread mapsize! factivate ; + +: fill-map ( tile -- ) + 0 mapsize * for dup map i + b! next drop invalidate-map ; diff --git a/pete.jim b/pete.jim index 93e9e96..1bf0905 100755 Binary files a/pete.jim and b/pete.jim differ diff --git a/pete.jor b/pete.jor index 2416acb..09e6907 100755 --- a/pete.jor +++ b/pete.jor @@ -8,15 +8,17 @@ car :touch ;entity :noname - :| player yield + :| player yield player.driving? not if car yield then 0 |; ' entities redefine ( TODO: DSL for touch events? ) - :| 2dup S leaving? player.driving? not and if + :| 2dup S leaving? player.driving? not and if pete say" It's too far to walk to town." 1 else 2dup 12 7 2= if - player.driving? not if pete say" TODO: Go home" then 1 + player.driving? not if + petehous.jor queue-level + then 1 else 0 then then >rot drop drop |; ' player-touch redefine s" pete.map" load-map diff --git a/pete.map b/pete.map index f64bffd..29ec624 100755 Binary files a/pete.map and b/pete.map differ diff --git a/petehous.jim b/petehous.jim new file mode 100755 index 0000000..60bfdc7 Binary files /dev/null and b/petehous.jim differ diff --git a/petehous.jor b/petehous.jor new file mode 100755 index 0000000..8069463 --- /dev/null +++ b/petehous.jor @@ -0,0 +1,14 @@ +( P E T E ' S H O U S E ) + +:noname + reset-level + 16 9 tile>world player entity.pos! + :| 16 10 2= if + 12 8 tile>world player entity.pos! + pete.jor queue-level + 1 else 0 then + |; ' player-touch redefine + + s" petehous.map" load-map +; ' onload redefine + diff --git a/petehous.map b/petehous.map new file mode 100755 index 0000000..3f5c161 Binary files /dev/null and b/petehous.map differ diff --git a/tiles.tif b/tiles.tif index debcfba..a988833 100755 Binary files a/tiles.tif and b/tiles.tif differ diff --git a/timer.jim b/timer.jim index 7078a5c..2a2e84a 100755 Binary files a/timer.jim and b/timer.jim differ