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

This commit is contained in:
Jeremy Penner 2020-02-02 18:30:00 -05:00
parent 779ae1bab3
commit adbb39113d
16 changed files with 106 additions and 402 deletions

View file

@ -101,7 +101,7 @@ array frames
create b, dup b, 0 for b, next create b, dup b, 0 for b, next
does> ( dir a -- ) swap drop lookup-frame ; does> ( dir a -- ) swap drop lookup-frame ;
-1 defsingle {{blank}} -1 defsingle {blank}
0 defstatic {car} 0 defstatic {car}
5 defstatic {car-lit} 5 defstatic {car-lit}
1 defstatic {pete-stand} 1 defstatic {pete-stand}
@ -122,11 +122,6 @@ array frames
46 defsingle {aliem} 46 defsingle {aliem}
13 14 2 5 defmulti {neut} 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 ) : sprite-bob ( x y sprindex -- x y sprindex )
dup 13 >= over 14 <= and if dup 13 >= over 14 <= and if
>rot 2dup + ticks + 40 % 20 < if 1 + then <rot >rot 2dup + ticks + 40 % 20 < if 1 + then <rot

View file

@ -5,14 +5,23 @@ var MODE-WAIT
( T I C K ) ( T I C K )
defer party defer party
defer entities 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 ) : 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 ) ( P L A Y E R )
var player.state userword var player.state userword
@ -29,7 +38,7 @@ var player.prevdir
: isjaye? isneut? not ; userword : isjaye? isneut? not ; userword
: {jaye} : {jaye}
isneut? not player.state MOVING f@ and isjaye? player.state MOVING f@ and
if {jeanne-walk} else {jeanne} then ; if {jeanne-walk} else {jeanne} then ;
: player.canmove? ( x y -- ) : player.canmove? ( x y -- )
@ -116,12 +125,14 @@ var q-player.y
( S T U F F ) ( S T U F F )
: reset-level : reset-level
0 objects !
:| done |; ' entities redefine :| done |; ' entities redefine
:| drop drop 0 |; ' jaye-touch redefine :| drop drop 0 |; ' jaye-touch redefine
:| drop drop 0 |; ' neut-touch redefine ; userword :| drop drop 0 |; ' neut-touch redefine ; userword
: mode-move : mode-move
player-tick player-tick
( objects @ if objects @ links each dup obj-entity EVTICK entity>do more )
entities each EVTICK entity>do more entities each EVTICK entity>do more
party each EVTICK entity>do more party each EVTICK entity>do more
pneut EVTICK entity>do pneut EVTICK entity>do
@ -149,6 +160,9 @@ var showmouse
var glitchlevel var glitchlevel
var quaking var quaking
var _dorubber
: rubber _dorubber @ not _dorubber ! ;
: full-draw : full-draw
quaking @ not if quaking @ not if
player entity.x @ 152 - player entity.x @ 152 -
@ -158,6 +172,9 @@ var quaking
0 ticks 3 % 13 * 8 % scroll 0 ticks 3 % 13 * 8 % scroll
then then
_dorubber @ objects @ and if
objects @ links each dup obj-entity draw-entity more
then
entities each draw-entity more entities each draw-entity more
party each draw-entity more party each draw-entity more
player.state HASNEUT f@ if pneut draw-entity then player.state HASNEUT f@ if pneut draw-entity then
@ -169,6 +186,72 @@ var quaking
draw-screen draw-screen
draw-footer ; 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 :noname
reset-level reset-level
MODE-MOVE @ ' tick redefine MODE-MOVE @ ' tick redefine

View file

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

Binary file not shown.

View file

@ -11,68 +11,20 @@
jaye say" That was an earthquake!" 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 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 d1 12 8 switch s1
0 15 8 computer c1 0 15 8 computer c1
7 6 door d2 7 6 door d2
d2 6 6 switch s2 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 c1 :noname
dup EVTOUCH = isjaye? and if 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." jaye say" Neut is running now.\I can hit the space bar\to control them."
then then
then chainev ; 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 :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 s" lev00001.map" load-map
( ' intro sched ) ( ' intro sched )

Binary file not shown.

View file

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

BIN
pete.map

Binary file not shown.

View file

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

Binary file not shown.

View file

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

BIN
road.map

Binary file not shown.

View file

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

BIN
space.map

Binary file not shown.

View file

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

Binary file not shown.