diff --git a/entity.jor b/entity.jor index f496c2f..cfe04ee 100755 --- a/entity.jor +++ b/entity.jor @@ -101,7 +101,7 @@ array frames create b, dup b, 0 for b, next does> ( dir a -- ) swap drop lookup-frame ; --1 defsingle {{blank}} +-1 defsingle {blank} 0 defstatic {car} 5 defstatic {car-lit} 1 defstatic {pete-stand} @@ -122,11 +122,6 @@ array frames 46 defsingle {aliem} 13 14 2 5 defmulti {neut} -var _dorubber -: {blank} _dorubber @ if {duck} else {{blank}} then ; -: rubber _dorubber @ not _dorubber ! ; - - : sprite-bob ( x y sprindex -- x y sprindex ) dup 13 >= over 14 <= and if >rot 2dup + ticks + 40 % 20 < if 1 + then r 2dup ( x y x y r:e ) + r@ entity.x @ r@ entity.y @ world>tile 2= ( x y b r:e ) + if rot - entities each >r 2dup ( 0 x y x y r:e ) - r@ entity.x @ r@ entity.y @ world>tile 2= ( 0 x y eq r:e ) - if rot break ( e x y ) - else rdrop then ( 0 x y ) - more drop drop ; + 0 entities each single-entity-at if break then more + dup not objects @ and if + objects @ links each + >r r@ obj-entity single-entity-at if rdrop 0 else rot drop drop ; ( P L A Y E R ) var player.state userword @@ -29,7 +38,7 @@ var player.prevdir : isjaye? isneut? not ; userword : {jaye} - isneut? not player.state MOVING f@ and + isjaye? player.state MOVING f@ and if {jeanne-walk} else {jeanne} then ; : player.canmove? ( x y -- ) @@ -116,12 +125,14 @@ var q-player.y ( S T U F F ) : reset-level + 0 objects ! :| done |; ' entities redefine :| drop drop 0 |; ' jaye-touch redefine :| drop drop 0 |; ' neut-touch redefine ; userword : mode-move player-tick +( objects @ if objects @ links each dup obj-entity EVTICK entity>do more ) entities each EVTICK entity>do more party each EVTICK entity>do more pneut EVTICK entity>do @@ -149,6 +160,9 @@ var showmouse var glitchlevel var quaking +var _dorubber +: rubber _dorubber @ not _dorubber ! ; + : full-draw quaking @ not if player entity.x @ 152 - @@ -158,6 +172,9 @@ var quaking 0 ticks 3 % 13 * 8 % scroll then + _dorubber @ objects @ and if + objects @ links each dup obj-entity draw-entity more + then entities each draw-entity more party each draw-entity more player.state HASNEUT f@ if pneut draw-entity then @@ -169,6 +186,72 @@ var quaking draw-screen draw-footer ; +var defining-objects-head +var defining-objects-ptr +: objects: create here 0 , + 0 defining-objects-head ! + defining-objects-ptr ! +does> @ objects ! ; + +: link-object ( entity -- ) + here defining-objects-head @ , swap , + dup defining-objects-head ! + defining-objects-ptr @ ! ; + + 4 const COMP-OFF + 5 const COMP-ON + 9 const DOOR-CLOSED +10 const DOOR-OPENED +11 const SWITCH-OFF +12 const SWITCH-ON + + +: entity>tile ( entity -- tile ) entity>pos world>tile tile ; +: entity>tile? ( entity expected - b ) swap entity>tile b@ = ; + +: toggleval ( off on val -- off|on ) over = not if swap then drop ; +: toggletile ( entity off on -- ) + r r@ entity>tile b@ toggleval tile b! invalidate-map ; + +: respondertile! ( tile -- ) responder entity>tile b! invalidate-map ; + +: handle-onoff ( ev on off -- ) + rot toggletile else + drop drop drop then then then ; +: statechange? ( ev -- b ) + dup EVACT = over EVDEACT = or swap EVTOG = or ; + +: blankentity array here >r N ' {duck} allotentity tile? if EVACT else EVDEACT then + responder entity.user @ swap entity>do + else drop then ; + +: door blankentity dup link-object + :| dup EVTOUCH = isjaye? and responder DOOR-OPENED entity>tile? and if + move-player + then + DOOR-OPENED DOOR-CLOSED handle-onoff + |; swap ! ; + +: switch blankentity swap , dup link-object + :| dup EVTOUCH = isneut? and if move-player then + dup EVTOUCH = if responder EVTOG entity>do then + dup SWITCH-ON SWITCH-OFF handle-onoff + SWITCH-ON handle-link |; swap ! ; + +: computer blankentity swap , dup link-object + :| dup EVTOUCH = isjaye? and if responder EVACT entity>do then + dup EVTOUCH = isneut? and if move-player then + dup COMP-ON COMP-OFF handle-onoff + COMP-ON handle-link |; swap ! ; + +: chainev ( entity xp -- ) swap dup @ , ! ; immediate + :noname reset-level MODE-MOVE @ ' tick redefine diff --git a/jeanne.jor b/jeanne.jor deleted file mode 100755 index c3c0a1f..0000000 --- a/jeanne.jor +++ /dev/null @@ -1,59 +0,0 @@ -( J E A N N E ) - -16 18 W ' {horse} defentity e_chuck -14 22 N ' {car} defentity car - -e_chuck :touch - pete say" Hey there, Chuck." - chuck say" * w h i n n y *\(Hey there, Pete.)" -;entity - -car :touch - move-player 1 player.state DRIVING f! -;entity - -:noname - 0 player.state DRIVING f! -:| CHUCK-HOME flag@ if e_chuck yield then - player.driving? not CHUCK-FOLLOW flag@ not and if car yield then - done |; ' entities redefine - - :| -touch-begin S leaving? dup - if player.driving? not - if pete say" I'm not walking." - else move-player 24 7 road.jor queue-level - then - then -touch-next 6 21 2= dup - if player.driving? not - if CHUCK-FOLLOW flag@ not if - noone say" * knock knock *" - clear 30 sleep - pete say" Nobody home, I guess." - jeanne say" Go away before I call the\cops, Pete!" - pete say" Oh.\I guess she's still mad." - JEANNE-ANGRY setflag - else - pete say" I brought you your\damn horse, Jeanne!" - jeanne say" Oh my God. Is he okay?\Hold on, I'm coming outside." - pete say" He's fine." - W player entity.dir ! move-player move-player E player entity.dir ! - ( todo: jeanne sprite I guess ) - chuck say" * n u z z l e *\(Jeanne! I'm home!)" - jeanne say" Jesus, Chuck, you're a wreck.\Let's get you fed and rested." - pete say" You're welcome." - jeanne say" Don't think for a MINUTE\I'm not still furious at you." - jeanne say" If I catch you on my property\again, I *will* call the cops." - pete say" Alright, alright, I'm going!\Christ, no good deed goes\unpunished." - CHUCK-HOME setflag CHUCK-FOLLOW clearflag - 10 6 petehous.jor queue-level - then - else - pete say" Jeanne hates me enough already\without driving through her\front door!" - then - then -touch-last |; ' player-touch redefine - -s" jeanne.map" load-map -; ' onload redefine diff --git a/jeanne.map b/jeanne.map deleted file mode 100755 index d74b00a..0000000 Binary files a/jeanne.map and /dev/null differ diff --git a/lev00001.jor b/lev00001.jor index e32f8ed..38605f0 100755 --- a/lev00001.jor +++ b/lev00001.jor @@ -11,68 +11,20 @@ jaye say" That was an earthquake!" ; - 4 const COMP-OFF - 5 const COMP-ON - 9 const DOOR-CLOSED -10 const DOOR-OPENED -11 const SWITCH-OFF -12 const SWITCH-ON - -: entity>tile ( entity -- tile ) entity>pos world>tile tile ; -: entity>tile? ( entity expected - b ) swap entity>tile b@ = ; - -: toggleval ( off on val -- off|on ) over = not if swap then drop ; -: toggletile ( entity off on -- ) - r r@ entity>tile b@ toggleval tile b! invalidate-map ; - -: respondertile! ( tile -- ) responder entity>tile b! invalidate-map ; - -: handle-onoff ( ev on off -- ) - rot toggletile else - drop drop drop then then then ; -: statechange? ( ev -- b ) - dup EVACT = over EVDEACT = or swap EVTOG = or ; - -: blankentity array here >r N ' {blank} allotentity tile? and if - move-player - then - DOOR-OPENED DOOR-CLOSED handle-onoff - |; swap ! ; - -: handle-link ( ev ontile -- ) - swap statechange? if - responder swap entity>tile? if EVACT else EVDEACT then - responder entity.user @ swap entity>do - else drop then ; - -: switch blankentity swap , - :| dup EVTOUCH = isneut? and if move-player then - dup EVTOUCH = if responder EVTOG entity>do then - dup SWITCH-ON SWITCH-OFF handle-onoff - SWITCH-ON handle-link |; swap ! ; - -: computer blankentity swap , - :| dup EVTOUCH = isjaye? and if responder EVACT entity>do then - dup EVTOUCH = isneut? and if move-player then - dup COMP-ON COMP-OFF handle-onoff - COMP-ON handle-link |; swap ! ; - -: chainev ( entity xp -- ) swap dup @ , ! ; immediate +objects: O 12 9 door d1 -d1 :noname - dup EVTOUCH = isjaye? and d1 DOOR-CLOSED entity>tile? and if - jaye say" It won't open!" - then chainev ; d1 12 8 switch s1 0 15 8 computer c1 7 6 door d2 d2 6 6 switch s2 +0 1 4 computer c2 + +d1 :noname + dup EVTOUCH = isjaye? and d1 DOOR-CLOSED entity>tile? and if + jaye say" It won't open!" + then chainev ; c1 :noname dup EVTOUCH = isjaye? and if @@ -86,13 +38,16 @@ c1 :noname jaye say" Neut is running now.\I can hit the space bar\to control them." then then chainev ; +c2 :noname + dup EVTOUCH = isjaye? and if + c2 COMP-OFF entity>tile? if + jaye say" Looks like there's still\power to this terminal." + then + jaye say" If I turn a terminal on,\Neut can use it to\travel through the network." + then chainev ; :noname - reset-level - :| d1 yield s1 yield c1 yield d2 yield s2 yield done |; ' entities redefine - -:| touch-begin 15 8 2= dup if -then touch-last |; ' jaye-touch redefine + reset-level O s" lev00001.map" load-map ( ' intro sched ) diff --git a/lev00001.map b/lev00001.map index 8ef78bf..d8c8337 100755 Binary files a/lev00001.map and b/lev00001.map differ diff --git a/pete.jor b/pete.jor deleted file mode 100755 index 44c9226..0000000 --- a/pete.jor +++ /dev/null @@ -1,63 +0,0 @@ -( P E T E ) - -13 8 N ' {car} defentity car -32 5 W ' {horse} defentity e_chuck -17 10 W ' {boat} defentity boat -26 10 W ' {duck} defentity duck1 -32 7 E ' {duck} defentity duck2 - -car :touch - move-player - 1 player.state DRIVING f! -;entity - -boat :touch - move-player - 1 player.state BOATING f! -;entity - -e_chuck :touch - pete say" It's good to have you\back, Chuck." - chuck say" * w h i n n y *\(I remember this place...)" -;entity - -:noname -:| player.driving? not CHUCK-FOLLOW flag@ not and if car yield then - CHUCK-STOLEN flag@ if e_chuck yield then - player.boating? not if boat yield then - duck1 yield duck2 yield - done |; ' entities redefine - - :| -touch-begin S leaving? dup - if player.driving? not CHUCK-FOLLOW flag@ not and - if pete say" It's too far to walk to town." - else move-player 5 10 road.jor queue-level - then - then -touch-next N leaving? dup - if move-player 24 49 space.jor queue-level then -touch-next 13 8 2= player.driving? and dup - if move-player - 0 player.state DRIVING f! - W player entity.dir ! - move-player - then -touch-next 19 9 2= CHUCK-FOLLOW flag@ and player entity.dir @ E = and dup - if pete say" Hmm, yeah, lots of good\grazing over here..." - say" Let's get you comfy, Chuck." move-player then -touch-next 22 9 2= CHUCK-FOLLOW flag@ and dup - if pete say" Welcome home, old buddy." - chuck say" * n e i g h *\(OK, Pete.)" - CHUCK-FOLLOW clearflag CHUCK-STOLEN setflag - 13 7 petehous.jor queue-level then -touch-next 12 7 2= player.driving? not and dup - if move-player 16 9 petehous.jor queue-level then -touch-next 30 7 2= dup - if pete say" It's... kinda swampy.\I don't wanna get wet if I\don't have to." then -touch-next 30 9 2= dup - if pete say" Feels spooky over here,\somehow." then -touch-last |; ' player-touch redefine - -s" pete.map" load-map -; ' onload redefine diff --git a/pete.map b/pete.map deleted file mode 100755 index cb3160b..0000000 Binary files a/pete.map and /dev/null differ diff --git a/petehous.jor b/petehous.jor deleted file mode 100755 index 20358ad..0000000 --- a/petehous.jor +++ /dev/null @@ -1,95 +0,0 @@ -( P E T E ' S H O U S E ) - -16 5 N ' {pete-table} defentity table -15 5 N ' {chair} defentity chair -7 6 N ' {pete-bed} defentity bed -10 9 N ' {phone} defentity e_phone -18 3 N ' {fridge} defentity fridge - -table :touch pete say" Yesterday's breakfast is still\on the table." - say" Maybe the day before's too." ;entity -chair :touch pete say" I've had my morning coffee\already." ;entity -bed :touch pete say" I'm not tired yet." ;entity -fridge :touch pete say" Should get some more beer soon." ;entity - -e_phone :touch phone :| - -s" [don't pick up]" -:| pete say" Hmm... no answer." |; yield - -s" Hey Pete, what's up?" -:| pete say" Not much, old friend!" - 0 begin phone :| - JEANNE-ANGRY flag@ CHUCK-GONE flag@ not and if - s" I hear Jeanne's awful mad\at you!" - :| pete say" Ohh, she'll come round." - phone say" What'd you do, anyway?" - pete say" Me?! What makes you think I\did anything?" - phone say" Come on, Pete, how long\have we known each other?" - pete say" Haw haw haw! Well, it's a\pretty good story..." - say" I was taking Chuck out for a\midnight ride, see..." - phone say" *sigh* You didn't even think\of asking, did you." - pete say" Hell no! He's my horse!" - phone say" Chuck hasn't been your horse\for years, Pete. That's what\happens when you sell them." - pete say" Quit moralizing and let me tell\my story. So there I was,\riding on the trail..." - say" We get to the clearing, and\I look up at the stars." - say" It's the clearest night\you've ever seen in your life." - say" Just as I'm looking up,\I see something." - phone say" 'Something'?" - pete say" I have seen my share of\airplanes and shooting stars.\This was not that." - say" I'm not saying it was aliens..." - phone say" ... but it was aliens." - pete say" I'm not saying it!\You said it." - say" Anyway, I get off Chuck and\lie down on the grass, to\get a better look, see?" - say" Maybe have a pull or two of\whiskey, while I'm watching\the sky." - say" I guess I must've dozed off,\because next thing I know\it's morning and Chuck's gone." - phone say" You LOST him??" - pete say" I figured he just went home!\But when I went to Jeanne's,\he wasn't there." - phone say" You lost him." - pete say" He's a smart old goat,\just like me. He'll\turn up soon." - CHUCK-GONE setflag - |; yield - then - CHUCK-GONE flag@ if - s" You found Chuck yet?" - :| pete say" I'm sure he'll turn up soon!\Sheesh, get off my back." |; yield - then - CHUCK-FOLLOW flag@ if - s" You found Chuck yet?" - :| pete say" He's right here." - chuck say" * s n o r t *" - phone say" You brought him in your house??" - phone say" Of course you did.\Never mind.\Don't even bother explaining." - |; yield - then - CHUCK-STOLEN flag@ CHUCK-HOME flag@ or CHUCK-EXPLAINED flag@ not and if - s" You found Chuck yet?" - :| pete say" He found his way home." - phone say" Well, thank goodness\for that." - CHUCK-EXPLAINED setflag - |; yield - then - s" Goodbye, Pete." :| pete say" Goodbye!" drop 1 |; yield - done |; choose - dup until drop -|; yield - -done |; choose ;entity - -:noname - reset-level - :| table yield chair yield bed yield e_phone yield fridge yield done |; ' entities redefine - :| -touch-begin 16 10 2= dup if - move-player 12 8 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-last |; ' player-touch redefine - - s" petehous.map" load-map -; ' onload redefine - diff --git a/petehous.map b/petehous.map deleted file mode 100755 index 36e00ac..0000000 Binary files a/petehous.map and /dev/null differ diff --git a/road.jor b/road.jor deleted file mode 100755 index 6abb7eb..0000000 --- a/road.jor +++ /dev/null @@ -1,32 +0,0 @@ -( O V E R W O R L D ) - -24 4 N ' {horse} defentity chuck - -:noname - CHUCK-FOLLOW flag@ not player.state DRIVING f! - :| CHUCK-HOME flag@ if chuck yield then - done |; ' entities redefine - :| -touch-begin E leaving? dup - if pete say" It's 100 miles to the next town." then -touch-next 24 15 2= CHUCK-FOLLOW flag@ and dup - if pete say" I'm not walking all the way into\town with a horse!" then -touch-next 5 9 2= dup - if move-player 13 12 pete.jor queue-level then -touch-next 13 6 2= dup - if move-player 38 71 trail1.jor queue-level then -touch-next 24 6 2= dup - if move-player 13 22 jeanne.jor queue-level then -touch-next 39 33 2= dup - if pete say" School's out for the day,\looks like." then -touch-next 32 36 2= dup - if mary say" General store and post office." then -touch-next 35 39 2= dup - if pete say" Community center." then -touch-next tile b@ 17 = dup - if pete say" I'm not one to drop in\unannounced." then -touch-last |; ' player-touch redefine -s" road.map" load-map - -; ' onload redefine - diff --git a/road.map b/road.map deleted file mode 100755 index 0536e8d..0000000 Binary files a/road.map and /dev/null differ diff --git a/space.jor b/space.jor deleted file mode 100755 index 063aa8f..0000000 --- a/space.jor +++ /dev/null @@ -1,26 +0,0 @@ -( S P A C E ) - -24 10 N ' {aliem} defentity aliem -28 28 N ' {pete-bed} defentity bed -19 21 N ' {phone} defentity e_phone - -aliem :touch - pete say" hey mr aliem" -;entity - -:noname -:| aliem yield bed yield e_phone yield done |; ' entities redefine - -:| touch-begin S leaving? dup - if move-player 0 glitchlevel ! 19 0 pete.jor queue-level then -touch-next 5 11 2= dup - if move-player 41 37 tile>world player entity.pos! then -touch-next 41 37 2= dup - if move-player 5 11 tile>world player entity.pos! then -touch-next 44 23 2= dup - if pete say" It's...." say" home?" then -touch-last |; ' player-touch redefine - -s" space.map" load-map -4 glitchlevel ! -; ' onload redefine diff --git a/space.map b/space.map deleted file mode 100755 index bede0ab..0000000 Binary files a/space.map and /dev/null differ diff --git a/trail1.jor b/trail1.jor deleted file mode 100755 index a62dc9c..0000000 --- a/trail1.jor +++ /dev/null @@ -1,54 +0,0 @@ -( T R A I L 1 ) - -50 17 E ' {horse} defentity e_chuck -39 71 N ' {car} defentity car - -car :touch - CHUCK-FOLLOW flag@ if - pete say" I can't leave Chuck here!" - else - move-player 1 player.state DRIVING f! - then -;entity - -e_chuck :touch - pete say" Woah, boy. Calm down." move-player - chuck say" * w h i n n y *\(You came back!)" - pete say" Of course I did, boy.\Of course I did." - p_chuck follow CHUCK-GONE clearflag CHUCK-FOLLOW setflag -;entity - -:noname -0 player.state DRIVING f! - -:| CHUCK-GONE flag@ if e_chuck yield then - player.driving? not if car yield then - done |; ' entities redefine - -:| -touch-begin S leaving? dup - if player.driving? not CHUCK-FOLLOW flag@ not and - if pete say" I'm not walking." - else move-player 13 7 road.jor queue-level - then - then -CHUCK-GONE flag@ if - touch-next 49 17 2= dup - if - pete say" Oh for the love of..." - say" Chuck! How on Earth did you\end up over there!?" - W e_chuck entity.dir ! - chuck say" * n e i g h *\(Help me Pete, I'm lost!)" - then -then -touch-next 3 56 2= dup - if - 1 glitchlevel ! - pete say" This is where I buried it." - say" All those years ago." - 0 glitchlevel ! - then -touch-last |; ' player-touch redefine - -s" trail1.map" load-map -; ' onload redefine diff --git a/trail1.map b/trail1.map deleted file mode 100755 index 429d959..0000000 Binary files a/trail1.map and /dev/null differ