Terminal-warping, cleanup unused pete286 junk, auto-entity list

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 <rot

game.jor

@@ -5,14 +5,23 @@ var MODE-WAIT
 ( T I C K )
 defer party
 defer entities
+var objects
+
+: obj-entity ( optr -- entity ) cell + @ ;
+
+: single-entity-at ( x y 0 entity -- x y entity|0 b )
+  swap drop >r 2dup ( x y x y r:e )
+  r@ entity.x @ r@ entity.y @ world>tile 2= ( x y b r:e )
+  if <r else rdrop 0 then dup ;
 
 : entity-at ( x y -- entity|0 )
-  0 >rot
+  0 entities each single-entity-at if break then more
-  entities each >r 2dup ( 0 x y x y r:e )
+  dup not objects @ and if
-    r@ entity.x @ r@ entity.y @ world>tile 2= ( 0 x y eq r:e )
+    objects @ links each
-    if <rot drop <r >rot break ( e x y )
+      >r r@ obj-entity single-entity-at if rdrop 0 else <r then
-    else rdrop then ( 0 x y )
+    more
-  more drop drop ;
+  then
+  >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 -- )
+  <rot >r r@ entity>tile b@ toggleval <r entity>tile b! invalidate-map ;
+
+: respondertile! ( tile -- ) responder entity>tile b! invalidate-map ;
+
+: handle-onoff ( ev on off -- )
+  <rot dup EVDEACT = if drop swap drop respondertile! else
+       dup EVACT = if drop drop respondertile! else
+       dup EVTOG = if drop responder >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 <r ;
+
+: 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 ;
+
+: 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

jeanne.jor

@@ -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

lev00001.jor

@@ -11,68 +11,20 @@
   jaye say" That was an earthquake!"
 ;
 
- 4 const COMP-OFF
+objects: O
- 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 -- )
-  <rot >r r@ entity>tile b@ toggleval <r entity>tile b! invalidate-map ;
-
-: respondertile! ( tile -- ) responder entity>tile b! invalidate-map ;
-
-: handle-onoff ( ev on off -- )
-  <rot dup EVDEACT = if drop swap drop respondertile! else
-       dup EVACT = if drop drop respondertile! else
-       dup EVTOG = if drop responder >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 <r ;
-: door blankentity
-  :| dup EVTOUCH = isjaye? and responder DOOR-OPENED entity>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
 
 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
+  reset-level O
-  :| 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
 
   s" lev00001.map" load-map
 (  ' intro sched )

pete.jor

@@ -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

petehous.jor

@@ -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
-

road.jor

@@ -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
-

space.jor

@@ -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

trail1.jor

@@ -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