diff --git a/defs.jim b/defs.jim index 58c6fd0..1104381 100755 Binary files a/defs.jim and b/defs.jim differ diff --git a/defs.jor b/defs.jor index 16fedce..0c3491c 100755 --- a/defs.jor +++ b/defs.jor @@ -15,6 +15,7 @@ rot drop drop ; + : test-xy { x y -- b } + search-xy 1 2 2= yield 3 4 2= yield drop drop 999 yield ; + test-xy will return 1 if x y is 1 2 or 3 4, otherwise it returns 999. + Note that it must always end with a yield, as search has no way to tell + the difference between an early termination and a final non-zero result. +) +: search + ' yield , ' dup , ' not , [ ' while , ] ' drop , [ ' repeat , ] + ' rdrop , ; immediate + : min ( x y -- x|y ) 2dup > if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ; diff --git a/entity.jim b/entity.jim index 92d2958..47cf9bd 100755 Binary files a/entity.jim and b/entity.jim differ diff --git a/footer.jim b/footer.jim index 7e22044..c908f9a 100755 Binary files a/footer.jim and b/footer.jim differ diff --git a/footer.jor b/footer.jor index 06666b0..ebdc885 100755 --- a/footer.jor +++ b/footer.jor @@ -33,16 +33,16 @@ var textx var texty 2 const textspeed -: nltext 7 textx ! 10 texty +! ; +: nltext 6 textx ! 10 texty +! ; : inctextx textx @ 1 + dup 38 <= if textx ! - else drop nltext then ; + else drop nltext inctextx then ; key \ const '\' : statusc dup dup '\' = swap '\n' = or if drop nltext else dup '\r' = if drop - else textx @ texty @ rot drop drop 1 - ; +: touched? if 2 else 1 then ; +: touched-more? if 2 else 0 then ; +: touch-next ' touched-more? , ' yield , ; immediate +: touch-last ' touched? , ' yield , ; immediate +: ;touch [ ' touch-last , ' [ , ] ; immediate + : check-player-touch ( x y -- b ) - 2dup entity-at dup if EVTOUCH entity>do drop drop 1 else drop - 2dup player-touch if drop drop 1 else - 2dup out-of-bounds if drop drop 1 else - player.canmove? if 0 else 1 then then then then ; + touch-begin entity-at dup if EVTOUCH entity>do 1 then + touch-next player-touch + touch-next out-of-bounds + touch-next player.canmove? not ;touch : try-move-player player entity-dst check-player-touch not if move-player then ; -: check-entity-touch ( x y -- b ) - 2dup entity-at if drop drop 1 else - 2dup out-of-bounds if 1 else - WALKABLE mapflag? if 0 else 1 then then then ; +: check-entity-touch + touch-begin entity-at + touch-next out-of-bounds + touch-next WALKABLE mapflag? ;touch : try-move-entity ( e -- ) dup entity-dst check-entity-touch not if move-entity then ; @@ -100,7 +107,7 @@ player :tick ( S T U F F ) : hello-world - player.state DRIVING f@ not player.state DRIVING f! ; + player.state DRIVING fnot! ; : mode-move entities each EVTICK entity>do more diff --git a/game.prj b/game.prj index ff5b3ae..18d73f5 100755 Binary files a/game.prj and b/game.prj differ diff --git a/input.jim b/input.jim index 4a26a3e..b0a17eb 100755 Binary files a/input.jim and b/input.jim differ diff --git a/map.jim b/map.jim index 5350678..cbb112a 100755 Binary files a/map.jim and b/map.jim differ diff --git a/pete.jim b/pete.jim index 1bf0905..e0772b5 100755 Binary files a/pete.jim and b/pete.jim differ diff --git a/pete.jor b/pete.jor index 09e6907..e81e94b 100755 --- a/pete.jor +++ b/pete.jor @@ -12,15 +12,13 @@ car :touch player.driving? not if car yield then 0 |; ' entities redefine - ( TODO: DSL for touch events? ) - :| 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 - petehous.jor queue-level - then 1 - else 0 then then >rot drop drop - |; ' player-touch redefine + :| touch-begin S leaving? player.driving? not and dup if + pete say" It's too far to walk to town." then + touch-next 12 7 2= dup if + player.driving? not if + petehous.jor queue-level + then then + touch-last |; ' player-touch redefine s" pete.map" load-map ; ' onload redefine diff --git a/petehous.jim b/petehous.jim index 60bfdc7..2b12a94 100755 Binary files a/petehous.jim and b/petehous.jim differ diff --git a/petehous.jor b/petehous.jor index 8069463..c9d4880 100755 --- a/petehous.jor +++ b/petehous.jor @@ -3,11 +3,19 @@ :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 + :| +touch-begin 16 10 2= dup if + 12 8 tile>world player entity.pos! + pete.jor queue-level +then touch-next 9 4 2= dup if + pete say" The closet is a disaster.\I don't want to deal with that\right now." +then touch-next 11 4 2= dup if + pete say" I'm already dressed." +then touch-next 16 3 2= dup if + pete say" The sink's full of nasty dishes.\I'm not touching them." +then touch-next 18 3 2= dup if + pete say" Should get some more beer soon." +then touch-last |; ' player-touch redefine s" petehous.map" load-map ; ' onload redefine diff --git a/repl.jim b/repl.jim new file mode 100755 index 0000000..8d373a8 Binary files /dev/null and b/repl.jim differ diff --git a/timer.jim b/timer.jim index 2a2e84a..8986c67 100755 Binary files a/timer.jim and b/timer.jim differ