diff --git a/dtext.c b/dtext.c new file mode 100755 index 0000000..ae5b27c --- /dev/null +++ b/dtext.c @@ -0,0 +1,29 @@ +#include +#include "dtext.h" + +int dtext_x = 0; +int dtext_y = 0; +int dtext_left = 0; +int dtext_attr = 0x1f; + +void dtext_emit(char c) { + if (c == '\n') { + dtext_cr(); + return; + } + if (c == '\r') return; + WDTEXT[dtext_x + (dtext_y * 80)] = (c) | (dtext_attr << 8); + dtext_x ++; + if (dtext_x >= 80) { + dtext_cr(); + } + +} + +void dtext_emitattr(char attr) { + DTEXT[(dtext_x << 1) + (dtext_y * 160) + 1] = attr; + dtext_x ++; + if (dtext_x >= 80) { + dtext_cr(); + } +} diff --git a/dtext.h b/dtext.h new file mode 100755 index 0000000..cbde4c0 --- /dev/null +++ b/dtext.h @@ -0,0 +1,13 @@ +/* D I R E C T T E X T M O D E */ + +extern int dtext_x; +extern int dtext_y; +extern int dtext_left; +extern int dtext_attr; + +#define DTEXT ((volatile char far *)MK_FP(0xb800, 0)) +#define WDTEXT ((volatile int far *)MK_FP(0xb800, 0)) + +#define dtext_cr() { dtext_x = dtext_left; dtext_y ++; } +void dtext_emit(char c); +void dtext_emitattr(char attr); diff --git a/end.jim b/end.jim index 1238c68..bb50e46 100755 Binary files a/end.jim and b/end.jim differ diff --git a/end.jor b/end.jor index cdd03b5..8fcc862 100755 --- a/end.jor +++ b/end.jor @@ -1,10 +1,9 @@ ( E N D ) :noname - reset-level - s" end.map" load-map 7 11 tile>world Jaye entity.pos! 6 12 tile>world Neut entity.pos! + with-gord ; ' onload redefine diff --git a/entity.jim b/entity.jim index 5d6f9c2..caa7cdb 100755 Binary files a/entity.jim and b/entity.jim differ diff --git a/entity.jor b/entity.jor index 2c120e4..a67f284 100755 --- a/entity.jor +++ b/entity.jor @@ -58,6 +58,8 @@ var _responder 0 > if E else NODIR then then then then ; : facing ( x1 y1 x2 y2 -- dir ) -pos pos>dir ; +: face ( e1 e2 -- ) + over swap entity>pos pos facing swap entity.dir ! ; : entity-dst ( e -- x y ) >r r@ entity.dir @ dir>pos @@ -94,7 +96,8 @@ array frames does> ( dir a -- ) swap drop lookup-frame ; -1 defsingle {blank} -0 defsingle {gord-sit} +0 defsingle {gord-floor} +1 defsingle {gord-sit} 0 defstatic {gord-stand} 0 1 2 5 defanim {gord-walk} 2 defstatic {jaye-stand} diff --git a/footer.jim b/footer.jim index a8ce8a2..64226a0 100755 Binary files a/footer.jim and b/footer.jim differ diff --git a/game.jim b/game.jim index 5e68774..21d925e 100755 Binary files a/game.jim and b/game.jim differ diff --git a/game.jor b/game.jor index 44777a0..c8883c5 100755 --- a/game.jor +++ b/game.jor @@ -14,6 +14,7 @@ var player.prevdir 4 const HASNEUT userword 8 const HASGORD userword 16 const ISPROG userword +32 const GORDSIT userword 1 player.state HASNEUT f! @@ -32,9 +33,9 @@ var posessed-rexx : {gord} player.state HASGORD f@ if - isjaye? player.state MOVING f@ and + isjaye? player.state MOVING f@ and player.state GORDSIT f@ or if {gord-walk} else {gord-stand} then - else {gord-sit} then ; + else player.state GORDSIT f@ if {gord-sit} else {gord-floor} then then ; : player.canmove? ( x y -- ) player.state NOCLIP f@ not if @@ -100,24 +101,44 @@ var posessed-rexx S = if swap drop mapsize swap drop >= else drop mapsize drop >= then then then ; -defer jaye-touch ( x y -- b ) -defer neut-touch ( x y -- b ) +defer touch-override ( x y -- b ) : rexx-touch ( x y -- b ) - 2dup RUBBLE mapflag? if + 2dup RUBBLE mapflag? isrexx? and if tile 3 swap b! invalidate-map 0 - else 2dup tile b@ REXX-POD = if + else tile b@ REXX-POD = if move-player S posessed-rexx @ entity.dir ! posessed-rexx @ entity>pos Neut entity.pos! 0 posessed-rexx ! - drop drop 1 - else drop drop 0 then then ; + 1 + else 0 then then ; -: player-touch - isneut? if neut-touch else - isrexx? if rexx-touch else - jaye-touch then then ; +defer on-gord-sit + +: do-gord-sit ( x y -- b ) + player.state HASGORD f@ isjaye? and if + tile b@ CHAIR = if + 1 player.state GORDSIT f! + player.prevdir @ Gord entity.dir ! + Gord move-entity + player entity.dir @ Gord entity.dir ! + Gord move-entity + 0 player.state HASGORD f! + on-gord-sit + 1 + else 0 then + else drop drop 0 then ; + +: activate-dir ( x y dir -- ) + dir>pos +pos entity-at EVTOUCH entity>do ; + +: activate-gord + Gord entity>pos world>tile + 2dup N activate-dir + 2dup S activate-dir + 2dup E activate-dir + W activate-dir ; : touch-begin each 2dup more >rot drop drop ; : touch-next dup if rdrop done then drop rswap ; @@ -126,7 +147,9 @@ defer neut-touch ( x y -- b ) : check-player-touch ( x y -- b ) touch-begin entity-at dup if EVTOUCH entity>do 1 then - touch-next player-touch + touch-next touch-override + touch-next rexx-touch + touch-next do-gord-sit touch-next out-of-bounds touch-next player.canmove? not ;touch @@ -142,7 +165,6 @@ defer neut-touch ( x y -- b ) touch-next WALKABLE mapflag? ;touch : try-move-entity ( e -- ) - s" try-move-entity" type cr dup entity-dst check-entity-touch not if move-entity then ; var q-level @@ -153,6 +175,9 @@ var q-level player.state ISPROG fnot! isprog? if prog-view else human-view then then + ^Z key-pressed player.state GORDSIT f@ and isjaye? and if + activate-gord + then 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 @@ -160,22 +185,19 @@ var q-level if ' try-move-player sched then ; ( S T U F F ) -: reset-level - 0 objects ! - :| player.state HASGORD f@ not gord-present? and if Gord yield then - done |; ' entities redefine - :| drop drop 0 |; ' jaye-touch redefine - :| drop drop 0 |; ' neut-touch redefine ; userword +defer reset-level userword : mode-move player-tick -( objects @ if objects @ links each dup obj-entity EVTICK entity>do more ) + +( objects @ if objects @ links each dup obj-entity EVTICK entity>do more entities each EVTICK entity>do more party each EVTICK entity>do more - Neut EVTICK entity>do + Neut EVTICK entity>do ) DEV if tick-mapedit jiles then tick-debounce + q-level @ dup if 0 q-level ! reset-level @@ -200,7 +222,8 @@ var quaking 0 ticks 3 % 13 * 8 % scroll then - party each draw-entity more + party each dup Jaye != if draw-entity else drop then more + Jaye draw-entity player.state HASNEUT f@ if Neut draw-entity then objects @ if objects @ links each dup obj-entity draw-entity more @@ -337,10 +360,25 @@ var _dorubber Gord :noname dup EVTOUCH = isjaye? and player.state HASGORD f@ not and if - move-player - with-gord + player.state GORDSIT f@ if + 1 player.state HASGORD f! + Gord player face + Gord move-entity + 0 player.state GORDSIT f! + Gord follow + else move-player with-gord then then chain-listener ; +Gord @ const gord-listener +: chain-gord-listener gord-listener execute ; + +:noname + 0 objects ! + Gord gord-listener listener! + ' noop ' on-gord-sit redefine + :| player.state HASGORD f@ not gord-present? and if Gord yield then + done |; ' entities redefine + :| drop drop 0 |; ' touch-override redefine ; ' reset-level redefine :noname reset-level diff --git a/gameboot.jor b/gameboot.jor index 12f1ab3..d1e3812 100755 --- a/gameboot.jor +++ b/gameboot.jor @@ -1,7 +1,7 @@ : blah ' seremit task-emit ! ; blah -0 const DEV +1 const DEV : devon 1 ' DEV redefine ; @@ -35,10 +35,11 @@ intern lev00001.jor intern lev00002.jor intern lev00003.jor intern lev00004.jor +intern lev00005.jor intern end.jor :noname loadfile ; checkpoint _loadlevel ' _loadlevel ' loadlevel redefine -lev00004.jor loadlevel +lev00005.jor loadlevel diff --git a/jiles.jim b/jiles.jim index 5fffb08..681679a 100755 Binary files a/jiles.jim and b/jiles.jim differ diff --git a/job.jim b/job.jim index b9181bc..a9bfa30 100755 Binary files a/job.jim and b/job.jim differ diff --git a/jopl.c b/jopl.c index 585363e..f83d596 100755 --- a/jopl.c +++ b/jopl.c @@ -6,6 +6,7 @@ #include "kbd.h" #include "timer.h" #include "serial.h" +#include "dtext.h" cell ontick = 0; void f_adlib_read() { @@ -79,6 +80,14 @@ void f_random() { TOP().i = random(TOP().i); } +void f_dtextemit() { + dtext_emit(TOP().i); + DROP(1); +} +void f_dtextemitattr() { + dtext_emitattr(dtext_attr); +} + void do_repl(char *exe) { adlib_init(); @@ -96,6 +105,13 @@ void do_repl(char *exe) { CDEF("key-pressed", f_keyWasPressed); CDEF("key-down", f_keydown); CDEF("rnd", f_random); + PCONST("textx", &dtext_x); + PCONST("texty", &dtext_y); + PCONST("textleft", &dtext_left); + PCONST("textattr", &dtext_attr); + CDEF("emit-direct", f_dtextemit); + CDEF("attremit", f_dtextemitattr); + f_loadfile("jopl.jor"); ontick = f_lookupcp("ontick"); timer_setcallback(timer_callback); diff --git a/jopl.exe b/jopl.exe index 97c6696..018a306 100755 Binary files a/jopl.exe and b/jopl.exe differ diff --git a/jopl.jim b/jopl.jim new file mode 100755 index 0000000..7419a78 Binary files /dev/null and b/jopl.jim differ diff --git a/jopl.jor b/jopl.jor index 9b8ff8f..403a02a 100755 --- a/jopl.jor +++ b/jopl.jor @@ -171,35 +171,9 @@ array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , ( T E X T ) -var textx -var texty -var textattr -var textleft -0x1f textattr ! +: setattr-to ( w -- ) 0 for attremit next ; -: out-direct ( c -- ) - textattr @ 8 << | - texty @ 160 * textx @ 1 << + - 0xb800 !far ; - -: setattr-to ( w -- ) - texty @ 80 * textx @ + - dup rot - for dup i 1 << 1 + 0xb800 b!far next drop ; - -: clearline - textattr @ 8 << - texty @ 80 * textx @ + - texty @ 1 + 80 * - for dup i 1 << 0xb800 !far next drop ; - -: +textx! ( n -- ) - textx @ + dup 80 >= if drop cr else textx ! then ; -: emit-direct ( c -- ) - dup '\n' = if textleft @ textx ! 1 texty +! drop else - dup '\r' = if drop else - out-direct 1 +textx! then then ; +: clearline begin 0 emit-direct textx @ textleft @ = until ; : rpad ( n -- ) textleft @ + textx @ for bl next ; @@ -232,7 +206,7 @@ var textleft track @ dup if 20 0 for emit-status-cmd next then drop clearline ; -: trackstatus cr voice @ showtrack ; +: trackstatus voice @ showtrack ; var tempo userword 1 tempo ! : player @@ -250,7 +224,8 @@ var t2 t2 @ 0x03 adlib! 0x42 0x04 adlib! ; -: ontick startt2 player ' status 0 textleft textx texty preserving ( trackstatus ) ; +: ontick startt2 player + :| status trackstatus |; 0 textleft textx texty preserving ; : keynote [ inline| 44 b, 31 b, 45 b, 32 b, 46 b, 47 b, 34 b, 48 b, 35 b, 49 b, 36 b, 50 b, @@ -301,7 +276,7 @@ var stopkeys 41 key-pressed if noteoff then 88 key-pressed if rndinst then ; -: jam ' jamkeys dokeys ; userword +: jam ( todo: print? ) ' jamkeys dokeys ; userword var menuscroll var menuy diff --git a/jopl.prj b/jopl.prj index d34877d..24426a0 100755 Binary files a/jopl.prj and b/jopl.prj differ diff --git a/lev00001.jim b/lev00001.jim index d201aed..40210bd 100755 Binary files a/lev00001.jim and b/lev00001.jim differ diff --git a/lev00001.jor b/lev00001.jor index 0deb738..25f077b 100755 --- a/lev00001.jor +++ b/lev00001.jor @@ -59,8 +59,7 @@ sexit :noname jaye say" Neut might be able to\hack it..." then chain-listener ; -:noname - reset-level O +:noname O s" lev00001.map" load-map 0 player.state HASNEUT f! diff --git a/lev00002.jim b/lev00002.jim index dc76898..a84524d 100755 Binary files a/lev00002.jim and b/lev00002.jim differ diff --git a/lev00002.jor b/lev00002.jor index 56d79cb..6ebc48a 100755 --- a/lev00002.jor +++ b/lev00002.jor @@ -48,8 +48,7 @@ c2 :noname neut say" THIS INCIDENT HAS\BEEN REPORTED" then chain-listener ; -:noname - reset-level O +:noname O s" lev00002.map" load-map 11 11 tile>world Jaye entity.pos! diff --git a/lev00003.jim b/lev00003.jim index 418ca62..0e869e4 100755 Binary files a/lev00003.jim and b/lev00003.jim differ diff --git a/lev00003.jor b/lev00003.jor index f616ce4..7c1740e 100755 --- a/lev00003.jor +++ b/lev00003.jor @@ -96,7 +96,10 @@ d2 :noname then chain-listener ; var gord-up -Gord :noname + +:noname O + + Gord :| dup EVTOUCH = isrexx? and if gord say" AHHH NOOO\NOT GARBAGE\I AM NOT GARBAGE" rexx say" Whatever you say, boss!" @@ -107,7 +110,7 @@ Gord :noname jaye say" Here, let me help you up." hide-footer then - dup chain-listener + dup chain-gord-listener EVTOUCH = isjaye? and gord-up @ not and if 1 gord-up ! gord say" Thanks." @@ -115,10 +118,7 @@ Gord :noname jaye say" I can help you get around if\you help me navigate this\maze of a security system." gord say" I'm just as eager to get\out of here as you." gord say" Let's go." - then ; - -:noname - reset-level O + then |; listener! s" lev00003.map" load-map 7 11 tile>world Jaye entity.pos! diff --git a/lev00004.jim b/lev00004.jim index a73aeb6..fa97c8d 100755 Binary files a/lev00004.jim and b/lev00004.jim differ diff --git a/lev00004.jor b/lev00004.jor index 4ebab06..fb28733 100755 --- a/lev00004.jor +++ b/lev00004.jor @@ -5,7 +5,7 @@ objects: O 15 6 door d1 11 6 door d2 10 4 door d3 -end.jor 0 4 exitdoor dx +lev00005.jor 0 4 exitdoor dx 15 11 defrexx Rexx @@ -25,8 +25,16 @@ defer c1-targ :noname c2 computer-on? if c2 else c3 then ; ' c1-targ redefine -:noname - reset-level O +var first-gord-sit + +:noname O + + :| first-gord-sit @ not if + 1 first-gord-sit ! + gord say" Phew, it feels good to\rest my leg for a bit." + gord say" If you need me to do something\from my chair, you can press\the Z key." + then + |; ' on-gord-sit redefine s" lev00004.map" load-map 18 4 tile>world Jaye entity.pos! diff --git a/lev00004.map b/lev00004.map index 212f8a2..6a11295 100755 Binary files a/lev00004.map and b/lev00004.map differ diff --git a/lev00005.jim b/lev00005.jim new file mode 100755 index 0000000..c912c69 Binary files /dev/null and b/lev00005.jim differ diff --git a/lev00005.jor b/lev00005.jor new file mode 100755 index 0000000..0b4b087 --- /dev/null +++ b/lev00005.jor @@ -0,0 +1,34 @@ +( L E V 0 0 0 0 5 ) + +objects: O + +16 7 defrexx Rexx + +:noname 0 MAXTILE for i tileflags + b@ RUBBLE & if i b, then next ; +array rubbletiles execute +here rubbletiles - 1 - const MAXRUBBLE + +: randomrubble ticks MAXRUBBLE % rubbletiles + b@ ; + +: rexx-pos ( -- x y ) Rexx entity>pos world>tile ; +: rexx-dest ( -- x y ) rexx-pos Rexx entity.dir @ dir>pos +pos ; + +: can-drop-rubble? ( -- b ) rexx-pos tile b@ CARPET = ; +: not-picking-up? ( -- b ) rexx-dest RUBBLE mapflag? not ; + +: touch ( x y -- b ) + drop drop + not-picking-up? can-drop-rubble? and isrexx? and if + randomrubble rexx-pos tile b! invalidate-map + then 0 ; + +:noname O + + ' touch ' touch-override redefine + + s" lev00005.map" load-map + 18 4 tile>world Jaye entity.pos! + 19 5 tile>world Neut entity.pos! + with-gord + +; ' onload redefine diff --git a/lev00005.map b/lev00005.map new file mode 100755 index 0000000..645c44b Binary files /dev/null and b/lev00005.map differ diff --git a/map.jim b/map.jim index 658ff2e..cf151ea 100755 Binary files a/map.jim and b/map.jim differ diff --git a/map.jor b/map.jor index 75b950d..f757752 100755 --- a/map.jor +++ b/map.jor @@ -37,8 +37,10 @@ array tileflags here tileflags - 1 - const MAXTILE + 3 const CARPET 4 const COMP-OFF 5 const COMP-ON + 7 const CHAIR 9 const DOOR-CLOSED 10 const DOOR-OPENED 11 const SWITCH-OFF diff --git a/sprite.gfx b/sprite.gfx index 9417460..40fb3ef 100755 Binary files a/sprite.gfx and b/sprite.gfx differ diff --git a/state.jim b/state.jim index c26897f..57a8b84 100755 Binary files a/state.jim and b/state.jim differ diff --git a/tiles.gfx b/tiles.gfx index 984e837..c8076c4 100755 Binary files a/tiles.gfx and b/tiles.gfx differ