mirror of
https://github.com/PDP-10/its.git
synced 2026-02-05 16:14:50 +00:00
Zork source code from 1979.
This commit is contained in:
Lars Brinkhoff
committed by
Eric Swenson
Eric Swenson
parent
c67abaded0
commit
1b555896eb
2036
src/zork/act1.253
Normal file
2036
src/zork/act1.253
Normal file
File diff suppressed because it is too large
Load Diff
793
src/zork/act2.92
Normal file
793
src/zork/act2.92
Normal file
@@ -0,0 +1,793 @@
|
||||
|
||||
; "SUBTITLE COAL MINE"
|
||||
|
||||
<DEFINE BOOM-ROOM ("AUX" (DUMMY? <>) (WIN ,WINNER) O (AOBJS <AOBJS .WIN>))
|
||||
#DECL ((DUMMY?) <OR ATOM FALSE> (WIN) ADV (O) OBJECT)
|
||||
<COND (<OR <VERB? "GO-IN">
|
||||
<AND <VERB? "ON" "TRNON" "LIGHT" "BURN">
|
||||
<SET DUMMY? T>>>
|
||||
<COND (<OR <AND <MEMQ <SET O <SFIND-OBJ "CANDL">> .AOBJS>
|
||||
<TRNN .O ,ONBIT>>
|
||||
<AND <MEMQ <SET O <SFIND-OBJ "TORCH">> .AOBJS>
|
||||
<TRNN .O ,ONBIT>>
|
||||
<AND <MEMQ <SET O <SFIND-OBJ "MATCH">> .AOBJS>
|
||||
<TRNN .O ,ONBIT>>>
|
||||
<UNWIND
|
||||
<PROG ()
|
||||
<COND (.DUMMY?
|
||||
<TELL
|
||||
"I didn't realize that adventurers are stupid enough to light a
|
||||
" ,LONG-TELL1 <ODESC2 .O> " in a room which reeks of coal gas.
|
||||
Fortunately, there is justice in the world.">)
|
||||
(<TELL
|
||||
"Oh dear. It appears that the smell coming from this room was coal
|
||||
gas. I would have thought twice about carrying a " ,LONG-TELL1
|
||||
<ODESC2 .O> "in here.">)>
|
||||
<FWEEP 7>
|
||||
<JIGS-UP " BOOOOOOOOOOOM ">>
|
||||
<JIGS-UP " BOOOOOOOOOOOM ">>)>)>>
|
||||
|
||||
<DEFINE BATS-ROOM ()
|
||||
<COND (<AND <VERB? "GO-IN">
|
||||
<NOT <MEMQ <SFIND-OBJ "GARLI"> <AOBJS ,WINNER>>>>
|
||||
<FLY-ME>)
|
||||
(<VERB? "LOOK">
|
||||
<TELL
|
||||
"You are in a small room which has only one door, to the east.">
|
||||
<AND <MEMQ <SFIND-OBJ "GARLI"> <AOBJS ,WINNER>>
|
||||
<TELL
|
||||
"In the corner of the room on the ceiling is a large vampire bat who
|
||||
is obviously deranged and holding his nose.">>)>>
|
||||
|
||||
<DEFINE FLY-ME ("AUX" (BAT-DROPS ,BAT-DROPS))
|
||||
#DECL ((BAT-DROPS) <VECTOR [REST STRING]>)
|
||||
<UNWIND
|
||||
<PROG ()
|
||||
<FWEEP 4 1>
|
||||
<TELL
|
||||
"A deranged giant vampire bat (a reject from WUMPUS) swoops down
|
||||
from his belfry and lifts you away....">
|
||||
<GOTO <FIND-ROOM <PICK-ONE .BAT-DROPS>>>>
|
||||
<GOTO <FIND-ROOM <PICK-ONE .BAT-DROPS>>>>
|
||||
<PUT ,PRSVEC 2 <>>
|
||||
<ROOM-INFO>
|
||||
T>
|
||||
|
||||
<DEFINE FWEEP (NUM "OPTIONAL" (SLP 0))
|
||||
#DECL ((NUM SLP) FIX)
|
||||
<REPEAT ((N .NUM))
|
||||
#DECL ((N) FIX)
|
||||
<AND <0? <SET N <- .N 1>>> <RETURN>>
|
||||
<IMAGE 7>
|
||||
<OR <0? .SLP> <SLEEP .SLP>>>
|
||||
<TTY-INIT <>>>
|
||||
|
||||
<GDECL (BAT-DROPS) <VECTOR [REST STRING]>>
|
||||
|
||||
<SETG CAGE-TOP!-FLAG T>
|
||||
|
||||
<DEFINE DUMBWAITER ("AUX" (TB <SFIND-OBJ "TBASK">)
|
||||
(TOP <SFIND-ROOM "TSHAF">) (BOT <SFIND-ROOM "BSHAF">)
|
||||
(FB <SFIND-OBJ "FBASK">) (CT ,CAGE-TOP!-FLAG)
|
||||
(DUMMY ,DUMMY) (LIT? <LIT? ,HERE>))
|
||||
#DECL ((FB TB) OBJECT (TOP BOT) ROOM (LIT? CT) <OR ATOM FALSE>
|
||||
(DUMMY) <VECTOR [REST STRING]>)
|
||||
<COND (<VERB? "RAISE">
|
||||
<COND (.CT
|
||||
<TELL <PICK-ONE ,DUMMY>>)
|
||||
(<REMOVE-OBJECT .TB>
|
||||
<REMOVE-OBJECT .FB>
|
||||
<INSERT-OBJECT .TB .TOP>
|
||||
<INSERT-OBJECT .FB .BOT>
|
||||
<TELL "The basket is raised to the top of the shaft.">
|
||||
<SETG CAGE-TOP!-FLAG T>)>)
|
||||
(<VERB? "LOWER">
|
||||
<COND (<NOT .CT>
|
||||
<TELL <PICK-ONE .DUMMY>>)
|
||||
(<REMOVE-OBJECT .TB>
|
||||
<REMOVE-OBJECT .FB>
|
||||
<INSERT-OBJECT .TB .BOT>
|
||||
<INSERT-OBJECT .FB .TOP>
|
||||
<TELL "The basket is lowered to the bottom of the shaft.">
|
||||
<SETG CAGE-TOP!-FLAG <>>
|
||||
<COND (<AND .LIT? <NOT <LIT? ,HERE>>>
|
||||
<TELL "It is now pitch black.">)>
|
||||
T)>)
|
||||
(<OR <==? <PRSO> .FB>
|
||||
<==? <PRSI> .FB>>
|
||||
<TELL "The basket is at the other end of the chain.">)
|
||||
(<VERB? "TAKE">
|
||||
<TELL "The cage is securely fastened to the iron chain.">)>>
|
||||
|
||||
<DEFINE MACHINE-ROOM ()
|
||||
<COND (<VERB? "LOOK">
|
||||
<TELL ,MACHINE-DESC
|
||||
,LONG-TELL1
|
||||
<COND (<TRNN <SFIND-OBJ "MACHI"> ,OPENBIT>
|
||||
"open.")
|
||||
("closed.")>>)>>
|
||||
|
||||
<DEFINE MACHINE-FUNCTION ("AUX" (DUMMY ,DUMMY) (MACH <SFIND-OBJ "MACHI">))
|
||||
#DECL ((MACH) OBJECT (DUMMY) <VECTOR [REST STRING]>)
|
||||
<COND
|
||||
(<==? ,HERE <SFIND-ROOM "MACHI">>
|
||||
<COND
|
||||
(<VERB? "OPEN">
|
||||
<COND (<TRNN .MACH ,OPENBIT>
|
||||
<TELL <PICK-ONE .DUMMY>>)
|
||||
(<TELL "The lid opens.">
|
||||
<TRO .MACH ,OPENBIT>)>)
|
||||
(<VERB? "CLOSE">
|
||||
<COND (<TRNN .MACH ,OPENBIT>
|
||||
<TELL "The lid closes.">
|
||||
<TRZ .MACH ,OPENBIT>
|
||||
T)
|
||||
(<TELL <PICK-ONE .DUMMY>>)>)>)>>
|
||||
|
||||
<DEFINE MSWITCH-FUNCTION ("AUX" (C <SFIND-OBJ "COAL">) D (MACH <SFIND-OBJ "MACHI">)
|
||||
(SCREW <SFIND-OBJ "SCREW">))
|
||||
#DECL ((MACH SCREW C D) OBJECT)
|
||||
<COND (<VERB? "TURN">
|
||||
<COND (<==? <PRSI> .SCREW>
|
||||
<COND (<TRNN .MACH ,OPENBIT>
|
||||
<TELL
|
||||
"The machine doesn't seem to want to do anything.">)
|
||||
(<TELL
|
||||
"The machine comes to life (figuratively) with a dazzling display of
|
||||
colored lights and bizarre noises. After a few moments, the
|
||||
excitement abates." ,LONG-TELL1>
|
||||
<COND (<==? <OCAN .C> .MACH>
|
||||
<REMOVE-OBJECT .C>
|
||||
<PUT .MACH
|
||||
,OCONTENTS
|
||||
(<SET D <SFIND-OBJ "DIAMO">>
|
||||
!<OCONTENTS .MACH>)>
|
||||
<PUT .D ,OCAN .MACH>)
|
||||
(<NOT <EMPTY? <OCONTENTS .MACH>>>
|
||||
<PUT .MACH ,OCONTENTS (<SFIND-OBJ "GUNK">)>)
|
||||
(T)>)>)
|
||||
(<TELL "It seems that a " 1 <ODESC2 <PRSI>> " won't do.">)>)>>
|
||||
|
||||
<DEFINE GUNK-FUNCTION ("AUX" (G <SFIND-OBJ "GUNK">) (M <OCAN .G>))
|
||||
#DECL ((G) OBJECT (M) <OR OBJECT FALSE>)
|
||||
<COND (.M
|
||||
<PUT .M ,OCONTENTS <SPLICE-OUT .G <OCONTENTS .M>>>
|
||||
<PUT .G ,OCAN <>>
|
||||
<TELL
|
||||
"The slag turns out to be rather insubstantial, and crumbles into dust
|
||||
at your touch. It must not have been very valuable.">)>>
|
||||
|
||||
<SETG SCORE-MAX <+ ,SCORE-MAX <SETG LIGHT-SHAFT 10>>>
|
||||
|
||||
<DEFINE NO-OBJS ()
|
||||
<COND (<EMPTY? <AOBJS ,WINNER>>
|
||||
<SETG EMPTY-HANDED!-FLAG T>)
|
||||
(ELSE <SETG EMPTY-HANDED!-FLAG <>>)>
|
||||
<COND (<AND <==? ,HERE <SFIND-ROOM "BSHAF">>
|
||||
<LIT? ,HERE>>
|
||||
<SCORE-UPD ,LIGHT-SHAFT>
|
||||
<SETG LIGHT-SHAFT 0>)>>
|
||||
|
||||
<GDECL (LIGHT-SHAFT) FIX>
|
||||
|
||||
\
|
||||
|
||||
;"SUBTITLE OLD MAN RIVER, THAT OLD MAN RIVER..."
|
||||
|
||||
<DEFINE CLIFF-FUNCTION ()
|
||||
<COND (<MEMQ <SFIND-OBJ "RBOAT"> <AOBJS ,WINNER>>
|
||||
<SETG DEFLATE!-FLAG <>>)
|
||||
(<SETG DEFLATE!-FLAG T>)>>
|
||||
|
||||
<DEFINE STICK-FUNCTION ("AUX" (HERE ,HERE))
|
||||
#DECL ((HERE) ROOM)
|
||||
<COND (<VERB? "WAVE">
|
||||
<COND (<OR <==? .HERE <SFIND-ROOM "FALLS">>
|
||||
<==? .HERE <SFIND-ROOM "POG">>>
|
||||
<COND (<NOT ,RAINBOW!-FLAG>
|
||||
<TRO <SFIND-OBJ "POT"> ,OVISON>
|
||||
<TELL
|
||||
"Suddenly, the rainbow appears to become solid and, I venture,
|
||||
walkable (I think the giveaway was the stairs and bannister).">
|
||||
<SETG RAINBOW!-FLAG T>)
|
||||
(<TELL
|
||||
"The rainbow seems to have become somewhat run-of-the-mill.">
|
||||
<SETG RAINBOW!-FLAG <>>)>)
|
||||
(<==? .HERE <SFIND-ROOM "RAINB">>
|
||||
<SETG RAINBOW!-FLAG <>>
|
||||
<JIGS-UP
|
||||
"The structural integrity of the rainbow seems to have left it,
|
||||
leaving you about 450 feet in the air, supported by water vapor.">)
|
||||
(<TELL "Very good.">)>)>>
|
||||
|
||||
<DEFINE FALLS-ROOM ()
|
||||
<COND (<VERB? "LOOK">
|
||||
<TELL
|
||||
"You are at the top of Aragain Falls, an enormous waterfall with a
|
||||
drop of about 450 feet. The only path here is on the north end." ,LONG-TELL1>
|
||||
<COND (,RAINBOW!-FLAG
|
||||
<TELL
|
||||
"A solid rainbow spans the falls.">)
|
||||
(<TELL
|
||||
"A beautiful rainbow can be seen over the falls and to the east.">)>)>>
|
||||
|
||||
<DEFINE BARREL ("OPTIONAL" (ARG <>))
|
||||
#DECL ((ARG) <OR FALSE ATOM>)
|
||||
<AND <==? .ARG READ-IN>
|
||||
<COND (<VERB? "WALK"> <TELL "You cannot move the barrel.">)
|
||||
(<VERB? "LOOK">
|
||||
<TELL
|
||||
"You are inside a barrel. Congratulations. Etched into the side of the
|
||||
barrel is the word 'Geronimo!'. From your position, you cannot see
|
||||
the falls.">)
|
||||
(<VERB? "TAKE"> <PICK-ONE ,YUKS>)
|
||||
(<VERB? "BURN">
|
||||
<TELL "The barrel is damp and cannot be burned.">)>>>
|
||||
|
||||
<DEFINE DBOAT-FUNCTION ("AUX" (HERE ,HERE) (DBOAT <SFIND-OBJ "DBOAT">))
|
||||
#DECL ((DBOAT) OBJECT (HERE) ROOM)
|
||||
<COND (<VERB? "INFLA">
|
||||
<TELL
|
||||
"This boat will not inflate since some moron put a hole in it.">)
|
||||
(<VERB? "PLUG">
|
||||
<COND (<==? <PRSI> <SFIND-OBJ "PUTTY">>
|
||||
<TELL
|
||||
"Well done. The boat is repaired.">
|
||||
<COND (<NOT <OROOM .DBOAT>>
|
||||
<DROP-OBJECT .DBOAT>
|
||||
<TAKE-OBJECT <SFIND-OBJ "IBOAT">>)
|
||||
(<REMOVE-OBJECT <SFIND-OBJ "DBOAT">>
|
||||
<INSERT-OBJECT <SFIND-OBJ "IBOAT"> .HERE>)>)
|
||||
(<WITH-TELL <PRSI>>)>)>>
|
||||
|
||||
<DEFINE RBOAT-FUNCTION ("OPTIONAL" (ARG <>)
|
||||
"AUX" (RBOAT <SFIND-OBJ "RBOAT">)
|
||||
(IBOAT <SFIND-OBJ "IBOAT">) (HERE ,HERE))
|
||||
#DECL ((ARG) <OR FALSE ATOM> (IBOAT RBOAT) OBJECT (HERE) ROOM)
|
||||
<COND (.ARG <>)
|
||||
(<VERB? "BOARD">
|
||||
<COND (<MEMQ <SFIND-OBJ "STICK"> <AOBJS ,WINNER>>
|
||||
<TELL
|
||||
"There is a hissing sound and the boat deflates.">
|
||||
<REMOVE-OBJECT .RBOAT>
|
||||
<INSERT-OBJECT <SFIND-OBJ "DBOAT"> .HERE>
|
||||
T)>)
|
||||
(<VERB? "INFLA">
|
||||
<TELL "Inflating it further would probably burst it.">)
|
||||
(<VERB? "DEFLA">
|
||||
<COND (<==? <AVEHICLE ,WINNER> .RBOAT>
|
||||
<TELL
|
||||
"You can't deflate the boat while you're in it.">)
|
||||
(<NOT <MEMQ .RBOAT <ROBJS .HERE>>>
|
||||
<TELL
|
||||
"The boat must be on the ground to be deflated.">)
|
||||
(<TELL
|
||||
"The boat deflates.">
|
||||
<SETG DEFLATE!-FLAG T>
|
||||
<REMOVE-OBJECT .RBOAT>
|
||||
<INSERT-OBJECT .IBOAT .HERE>)>)>>
|
||||
|
||||
<DEFINE BREATHE ()
|
||||
<PERFORM INFLATER <FIND-VERB "INFLA"> <PRSO> <SFIND-OBJ "LUNGS">>>
|
||||
|
||||
<DEFINE IBOAT-FUNCTION ("AUX" (IBOAT <SFIND-OBJ "IBOAT">) (RBOAT <SFIND-OBJ "RBOAT">)
|
||||
(HERE ,HERE))
|
||||
#DECL ((IBOAT RBOAT) OBJECT (HERE) ROOM)
|
||||
<COND (<VERB? "INFLA">
|
||||
<COND (<NOT <MEMQ .IBOAT <ROBJS .HERE>>>
|
||||
<TELL
|
||||
"The boat must be on the ground to be inflated.">)
|
||||
(<==? <PRSI> <SFIND-OBJ "PUMP">>
|
||||
<TELL
|
||||
"The boat inflates and appears seaworthy.">
|
||||
<SETG DEFLATE!-FLAG <>>
|
||||
<REMOVE-OBJECT .IBOAT>
|
||||
<INSERT-OBJECT .RBOAT .HERE>)
|
||||
(<==? <PRSI> <SFIND-OBJ "LUNGS">>
|
||||
<TELL
|
||||
"You don't have enough lung power to inflate it.">)
|
||||
(<TELL
|
||||
"With a " 1 <ODESC2 <PRSI>> "? Surely you jest!">)>)>>
|
||||
|
||||
<DEFINE OVER-FALLS ()
|
||||
<COND (<VERB? "LOOK"> T)
|
||||
(<JIGS-UP ,OVER-FALLS-STR1>)>>
|
||||
|
||||
<SETG BUOY-FLAG!-FLAG T>
|
||||
|
||||
<DEFINE SHAKER ("AUX" (HERE ,HERE))
|
||||
#DECL ((HERE) ROOM)
|
||||
<COND (<OBJECT-ACTION>)
|
||||
(<TRNN <PRSO> ,VILLAIN>
|
||||
<TELL "This seems to have no effect.">)
|
||||
(<NOT <TRNN <PRSO> ,TAKEBIT>>
|
||||
<TELL "You can't take it; thus, you can't shake it!">)
|
||||
(<AND <NOT <TRNN <PRSO> ,OPENBIT>>
|
||||
<NOT <EMPTY? <OCONTENTS <PRSO>>>>
|
||||
<TELL
|
||||
"It sounds like there is something inside the " 1 <ODESC2 <PRSO>> ".">>)
|
||||
(<AND <TRNN <PRSO> ,OPENBIT>
|
||||
<NOT <EMPTY? <OCONTENTS <PRSO>>>>>
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) OBJECT)
|
||||
<PUT .X ,OCAN <>>
|
||||
<INSERT-OBJECT .X .HERE>>
|
||||
<OCONTENTS <PRSO>>>
|
||||
<PUT <PRSO> ,OCONTENTS ()>
|
||||
<TELL
|
||||
"All of the objects spill onto the floor.">)>>
|
||||
|
||||
<DEFINE RIVR4-ROOM ()
|
||||
<AND <MEMQ <SFIND-OBJ "BUOY"> <AOBJS ,WINNER>>
|
||||
,BUOY-FLAG!-FLAG
|
||||
<TELL
|
||||
"Something seems funny about the feel of the buoy.">
|
||||
<SETG BUOY-FLAG!-FLAG <>>>>
|
||||
|
||||
<SETG BEACH-DIG!-FLAG 0>
|
||||
|
||||
<SETG GUANO-DIG!-FLAG 0>
|
||||
|
||||
<GDECL (BEACH-DIG!-FLAG GUANO-DIG!-FLAG) FIX>
|
||||
|
||||
<DEFINE DIGGER ()
|
||||
<COND (<==? <PRSI> <SFIND-OBJ "SHOVE">>
|
||||
<OBJECT-ACTION>)
|
||||
(<TRNN <PRSI> ,TOOLBIT>
|
||||
<TELL
|
||||
"Digging with the " 1 <ODESC2 <PRSI>> " is slow and tedious.">)
|
||||
(<TELL
|
||||
"Digging with a " 1 <ODESC2 <PRSI>> " is silly.">)>>
|
||||
|
||||
<DEFINE GROUND-FUNCTION ()
|
||||
<COND (<==? ,HERE <SFIND-ROOM "BEACH">>
|
||||
<SAND-FUNCTION>)
|
||||
(<VERB? "DIG">
|
||||
<TELL "The ground is too hard for digging here.">)>>
|
||||
|
||||
<DEFINE SAND-FUNCTION ("AUX" (S <SFIND-OBJ "STATU">) (HERE ,HERE) CNT)
|
||||
#DECL ((S) OBJECT (HERE) ROOM (CNT) FIX)
|
||||
<COND (<VERB? "DIG">
|
||||
<SETG BEACH-DIG!-FLAG <SET CNT <+ 1 ,BEACH-DIG!-FLAG>>>
|
||||
<COND (<G? .CNT 4>
|
||||
<SETG BEACH-DIG!-FLAG 0>
|
||||
<AND <MEMQ .S <ROBJS .HERE>>
|
||||
<TRZ .S ,OVISON>>
|
||||
<JIGS-UP "The hole collapses, smothering you.">)
|
||||
(<==? .CNT 4>
|
||||
<COND (<NOT <TRNN .S ,OVISON>>
|
||||
<TELL "You can see a small statue here in the sand.">
|
||||
<TRO .S ,OVISON>)>)
|
||||
(<L? .CNT 0>)
|
||||
(<TELL <NTH ,BDIGS .CNT>>)>)>>
|
||||
|
||||
<DEFINE GUANO-FUNCTION ("AUX" (HERE ,HERE) CNT)
|
||||
#DECL ((HERE) ROOM (CNT) FIX)
|
||||
<COND (<VERB? "DIG">
|
||||
<SETG GUANO-DIG!-FLAG <SET CNT <+ 1 ,GUANO-DIG!-FLAG>>>
|
||||
<COND (<G? .CNT 3>
|
||||
<TELL "This is getting you nowhere.">)
|
||||
(<TELL <NTH ,CDIGS .CNT>>)>)>>
|
||||
|
||||
<GDECL (BDIGS CDIGS) <VECTOR [REST STRING]>>
|
||||
|
||||
<DEFINE GERONIMO ()
|
||||
<COND (<==? <AVEHICLE ,WINNER> <SFIND-OBJ "BARRE">>
|
||||
<JIGS-UP ,OVER-FALLS-STR>)
|
||||
(<TELL
|
||||
"Wasn't he an Indian?">)>>
|
||||
|
||||
<GDECL (SWIMYUKS) <VECTOR [REST STRING]>>
|
||||
|
||||
<DEFINE SWIMMER ("AUX" (SWIMYUKS ,SWIMYUKS))
|
||||
#DECL ((SWIMYUKS) <VECTOR [REST STRING]>)
|
||||
<COND (<RTRNN ,HERE ,RFILLBIT>
|
||||
<TELL
|
||||
"Swimming is not allowed in this dungeon.">)
|
||||
(<TELL <PICK-ONE .SWIMYUKS>>)>>
|
||||
|
||||
\
|
||||
|
||||
;"SUBTITLE LURKING GRUES"
|
||||
|
||||
<DEFINE GRUE-FUNCTION ()
|
||||
<COND (<VERB? "EXAMI">
|
||||
<TELL ,GRUE-DESC1 ,LONG-TELL1>)
|
||||
(<VERB? "FIND">
|
||||
<TELL ,GRUE-DESC2 ,LONG-TELL1>)>>
|
||||
|
||||
\
|
||||
|
||||
;"THE VOLCANO"
|
||||
|
||||
<SETG BTIE!-FLAG <>>
|
||||
<GDECL (BTIE!-FLAG) <OR FALSE OBJECT>>
|
||||
|
||||
<SETG BINF!-FLAG <>>
|
||||
|
||||
<DEFINE BALLOON BALLACT ("OPTIONAL" (ARG <>)
|
||||
"AUX" (BALL <SFIND-OBJ "BALLO">) (CONT <SFIND-OBJ "RECEP">)
|
||||
M (BINF ,BINF!-FLAG) R)
|
||||
#DECL ((ARG) <OR ATOM FALSE> (BALL CONT) OBJECT
|
||||
(BINF) <OR FALSE OBJECT> (M) <OR FALSE VECTOR>
|
||||
(BALLACT) ACTIVATION (R) <OR NEXIT CEXIT DOOR ROOM>)
|
||||
<COND (<==? .ARG READ-OUT>
|
||||
<COND (<VERB? "LOOK">
|
||||
<COND (.BINF
|
||||
<TELL
|
||||
"The cloth bag is inflated and there is a "
|
||||
1
|
||||
<ODESC2 .BINF>
|
||||
" burning in the receptacle.">)
|
||||
(<TELL "The cloth bag is draped over the the basket.">)>
|
||||
<COND (,BTIE!-FLAG
|
||||
<TELL "The balloon is tied to the hook.">)>)>
|
||||
<RETURN <> .BALLACT>)>
|
||||
<COND (<==? .ARG READ-IN>
|
||||
<COND (<VERB? "WALK">
|
||||
<COND (<SET M
|
||||
<MEMQ <2 ,PRSVEC> <REXITS ,HERE>>>
|
||||
<COND (,BTIE!-FLAG
|
||||
<TELL "You are tied to the ledge.">
|
||||
<RETURN T .BALLACT>)
|
||||
(ELSE
|
||||
<AND <TYPE? <SET R <2 .M>> ROOM>
|
||||
<NOT <RTRNN .R ,RMUNGBIT>>
|
||||
<SETG BLOC .R>>
|
||||
<CLOCK-INT ,BINT 3>
|
||||
<RETURN <> .BALLACT>)>)
|
||||
(<TELL
|
||||
"I'm afraid you can't control the balloon in this way.">
|
||||
<RETURN T .BALLACT>)>)
|
||||
(<AND <VERB? "TAKE">
|
||||
<==? ,BINF!-FLAG <PRSO>>>
|
||||
<TELL "You don't really want to hold a burning "
|
||||
1
|
||||
<ODESC2 <PRSO>>
|
||||
".">
|
||||
<RETURN T .BALLACT>)
|
||||
(<AND <VERB? "PUT">
|
||||
<==? <PRSI> .CONT>
|
||||
<NOT <EMPTY? <OCONTENTS .CONT>>>>
|
||||
<TELL "The receptacle is already occupied.">
|
||||
<RETURN T .BALLACT>)
|
||||
(<RETURN <> .BALLACT>)>)>
|
||||
<COND (<VERB? "C-INT">
|
||||
<COND (<OR <AND <TRNN .CONT ,OPENBIT> ,BINF!-FLAG>
|
||||
<MEMBER "LEDG" <STRINGP <RID ,HERE>>>>
|
||||
<RISE-AND-SHINE .BALL>)
|
||||
(<DECLINE-AND-FALL .BALL>)>)>>
|
||||
|
||||
<SETG BLAB!-FLAG <>>
|
||||
|
||||
<GDECL (BURNUP-INT BINT) CEVENT>
|
||||
|
||||
<DEFINE RISE-AND-SHINE (BALL
|
||||
"AUX" (S <TOP ,SCRSTR>) M
|
||||
(IN? <==? <AVEHICLE ,WINNER> .BALL>) (BL ,BLOC))
|
||||
#DECL ((BALL) OBJECT (BL) ROOM (M) <OR FALSE STRING> (S) STRING
|
||||
(IN?) <OR ATOM FALSE>)
|
||||
<CLOCK-INT ,BINT 3>
|
||||
<COND (<SET M <MEMBER "VAIR" <STRINGP <RID .BL>>>>
|
||||
<COND (<=? <REST .M 4> "4">
|
||||
<CLOCK-DISABLE ,BURNUP-INT>
|
||||
<CLOCK-DISABLE ,BINT>
|
||||
<REMOVE-OBJECT .BALL>
|
||||
<INSERT-OBJECT <SFIND-OBJ "DBALL"> <SFIND-ROOM "VLBOT">>
|
||||
<COND (.IN?
|
||||
<JIGS-UP
|
||||
|
||||
"Your balloon has hit the rim of the volcano, ripping the cloth and
|
||||
causing you a 500 foot drop. Did you get your flight insurance?">)
|
||||
(<==? ,HERE <SFIND-ROOM "VLBOT">>
|
||||
<TELL
|
||||
"You watch the balloon explode after hitting the rim; its tattered
|
||||
remains land on the ground by your feet.">)
|
||||
(<TELL
|
||||
"You hear a boom and notice that the balloon is falling to the ground.">)>
|
||||
<SETG BLOC <SFIND-ROOM "VLBOT">>)
|
||||
(<SUBSTRUC <STRINGP <RID .BL>> 0 4 .S>
|
||||
<PUT .S 5 <CHTYPE <+ <CHTYPE <5 .M> FIX> 1> CHARACTER>>
|
||||
<COND (.IN?
|
||||
<GOTO <SETG BLOC <FIND-ROOM .S>>>
|
||||
<TELL "The balloon ascends.">
|
||||
<ROOM-INFO>)
|
||||
(<PUT-BALLOON .BALL .S "ascends.">)>)>)
|
||||
(<SET M <MEMBER "LEDG" <STRINGP <RID .BL>>>>
|
||||
<SUBSTRUC "VAIR" 0 4 .S>
|
||||
<PUT .S 5 <5 .M>>
|
||||
<COND (.IN?
|
||||
<GOTO <SETG BLOC <FIND-ROOM .S>>>
|
||||
<TELL "The balloon leaves the ledge.">
|
||||
<ROOM-INFO>)
|
||||
(<CLOCK-INT ,VLGIN 10>
|
||||
<PUT-BALLOON .BALL .S "floats away. It seems to be ascending,
|
||||
due to its light load.">)>)
|
||||
(.IN?
|
||||
<GOTO <SETG BLOC <SFIND-ROOM "VAIR1">>>
|
||||
<TELL "The balloon rises slowly from the ground.">
|
||||
<ROOM-INFO>)
|
||||
(<PUT-BALLOON .BALL "VAIR1" "lifts off.">)>>
|
||||
|
||||
<DEFINE BALLOON-BURN ("AUX" BLABE (BALL <SFIND-OBJ "BALLO">))
|
||||
#DECL ((BALL BLABE) OBJECT)
|
||||
<TELL "The "
|
||||
1
|
||||
<ODESC2 <PRSO>>
|
||||
" burns inside the receptacle.">
|
||||
<SETG BURNUP-INT <CLOCK-INT ,BRNIN <* <OSIZE <PRSO>> 20>>>
|
||||
<TRO <PRSO> <+ ,FLAMEBIT ,LIGHTBIT ,ONBIT>>
|
||||
<TRZ <PRSO> <+ ,TAKEBIT ,READBIT>>
|
||||
<COND (,BINF!-FLAG)
|
||||
(<TELL
|
||||
"The cloth bag inflates as it fills with hot air.">
|
||||
<COND (<NOT ,BLAB!-FLAG>
|
||||
<PUT .BALL
|
||||
,OCONTENTS
|
||||
(<SET BLABE <SFIND-OBJ "BLABE">>
|
||||
!<OCONTENTS .BALL>)>
|
||||
<PUT .BLABE ,OCAN .BALL>)>
|
||||
<SETG BLAB!-FLAG T>
|
||||
<SETG BINF!-FLAG <PRSO>>
|
||||
<CLOCK-INT ,BINT 3>)>>
|
||||
|
||||
<DEFINE PUT-BALLOON (BALL THERE STR "AUX" (HERE ,HERE))
|
||||
#DECL ((BALL) OBJECT (HERE) ROOM (THERE STR) STRING)
|
||||
<COND (<OR <MEMBER "LEDG" <STRINGP <RID .HERE>>>
|
||||
<==? .HERE <FIND-ROOM "VLBOT">>>
|
||||
<TELL "You watch as the balloon slowly " 1 .STR>)>
|
||||
<REMOVE-OBJECT .BALL>
|
||||
<INSERT-OBJECT .BALL <SETG BLOC <FIND-ROOM .THERE>>>>
|
||||
|
||||
<GDECL (BLOC) ROOM>
|
||||
|
||||
<DEFINE DECLINE-AND-FALL (BALL "AUX" (S <TOP ,SCRSTR>) M (BL ,BLOC)
|
||||
(IN? <==? <AVEHICLE ,WINNER> .BALL>) FOO)
|
||||
#DECL ((BALL) OBJECT (BL) ROOM (M) <OR FALSE STRING> (S) STRING
|
||||
(IN?) <OR ATOM FALSE> (FOO) CEVENT)
|
||||
<CLOCK-INT ,BINT 3>
|
||||
<COND (<SET M <MEMBER "VAIR" <STRINGP <RID .BL>>>>
|
||||
<COND (<=? <REST .M 4> "1">
|
||||
<COND (.IN?
|
||||
<GOTO <SETG BLOC <SFIND-ROOM "VLBOT">>>
|
||||
<COND (,BINF!-FLAG
|
||||
<TELL "The balloon has landed.">
|
||||
<CLOCK-INT ,BINT 0>
|
||||
<ROOM-INFO>)
|
||||
(T
|
||||
<REMOVE-OBJECT .BALL>
|
||||
<INSERT-OBJECT <SFIND-OBJ "DBALL"> ,BLOC>
|
||||
<PUT ,WINNER ,AVEHICLE <>>
|
||||
<CLOCK-DISABLE <SET FOO <CLOCK-INT ,BINT 0>>>
|
||||
<TELL
|
||||
"You have landed, but the balloon did not survive.">)>)
|
||||
(<PUT-BALLOON .BALL "VLBOT" "lands.">)>)
|
||||
(<SUBSTRUC <STRINGP <RID .BL>> 0 4 .S>
|
||||
<PUT .S 5 <CHTYPE <- <CHTYPE <5 .M> FIX> 1> CHARACTER>>
|
||||
<COND (.IN?
|
||||
<GOTO <SETG BLOC <FIND-ROOM .S>>>
|
||||
<TELL "The balloon descends.">
|
||||
<ROOM-INFO>)
|
||||
(<PUT-BALLOON .BALL .S "descends.">)>)>)>>
|
||||
|
||||
<DEFINE BCONTENTS ()
|
||||
<COND (<VERB? "TAKE">
|
||||
<TELL
|
||||
"The " 0 <ODESC2 <PRSO>> " is an integral part of the basket and cannot
|
||||
be removed.">
|
||||
<COND (<==? <PRSO> <SFIND-OBJ "BROPE">>
|
||||
<TELL " The wire might possibly be tied, though.">)
|
||||
(<TELL "">)>)
|
||||
(<VERB? "FIND" "EXAMI">
|
||||
<TELL
|
||||
"The " 1 <ODESC2 <PRSO>> " is part of the basket. It may be manipulated
|
||||
within the basket but cannot be removed.">)>>
|
||||
|
||||
<DEFINE WIRE-FUNCTION ("AUX" (BINT ,BINT))
|
||||
#DECL ((BINT) CEVENT)
|
||||
<COND (<VERB? "TAKE" "FIND" "EXAMI">
|
||||
<BCONTENTS>)
|
||||
(<VERB? "TIE">
|
||||
<COND (<AND <==? <PRSO> <SFIND-OBJ "BROPE">>
|
||||
<OR <==? <PRSI> <SFIND-OBJ "HOOK1">>
|
||||
<==? <PRSI> <SFIND-OBJ "HOOK2">>>>
|
||||
<SETG BTIE!-FLAG <PRSI>>
|
||||
<ODESC1 <PRSI>
|
||||
"The basket is anchored to a small hook by the braided wire.">
|
||||
<CLOCK-DISABLE .BINT>
|
||||
<TELL "The balloon is fastened to the hook.">)>)
|
||||
(<AND <VERB? "UNTIE">
|
||||
<==? <PRSO> <SFIND-OBJ "BROPE">>>
|
||||
<COND (,BTIE!-FLAG
|
||||
<CLOCK-ENABLE <SET BINT <CLOCK-INT ,BINT 3>>>
|
||||
<ODESC1 ,BTIE!-FLAG ,HOOK-DESC>
|
||||
<SETG BTIE!-FLAG <>>
|
||||
<TELL "The wire falls off of the hook.">)
|
||||
(<TELL "The wire is not tied to anything.">)>)>>
|
||||
|
||||
<DEFINE BURNUP ("AUX" (R <SFIND-OBJ "RECEP">) (OBJ <1 <OCONTENTS .R>>))
|
||||
#DECL ((R OBJ) OBJECT)
|
||||
<COND (<==? ,HERE ,BLOC>
|
||||
<TELL
|
||||
"You notice that the " 1 <ODESC2 .OBJ> " has burned out, and that
|
||||
the cloth bag starts to deflate.">)>
|
||||
<PUT .R ,OCONTENTS <SPLICE-OUT .OBJ <OCONTENTS .R>>>
|
||||
<SETG BINF!-FLAG <>>
|
||||
T>
|
||||
|
||||
<SETG SAFE-FLAG!-FLAG <>>
|
||||
|
||||
<DEFINE SAFE-ROOM ()
|
||||
<COND (<VERB? "LOOK">
|
||||
<TELL
|
||||
"You are in a dusty old room which is virtually featureless, except
|
||||
for an exit on the north side."
|
||||
,LONG-TELL1
|
||||
<COND (<NOT ,SAFE-FLAG!-FLAG>
|
||||
"
|
||||
Imbedded in the far wall, there is a rusty old box. It appears that
|
||||
the box is somewhat damaged, since an oblong hole has been chipped
|
||||
out of the front of it.")
|
||||
("
|
||||
On the far wall is a rusty box, whose door has been blown off.")>>)>>
|
||||
|
||||
<DEFINE SAFE-FUNCTION ()
|
||||
<COND (<VERB? "TAKE">
|
||||
<TELL "The box is imbedded in the wall.">)
|
||||
(<VERB? "OPEN">
|
||||
<COND (,SAFE-FLAG!-FLAG <TELL "The box has no door!">)
|
||||
(<TELL "The box is rusted and will not open.">)>)
|
||||
(<VERB? "CLOSE">
|
||||
<COND (,SAFE-FLAG!-FLAG <TELL "The box has no door!">)
|
||||
(<TELL "The box is not open, chomper!">)>)>>
|
||||
|
||||
<DEFINE BRICK-FUNCTION ()
|
||||
<COND (<VERB? "BURN">
|
||||
<REMOVE-OBJECT <FIND-OBJ "BRICK">>
|
||||
<JIGS-UP ,BRICK-BOOM>)>>
|
||||
|
||||
<DEFINE FUSE-FUNCTION ("AUX" (FUSE <SFIND-OBJ "FUSE">)
|
||||
(BRICK <SFIND-OBJ "BRICK">) BRICK-ROOM OC)
|
||||
#DECL ((FUSE BRICK) OBJECT (BRICK-ROOM) <OR ROOM FALSE>
|
||||
(OC) <OR OBJECT FALSE>)
|
||||
<COND (<VERB? "BURN">
|
||||
<TELL "The wire starts to burn.">
|
||||
<CLOCK-ENABLE <CLOCK-INT ,FUSIN 2>>)
|
||||
(<VERB? "C-INT">
|
||||
<COND (<==? <OCAN .FUSE> .BRICK>
|
||||
<COND (<SET OC <OCAN .BRICK>>
|
||||
<SET BRICK-ROOM <OROOM .OC>>)
|
||||
(<SET BRICK-ROOM <OROOM .BRICK>>)>
|
||||
<OR .BRICK-ROOM <SET BRICK-ROOM ,HERE>>
|
||||
<COND (<==? .BRICK-ROOM ,HERE>
|
||||
<MUNG-ROOM .BRICK-ROOM
|
||||
"The way is blocked by debris from an explosion.">
|
||||
<JIGS-UP ,BRICK-BOOM>)
|
||||
(<==? .BRICK-ROOM <SFIND-ROOM "SAFE">>
|
||||
<CLOCK-INT ,SAFIN 5>
|
||||
<SETG MUNGED-ROOM <OROOM .BRICK>>
|
||||
<TELL "There is an explosion nearby.">
|
||||
<COND (<MEMQ .BRICK <OCONTENTS <SFIND-OBJ "SSLOT">>>
|
||||
<TRZ <SFIND-OBJ "SSLOT"> ,OVISON>
|
||||
<TRO <SFIND-OBJ "SAFE"> ,OPENBIT>
|
||||
<SETG SAFE-FLAG!-FLAG T>)>)
|
||||
(<TELL "There is an explosion nearby.">
|
||||
<CLOCK-INT ,SAFIN 5>
|
||||
<SETG MUNGED-ROOM .BRICK-ROOM>
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) OBJECT)
|
||||
<COND (<TRNN .X ,TAKEBIT>
|
||||
<TRZ .X ,OVISON>)>>
|
||||
<ROBJS .BRICK-ROOM>>
|
||||
<COND (<==? .BRICK-ROOM <SFIND-ROOM "LROOM">>
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) OBJECT)
|
||||
<PUT .X ,OCAN <>>>
|
||||
<OCONTENTS <SFIND-OBJ "TCASE">>>
|
||||
<PUT <SFIND-OBJ "TCASE"> ,OCONTENTS ()>)>)>
|
||||
<REMOVE-OBJECT .BRICK>)
|
||||
(<OR <NOT <OROOM .FUSE>> <==? ,HERE <OROOM .FUSE>>>
|
||||
<TELL "The wire rapidly burns into nothingness.">)>
|
||||
<REMOVE-OBJECT .FUSE>)>>
|
||||
|
||||
<DEFINE SAFE-MUNG ("AUX" (RM ,MUNGED-ROOM))
|
||||
#DECL ((RM) ROOM)
|
||||
<COND (<==? ,HERE .RM>
|
||||
<JIGS-UP
|
||||
<COND (<RTRNN .RM ,RHOUSEBIT>
|
||||
"The house shakes, and the ceiling of the room you're in collapses,
|
||||
turning you into a pancake.")
|
||||
("The room trembles and 50,000 pounds of rock fall on you, turning you
|
||||
into a pancake.")>>)
|
||||
(<TELL
|
||||
"You may recall that recent explosion. Well, probably as a result of
|
||||
that, you hear an ominous rumbling, as if one of the rooms in the
|
||||
dungeon had collapsed." ,LONG-TELL1>
|
||||
<AND <==? .RM <SFIND-ROOM "SAFE">>
|
||||
<CLOCK-INT ,LEDIN 8>>)>
|
||||
<MUNG-ROOM .RM "The way is blocked by debris from an explosion.">>
|
||||
|
||||
<DEFINE LEDGE-MUNG ("AUX" (RM <SFIND-ROOM "LEDG4">))
|
||||
#DECL ((RM) ROOM)
|
||||
<COND (<==? ,HERE .RM>
|
||||
<COND (<AVEHICLE ,WINNER>
|
||||
<COND (,BTIE!-FLAG
|
||||
<SET RM <SFIND-ROOM "VLBOT">>
|
||||
<SETG BLOC .RM>
|
||||
<REMOVE-OBJECT <SFIND-OBJ "BALLO">>
|
||||
<INSERT-OBJECT <SFIND-OBJ "DBALL"> .RM>
|
||||
<SETG BTIE!-FLAG <>>
|
||||
<SETG BINF!-FLAG <>>
|
||||
<CLOCK-DISABLE ,BINT>
|
||||
<CLOCK-DISABLE ,BRNIN>
|
||||
<JIGS-UP
|
||||
"The ledge collapses, probably as a result of the explosion. A large
|
||||
chunk of it, which is attached to the hook, drags you down to the
|
||||
ground. Fatally.">)
|
||||
(<TELL "The ledge collapses, leaving you with no place to land.">)>)
|
||||
(T
|
||||
<JIGS-UP
|
||||
"The force of the explosion has caused the ledge to collapse
|
||||
belatedly.">)>)
|
||||
(<TELL "The ledge collapses, giving you a narrow escape.">)>
|
||||
<MUNG-ROOM .RM "The ledge has collapsed and cannot be landed on.">>
|
||||
|
||||
<DEFINE LEDGE-FUNCTION ()
|
||||
<COND (<VERB? "LOOK">
|
||||
<TELL
|
||||
"You are on a wide ledge high into the volcano. The rim of the
|
||||
volcano is about 200 feet above and there is a precipitous drop below
|
||||
to the bottom." ,LONG-TELL1
|
||||
<COND (<RTRNN <SFIND-ROOM "SAFE"> ,RMUNGBIT>
|
||||
" The way to the south is blocked by rubble.")
|
||||
(" There is a small door to the south.")>>)>>
|
||||
|
||||
<DEFINE BLAST ()
|
||||
<COND (<==? ,HERE <SFIND-ROOM "SAFE">>)
|
||||
(<TELL "I don't really know how to do that.">)>>
|
||||
|
||||
<DEFINE VOLGNOME ()
|
||||
<COND (<MEMBER "LEDG" <STRINGP <RID ,HERE>>>
|
||||
<TELL ,GNOME-DESC ,LONG-TELL1>
|
||||
<INSERT-OBJECT <SFIND-OBJ "GNOME"> ,HERE>)
|
||||
(<CLOCK-INT ,VLGIN 1>)>>
|
||||
|
||||
<SETG GNOME-DOOR!-FLAG <SETG GNOME-FLAG!-FLAG <>>>
|
||||
|
||||
<DEFINE GNOME-FUNCTION ("AUX" (GNOME <SFIND-OBJ "GNOME">) BRICK)
|
||||
#DECL ((GNOME) OBJECT (BRICK) OBJECT)
|
||||
<COND (<AND <VERB? "GIVE" "THROW">
|
||||
<COND (<N==? <OTVAL <PRSO>> 0>
|
||||
<TELL
|
||||
"Thank you very much for the " ,LONG-TELL1 <ODESC2 <PRSO>> ". I don't believe
|
||||
I've ever seen one as beautiful. 'Follow me', he says, and a door
|
||||
appears on the west end of the ledge. Through the door, you can see
|
||||
a narrow chimney sloping steeply downward. The gnome moves quickly,
|
||||
and he disappears from sight.">
|
||||
<REMOVE-OBJECT <PRSO>>
|
||||
<REMOVE-OBJECT .GNOME>
|
||||
<SETG GNOME-DOOR!-FLAG T>)
|
||||
(<BOMB? <PRSO>>
|
||||
<OR <OROOM <SET BRICK <SFIND-OBJ "BRICK">>>
|
||||
<INSERT-OBJECT .BRICK ,HERE>>
|
||||
<REMOVE-OBJECT .GNOME>
|
||||
<CLOCK-DISABLE ,GNOIN>
|
||||
<CLOCK-DISABLE ,VLGIN>
|
||||
<TELL
|
||||
"'That certainly wasn't what I had in mind', he says, and disappears.">)
|
||||
(<TELL
|
||||
"'That wasn't quite what I had in mind', he says, crunching the
|
||||
" 1 <ODESC2 <PRSO>> " in his rock-hard hands.">
|
||||
<REMOVE-OBJECT <PRSO>>)>>)
|
||||
(<VERB? "C-INT">
|
||||
<COND (<==? ,HERE <OROOM .GNOME>>
|
||||
<TELL
|
||||
"The gnome glances at his watch. 'Oops. I'm late for an
|
||||
appointment!' He disappears, leaving you alone on the ledge." ,LONG-TELL1>)>
|
||||
<REMOVE-OBJECT .GNOME>)
|
||||
(<TELL
|
||||
"The gnome appears increasingly nervous.">
|
||||
<OR ,GNOME-FLAG!-FLAG <CLOCK-INT ,GNOIN 5>>
|
||||
<SETG GNOME-FLAG!-FLAG T>)>>
|
||||
1536
src/zork/act3.198
Normal file
1536
src/zork/act3.198
Normal file
File diff suppressed because it is too large
Load Diff
1151
src/zork/act4.231
Normal file
1151
src/zork/act4.231
Normal file
File diff suppressed because it is too large
Load Diff
924
src/zork/b.176
Normal file
924
src/zork/b.176
Normal file
@@ -0,0 +1,924 @@
|
||||
|
||||
"BIBLE -- print catalog of object, rooms, and verbs"
|
||||
|
||||
<SETG NO-SORT T>
|
||||
|
||||
<DEFINE BIBLE ("OPTIONAL" (F "NUL:") "AUX" (C <OPEN "PRINT" .F>) (O ,OUTCHAN))
|
||||
#DECL ((F) STRING (C) <OR CHANNEL FALSE> (O) CHANNEL)
|
||||
<SETG NO-SORT <>>
|
||||
<AND .C
|
||||
<PROG ((OUTCHAN .C))
|
||||
#DECL ((OUTCHAN) <SPECIAL CHANNEL>)
|
||||
<SETG OUTCHAN .C>
|
||||
<APPLY-RANDOM DO-SCRIPT>
|
||||
<ATLAS>
|
||||
<PRINC <ASCII 12> .C>
|
||||
<CATALOG>
|
||||
<PRINC <ASCII 12> .C>
|
||||
<GET-ACTIONS>
|
||||
<PRINC <ASCII 12> .C>
|
||||
<APPLY-RANDOM DO-UNSCRIPT>
|
||||
<SETG OUTCHAN .O>
|
||||
<CLOSE .C>>>
|
||||
"DONE">
|
||||
|
||||
<DEFINE ATLAS ("TUPLE" RMTUP
|
||||
"AUX" (CNT 0) (RMS '![]) (OUTCHAN .OUTCHAN) (TEST? <>) (SHORT? <>)
|
||||
(PVAL? <>))
|
||||
#DECL ((RMTUP) TUPLE (RMS) <UVECTOR [REST ROOM]> (OUTCHAN) CHANNEL
|
||||
(CNT) FIX (TEST? SHORT?) <OR FALSE ATOM>)
|
||||
<COND (<EMPTY? .RMTUP>)
|
||||
(ELSE
|
||||
<COND (<==? <1 .RMTUP> T>
|
||||
<SET RMTUP <REST .RMTUP>>
|
||||
<SET SHORT? T>
|
||||
<COND (<==? <1 .RMTUP> T>
|
||||
<SET RMTUP <REST .RMTUP>>
|
||||
<SET PVAL? T>)>)>
|
||||
<COND (<AND <NOT <EMPTY? .RMTUP>> <TYPE? <1 .RMTUP> ROOM>>
|
||||
<SET RMS
|
||||
<MAPF
|
||||
,UVECTOR
|
||||
<FUNCTION (N "AUX" R)
|
||||
#DECL ((N) STRING (R) ROOM)
|
||||
<COND (<NOT <EMPTY? <RDESC2 <SET R <FIND-ROOM .N>>>>>
|
||||
<MAPRET .R>)
|
||||
(<PRINC "****** "> <PRINC .N>
|
||||
<PRINC " is NOT a room ******">
|
||||
<CRLF> <MAPRET>)>>
|
||||
.RMTUP>>)
|
||||
(<AND <NOT <EMPTY? .RMTUP>> <TYPE? <1 .RMTUP> FORM ATOM FIX>>
|
||||
<SET TEST? T>)>)>
|
||||
<MAPF <>
|
||||
<FUNCTION (R "AUX" X)
|
||||
#DECL ((R) <SPECIAL ROOM> (X) ANY)
|
||||
<COND (<OR <NOT .TEST?>
|
||||
<MAPF <>
|
||||
<FUNCTION (TEST)
|
||||
#DECL ((TEST) ANY)
|
||||
<OR <COND (<TYPE? .TEST FIX>
|
||||
<RTRNN .R .TEST>)
|
||||
(<TYPE? .TEST ATOM>
|
||||
<COND (<NOT <GASSIGNED? .TEST>> <>)
|
||||
(<TYPE? ,.TEST FIX>
|
||||
<SET X <NTH .R ,.TEST>>)
|
||||
(<SET X <OGET .R .TEST>>)>)
|
||||
(<EVAL .TEST>)>
|
||||
<MAPLEAVE <>>>>
|
||||
.RMTUP>>
|
||||
<SET CNT <+ .CNT 1>>
|
||||
<COND (.SHORT?
|
||||
<ROOM-NAME .R>
|
||||
<COND (.PVAL? <COLUMN 30> <PRINC "==> "> <SPRINT .X>)>
|
||||
<CRLF>)
|
||||
(ELSE <RINFO .R .RMS>)>)>>
|
||||
<COND (<OR .TEST? ,NO-SORT> <UVECTOR !,ROOMS>)
|
||||
(<OORDER <UVECTOR !,ROOMS> ,RDESC2>)>>
|
||||
.CNT>
|
||||
|
||||
"CATALOG -- print catalog of all objects"
|
||||
|
||||
<DEFINE CATALOG ("TUPLE" OBJTUP
|
||||
"AUX" (CNT 0) OBJS (OUTCHAN .OUTCHAN) (TEST? <>) (SHORT? <>)
|
||||
(PVAL? <>))
|
||||
#DECL ((OBJTUP) TUPLE (OBJS) UVECTOR (OUTCHAN) CHANNEL
|
||||
(CNT) FIX (TEST? SHORT?) <OR ATOM FALSE>)
|
||||
<COND (<EMPTY? .OBJTUP> <SET OBJS <UVECTOR !,OBJECTS>>)
|
||||
(ELSE
|
||||
<COND (<==? <1 .OBJTUP> T>
|
||||
<SET OBJTUP <REST .OBJTUP>>
|
||||
<SET SHORT? T>
|
||||
<COND (<==? <1 .OBJTUP> T>
|
||||
<SET OBJTUP <REST .OBJTUP>>
|
||||
<SET PVAL? T>)>)>
|
||||
<COND (<AND <NOT <EMPTY? .OBJTUP>> <TYPE? <1 .OBJTUP> FORM ATOM FIX>>
|
||||
<SET TEST? T>
|
||||
<SET OBJS <UVECTOR !,OBJECTS>>)
|
||||
(<NOT <EMPTY? .OBJTUP>>
|
||||
<SET OBJS
|
||||
<MAPF
|
||||
,UVECTOR
|
||||
<FUNCTION (N "AUX" O)
|
||||
#DECL ((N) STRING (O) OBJECT)
|
||||
<COND (<NOT <EMPTY? <ODESC2 <SET O <FIND-OBJ .N>>>>>
|
||||
<MAPRET .O>)
|
||||
(ELSE
|
||||
<PRINC "****** ">
|
||||
<PRINC .N>
|
||||
<PRINC " is NOT an object ******">
|
||||
<CRLF>
|
||||
<MAPRET>)>>
|
||||
.OBJTUP>>)
|
||||
(ELSE <SET OBJS <UVECTOR !,OBJECTS>>)>)>
|
||||
<MAPF <>
|
||||
<FUNCTION (O "AUX" X)
|
||||
#DECL ((O) <SPECIAL OBJECT> (X) ANY)
|
||||
<COND (<OR <NOT .TEST?>
|
||||
<MAPF <>
|
||||
<FUNCTION (TEST)
|
||||
#DECL ((TEST) ANY)
|
||||
<OR <COND (<TYPE? .TEST FIX>
|
||||
<TRNN .O .TEST>)
|
||||
(<TYPE? .TEST ATOM>
|
||||
<COND (<NOT <GASSIGNED? .TEST>> <>)
|
||||
(<TYPE? ,.TEST FIX>
|
||||
<SET X <NTH .O ,.TEST>>)
|
||||
(<SET X <OGET .O .TEST>>)>)
|
||||
(<EVAL .TEST>)>
|
||||
<MAPLEAVE <>>>>
|
||||
.OBJTUP>>
|
||||
<SET CNT <+ .CNT 1>>
|
||||
<COND (.SHORT?
|
||||
<OBJECT-NAME .O>
|
||||
<COND (.PVAL? <COLUMN 30> <PRINC "==> "> <SPRINT .X>)>
|
||||
<CRLF>)
|
||||
(ELSE <OINFO .O>)>)>>
|
||||
<COND (<OR .TEST? ,NO-SORT> .OBJS)
|
||||
(<OORDER .OBJS ,ODESC2>)>>
|
||||
.CNT>
|
||||
|
||||
<DEFINE COLUMN (N "AUX" (OUTCHAN .OUTCHAN) (X <- .N <14 .OUTCHAN>>))
|
||||
#DECL ((N X) FIX (OUTCHAN) CHANNEL)
|
||||
<COND (<L=? .X 0> <PRINC !\ >)
|
||||
(ELSE
|
||||
<PRINTSTRING " "
|
||||
.OUTCHAN
|
||||
.X>)>>
|
||||
|
||||
<DEFINE SPRINT (A "AUX" (OUTCHAN .OUTCHAN) AR AL)
|
||||
#DECL ((A) ANY (OUTCHAN) CHANNEL (AR) <OR STRING FALSE> (AL) FIX)
|
||||
<COND (<TYPE? .A OBJECT> <OBJECT-NAME .A>)
|
||||
(<TYPE? .A ROOM> <ROOM-NAME .A>)
|
||||
(<MONAD? .A> <PRIN1 .A>)
|
||||
(<TYPE? .A STRING>
|
||||
<REPEAT ()
|
||||
<COND (<EMPTY? .A>
|
||||
<SET AL 0>
|
||||
<SET A "">
|
||||
<RETURN>)
|
||||
(<MEMQ <1 .A> "
|
||||
\"">
|
||||
<SET A <REST .A>>)
|
||||
(ELSE
|
||||
<COND (<SET AR <MEMQ <ASCII 13> .A>>
|
||||
<SET AL <- <LENGTH .A> <LENGTH .AR>>>)
|
||||
(<SET AL <LENGTH .A>>)>
|
||||
<SET AL <MIN .AL <- <13 .OUTCHAN> <+ 6 <14 .OUTCHAN>>>>>
|
||||
<RETURN>)>>
|
||||
<PRINC !\">
|
||||
<PRINTSTRING .A .OUTCHAN .AL>
|
||||
<PRINC "... \"">)>
|
||||
T>
|
||||
|
||||
\
|
||||
|
||||
<DEFINE RINFO (A "OPTIONAL" (RMS '![])
|
||||
"AUX" R (OUTCHAN .OUTCHAN) (HERO ,PLAYER) (LAMP <FIND-OBJ "LAMP">))
|
||||
#DECL ((A) <OR ROOM STRING> (R) ROOM (RMS) UVECTOR (OUTCHAN) CHANNEL
|
||||
(HERO) ADV (LAMP) OBJECT)
|
||||
<AND <TYPE? .A STRING> <SET A <FIND-ROOM .A>>>
|
||||
<SET R .A>
|
||||
<OR <MEMQ <FIND-OBJ "LAMP"> <AOBJS ,WINNER>> <CONS-OBJ "LAMP">>
|
||||
<TRO .LAMP ,ONBIT>
|
||||
<PROG ()
|
||||
<COND (<==? <RID .R> <PSTRING "!">> <RETURN>)>
|
||||
<COND (<AND <NOT <EMPTY? .RMS>>
|
||||
<NOT <MEMQ .R .RMS>>
|
||||
<NOT <EXIT-TO <REXITS .R> .RMS>>>
|
||||
<RETURN>)>
|
||||
<SETG HERE .R>
|
||||
<PUT .HERO ,AROOM .R>
|
||||
<RTRO .R ,RSEENBIT>
|
||||
<PRINC "
|
||||
====== ">
|
||||
<ROOM-NAME .R T>
|
||||
<PRINC " ======
|
||||
">
|
||||
<CRLF>
|
||||
<BIT-INFO .R>
|
||||
<DIR-INFO .R>
|
||||
<PRINC "`">
|
||||
<COND (<TYPE? ,ROOM-DESC RSUBR RSUBR-ENTRY>
|
||||
<ROOM-DESC>)
|
||||
(<APPLY-RANDOM ,ROOM-DESC>)>
|
||||
<PRINC "'">
|
||||
<CRLF>
|
||||
<COND (<RACTION .R>
|
||||
<PRINC "Special action function: ">
|
||||
<COND (<TYPE? <RACTION .R> NOFFSET>
|
||||
<PRIN1 <GET-ATOM <RACTION .R>>>)
|
||||
(<FUNCTION-PRINT <RACTION .R>>)>
|
||||
<CRLF>)>>>
|
||||
|
||||
<SETG BITTYS
|
||||
[,RLIGHTBIT
|
||||
,RAIRBIT
|
||||
,RWATERBIT
|
||||
,RSACREDBIT
|
||||
,RFILLBIT
|
||||
,RMUNGBIT
|
||||
,RBUCKBIT
|
||||
,RHOUSEBIT
|
||||
,RENDGAME]>
|
||||
|
||||
<SETG DESCS
|
||||
'["Lighted"
|
||||
"Mid-air"
|
||||
"Watery"
|
||||
"Robber-proof"
|
||||
"Water-source"
|
||||
"Destroyed"
|
||||
"Bucket"
|
||||
"part of the House"
|
||||
"part of the End Game"]>
|
||||
|
||||
<GDECL (BITTYS) <VECTOR [REST FIX]> (DESCS) <VECTOR [REST STRING]>>
|
||||
|
||||
"BIT-INFO -- print info about a room's bits"
|
||||
|
||||
<DEFINE BIT-INFO (R "AUX" (BB <>) (OUTCHAN .OUTCHAN))
|
||||
#DECL ((R) ROOM (BB) <OR ATOM FALSE> (OUTCHAN) CHANNEL)
|
||||
<COND (<NOT <0? <RVAL .R>>>
|
||||
<PRINC "Room is valued at ">
|
||||
<PRINC <RVAL .R>>
|
||||
<SET BB T>)>
|
||||
<MAPF <>
|
||||
<FUNCTION (B D)
|
||||
#DECL ((B) FIX (D) STRING)
|
||||
<COND (<RTRNN .R .B>
|
||||
<COND (.BB <PRINC ", ">)
|
||||
(ELSE
|
||||
<PRINC "Room is ">)>
|
||||
<SET BB T>
|
||||
<PRINC .D>)>>
|
||||
,BITTYS
|
||||
,DESCS>
|
||||
<AND .BB <PRINC ".
|
||||
|
||||
">>>
|
||||
|
||||
<COND (<NOT <LOOKUP "COMPILE" <ROOT>>>
|
||||
<SETG DIRS
|
||||
[<CHTYPE <PSTRING "OUT"> DIRECTION>
|
||||
"Out"
|
||||
<CHTYPE <PSTRING "NE"> DIRECTION>
|
||||
"Northeast"
|
||||
<CHTYPE <PSTRING "NW"> DIRECTION>
|
||||
"Northwest"
|
||||
<CHTYPE <PSTRING "SE"> DIRECTION>
|
||||
"Southeast"
|
||||
<CHTYPE <PSTRING "SW"> DIRECTION>
|
||||
"Southwest"
|
||||
<CHTYPE <PSTRING "NORTH"> DIRECTION>
|
||||
"North"
|
||||
<CHTYPE <PSTRING "SOUTH"> DIRECTION>
|
||||
"South"
|
||||
<CHTYPE <PSTRING "EAST"> DIRECTION>
|
||||
"East"
|
||||
<CHTYPE <PSTRING "WEST"> DIRECTION>
|
||||
"West"
|
||||
<CHTYPE <PSTRING "UP"> DIRECTION>
|
||||
"Up"
|
||||
<CHTYPE <PSTRING "DOWN"> DIRECTION>
|
||||
"Down"
|
||||
<CHTYPE <PSTRING "LAUNC"> DIRECTION>
|
||||
"Launch"
|
||||
<CHTYPE <PSTRING "CROSS"> DIRECTION>
|
||||
"Cross"
|
||||
<CHTYPE <PSTRING "CLIMB"> DIRECTION>
|
||||
"Climb"
|
||||
<CHTYPE <PSTRING "EXIT"> DIRECTION>
|
||||
"Exit"
|
||||
<CHTYPE <PSTRING "ENTER"> DIRECTION>
|
||||
"Enter"
|
||||
<CHTYPE <PSTRING "LAND"> DIRECTION>
|
||||
"Land"]>)>
|
||||
|
||||
<GDECL (DIRS) <VECTOR [REST DIRECTION STRING]>>
|
||||
|
||||
<DEFINE EXIT-TO (EXITS RMS)
|
||||
#DECL ((EXITS) EXIT (RMS) <UVECTOR [REST ROOM]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (E)
|
||||
#DECL ((E) <OR DIRECTION ROOM CEXIT NEXIT DOOR>)
|
||||
<COND (<TYPE? .E DIRECTION>)
|
||||
(<AND <TYPE? .E ROOM> <MEMQ .E .RMS>>
|
||||
<MAPLEAVE T>)
|
||||
(<AND <TYPE? .E CEXIT> <MEMQ <2 .E> .RMS>>
|
||||
<MAPLEAVE T>)
|
||||
(<AND <TYPE? .E DOOR>
|
||||
<OR <MEMQ <DROOM1 .E> .RMS>
|
||||
<MEMQ <DROOM2 .E> .RMS>>>
|
||||
<MAPLEAVE T>)>>
|
||||
.EXITS>>
|
||||
|
||||
<DEFINE DIR-INFO (ROOM "AUX" (L <REXITS .ROOM>) (DL ,DIRS) D R (OUTCHAN .OUTCHAN) X)
|
||||
#DECL ((L) <OR EXIT VECTOR> (DL) VECTOR (OUTCHAN) CHANNEL (D) STRING
|
||||
(ROOM) ROOM (X) <OR FALSE VECTOR> (R) ANY)
|
||||
<REPEAT ()
|
||||
<COND (<EMPTY? .L> <CRLF> <RETURN>)
|
||||
(<NOT <TYPE? <1 .L> DIRECTION>>
|
||||
<PRINC " BADLY designed room!">)
|
||||
(<==? <1 .L> <CHTYPE <PSTRING "#!#!#"> DIRECTION>>
|
||||
<PRINC "No exits from this room.">
|
||||
<COND (<LENGTH? .L 2> <CRLF> <CRLF> <RETURN>)
|
||||
(ELSE <PRINC " BADLY designed room!">)>)
|
||||
(<SET X <MEMQ <1 .L> .DL>> <PRINC <2 .X>>)
|
||||
(ELSE <PRINC <1 .L>>)>
|
||||
<COND (<TYPE? <SET R <2 .L>> ROOM>
|
||||
<PRINC " to ">
|
||||
<ROOM-NAME .R>
|
||||
<PRINC !\.>)
|
||||
(<TYPE? .R CEXIT>
|
||||
<PRINC " to ">
|
||||
<ROOM-NAME <2 .R>>
|
||||
<PRINC " (if ">
|
||||
<PRINC <1 .R>>
|
||||
<PRINC ").">)
|
||||
(<TYPE? .R DOOR>
|
||||
<PRINC " to ">
|
||||
<ROOM-NAME <COND (<==? <DROOM1 .R> .ROOM> <DROOM2 .R>)
|
||||
(<==? <DROOM2 .R> .ROOM> <DROOM1 .R>)>>
|
||||
<PRINC " (if ">
|
||||
<OBJECT-NAME <DOBJ .R>>
|
||||
<PRINC " is open).">)
|
||||
(<TYPE? .R NEXIT>
|
||||
<PRINC " is closed: ">
|
||||
<COND (<EMPTY? <SET D <REST .R 0>>>
|
||||
<PRINC "[No reason]">)
|
||||
(<PRINC .D>)>)
|
||||
(ELSE <PRINC "???">)>
|
||||
<CRLF>
|
||||
<SET L <REST .L 2>>>>
|
||||
|
||||
"ROOM-NAME -- print name of a room in less than 40 characters"
|
||||
|
||||
<DEFINE ROOM-NAME (R "OPTIONAL" (BIG <>) "AUX" (D <RDESC2 .R>) (OUTCHAN .OUTCHAN))
|
||||
#DECL ((R) ROOM (D) STRING (BIG) <OR ATOM FALSE> (OUTCHAN) CHANNEL)
|
||||
<COND (<EMPTY? .D>
|
||||
<PRINC "[NIL Room]">)
|
||||
(ELSE
|
||||
<COND (<OR .BIG <LENGTH? .D 40>> <PRINC .D>)
|
||||
(ELSE <PRINTSTRING .D .OUTCHAN 35> <PRINC "...">)>
|
||||
<PRINC " {">
|
||||
<PRINC <STRINGP <RID .R>>>
|
||||
<PRINC !\}>)>>
|
||||
|
||||
\
|
||||
|
||||
<DEFINE OBJECT-NAME (O "OPTIONAL" (A? <>) "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((O) OBJECT (A?) <OR ATOM FALSE> (OUTCHAN) CHANNEL)
|
||||
<COND (<EMPTY? <ODESC2 .O>>)
|
||||
(T
|
||||
<AND .A? <PRINC "A ">>
|
||||
<PRINC <ODESC2 .O>>)>
|
||||
<PRINC " {">
|
||||
<PRINC <STRINGP <OID .O>>>
|
||||
<PRINC !\}>>
|
||||
|
||||
"OINFO -- print info for a given object"
|
||||
|
||||
<DEFINE OINFO (SOBJ "OPTIONAL" (REC? <>) "AUX" O BB (OUTCHAN .OUTCHAN) OSYN)
|
||||
#DECL ((SOBJ) <OR STRING OBJECT> (O) OBJECT (OUTCHAN) CHANNEL
|
||||
(OSYN) UVECTOR (BB REC?) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .SOBJ STRING> <SET O <FIND-OBJ .SOBJ>>)
|
||||
(<SET O .SOBJ>)>
|
||||
<PRINC "
|
||||
====== ">
|
||||
<OBJECT-NAME .O T>
|
||||
<PRINC " ======">
|
||||
<CRLF>
|
||||
<SET OSYN
|
||||
<COND (<NOT <EMPTY? <ONAMES .O>>> <REST <ONAMES .O>>)
|
||||
(ELSE <ONAMES .O>)>>
|
||||
<COND (<NOT <EMPTY? .OSYN>>
|
||||
<CRLF>
|
||||
<PRINC "Synonyms: ">
|
||||
<SET BB <>>
|
||||
<MAPF <>
|
||||
<FUNCTION (A)
|
||||
#DECL ((A) PSTRING)
|
||||
<COND (.BB <PRINC ", ">)>
|
||||
<SET BB T>
|
||||
<PRINC <STRINGP .A>>>
|
||||
<REST <ONAMES .O>>>
|
||||
<PRINC !\.>
|
||||
<CRLF>)>
|
||||
<COND (<NOT <EMPTY? <OADJS .O>>>
|
||||
<AND <EMPTY? .OSYN> <CRLF>>
|
||||
<PRINC "Adjectives: ">
|
||||
<SET BB <>>
|
||||
<MAPF <>
|
||||
<FUNCTION (A)
|
||||
#DECL ((A) ADJECTIVE)
|
||||
<COND (.BB <PRINC ", ">)>
|
||||
<SET BB T>
|
||||
<PRINC <STRINGP .A>>>
|
||||
<OADJS .O>>
|
||||
<PRINC !\.>
|
||||
<CRLF>)>
|
||||
<CRLF>
|
||||
<COND (<TRNN .O ,NDESCBIT>
|
||||
<PRINC "[No description]">
|
||||
<CRLF>)
|
||||
(ELSE
|
||||
<COND (<AND <ODESCO .O> <NOT <EMPTY? <ODESCO .O>>>>
|
||||
<PRINC "`">
|
||||
<PRINC <ODESCO .O>>
|
||||
<PRINC "'">
|
||||
<CRLF>)>
|
||||
<COND (<NOT <EMPTY? <ODESC1 .O>>>
|
||||
<PRINC "`">
|
||||
<PRINC <ODESC1 .O>>
|
||||
<PRINC "'">
|
||||
<CRLF>)>)>
|
||||
<CRLF>
|
||||
<COND (<NOT <0? <OGLOBAL .O>>>
|
||||
<PRINC "The ">
|
||||
<OBJECT-NAME .O>
|
||||
<PRINC " is a global object.">
|
||||
<CRLF>)>
|
||||
<REPEAT ((O .O) (FIRST? T))
|
||||
#DECL ((O) OBJECT (FIRST?) <OR ATOM FALSE>)
|
||||
<COND (<OCAN .O>
|
||||
<SET O <OCAN .O>>
|
||||
<COND (<OR <TRNN .O ,VILLAIN> <OACTOR .O>>
|
||||
<COND (.FIRST? <PRINC "Carried by a ">)
|
||||
(ELSE <PRINC ", carried by a ">)>)
|
||||
(.FIRST? <PRINC "In a ">)
|
||||
(ELSE <PRINC ", in a ">)>
|
||||
<OBJECT-NAME .O>
|
||||
<SET FIRST? <>>)
|
||||
(<OROOM .O>
|
||||
<COND (.FIRST? <PRINC "In the ">)
|
||||
(ELSE <PRINC ", in the ">)>
|
||||
<ROOM-NAME <OROOM .O>>
|
||||
<PRINC !\.>
|
||||
<RETURN>)
|
||||
(ELSE
|
||||
<COND (.FIRST? <PRINC "No initial location.">)
|
||||
(ELSE <PRINC ", nowhere.">)>
|
||||
<RETURN>)>>
|
||||
<CRLF>
|
||||
<COND (<OR <NOT <0? <OFVAL .O>>>
|
||||
<NOT <0? <OTVAL .O>>>>
|
||||
<PRINC "Value: ">
|
||||
<COND (<NOT <0? <OFVAL .O>>>
|
||||
<PRINC <OFVAL .O>>
|
||||
<PRINC " if found">
|
||||
<COND (<NOT <0? <OTVAL .O>>>
|
||||
<PRINC ", ">
|
||||
<PRINC <OTVAL .O>>
|
||||
<PRINC " more if in trophy case">)>)
|
||||
(<NOT <0? <OTVAL .O>>>
|
||||
<PRINC <OTVAL .O>>
|
||||
<PRINC " if in trophy case">)>
|
||||
<PRINC ".">
|
||||
<CRLF>)>
|
||||
<COND (<G? <OSIZE .O> 0>
|
||||
<PRINC "Weighs ">
|
||||
<COND (<==? <OSIZE .O> ,BIGFIX> <PRINC "a ton">)
|
||||
(<PRINC <OSIZE .O>>)>
|
||||
<PRINC ".">
|
||||
<CRLF>)>
|
||||
<COND (<TRNN .O ,LIGHTBIT>
|
||||
<PRINC "Can produce light ">
|
||||
<COND (<OLINT .O>
|
||||
<PRINC "for ">
|
||||
<PRINC <1 <2 <OLINT .O>>>>
|
||||
<PRINC " moves.">)
|
||||
(ELSE <PRINC "indefinitely.">)>
|
||||
<CRLF>)>
|
||||
<COND (<G? <OCAPAC .O> 0>
|
||||
<PRINC "Capacity of ">
|
||||
<PRINC <OCAPAC .O>> <PRINC "."> <CRLF>
|
||||
<COND (<NOT <EMPTY? <OCONTENTS .O>>>
|
||||
<SET BB <>>
|
||||
<MAPF <>
|
||||
<FUNCTION (C)
|
||||
#DECL ((C) OBJECT)
|
||||
<COND (.BB <PRINC ", ">)
|
||||
(ELSE
|
||||
<PRINC "The ">
|
||||
<OBJECT-NAME .O>
|
||||
<PRINC " contains ">)>
|
||||
<SET BB T>
|
||||
<PRINC "a ">
|
||||
<OBJECT-NAME .C>>
|
||||
<OCONTENTS .O>>
|
||||
<PRINC ".">
|
||||
<CRLF>)>)>
|
||||
<COND (<G? <OSTRENGTH .O> 0>
|
||||
<PRINC "Fighting strength of ">
|
||||
<PRINC <OSTRENGTH .O>> <PRINC "."> <CRLF>
|
||||
<COND (<NOT <EMPTY? <OCONTENTS .O>>>
|
||||
<SET BB <>>
|
||||
<MAPF <>
|
||||
<FUNCTION (C)
|
||||
#DECL ((C) OBJECT)
|
||||
<COND (.BB <PRINC ", ">)
|
||||
(ELSE
|
||||
<PRINC "The ">
|
||||
<OBJECT-NAME .O>
|
||||
<PRINC " is armed with ">)>
|
||||
<SET BB T>
|
||||
<PRINC "a ">
|
||||
<OBJECT-NAME .C>>
|
||||
<OCONTENTS .O>>
|
||||
<PRINC ".">
|
||||
<CRLF>)>)>
|
||||
<COND (<NOT <0? <CHTYPE <OFLAGS .O> FIX>>>
|
||||
<SET BB <>>
|
||||
<MAPF <>
|
||||
<FUNCTION (B D)
|
||||
#DECL ((B) FIX (D) STRING)
|
||||
<COND (<TRNN .O .B>
|
||||
<COND (.BB <PRINC ", ">)
|
||||
(ELSE
|
||||
<PRINC "The ">
|
||||
<OBJECT-NAME .O>
|
||||
<PRINC " is ">)>
|
||||
<SET BB T>
|
||||
<PRINC .D>)>>
|
||||
,OBITTYS
|
||||
,ODESCS>
|
||||
<PRINC ".">
|
||||
<CRLF>)>
|
||||
<COND (<OACTION .O>
|
||||
<PRINC "Special action function: ">
|
||||
<FUNCTION-PRINT <OACTION .O>>
|
||||
<CRLF>)>
|
||||
<COND (.REC?
|
||||
<MAPF <>
|
||||
<FUNCTION (O) #DECL ((O) OBJECT) <OINFO .O T>>
|
||||
<OCONTENTS .O>>)>
|
||||
"DONE">
|
||||
|
||||
<SETG OBITTYS
|
||||
![,OVISON
|
||||
,READBIT
|
||||
,TAKEBIT
|
||||
,DOORBIT
|
||||
,TRANSBIT
|
||||
,FOODBIT
|
||||
,NDESCBIT
|
||||
,DRINKBIT
|
||||
,CONTBIT
|
||||
,LIGHTBIT
|
||||
,VICBIT
|
||||
,BURNBIT
|
||||
,FLAMEBIT
|
||||
,TOOLBIT
|
||||
,TURNBIT
|
||||
,VEHBIT
|
||||
,FINDMEBIT
|
||||
,SLEEPBIT
|
||||
,SEARCHBIT
|
||||
,SACREDBIT
|
||||
,TIEBIT
|
||||
,CLIMBBIT
|
||||
,ACTORBIT
|
||||
,WEAPONBIT
|
||||
,FIGHTBIT
|
||||
,VILLAIN
|
||||
,STAGGERED
|
||||
,TRYTAKEBIT
|
||||
,NO-CHECK-BIT
|
||||
,OPENBIT
|
||||
,TOUCHBIT
|
||||
,ONBIT!]>
|
||||
|
||||
<SETG ODESCS
|
||||
'["visible"
|
||||
"readable"
|
||||
"takeable"
|
||||
"a door"
|
||||
"transparent"
|
||||
"edible"
|
||||
"indescribable"
|
||||
"drinkable"
|
||||
"a container"
|
||||
"a light"
|
||||
"a victim"
|
||||
"flammable"
|
||||
"burning"
|
||||
"a tool"
|
||||
"turnable"
|
||||
"a vehicle"
|
||||
"reachable from a vehicle"
|
||||
"asleep"
|
||||
"searchable"
|
||||
"sacred"
|
||||
"tieable"
|
||||
"climbable"
|
||||
"an actor"
|
||||
"a weapon"
|
||||
"fighting"
|
||||
"a villain"
|
||||
"staggered"
|
||||
"dangerous to touch"
|
||||
"collective noun"
|
||||
"open"
|
||||
"touched"
|
||||
"turned on"
|
||||
"diggable"
|
||||
"a bunch"]>
|
||||
|
||||
<GDECL (OBITTYS) <UVECTOR [REST FIX]> (ODESCS) <VECTOR [REST STRING]>>
|
||||
|
||||
\
|
||||
|
||||
<GDECL (ACTIONS WORDS) OBLIST>
|
||||
|
||||
"GET-ACTIONS -- print action-info for all verbs"
|
||||
|
||||
<DEFINE GET-ACTIONS ("OPTIONAL" (V <>) "AUX" V1)
|
||||
#DECL ((V) <OR FALSE <UVECTOR [REST PSTRING]>>)
|
||||
<OR .V <SET V <ORDER ,ACTIONS-POBL>>>
|
||||
<SET V1 <IVECTOR <* 3 <LENGTH .V>>>>
|
||||
<MAPF <>
|
||||
<FUNCTION (X "AUX" (A <PLOOKUP .X ,ACTIONS-POBL>) M)
|
||||
#DECL ((X) PSTRING (A) ACTION (M) <OR FALSE VECTOR>)
|
||||
<COND (<SET M <MEMQ .A <TOP .V1>>>
|
||||
<PUT <SET M <BACK .M>>
|
||||
1
|
||||
(.X !<1 .M>)>)
|
||||
(<PUT .V1 1 (.X)>
|
||||
<PUT .V1 2 .A>
|
||||
<PUT .V1 3 0>
|
||||
<SET V1 <REST .V1 3>>)>>
|
||||
.V>
|
||||
<MAPR <>
|
||||
<FUNCTION (VV "AUX" (ITM <1 .VV>))
|
||||
#DECL ((VV) VECTOR (ITM) ANY)
|
||||
<COND (<TYPE? .ITM LIST>
|
||||
<PUT .VV 3 <TOPACT .ITM <2 .VV>>>)>>
|
||||
<SET V1 <TOP .V1>>>
|
||||
<SET V1 <MAPF ,VECTOR
|
||||
<FUNCTION (X)
|
||||
<COND (<TYPE? .X LOSE> <MAPSTOP>)
|
||||
(.X)>>
|
||||
.V1>>
|
||||
<SORT <> .V1 3 2>
|
||||
<MAPR <>
|
||||
<FUNCTION (VV "AUX" (ITM <1 .VV>) NM (1ST? T))
|
||||
#DECL ((VV) VECTOR (ITM) ANY (NM) PSTRING
|
||||
(1ST?) <OR FALSE ATOM>)
|
||||
<COND (<TYPE? <SET ITM <1 .VV>> LIST>
|
||||
<CRLF>
|
||||
<PRINC <STRINGP <SET NM <CHTYPE <3 .VV> PSTRING>>>>
|
||||
<PRINC " (">
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) PSTRING)
|
||||
<COND (<N==? .X .NM>
|
||||
<OR .1ST? <PRINC " ">>
|
||||
<SET 1ST? <>>
|
||||
<PRINC <STRINGP .X>>)>>
|
||||
.ITM>
|
||||
<PRINC !\)>
|
||||
<GET-ACTION <2 .VV>>)
|
||||
(<TYPE? .ITM LOSE> <MAPLEAVE T>)>>
|
||||
.V1>
|
||||
<LENGTH .V1>>
|
||||
|
||||
<DEFINE TOPACT (LST ACT "AUX" (ASTR <3 .ACT>))
|
||||
#DECL ((LST) <LIST [REST PSTRING]> (ACT) ACTION (ASTR) STRING)
|
||||
<COND (<EMPTY? .ASTR>
|
||||
<SET ASTR <STRING <STRINGP <1 .LST>>>>)>
|
||||
<COND (<MAPF <>
|
||||
<FUNCTION (PSTR)
|
||||
#DECL ((PSTR) PSTRING)
|
||||
<COND (<COMPS <STRINGP .PSTR> .ASTR>
|
||||
<MAPLEAVE <CHTYPE .PSTR FIX>>)>>
|
||||
.LST>)
|
||||
(<CHTYPE <NTH .LST <LENGTH .LST>> FIX>)>>
|
||||
|
||||
<DEFINE COMPS (STR1 STR2)
|
||||
#DECL ((STR1 STR2) STRING)
|
||||
<MAPF <>
|
||||
<FUNCTION (CHR1 CHR2)
|
||||
#DECL ((CHR1 CHR2) CHARACTER)
|
||||
<COND (<AND <G=? <ASCII .CHR2> <ASCII !\a>>
|
||||
<L=? <ASCII .CHR2> <ASCII !\z>>>
|
||||
<SET CHR2 <CHTYPE <- <ASCII .CHR2> 32> CHARACTER>>)>
|
||||
<COND (<==? .CHR1 .CHR2>)
|
||||
(<MAPLEAVE <>>)>>
|
||||
.STR1
|
||||
.STR2>>
|
||||
|
||||
"GET-ACTION -- print info for a single verb"
|
||||
|
||||
<DEFINE GET-ACTION (A "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((A) ACTION (OUTCHAN) CHANNEL)
|
||||
<MAPF <>
|
||||
<FUNCTION (S)
|
||||
#DECL ((S) SYNTAX)
|
||||
<CRLF>
|
||||
<COND (<STRNN .S ,SDRIVER> <COLUMN 4> <PRINC "* ">)
|
||||
(ELSE <COLUMN 6>)>
|
||||
<PRINC <VSTR .A>>
|
||||
<PARG <SYN1 .S>>
|
||||
<PARG <SYN2 .S>>>
|
||||
<VDECL .A>>
|
||||
<CRLF>>
|
||||
|
||||
"PARG -- print info for one argument of a verb"
|
||||
|
||||
<DEFINE PARG (VARG "AUX" (B <VBIT .VARG>) (W <VWORD .VARG>) (OUTCHAN .OUTCHAN))
|
||||
#DECL ((VARG) VARG (B W) FIX (OUTCHAN) CHANNEL)
|
||||
<COND (<AND <0? .B> <0? .W>>)
|
||||
(ELSE
|
||||
<COND (<VPREP .VARG>
|
||||
<PRINC !\ >
|
||||
<PLC <STRINGP <VPREP .VARG>>>)>
|
||||
<PRINC " <">
|
||||
<PVBIT .B>
|
||||
<AND <N==? .B <VFWIM .VARG>> <PRINC !\/> <PVBIT <VFWIM .VARG>>>
|
||||
<PVWORD .W>
|
||||
<PRINC !\>>)>>
|
||||
|
||||
"PVBIT -- print info for object spec for a verb argument"
|
||||
|
||||
<DEFINE PVBIT (B "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((B) FIX (OUTCHAN) CHANNEL)
|
||||
<COND (<==? .B -1> <PRINC "any">)
|
||||
(<0? .B> <PRINC "?none?">)
|
||||
(ELSE
|
||||
<PBITS .B ,ODESCS>)>>
|
||||
|
||||
"PVWORD -- print verb info for a verb argument"
|
||||
|
||||
<DEFINE PVWORD (W "AUX" (OUTCHAN .OUTCHAN) TC (COM <>))
|
||||
#DECL ((W) FIX (OUTCHAN) CHANNEL (TC) FIX (COM) <OR FALSE ATOM>)
|
||||
<COND (<==? .W 3>)
|
||||
(<0? .W> <PRINC ":none">)
|
||||
(ELSE
|
||||
<PRINC !\:>
|
||||
<SET TC </ <CHTYPE <ANDB .W <+ ,VTBIT ,VCBIT>> FIX> 4>>
|
||||
<SET COM T>
|
||||
<COND (<0? .TC> <SET COM <>>)
|
||||
(<1? .TC> <PRINC "try">)
|
||||
(<==? .TC 2> <PRINC "have">)
|
||||
(<==? .TC 3> <PRINC "take">)>
|
||||
<PBITS .W ,VBDESCS .COM>)>>
|
||||
|
||||
<SETG VBDESCS '["adv" "room" "" "" ""]>
|
||||
|
||||
<GDECL (VBDESCS) <VECTOR [REST STRING]>>
|
||||
|
||||
"PBITS -- print bits that are on in a flagword"
|
||||
|
||||
<DEFINE PBITS (B BNAMES "OPTIONAL" (COM? <>) "AUX" (N 1) (C 1) (OUTCHAN .OUTCHAN) S)
|
||||
#DECL ((B C N) FIX (BNAMES) <VECTOR [REST STRING]> (COM?) <OR ATOM FALSE>
|
||||
(OUTCHAN) CHANNEL (S) STRING)
|
||||
<REPEAT ()
|
||||
<COND (<NOT <0? <CHTYPE <ANDB .B .N> FIX>>>
|
||||
<COND (<NOT <EMPTY? <SET S <NTH .BNAMES .C>>>>
|
||||
<AND .COM? <PRINC ",">>
|
||||
<SET COM? T>
|
||||
<PRINC .S>)>)>
|
||||
<COND (<==? .N *200000000000*> <RETURN>)
|
||||
(ELSE <SET N <* .N 2>> <SET C <+ .C 1>>)>>>
|
||||
|
||||
"PLC -- print a string in lower case"
|
||||
|
||||
<DEFINE PLC (STR "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((STR) STRING (OUTCHAN) CHANNEL)
|
||||
<MAPF <>
|
||||
<FUNCTION (C "AUX" (A <ASCII .C>))
|
||||
#DECL ((C) CHARACTER (A) FIX)
|
||||
<COND (<AND <G=? .A <ASCII !\A>>
|
||||
<L=? .A <ASCII !\Z>>>
|
||||
<SET A <+ .A 32>>)>
|
||||
<PRINC <ASCII .A>>>
|
||||
.STR>
|
||||
.STR>
|
||||
|
||||
\
|
||||
|
||||
"GET-VERBS -- print various verb garbage -- probably doesn't work?"
|
||||
|
||||
<DEFINE GET-VERBS ("OPTIONAL" (TOPL <>) "AUX" (WORDS ,WORDS-POBL) V (OUTCHAN .OUTCHAN))
|
||||
#DECL ((V) <UVECTOR [REST PSTRING]> (TOPL) <OR ATOM FALSE> (OUTCHAN) CHANNEL)
|
||||
<SET V <ORDER .WORDS>>
|
||||
<MAPF <>
|
||||
<FUNCTION (X "AUX" (A <PLOOKUP .X .WORDS>))
|
||||
#DECL ((X) PSTRING (A) ANY)
|
||||
<COND (<AND <TYPE? .A VERB>
|
||||
<OR <NOT .TOPL> <==? .X <1 .A>>>>
|
||||
<PRINC <STRINGP .X>>
|
||||
<COLUMN 10>
|
||||
<COND (<==? <1 .A> .X> <PRINC "Top Level">)
|
||||
(<PRINC "= "> <PRINC <STRINGP <1 .A>>>)>
|
||||
<CRLF>)>>
|
||||
.V>
|
||||
<LENGTH .V>>
|
||||
|
||||
\
|
||||
|
||||
"GET-WORDS -- print various garbage about WORDS"
|
||||
|
||||
<DEFINE GET-WORDS ("AUX" (WORDS ,WORDS-POBL) V (LSTNAME <>) (OUTCHAN .OUTCHAN))
|
||||
#DECL ((V) UVECTOR (LSTNAME) <OR PSTRING FALSE> (OUTCHAN) CHANNEL)
|
||||
<SET V <ORDER .WORDS>>
|
||||
<MAPR <>
|
||||
<FUNCTION (Y "AUX" Z (X <1 .Y>))
|
||||
#DECL ((X) PSTRING (Y) UVECTOR)
|
||||
<COND
|
||||
(<N==? .X .LSTNAME>
|
||||
<PRINC <STRINGP .X>>
|
||||
<SET LSTNAME .X>
|
||||
<COLUMN 10>
|
||||
<COND (<SET Z <PLOOKUP .X .WORDS>>
|
||||
<COND (<TYPE? .Z VERB>
|
||||
<PRINC "ACTION">
|
||||
<COLUMN 24>
|
||||
<COND (<==? <1 .Z> .X> <PRINC "Top Level">)
|
||||
(<PRINC "= "> <PRINC <STRINGP <1 .Z>>>)>)
|
||||
(<TYPE? .Z BUZZ> <PRINC "BUZZ WORD">)
|
||||
(<PRIN1 <TYPE .Z>>)>)>
|
||||
<CRLF>)>>
|
||||
.V>
|
||||
</ <LENGTH .V> 2>>
|
||||
|
||||
\
|
||||
|
||||
"ORDER -- sorter for uvectors of atoms"
|
||||
|
||||
<DEFINE ORDER (O "AUX" (L ()) O1 S S1 S2 V1 V2 SP1 SP2)
|
||||
#DECL ((O) <OR <UVECTOR [REST PSTRING]> POBLIST> (S S1 S2) UVECTOR
|
||||
(SP1 SP2) STRING (V1 V2) PSTRING (O1) <<PRIMTYPE UVECTOR>
|
||||
[REST LIST]>
|
||||
(L) <LIST [REST PSTRING ANY]>)
|
||||
<COND (<TYPE? .O POBLIST>
|
||||
<SET O1 .O>
|
||||
<SET S
|
||||
<MAPF ,UVECTOR
|
||||
<FUNCTION ("AUX" Y)
|
||||
<COND (<EMPTY? .L>
|
||||
<COND (<EMPTY? .O1> <MAPSTOP>)
|
||||
(T
|
||||
<SET L <1 .O1>>
|
||||
<SET O1 <REST .O1>>)>
|
||||
<MAPRET>)
|
||||
(<SET Y <1 .L>>
|
||||
<SET L <REST .L 2>>
|
||||
<MAPRET .Y>)>>>>)
|
||||
(<SET S .O>)>
|
||||
<SET S1 <SET S2 .S>>
|
||||
<COND (<LENGTH? .S 1> .S)
|
||||
(ELSE
|
||||
<REPEAT ()
|
||||
<COND (<EMPTY? .S2>
|
||||
<COND (<EMPTY? <SET S1 <REST .S1>>> <RETURN .S>)
|
||||
(<SET S2 <REST .S1>> <AGAIN>)>)>
|
||||
<SET V1 <1 .S1>>
|
||||
<SET V2 <1 .S2>>
|
||||
<COND (<G? <CHTYPE .V1 FIX> <CHTYPE .V2 FIX>>
|
||||
<PUT .S1 1 .V2>
|
||||
<PUT .S2 1 .V1>)>
|
||||
<SET S2 <REST .S2>>>)>>
|
||||
|
||||
"OORDER -- order a list by an offset in each element"
|
||||
|
||||
<DEFINE OORDER (S OFFS "AUX" S1 S2 V1 V2 SP1 SP2)
|
||||
#DECL ((S S1 S2) <UVECTOR [REST <PRIMTYPE VECTOR>]> (V1 V2) <PRIMTYPE VECTOR>
|
||||
(OFFS) FIX (SP1 SP2) STRING)
|
||||
<SET S1 <SET S2 .S>>
|
||||
<COND (<LENGTH? .S 1> .S)
|
||||
(ELSE
|
||||
<REPEAT ()
|
||||
<COND (<EMPTY? .S2>
|
||||
<COND (<EMPTY? <SET S1 <REST .S1>>> <RETURN .S>)
|
||||
(<SET S2 <REST .S1>> <AGAIN>)>)>
|
||||
<SET V1 <1 .S1>>
|
||||
<SET V2 <1 .S2>>
|
||||
<SET SP1 <NTH .V1 .OFFS>>
|
||||
<SET SP2 <NTH .V2 .OFFS>>
|
||||
<COND (<ALPH .SP1 .SP2>
|
||||
<PUT .S1 1 .V2>
|
||||
<PUT .S2 1 .V1>)>
|
||||
<SET S2 <REST .S2>>>)>>
|
||||
|
||||
<DEFINE ALPH (S1 S2 "AUX" (L1 <LENGTH .S1>) (L2 <LENGTH .S2>))
|
||||
#DECL ((S1 S2) STRING (L1 L2) FIX)
|
||||
<COND (<AND <0? .L1> <NOT <0? .L2>>> <>)
|
||||
(<AND <0? .L2> <NOT <0? .L1>>> T)
|
||||
(ELSE
|
||||
<MAPR <>
|
||||
<FUNCTION (S1 S2 "AUX" (C1 <ASCII <1 .S1>>) (C2 <ASCII <1 .S2>>)
|
||||
(L1 <LENGTH .S1>) (L2 <LENGTH .S2>))
|
||||
#DECL ((S1 S2) STRING (C1 C2 L1 L2) FIX)
|
||||
<COND (<AND <G=? .C1 <ASCII !\a>> <L=? .C1 <ASCII !\z>>>
|
||||
<SET C1 <- .C1 32>>)>
|
||||
<COND (<AND <G=? .C2 <ASCII !\a>> <L=? .C2 <ASCII !\z>>>
|
||||
<SET C2 <- .C2 32>>)>
|
||||
<COND (<==? .C1 .C2>
|
||||
<COND (<AND <0? .L1> <NOT <0? .L2>>> <MAPLEAVE <>>)
|
||||
(<AND <0? .L2> <NOT <0? .L1>>> <MAPLEAVE T>)>)
|
||||
(<G? .C1 .C2>
|
||||
<MAPLEAVE T>)
|
||||
(<L? .C1 .C2>
|
||||
<MAPLEAVE <>>)>>
|
||||
.S1 .S2>)>>
|
||||
145
src/zork/build.cmd
Normal file
145
src/zork/build.cmd
Normal file
@@ -0,0 +1,145 @@
|
||||
MARC MARC
|
||||
‡
|
||||
CONN <ZORK>
|
||||
<MDL>MDL104
|
||||
<RESTORE "<MDL>M104UNI">
|
||||
<SNAME "ZORK">
|
||||
<FLOAD "LITLPK.GBIN">
|
||||
<USE "CLEAN" "PURITY">
|
||||
<SETG NULL!- <INSERT <STRING <ASCII 127>> <ROOT>>>
|
||||
%%<BLOCK (<MOBLIST FROBOZZ> <GET INITIAL OBLIST> <ROOT>)>
|
||||
<DEFINE GL (FILE "AUX" VAL (CH <OPEN "READ" .FILE>) L)
|
||||
<SET L
|
||||
<MAPF ,LIST
|
||||
<FUNCTION ()
|
||||
<SET VAL <READ .CH '<MAPSTOP>>>
|
||||
<EVAL .VAL>
|
||||
.VAL>>>
|
||||
<SET <SET VAL <PARSE <7 .CH>>> .L>
|
||||
.VAL>
|
||||
<DEFINE FLUSHG (ATM "AUX" (G ..ATM))
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
<COND (<AND <TYPE? .X FORM>
|
||||
<G? <LENGTH .X> 2>
|
||||
<MEMQ <1 .X> '![SETG DEFMAC DEFINE]>>
|
||||
<AND <MANIFEST? <2 .X>>
|
||||
<UNMANIFEST <2 .X>>>
|
||||
<GUNASSIGN <2 .X>>)>>
|
||||
.G>
|
||||
<UNASSIGN <REMOVE .ATM>>>
|
||||
%%<ENDBLOCK>
|
||||
<GL!-FROBOZZ "PRIM.NBIN">
|
||||
<GL!-FROBOZZ "MAKSTR.NBIN">
|
||||
<FLOAD "ZORK.XGBIN">
|
||||
<FLUSHG!-FROBOZZ PRIM>
|
||||
<FLUSHG!-FROBOZZ MAKSTR>
|
||||
<FLOAD "TYPHAK.NBIN">
|
||||
<MAPF <> <FUNCTION (X)
|
||||
<MAPF <> <FUNCTION (X)
|
||||
<COND (<GBOUND? .X> <PUT-DECL <GLOC .X> ANY>)>>
|
||||
.X>>
|
||||
<GET INITIAL OBLIST>>
|
||||
<CLEANUP>
|
||||
<PRINT-CLEANUP>
|
||||
%%<SET X ,PURELST>
|
||||
<GROUP-PURIFY X>
|
||||
<GL!-FROBOZZ "PRIM.NBIN">
|
||||
<GL!-FROBOZZ "MAKSTR.NBIN">
|
||||
<FLOAD "DUNG">
|
||||
<SETG END-GAME-EXISTS? T>
|
||||
%%<BLOCK (<GET FROBOZZ OBLIST> <GET INITIAL OBLIST> <ROOT>)>
|
||||
<DEFINE ROOM-FROB (RM L "AUX" TL)
|
||||
<COND (<SET TL <MEMBER <RDESC1 .RM> .L>>
|
||||
<PUT .RM ,RDESC1 <1 .TL>>)
|
||||
(<SET L (<RDESC1 .RM> !.L)>)>
|
||||
<COND (<SET TL <MEMBER <RDESC2 .RM> .L>>
|
||||
<PUT .RM ,RDESC2 <1 .TL>>)
|
||||
(<SET L (<RDESC2 .RM> !.L)>)>
|
||||
<MAPR <>
|
||||
<FUNCTION (Y "AUX" (X <1 .Y>))
|
||||
<COND (<AND <TYPE? .X CEXIT> <CXSTR .X>>
|
||||
<COND (<SET TL <MEMBER <CXSTR .X> .L>>
|
||||
<PUT .X ,CXSTR <1 .TL>>)
|
||||
(<SET L (<CXSTR .X> !.L)>)>)
|
||||
(<AND <TYPE? .X DOOR> <DSTR .X>>
|
||||
<COND (<SET TL <MEMBER <DSTR .X> .L>>
|
||||
<PUT .X ,DSTR <1 .TL>>)
|
||||
(<SET L (<DSTR .X> !.L)>)>)
|
||||
(<TYPE? .X NEXIT>
|
||||
<COND (<SET TL <MEMBER .X .L>>
|
||||
<PUT .Y 1 <1 .TL>>)
|
||||
(<SET L (.X !.L)>)>)>>
|
||||
<REXITS .RM>>
|
||||
.L>
|
||||
<DEFINE OBJECT-FROB (OBJ L "AUX" TL TEMP)
|
||||
<COND (<SET TL <MEMBER <ODESC1 .OBJ> .L>>
|
||||
<OPUT .OBJ ODESC1 <1 .TL>>)
|
||||
(<SET L (<ODESC1 .OBJ> !.L)>)>
|
||||
<COND (<SET TL <MEMBER <ODESC2 .OBJ> .L>>
|
||||
<PUT .OBJ ,ODESC2 <1 .TL>>)
|
||||
(<SET L (<ODESC2 .OBJ> !.L)>)>
|
||||
<COND (<SET TL <MEMBER <ODESCO .OBJ> .L>>
|
||||
<OPUT .OBJ ODESCO <1 .TL>>)
|
||||
(<SET L (<ODESCO .OBJ> !.L)>)>
|
||||
<COND (<SET TEMP <OREAD .OBJ>>
|
||||
<SET L (.TEMP !.L)>)>
|
||||
<COND (<SET TEMP <OFMSGS .OBJ>>
|
||||
<SET L (.TEMP !.L)>)>
|
||||
.L>
|
||||
%%<ENDBLOCK>
|
||||
<GL!-FROBOZZ "DISP1.GBIN">
|
||||
<DISPATCH-HACK>
|
||||
<FLUSHG!-FROBOZZ PRIM>
|
||||
<FLUSHG!-FROBOZZ MAKSTR>
|
||||
<FLUSHG!-FROBOZZ DISP1>
|
||||
<SET Y ()>
|
||||
<SETG FF "; \\\"Dungeon\\\"">
|
||||
%%<MAPF <>
|
||||
<FUNCTION (X)
|
||||
<SET Y <ROOM-FROB!-FROBOZZ .X .Y>>>
|
||||
,ROOMS>
|
||||
%%<MAPF <>
|
||||
<FUNCTION (X)
|
||||
<SET Y <OBJECT-FROB!-FROBOZZ .X .Y>>>
|
||||
,OBJECTS>
|
||||
%%<PUT <PUT FROBOZZ OBLIST> OBLIST>
|
||||
%%<MAPR <>
|
||||
<FUNCTION (X)
|
||||
<PUT .X 1 ,<1 .X>>>
|
||||
,PURE-LIST>
|
||||
%%<PUTREST <REST ,PURE-LIST <- <LENGTH ,PURE-LIST> 1>> .Y>
|
||||
%%<SET Y <IVECTOR <LENGTH ,PURE-LIST>>>
|
||||
%%<MAPR <>
|
||||
<FUNCTION (X Y)
|
||||
<PUT .X 1 <1 .Y>>>
|
||||
.Y ,PURE-LIST>
|
||||
%%<SETG PURE-LIST .Y>
|
||||
<UNASSIGN <REMOVE Y>>
|
||||
<LENGTH ,PURE-LIST>
|
||||
%%<PURIFY ,PURE-LIST ,DISPATCH-TABLE>
|
||||
<KILL:PURITY>
|
||||
<FLUSH-CLEANUP>
|
||||
<UNASSIGN X>
|
||||
<REMOVE <GUNASSIGN PURE-LIST>>
|
||||
<REMOVE <UNASSIGN FOO>>
|
||||
<DEFINE F (BAR) <GUNASSIGN <REMOVE .BAR>>>
|
||||
<F DROP>
|
||||
<F L-UNUSE>
|
||||
<F USE>
|
||||
<F ENTRY>
|
||||
<F PACKAGE>
|
||||
<F ENDPACKAGE>
|
||||
<F FIND/LOAD>
|
||||
<F F>
|
||||
<HANDLER <GET ERROR!-INTERRUPTS INTERRUPT> ,ERRH>
|
||||
<SETG MUD-HAND <OFF <3 <GET ,INCHAN INTERRUPT>>>>
|
||||
<SETG ZORK-HAND <OFF <HANDLER <GET ,INCHAN INTERRUPT> ,CTRL-S>>>
|
||||
<GC 0 T>
|
||||
<SETG DBG <>>
|
||||
<GC-MON T>
|
||||
<BLOAT 0 0 0 0 0 300>
|
||||
<SAVE-IT "<TAA>MADADV.SAVE" <>>
|
||||
<QUIT>
|
||||
DEL ZORK.XGBIN
|
||||
EXP
|
||||
650
src/zork/defs.171
Normal file
650
src/zork/defs.171
Normal file
@@ -0,0 +1,650 @@
|
||||
|
||||
"(c) Copyright 1978, Massachusetts Institute of Technology. All rights reserved."
|
||||
|
||||
<AND <L? ,MUDDLE 100>
|
||||
<NOT <OR <LOOKUP "COMPILE" <ROOT>>
|
||||
<LOOKUP "GROUP-GLUE" <GET INITIAL OBLIST>>>>
|
||||
<USE "LSRTNS">>
|
||||
|
||||
;"newtypes for oblist hack"
|
||||
<NEWTYPE PSTRING WORD>
|
||||
<NEWTYPE POBLIST UVECTOR '<<PRIMTYPE UVECTOR> [REST LIST]>>
|
||||
|
||||
;"applicables"
|
||||
|
||||
<NEWTYPE NOFFSET WORD>
|
||||
|
||||
<PUT RAPPLIC DECL '<OR ATOM FALSE NOFFSET>>
|
||||
|
||||
;"newtypes for parser"
|
||||
|
||||
<NEWTYPE BUZZ WORD>
|
||||
|
||||
<NEWTYPE DIRECTION WORD>
|
||||
|
||||
<NEWTYPE ADJECTIVE WORD>
|
||||
|
||||
<NEWTYPE PREP WORD>
|
||||
|
||||
\
|
||||
|
||||
;"generalized oflags tester"
|
||||
|
||||
<DEFMAC TRNN ('OBJ 'BIT)
|
||||
<FORM N==? <FORM CHTYPE <FORM ANDB .BIT <FORM OFLAGS .OBJ>> FIX> 0>>
|
||||
<DEFMAC RTRNN ('RM 'BIT)
|
||||
<FORM N==? <FORM CHTYPE <FORM ANDB .BIT <FORM RBITS .RM>> FIX> 0>>
|
||||
<DEFMAC GTRNN ('RM 'BIT)
|
||||
<FORM N==? <FORM CHTYPE <FORM ANDB .BIT <FORM RGLOBAL .RM>> FIX> 0>>
|
||||
<DEFMAC RTRZ ('RM BIT)
|
||||
<FORM PUT .RM ,RBITS <FORM CHTYPE <FORM ANDB <FORM RBITS .RM> <XORB .BIT -1>> FIX>>>
|
||||
<DEFMAC TRC ('OBJ 'BIT)
|
||||
<FORM PUT .OBJ ,OFLAGS <FORM CHTYPE <FORM XORB <FORM OFLAGS .OBJ> .BIT> FIX>>>
|
||||
<DEFMAC TRZ ('OBJ BIT)
|
||||
<FORM PUT .OBJ ,OFLAGS <FORM CHTYPE <FORM ANDB <FORM OFLAGS .OBJ> <XORB .BIT -1>> FIX>>>
|
||||
<DEFMAC TRO ('OBJ 'BIT)
|
||||
<FORM PUT .OBJ ,OFLAGS <FORM CHTYPE <FORM ORB <FORM OFLAGS .OBJ> .BIT> FIX>>>
|
||||
<DEFMAC RTRO ('RM 'BIT)
|
||||
<FORM PUT .RM ,RBITS <FORM CHTYPE <FORM ORB <FORM RBITS .RM> .BIT> FIX>>>
|
||||
<DEFMAC RTRC ('RM 'BIT)
|
||||
<FORM PUT .RM ,RBITS <FORM CHTYPE <FORM XORB <FORM RBITS .RM> .BIT> FIX>>>
|
||||
<DEFMAC ATRNN ('ADV 'BIT)
|
||||
<FORM N==? <FORM CHTYPE <FORM ANDB .BIT <FORM AFLAGS .ADV>> FIX> 0>>
|
||||
<DEFMAC ATRZ ('ADV BIT)
|
||||
<FORM PUT .ADV ,AFLAGS <FORM CHTYPE <FORM ANDB <FORM AFLAGS .ADV> <XORB .BIT -1>>
|
||||
FIX>>>
|
||||
<DEFMAC ATRO ('ADV 'BIT)
|
||||
<FORM PUT .ADV ,AFLAGS <FORM CHTYPE <FORM ORB <FORM AFLAGS .ADV> .BIT> FIX>>>
|
||||
|
||||
\
|
||||
|
||||
;"room definition"
|
||||
|
||||
<NEWSTRUC ROOM
|
||||
VECTOR
|
||||
RID
|
||||
PSTRING ;"room id"
|
||||
RDESC1
|
||||
STRING ;"long description"
|
||||
RDESC2
|
||||
STRING ;"short description"
|
||||
REXITS
|
||||
EXIT ;"list of exits"
|
||||
ROBJS
|
||||
<LIST [REST OBJECT]> ;"objects in room"
|
||||
RACTION
|
||||
RAPPLIC ;"room-action"
|
||||
RBITS
|
||||
FIX ;"random flags"
|
||||
RPROPS
|
||||
<LIST [REST ATOM ANY]>>
|
||||
|
||||
;"Slots for room"
|
||||
|
||||
<MAKE-SLOT RVAL FIX 0>
|
||||
|
||||
;"value for entering"
|
||||
|
||||
<MAKE-SLOT RGLOBAL FIX ,STAR-BITS>
|
||||
|
||||
;"globals for room"
|
||||
|
||||
<FLAGWORD RSEENBIT ;"visited?"
|
||||
RLIGHTBIT ;"endogenous light source?"
|
||||
RLANDBIT ;"on land"
|
||||
RWATERBIT ;"water room"
|
||||
RAIRBIT ;"mid-air room"
|
||||
RSACREDBIT ;"thief not allowed"
|
||||
RFILLBIT ;"can fill bottle here"
|
||||
RMUNGBIT ;"room has been munged"
|
||||
RBUCKBIT ;"this room is a bucket"
|
||||
RHOUSEBIT ;"This room is part of the house"
|
||||
RENDGAME ;"This room is in the end game"
|
||||
RNWALLBIT ;"This room doesn't have walls">
|
||||
|
||||
;"exit"
|
||||
|
||||
<NEWTYPE EXIT
|
||||
VECTOR
|
||||
'<<PRIMTYPE VECTOR> [REST DIRECTION <OR ROOM CEXIT DOOR NEXIT>]>>
|
||||
|
||||
;"conditional exit"
|
||||
|
||||
<NEWSTRUC CEXIT
|
||||
VECTOR
|
||||
CXFLAG
|
||||
ATOM ;"condition flag"
|
||||
CXROOM
|
||||
ROOM ;"room it protects"
|
||||
CXSTR
|
||||
<OR FALSE STRING> ;"description"
|
||||
CXACTION
|
||||
RAPPLIC ;"exit function">
|
||||
|
||||
<NEWSTRUC DOOR
|
||||
VECTOR
|
||||
DOBJ
|
||||
OBJECT ;"the door"
|
||||
DROOM1
|
||||
ROOM ;"one of the rooms"
|
||||
DROOM2
|
||||
ROOM ;"the other one"
|
||||
DSTR
|
||||
<OR FALSE STRING> ;"what to print if closed"
|
||||
DACTION
|
||||
RAPPLIC ;"what to call to decide">
|
||||
|
||||
<NEWTYPE NEXIT STRING>
|
||||
|
||||
;"unusable exit description"
|
||||
|
||||
\
|
||||
|
||||
;"PARSER related types"
|
||||
|
||||
<NEWSTRUC ACTION VECTOR VNAME PSTRING ;"atom associated with this action"
|
||||
VDECL VSPEC ;"syntaxes for this verb (any number)"
|
||||
VSTR STRING ;"string to print when talking about this verb">
|
||||
|
||||
;"VSPEC -- uvector of syntaxes for a verb"
|
||||
|
||||
<NEWTYPE VSPEC UVECTOR '<<PRIMTYPE UVECTOR> [REST SYNTAX]>>
|
||||
|
||||
;"SYNTAX -- a legal syntax for a sentence involving this verb"
|
||||
|
||||
<NEWSTRUC SYNTAX VECTOR SYN1 VARG ;"direct object, more or less"
|
||||
SYN2 VARG ;"indirect object, more or less"
|
||||
SFCN VERB ;"function to handle this action"
|
||||
SFLAGS FIX ;"flag bits for this verb">
|
||||
|
||||
;"SFLAGS of a SYNTAX"
|
||||
|
||||
<FLAGWORD SFLIP ;"T -- flip args (for verbs like PICK)"
|
||||
SDRIVER ;"T -- default syntax for gwimming and orphanery">
|
||||
|
||||
;"STRNN -- test a bit in the SFLAGS slot of a SYNTAX"
|
||||
|
||||
<DEFMAC STRNN ('S 'BIT)
|
||||
<FORM N==? <FORM CHTYPE <FORM ANDB .BIT <FORM SFLAGS .S>> FIX> 0>>
|
||||
|
||||
; "VARG -- types and locations of objects acceptable as args to verbs,
|
||||
these go in the SYN1 and SYN2 slots of a SYNTAX."
|
||||
|
||||
<NEWSTRUC VARG VECTOR VBIT FIX
|
||||
;"acceptable object characteristics (default any)"
|
||||
VFWIM FIX ;"spec for fwimming"
|
||||
VPREP <OR PREP FALSE> ;"preposition that must precede(?) object"
|
||||
VWORD FIX ;"locations object may be looked for in">
|
||||
|
||||
;"flagbit definitions for VWORD of a VARG"
|
||||
|
||||
<FLAGWORD VABIT ;"AOBJS -- look in AOBJS"
|
||||
VRBIT ;"ROBJS -- look in ROBJS"
|
||||
VTBIT ;"1 => try to take the object"
|
||||
VCBIT ;"1 => care if can't take object"
|
||||
VFBIT ;"1 => care if can't reach object">
|
||||
|
||||
;"VTRNN -- test a bit in the VWORD slot of a VARG"
|
||||
|
||||
<DEFMAC VTRNN ('V 'BIT)
|
||||
<FORM N==? <FORM CHTYPE <FORM ANDB .BIT <FORM VWORD .V>> FIX> 0>>
|
||||
|
||||
"VTBIT & VCBIT interact as follows:
|
||||
vtbit
|
||||
vcbit
|
||||
|
||||
1 1 = TAKE -- try to take, care if can't ('TURN WITH x')
|
||||
1 0 = TRY -- try to take, don't care if can't ('READ x')
|
||||
0 1 = MUST -- must already have object ('ATTACK TROLL WITH x')
|
||||
0 0 = NO-TAKE (default) -- don't try, don't care ('TAKE x')
|
||||
"
|
||||
|
||||
;"VERB -- name and function to apply to handle verb"
|
||||
|
||||
<NEWSTRUC VERB VECTOR VNAME PSTRING VFCN RAPPLIC>
|
||||
|
||||
;"ORPHANS -- mysterious vector of orphan data"
|
||||
|
||||
<NEWSTRUC (ORPHANS)
|
||||
VECTOR
|
||||
OFLAG
|
||||
<OR FALSE ATOM>
|
||||
OVERB
|
||||
<OR FALSE VERB>
|
||||
OSLOT1
|
||||
<OR FALSE OBJECT>
|
||||
OPREP
|
||||
<OR FALSE PREP>
|
||||
ONAME
|
||||
<OR FALSE STRING>>
|
||||
|
||||
;"prepositional phrases"
|
||||
|
||||
<NEWSTRUC PHRASE VECTOR PPREP PREP POBJ OBJECT>
|
||||
|
||||
\
|
||||
|
||||
;"BITS FOR 2ND ARG OF CALL TO TELL (DEFAULT IS 1)"
|
||||
|
||||
<MSETG LONG-TELL *400000000000*>
|
||||
|
||||
<MSETG PRE-CRLF 2>
|
||||
|
||||
<MSETG POST-CRLF 1>
|
||||
|
||||
<MSETG NO-CRLF 0>
|
||||
|
||||
<MSETG LONG-TELL1 <+ ,LONG-TELL ,POST-CRLF>>
|
||||
|
||||
<PSETG NULL-DESC "">
|
||||
|
||||
<PSETG NULL-EXIT <CHTYPE [] EXIT>>
|
||||
|
||||
<PSETG NULL-SYN ![!]>
|
||||
|
||||
;"adventurer"
|
||||
|
||||
<NEWSTRUC ADV
|
||||
VECTOR
|
||||
AROOM
|
||||
ROOM ;"where he is"
|
||||
AOBJS
|
||||
<LIST [REST OBJECT]> ;"what he's carrying"
|
||||
ASCORE
|
||||
FIX ;"score"
|
||||
AVEHICLE
|
||||
<OR FALSE OBJECT> ;"what he's riding in"
|
||||
AOBJ
|
||||
OBJECT ;"what he is"
|
||||
AACTION
|
||||
RAPPLIC ;"special action for robot, etc."
|
||||
ASTRENGTH
|
||||
FIX ;"fighting strength"
|
||||
AFLAGS
|
||||
FIX ;"flags THIS MUST BE SAME OFFSET AS OFLAGS!">
|
||||
|
||||
"bits in <AFLAGS adv>:
|
||||
bit-name"
|
||||
|
||||
<FLAGWORD ASTAGGERED ;"staggered?">
|
||||
|
||||
;"object"
|
||||
|
||||
<NEWSTRUC OBJECT
|
||||
VECTOR
|
||||
ONAMES
|
||||
<UVECTOR [REST PSTRING]> ;"synonyms"
|
||||
OADJS
|
||||
<UVECTOR [REST ADJECTIVE]> ;"adjectives for this"
|
||||
ODESC2
|
||||
STRING ;"short description"
|
||||
OFLAGS
|
||||
FIX ;"flags THIS MUST BE SAME OFFSET AS AFLAGS!"
|
||||
OACTION
|
||||
RAPPLIC ;"object-action"
|
||||
OCONTENTS
|
||||
<LIST [REST OBJECT]> ;"list of contents"
|
||||
OCAN
|
||||
<OR FALSE OBJECT> ;"what contains this"
|
||||
OROOM
|
||||
<OR FALSE ROOM> ;"what room its in"
|
||||
OPROPS
|
||||
<LIST [REST ATOM ANY]> ;"property list">
|
||||
|
||||
;"For funny slots in objects"
|
||||
|
||||
<MAKE-SLOT OTVAL FIX 0>
|
||||
|
||||
;"value when placed in trophy case"
|
||||
|
||||
<MAKE-SLOT OFVAL FIX 0>
|
||||
|
||||
;"value when found"
|
||||
|
||||
<MAKE-SLOT OSIZE FIX 5>
|
||||
|
||||
;"size"
|
||||
|
||||
<MAKE-SLOT OCAPAC FIX 0>
|
||||
|
||||
;"capacity"
|
||||
|
||||
<MAKE-SLOT ODESCO <OR STRING FALSE> <>>
|
||||
|
||||
;"first description"
|
||||
|
||||
<MAKE-SLOT ODESC1 STRING "">
|
||||
|
||||
;"long description"
|
||||
|
||||
<MAKE-SLOT OREAD <OR STRING FALSE> <>>
|
||||
|
||||
;"reading material"
|
||||
|
||||
<MAKE-SLOT OGLOBAL FIX 0>
|
||||
|
||||
;"global bit for this object"
|
||||
|
||||
<MAKE-SLOT OVTYPE FIX 0>
|
||||
|
||||
;"vehicle's type spec"
|
||||
|
||||
<MAKE-SLOT OACTOR ADV <>>
|
||||
|
||||
;"adventurer for actors"
|
||||
|
||||
<MAKE-SLOT OLINT <OR FALSE <VECTOR FIX CEVENT>> <>>
|
||||
|
||||
;"light interrupts"
|
||||
|
||||
<MAKE-SLOT OMATCH FIX 0>
|
||||
|
||||
;"# of matches"
|
||||
|
||||
<MAKE-SLOT OFMSGS <OR UVECTOR FALSE> <>>
|
||||
|
||||
;"melee messages"
|
||||
|
||||
<MAKE-SLOT OBVERB <OR FALSE VERB> <>>
|
||||
|
||||
;"bunch verb"
|
||||
|
||||
<MAKE-SLOT OSTRENGTH FIX 0>
|
||||
|
||||
;"strength for melee"
|
||||
|
||||
<DEFINE OID (OBJ) #DECL ((OBJ) OBJECT (VALUE) PSTRING) <1 <ONAMES .OBJ>>>
|
||||
|
||||
;"bits in <OFLAGS object>:
|
||||
bit-name bit-tester"
|
||||
|
||||
<FLAGWORD OVISON ;"visible?"
|
||||
READBIT ;"readable?"
|
||||
TAKEBIT ;"takeable?"
|
||||
DOORBIT ;"object is door"
|
||||
TRANSBIT ;"object is transparent"
|
||||
FOODBIT ;"object is food"
|
||||
NDESCBIT ;"object not describable"
|
||||
DRINKBIT ;"object is drinkable"
|
||||
CONTBIT ;"object can be opened/closed"
|
||||
LIGHTBIT ;"object can provide light"
|
||||
VICBIT ;"object is victim"
|
||||
BURNBIT ;"object is flammable"
|
||||
FLAMEBIT ;"object is on fire"
|
||||
TOOLBIT ;"object is a tool"
|
||||
TURNBIT ;"object can be turned"
|
||||
VEHBIT ;"object is a vehicle"
|
||||
FINDMEBIT ;"can be reached from a vehicle"
|
||||
SLEEPBIT ;"object is asleep"
|
||||
SEARCHBIT ;"allow multi-level access into this"
|
||||
SACREDBIT ;"thief can't take this"
|
||||
TIEBIT ;"object can be tied"
|
||||
CLIMBBIT ;"can be climbed (former ECHO-ROOM-BIT)"
|
||||
ACTORBIT ;"object is an actor"
|
||||
WEAPONBIT ;"object is a weapon"
|
||||
FIGHTBIT ;"object is in melee"
|
||||
VILLAIN ;"object is a bad guy"
|
||||
STAGGERED ;"object can't fight this turn"
|
||||
TRYTAKEBIT ;"object wants to handle not being taken"
|
||||
NO-CHECK-BIT ;"no checks (put & drop): for EVERY and VALUA"
|
||||
OPENBIT ;"object is open"
|
||||
TOUCHBIT ;"has this been touched?"
|
||||
ONBIT ;"light on?"
|
||||
DIGBIT ;"I can dig this"
|
||||
BUNCHBIT ;"*BUN*, all, etc.">
|
||||
|
||||
"extra stuff for flagword for objects"
|
||||
|
||||
"can i be opened?"
|
||||
|
||||
<DEFMAC OPENABLE? ('OBJ) <FORM TRNN .OBJ <FORM + ,DOORBIT ,CONTBIT>>>
|
||||
|
||||
"complement of the bit state"
|
||||
|
||||
<DEFMAC DESCRIBABLE? ('OBJ) <FORM NOT <FORM TRNN .OBJ ,NDESCBIT>>>
|
||||
|
||||
"if object is a light or aflame, then flaming"
|
||||
|
||||
<DEFMAC FLAMING? ('OBJ "AUX" (CONST <+ ,FLAMEBIT ,LIGHTBIT ,ONBIT>))
|
||||
<FORM ==? <FORM CHTYPE <FORM ANDB <FORM OFLAGS .OBJ> .CONST> FIX> .CONST>>
|
||||
|
||||
"if object visible and open or transparent, can see inside it"
|
||||
|
||||
<DEFMAC SEE-INSIDE? ('OBJ)
|
||||
<FORM AND <FORM TRNN .OBJ ,OVISON>
|
||||
<FORM OR <FORM TRNN .OBJ ,TRANSBIT> <FORM TRNN .OBJ ,OPENBIT>>>>
|
||||
|
||||
<DEFMAC GLOBAL? ('OBJ)
|
||||
<FORM NOT <FORM 0? <FORM CHTYPE <FORM ANDB ',STAR-BITS <FORM OGLOBAL .OBJ>> FIX>>>>
|
||||
|
||||
\
|
||||
|
||||
;"demons"
|
||||
|
||||
<NEWSTRUC HACK
|
||||
VECTOR
|
||||
HACTION
|
||||
RAPPLIC
|
||||
HOBJS
|
||||
<LIST [REST ANY]>
|
||||
"REST"
|
||||
HROOMS
|
||||
<LIST [REST ROOM]>
|
||||
HROOM
|
||||
ROOM
|
||||
HOBJ
|
||||
OBJECT
|
||||
HFLAG
|
||||
ANY>
|
||||
|
||||
;"Clock interrupts"
|
||||
|
||||
<NEWSTRUC CEVENT
|
||||
VECTOR
|
||||
CTICK
|
||||
FIX
|
||||
CACTION
|
||||
<OR ATOM NOFFSET>
|
||||
CFLAG
|
||||
<OR ATOM FALSE>
|
||||
CID
|
||||
ATOM
|
||||
CDEATH
|
||||
<OR ATOM FALSE>>
|
||||
|
||||
;"Questions for end game"
|
||||
|
||||
<NEWSTRUC QUESTION VECTOR QSTR STRING ;"question to ask"
|
||||
QANS VECTOR ;"answers (as returned by LEX)">
|
||||
|
||||
\
|
||||
|
||||
<SETG LOAD-MAX 100>
|
||||
|
||||
<SETG SCORE-MAX 0>
|
||||
|
||||
<SETG EG-SCORE-MAX 0>
|
||||
|
||||
<SETG EG-SCORE 0>
|
||||
|
||||
"SET WHEN IN LONG TELL"
|
||||
|
||||
<SETG IN-TELL 0>
|
||||
|
||||
"SET BY CTRL-S HANDLER TO CAUSE TELL TO FLUSH"
|
||||
|
||||
<SETG NO-TELL 0>
|
||||
|
||||
<GDECL (RAW-SCORE LOAD-MAX SCORE-MAX EG-SCORE-MAX EG-SCORE IN-TELL NO-TELL)
|
||||
FIX
|
||||
(RANDOM-LIST ROOMS SACRED-PLACES)
|
||||
<LIST [REST ROOM]>
|
||||
(STARS OBJECTS WEAPONS NASTIES)
|
||||
<LIST [REST OBJECT]>
|
||||
(PRSVEC)
|
||||
<VECTOR VERB <OR FALSE OBJECT DIRECTION> <OR FALSE OBJECT>>
|
||||
(WINNER PLAYER)
|
||||
ADV
|
||||
(HERE)
|
||||
ROOM
|
||||
(INCHAN OUTCHAN)
|
||||
CHANNEL
|
||||
(DEMONS)
|
||||
LIST
|
||||
(MOVES DEATHS)
|
||||
FIX
|
||||
(DUMMY YUKS)
|
||||
<VECTOR [REST STRING]>
|
||||
(SWORD-DEMON)
|
||||
HACK
|
||||
(CPOBJS) UVECTOR
|
||||
(CPHERE) FIX>
|
||||
|
||||
\
|
||||
; "SUBTITLE POBLIST HACKS"
|
||||
<SETG PPSTRING <ISTRING 5>>
|
||||
|
||||
<DEFINE PLOOKUP (NAME OBL "AUX" BUCK TL)
|
||||
#DECL ((NAME) <OR STRING <PRIMTYPE WORD>> (OBL) POBLIST (BUCK) FIX)
|
||||
<COND (<TYPE? .NAME STRING>
|
||||
<SET NAME <PSTRING .NAME>>)
|
||||
(<NOT <TYPE? .NAME PSTRING>>
|
||||
<SET NAME <CHTYPE .NAME PSTRING>>)>
|
||||
<COND (<SET TL <MEMQ .NAME <NTH .OBL <HASH .NAME .OBL>>>>
|
||||
<2 .TL>)>>
|
||||
|
||||
<DEFINE HASH (NAME OBL)
|
||||
#DECL ((NAME) <PRIMTYPE WORD> (OBL) POBLIST)
|
||||
<+ 1 <MOD <CHTYPE .NAME FIX> <LENGTH .OBL>>>>
|
||||
\
|
||||
|
||||
"UTILITY MACROS"
|
||||
|
||||
"TO CHECK VERBS"
|
||||
|
||||
<DEFMAC VERB? ("ARGS" AL)
|
||||
<COND (<1? <LENGTH .AL>>
|
||||
<FORM ==? <FORM VNAME '<PRSA>> <PSTRING <1 .AL>>>)
|
||||
(ELSE
|
||||
<FORM PROG ((VA <FORM VNAME '<PRSA>>))
|
||||
#DECL ((VA) PSTRING)
|
||||
<FORM OR
|
||||
!<MAPF ,LIST
|
||||
<FUNCTION (A)
|
||||
<FORM ==? <FORM LVAL VA> <PSTRING .A>>>
|
||||
.AL>>>)>>
|
||||
|
||||
<DEFMAC GET-DOOR-ROOM ('RM 'LEAVINGS)
|
||||
<FORM PROG <LIST <LIST EL <FORM DROOM1 .LEAVINGS>>>
|
||||
#DECL ((EL) ROOM)
|
||||
<FORM COND
|
||||
(<FORM ==? .RM <FORM LVAL EL>>
|
||||
<FORM DROOM2 .LEAVINGS>)
|
||||
(<FORM LVAL EL>)>>>
|
||||
|
||||
"APPLY AN OBJECT FUNCTION"
|
||||
|
||||
<DEFMAC APPLY-OBJECT ('OBJ)
|
||||
<FORM PROG ((FOO <FORM OACTION .OBJ>))
|
||||
#DECL ((FOO) RAPPLIC)
|
||||
<FORM COND (<FORM NOT <FORM LVAL FOO>> <>)
|
||||
(<FORM TYPE? <FORM LVAL FOO> ATOM>
|
||||
<FORM APPLY <FORM GVAL <FORM LVAL FOO>>>)
|
||||
(<FORM DISPATCH <FORM LVAL FOO>>)>>>
|
||||
|
||||
<DEFMAC CLOCK-DISABLE ('EV)
|
||||
<FORM PUT .EV ,CFLAG <>>>
|
||||
|
||||
<DEFMAC CLOCK-ENABLE ('EV)
|
||||
<FORM PUT .EV ,CFLAG T>>
|
||||
|
||||
<DEFMAC APPLY-RANDOM ('FROB "OPTIONAL" ('MUMBLE <>))
|
||||
<COND (<TYPE? .FROB ATOM>
|
||||
<COND (.MUMBLE
|
||||
<FORM APPLY <FORM GVAL .FROB> .MUMBLE>)
|
||||
(<FORM APPLY <FORM GVAL .FROB>>)>)
|
||||
(T
|
||||
<FORM COND
|
||||
(<FORM TYPE? .FROB ATOM>
|
||||
<COND (.MUMBLE
|
||||
<FORM APPLY <FORM GVAL .FROB> .MUMBLE>)
|
||||
(<FORM APPLY <FORM GVAL .FROB>>)>)
|
||||
(T <FORM DISPATCH .FROB .MUMBLE>)>)>>
|
||||
|
||||
<DEFINE OGET (O P "AUX" V)
|
||||
#DECL ((O) <OR OBJECT ROOM> (P) ATOM (V) <LIST [REST ATOM ANY]>)
|
||||
<COND (<TYPE? .O OBJECT> <SET V <OPROPS .O>>)
|
||||
(ELSE <SET V <RPROPS .O>>)>
|
||||
<REPEAT ()
|
||||
<COND (<EMPTY? .V> <RETURN <>>)
|
||||
(<==? <1 .V> .P> <RETURN <2 .V>>)
|
||||
(ELSE <SET V <REST .V 2>>)>>>
|
||||
|
||||
<DEFINE OPUT (O P X "OPTIONAL" (ADD? <>) "AUX" V)
|
||||
#DECL ((O) <OR OBJECT ROOM> (P) ATOM (V) <LIST [REST ATOM ANY]> (X) ANY
|
||||
(ADD?) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .O OBJECT> <SET V <OPROPS .O>>)
|
||||
(ELSE <SET V <RPROPS .O>>)>
|
||||
<REPEAT ((VV .V))
|
||||
<COND (<EMPTY? .VV>
|
||||
<COND (.ADD?
|
||||
<COND (<TYPE? .O OBJECT>
|
||||
<PUT .O ,OPROPS (.P .X !.V)>)
|
||||
(<PUT .O ,RPROPS (.P .X !.V)>)>)>
|
||||
<RETURN .O>)
|
||||
(<==? <1 .VV> .P> <PUT .VV 2 .X> <RETURN .O>)
|
||||
(ELSE <SET VV <REST .VV 2>>)>>>
|
||||
|
||||
<DEFINE FIND-VERB (STR "AUX" (WORDS ,WORDS-POBL))
|
||||
#DECL ((STR) STRING (WORDS) POBLIST)
|
||||
<COND (<PLOOKUP .STR .WORDS>)
|
||||
(<PINSERT .STR .WORDS <CHTYPE [<PSTRING .STR> T] VERB>>)>>
|
||||
|
||||
<DEFINE FIND-DIR (STR)
|
||||
#DECL ((STR) STRING (VALUE) DIRECTION)
|
||||
<COND (<PLOOKUP .STR ,DIRECTIONS-POBL>)
|
||||
(<ERROR NOT-FOUND!-ERRORS FIND-DIR .STR>)>>
|
||||
|
||||
<DEFINE FIND-ACTION (STR)
|
||||
#DECL ((STR) STRING (VALUE) ACTION)
|
||||
<COND (<PLOOKUP .STR ,ACTIONS-POBL>)
|
||||
(<ERROR NOT-FOUND!-ERRORS FIND-ACTION .STR>)>>
|
||||
|
||||
<DEFINE FIND-ROOM (STR)
|
||||
#DECL ((STR) <OR STRING <PRIMTYPE WORD>> (VALUE) ROOM)
|
||||
<COND (<PLOOKUP .STR ,ROOM-POBL>)
|
||||
(<ERROR NOT-FOUND!-ERRORS FIND-ROOM .STR>)>>
|
||||
|
||||
<DEFMAC SFIND-ROOM ('STR)
|
||||
<COND (<TYPE? .STR STRING>
|
||||
<FORM FIND-ROOM <PSTRING .STR>>)
|
||||
(<FORM FIND-ROOM .STR>)>>
|
||||
|
||||
<DEFMAC SFIND-OBJ ('STR)
|
||||
<COND (<TYPE? .STR STRING>
|
||||
<FORM FIND-OBJ <PSTRING .STR>>)
|
||||
(<FORM FIND-OBJ .STR>)>>
|
||||
|
||||
<DEFINE FIND-OBJ (STR)
|
||||
#DECL ((STR) <OR STRING <PRIMTYPE WORD>> (VALUE) OBJECT)
|
||||
<COND (<PLOOKUP .STR ,OBJECT-POBL>)
|
||||
(<ERROR NOT-FOUND!-ERRORS FIND-OBJ .STR>)>>
|
||||
|
||||
<DEFINE FIND-DOOR (RM OBJ)
|
||||
#DECL ((RM) ROOM (OBJ) OBJECT)
|
||||
<REPEAT ((L <REXITS .RM>) TD)
|
||||
#DECL ((L) <<PRIMTYPE VECTOR> [REST DIRECTION <OR DOOR ROOM CEXIT NEXIT>]>)
|
||||
<COND (<EMPTY? .L>
|
||||
<RETURN <>>)
|
||||
(<AND <TYPE? <SET TD <2 .L>> DOOR>
|
||||
<==? <DOBJ .TD> .OBJ>>
|
||||
<RETURN .TD>)>
|
||||
<SET L <REST .L 2>>>>
|
||||
|
||||
<SETG ROOMS ()>
|
||||
|
||||
<SETG OBJECTS ()>
|
||||
|
||||
<SETG ACTORS ()>
|
||||
|
||||
<SETG BIGFIX </ <CHTYPE <MIN> FIX> 2>>
|
||||
105
src/zork/disp1.2
Normal file
105
src/zork/disp1.2
Normal file
@@ -0,0 +1,105 @@
|
||||
<DEFINE DISPATCH-HACK ("AUX" Y)
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) OBJECT)
|
||||
<PUT .X ,OACTION <DISP-FROB <OACTION .X>>>>
|
||||
,OBJECTS>
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) ROOM)
|
||||
<PUT .X ,RACTION <DISP-FROB <RACTION .X>>>
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
<COND (<TYPE? .X CEXIT>
|
||||
<PUT .X ,CXACTION <DISP-FROB <CXACTION .X>>>)
|
||||
(<TYPE? .X DOOR>
|
||||
<PUT .X ,DACTION <DISP-FROB <DACTION .X>>>)>>
|
||||
<REXITS .X>>>
|
||||
,ROOMS>
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) HACK)
|
||||
<PUT .X ,HACTION <DISP-FROB <HACTION .X>>>>
|
||||
,DEMONS>
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) LIST)
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
<COND (<TYPE? .X VERB>
|
||||
<PUT .X ,VFCN <DISP-FROB <VFCN .X>>>)>>
|
||||
.X>>
|
||||
,WORDS-POBL>
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) LIST)
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) ATOM)
|
||||
<COND (<AND <GASSIGNED? .X>
|
||||
<TYPE? <SET Y ,.X> CEVENT>>
|
||||
<PUT .Y ,CACTION <DISP-FROB <CACTION .Y>>>)>>
|
||||
.X>>
|
||||
<GET INITIAL OBLIST>>
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) ADV)
|
||||
<PUT .X ,AACTION <DISP-FROB <AACTION .X>>>>
|
||||
,ACTORS>
|
||||
<SETG DISPATCH-TABLE <UVECTOR !<REST ,OFFL>>>
|
||||
<GUNASSIGN OFFL>
|
||||
<GUNASSIGN OFFLT>
|
||||
<GUNASSIGN COFFSET>
|
||||
"DONE">
|
||||
|
||||
<SETG COFFSET 0>
|
||||
<GDECL (COFFSET) FIX (OFFL OFFLT) LIST>
|
||||
<SETG OFFL (-1)>
|
||||
<SETG OFFLT ,OFFL>
|
||||
<DEFINE DISP-FROB (MUMBLE "AUX" TL X (CF ,COFFSET))
|
||||
#DECL ((TL) LIST (CF) FIX)
|
||||
<COND (<AND <TYPE? .MUMBLE ATOM>
|
||||
<GASSIGNED? .MUMBLE>>
|
||||
<COND (<TYPE? <SET X ,.MUMBLE> RSUBR-ENTRY>
|
||||
<COND (<L? .CF 0>
|
||||
<SETG COFFSET <+ <- .CF> 2>>)
|
||||
(<SETG COFFSET <+ .CF 1>>)>
|
||||
<SET TL <INST-GEN .X>>
|
||||
<SETG OFFLT <REST <PUTREST ,OFFLT .TL> <LENGTH .TL>>>
|
||||
<SETG .MUMBLE <CHTYPE ,COFFSET NOFFSET>>)
|
||||
(<TYPE? .X NOFFSET>
|
||||
.X)
|
||||
(.MUMBLE)>)
|
||||
(.MUMBLE)>>
|
||||
|
||||
<DEFINE INST-GEN (RENTRY "AUX" CV CV1 IOFFS)
|
||||
#DECL ((RENTRY) RSUBR-ENTRY (CV CV1) <<PRIMTYPE UVECTOR> [REST <PRIMTYPE WORD>]>)
|
||||
<SET IOFFS <ENTRY-LOC .RENTRY>>
|
||||
<SET CV <REST <SET CV1 <1 <1 .RENTRY>>> .IOFFS>>
|
||||
<REPEAT FOO (INST)
|
||||
<SET INST <1 .CV>>
|
||||
<COND (<==? <GOPCODE .INST> ,PUSHJ>
|
||||
<COND (<NOT <INDIRECT? .INST>>
|
||||
<SET IOFFS <GETADR .INST>>
|
||||
<RETURN (<CHTYPE <ORB ,BASE-INST .IOFFS> WORD>)>)
|
||||
(<SETG COFFSET <- ,COFFSET>>
|
||||
<REPEAT (TOFFS)
|
||||
<SET INST <1 <SET CV <BACK .CV>>>>
|
||||
<COND (<==? <GOPCODE .INST> ,ADDI>
|
||||
<SET TOFFS <GETADR .INST>>
|
||||
<SET IOFFS <GETADR <NTH .CV1 <+ .TOFFS 1>>>>
|
||||
<RETURN
|
||||
(<CHTYPE <ORB ,BASE-INST .IOFFS> WORD>
|
||||
<CHTYPE <ORB ,BASE-INST <GETADR <NTH .CV1 .TOFFS>>> WORD>)
|
||||
.FOO>)>>)>)>
|
||||
<SET CV <REST .CV>>>>
|
||||
|
||||
<DEFMAC GETADR ('FROB)
|
||||
<FORM CHTYPE <FORM GETBITS .FROB <BITS 18 0>> FIX>>
|
||||
|
||||
<DEFMAC GOPCODE ('FROB)
|
||||
<FORM CHTYPE <FORM GETBITS .FROB <BITS 9 27>> FIX>>
|
||||
|
||||
<DEFMAC INDIRECT? ('FROB)
|
||||
<FORM 1? <FORM CHTYPE <FORM GETBITS .FROB <BITS 1 22>> FIX>>>
|
||||
|
||||
<SETG PUSHJ *260*>
|
||||
<SETG ADDI *271*>
|
||||
<SETG BASE-INST *260755000000*> ; " PUSHJ P,(M)"
|
||||
<MANIFEST PUSHJ ADDI BASE-INST>
|
||||
6555
src/zork/dung.354
Normal file
6555
src/zork/dung.354
Normal file
File diff suppressed because it is too large
Load Diff
977
src/zork/impl.123
Normal file
977
src/zork/impl.123
Normal file
@@ -0,0 +1,977 @@
|
||||
|
||||
"(c) Copyright 1979, Massachusetts Institute of Technology. All rights reserved."
|
||||
|
||||
<OR <TYPE? ,REP SUBR>
|
||||
<SETG SAVEREP ,REP>>
|
||||
|
||||
<DEFINE ZGO ()
|
||||
<SETG REP ,ZREP>
|
||||
<ON "BLOCKED"
|
||||
<FUNCTION (FOO)
|
||||
<PRINC !\:>>
|
||||
5>
|
||||
<ERRET>>
|
||||
|
||||
<DEFINE ZREP ZTOP ("AUX" RD)
|
||||
#DECL ((ZTOP) <SPECIAL ACTIVATION> (RD) ANY)
|
||||
<REPEAT ()
|
||||
<CRLF>
|
||||
<SET RD <READ>>
|
||||
<CRLF>
|
||||
<SET RD <ZEVAL .RD>>
|
||||
<ZPRINT .RD>
|
||||
.RD>>
|
||||
|
||||
<DEFINE ZPRINT (ITEM)
|
||||
#DECL ((ITEM) ANY)
|
||||
<COND (<TYPE? .ITEM OBJECT>
|
||||
<ZOBJ-PRINT .ITEM>)
|
||||
(<TYPE? .ITEM ROOM>
|
||||
<ZRM-PRINT .ITEM>)
|
||||
(<TYPE? .ITEM VERB>
|
||||
<PRINC "Verb = ">
|
||||
<PRINC <STRINGP <1 .ITEM>>>)
|
||||
(<TYPE? .ITEM CEVENT>
|
||||
<ZEV-PRINT .ITEM>)
|
||||
(<TYPE? .ITEM LIST>
|
||||
<ZLST-PRINT .ITEM>)
|
||||
(<==? .ITEM T>
|
||||
<PRINC "True">)
|
||||
(<==? .ITEM <>>
|
||||
<PRINC "False">)
|
||||
(<PRIN1 .ITEM>)>>
|
||||
|
||||
<DEFINE ZEV-PRINT (CEV)
|
||||
#DECL ((CEV) CEVENT)
|
||||
<PRINC "Running ">
|
||||
<PRINC <SPNAME <2 .CEV>>>
|
||||
<PRINC " in ">
|
||||
<PRIN1 <1 .CEV>>
|
||||
<PRINC " moves">
|
||||
<COND (<NOT <3 .CEV>>
|
||||
<PRINC " (disabled)">)>>
|
||||
|
||||
<DEFINE ZLST-PRINT (LST)
|
||||
#DECL ((LST) LIST)
|
||||
<PRINC "List containing:">
|
||||
<ZPC .LST>>
|
||||
|
||||
<DEFINE ZOBJ-PRINT (OBJ)
|
||||
#DECL ((OBJ) OBJECT)
|
||||
<PRINC "Object = ">
|
||||
<PRINC <ODESC2 .OBJ>>
|
||||
<COND (<OCAN .OBJ>
|
||||
<PRINC " (in ">
|
||||
<PRINC <ODESC2 <OCAN .OBJ>>>
|
||||
<PRINC ")">)>
|
||||
<COND (<NOT <EMPTY? <OCONTENTS .OBJ>>>
|
||||
<PRINC " /Contains:">
|
||||
<ZPC <OCONTENTS .OBJ>>)>>
|
||||
|
||||
<DEFINE ZPC (LST)
|
||||
#DECL ((LST) LIST)
|
||||
<PRINC !\ >
|
||||
<MAPR <>
|
||||
<FUNCTION (LST2 "AUX" (ITEM <1 .LST2>))
|
||||
#DECL ((LST2) LIST (ITEM) ANY)
|
||||
<COND (<TYPE? .ITEM OBJECT>
|
||||
<PRINC <ODESC2 .ITEM>>)
|
||||
(<PRIN1 .ITEM>)>
|
||||
<OR <LENGTH? .LST2 1>
|
||||
<PRINC " & ">>>
|
||||
.LST>>
|
||||
|
||||
<DEFINE ZRM-PRINT (RM "AUX" (OBJS <ROBJS .RM>))
|
||||
#DECL ((RM) ROOM (OBJS) <LIST [REST OBJECT]>)
|
||||
<PRINC "Room = ">
|
||||
<PRINC <RDESC2 .RM>>
|
||||
<COND (<NOT <EMPTY? .OBJS>>
|
||||
<PRINC "
|
||||
Contains:">
|
||||
<ZPC .OBJS>)>
|
||||
<PRINC "
|
||||
Exits to: ">
|
||||
<MAPF <>
|
||||
<FUNCTION (ITM)
|
||||
#DECL ((ITM) ANY)
|
||||
<COND (<TYPE? .ITM DIRECTION>
|
||||
<PRINC <STRINGP .ITM>>
|
||||
<PRINC !\ >)>>
|
||||
<REXITS .RM>>>
|
||||
|
||||
<SET ZFLUSH
|
||||
<ON "CHAR"
|
||||
<FUNCTION (CHR CHN)
|
||||
#DECL ((CHR) CHARACTER (CHN) CHANNEL)
|
||||
<COND (<==? .CHR <ASCII 7>>
|
||||
<INT-LEVEL 0>
|
||||
<AND <GET BLOCKED!-INTERRUPTS INTERRUPT>
|
||||
<OFF "BLOCKED">>
|
||||
<SETG REP ,SAVEREP>
|
||||
<LISTEN>)>>
|
||||
8 0 ,INCHAN>>
|
||||
|
||||
<DEFINE ZEVAL (ITEM "OPTIONAL" (FLAG <>) "AUX" OPER TEMP)
|
||||
#DECL ((ITEM TEMP) ANY (OPER) STRING (FLAG) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .ITEM FIX FLOAT STRING> .ITEM)
|
||||
(<TYPE? .ITEM FORM> <EVAL .ITEM>)
|
||||
(<TYPE? .ITEM ATOM>
|
||||
<SET OPER <SPNAME .ITEM>>
|
||||
<COND (<SET TEMP <ZLOOKUP .OPER ,ZERO-POBL>>
|
||||
<APPLY .TEMP>)
|
||||
(<ZLOOKUP .OPER ,ZVARS-POBL>)
|
||||
(<PLOOKUP .OPER ,OBJECT-POBL>)
|
||||
(<PLOOKUP .OPER ,ROOM-POBL>)
|
||||
(<PLOOKUP .OPER ,WORDS-POBL>)
|
||||
(<ZLOOKUP .OPER ,ZOBITS-POBL>)
|
||||
(<ZLOOKUP .OPER ,ZRBITS-POBL>)
|
||||
(.FLAG #LOSE 0)
|
||||
(ELSE <ILLEGAL "Unknown word: " .OPER>)>)
|
||||
(<TYPE? .ITEM LIST>
|
||||
<REPEAT (R I S)
|
||||
#DECL ((R I) ANY (S) STRING)
|
||||
<COND (<EMPTY? .ITEM> <RETURN <AND <ASSIGNED? R> .R>>)>
|
||||
<SET I <1 .ITEM>>
|
||||
<COND (<TYPE? .I ATOM>
|
||||
<SET S <SPNAME .I>>
|
||||
<COND (<SET TEMP <ZLOOKUP .S ,ZERO-POBL>>
|
||||
<SET R <APPLY .TEMP>>)
|
||||
(<SET TEMP <ZLOOKUP .S ,ONE-POBL>>
|
||||
<COND (<EMPTY? <SET ITEM <REST .ITEM>>>
|
||||
<TOOFEW .S>)
|
||||
(ELSE
|
||||
<SET R
|
||||
<APPLY .TEMP
|
||||
<ZEVAL <1 .ITEM>>>>)>)
|
||||
(<SET TEMP <ZLOOKUP .S ,TWO-POBL>>
|
||||
<COND (<EMPTY? <SET ITEM <REST .ITEM>>>
|
||||
<TOOFEW .S>)
|
||||
(<ASSIGNED? R>
|
||||
<SET R
|
||||
<APPLY .TEMP
|
||||
.R
|
||||
<ZEVAL <1 .ITEM>>>>)
|
||||
(ELSE
|
||||
<TOOFEW .S>)>)
|
||||
(<SET TEMP <ZLOOKUP .S ,ANY-POBL>>
|
||||
<COND (<EMPTY? <SET ITEM <REST .ITEM>>>
|
||||
<TOOFEW .S>)
|
||||
(ELSE
|
||||
<SET R
|
||||
<APPLY .TEMP
|
||||
<OR <NOT <ASSIGNED? R>>
|
||||
.R>
|
||||
.ITEM>>
|
||||
<RETURN .R>)>)
|
||||
(ELSE <SET R <ZEVAL .I>>)>)
|
||||
(ELSE <SET R <ZEVAL .I>>)>
|
||||
<SET ITEM <REST .ITEM>>>)
|
||||
(<ILLEGAL "ZEVAL of non list, form or atom.">)>>
|
||||
|
||||
<DEFINE ZIN (ITM1 ITM2)
|
||||
#DECL ((ITM1 ITM2) ANY)
|
||||
<COND (<TYPE? .ITM2 LIST>
|
||||
<AND <MEMQ .ITM1 .ITM2> T>)
|
||||
(<TYPE? .ITM1 OBJECT>
|
||||
<COND (<TYPE? .ITM2 OBJECT>
|
||||
<==? <OCAN .ITM1> .ITM2>)
|
||||
(<TYPE? .ITM2 ROOM>
|
||||
<AND <MEMQ .ITM1 <ROBJS .ITM2>> T>)
|
||||
(<TYPE? .ITM2 ADV>
|
||||
<AND <MEMQ .ITM1 <AOBJS ,WINNER>> T>)
|
||||
(<ILLEGAL "Illegal container - " .OBJ2>)>)
|
||||
(<ILLEGAL "Illegal object?">)>>
|
||||
|
||||
<DEFINE ZEQUALS (ITM1 ITM2)
|
||||
#DECL ((ITM1 ITM2) ANY)
|
||||
<COND (<==? <TYPE .ITM1> <TYPE .ITM2>>
|
||||
<==? .ITM1 .ITM2>)
|
||||
(<TYPE? .ITM2 FIX>
|
||||
<COND (<TYPE? .ITM1 OBJECT> <TRNN .ITM1 .ITM2>)
|
||||
(<TYPE? .ITM1 ROOM> <RTRNN .ITM1 .ITM2>)
|
||||
(<ILLEGAL "Unknown type?">)>)>>
|
||||
|
||||
"ZIF -- fsubr"
|
||||
|
||||
<DEFINE ZIF (DUMMY LST "AUX" P (TOKEN then) (R <>))
|
||||
<COND (<SET P <ZEVAL <1 .LST>>>)
|
||||
(ELSE <SET TOKEN else>)>
|
||||
<COND (<SET LST <MEMQ .TOKEN .LST>>
|
||||
<MAPF <>
|
||||
<FUNCTION (I)
|
||||
<AND <==? .I else> <MAPLEAVE .R>>
|
||||
<SET R <ZEVAL .I>>>
|
||||
<REST .LST>>)
|
||||
(ELSE <ILLEGAL "If lacks then/else">)>>
|
||||
|
||||
"ZCASE -- fsubr"
|
||||
|
||||
<SETG EXPR <ILIST 3>>
|
||||
|
||||
<DEFINE ZCASE (DUMMY LST "AUX" OBJ (E ,EXPR))
|
||||
<SET OBJ <1 .LST>>
|
||||
<COND (<TYPE? .OBJ ATOM>)(ELSE <SET OBJ <ZEVAL .OBJ>>)>
|
||||
<SET LST <REST .LST>>
|
||||
<COND (<EMPTY? .LST> <TOOFEW "case">)
|
||||
(<TYPE? <SET OPR <1 .LST>> ATOM>
|
||||
<SET LST <REST .LST>>)>
|
||||
<MAPF <>
|
||||
<FUNCTION (I)
|
||||
<PUT .E 1 .OBJ>
|
||||
<PUT .E 2 .OPR>
|
||||
<PUT .E 3 <1 .I>>
|
||||
<COND (<OR <==? <1 .I> else> <ZEVAL .E>>
|
||||
<MAPLEAVE <ZEVAL <REST .I>>>)>>
|
||||
.LST>>
|
||||
|
||||
"ZFOR-EACH -- fsubr"
|
||||
|
||||
<DEFINE ZFOR-EACH (DUMMY ARGL)
|
||||
#DECL ((ARGL) LIST)
|
||||
<COND (<LENGTH? .ARGL 1>
|
||||
<TOOFEW>)
|
||||
(<TYPE? <SET LST <ZEVAL <1 .ARGL>>> LIST>
|
||||
<MAPF <>
|
||||
<FUNCTION (ZITS)
|
||||
#DECL ((ZITS) <SPECIAL ANY>)
|
||||
<ZEVAL <REST .ARGL>>>
|
||||
.LST>)
|
||||
(<ILLEGAL "Argument-not-list/FOR-EACH">)>>
|
||||
|
||||
"ZPLUS -- two args"
|
||||
|
||||
<DEFINE ZPLUS (A B)
|
||||
<COND (<ASSIGNED? B> <+ .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZMINUS -- two args"
|
||||
|
||||
<DEFINE ZMINUS (A B)
|
||||
<COND (<ASSIGNED? B> <- .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZTIMES -- two args"
|
||||
|
||||
<DEFINE ZTIMES (A B)
|
||||
<COND (<ASSIGNED? B> <* .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZDIVIDED -- two args"
|
||||
|
||||
<DEFINE ZDIVIDED (A B)
|
||||
<COND (<ASSIGNED? B> </ .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZLESS -- two args"
|
||||
|
||||
<DEFINE ZLESS (A B)
|
||||
<COND (<ASSIGNED? B> <L? .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZGREATER -- two args"
|
||||
|
||||
<DEFINE ZGREATER (A B)
|
||||
<COND (<ASSIGNED? B> <G? .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZEQUAL -- two args"
|
||||
|
||||
<DEFINE ZEQUAL (A B)
|
||||
<COND (<ASSIGNED? B> <==? .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZAND -- two args"
|
||||
|
||||
<DEFINE ZAND (A B)
|
||||
<COND (<ASSIGNED? B> <AND .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZOR -- two args"
|
||||
|
||||
<DEFINE ZOR (A B)
|
||||
<COND (<ASSIGNED? B> <OR .A .B>)
|
||||
(ELSE .A)>>
|
||||
|
||||
"ZIS -- fsubr"
|
||||
|
||||
<DEFINE ZIS (OBJ LIST)
|
||||
<ZPRED .OBJ .LIST>>
|
||||
|
||||
"ZISNT -- fsubr"
|
||||
|
||||
<DEFINE ZISNT (OBJ LIST)
|
||||
<NOT <ZPRED .OBJ .LIST>>>
|
||||
|
||||
"ZPRED -- general predicates"
|
||||
|
||||
<DEFINE ZPRED (OBJ EXPR "OPTIONAL" (TTYPE <>)
|
||||
"AUX" (NTTYPE <>) (VAL <>) (NOT? <>) (BOOL? <>))
|
||||
#DECL ((OBJ) ANY (EXPR) <OR ATOM LIST>)
|
||||
<COND (<TYPE? .EXPR ATOM>
|
||||
<COND (<NOT .TTYPE>
|
||||
<ZEQUALS .OBJ <ZEVAL .EXPR>>)
|
||||
(<=? .TTYPE in>
|
||||
<ZIN .OBJ <ZEVAL .EXPR>>)
|
||||
(ELSE <ERROR UNKNOWN-TTYPE .TTYPE>)>)
|
||||
(ELSE
|
||||
<MAPF <>
|
||||
<FUNCTION (E)
|
||||
#DECL ((E) <OR ATOM LIST>)
|
||||
<COND (<AND <TYPE? .E ATOM> <MEMQ .E ,BUZZ>>)
|
||||
(<==? .E or> <SET BOOL? <>>)
|
||||
(<==? .E and> <SET BOOL? T>)
|
||||
(<==? .E not> <SET NOT? <NOT .NOT?>>)
|
||||
(<MEMQ .E ,TEST-TYPES> <SET NTTYPE .E>)
|
||||
(ELSE
|
||||
<SET NVAL <ZPRED .OBJ .E <OR .NTTYPE .TTYPE>>>
|
||||
<SET NTTYPE <>>
|
||||
<COND (.NOT?
|
||||
<SET NVAL <NOT .NVAL>>
|
||||
<SET NOT? <>>)>
|
||||
<COND (.BOOL?
|
||||
<SET VAL <AND .VAL .NVAL>>)
|
||||
(ELSE
|
||||
<SET VAL <OR .VAL .NVAL>>)>)>>
|
||||
.EXPR>
|
||||
.VAL)>>
|
||||
|
||||
"ZLOOKUP -- fsubr"
|
||||
|
||||
<DEFINE ZLKUP (DUMMY ARGL "AUX" M LST)
|
||||
#DECL ((ARGL) LIST (M) <OR FALSE LIST> (LST) ANY)
|
||||
<COND (<LENGTH? .ARGL 1> <TOOFEW>)
|
||||
(<TYPE? <SET LST <ZEVAL <2 .ARGL>>> LIST>
|
||||
<AND <SET M <MEMQ <ZEVAL <1 .ARGL>> .LST>>
|
||||
<NOT <LENGTH? .M 1>>>
|
||||
<2 .M>)
|
||||
(<ILLEGAL "Lookup in non-list?">)>>
|
||||
|
||||
"ZCONTENTS -- fsubr"
|
||||
|
||||
<DEFINE ZCONTENTS (DUMMY ARGL "AUX" (ARG .ARGL) ITEM)
|
||||
#DECL ((ARGL ARG) LIST (ITEM) ANY)
|
||||
<COND (<OR <EMPTY? .ARGL>
|
||||
<AND <==? <1 .ARGL> of>
|
||||
<SET ARG <REST .ARG>>
|
||||
<LENGTH? .ARGL 1>>>
|
||||
<TOOFEW>)>
|
||||
<COND (<TYPE? <SET ITEM <ZEVAL <1 .ARG>>> OBJECT>
|
||||
<OCONTENTS .ITEM>)
|
||||
(<TYPE? .ITEM ROOM>
|
||||
<ROBJS .ITEM>)
|
||||
(<TYPE? .ITEM ADV>
|
||||
<AOBJS .ITEM>)
|
||||
(<ILLEGAL "Unknown/CONTENTS">)>>
|
||||
|
||||
"ZSET -- fsubr"
|
||||
|
||||
<DEFINE ZSET (DUMMY ARGL)
|
||||
#DECL ((ARGL) LIST)
|
||||
<COND (<LENGTH? .ARGL 1>
|
||||
<TOOFEW>)
|
||||
(<TYPE? <1 .ARGL> ATOM>
|
||||
<ZINSERT <SPNAME <1 .ARGL>> ,ZVARS-POBL <ZEVAL <2 .ARGL>>>)
|
||||
(<ILLEGAL "Non-atomic set?">)>>
|
||||
|
||||
"ZDEFINE -- fsubr"
|
||||
|
||||
<DEFINE ZDEFINE (DUMMY ARGL "AUX" STR)
|
||||
#DECL ((ARGL) LIST (STR) STRING)
|
||||
<COND (<N==? <LENGTH .ARGL> 2>
|
||||
<WNA>)
|
||||
(<ZINSERT <SET STR <SPNAME <1 .ARGL>>>
|
||||
,ZVARS-POBL
|
||||
<2 .ARGL>>
|
||||
<ZFUNCTION .STR>
|
||||
<1 .ARGL>)>>
|
||||
|
||||
<DEFINE ZFUNCTION (STR)
|
||||
#DECL ((STR) STRING)
|
||||
<ZINSERT .STR
|
||||
<GET INITIAL OBLIST>
|
||||
<CHTYPE <LIST () <FORM ZEVAL <FORM ZLOOKUP .STR ,ZVARS-POBL>>> FUNCTION>>>
|
||||
|
||||
"ZLOAD -- one arg"
|
||||
|
||||
<DEFINE ZLOAD (ARG "AUX" STR)
|
||||
#DECL ((ARG) ANY (STR) ANY)
|
||||
<COND (<AND <TYPE? .ARG STRING> <SET STR .ARG>>
|
||||
<COND (<SET C <OPEN "READ" .STR>>
|
||||
<SET <ZATOM <7 .C>>
|
||||
<MAPF ,LIST
|
||||
<FUNCTION ()
|
||||
#DECL ((ITM) ANY)
|
||||
<SET ITM <READ .C '<MAPSTOP>>>
|
||||
<COND (<TYPE? .ITM LIST>
|
||||
<ZEVAL .ITM>)>
|
||||
.ITM>>>
|
||||
<CLOSE .C>
|
||||
"Done")
|
||||
(<ILLEGAL "File not found.">)>)
|
||||
(<ILLEGAL "Non-string file name?">)>>
|
||||
|
||||
"ZATOM -- ??"
|
||||
|
||||
<DEFINE ZATOM (STR)
|
||||
#DECL ((STR) STRING)
|
||||
<OR <LOOKUP .STR <GET INITIAL OBLIST>>
|
||||
<INSERT .STR <GET INITIAL OBLIST>>>>
|
||||
|
||||
"ZDUMP -- one arg"
|
||||
|
||||
<DEFINE ZDUMP (ARG "AUX" STR ATM LST)
|
||||
#DECL ((ARG) ANY (STR LST) ANY (ATM) ATOM)
|
||||
<COND (<AND <TYPE? .ARG STRING> <SET STR .ARG>>
|
||||
<COND (<SET C <OPEN "PRINT" .STR>>
|
||||
<COND (<AND <ASSIGNED? <SET ATM <ZATOM <7 .C>>>>
|
||||
<TYPE? <SET LST ..ATM> LIST>>
|
||||
<MAPF <>
|
||||
<FUNCTION (ITM)
|
||||
#DECL ((ITM) ANY)
|
||||
<COND (<AND <TYPE? .ITM LIST>
|
||||
<==? <1 .ITM> define>>
|
||||
<PPRINT (define
|
||||
<2 .ITM>
|
||||
<ZLOOKUP <SPNAME <2 .ITM>>
|
||||
,ZVARS-POBL>)
|
||||
.C>)
|
||||
(<PPRINT .ITM .C>)>>
|
||||
.LST>
|
||||
<CLOSE .C>
|
||||
<TELL "Done" 0>)
|
||||
(<ILLEGAL "Not a group?">)>)
|
||||
(<ILLEGAL "Can't open channel?">)>)
|
||||
(<ILLEGAL "Non-string file name?">)>>
|
||||
|
||||
"ZPPRINT -- one arg"
|
||||
|
||||
<DEFINE ZPPRINT (DUMMY ARG)
|
||||
#DECL ((ARG) ANY)
|
||||
<ZEDIT <> .ARG T>>
|
||||
|
||||
"ZRUN -- fsubr"
|
||||
|
||||
<DEFINE ZRUN (DUMMY ARGL "AUX" STR ARG VAL (CEV <>))
|
||||
#DECL ((ARGL) LIST (STR) STRING (VAL ARG) ANY (CEV) <OR FALSE CEVENT>)
|
||||
<COND (<EMPTY? .ARGL> <TOOFEW>)
|
||||
(<AND <TYPE? <SET ARG <1 .ARGL>> ATOM>
|
||||
<TYPE? <SET VAL <ZLOOKUP <SET STR <SPNAME .ARG>> ,ZVARS-POBL>> LIST>>
|
||||
<MAPF <>
|
||||
<FUNCTION (ITEM)
|
||||
<COND (<MEMQ .ITEM '[in moves]>)
|
||||
(<TYPE? .ITEM FIX>
|
||||
<SET CEV
|
||||
<COND (<ZLOOKUP .STR ,ZINT-POBL>)
|
||||
(<ZINSERT .STR
|
||||
,ZINT-POBL
|
||||
<CEVENT 0
|
||||
<ZATOM .STR>
|
||||
<>
|
||||
"**::**">>)>>
|
||||
<COND (<MEMQ .CEV ,ZINTS>)
|
||||
(<SETG ZINTS (<LOOKUP .STR ,ZINT-POBL>
|
||||
.CEV
|
||||
!,ZINTS)>)>
|
||||
<MAPLEAVE <CLOCK-ENABLE <CLOCK-INT .CEV .ITEM>>>)
|
||||
(<ILLEGAL "Bad argument/RUN">)>>
|
||||
<REST .ARGL>>
|
||||
<OR .CEV <ZEVAL .VAL>>)
|
||||
(<ILLEGAL "Not applicable?">)>>
|
||||
|
||||
"ZENABLE -- one arg"
|
||||
|
||||
<DEFINE ZENABLE (ARG "AUX")
|
||||
#DECL ((ARG) ANY)
|
||||
<CLOCK-ENABLE <ZINT-FIND .ARG>>>
|
||||
|
||||
"ZDISABLE -- one arg"
|
||||
|
||||
<DEFINE ZDISABLE (ARG "AUX")
|
||||
#DECL ((ARG) ANY)
|
||||
<CLOCK-DISABLE <ZINT-FIND .ARG>>>
|
||||
|
||||
<DEFINE ZINT-FIND (ITEM "AUX" (VARS ,ZVARS-POBL))
|
||||
#DECL ((ITEM) ANY (VARS) OBLIST)
|
||||
<COND (<AND <TYPE? .ITEM LIST>
|
||||
<REPEAT ((L ,ZINTS))
|
||||
#DECL ((L) <LIST [REST ATOM CEVENT]>)
|
||||
<COND (<EMPTY? .L> <RETURN <>>)
|
||||
(<==? <ZLOOKUP <SPNAME <1 .L>> .VARS> .ITEM>
|
||||
<RETURN <2 .L>>)
|
||||
(<SET L <REST .L 2>>)>>>)
|
||||
(<ILLEGAL "Not an interrupt">)>>
|
||||
|
||||
"ZEDIT -- fsubr"
|
||||
|
||||
<DEFINE ZEDIT (DUMMY ARGL "OPTIONAL" (PRINT? <>) "AUX" L ARG STR)
|
||||
#DECL ((ARGL) LIST (ARG) ANY (L) ANY (PRINT?) <OR FALSE ATOM> (STR) STRING)
|
||||
<COND (<EMPTY? .ARGL> <TOOFEW>)
|
||||
(<TYPE? <SET ARG <1 .ARGL>> ATOM>
|
||||
<COND (<TYPE? <SET L <ZLOOKUP <SET STR <SPNAME .ARG>> ,ZVARS-POBL>> LIST>
|
||||
<ZINSERT <SPNAME .ARG> ,ZVARS-POBL <ZEP .L .PRINT?>>
|
||||
.ARG)
|
||||
(<TYPE? .L ROOM OBJECT>
|
||||
<SET VAL <ZEP <ZLOOKUP <SPNAME .ARG> ,ZDEFS-POBL> .PRINT?>>
|
||||
<ZINSERT .STR ,ZDEFS-POBL .VAL>
|
||||
<COND (<TYPE? .L ROOM>
|
||||
<RM/OBJ-CREATE .VAL <>>)
|
||||
(<RM/OBJ-CREATE .VAL>)>)
|
||||
(<ILLEGAL "Value of atom not a list?">)>)
|
||||
(<ILLEGAL "Must edit an atom.">)>>
|
||||
|
||||
<DEFINE ZEP (OBJ PRINT?)
|
||||
#DECL ((OBJ) LIST (PRINT?) <OR ATOM FALSE>)
|
||||
<COND (.PRINT?
|
||||
<PPRINT .OBJ>
|
||||
.OBJ)
|
||||
(<TELL " Starting edit." 0>
|
||||
<EDIT OBJ>
|
||||
<TELL "
|
||||
Return from edit.">
|
||||
.OBJ)>>
|
||||
|
||||
"zero-arg goodies"
|
||||
|
||||
<DEFINE ZWINNER () ,WINNER>
|
||||
|
||||
<DEFINE ZTRUE () T>
|
||||
|
||||
<DEFINE ZFALSE () <>>
|
||||
|
||||
<DEFINE ZSCORE () <ASCORE ,WINNER>>
|
||||
|
||||
<DEFINE ZPRSO () <PRSO>>
|
||||
|
||||
<DEFINE ZROOM () ,HERE>
|
||||
|
||||
<DEFINE ZPRSI () <PRSI>>
|
||||
|
||||
<DEFINE ZVERB () <PRSA>>
|
||||
|
||||
<DEFINE ZIT () .ZITS>
|
||||
|
||||
<DEFINE ZZORK () <OFF "BLOCKED"> <DC>>
|
||||
|
||||
"ZTAKE -- one arg"
|
||||
|
||||
<DEFINE ZTAKE (ARG "AUX" OBJ)
|
||||
#DECL ((ARG) ANY (OBJ) ANY)
|
||||
<COND (<TYPE? .ARG OBJECT>
|
||||
<REMOVE-OBJECT .OBJ>
|
||||
<TAKE-OBJECT .OBJ>)>>
|
||||
|
||||
"ZREMOVE -- fsubr"
|
||||
|
||||
<DEFINE ZREMOVE (DUMMY LST "AUX" OBJ)
|
||||
#DECL ((LST) LIST (OBJ) ANY)
|
||||
<COND (<EMPTY? .LST>
|
||||
<TOOFEW>)
|
||||
(<MAPF <>
|
||||
<FUNCTION (ITM)
|
||||
#DECL ((ITM) ANY)
|
||||
<COND (<==? .ITM and>)
|
||||
(<TYPE? <SET OBJ <ZEVAL .ITM>> OBJECT>
|
||||
<REMOVE-OBJECT .OBJ>)
|
||||
(<ILLEGAL "Not an object/REMOVE">)>>
|
||||
.LST>)
|
||||
(<ILLEGAL "Not an object/REMOVE">)>>
|
||||
|
||||
"ZPUTIN -- fsubr"
|
||||
|
||||
<DEFINE ZPUTIN (DUMMY LST "AUX" OBJ)
|
||||
#DECL ((LST) LIST (OBJ) ANY)
|
||||
<COND (<LENGTH? .LST 1>
|
||||
<TOOFEW>)
|
||||
(ELSE
|
||||
<SET OBJ2 <COND (<MEMQ <2 .LST> ![in into to]>
|
||||
<COND (<LENGTH? .LST 2>
|
||||
<TOOFEW>)
|
||||
(<ZEVAL <3 .LST>>)>)
|
||||
(<ZEVAL <2 .LST>>)>>
|
||||
<COND (<TYPE? .OBJ2 LIST>
|
||||
<CONS <ZEVAL <1 .LST>> .OBJ2>)
|
||||
(<TYPE? <SET OBJ <ZEVAL <1 .LST>>> OBJECT>
|
||||
<REMOVE-OBJECT .OBJ>
|
||||
<COND (<TYPE? .OBJ2 ROOM>
|
||||
<INSERT-OBJECT .OBJ .OBJ2>)
|
||||
(<TYPE? .OBJ2 OBJECT>
|
||||
<INSERT-INTO .OBJ2 .OBJ>)
|
||||
(<TYPE? .OBJ2 ADV>
|
||||
<TAKE-OBJECT .OBJ>)
|
||||
(<ILLEGAL "Illegal operator/INSERT">)>)
|
||||
(<ILLEGAL "Not an object/INSERT">)>)>>
|
||||
|
||||
"ZTELL -- fsubr"
|
||||
|
||||
<DEFINE ZTELL (DUMMY LST)
|
||||
<MAPF <>
|
||||
<FUNCTION (ITEM)
|
||||
<COND (<TYPE? .ITEM STRING>
|
||||
<TELL .ITEM 0>)
|
||||
(<==? .ITEM crlf>
|
||||
<TELL "">)
|
||||
(<TYPE? <SET VAL <ZEVAL .ITEM>> OBJECT>
|
||||
<TELL <ODESC2 .VAL> 0>)
|
||||
(<ILLEGAL "Unknown print operator.">)>>
|
||||
.LST>>
|
||||
|
||||
"ZGOTO -- one arg"
|
||||
|
||||
<DEFINE ZGOTO (ARG)
|
||||
#DECL ((ARG) ANY)
|
||||
<COND (<TYPE? .ARG ROOM> <GOTO .ARG>)
|
||||
(<ILLEGAL "Not a room/GOTO">)>>
|
||||
|
||||
"ZMAKE -- fsubr"
|
||||
|
||||
<DEFINE ZMAKE (DUMMY LST "AUX" OBJ (NOT? <MEMQ not .LST>))
|
||||
#DECL ((LST) LIST (OBJ) ANY (NOT?) <OR FALSE LIST>)
|
||||
<COND (<OR <AND .NOT? <LENGTH? .LST 2>>
|
||||
<LENGTH? .LST 1>>
|
||||
<TOOFEW>)
|
||||
(<TYPE? <SET OBJ <ZEVAL <1 .LST>>> OBJECT>
|
||||
<COND (<SET M <ZLOOKUP <SPNAME <COND (.NOT? <3 .LST>) (<2 .LST>)>>
|
||||
,ZOBITS-POBL>>
|
||||
<COND (.NOT?
|
||||
<TRZ .OBJ .M>)
|
||||
(<TRO .OBJ .M>)>)
|
||||
(<ILLEGAL "Not an object flag/MAKE">)>)
|
||||
(<TYPE? .OBJ ROOM>
|
||||
<COND (<SET M <ZLOOKUP <SPNAME <COND (.NOT? <3 .LST>) (<2 .LST>)>>
|
||||
,ZRBITS-POBL>>
|
||||
<COND (.NOT?
|
||||
<RTRZ .OBJ .M>)
|
||||
(<RTRO .OBJ .M>)>)
|
||||
(<ILLEGAL "Not a room flag/MAKE">)>)
|
||||
(<ILLEGAL "Not a room or object/MAKE">)>>
|
||||
|
||||
<DEFINE ZTOPLEVEL () <ERRET>>
|
||||
|
||||
<DEFINE ZSTACK& () <ZSTACK T>>
|
||||
|
||||
<DEFINE ZSTACK ("OPTIONAL" (FLG <>) "AUX" (F <FRAME>) (LEVEL -1) ARG)
|
||||
#DECL ((FLG) <OR ATOM FALSE> (F) FRAME (LEVEL) FIX (ARG) ANY)
|
||||
<REPEAT ()
|
||||
<COND (<==? <FUNCT .F> TOPLEVEL>
|
||||
<PRINC "toplevel">
|
||||
<RETURN>)
|
||||
(<AND <==? <FUNCT .F> EVAL>
|
||||
<TYPE? <SET ARG <1 <ARGS .F>>> FORM>
|
||||
<OR <==? <1 .ARG> ZEVAL>
|
||||
<==? <1 .ARG> ZPRED>
|
||||
<==? <1 .ARG> ILLEGAL>>>
|
||||
<PRIN1 <SET LEVEL <+ .LEVEL 1>>>
|
||||
<PRINC !\ >
|
||||
<PRIN1 <1 .ARG>>
|
||||
<INDENT-TO 10>
|
||||
<COND (.FLG
|
||||
<&1 <EVAL <2 .ARG> .F>>
|
||||
<AND <==? <1 .ARG> ZPRED>
|
||||
<CRLF>
|
||||
<INDENT-TO 10>
|
||||
<&1 <EVAL <3 .ARG> .F>>>)
|
||||
(<EPRIN1 <EVAL <2 .ARG> .F>>
|
||||
<AND <==? <1 .ARG> ZPRED>
|
||||
<CRLF>
|
||||
<INDENT-TO 10>
|
||||
<EPRIN1 <EVAL <3 .ARG> .F>>>)>
|
||||
<CRLF>)>
|
||||
<SET F <FRAME .F>>>
|
||||
,NULL>
|
||||
|
||||
<DEFINE ZRETURN (DUMMY ARGL)
|
||||
#DECL ((ARGL) LIST)
|
||||
<ZRETRY <ZEVAL <2 .ARGL>> <ZEVAL <1 .ARGL>>>>
|
||||
|
||||
<DEFINE ZRETRY (TARGET "OPTIONAL" (VAL #LOSE 0) "AUX" (LEVEL -1) (F <FRAME>) ARG)
|
||||
#DECL ((TARGET LEVEL) FIX (ARG VAL) ANY (F) FRAME)
|
||||
<COND (<TYPE? .TARGET FIX>
|
||||
<REPEAT ()
|
||||
<COND (<==? <FUNCT .F> TOPLEVEL>
|
||||
<PRINC "Beyond toplevel?">
|
||||
<RETURN>)
|
||||
(<AND <==? <FUNCT .F> EVAL>
|
||||
<TYPE? <SET ARG <1 <ARGS .F>>> FORM>
|
||||
<OR <==? <1 .ARG> ZEVAL>
|
||||
<==? <1 .ARG> ZPRED>
|
||||
<==? <1 .ARG> ILLEGAL>>
|
||||
<==? <SET LEVEL <+ .LEVEL 1>> .TARGET>>
|
||||
<COND (<TYPE? .VAL LOSE>
|
||||
<RETRY .F>)
|
||||
(<ERRET .VAL .F>)>)>
|
||||
<SET F <FRAME .F>>>)
|
||||
(<ILLEGAL "Bad argument to RETRY/RETURN">)>>
|
||||
|
||||
<DEFINE ZCREATE (DUMMY ARGL "AUX" TYP)
|
||||
#DECL ((ARGL) LIST (TYP) ANY)
|
||||
<COND (<==? <SET TYP <1 .ARGL>> room>
|
||||
<RM/OBJ-CREATE <REST .ARGL> <>>)
|
||||
(<==? .TYP object>
|
||||
<RM/OBJ-CREATE <REST .ARGL>>)
|
||||
(<==? .TYP syntax>
|
||||
<SYNTAX-CREATE <REST .ARGL>>)
|
||||
(<==? .TYP list>
|
||||
<MAPF ,LIST ,ZEVAL <REST .ARGL>>)
|
||||
(<ILLEGAL "Unknown type/CREATE">)>>
|
||||
|
||||
<SETG HI-RM/OBJ 0>
|
||||
|
||||
<DEFINE NEXT-RM/OBJ ()
|
||||
<STRING "Z" <UNPARSE <SETG HI-RM/OBJ <+ ,HI-RM/OBJ 1>>>>>
|
||||
|
||||
<DEFINE RM/OBJ-CREATE (ARGL "OPTIONAL" (OBJ? T)
|
||||
"AUX" NAME (OBJS ()) RM OBJ SYN ADJ)
|
||||
#DECL ((ARGL) LIST (NAME) ATOM (OBJS) <LIST [REST OBJECT]>
|
||||
(RM) ROOM (OBJECT) OBJECT (OBJ?) <OR ATOM FALSE>
|
||||
(SYN) <UVECTOR [REST PSTRING]> (ADJ) <UVECTOR [REST ADJECTIVE]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (ITEM "AUX" OPER VAL VAL2)
|
||||
#DECL ((ITEM OPER VAL VAL2) ANY)
|
||||
<COND (<TYPE? .ITEM ATOM>
|
||||
<SET NAME .ITEM>
|
||||
<SET VAL <ZLOOKUP <SPNAME .NAME> ,ZVARS-POBL>>
|
||||
<COND (.OBJ?
|
||||
<SET OBJ
|
||||
<COND (<TYPE? .VAL OBJECT> .VAL)
|
||||
(<GET-OBJ <NEXT-RM/OBJ>>)>>)
|
||||
(<SET RM
|
||||
<COND (<TYPE? .VAL ROOM> .VAL)
|
||||
(<GET-ROOM <NEXT-RM/OBJ>>)>>)>)
|
||||
(<TYPE? .ITEM LIST>
|
||||
<COND (<LENGTH? .ITEM 1>
|
||||
<ILLEGAL "Bad format/CREATE">)
|
||||
(<==? <SET OPER <1 .ITEM>> property>
|
||||
<COND (.OBJ?
|
||||
<PUT .OBJ
|
||||
,OFLAGS
|
||||
<BITS-GET ,ZOBITS-POBL <REST .ITEM>>>)
|
||||
(<PUT .RM
|
||||
,RBITS
|
||||
<BITS-GET ,ZRBITS-POBL <REST .ITEM>>>
|
||||
<RTRO .RM ,RLANDBIT>)>)
|
||||
(<AND <SET VAL <2 .ITEM>> <>>)
|
||||
(<==? .OPER name>
|
||||
<COND (.OBJ?
|
||||
<PUT .OBJ ,ODESC2 .VAL>)
|
||||
(<PUT .RM ,RDESC2 .VAL>)>)
|
||||
(<==? .OPER description>
|
||||
<COND (.OBJ?
|
||||
<OPUT .OBJ ODESC1 .VAL T>)
|
||||
(<PUT .RM ,RDESC1 .VAL>)>)
|
||||
(<==? .OPER run>
|
||||
<COND (<TYPE? .VAL ATOM>
|
||||
<COND (<GASSIGNED? .VAL>)
|
||||
(<SETG .VAL ,ZFALSE>)>
|
||||
<COND (.OBJ?
|
||||
<PUT .OBJ ,OACTION .VAL>)
|
||||
(<PUT .RM ,RACTION .VAL>)>)
|
||||
(<ILLEGAL "Bad routine/CREATE">)>)
|
||||
(<==? .OPER contents>
|
||||
<MAPF <>
|
||||
<FUNCTION (FOO)
|
||||
#DECL ((FOO) ANY)
|
||||
<COND (<TYPE? <SET VAL2 <ZEVAL .FOO T>>
|
||||
OBJECT>
|
||||
<REMOVE-OBJECT .VAL2>)
|
||||
(<TYPE? .VAL2 LOSE>
|
||||
<SET VAL2
|
||||
<RM/OBJ-CREATE (.FOO)>>)
|
||||
(<ILLEGAL "Bad object/CREATE">)>
|
||||
<SET OBJS (.VAL2 !.OBJS)>>
|
||||
<REST .ITEM>>)
|
||||
(<AND <NOT .OBJ?> <==? .OPER exit>>
|
||||
<ZEXIT .RM <REST .ITEM>>)
|
||||
(<AND .OBJ? <==? .OPER synonym>>
|
||||
<SET SYN
|
||||
<MAPF ,UVECTOR
|
||||
<FUNCTION (NAM)
|
||||
#DECL ((NAM) ANY)
|
||||
<COND (<TYPE? .NAM ATOM>
|
||||
<ZSYN .NAM .OBJ>)
|
||||
(<ILLEGAL "Bad synonym/CREATE">)>>
|
||||
<REST .ITEM>>>)
|
||||
(<AND .OBJ? <==? .OPER adjective>>
|
||||
<SET ADJ
|
||||
<MAPF ,UVECTOR
|
||||
<FUNCTION (NAM)
|
||||
#DECL ((NAM) ANY)
|
||||
<COND (<TYPE? .NAM ATOM>
|
||||
<ADD-ZORK ADJECTIVE <SPNAME .NAM>>)
|
||||
(<ILLEGAL "Bad adjective/CREATE">)>>
|
||||
<REST .ITEM>>>)
|
||||
(<ILLEGAL "Bad identifier/CREATE">)>)>>
|
||||
.ARGL>
|
||||
<ZINSERT <SPNAME .NAME> ,ZDEFS-POBL .ARGL>
|
||||
<COND (.OBJ?
|
||||
<PUT .OBJ ,OCONTENTS ()>
|
||||
<MAPF <>
|
||||
<FUNCTION (NOBJ) #DECL ((NOBJ) OBJECT)
|
||||
<INSERT-INTO .OBJ .NOBJ>>
|
||||
.OBJS>
|
||||
<AND <ASSIGNED? SYN> <PUT .OBJ ,ONAMES .SYN>>
|
||||
<AND <ASSIGNED? ADJ> <PUT .OBJ ,OADJS .ADJ>>
|
||||
<ZINSERT <SPNAME .NAME> ,ZVARS-POBL .OBJ>
|
||||
.OBJ)
|
||||
(<PUT .RM ,ROBJS ()>
|
||||
<MAPF <>
|
||||
<FUNCTION (NOBJ) #DECL ((NOBJ) OBJECT)
|
||||
<INSERT-OBJECT .NOBJ .RM>>
|
||||
.OBJS>
|
||||
<ZINSERT <SPNAME .NAME> ,ZVARS-POBL .RM>
|
||||
.RM)>>
|
||||
|
||||
<DEFINE ZSYN (NAM OBJ "AUX" (S <SPNAME .NAM>) STR)
|
||||
#DECL ((NAM) ATOM (S STR) STRING (OBJ) OBJECT)
|
||||
<SET STR <UPPERCASE <SUBSTRUC .S 0 <MIN <LENGTH .S> 5>>>>
|
||||
<PINSERT .STR ,OBJECT-POBL .OBJ>
|
||||
<PSTRING .STR>>
|
||||
|
||||
<DEFINE ZEXIT (THIS LST "AUX" DIR RM RM? (NEXIT <>) (CEXIT <>) (CFCN <>) M EXIT)
|
||||
#DECL ((LST) LIST (DIR) <OR DIRECTION FALSE> (RM?) ANY (RM THIS) ROOM
|
||||
(NEXIT) <OR STRING FALSE> (CEXIT CFCN) <OR FALSE ATOM> (EXIT) ANY
|
||||
(M) <OR FALSE <VECTOR [REST DIRECTION ANY]>>)
|
||||
<COND (<LENGTH? .LST 2>
|
||||
<TOOFEW>)
|
||||
(<SET DIR <PLOOKUP <UPPERCASE <PNAME <1 .LST>>> ,DIRECTIONS-POBL>>
|
||||
<COND (<==? <2 .LST> to>
|
||||
<COND (<TYPE? <SET RM? <ZEVAL <3 .LST> T>> ROOM>)
|
||||
(<TYPE? .RM? LOSE>
|
||||
<SET RM? <RM/OBJ-CREATE (<3 .LST>) <>>>)
|
||||
(<TYPE? .RM? STRING>
|
||||
<SET NEXIT .RM?>)
|
||||
(<ILLEGAL "Not-a-room/EXIT">)>
|
||||
<SET RM .RM?>
|
||||
<SET LST <REST .LST 3>>
|
||||
<COND (<EMPTY? .LST>)
|
||||
(<AND <==? <1 .LST> if>
|
||||
<NOT <LENGTH? .LST 1>>>
|
||||
<COND (<==? <2 .LST> run>
|
||||
<COND (<LENGTH? .LST 2>
|
||||
<SET CFCN <3 .LST>>)
|
||||
(<ILLEGAL "Bad format/EXIT">)>)
|
||||
(<SET CEXIT <2 .LST>>)>)
|
||||
(<ILLEGAL "Bad format/EXIT">)>
|
||||
<SET EXIT
|
||||
<COND (.NEXIT <CHTYPE .NEXIT STRING>)
|
||||
(.CEXIT <CEXIT <SPNAME .CEXIT> <RID .RM> "" <> <>>)
|
||||
(.CFCN <CEXIT "FROBOZZ" <RID .RM> "" <> .CFCN>)
|
||||
(.RM)>>
|
||||
<COND (<SET M <MEMQ .DIR <REXITS .THIS>>>
|
||||
<PUT .M 2 .EXIT>)
|
||||
(<PUT .THIS ,REXITS <VECTOR .DIR .EXIT !<REXITS .THIS>>>)>)
|
||||
(<ILLEGAL "Bad format/EXIT">)>)
|
||||
(<ILLEGAL "Unknown-direction: " <1 .LST>>)>>
|
||||
|
||||
<DEFINE BITS-GET (POBL ARGL "AUX" FX)
|
||||
#DECL ((ARGL) LIST (POBL) OBLIST (FX) <OR FIX FALSE>)
|
||||
<MAPF ,+
|
||||
<FUNCTION (ITEM)
|
||||
<COND (<AND <TYPE? .ITEM ATOM>
|
||||
<SET FX <ZLOOKUP <SPNAME .ITEM> .POBL>>>)
|
||||
(<ILLEGAL "Illegal property.">)>>
|
||||
.ARGL>>
|
||||
|
||||
<DEFINE ZOBLIST (ATM NUM)
|
||||
<SETG .ATM <MOBLIST .ATM .NUM>>>
|
||||
|
||||
<DEFINE ZLOOKUP (STR OBL "AUX" ATM)
|
||||
#DECL ((STR) STRING (OBL) OBLIST (ATM) <OR FALSE ATOM>)
|
||||
<AND <SET ATM <LOOKUP .STR .OBL>> ,.ATM>>
|
||||
|
||||
<DEFINE ZINSERT (STR OBL VAL)
|
||||
#DECL ((STR) STRING (OBL) OBLIST (VAL) ANY)
|
||||
<SETG <OR <LOOKUP .STR .OBL> <INSERT .STR .OBL>> .VAL>>
|
||||
|
||||
<DEFINE PINS (POBL VEC)
|
||||
#DECL ((POBL) OBLIST (VEC) <VECTOR [REST <OR STRING ATOM> ANY]>)
|
||||
<REPEAT ((V .VEC) ELEM)
|
||||
#DECL ((V) <VECTOR [REST <OR STRING ATOM> ANY]> (ELEM) <OR STRING ATOM>)
|
||||
<ZINSERT <COND (<TYPE? <SET ELEM <1 .V>> ATOM>
|
||||
<PNAME .ELEM>)
|
||||
(.ELEM)>
|
||||
.POBL
|
||||
<2 .V>>
|
||||
<COND (<EMPTY? <SET V <REST .V 2>>>
|
||||
<RETURN>)>>>
|
||||
|
||||
<ZOBLIST ZOBITS-POBL 17>
|
||||
<ZOBLIST ZRBITS-POBL 17>
|
||||
<ZOBLIST ZVARS-POBL 17>
|
||||
<ZOBLIST ZDEFS-POBL 17>
|
||||
<ZOBLIST ZINT-POBL 17>
|
||||
|
||||
<ZOBLIST ZERO-POBL 17>
|
||||
<ZOBLIST ONE-POBL 17>
|
||||
<ZOBLIST TWO-POBL 17>
|
||||
<ZOBLIST ANY-POBL 17>
|
||||
|
||||
<SETG ZINTS ()>
|
||||
|
||||
<GDECL (ZINTS) <LIST [REST ATOM CEVENT]>>
|
||||
|
||||
<PINS ,ANY-POBL
|
||||
["edit" ,ZEDIT "pprint" ,ZPPRINT
|
||||
"if" ,ZIF "case" ,ZCASE "for-each" ,ZFOR-EACH "contents" ,ZCONTENTS
|
||||
"is" ,ZIS "isnt" ,ZISNT
|
||||
"define" ,ZDEFINE "set" ,ZSET "run" ,ZRUN "lookup" ,ZLKUP
|
||||
"remove" ,ZREMOVE "insert" ,ZPUTIN "return" ,ZRETURN "put" ,ZPUTIN
|
||||
"print" ,ZTELL "make" ,ZMAKE "create" ,ZCREATE]>
|
||||
|
||||
<PINS ,TWO-POBL
|
||||
["and" ,ZAND "or" ,ZOR "plus" ,ZPLUS "minus" ,ZMINUS
|
||||
"times" ,ZTIMES "divided-by" ,ZDIVIDED "is-greater-than" ,ZGREATER
|
||||
"is-less-than" ,ZLESS "gt" ,ZGREATER "lt" ,ZLESS "eq" ,ZEQUAL
|
||||
"equals" ,ZEQUAL]>
|
||||
|
||||
<PINS ,ONE-POBL
|
||||
["retry" ,ZRETRY "goto" ,ZGOTO "take" ,ZTAKE
|
||||
"load" ,ZLOAD "dump" ,ZDUMP "enable" ,ZENABLE "disable" ,ZDISABLE
|
||||
]>
|
||||
|
||||
<PINS ,ZERO-POBL
|
||||
["stack" ,ZSTACK "stack&" ,ZSTACK& "toplevel" ,ZTOPLEVEL
|
||||
"me" ,ZWINNER "hand" ,ZWINNER "player" ,ZWINNER
|
||||
"handled" ,ZTRUE
|
||||
"not-handled" ,ZFALSE
|
||||
"room" ,ZROOM "here" ,ZROOM
|
||||
"verb" ,ZVERB "zork" ,ZZORK
|
||||
"objo" ,ZPRSO "direct-object" ,ZPRSO "object" ,ZPRSO
|
||||
"indirect-object" ,ZPRSI "obji" ,ZPRSI "it" ,ZIT
|
||||
"score" ,ZSCORE]>
|
||||
|
||||
<PINS ,ZOBITS-POBL
|
||||
["visible" ,OVISON "readable" ,READBIT "burnable" ,BURNBIT
|
||||
"weapon" ,WEAPONBIT "takeable" ,TAKEBIT "villain" ,VILLAIN
|
||||
"container" ,CONTBIT "edible" ,FOODBIT "transparent" ,TRANSBIT
|
||||
"indescribable" ,NDESCBIT "drinkable" ,DRINKBIT "potable" ,DRINKBIT
|
||||
"light" ,LIGHTBIT "victim" ,VICBIT "flaming" ,FLAMEBIT "tool" ,TOOLBIT
|
||||
"turnable" ,TURNBIT "vehicle" ,VEHBIT "sacred" ,SACREDBIT "tieable"
|
||||
,TIEBIT "climbable" ,CLIMBBIT "open" ,OPENBIT "touched" ,TOUCHBIT
|
||||
"on" ,ONBIT]>
|
||||
|
||||
<PINS ,ZRBITS-POBL
|
||||
["land" ,RLANDBIT "seen" ,RSEENBIT "illuminated" ,RLIGHTBIT
|
||||
"sacred" ,RSACREDBIT "reservoir" ,RFILLBIT
|
||||
"inaccessible" ,RMUNGBIT "wallless" ,RNWALLBIT]>
|
||||
|
||||
<SETG BUZZ ![a the is]>
|
||||
|
||||
<SETG NOTS [not isnt]>
|
||||
|
||||
<SETG TEST-TYPES [in]>
|
||||
|
||||
<DEFINE ILLEGAL ("OPTIONAL" (STR "Illegal operation.") (STR2 ""))
|
||||
#DECL ((STR) STRING)
|
||||
<TELL .STR 0 .STR2>
|
||||
<LISTEN>>
|
||||
|
||||
<DEFINE TOOFEW ("OPTIONAL" WHAT)
|
||||
<TELL "Too few arguments" 0>
|
||||
<AND <ASSIGNED? WHAT> <TELL " to " 0 .WHAT>>
|
||||
<LISTEN>>
|
||||
|
||||
<DEFINE WNA ()
|
||||
<TELL "Wrong number of arguments." 0>
|
||||
<LISTEN>>
|
||||
|
||||
|
||||
344
src/zork/makstr.44
Normal file
344
src/zork/makstr.44
Normal file
@@ -0,0 +1,344 @@
|
||||
|
||||
<GDECL (GLOHI STAR-BITS) FIX>
|
||||
|
||||
<DEFINE MPOBLIST (ATM LEN)
|
||||
#DECL ((ATM) ATOM (LEN) FIX)
|
||||
<SETG .ATM <CHTYPE <IUVECTOR .LEN ()> POBLIST>>>
|
||||
|
||||
<DEFINE PINSERT (NAME OBL VAL "AUX" BUCKET BUCK TL)
|
||||
#DECL ((NAME) <OR STRING <PRIMTYPE WORD>> (OBL) POBLIST (VAL) ANY (BUCK) FIX
|
||||
(TL) <OR LIST FALSE>)
|
||||
<COND (<TYPE? .NAME STRING>
|
||||
<SET NAME <PSTRING .NAME>>)
|
||||
(<NOT <TYPE? .NAME PSTRING>>
|
||||
<SET NAME <CHTYPE .NAME PSTRING>>)>
|
||||
<SET BUCK <HASH .NAME .OBL>>
|
||||
<COND (<SET TL <MEMQ .NAME <SET BUCKET <NTH .OBL .BUCK>>>>
|
||||
<PUT .TL 2 .VAL>)
|
||||
(T
|
||||
<PUT .OBL .BUCK (.NAME .VAL !.BUCKET)>)>
|
||||
.VAL>
|
||||
|
||||
<DEFINE CEVENT (TICK APP FLG NAME "OPTIONAL" (DEATH <>)
|
||||
"AUX" (OBL <GET INITIAL OBLIST>) ATM)
|
||||
#DECL ((TICK) FIX (APP) <OR ATOM NOFFSET> (FLG DEATH) <OR ATOM FALSE>
|
||||
(OBL) OBLIST (NAME) <OR ATOM STRING> (ATM) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .NAME STRING>
|
||||
<COND (<SET ATM <LOOKUP .NAME .OBL>>)
|
||||
(T <SET ATM <INSERT .NAME .OBL>>)>)
|
||||
(<SET ATM .NAME>)>
|
||||
<SETG .ATM <CHTYPE [.TICK .APP .FLG .ATM .DEATH] CEVENT>>>
|
||||
|
||||
<DEFINE CEXIT (FLID RMID "OPTIONAL" (STR <>) (FLAG <>) (FUNCT <>) "AUX" ATM)
|
||||
#DECL ((STR) <OR FALSE STRING> (FLID RMID) <OR ATOM STRING>
|
||||
(ATM FUNCT) <OR ATOM FALSE> (FLAG) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .FLID ATOM> <SET FLID <SPNAME .FLID>>)>
|
||||
<SET ATM <OR <LOOKUP .FLID <GET FLAG OBLIST>>
|
||||
<INSERT .FLID <GET FLAG OBLIST>>>>
|
||||
<SETG .ATM .FLAG>
|
||||
<CHTYPE <VECTOR .ATM <GET-ROOM .RMID> .STR .FUNCT> CEXIT>>
|
||||
|
||||
<DEFINE DOOR (OID RM1 RM2 "OPTIONAL" (STR <>) (FN <>) "AUX" (OBJ <GET-OBJ .OID>))
|
||||
#DECL ((OID) STRING (STR) <OR STRING FALSE> (FN) <OR ATOM FALSE>
|
||||
(OBJ) OBJECT (RM1 RM2) <OR STRING ROOM>)
|
||||
<COND (<FIND-DOOR <SET RM1 <GET-ROOM .RM1>> .OBJ>)
|
||||
(<FIND-DOOR <SET RM2 <GET-ROOM .RM2>> .OBJ>)
|
||||
(<CHTYPE [.OBJ .RM1 .RM2 .STR .FN] DOOR>)>>
|
||||
|
||||
<DEFINE EXIT ("TUPLE" PAIRS
|
||||
"AUX" (DOBL ,DIRECTIONS-POBL) (FROB <IVECTOR <LENGTH .PAIRS>>)
|
||||
DIR)
|
||||
#DECL ((PAIRS) <TUPLE [REST STRING <OR DOOR NEXIT CEXIT STRING ATOM>]>
|
||||
(DIR) DIRECTION (FROB) VECTOR (DOBL) POBLIST)
|
||||
<REPEAT ((F .FROB))
|
||||
#DECL ((F) VECTOR)
|
||||
<COND (<SET DIR <PLOOKUP <1 .PAIRS> .DOBL>>
|
||||
<PUT .F 1 .DIR>
|
||||
<COND (<TYPE? <2 .PAIRS> STRING>
|
||||
<PUT .F 2 <GET-ROOM <2 .PAIRS>>>)
|
||||
(<PUT .F 2 <2 .PAIRS>>)>
|
||||
<SET F <REST .F 2>>)>
|
||||
<COND (<EMPTY? <SET PAIRS <REST .PAIRS 2>>> <RETURN>)>>
|
||||
<CHTYPE .FROB EXIT>>
|
||||
|
||||
<DEFINE ROOM (ID D1 D2 EX
|
||||
"OPTIONAL" (OBJS ()) (APP <>) (BIT ,RLANDBIT) (PROPS ())
|
||||
"AUX" (RM <GET-ROOM .ID>) VAL M)
|
||||
#DECL ((ID D1 D2) STRING (EX) EXIT (APP) <OR FALSE ATOM> (BIT VAL) FIX
|
||||
(RM) ROOM (PROPS) <LIST [REST ATOM ANY]>
|
||||
(M) <OR FALSE <LIST ATOM FIX>>)
|
||||
<SET VAL <COND (<SET M <MEMQ RVAL .PROPS>> <2 .M>) (0)>>
|
||||
<COND (<NOT <0? <CHTYPE <ANDB .BIT ,RENDGAME> FIX>>>
|
||||
<SETG EG-SCORE-MAX <+ ,EG-SCORE-MAX .VAL>>)
|
||||
(<SETG SCORE-MAX <+ ,SCORE-MAX .VAL>>)>
|
||||
<COND (<SET M <MEMQ RGLOBAL .PROPS>> <PUT .M 2 <+ <2 .M> ,STAR-BITS>>)>
|
||||
<PUT .RM ,ROBJS .OBJS>
|
||||
<PUT .RM ,RDESC1 .D1>
|
||||
<PUT .RM ,RDESC2 .D2>
|
||||
<PUT .RM ,REXITS .EX>
|
||||
<PUT .RM ,RACTION .APP>
|
||||
<PUT .RM ,RPROPS .PROPS>
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) OBJECT) <PUT .X ,OROOM .RM>>
|
||||
<ROBJS .RM>>
|
||||
<PUT .RM ,RBITS .BIT>
|
||||
.RM>
|
||||
|
||||
<DEFINE FIND-PREP (STR "AUX" VAL)
|
||||
#DECL ((STR) STRING)
|
||||
<COND (<SET VAL <PLOOKUP .STR ,WORDS-POBL>>
|
||||
<COND (<TYPE? .VAL PREP> .VAL)
|
||||
(<ERROR NO-PREP!-ERRORS>)>)
|
||||
(<PINSERT .STR ,WORDS-POBL <CHTYPE <PSTRING .STR> PREP>>)>>
|
||||
|
||||
<DEFINE ADD-ACTION (NAM STR "TUPLE" DECL "AUX" (ACTIONS ,ACTIONS-POBL))
|
||||
#DECL ((NAM STR) STRING (DECL) <TUPLE [REST VECTOR]>
|
||||
(ACTIONS) POBLIST)
|
||||
<PINSERT .NAM .ACTIONS <CHTYPE [<PSTRING .NAM> <MAKE-ACTION !.DECL> .STR] ACTION>>>
|
||||
|
||||
<DEFINE ADD-DIRECTIONS ("TUPLE" NMS "AUX" (DIR ,DIRECTIONS-POBL))
|
||||
#DECL ((NMS) <TUPLE [REST STRING]> (DIR) POBLIST)
|
||||
<MAPF <>
|
||||
<FUNCTION (X) <PINSERT .X .DIR <CHTYPE <PSTRING .X> DIRECTION>>>
|
||||
.NMS>>
|
||||
|
||||
<DEFINE DSYNONYM (STR
|
||||
"TUPLE" NMS
|
||||
"AUX" (DIR ,DIRECTIONS-POBL) (VAL <PLOOKUP .STR .DIR>))
|
||||
#DECL ((STR) STRING (NMS) <TUPLE [REST STRING]> (VAL) DIRECTION (DIR) POBLIST)
|
||||
<MAPF <> <FUNCTION (X) <PINSERT .X .DIR .VAL>> .NMS>>
|
||||
|
||||
<DEFINE VSYNONYM (N1 "TUPLE" N2 "AUX" VAL (ACTIONS ,ACTIONS-POBL))
|
||||
#DECL ((N1) STRING (N2) <TUPLE [REST STRING]> (VAL) ANY (ACTIONS) POBLIST)
|
||||
<COND (<SET VAL <PLOOKUP .N1 .ACTIONS>>
|
||||
<MAPF <> <FUNCTION (X) <PINSERT .X .ACTIONS .VAL>> .N2>)>>
|
||||
|
||||
"STUFF FOR ADDING TO VOCABULARY, ADDING TO LISTS (OF DEMONS, FOR EXAMPLE)."
|
||||
|
||||
<DEFINE ADD-BUZZ ("TUPLE" W)
|
||||
#DECL ((W) <TUPLE [REST STRING]>)
|
||||
<ADD-ZORK BUZZ !.W>>
|
||||
|
||||
<DEFINE ADD-ZORK (NM "TUPLE" W)
|
||||
#DECL ((NM) ATOM (W) <TUPLE [REST STRING]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) STRING)
|
||||
<PINSERT .X ,WORDS-POBL <CHTYPE <PSTRING .X> .NM>>>
|
||||
.W>>
|
||||
|
||||
<DEFINE SYNONYM (N1 "TUPLE" N2 "AUX" VAL (WORDS ,WORDS-POBL))
|
||||
#DECL ((N1) STRING (N2) <TUPLE [REST STRING]> (VAL) ANY (WORDS) POBLIST)
|
||||
<COND (<SET VAL <PLOOKUP .N1 .WORDS>>
|
||||
<MAPF <> <FUNCTION (X) <PINSERT .X .WORDS .VAL>> .N2>)>>
|
||||
|
||||
<DEFINE ADD-DEMON (X) #DECL ((X) HACK)
|
||||
<COND (<MAPR <>
|
||||
<FUNCTION (Y) #DECL ((Y) <LIST [REST HACK]>)
|
||||
<COND (<==? <HACTION <1 .Y>> <HACTION .X>>
|
||||
<PUT .Y 1 .X>
|
||||
<MAPLEAVE T>)>>
|
||||
,DEMONS>)
|
||||
(<SETG DEMONS (.X !,DEMONS)>)>>
|
||||
|
||||
<DEFINE ADD-ACTOR (ADV "AUX" (ACTORS ,ACTORS))
|
||||
#DECL ((ADV) ADV (ACTORS) <LIST [REST ADV]>)
|
||||
<COND (<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) ADV)
|
||||
<COND (<==? <AOBJ .X> <AOBJ .ADV>>
|
||||
<MAPLEAVE T>)>>
|
||||
.ACTORS>)
|
||||
(<SETG ACTORS (.ADV !.ACTORS)>)>
|
||||
.ADV>
|
||||
|
||||
<DEFINE SADD-ACTION (STR1 ATM)
|
||||
<ADD-ACTION .STR1 "" [[.STR1 .ATM]]>>
|
||||
|
||||
<DEFINE 1ADD-ACTION (STR1 STR2 ATM)
|
||||
<ADD-ACTION .STR1 .STR2 [OBJ [.STR1 .ATM]]>>
|
||||
|
||||
<DEFINE 1NRADD-ACTION (STR1 STR2 ATM)
|
||||
<ADD-ACTION .STR1 .STR2 [NROBJ [.STR1 .ATM]]>>
|
||||
|
||||
"MAKE-ACTION: Function for creating a verb. Takes;
|
||||
|
||||
vspec => [objspec {\"prep\"} {objspec} [pstring fcn] extras]
|
||||
|
||||
objspec => OBJ | objlist
|
||||
|
||||
objlist => ( objbits {fwimbits} {NO-TAKE} {MUST-HAVE} {TRY-TAKE} {=} )
|
||||
|
||||
extras => DRIVER FLIP
|
||||
|
||||
Creates a VSPEC.
|
||||
"
|
||||
|
||||
<DEFINE MAKE-ACTION ("TUPLE" SPECS "AUX" VV SUM (PREP <>) ATM VERB)
|
||||
#DECL ((SPECS) TUPLE (VV) <PRIMTYPE VECTOR> (SUM) FIX (PREP ATM) ANY
|
||||
(VERB) VERB)
|
||||
<CHTYPE
|
||||
<MAPF ,UVECTOR
|
||||
<FUNCTION (SP "AUX" (SYN <VECTOR <> <> <> 0>) (WHR 1))
|
||||
#DECL ((SP) VECTOR (SYN) VECTOR (WHR) FIX)
|
||||
<MAPF <>
|
||||
<FUNCTION (ITM)
|
||||
#DECL ((ITM) ANY)
|
||||
<COND (<TYPE? .ITM STRING> <SET PREP <FIND-PREP .ITM>>)
|
||||
(<AND <==? .ITM OBJ>
|
||||
<SET ITM '(-1 REACH ROBJS AOBJS)>
|
||||
<>>)
|
||||
(<AND <==? .ITM NROBJ>
|
||||
<SET ITM '(-1 ROBJS AOBJS)>
|
||||
<>>)
|
||||
(<TYPE? .ITM LIST>
|
||||
<SET VV <IVECTOR 4>>
|
||||
<PUT .VV ,VBIT <1 .ITM>>
|
||||
<COND (<AND <NOT <LENGTH? .ITM 1>>
|
||||
<TYPE? <2 .ITM> FIX>>
|
||||
<PUT .VV ,VFWIM <2 .ITM>>)
|
||||
(ELSE
|
||||
<PUT .VV ,VBIT -1>
|
||||
<PUT .VV ,VFWIM <1 .ITM>>)>
|
||||
<AND <MEMQ = .ITM> <PUT .VV ,VBIT <VFWIM .VV>>>
|
||||
<PUT .VV ,VPREP .PREP>
|
||||
<SET SUM 0>
|
||||
<SET PREP <>>
|
||||
<AND <MEMQ AOBJS .ITM> <SET SUM <+ .SUM ,VABIT>>>
|
||||
<AND <MEMQ ROBJS .ITM> <SET SUM <+ .SUM ,VRBIT>>>
|
||||
<AND <MEMQ NO-TAKE .ITM> <SET SUM .SUM>>
|
||||
<AND <MEMQ HAVE .ITM> <SET SUM <+ .SUM ,VCBIT>>>
|
||||
<AND <MEMQ REACH .ITM> <SET SUM <+ .SUM ,VFBIT>>>
|
||||
<AND <MEMQ TRY .ITM> <SET SUM <+ .SUM ,VTBIT>>>
|
||||
<AND <MEMQ TAKE .ITM>
|
||||
<SET SUM <+ .SUM ,VTBIT ,VCBIT>>>
|
||||
<PUT .VV ,VWORD .SUM>
|
||||
<PUT .SYN .WHR <CHTYPE .VV VARG>>
|
||||
<SET WHR <+ .WHR 1>>)
|
||||
(<TYPE? .ITM VECTOR>
|
||||
<SET VERB <FIND-VERB <1 .ITM>>>
|
||||
<COND (<==? <VFCN .VERB> T>
|
||||
<PUT .VERB ,VFCN <2 .ITM>>)>
|
||||
<PUT .SYN ,SFCN .VERB>)
|
||||
(<==? .ITM DRIVER>
|
||||
<PUT .SYN
|
||||
,SFLAGS
|
||||
<CHTYPE <ORB <SFLAGS .SYN> ,SDRIVER> FIX>>)
|
||||
(<==? .ITM FLIP>
|
||||
<PUT .SYN
|
||||
,SFLAGS
|
||||
<CHTYPE <ORB <SFLAGS .SYN> ,SFLIP> FIX>>)>>
|
||||
.SP>
|
||||
<OR <SYN1 .SYN> <PUT .SYN ,SYN1 ,EVARG>>
|
||||
<OR <SYN2 .SYN> <PUT .SYN ,SYN2 ,EVARG>>
|
||||
<CHTYPE .SYN SYNTAX>>
|
||||
.SPECS>
|
||||
VSPEC>>
|
||||
|
||||
"Default value for syntax slots not specified"
|
||||
|
||||
<SETG EVARG <CHTYPE [0 0 <> 0] VARG>>
|
||||
|
||||
<GDECL (EVARG) VARG>
|
||||
|
||||
;"To add VERBs to the BUNCHERS list"
|
||||
|
||||
<DEFINE ADD-BUNCHER ("TUPLE" STRS)
|
||||
#DECL ((STRS) <TUPLE [REST STRING]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (STR)
|
||||
#DECL ((STR) STRING)
|
||||
<SETG BUNCHERS
|
||||
(<FIND-VERB .STR> !,BUNCHERS)>>
|
||||
.STRS>>
|
||||
|
||||
; "For making end game questions"
|
||||
|
||||
<DEFINE ADD-QUESTION (STR VEC)
|
||||
#DECL ((STR) STRING (VEC) VECTOR)
|
||||
<PUT <SETG QVEC <BACK ,QVEC>>
|
||||
1
|
||||
<CHTYPE [.STR .VEC] QUESTION>>
|
||||
<AND <TYPE? <1 .VEC> OBJECT>
|
||||
<ADD-INQOBJ <1 .VEC>>>>
|
||||
|
||||
<DEFINE ADD-INQOBJ (OBJ)
|
||||
#DECL ((OBJ) OBJECT)
|
||||
<SETG INQOBJS (.OBJ !,INQOBJS)>>
|
||||
|
||||
<GDECL (GLOBAL-OBJECTS) <LIST [REST OBJECT]>>
|
||||
|
||||
<DEFINE GOBJECT (NAM IDS ADJS STR FLAGS
|
||||
"OPTIONAL" (APP <>) (CONTS ()) (PROPS (OGLOBAL 0))
|
||||
"AUX" OBJ BITS)
|
||||
#DECL ((IDS ADJS) <VECTOR [REST STRING]> (STR) STRING (FLAGS) FIX
|
||||
(APP) <OR ATOM FALSE> (OBJ) OBJECT
|
||||
(NAM) <OR FALSE ATOM> (CONTS) LIST (PROPS) LIST)
|
||||
<SET OBJ <OBJECT .IDS .ADJS .STR .FLAGS .APP .CONTS .PROPS>>
|
||||
<COND (.NAM
|
||||
<COND (<GASSIGNED? .NAM> <SET BITS ,.NAM>)
|
||||
(<SETG GLOHI <SET BITS <* ,GLOHI 2>>>
|
||||
<SETG .NAM .BITS>)>)
|
||||
(<SETG GLOHI <SET BITS <* ,GLOHI 2>>>
|
||||
<SETG STAR-BITS <+ ,STAR-BITS .BITS>>)>
|
||||
<OGLOBAL .OBJ .BITS>
|
||||
<COND (<NOT <GASSIGNED? GLOBAL-OBJECTS>>
|
||||
<SETG GLOBAL-OBJECTS ()>)>
|
||||
<COND (<NOT <MEMQ .OBJ ,GLOBAL-OBJECTS>>
|
||||
<SETG GLOBAL-OBJECTS (.OBJ !,GLOBAL-OBJECTS)>)>
|
||||
.OBJ>
|
||||
|
||||
<DEFINE OBJECT (NAMES ADJS DESC FLAGS
|
||||
"OPTIONAL" (ACTION <>) (CONTENTS ()) (PROPS ())
|
||||
"AUX" (OBJ <GET-OBJ <1 .NAMES>>) (OBJS ,OBJECT-POBL))
|
||||
#DECL ((NAMES ADJS) <VECTOR [REST STRING]> (DESC) STRING (FLAGS) FIX
|
||||
(ACTION) <OR FALSE RAPPLIC> (CONTENTS) <LIST [REST OBJECT]>
|
||||
(PROPS) <LIST [REST ATOM ANY]> (OBJ) OBJECT (OBJS) POBLIST)
|
||||
<PUT .OBJ ,ONAMES
|
||||
<MAPF ,UVECTOR
|
||||
<FUNCTION (X) #DECL ((X) STRING)
|
||||
<COND (<PLOOKUP .X .OBJS>
|
||||
<PSTRING .X>)
|
||||
(T
|
||||
<PINSERT .X .OBJS .OBJ>
|
||||
<PSTRING .X>)>>
|
||||
.NAMES>>
|
||||
<PUT .OBJ
|
||||
,OADJS
|
||||
<MAPF ,UVECTOR <FUNCTION (W) <ADD-ZORK ADJECTIVE .W>> .ADJS>>
|
||||
<CHUTYPE <OADJS .OBJ> ADJECTIVE>
|
||||
<PUT .OBJ ,ODESC2 .DESC>
|
||||
<PUT .OBJ ,OFLAGS .FLAGS>
|
||||
<PUT .OBJ ,OACTION .ACTION>
|
||||
<PUT .OBJ ,OCONTENTS .CONTENTS>
|
||||
<MAPF <> <FUNCTION (X) <PUT .X ,OCAN .OBJ>> .CONTENTS>
|
||||
<PUT .OBJ ,OPROPS .PROPS>
|
||||
<SETG SCORE-MAX <+ ,SCORE-MAX <OTVAL .OBJ> <OFVAL .OBJ>>>
|
||||
.OBJ>
|
||||
|
||||
<DEFINE GET-OBJ (STR "AUX" ATM OBJ O)
|
||||
#DECL ((STR) STRING (ATM) <OR FALSE ATOM> (OBJ) OBJECT (O) <OR FALSE OBJECT>)
|
||||
<COND (<AND <SET O <PLOOKUP .STR ,OBJECT-POBL>>
|
||||
<==? <PSTRING .STR> <OID .O>>> .O)
|
||||
(<PINSERT .STR ,OBJECT-POBL
|
||||
<SET OBJ <CHTYPE [<UVECTOR <PSTRING .STR>>
|
||||
'![] "" 0 <> () <> <> ()] OBJECT>>>
|
||||
<SETG OBJECTS (.OBJ !,OBJECTS)>
|
||||
.OBJ)>>
|
||||
|
||||
<DEFINE GET-ROOM (ID "AUX" ROOM)
|
||||
#DECL ((ID) <OR ATOM STRING> (VALUE) ROOM (ROOM) ROOM)
|
||||
<COND (<PLOOKUP .ID ,ROOM-POBL>)
|
||||
(<PINSERT .ID
|
||||
,ROOM-POBL
|
||||
<SET ROOM
|
||||
<CHTYPE <VECTOR <PSTRING .ID>
|
||||
,NULL-DESC
|
||||
,NULL-DESC
|
||||
,NULL-EXIT
|
||||
()
|
||||
<>
|
||||
0
|
||||
()>
|
||||
ROOM>>>
|
||||
<SETG ROOMS (.ROOM !,ROOMS)>
|
||||
.ROOM)>>
|
||||
324
src/zork/melee.137
Normal file
324
src/zork/melee.137
Normal file
@@ -0,0 +1,324 @@
|
||||
|
||||
"
|
||||
0 -- attacker misses
|
||||
1 -- defender unconscious
|
||||
2 -- defender dead
|
||||
3 -- defender lightly wounded
|
||||
4 -- defender seriously wounded
|
||||
5 -- staggered
|
||||
6 -- loses weapon
|
||||
7 -- hesitate (miss on free swing)
|
||||
8 -- sitting duck (crunch!)
|
||||
"
|
||||
|
||||
<MSETG MISSED 0>
|
||||
|
||||
<MSETG UNCONSCIOUS 1>
|
||||
|
||||
<MSETG KILLED 2>
|
||||
|
||||
<MSETG LIGHT-WOUND 3>
|
||||
|
||||
<MSETG SERIOUS-WOUND 4>
|
||||
|
||||
<MSETG STAGGER 5>
|
||||
|
||||
<MSETG LOSE-WEAPON 6>
|
||||
|
||||
<MSETG HESITATE 7>
|
||||
|
||||
<MSETG SITTING-DUCK 8>
|
||||
|
||||
<SETG STRENGTH-MAX 7>
|
||||
|
||||
<SETG STRENGTH-MIN 2>
|
||||
|
||||
<SETG CURE-WAIT 30>
|
||||
|
||||
<GDECL (DEF1-RES DEF2-RES DEF3-RES)
|
||||
<UVECTOR [REST UVECTOR]>
|
||||
(DEF1 DEF2A DEF2B DEF3A DEF3B DEF3C)
|
||||
<UVECTOR [REST FIX]>
|
||||
(OPPV) VECTOR
|
||||
(VILLAINS) <LIST [REST OBJECT]>
|
||||
(VILLAIN-PROBS) <UVECTOR [REST FIX]>
|
||||
(STRENGTH-MIN STRENGTH-MAX CURE-WAIT) FIX>
|
||||
|
||||
|
||||
<DEFINE FIGHTING (FROB "AUX" (HERE ,HERE) (OPPS ,OPPV) (HERO ,PLAYER) (FIGHT? <>)
|
||||
RANDOM-ACTION (THIEF <SFIND-OBJ "THIEF">))
|
||||
#DECL ((FROB) HACK (OPPS) <VECTOR [REST <OR OBJECT FALSE>]> (HERO) ADV
|
||||
(HERE) ROOM (FIGHT?) <OR ATOM FALSE> (THIEF) OBJECT
|
||||
(RANDOM-ACTION) <OR ATOM NOFFSET FALSE>)
|
||||
<COND
|
||||
(<AND ,PARSE-WON <NOT ,DEAD!-FLAG>>
|
||||
<MAPR <>
|
||||
<FUNCTION (OO OV VOUT "AUX" (O <1 .OO>) (S <OSTRENGTH .O>))
|
||||
#DECL ((OO) <LIST [REST OBJECT]> (OV) VECTOR
|
||||
(VOUT) <UVECTOR [REST FIX]> (O) OBJECT (S) FIX)
|
||||
<PUT .OV 1 <>>
|
||||
<SET RANDOM-ACTION <OACTION .O>>
|
||||
<COND (<==? .HERE <OROOM .O>>
|
||||
<COND (<AND <==? .O .THIEF>
|
||||
,THIEF-ENGROSSED!-FLAG>
|
||||
<SETG THIEF-ENGROSSED!-FLAG <>>)
|
||||
(<L? .S 0>
|
||||
<COND (<AND <NOT <0? <1 .VOUT>>>
|
||||
<PROB <1 .VOUT>
|
||||
</ <+ <1 .VOUT> 100> 2>>>
|
||||
<OSTRENGTH .O <- .S>>
|
||||
<PUT .VOUT 1 0>
|
||||
<AND .RANDOM-ACTION
|
||||
<PERFORM .RANDOM-ACTION
|
||||
<FIND-VERB "IN!">>>)
|
||||
(<PUT .VOUT 1 <+ <1 .VOUT> 10>>)>)
|
||||
(<TRNN .O ,FIGHTBIT>
|
||||
<SET FIGHT? T>
|
||||
<PUT .OV 1 .O>)
|
||||
(.RANDOM-ACTION
|
||||
<COND (<PERFORM .RANDOM-ACTION <FIND-VERB "1ST?">>
|
||||
<SET FIGHT? T>
|
||||
<TRO .O ,FIGHTBIT>
|
||||
<SETG PARSE-CONT <>>
|
||||
<PUT .OV 1 .O>)>)>)
|
||||
(<N==? .HERE <OROOM .O>>
|
||||
<COND (<TRNN .O ,FIGHTBIT>
|
||||
<COND (.RANDOM-ACTION
|
||||
<PERFORM .RANDOM-ACTION <FIND-VERB "FGHT?">>)>)>
|
||||
<AND <==? .O .THIEF>
|
||||
<SETG THIEF-ENGROSSED!-FLAG <>>>
|
||||
<ATRZ .HERO ,ASTAGGERED>
|
||||
<TRZ .O ,STAGGERED>
|
||||
<TRZ .O ,FIGHTBIT>
|
||||
<COND (<L? .S 0>
|
||||
<OSTRENGTH .O <- .S>>
|
||||
<COND (.RANDOM-ACTION
|
||||
<PERFORM .RANDOM-ACTION <FIND-VERB "IN!">>)>)>)>>
|
||||
,VILLAINS
|
||||
.OPPS
|
||||
,VILLAIN-PROBS>
|
||||
<COND (.FIGHT?
|
||||
<CLOCK-INT ,CURIN>
|
||||
<REPEAT ((OUT <>) RES)
|
||||
#DECL ((OUT) <OR FIX FALSE> (RES) <OR FIX FALSE>)
|
||||
<COND (<MAPF <>
|
||||
<FUNCTION (O)
|
||||
#DECL ((O) <OR OBJECT FALSE>)
|
||||
<COND (<NOT .O>)
|
||||
(<AND <SET RANDOM-ACTION <OACTION .O>>
|
||||
<PERFORM .RANDOM-ACTION <FIND-VERB "FGHT?">>>)
|
||||
(<NOT <SET RES
|
||||
<BLOW .HERO .O <OFMSGS .O> <> .OUT>>>
|
||||
<MAPLEAVE <>>)
|
||||
(<==? .RES ,UNCONSCIOUS>
|
||||
<SET OUT <+ 2 <MOD <RANDOM> 3>>>)
|
||||
(T)>>
|
||||
.OPPS>
|
||||
<COND (<NOT .OUT> <RETURN>)
|
||||
(<0? <SET OUT <- .OUT 1>>> <RETURN>)>)
|
||||
(ELSE <RETURN>)>>)>)>>
|
||||
|
||||
<DEFINE PRES (TAB A D W "AUX" (L <LENGTH .TAB>))
|
||||
#DECL ((TAB) <UVECTOR [REST VECTOR]> (A D) STRING
|
||||
(W) <OR STRING FALSE>)
|
||||
<MAPF <>
|
||||
<FUNCTION (S)
|
||||
<COND (<TYPE? .S STRING> <TELL .S 0>)
|
||||
(<TYPE? .S ATOM>
|
||||
<COND (<==? .S A> <TELL .A 0>)
|
||||
(<==? .S D> <TELL .D 0>)
|
||||
(<AND .W <==? .S W>> <TELL .W 0>)>)>>
|
||||
<NTH .TAB <+ 1 <MOD <RANDOM> .L>>>>
|
||||
<TELL "" 1>>
|
||||
|
||||
"The <MAX 1 ...> is strictly a patch, to keep the thing from dying. I doubt
|
||||
it's the right thing.--taa"
|
||||
"It wasn't."
|
||||
|
||||
<DEFINE FIGHT-STRENGTH (HERO "OPTIONAL" (ADJUST? T)
|
||||
"AUX" S (SMAX ,STRENGTH-MAX) (SMIN ,STRENGTH-MIN))
|
||||
#DECL ((HERO) ADV (S SMAX SMIN VALUE) FIX (ADJUST?) <OR ATOM FALSE>)
|
||||
<SET S
|
||||
<+ .SMIN
|
||||
<FIX <+ .5
|
||||
<* <- .SMAX .SMIN>
|
||||
</ <FLOAT <ASCORE .HERO>>
|
||||
<FLOAT ,SCORE-MAX>>>>>>>
|
||||
<COND (.ADJUST? <+ .S <ASTRENGTH .HERO>>)(ELSE .S)>>
|
||||
|
||||
<DEFINE VILLAIN-STRENGTH (VILLAIN
|
||||
"AUX" (OD <OSTRENGTH .VILLAIN>) WV)
|
||||
#DECL ((VILLAIN) OBJECT (WV) <OR FALSE VECTOR>
|
||||
(OD VALUE) FIX)
|
||||
<COND (<G=? .OD 0>
|
||||
<COND (<AND <==? .VILLAIN <SFIND-OBJ "THIEF">>
|
||||
,THIEF-ENGROSSED!-FLAG>
|
||||
<SET OD <MIN .OD 2>>
|
||||
<SETG THIEF-ENGROSSED!-FLAG <>>)>
|
||||
<COND (<AND <NOT <EMPTY? <PRSI>>>
|
||||
<TRNN <PRSI> ,WEAPONBIT>
|
||||
<SET WV <MEMQ .VILLAIN ,BEST-WEAPONS>>
|
||||
<==? <2 .WV> <PRSI>>>
|
||||
<SET OD <MAX 1 <- .OD <3 .WV>>>>)>)>
|
||||
.OD>
|
||||
|
||||
<GDECL (CURIN) CEVENT (BEST-WEAPONS) <VECTOR [REST OBJECT OBJECT FIX]>>
|
||||
|
||||
<DEFINE BLOW (HERO VILLAIN REMARKS HERO? OUT?
|
||||
"AUX" DWEAPON (VDESC <ODESC2 .VILLAIN>) ATT DEF OA OD TBL RES
|
||||
NWEAPON RANDOM-ACTION)
|
||||
#DECL ((HERO) ADV (VILLAIN) OBJECT (DWEAPON NWEAPON) <OR OBJECT FALSE>
|
||||
(RES OA OD ATT DEF FIX) FIX (REMARKS) <UVECTOR [REST UVECTOR]>
|
||||
(HERO?) <OR ATOM FALSE> (VDESC) STRING (TBL) <UVECTOR [REST FIX]>
|
||||
(OUT?) <OR FIX FALSE> (RANDOM-ACTION) <OR ATOM FALSE NOFFSET>)
|
||||
<PROG ()
|
||||
<COND (.HERO?
|
||||
<TRO .VILLAIN ,FIGHTBIT>
|
||||
<COND (<ATRNN .HERO ,ASTAGGERED>
|
||||
<TELL
|
||||
"You are still recovering from that last blow, so your attack is
|
||||
ineffective.">
|
||||
<ATRZ .HERO ,ASTAGGERED>
|
||||
<RETURN>)>
|
||||
<SET OA <SET ATT <MAX 1 <FIGHT-STRENGTH .HERO>>>>
|
||||
<COND (<0? <SET OD <SET DEF <VILLAIN-STRENGTH .VILLAIN>>>>
|
||||
<COND (<==? .VILLAIN <SFIND-OBJ "#####">>
|
||||
<RETURN <JIGS-UP
|
||||
"Well, you really did it that time. Is suicide painless?">>)>
|
||||
<TELL "Attacking the " 1 .VDESC " is pointless.">
|
||||
<RETURN>)>
|
||||
<SET DWEAPON
|
||||
<AND <NOT <EMPTY? <OCONTENTS .VILLAIN>>>
|
||||
<1 <OCONTENTS .VILLAIN>>>>)
|
||||
(ELSE
|
||||
<SETG PARSE-CONT <>>
|
||||
<COND (<ATRNN .HERO ,ASTAGGERED> <ATRZ .HERO ,ASTAGGERED>)>
|
||||
<COND (<TRNN .VILLAIN ,STAGGERED>
|
||||
<TELL "The "
|
||||
1
|
||||
.VDESC
|
||||
" slowly regains his feet.">
|
||||
<TRZ .VILLAIN ,STAGGERED>
|
||||
<RETURN 0>)>
|
||||
<SET OA <SET ATT <VILLAIN-STRENGTH .VILLAIN>>>
|
||||
<COND (<L=? <SET DEF <FIGHT-STRENGTH .HERO>> 0> <RETURN>)>
|
||||
<SET OD <FIGHT-STRENGTH .HERO <>>>
|
||||
<SET DWEAPON <FWIM ,WEAPONBIT <AOBJS .HERO> T>>)>
|
||||
<COND (<L? .DEF 0>
|
||||
<COND (.HERO?
|
||||
<TELL "The unconscious " 1 .VDESC
|
||||
" cannot defend himself: He dies.">)>
|
||||
<SET RES ,KILLED>)
|
||||
(ELSE
|
||||
<COND (<1? .DEF>
|
||||
<COND (<G? .ATT 2> <SET ATT 3>)>
|
||||
<SET TBL <NTH ,DEF1-RES .ATT>>)
|
||||
(<==? .DEF 2>
|
||||
<COND (<G? .ATT 3> <SET ATT 4>)>
|
||||
<SET TBL <NTH ,DEF2-RES .ATT>>)
|
||||
(<G? .DEF 2>
|
||||
<SET ATT <- .ATT .DEF>>
|
||||
<COND (<L? .ATT -1> <SET ATT -2>)
|
||||
(<G? .ATT 1> <SET ATT 2>)>
|
||||
<SET TBL <NTH ,DEF3-RES <+ .ATT 3>>>)>
|
||||
<SET RES <NTH .TBL <+ 1 <MOD <RANDOM> 9>>>>
|
||||
<COND (.OUT?
|
||||
<COND (<==? .RES ,STAGGER> <SET RES ,HESITATE>)
|
||||
(ELSE <SET RES ,SITTING-DUCK>)>)>
|
||||
<COND (<AND <==? .RES ,STAGGER>
|
||||
.DWEAPON
|
||||
<PROB 25 <COND (.HERO? 10)(ELSE 50)>>>
|
||||
<SET RES ,LOSE-WEAPON>)>
|
||||
<PRES <NTH .REMARKS <+ .RES 1>>
|
||||
<COND (.HERO? "Adventurer") (ELSE .VDESC)>
|
||||
<COND (.HERO? .VDESC) (ELSE "Adventurer")>
|
||||
<AND .DWEAPON <ODESC2 .DWEAPON>>>)>
|
||||
<COND (<OR <==? .RES ,MISSED> <==? .RES ,HESITATE>>)
|
||||
(<==? .RES ,UNCONSCIOUS>
|
||||
<COND (.HERO? <SET DEF <- .DEF>>)>)
|
||||
(<OR <==? .RES ,KILLED> <==? .RES ,SITTING-DUCK>> <SET DEF 0>)
|
||||
(<==? .RES ,LIGHT-WOUND> <SET DEF <MAX 0 <- .DEF 1>>>)
|
||||
(<==? .RES ,SERIOUS-WOUND> <SET DEF <MAX 0 <- .DEF 2>>>)
|
||||
(<==? .RES ,STAGGER>
|
||||
<COND (.HERO? <TRO .VILLAIN ,STAGGERED>)
|
||||
(ELSE <ATRO .HERO ,ASTAGGERED>)>)
|
||||
(<AND <==? .RES ,LOSE-WEAPON> .DWEAPON>
|
||||
<COND (.HERO?
|
||||
<REMOVE-OBJECT .DWEAPON>
|
||||
<INSERT-OBJECT .DWEAPON ,HERE>)
|
||||
(ELSE
|
||||
<DROP-OBJECT .DWEAPON .HERO>
|
||||
<INSERT-OBJECT .DWEAPON ,HERE>
|
||||
<COND (<SET NWEAPON <FWIM ,WEAPONBIT <AOBJS .HERO> T>>
|
||||
<TELL
|
||||
"Fortunately, you still have a " 1 <ODESC2 .NWEAPON> ".">)>)>)
|
||||
(ELSE <ERROR MELEE "CHOMPS" .RES .HERO? .ATT .DEF .TBL>)>
|
||||
<COND (<NOT .HERO?>
|
||||
<PUT .HERO ,ASTRENGTH <COND (<0? .DEF> -10000)(<- .DEF .OD>)>>
|
||||
<COND (<L? <- .DEF .OD> 0>
|
||||
<CLOCK-ENABLE ,CURIN>
|
||||
<PUT ,CURIN ,CTICK ,CURE-WAIT>)>
|
||||
<COND (<L=? <FIGHT-STRENGTH .HERO> 0>
|
||||
<PUT .HERO ,ASTRENGTH <+ 1 <- <FIGHT-STRENGTH .HERO <>>>>>
|
||||
<JIGS-UP
|
||||
"It appears that that last blow was too much for you. I'm afraid you
|
||||
are dead.">
|
||||
<>)
|
||||
(.RES)>)
|
||||
(ELSE
|
||||
<OSTRENGTH .VILLAIN .DEF>
|
||||
<COND (<0? .DEF>
|
||||
<TRZ .VILLAIN ,FIGHTBIT>
|
||||
<TELL
|
||||
"Almost as soon as the " ,LONG-TELL .VDESC " breathes his last breath, a cloud
|
||||
of sinister black fog envelops him, and when the fog lifts, the
|
||||
carcass has disappeared.">
|
||||
<REMOVE-OBJECT .VILLAIN>
|
||||
<COND (<SET RANDOM-ACTION <OACTION .VILLAIN>>
|
||||
<PERFORM .RANDOM-ACTION <FIND-VERB "DEAD!">>)>
|
||||
<TELL "">
|
||||
.RES)
|
||||
(<==? .RES ,UNCONSCIOUS>
|
||||
<COND (<SET RANDOM-ACTION <OACTION .VILLAIN>>
|
||||
<PERFORM .RANDOM-ACTION <FIND-VERB "OUT!">>)>
|
||||
.RES)
|
||||
(.RES)>)>>>
|
||||
|
||||
<DEFINE WINNING? (V H "AUX" (VS <OSTRENGTH .V>) (PS <- .VS <FIGHT-STRENGTH .H>>))
|
||||
#DECL ((V) OBJECT (H) ADV (VS PS) FIX)
|
||||
<COND (<G? .PS 3> <PROB 90 100>)
|
||||
(<G? .PS 0> <PROB 75 85>)
|
||||
(<0? .PS> <PROB 50 30>)
|
||||
(<G? .VS 1> <PROB 25>)
|
||||
(ELSE <PROB 10 0>)>>
|
||||
|
||||
<DEFINE CURE-CLOCK ("AUX" (HERO ,PLAYER) (S <ASTRENGTH .HERO>) (I ,CURIN))
|
||||
#DECL ((HERO) ADV (S) FIX (I) CEVENT)
|
||||
<COND (<G? .S 0> <PUT .HERO ,ASTRENGTH <SET S 0>>)
|
||||
(<L? .S 0> <PUT .HERO ,ASTRENGTH <SET S <+ .S 1>>>)>
|
||||
<COND (<L? .S 0> <PUT .I ,CTICK ,CURE-WAIT>)
|
||||
(ELSE <CLOCK-DISABLE .I>)>>
|
||||
|
||||
<DEFINE DIAGNOSE ("AUX" (W ,WINNER) (MS <FIGHT-STRENGTH .W <>>)
|
||||
(WD <ASTRENGTH .W>) (RS <+ .MS .WD>) (I <CTICK ,CURIN>))
|
||||
#DECL ((W) ADV (MS WD RD I) FIX)
|
||||
<COND (<NOT <CFLAG ,CURIN>>
|
||||
<SET WD 0>)
|
||||
(<SET WD <- .WD>>)>
|
||||
<COND (<0? .WD> <TELL "You are in perfect health.">)
|
||||
(<1? .WD> <TELL "You have a light wound," 0>)
|
||||
(<==? .WD 2> <TELL "You have a serious wound," 0>)
|
||||
(<==? .WD 3> <TELL "You have several wounds," 0>)
|
||||
(<G? .WD 3> <TELL "You have serious wounds," 0>)>
|
||||
<COND (<NOT <0? .WD>>
|
||||
<TELL " which will be cured after " 0>
|
||||
<PRINC <+ <* ,CURE-WAIT <- .WD 1>> .I>>
|
||||
<TELL " moves.">)>
|
||||
<COND (<0? .RS> <TELL "You are at death's door.">)
|
||||
(<1? .RS> <TELL "You can be killed by one more light wound.">)
|
||||
(<==? .RS 2> <TELL "You can be killed by a serious wound.">)
|
||||
(<==? .RS 3> <TELL "You can survive one serious wound.">)
|
||||
(<G? .RS 3> <TELL "You are strong enough to take several wounds.">)>
|
||||
<COND (<NOT <0? ,DEATHS>>
|
||||
<TELL "You have been killed " 1 <COND (<1? ,DEATHS> "once.")
|
||||
(T "twice.")>>)>>
|
||||
1021
src/zork/parser.130
Normal file
1021
src/zork/parser.130
Normal file
File diff suppressed because it is too large
Load Diff
67
src/zork/points.txt
Normal file
67
src/zork/points.txt
Normal file
@@ -0,0 +1,67 @@
|
||||
DUNGEON POINTS LIST
|
||||
|
||||
I. Treasures.
|
||||
Total=trophy,find
|
||||
|
||||
brass bauble (brought by Bird) 2= 1, 1 **
|
||||
grail (in Grail Room) 7= 5, 2
|
||||
clockwork canary (in Egg in Up a Tree) 8= 2, 6 **
|
||||
sapphire bracelet (in Gas Room) 8= 3, 5
|
||||
jewel-encrusted egg (in Up a Tree) 10= 5, 5 **
|
||||
tin of spices (in Pool Room) 10= 5, 5
|
||||
jade figurine (in Bat Room) 10= 5, 5
|
||||
gold coffin (in Egypt Room) 10= 7, 3
|
||||
painting (in Gallery) 11= 7, 4
|
||||
crystal sphere (in Dingy Closet) 12= 6, 6
|
||||
stamp (in Purple Book in Library) 14= 10, 4
|
||||
pearl necklace (in Pearl Room) 14= 5, 9
|
||||
blue palantir (in Dreary Room) 15= 5,10 **
|
||||
red palantir (in Coal Chute) 15= 5,10 **
|
||||
emerald (in Buoy in Frigid River) 15= 10, 5
|
||||
portrait (in Chairman's Office) 15= 5,10 **
|
||||
crystal trident (in Atlantis Room) 15= 11, 4
|
||||
bag of coins (in Maze) 15= 5,10
|
||||
diamond (made from Coal in Machine) 16= 6,10
|
||||
violin (in Steel Box in Round Room) 20= 10,10
|
||||
pot of gold (at End of Rainbow) 20= 10,10
|
||||
torch (in Torch Room) 20= 6,14
|
||||
chalice (in Treasure Room) 20= 10,10
|
||||
priceless zorkmid (on Narrow Ledge) 22= 12,10
|
||||
platinum bar (in Loud Room) 22= 10,12
|
||||
statue (in Sandy Beach) 23= 13,10
|
||||
ruby (in Ruby Room; behind Glacier) 23= 8,15
|
||||
trunk with jewels (under Reservior) 23= 8,15
|
||||
crown (in Safe in Dusty Room) 25= 10,15
|
||||
gold card (in Puzzle) 25= 15,10 **
|
||||
zorkmid bills (in Vault) 25= 15,10 **
|
||||
---
|
||||
Treasures Subtotal 490
|
||||
|
||||
** Treasures added since first Decus release
|
||||
|
||||
II. Accomplishments.
|
||||
|
||||
Getting into Kitchen (Window) 10
|
||||
Getting into Cellar (Trap Door) 25
|
||||
Getting past Cyclops (Odysseus) 10
|
||||
Getting into Thief's Treasure Room 25
|
||||
Getting past Troll (E-W Passage) 5
|
||||
Land of Living Dead (Exorcism) 30
|
||||
Top of Well 10
|
||||
Light Shaft 10
|
||||
---
|
||||
Accompishments Subtotal 125
|
||||
|
||||
---
|
||||
Grand Total 615
|
||||
|
||||
III. End Game.
|
||||
|
||||
Crypt 5*
|
||||
Top of Stairs 10*
|
||||
Into Mirror 15*
|
||||
Dungeon Entrance (Past Guardians) 15*
|
||||
Narrow Corridor (Past Dungeon Master) 20*
|
||||
Treasury 35*
|
||||
---
|
||||
100*
|
||||
307
src/zork/ppaper.txt
Normal file
307
src/zork/ppaper.txt
Normal file
@@ -0,0 +1,307 @@
|
||||
(c) Copyright 1979, Massachusetts Institute of Technology. All rights reserved.
|
||||
|
||||
Parser Paper
|
||||
|
||||
This paper is intended as a rather technical description of the Zork
|
||||
parser, with particular emphasis on the actual algorithm and mechanics
|
||||
of parsing an english command. The method is quite specific to the task
|
||||
and is not very 'elegant'; it nonetheless meets the two basic
|
||||
requirements for a game of this type: the ability to understand a
|
||||
moderately complex sentence, and fast response. The parser itself is a
|
||||
rather small piece of code, considering the assortment of command
|
||||
syntaxes that it is called upon to parser. As can be from a small
|
||||
amount of game playing, the parser is Much (perhaps most) of the code
|
||||
in the parser deals with matters peripheral to the central task of
|
||||
parsing; however, these 'peripherals' in fact make the parser, and
|
||||
therefore the game, much more pleasant to use. These peripherals
|
||||
include the use of 'memory frames' and defaulting, both of which will be
|
||||
discused below.
|
||||
|
||||
The Zork parser can understand the following sentence: 'Put all of
|
||||
the valuables except the torch and the coin into the trophy case'. That
|
||||
may indeed be impressive, but it belies the fact that the Zork parser
|
||||
is actually a three-word parser: its 'output' is a structure which
|
||||
contains at most a verb and two nouns (objects in the game) and in the
|
||||
simplest case only a verb. The parser's job then is to take a possibly
|
||||
complex set of words and distill them into a small and managable size.
|
||||
The actual parsing is an iterative procedure involving a number of mostly
|
||||
unrelated processing (that is, there is very little 'communication'
|
||||
between the modules). This does not mean that this is the preferable
|
||||
way of parsing; indeed, it causes the parser appear less than intelligent
|
||||
in a number of cases, as will be seen below. The modules in the parser
|
||||
perform the following tasks and each will be discussed in turn:
|
||||
|
||||
1) Making words from the input stream,
|
||||
2) Making verbs and noun clauses out of the words,
|
||||
3) Defaulting from previous inputs, if needed (memory frames),
|
||||
4) Matching the verbs and noun clauses with known syntaxes (this
|
||||
may include doing defaulting and using memory frames), and
|
||||
5) Performing various housekeeping chores.
|
||||
|
||||
The simplest of the modules is the first. All of the characters
|
||||
in the input stream are examined looking for word breaks and each word
|
||||
as it is found is truncated to five characters (a restriction imposed
|
||||
by space limitations; each word is one PDP-10 machine word, i.e. 36 bits).
|
||||
Commas are replaced by the word 'AND' and periods are replaced by the
|
||||
word 'THEN'. These are used for separating multiple objects (e.g. 'Take
|
||||
the knife, sword, and the matchbook') and in separating multiple commands
|
||||
in one command line (e.g. 'North. East. Open the window. Go in.),
|
||||
respectively.
|
||||
|
||||
The second phase is the one in which the actual verbs and noun clauses
|
||||
of the sentence are found. Essentially, this phase is a single loop
|
||||
through all of the words in each logical command which is terminated
|
||||
either by an end of line specifier (the null string) or by the word
|
||||
'THEN'. Each word is examined in the following manner:
|
||||
|
||||
1) If no verb has been specified and the word is in the verb
|
||||
dictionary, make that word the current verb.
|
||||
2) If no verb has been specified and the word is in the directions
|
||||
dictionary, the command is assumed to be movement in that
|
||||
direction. The entire parse completes immediately. This
|
||||
makes movement commands parse very quickly, which is important
|
||||
in a game in which most of the coomands are movements.
|
||||
3) If the word is in the adjectives dictionary, that word is made
|
||||
the current adjective, regardless of whether other adjectives
|
||||
have been given previously. This allows a sentence like
|
||||
'Take the burned-out useless lantern' to work. Note also
|
||||
that 'Take the green nasty square burned-out useless lantern'
|
||||
will also work and that 'Take the burned-out useless green
|
||||
nasty square' lantern will not, assuming that only burned-out
|
||||
and useless are legal adjectives for the lantern.
|
||||
4) If the word is in the prepositions dictionary, that word is
|
||||
made the current preposition, unless a preposition has
|
||||
already been given, in which case others are ignored. This
|
||||
allows 'Get out of the boat' to work. Also, 'Get out down
|
||||
under of with to for the boat' will also work. The point
|
||||
of the previous two examples (here and 3 above) is that
|
||||
the parser is more interested in finding something that can
|
||||
parse than in correcting silly sentences. This don't-care
|
||||
approach provides for some of the parser's speed.
|
||||
5) If the word is in the 'buzzword' dictionary, it is ignored.
|
||||
Buzzwords include A, THE, IS, etc. For the final silly but
|
||||
parsable input, try out the following:
|
||||
'The put a the is large small clean rusty the knife is in with
|
||||
down under for the a blue orange gold trophy case'.
|
||||
Interpretation:
|
||||
'Put the rusty knife in the trophy case'
|
||||
The moral is: Most people will not expect the former to work
|
||||
and thus will not try it. Thus, there is no harm done in
|
||||
providing the optimization of simply ignoring those cases.
|
||||
6) If the word is in the objects dictionary, the fun begins, as
|
||||
described below.
|
||||
7) Otherwise the word is unknown, the parser prints 'I don't
|
||||
know the word <unknown word>', and the parse ends abruptly.
|
||||
|
||||
When an object name is specified the parser tries to fill one of the
|
||||
maximum two slots which the parser allows for objects. If more than two
|
||||
objects are specified in a command, the parse ends in error. The method
|
||||
for finding an object from its name is rather more compicated than it
|
||||
would seem. This is because the parser must decide which objects, from
|
||||
among all of the objects in the game, can be referenced legally at
|
||||
any given time, and then decide which object matches a given description
|
||||
uniquely from those possibilities. Here's what it does:
|
||||
|
||||
First, it attempts to find the unique object represented by the
|
||||
input which can be found in the current environment. To this end, a
|
||||
routine called 'GET-OBJECT' is called with the object name and the
|
||||
current adjective. GET-OBJECT tries to find an object matching those
|
||||
specifications and which is available in the current environment (i.e.
|
||||
room). In so doing, it checks the possessions of the player, the
|
||||
contents of the room, and the current 'global' objects. The latter
|
||||
consist of 'global global' objects, which are defined to always be
|
||||
available (e.g. parts of the body, the ground) and 'local global'
|
||||
objects which may be part of the current environment (e.g. a house might
|
||||
be referenced in the various parts of the house and in the house's
|
||||
immediate surroundings). The latter type of global is specified in the
|
||||
definition of each particular room. In 'checking' these groups of
|
||||
objects, the parser enforces such restrictions as being unable to find
|
||||
an object which is inside a closed receptacle or a darkened room.
|
||||
GET-OBJECT may find more than one object which is completely specified
|
||||
in the current environment by the object name and adjective. When it
|
||||
returns with an 'ambiguity', the parse stops and the player is asked to
|
||||
disambiguate the object (e.g. saying 'Push the button' might lead to the
|
||||
reply 'Which button?' if there were more than one button present).
|
||||
Similarly, returns indicating a darkened room or the total inability to
|
||||
find a given object result in the parser giving the messages 'It's too
|
||||
dark in here to see' and 'I can't see any <adjective> <object name>
|
||||
here'. In these cases the parse is again ended prematurely.
|
||||
|
||||
Assuming that no error has occured thus far, a unique object has
|
||||
been returned by GET-OBJECT. The parser now checks for two special
|
||||
cases: multiple objects and prepositional phrases. In the first, the
|
||||
object found is appended to a group which includes all of the objects
|
||||
specified thus far within the 'AND'. If this was the first object in
|
||||
the group, a special 'AND' object is made the value of the current
|
||||
slot. In the case in which a preposition has been specified, the phrase
|
||||
and object are joined into a structure called, unsurprisingly, a phrase,
|
||||
which is then saved into the current slot. This pass through the input
|
||||
continues until a command terminator is reached (end of line or the word
|
||||
'THEN'). If the command terminator is the word 'THEN', a pointer to
|
||||
the remainder of the is saved in order that processing can continue after
|
||||
the current command is processed.
|
||||
|
||||
The third phase of parsing is a simple-minded attempt to use the
|
||||
parser's 'memory frames' to supply those parts of a command which are
|
||||
absolutely required for further processing (e.g. a verb) and to cause
|
||||
dangling prepositions and adjectives to be examined. This phase is
|
||||
again iterative, performing the following checks in turn:
|
||||
|
||||
1. If there is no verb, try to find one in 'memory'. If unable
|
||||
to, give an error message and save whatever input has been
|
||||
processed. For example, if the input were 'THE BOTTLE' and
|
||||
no verb was specified or is in 'memory', the parser will ask
|
||||
'What should I do with the bottle?' and save in 'memory' the
|
||||
object representing the word 'BOTTLE'. This provides the
|
||||
mechanism for the player being able to respond 'OPEN IT'.
|
||||
How this is done will be discussed later.
|
||||
|
||||
2. If there is a preposition in 'memory' and the last object
|
||||
specified is not already part of a phrase, the preposition
|
||||
is joined with the object to make a phrase. Since this
|
||||
might cause an inappropriate use of 'memory' in a fully
|
||||
specified sentence, a check is also made to insure that
|
||||
if a verb was specified in the current input, that the
|
||||
same verb was the one saved in 'memory'.
|
||||
|
||||
3. If there is a dangling preposition in the input and the
|
||||
last object specified is not part of a phrase, a phrase
|
||||
is constructed from the two. This enables 'Turn the lamp off'
|
||||
to be 'turned into' 'Turn off the lamp'.
|
||||
|
||||
The fourth phase of parsing now begins: that of syntax checking.
|
||||
In order to discuss what syntax checking entails, the definition of
|
||||
a syntax must be described. In the simplest case, a syntax definition
|
||||
might look like:
|
||||
|
||||
Verb DIRECT: [OBJ [ACTION-SPECIFICATION]]
|
||||
|
||||
The 'OBJ' specifies that any object is legal for the verb and ACTION-
|
||||
SPECIFICATION refers to the verb routine which will be called if this
|
||||
syntax is used. This verb, then, takes only a direct object. Similarly,
|
||||
a verb which takes both a direct and indirect object might look like:
|
||||
|
||||
Verb BOTH: [OBJ OBJ [ACTION-SPECIFICATION]]
|
||||
|
||||
Note that each item before the action specification refers to one
|
||||
object which may be specified in the syntax. Prepositions can now be
|
||||
added to the syntax definition by placing the desired one appropriately.
|
||||
The following are plausible definitions for the verbs 'put' and 'pick'.
|
||||
They describe the syntaxes 'Put something in something' and 'Pick up
|
||||
something', respectively.
|
||||
|
||||
Verb PUT: [OBJ "IN" OBJ [ACTION-PUT]]
|
||||
Verb PICK: ["UP" OBJ [ACTION-TAKE]]
|
||||
|
||||
Most Zork verbs have more than one possible syntax. Thus, a verb
|
||||
is defined to have an arbitrary number of these syntaxes. As an example,
|
||||
the verb 'turn' might look like this:
|
||||
|
||||
Verb TURN: ["ON" OBJ [ACTION-LIGHT]]
|
||||
["OFF" OBJ [ACTION-EXTINGUISH]]
|
||||
[OBJ "WITH" OBJ [ACTION-TURN]]
|
||||
[OBJ "TO" OBJ [ACTION-SET]]
|
||||
|
||||
This defines four different syntaxes for the verb 'turn'. Note that
|
||||
each syntax describes a different action routine. If the player types
|
||||
'Turn off lamp', the EXTINGUISH routine will be called, etc. With this
|
||||
brief introduction to syntax definition, it is possible to describe the
|
||||
step of syntax checking.
|
||||
|
||||
In the simplest case, syntax checking is a loop through all of the
|
||||
possible syntaxes for a given verb and seeing if there is an exact match.
|
||||
For example, if the player typed 'Turn the bolt with the knife' the parser
|
||||
would, by syntax checking time, have the following output:
|
||||
|
||||
[<verb TURN> <object: BOLT> <phrase: WITH KNIFE>]
|
||||
|
||||
Were the proper syntaxes for 'turn' those desribed above, the second
|
||||
of them would be seen as a match and the action TURN would be
|
||||
selected. The simple case is sufficient to demonstrate this parser module
|
||||
in overview. What actually happens is this:
|
||||
|
||||
Each syntax for the given verb is taken and compared to the parser's
|
||||
current output, one 'slot' at a time. In the given example, the first
|
||||
'slot' is <object: BOLT> and the second, <phrase: WITH KNIFE>. If the
|
||||
first slot matches the current syntax, the second is checked. If the
|
||||
second also matches, syntax checking is finished and the appropriate
|
||||
action is selected. Otherwise, the following strategy is invoked:
|
||||
|
||||
1st 2nd Action
|
||||
--- --- ------
|
||||
Match Match Above case, works immediately
|
||||
Match Non-match Go to next syntax
|
||||
Match None given Hold onto this syntax as a possibility.
|
||||
If none better come along, save this
|
||||
possibility in a 'memory frame' and
|
||||
ask the player to supply it.
|
||||
|
||||
Non-match 1st slot Try putting the first slot into the
|
||||
matches 2nd second, and hold onto this syntax as
|
||||
syntax a possibility - He might have said
|
||||
and 2nd not 'Kill with knife', meaning the troll.
|
||||
given
|
||||
|
||||
Non-match Not as above Go to next syntax
|
||||
|
||||
When this pass is completed, there are two possibilities: either
|
||||
an exact match was found, in which case the final stages of the parse
|
||||
are performed (see below) or there is some object or phrase unspecified
|
||||
in the input which is required to make a legal syntax. The following
|
||||
is then done:
|
||||
|
||||
No Held Syntax
|
||||
-> Say 'I can't make sense out of that.'
|
||||
|
||||
Held -> Each slot in the held syntax is examined. If the same
|
||||
slot in the input is not specified, two things are tried:
|
||||
|
||||
1. Find an object in a 'memory frame'
|
||||
2. Find a 'reasonable' object
|
||||
|
||||
'What', you may ask, 'is a reasonable object'. This leads directly
|
||||
into the concept of defaulting which was alluded to previously. In
|
||||
Zork, defaulting is done through additional specifications in the syntax
|
||||
definitions. As an example of how this is done, consider the following
|
||||
updated version of a previous example:
|
||||
|
||||
Verb TURN: ["OFF" <ON-property> [ACTION-EXTINGUISH]]
|
||||
|
||||
This means that rather than any object being proper in the syntax
|
||||
that specifically those objects with some 'ON' property should be
|
||||
considered when the object is not specified. In this example, if
|
||||
there were only one 'ON' object in the room, it would be chosen as
|
||||
the 'reasonable' default object. The facility for specifying a property
|
||||
in the syntax allows the parser to reject some inputs without having
|
||||
the action routines do the checking. The addition of an equals sign
|
||||
before the property specification tells the parser that the object
|
||||
specified MUST have that property. More on this feature later.
|
||||
|
||||
Assuming that none of those strategies has worked, we store
|
||||
a 'memory frame' and ask the user to provide the missing information.
|
||||
If, however, all of the objects are specified (or defaulted, or found
|
||||
in memory), the final phase of the parse is performed.
|
||||
|
||||
The final phase of parsing is the enforcement of conditions
|
||||
specified in the syntax definitions ('What, more??') as to whether
|
||||
objects specified by the player should be in his possession before
|
||||
any action is taken. This also allows action routines to do less
|
||||
'paperwork'. The possible specifications for the taking of objects
|
||||
are:
|
||||
Option Example
|
||||
------ -------
|
||||
Don't even try Take
|
||||
Try, but don't care if can't Read
|
||||
Try, and fail if can't Kill
|
||||
|
||||
The verb 'take' doesn't need to check, since that's what
|
||||
take does anyway. 'Read' would like the player to have the item
|
||||
being read, but not caring about the result allows for reading
|
||||
objects which cannot be taken (e.g. walls). The best example
|
||||
of an object which wants to already be in hand is a weapon, with
|
||||
the verb being 'Kill'. Clearly, a fighting situation is not
|
||||
conducive to stooping down to pick up the weapon and then being
|
||||
able to brandish it in one turn. Other examples from Zork can
|
||||
easily be imagined.
|
||||
|
||||
(c) Copyright 1979, Massachusetts Institute of Technology. All rights reserved.
|
||||
102
src/zork/prim.9
Normal file
102
src/zork/prim.9
Normal file
@@ -0,0 +1,102 @@
|
||||
"(c) Copyright 1978, Massachusetts Institute of Technology. All rights reserved."
|
||||
<DEFINE MSETG (FOO BAR)
|
||||
#DECL ((FOO) ATOM (BAR) ANY)
|
||||
<COND (<AND <GASSIGNED? .FOO> <N=? .BAR ,.FOO>>
|
||||
<ERROR MSETG .FOO ALREADY-GASSIGNED ,.FOO>)
|
||||
(ELSE
|
||||
<SETG .FOO .BAR>
|
||||
<MANIFEST .FOO>)>>
|
||||
|
||||
<DEFINE PSETG (FOO BAR "AUX" PL)
|
||||
#DECL ((FOO) ATOM (PL) <LIST [REST ATOM]>)
|
||||
<SETG .FOO .BAR>
|
||||
<COND (<GASSIGNED? PURE-LIST> <SET PL ,PURE-LIST>)
|
||||
(ELSE <SET PL <SETG PURE-LIST ()>>)>
|
||||
<COND (<NOT <MEMQ .FOO .PL>>
|
||||
<SETG PURE-LIST <SET PL (.FOO !.PL)>>)
|
||||
(<AND <GASSIGNED? PURE-CAREFUL> ,PURE-CAREFUL>
|
||||
<ERROR PSETG-DUPLICATE .FOO>)>
|
||||
.BAR>
|
||||
|
||||
<DEFINE FLAGWORD ("TUPLE" FS "AUX" (TOT 1) (CNT 1))
|
||||
#DECL ((FS) <TUPLE [REST <OR ATOM FALSE>]> (TOT CNT) FIX)
|
||||
<MAPF <>
|
||||
<FUNCTION (F)
|
||||
#DECL ((F) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .F ATOM>
|
||||
<COND (<NOT <LOOKUP "GROUP-GLUE" <GET INITIAL OBLIST>>>
|
||||
<MSETG .F .TOT>)>)>
|
||||
<SET TOT <* 2 .TOT>>
|
||||
<COND (<G? <SET CNT <+ .CNT 1>> 36>
|
||||
<ERROR FLAGWORD .CNT>)>>
|
||||
.FS>
|
||||
.CNT>
|
||||
|
||||
<DEFINE NEWSTRUC (NAM PRIM
|
||||
"ARGS" ELEM
|
||||
"AUX" (LL <FORM <FORM PRIMTYPE .PRIM>>) (L .LL)
|
||||
R RR (CNT 1) OFFS DEC)
|
||||
#DECL ((NAM) <OR ATOM <LIST [REST ATOM]>> (PRIM) ATOM
|
||||
(LL L RR R) <PRIMTYPE LIST>
|
||||
(CNT) FIX (OFFS DEC) ANY (ELEM) LIST)
|
||||
<REPEAT ()
|
||||
<COND (<EMPTY? .ELEM>
|
||||
<COND (<ASSIGNED? RR> <PUTREST .R (<VECTOR !.RR>)>)>
|
||||
<COND (<TYPE? .NAM ATOM>
|
||||
<COND (<LOOKUP "COMPILE" <ROOT>>
|
||||
<NEWTYPE .NAM .PRIM .LL>)
|
||||
(<NEWTYPE .NAM .PRIM>)>)
|
||||
(ELSE
|
||||
<PUT .LL 1 .PRIM>
|
||||
<EVAL <FORM GDECL .NAM .LL>>
|
||||
<SET NAM <1 .NAM>>)>
|
||||
<RETURN .NAM>)
|
||||
(<LENGTH? .ELEM 1> <ERROR NEWSTRUC>)>
|
||||
<SET OFFS <1 .ELEM>>
|
||||
<SET DEC <2 .ELEM>>
|
||||
<COND (<OR <NOT .OFFS> <TYPE? .OFFS FORM>>
|
||||
<SET CNT <+ .CNT 1>>
|
||||
<SET ELEM <REST .ELEM>>
|
||||
<AGAIN>)>
|
||||
<COND (<AND <TYPE? .OFFS STRING> <=? .OFFS "REST">>
|
||||
<AND <ASSIGNED? RR> <ERROR NEWSTRUC TWO-RESTS>>
|
||||
<SET R .L>
|
||||
<SET RR <SET L <LIST REST>>>
|
||||
<SET ELEM <REST .ELEM>>
|
||||
<AGAIN>)
|
||||
(<LOOKUP "GROUP-GLUE" <GET INITIAL OBLIST>>)
|
||||
(<TYPE? .OFFS ATOM>
|
||||
<MSETG .OFFS .CNT>)
|
||||
(<TYPE? .OFFS LIST>
|
||||
<MAPF <> <FUNCTION (A) <MSETG .A .CNT>> .OFFS>)
|
||||
(ELSE <ERROR NEWSTRUC>)>
|
||||
<SET CNT <+ .CNT 1>>
|
||||
<PUTREST .L <SET L (.DEC)>>
|
||||
<SET ELEM <REST .ELEM 2>>>>
|
||||
|
||||
"MAKE-SLOT -- define a funny slot in an object"
|
||||
|
||||
<SETG SLOTS ()>
|
||||
|
||||
<DEFINE MAKE-SLOT (NAME 'TYP 'DEF)
|
||||
#DECL ((NAME) ATOM (TYP) <OR ATOM FORM> (DEF) ANY)
|
||||
<COND
|
||||
(<OR <NOT <GASSIGNED? .NAME>>
|
||||
<AND <ASSIGNED? REDEFINE> .REDEFINE>
|
||||
<ERROR SLOT-NAME-ALREADY-USED!-ERRORS .NAME>>
|
||||
<SETG SLOTS
|
||||
(<EVAL <FORM DEFMAC
|
||||
.NAME
|
||||
'('OBJ "OPTIONAL" 'VAL)
|
||||
<FORM COND
|
||||
('<ASSIGNED? VAL>
|
||||
<FORM FORM OPUT '.OBJ .NAME '.VAL>)
|
||||
(<FORM FORM
|
||||
PROG
|
||||
'()
|
||||
<CHTYPE ('(VALUE) .TYP) DECL>
|
||||
<FORM FORM
|
||||
COND
|
||||
(<FORM FORM OGET '.OBJ .NAME>)
|
||||
(ELSE <FORM QUOTE .DEF>)>>)>>>
|
||||
!,SLOTS)>)>>
|
||||
1963
src/zork/rooms.393
Normal file
1963
src/zork/rooms.393
Normal file
File diff suppressed because it is too large
Load Diff
445
src/zork/sr.54
Normal file
445
src/zork/sr.54
Normal file
@@ -0,0 +1,445 @@
|
||||
|
||||
<SETG SAVSTR <ISTRING 5>>
|
||||
|
||||
<SETG SAVE-VERSION -1>
|
||||
|
||||
<GDECL (SAVE-VERSION) FIX (SRUV) <UVECTOR [REST FIX]>>
|
||||
|
||||
;"CONSTANTS FOR SAVE-RESTORE UVECTOR"
|
||||
|
||||
<MSETG OBJSVLN 3600>
|
||||
|
||||
;"Length of ROOMS block"
|
||||
|
||||
<MSETG RMSVLN 2000>
|
||||
|
||||
;"Length of DEMONS block"
|
||||
|
||||
<MSETG DMNSVLN 225>
|
||||
|
||||
;"Length of <HOBJS <robber>> block"
|
||||
|
||||
<MSETG HOBJSVLN 17>
|
||||
|
||||
;"Starting offset of CLOCKER slots"
|
||||
|
||||
<MSETG CEVSVOFF 20>
|
||||
|
||||
;"Length of CEVENT slots (33 CEVENTS x 3 slots)"
|
||||
|
||||
<MSETG CEVSVLN 99>
|
||||
|
||||
;"Length of ACTORs block"
|
||||
|
||||
<SETG ACTSVLN 122>
|
||||
|
||||
;"Length of WINNER block"
|
||||
|
||||
<MSETG WSVLN 22>
|
||||
|
||||
;"Length of MONAD GVAL block"
|
||||
|
||||
<MSETG MGSVLN 125>
|
||||
|
||||
;"Length of ROOM GVAL block"
|
||||
|
||||
<MSETG RMGSVLN 15>
|
||||
|
||||
;"Length of OBJECT GVAL block"
|
||||
|
||||
<MSETG OBJGSVLN 10>
|
||||
|
||||
;"# of slots for OBJECTs"
|
||||
|
||||
<MSETG PUZSVLN 164>
|
||||
|
||||
<MSETG SAVLENGTH
|
||||
<+ 1 ,OBJSVLN ,RMSVLN ,DMNSVLN ,ACTSVLN ,MGSVLN ,RMGSVLN ,OBJGSVLN ,PUZSVLN>>
|
||||
|
||||
<MSETG ORECLN 12>
|
||||
|
||||
;"# of slots for ROOMs"
|
||||
|
||||
<MSETG RRECLN 8>
|
||||
|
||||
;"# of slots for CEVENT"
|
||||
|
||||
<MSETG CRECLN 3>
|
||||
|
||||
;"Names of slots to be saved from OBJECTS"
|
||||
|
||||
<PSETG OSNAMES
|
||||
'![OID OCAN OFLAGS OROOM ORAND OFVAL OSIZE OCAPAC OLINT OMATCH
|
||||
OSTRENGTH!]>
|
||||
|
||||
;"Types of these slots (rested once)"
|
||||
|
||||
<PSETG OSTYPES '![OBJECT FIX ROOM FIX FIX FIX FIX FIX FIX FIX!]>
|
||||
|
||||
;"Names of slots to be saved from ROOMS"
|
||||
|
||||
<PSETG RSNAMES '![RID RVARS RBITS RRAND RVAL!]>
|
||||
|
||||
;"Types of these slots (rested once)"
|
||||
|
||||
<PSETG RSTYPES '![FIX WORD FIX FIX!]>
|
||||
|
||||
;"Names of slots to be saved from CEVENTS"
|
||||
|
||||
<PSETG CSNAMES '![CID CTICK CFLAG!]>
|
||||
|
||||
;"Types of these slots"
|
||||
|
||||
<PSETG CSTYPES '![FIX FIX!]>
|
||||
|
||||
<GDECL (OSNAMES RSNAMES CSNAMES OSTYPES RSTYPES CSTYPES) <UVECTOR [REST ATOM]>>
|
||||
|
||||
<DEFINE POS (OBJ LST "AUX" M)
|
||||
#DECL ((OBJ) ANY (LST) LIST (M) <OR FALSE LIST>)
|
||||
<AND <SET M <MEMQ .OBJ .LST>>
|
||||
<+ 1 <- <LENGTH .LST> <LENGTH .M>>>>>
|
||||
|
||||
; "Get the FIX code for any item."
|
||||
<GDECL (CLOCKER) HACK (CLOCK-CALLERS) LIST (ACTORS) <LIST [REST ADV]>>
|
||||
|
||||
<DEFINE SCODE (ITM "AUX" RI)
|
||||
#DECL ((ITM) ANY (RI) <VECTOR FIX CEVENT>)
|
||||
<COND (<==? .ITM T> 10223616)
|
||||
(<NOT .ITM> 2883584)
|
||||
(<TYPE? .ITM ADV> 0)
|
||||
(<TYPE? .ITM ATOM PSTRING> <ATMFIX .ITM>)
|
||||
(<==? <PRIMTYPE .ITM> WORD> <CHTYPE .ITM FIX>)
|
||||
(<TYPE? .ITM ROOM> <ATMFIX <RID .ITM>>)
|
||||
(<TYPE? .ITM OBJECT> <ATMFIX <OID .ITM>>)
|
||||
(<DECL? .ITM '<VECTOR FIX CEVENT>>
|
||||
<SET RI .ITM>
|
||||
<PUTBITS <PUTBITS 3145728
|
||||
<BITS 18 0>
|
||||
<POS <2 .RI> <HOBJS ,CLOCKER>>>
|
||||
<BITS 9 9>
|
||||
<1 .RI>>)
|
||||
(5505024)>>
|
||||
|
||||
;"Get an object from any FIX code (inverse of SCODE)"
|
||||
|
||||
<DEFINE SDECODE (FX TYP "AUX" ATM)
|
||||
#DECL ((FX) FIX (TYP) ATOM (ATM) <OR ATOM FALSE>)
|
||||
<COND (<==? .FX *47000000*>)
|
||||
(<==? .FX *13000000*> <>)
|
||||
(<==? .FX *25000000*> #FALSE (1))
|
||||
(<==? <GETBITS .FX <BITS 18 18>> #WORD *14*>
|
||||
<VECTOR <CHTYPE <GETBITS .FX <BITS 9 9>> FIX>
|
||||
<NTH <HOBJS ,CLOCKER> <CHTYPE <GETBITS .FX <BITS 9 0>> FIX>>>)
|
||||
(<==? .TYP OBJECT>
|
||||
<COND (<0? .FX> <>)
|
||||
(<FIND-OBJ <FIXSTR .FX>>)>)
|
||||
(<==? .TYP ROOM>
|
||||
<COND (<0? .FX> <>)
|
||||
(<NOT <PLOOKUP <FIXSTR .FX> ,ROOM-POBL>>
|
||||
<FIND-ROOM "FCHMP">)
|
||||
(<FIND-ROOM <FIXSTR .FX>>)>)
|
||||
(<==? .TYP CEVENT>
|
||||
<COND (<0? .FX> <>)
|
||||
(<SET ATM <LOOKUP <FIXSTR .FX> <GET INITIAL OBLIST>>>
|
||||
,.ATM)>)
|
||||
(<CHTYPE .FX .TYP>)>>
|
||||
|
||||
; "Save elements from a list of items:
|
||||
Arg 1: The code UVECTOR
|
||||
Arg 2: The list of items (e.g. ,ROOMS ,OBJECTS)
|
||||
Arg 3: Number of elements to REST off Arg 1 when finished
|
||||
Arg 4: A UVECTOR of offsets for each item to be saved
|
||||
Arg 5: The number of slots to be used for each item in the UVECTOR"
|
||||
|
||||
<DEFINE UNSAVORY-CODE (SU L OFF NUVEC RECLEN "AUX" (NU .SU))
|
||||
#DECL ((L) LIST (OFF RECLEN) FIX (SU NU) <UVECTOR [REST FIX]>
|
||||
(NUVEC) <UVECTOR [REST ATOM]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (ITM "AUX" (U .NU))
|
||||
#DECL ((ITM) <PRIMTYPE VECTOR> (U) <UVECTOR [REST FIX]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (SLT "AUX" VAL)
|
||||
#DECL ((SLT) ATOM (VAL) ANY)
|
||||
<SET VAL <SRGET .ITM .SLT>>
|
||||
<PUT .U
|
||||
1
|
||||
<SCODE .VAL>>
|
||||
<SET U <REST .U 1>>>
|
||||
.NUVEC>
|
||||
<SET NU <REST .NU .RECLEN>>>
|
||||
.L>
|
||||
<REST .SU .OFF>>
|
||||
|
||||
; "Restore elements from an object
|
||||
Arg 1: The code UVECTOR
|
||||
Arg 2: The object
|
||||
Arg 3: A UVECTOR of offsets into the object
|
||||
Arg 4: A UVECTOR of types for these offsets (ATOMs)"
|
||||
|
||||
<DEFINE UNRESTFUL-CODE (U OBJ NUVEC TUVEC "AUX" M)
|
||||
#DECL ((U) <UVECTOR [REST FIX]> (TUVEC NUVEC) <UVECTOR [REST ATOM]>
|
||||
(OBJ) <PRIMTYPE VECTOR> (M) <OR FALSE <VECTOR OBJECT ATOM ATOM>>)
|
||||
<MAPF <>
|
||||
<FUNCTION (SLT TYP "AUX" TMP)
|
||||
#DECL ((SLT TYP) ATOM)
|
||||
<COND (<OR <SET TMP <SDECODE <1 .U> .TYP>> <EMPTY? .TMP>>
|
||||
<SRPUT .OBJ .SLT .TMP>)>
|
||||
<SET U <REST .U 1>>>
|
||||
.NUVEC
|
||||
.TUVEC>>
|
||||
|
||||
<DEFINE SRGET (OBJ SLT "AUX" HOW)
|
||||
#DECL ((OBJ) <PRIMTYPE VECTOR> (SLT) ATOM (HOW) APPLICABLE)
|
||||
<COND (<AND <GASSIGNED? .SLT>
|
||||
<TYPE? <SET HOW ,.SLT> FIX>>
|
||||
<NTH .OBJ .HOW>)
|
||||
(<==? .SLT OID>
|
||||
<OID .OBJ>)
|
||||
(<OGET .OBJ .SLT>)>>
|
||||
|
||||
<DEFINE SRPUT (OBJ SLT VAL "AUX" HOW M)
|
||||
#DECL ((OBJ) <PRIMTYPE VECTOR> (SLT) ATOM (VAL) ANY (HOW) APPLICABLE
|
||||
(M) <OR FALSE <VECTOR OBJECT ATOM ATOM>>)
|
||||
<COND (<SET M <MEMQ .OBJ ,OFIXUPS>>
|
||||
<COND (<==? <2 .M> .SLT> <SET SLT <3 .M>>)>)>
|
||||
<COND (<AND <GASSIGNED? .SLT>
|
||||
<TYPE? <SET HOW ,.SLT> FIX>>
|
||||
<PUT .OBJ .HOW .VAL>)
|
||||
(<OPUT .OBJ .SLT .VAL>)>>
|
||||
|
||||
;
|
||||
"Save GVALs
|
||||
Arg 1: The code UVECTOR
|
||||
Arg 2: A UVECTOR of ATOMS (which must have GVALs!
|
||||
Arg 3: Number of times to rest UVECTOR when done"
|
||||
|
||||
<DEFINE SAVE-GVAL (V GV RST)
|
||||
#DECL ((V) <UVECTOR [REST FIX]> (GV) <UVECTOR [REST ATOM]> (RST) FIX)
|
||||
<MAPR <>
|
||||
<FUNCTION (ATMS VEC)
|
||||
#DECL ((ATMS) <UVECTOR [REST ATOM]> (VEC) <UVECTOR [REST FIX]>)
|
||||
<PUT .VEC 1 <SCODE <GVAL <1 .ATMS>>>>>
|
||||
.GV
|
||||
.V>
|
||||
<REST .V .RST>>
|
||||
|
||||
; "Restore GVALs
|
||||
Args 1-3: As above
|
||||
Arg 4: The type (ATOM) to restore"
|
||||
|
||||
<DEFINE REST-GVAL (V GV RST TYP)
|
||||
#DECL ((V) <UVECTOR [REST FIX]> (GV) <UVECTOR [REST ATOM]> (RST) FIX (TYP) ATOM)
|
||||
<MAPF <>
|
||||
<FUNCTION (ATM VAL)
|
||||
#DECL ((ATM) ATOM (VAL) FIX)
|
||||
<SETG .ATM <SDECODE .VAL .TYP>>>
|
||||
.GV
|
||||
.V>
|
||||
<REST .V .RST>>
|
||||
|
||||
; "Restore a LIST of OBJECTs
|
||||
Arg 1: The code UVECTOR
|
||||
Stops when a 0 is encountered"
|
||||
|
||||
<DEFINE REST-LIST (V)
|
||||
#DECL ((V) <UVECTOR [REST FIX]>)
|
||||
<MAPF ,LIST
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) FIX)
|
||||
<COND (<0? .X> <MAPSTOP>)
|
||||
(<SDECODE .X OBJECT>)>>
|
||||
.V>>
|
||||
|
||||
; "Restore ROOMS/OBJECTS
|
||||
Arg 1: The code UVECTOR
|
||||
Arg 2: A UVECTOR of offsets into the objects (FIX)
|
||||
Arg 3: A UVECTOR of types of the offsets (ATOM)
|
||||
Arg 4: The length of each record
|
||||
Arg 5: OBJECT/ROOM flag
|
||||
Gets the item (ROOM or OBJECT) from the ID slot and then
|
||||
calls UNRESTFUL-CODE to fill the elements (note that this
|
||||
function is called with names = <REST ,xSNAMES>
|
||||
This function also fixes up OCONTENTS and OROOM slots."
|
||||
|
||||
<DEFINE REST-ITEMS (V NAMES TYPES RECLEN TYPE "AUX" D C)
|
||||
#DECL ((V) <UVECTOR [REST FIX]> (TYPES NAMES) <UVECTOR [REST ATOM]>
|
||||
(RECLEN) FIX (TYPE) ATOM (C) <OR FALSE <PRIMTYPE VECTOR>>
|
||||
(D) <OR FALSE DOOR>)
|
||||
<REPEAT (OBJ)
|
||||
#DECL ((OBJ) <OR FALSE <PRIMTYPE VECTOR>>)
|
||||
<COND
|
||||
(<SET OBJ <SDECODE <1 .V> .TYPE>>
|
||||
<UNRESTFUL-CODE <REST .V> .OBJ .NAMES .TYPES>
|
||||
<COND (<==? .TYPE OBJECT>
|
||||
<COND (<SET C <OCAN .OBJ>>
|
||||
<PUT .C ,OCONTENTS (.OBJ !<OCONTENTS .C>)>)
|
||||
(<SET C <OROOM .OBJ>>
|
||||
<PUT .C ,ROBJS (.OBJ !<ROBJS .C>)>
|
||||
<COND (<AND <TRNN .OBJ ,DOORBIT>
|
||||
<SET D <FIND-DOOR .C .OBJ>>>
|
||||
<SET C <GET-DOOR-ROOM .C .D>>
|
||||
<PUT .C ,ROBJS (.OBJ !<ROBJS .C>)>)>)>)>
|
||||
<SET V <REST .V .RECLEN>>)
|
||||
(<RETURN>)>>>
|
||||
|
||||
<DEFINE GET-SRUV ()
|
||||
<COND (<GASSIGNED? SRUV>
|
||||
<MAPR <>
|
||||
<FUNCTION (X) #DECL ((X) <UVECTOR [REST FIX]>)
|
||||
<PUT .X 1 0>>
|
||||
,SRUV>
|
||||
,SRUV)
|
||||
(<BLOAT <+ ,SAVLENGTH 2>>
|
||||
<SETG SRUV <IUVECTOR ,SAVLENGTH 0>>)>>
|
||||
|
||||
; "Save the game -- linear sequence of calls to above"
|
||||
|
||||
<DEFINE SAVE-GAME (CH "AUX" V VV (C ,CLOCKER) (H ,ROBBER-DEMON))
|
||||
#DECL ((V VV) <UVECTOR [REST FIX]> (C H) HACK (CH) CHANNEL)
|
||||
<SET V <GET-SRUV>> ;"Save objects"
|
||||
<PUT .V 1 ,SAVE-VERSION>
|
||||
<SET V <REST .V>>
|
||||
<SET V <UNSAVORY-CODE .V ,OBJECTS ,OBJSVLN ,OSNAMES ,ORECLN>>
|
||||
;"Save rooms"
|
||||
<SET V <UNSAVORY-CODE .V ,ROOMS ,RMSVLN ,RSNAMES ,RRECLN>>
|
||||
;"Save robber's booty"
|
||||
<SET VV <UNSAVORY-CODE .V <HOBJS .H> ,HOBJSVLN '![OID] 1>>
|
||||
;"Save robber stuff"
|
||||
<PUT .VV 1 <SCODE <1 <HROOMS .H>>>>
|
||||
<PUT .VV 2 <SCODE <HROOM .H>>>
|
||||
<PUT .VV 3 <SCODE <HFLAG .H>>>
|
||||
<PUT .VV 4 <COND (<HACTION .H> 1)
|
||||
(0)>>
|
||||
<PUT .VV 5 <COND (<HACTION ,SWORD-DEMON> 1)
|
||||
(0)>>
|
||||
;"Save clocker"
|
||||
<SET VV
|
||||
<UNSAVORY-CODE <REST .VV 5> <HOBJS .C> ,CEVSVLN ,CSNAMES ,CRECLN>>
|
||||
<SET V <SET VV <REST .V ,DMNSVLN>>> ;"Save winners"
|
||||
<MAPF <> <FUNCTION (X) <SET VV <WINSAVE .VV .X>>> ,ACTORS>
|
||||
<SET V <REST .V ,ACTSVLN>> ;"Save GVALs (MONAD, ROOM, OBJECT)"
|
||||
<SET V <SAVE-GVAL .V ,MGVALS ,MGSVLN>>
|
||||
<SET V <SAVE-GVAL .V ,RMGVALS ,RMGSVLN>>
|
||||
<SET V <SAVE-GVAL .V ,OBJGVALS ,OBJGSVLN>>
|
||||
<SAVE-PUZZLE .V>
|
||||
<PRINTB <TOP .V> .CH>
|
||||
<CLOSE .CH>
|
||||
"DONE">
|
||||
|
||||
<DEFINE SAVE-PUZZLE (U "AUX" (BUCK 1))
|
||||
#DECL ((U) <UVECTOR [REST FIX]> (BUCK) FIX)
|
||||
<COND (<==? <LENGTH <TOP .U>> ,SAVLENGTH>
|
||||
<PUT ,CPOBJS ,CPHERE <ROBJS <SFIND-ROOM "CP">>>
|
||||
<SUBSTRUC ,CPUVEC 0 64 .U>
|
||||
<SET U <REST .U 64>>
|
||||
<MAPF <>
|
||||
<FUNCTION (LST)
|
||||
#DECL ((LST) LIST)
|
||||
<MAPF <>
|
||||
<FUNCTION (OBJ)
|
||||
#DECL ((OBJ) OBJECT)
|
||||
<PUT .U 1 <SCODE .OBJ>>
|
||||
<PUT .U 2 .BUCK>
|
||||
<SET U <REST .U 2>>>
|
||||
.LST>
|
||||
<SET BUCK <+ .BUCK 1>>>
|
||||
,CPOBJS>)>>
|
||||
|
||||
<DEFINE RESTORE-PUZZLE (U "AUX" (OBJS ,CPOBJS) WHR)
|
||||
#DECL ((U) <UVECTOR [REST FIX]> (OBJS) <UVECTOR [REST LIST]> (WHR) FIX)
|
||||
<COND (<==? <LENGTH <TOP .U>> ,SAVLENGTH>
|
||||
<SUBSTRUC .U 0 64 ,CPUVEC>
|
||||
<SET U <REST .U 64>>
|
||||
<MAPR <>
|
||||
<FUNCTION (UVC)
|
||||
#DECL ((UVC) <UVECTOR [REST LIST]>)
|
||||
<PUT .UVC 1 '()>>
|
||||
.OBJS>
|
||||
<REPEAT ()
|
||||
<COND (<0? <1 .U>>
|
||||
<RETURN>)
|
||||
(<PUT .OBJS
|
||||
<SET WHR <2 .U>>
|
||||
(<SDECODE <1 .U> OBJECT> !<NTH .OBJS .WHR>)>)>
|
||||
<SET U <REST .U 2>>>
|
||||
<OR <0? ,CPHERE>
|
||||
<PUT <SFIND-ROOM "CP"> ,ROBJS <NTH ,CPOBJS ,CPHERE>>>)>>
|
||||
|
||||
<DEFINE WINSAVE (V W)
|
||||
#DECL ((V) <UVECTOR [REST FIX]> (W) ADV)
|
||||
<PUT .V 1 <SCODE <AROOM .W>>>
|
||||
<PUT .V 2 <SCODE <ASCORE .W>>>
|
||||
<PUT .V 3 <SCODE <AVEHICLE .W>>>
|
||||
<PUT .V 4 <SCODE <AOBJ .W>>>
|
||||
<PUT .V 5 <SCODE <ASTRENGTH .W>>>
|
||||
<UNSAVORY-CODE <REST .V 5> <AOBJS .W> ,WSVLN '![OID!] 1>>
|
||||
|
||||
<DEFINE RESTORE-GAME RG (CH "AUX" V VV (H ,ROBBER-DEMON) (C ,CLOCKER)
|
||||
(CSNAMES ,CSNAMES) (CSTYPES ,CSTYPES) (CNT 2))
|
||||
#DECL ((CH) CHANNEL (V VV) <UVECTOR [REST FIX]> (C H) HACK
|
||||
(CSNAMES CSTYPES) UVECTOR (CNT) FIX (RG) ACTIVATION)
|
||||
<SET V <GET-SRUV>>
|
||||
<COND (<READB .V .CH>
|
||||
<COND (<N==? <1 .V> ,SAVE-VERSION>
|
||||
<TELL
|
||||
"ERROR--Save file is incompatible with this version of Dungeon.">
|
||||
<CLOSE .CH>
|
||||
<RETURN <> .RG>)>
|
||||
<SET V <REST .V>>
|
||||
<CLOSE .CH>
|
||||
; "Clear slots"
|
||||
<MAPF <> <FUNCTION (X) #DECL ((X) OBJECT) <PUT .X ,OCONTENTS ()>> ,OBJECTS>
|
||||
<MAPF <> <FUNCTION (X) #DECL ((X) ROOM) <PUT .X ,ROBJS ()>> ,ROOMS>
|
||||
; "Retrieve clocker first!"
|
||||
<PUT .C ,HOBJS
|
||||
<MAPR ,LIST
|
||||
<FUNCTION (UV "AUX" CV)
|
||||
#DECL ((UV) UVECTOR (CV) <OR FALSE CEVENT>)
|
||||
<COND (<0? <SET CNT <MOD <+ .CNT 1> 3>>>
|
||||
<COND (<SET CV <SDECODE <1 .UV> CEVENT>>
|
||||
<UNRESTFUL-CODE <REST .UV> .CV
|
||||
<REST .CSNAMES> .CSTYPES>
|
||||
<MAPRET .CV>)
|
||||
(<MAPSTOP>)>)
|
||||
(<MAPRET>)>>
|
||||
<REST .V <+ ,OBJSVLN ,RMSVLN ,HOBJSVLN 5>>>>
|
||||
; "Get objects"
|
||||
<REST-ITEMS .V <REST ,OSNAMES> ,OSTYPES ,ORECLN OBJECT>
|
||||
; "Get rooms"
|
||||
<REST-ITEMS <SET V <REST .V ,OBJSVLN>> <REST ,RSNAMES> ,RSTYPES ,RRECLN ROOM>
|
||||
; "Get robber"
|
||||
<PUT .H ,HOBJS <REST-LIST <SET V <REST .V ,RMSVLN>>>>
|
||||
<SET VV <REST .V ,HOBJSVLN>>
|
||||
<PUT .H ,HROOMS <MEMQ <SDECODE <1 .VV> ROOM> ,ROOMS>>
|
||||
<PUT .H ,HROOM <SDECODE <2 .VV> ROOM>>
|
||||
<PUT .H ,HFLAG <SDECODE <3 .VV> FIX>>
|
||||
<COND (<1? <4 .VV>>
|
||||
<PUT .H ,HACTION <COND (<TYPE? ,ROBBER NOFFSET> ,ROBBER)
|
||||
(ROBBER)>>)
|
||||
(T <PUT .H ,HACTION <>>)>
|
||||
<COND (<1? <5 .VV>>
|
||||
<PUT ,SWORD-DEMON ,HACTION <COND (<TYPE? ,SWORD-GLOW NOFFSET>
|
||||
,SWORD-GLOW)
|
||||
(SWORD-GLOW)>>)>
|
||||
<SET V <SET VV <REST .V ,DMNSVLN>>>
|
||||
; "Get winner"
|
||||
<MAPF <> <FUNCTION (X) #DECL ((X) ADV) <SET VV <WINREST .VV .X>>> ,ACTORS>
|
||||
<SET V <REST .V ,ACTSVLN>>
|
||||
; "Get GVALS"
|
||||
<SET V <REST-GVAL .V ,MGVALS ,MGSVLN FIX>>
|
||||
<SET V <REST-GVAL .V ,RMGVALS ,RMGSVLN ROOM>>
|
||||
<SET V <REST-GVAL .V ,OBJGVALS ,OBJGSVLN OBJECT>>
|
||||
<RESTORE-PUZZLE .V>
|
||||
"DONE")>>
|
||||
|
||||
<DEFINE WINREST (V W "AUX" T)
|
||||
#DECL ((V) <UVECTOR [REST FIX]> (W) ADV (T) OBJECT)
|
||||
<PUT .W ,AROOM <SDECODE <1 .V> ROOM>>
|
||||
<PUT .W ,ASCORE <SDECODE <2 .V> FIX>>
|
||||
<PUT .W ,AVEHICLE <SDECODE <3 .V> OBJECT>>
|
||||
<PUT .W ,AOBJ <OPUT <SET T <SDECODE <4 .V> OBJECT>> OACTOR .W>>
|
||||
<PUT .W ,ASTRENGTH <SDECODE <5 .V> FIX>>
|
||||
<PUT .W ,AOBJS <REST-LIST <SET V <REST .V 5>>>>
|
||||
<REST .V ,WSVLN>>
|
||||
|
||||
<GDECL (OFIXUPS) <VECTOR [REST OBJECT ATOM ATOM]>>
|
||||
BIN
src/zork/syntax.7
Normal file
BIN
src/zork/syntax.7
Normal file
Binary file not shown.
25
src/zork/tape.999
Normal file
25
src/zork/tape.999
Normal file
@@ -0,0 +1,25 @@
|
||||
TAPE NO 999 CREATION DATE 800412
|
||||
|
||||
1 EJS ACT1 253 1 4/12/80 09:27:58.5
|
||||
2 EJS ACT2 92 1 4/12/80 09:28:42
|
||||
3 EJS ACT3 198 1 4/12/80 09:29:13.5
|
||||
4 EJS ACT4 231 1 4/12/80 09:30:23
|
||||
5 EJS B 176 1 4/12/80 09:52:30.5
|
||||
6 EJS BUILD CMD 1 4/12/80 10:33:39
|
||||
7 EJS DEFS 171 1 4/12/80 09:52:46
|
||||
8 EJS DISP1 2 1 4/12/80 09:53:03
|
||||
9 EJS DUNG 354 1 4/12/80 09:18:39
|
||||
10 EJS IMPL 123 0 4/12/80 09:53:16.5
|
||||
11 EJS MAKSTR 44 0 4/12/80 09:53:33.5
|
||||
12 EJS MELEE 137 0 4/12/80 09:53:46.5
|
||||
13 EJS PARSER 130 0 4/12/80 09:53:57.5
|
||||
14 EJS POINTS TXT 0 4/12/80 10:33:47
|
||||
15 EJS PPAPER TXT 0 4/12/80 10:33:55.5
|
||||
16 EJS PRIM 9 0 4/12/80 09:54:09.5
|
||||
17 EJS ROOMS 393 0 4/12/80 09:54:21.5
|
||||
18 EJS SR 54 0 4/12/80 09:54:44
|
||||
19 EJS SYNTAX 7 0 4/12/80 09:54:56.5
|
||||
20 EJS TELL 152 0 4/12/80 10:01:06.5
|
||||
21 EJS TYPHAK 16 0 4/12/80 10:01:20
|
||||
22 EJS UTIL 16 0 4/12/80 10:01:29 E-O-T
|
||||
REEL = 0
|
||||
1263
src/zork/tell.152
Normal file
1263
src/zork/tell.152
Normal file
File diff suppressed because it is too large
Load Diff
128
src/zork/typhak.16
Normal file
128
src/zork/typhak.16
Normal file
@@ -0,0 +1,128 @@
|
||||
|
||||
<DEFINE CEVENT-PRINT (EV "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((EV) CEVENT)
|
||||
<PRINC "#CEVENT [">
|
||||
<COND (<CFLAG .EV> <PRINC "ENABLED">)
|
||||
(<PRINC "DISABLED">)>
|
||||
<PRINC " @ ">
|
||||
<PRIN1 <CTICK .EV>>
|
||||
<PRINC " -> ">
|
||||
<FUNCTION-PRINT <CACTION .EV>>
|
||||
<PRINC "]">>
|
||||
|
||||
<PRINTTYPE CEVENT ,CEVENT-PRINT>
|
||||
|
||||
<DEFINE FUNCTION-PRINT (FROB "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((FROB) <OR ATOM NOFFSET APPLICABLE FALSE> (OUTCHAN) CHANNEL)
|
||||
<COND (<NOT .FROB> <PRINC "<>">)
|
||||
(<TYPE? .FROB RSUBR RSUBR-ENTRY>
|
||||
<PRIN1 <2 .FROB>>)
|
||||
(<TYPE? .FROB ATOM>
|
||||
<PRIN1 .FROB>)
|
||||
(<TYPE? .FROB NOFFSET>
|
||||
<PRINC "#NOFFSET ">
|
||||
<PRIN1 <GET-ATOM .FROB>>)
|
||||
(<PRINC "#FUNCTION ">
|
||||
<PRIN1 <GET-ATOM .FROB>>)>>
|
||||
|
||||
<DEFINE OFF-APPLY (FOO "TUPLE" ARGS)
|
||||
#DECL ((FOO) NOFFSET)
|
||||
<COND (<G? <LENGTH .ARGS> 1>
|
||||
<ERROR TOO-MANY-ARGS OFF-APPLY>)
|
||||
(<OR <EMPTY? .ARGS>
|
||||
<NOT <1 .ARGS>>>
|
||||
<DISPATCH .FOO>)
|
||||
(T
|
||||
<DISPATCH .FOO <1 .ARGS>>)>>
|
||||
|
||||
<DEFINE OFF-PRINT (FOO)
|
||||
#DECL ((FOO) NOFFSET)
|
||||
<PRINC "#NOFFSET ">
|
||||
<PRIN1 <GET-ATOM .FOO>>>
|
||||
|
||||
<APPLYTYPE NOFFSET ,OFF-APPLY>
|
||||
|
||||
<PRINTTYPE NOFFSET ,OFF-PRINT>
|
||||
|
||||
<DEFINE ROOM-PRINT (ROOM)
|
||||
#DECL ((ROOM) ROOM)
|
||||
<PRINC "#ROOM [">
|
||||
<PSTRING-PRINT <RID .ROOM> <>>
|
||||
<PRINC " \\\"">
|
||||
<PRINC <RDESC2 .ROOM>>
|
||||
<PRINC "\\\"">
|
||||
<COND (<EMPTY? <REXITS .ROOM>>)
|
||||
(<PRINC " ">
|
||||
<REPEAT ((EX <REXITS .ROOM>))
|
||||
<PRINC <1 .EX>>
|
||||
<COND (<EMPTY? <SET EX <REST .EX 2>>> <RETURN>)
|
||||
(<PRINC " ">)>>)>
|
||||
<COND (<EMPTY? <ROBJS .ROOM>>)
|
||||
(<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) OBJECT)
|
||||
<PRINC " ">
|
||||
<PRINC <OID .X>>>
|
||||
<ROBJS .ROOM>>)>
|
||||
<PRINC " ">
|
||||
<FUNCTION-PRINT <RACTION .ROOM>>
|
||||
<PRINC "]">>
|
||||
|
||||
<PRINTTYPE ROOM ,ROOM-PRINT>
|
||||
|
||||
<DEFINE OBJ-PRINT (OBJ)
|
||||
#DECL ((OBJ) OBJECT)
|
||||
<PRINC "#OBJECT [">
|
||||
<COND (<EMPTY? <ONAMES .OBJ>> <PRINC !\?>)
|
||||
(<PSTRING-PRINT <OID .OBJ> <>>)>
|
||||
<PRINC " ">
|
||||
<PRINC <ODESC2 .OBJ>>
|
||||
<COND (<NOT <EMPTY? <OCONTENTS .OBJ>>>
|
||||
<PRINC " ">
|
||||
<MAPF <>
|
||||
<FUNCTION (X) <PRINC <OID .X>> <PRINC " ">>
|
||||
<OCONTENTS .OBJ>>)
|
||||
(<OCAN .OBJ> <PRINC " in "> <PRINC <OID <OCAN .OBJ>>> <PRINC " ">)
|
||||
(<PRINC " ">)>
|
||||
<FUNCTION-PRINT <OACTION .OBJ>>
|
||||
<PRINC "]">>
|
||||
|
||||
<PRINTTYPE OBJECT ,OBJ-PRINT>
|
||||
|
||||
<DEFINE HACK-PRINT (HACK)
|
||||
#DECL ((HACK) HACK)
|
||||
<PRINC "#HACK [">
|
||||
<FUNCTION-PRINT <HACTION .HACK>>
|
||||
<PRINC !\ >
|
||||
<PRIN1 <HOBJS .HACK>>
|
||||
<PRINC !\]>>
|
||||
|
||||
<PRINTTYPE HACK ,HACK-PRINT>
|
||||
|
||||
<DEFINE ACTION-PRINT (ACT "AUX" (OUTCHAN .OUTCHAN))
|
||||
#DECL ((ACT) ACTION (OUTCHAN) CHANNEL)
|
||||
<PRINC "#ACTION ">
|
||||
<PRINC <VSTR .ACT>>>
|
||||
|
||||
<PRINTTYPE ACTION ,ACTION-PRINT>
|
||||
|
||||
<DEFINE PSTRING-PRINT (OBJ "OPTIONAL" (TYPE-PRINT T) "AUX" (BP 36) C)
|
||||
#DECL ((OBJ) <PRIMTYPE WORD> (BP C) FIX (TYPE-PRINT) <OR ATOM FALSE>)
|
||||
<COND (.TYPE-PRINT <PRINC !\#> <PRIN1 <TYPE .OBJ>> <PRINC !\ >)>
|
||||
<MAPF <>
|
||||
<FUNCTION ()
|
||||
<COND (<G? <SET BP <- .BP 7>> 0>
|
||||
<COND (<N==? <SET C <CHTYPE <GETBITS .OBJ <BITS 7 .BP>> FIX>>
|
||||
0>
|
||||
<PRINC <ASCII .C>>)>)
|
||||
(T <MAPLEAVE .OBJ>)>>>>
|
||||
|
||||
<PRINTTYPE PSTRING ,PSTRING-PRINT>
|
||||
|
||||
<PRINTTYPE PREP ,PSTRING-PRINT>
|
||||
|
||||
<PRINTTYPE DIRECTION ,PSTRING-PRINT>
|
||||
|
||||
<PRINTTYPE ADJECTIVE ,PSTRING-PRINT>
|
||||
|
||||
<PRINTTYPE BUZZ ,PSTRING-PRINT>
|
||||
257
src/zork/util.16
Normal file
257
src/zork/util.16
Normal file
@@ -0,0 +1,257 @@
|
||||
"(c) Copyright 1978, Massachusetts Institute of Technology. All rights reserved."
|
||||
"UTILITY FUNCTIONS ONLY!"
|
||||
|
||||
;"Functions for hacking objects, rooms, winner, etc.
|
||||
REMOVE-OBJECT <obj>
|
||||
Remove an object from any room or ,WINNER or its container.
|
||||
INSERT-OBJECT <obj> <room>
|
||||
Put the object into the room.
|
||||
REMOVE-FROM <obj1> <obj2>
|
||||
Make obj1 no longer contain obj2.
|
||||
INSERT-INTO <obj1> <obj2>
|
||||
Make obj1 contain obj2.
|
||||
TAKE-OBJECT <obj> {OPTIONAL} <adv>
|
||||
Make <obj> one of <adv>'s possessions.
|
||||
DROP-OBJECT <obj> {OPTIONAL} <adv>
|
||||
Remove <obj> from <adv>'s possessions.
|
||||
DROP-IF <obj> {OPTIONAL} <adv>
|
||||
Do a DROP-OBJECT if <adv> has <obj> as a possession.
|
||||
SNARF-OBJECT <obj1> <obj2>
|
||||
Find <obj1>, REMOVE-OBJECT it, and <INSERT-INTO <obj2> <obj1>.
|
||||
|
||||
IN-ROOM? <obj> {OPTIONAL} <room>
|
||||
Is <obj> anywhere inside the room (but not with ,WINNER)?
|
||||
IN-ROOM? does not check OVISON!
|
||||
|
||||
HACKABLE?
|
||||
Is <obj> either in ,HERE or in current vehicle.
|
||||
Uses SEARCH-LIST so completely groks visibility, containers, etc.
|
||||
|
||||
"
|
||||
|
||||
\
|
||||
|
||||
<DEFINE REMOVE-OBJECT (OBJ "OPTIONAL" (WINNER ,WINNER) "AUX" OCAN OROOM)
|
||||
#DECL ((OBJ) OBJECT (OCAN) <OR OBJECT FALSE> (OROOM) <OR FALSE ROOM>
|
||||
(WINNER) ADV)
|
||||
<COND (<SET OCAN <OCAN .OBJ>>
|
||||
<PUT .OCAN ,OCONTENTS <SPLICE-OUT .OBJ <OCONTENTS .OCAN>>>)
|
||||
(<SET OROOM <OROOM .OBJ>>
|
||||
<PUT .OROOM ,ROBJS <SPLICE-OUT .OBJ <ROBJS .OROOM>>>)
|
||||
(<MEMQ .OBJ <AOBJS .WINNER>>
|
||||
<PUT .WINNER ,AOBJS <SPLICE-OUT .OBJ <AOBJS .WINNER>>>)>
|
||||
<PUT .OBJ ,OROOM <>>
|
||||
<PUT .OBJ ,OCAN <>>>
|
||||
|
||||
<DEFINE INSERT-OBJECT (OBJ ROOM)
|
||||
#DECL ((OBJ) OBJECT (ROOM) ROOM)
|
||||
<PUT .ROOM ,ROBJS (<PUT .OBJ ,OROOM .ROOM> !<ROBJS .ROOM>)>>
|
||||
|
||||
<DEFINE INSERT-INTO (CNT OBJ)
|
||||
#DECL ((OBJ CNT) OBJECT)
|
||||
<PUT .CNT ,OCONTENTS (.OBJ !<OCONTENTS .CNT>)>
|
||||
<PUT .OBJ ,OCAN .CNT>
|
||||
<PUT .OBJ ,OROOM <>>>
|
||||
|
||||
<DEFINE REMOVE-FROM (CNT OBJ)
|
||||
#DECL ((OBJ CNT) OBJECT)
|
||||
<PUT .CNT ,OCONTENTS <SPLICE-OUT .OBJ <OCONTENTS .CNT>>>
|
||||
<PUT .OBJ ,OCAN <>>>
|
||||
|
||||
<DEFINE TAKE-OBJECT (OBJ "OPTIONAL" (WINNER ,WINNER))
|
||||
#DECL ((OBJ) OBJECT (WINNER) ADV)
|
||||
<TRO .OBJ ,TOUCHBIT>
|
||||
<PUT .WINNER ,AOBJS (<PUT .OBJ ,OROOM <>> !<AOBJS .WINNER>)>>
|
||||
|
||||
<DEFINE DROP-OBJECT (OBJ "OPTIONAL" (WINNER ,WINNER))
|
||||
#DECL ((OBJ) OBJECT (WINNER) ADV)
|
||||
<PUT .WINNER ,AOBJS <SPLICE-OUT .OBJ <AOBJS .WINNER>>>>
|
||||
|
||||
<DEFINE DROP-IF (OBJ "OPTIONAL" (WINNER ,WINNER))
|
||||
#DECL ((OBJ) OBJECT (WINNER) ADV)
|
||||
<AND <MEMQ .OBJ <AOBJS .WINNER>>
|
||||
<DROP-OBJECT .OBJ .WINNER>>>
|
||||
|
||||
<DEFINE SNARF-OBJECT (WHO WHAT)
|
||||
#DECL ((WHO WHAT) OBJECT)
|
||||
<COND (<AND <N==? <OCAN .WHAT> .WHO>
|
||||
<OR <OROOM .WHAT>
|
||||
<OCAN .WHAT>>>
|
||||
<REMOVE-OBJECT .WHAT>
|
||||
<INSERT-INTO .WHO .WHAT>)
|
||||
(.WHO)>>
|
||||
|
||||
<DEFINE IN-ROOM? (OBJ "OPTIONAL" (HERE ,HERE) "AUX" TOBJ)
|
||||
#DECL ((OBJ) OBJECT (HERE) ROOM (TOBJ) <OR OBJECT FALSE>)
|
||||
<COND (<SET TOBJ <OCAN .OBJ>>
|
||||
<COND (<==? <OROOM .TOBJ> .HERE>)
|
||||
(<TRNN .TOBJ ,SEARCHBIT>
|
||||
<IN-ROOM? .TOBJ .HERE>)>)
|
||||
(<==? <OROOM .OBJ> .HERE>)>>
|
||||
|
||||
<DEFINE HACKABLE? (OBJ RM "AUX" (AV <AVEHICLE ,WINNER>))
|
||||
#DECL ((OBJ) OBJECT (RM) ROOM (AV) <OR FALSE OBJECT>)
|
||||
<COND (.AV
|
||||
<SEARCH-LIST <OID .OBJ> <OCONTENTS .AV> <>>)
|
||||
(<SEARCH-LIST <OID .OBJ> <ROBJS .RM> <>>)>>
|
||||
|
||||
\
|
||||
|
||||
"Villains, thieves, and scoundrels"
|
||||
|
||||
"ROB-ADV: TAKE ALL OF THE VALUABLES A HACKER IS CARRYING"
|
||||
|
||||
<DEFINE ROB-ADV (WIN NEWLIST)
|
||||
#DECL ((WIN) ADV (NEWLIST) <LIST [REST OBJECT]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) OBJECT)
|
||||
<COND (<AND <G? <OTVAL .X> 0> <NOT <TRNN .X ,SACREDBIT>>>
|
||||
<PUT .WIN ,AOBJS <SPLICE-OUT .X <AOBJS .WIN>>>
|
||||
<SET NEWLIST (.X !.NEWLIST)>)>>
|
||||
<AOBJS .WIN>>
|
||||
.NEWLIST>
|
||||
|
||||
"ROB-ROOM: TAKE VALUABLES FROM A ROOM, PROBABILISTICALLY"
|
||||
|
||||
<DEFINE ROB-ROOM (RM NEWLIST PROB)
|
||||
#DECL ((RM) ROOM (NEWLIST) <LIST [REST OBJECT]> (PROB) FIX)
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) OBJECT)
|
||||
<COND (<AND <G? <OTVAL .X> 0>
|
||||
<NOT <TRNN .X ,SACREDBIT>>
|
||||
<TRNN .X ,OVISON>
|
||||
<PROB .PROB>>
|
||||
<REMOVE-OBJECT .X>
|
||||
<TRO .X ,TOUCHBIT>
|
||||
<SET NEWLIST (.X !.NEWLIST)>)
|
||||
(<OACTOR .X>
|
||||
<SET NEWLIST <ROB-ADV <OACTOR .X> .NEWLIST>>)>>
|
||||
<ROBJS .RM>>
|
||||
.NEWLIST>
|
||||
|
||||
<DEFINE GET-DEMON (ID "AUX" (OBJ <FIND-OBJ .ID>) (DEMS ,DEMONS))
|
||||
#DECL ((ID) STRING (OBJ) OBJECT (DEMS) <LIST [REST HACK]>)
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) HACK)
|
||||
<COND (<==? <HOBJ .X> .OBJ> <MAPLEAVE .X>)>>
|
||||
.DEMS>>
|
||||
|
||||
\
|
||||
|
||||
; "The guiding light"
|
||||
|
||||
<DEFINE LIGHT-SOURCE (ME)
|
||||
#DECL ((ME) ADV)
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) OBJECT)
|
||||
<COND (<NOT <TRNN .X ,LIGHTBIT>>
|
||||
<MAPLEAVE .X>)>>
|
||||
<AOBJS .ME>>>
|
||||
|
||||
;"LIT? --
|
||||
IS THERE ANY LIGHT SOURCE IN THIS ROOM"
|
||||
|
||||
<SETG ALWAYS-LIT <>>
|
||||
|
||||
<DEFINE LIT? (RM "AUX" (WIN ,WINNER))
|
||||
#DECL ((RM) ROOM (WIN) ADV)
|
||||
<OR <RTRNN .RM ,RLIGHTBIT>
|
||||
<LFCN <ROBJS .RM>>
|
||||
<AND <==? ,HERE .RM> <LFCN <AOBJS .WIN>>>
|
||||
<AND <N==? .WIN ,PLAYER>
|
||||
<==? ,HERE <AROOM ,PLAYER>>
|
||||
<LFCN <AOBJS ,PLAYER>>>
|
||||
,ALWAYS-LIT>>
|
||||
|
||||
<DEFINE LFCN LFCN (L "AUX" Y)
|
||||
#DECL ((L) <LIST [REST OBJECT]> (Y) ADV (LFCN) ACTIVATION)
|
||||
<MAPF <>
|
||||
<FUNCTION (X)
|
||||
#DECL ((X) OBJECT)
|
||||
<AND <TRNN .X ,ONBIT> <MAPLEAVE T>>
|
||||
<COND (<AND <TRNN .X ,OVISON>
|
||||
<OR <TRNN .X ,OPENBIT>
|
||||
<TRNN .X ,TRANSBIT>>>
|
||||
<MAPF <>
|
||||
<FUNCTION (X) #DECL ((X) OBJECT)
|
||||
<COND (<TRNN .X ,ONBIT>
|
||||
<RETURN T .LFCN>)>>
|
||||
<OCONTENTS .X>>)>
|
||||
<COND (<AND <TRNN .X ,ACTORBIT>
|
||||
<LFCN <AOBJS <SET Y <OACTOR .X>>>>>
|
||||
<MAPLEAVE T>)>>
|
||||
.L>>
|
||||
|
||||
\
|
||||
; "Random Utilities"
|
||||
|
||||
<DEFINE PICK-ONE (VEC)
|
||||
#DECL ((VEC) VECTOR)
|
||||
<NTH .VEC <+ 1 <MOD <RANDOM> <LENGTH .VEC>>>>>
|
||||
|
||||
<SETG LUCKY!-FLAG T>
|
||||
|
||||
<DEFINE PROB (GOODLUCK "OPTIONAL" (BADLUCK .GOODLUCK))
|
||||
#DECL ((GOODLUCK BADLUCK) FIX)
|
||||
<L=? <MOD <RANDOM> 100>
|
||||
<COND (,LUCKY!-FLAG .GOODLUCK)
|
||||
(.BADLUCK)>>>
|
||||
|
||||
<DEFINE YES/NO (NO-IS-BAD? "AUX" (INBUF ,INBUF) (INCHAN ,INCHAN))
|
||||
#DECL ((INBUF) STRING (NO-IS-BAD?) <OR ATOM FALSE> (INCHAN) CHANNEL)
|
||||
<RESET .INCHAN>
|
||||
<TTY-INIT <>>
|
||||
<READST .INBUF "" <>>
|
||||
<COND (.NO-IS-BAD?
|
||||
<NOT <MEMQ <1 .INBUF> "NnfF">>)
|
||||
(T
|
||||
<MEMQ <1 .INBUF> "TtYy">)>>
|
||||
|
||||
<DEFINE SPLICE-OUT (OBJ AL)
|
||||
#DECL ((AL) LIST (OBJ) ANY)
|
||||
<COND (<==? <1 .AL> .OBJ> <REST .AL>)
|
||||
(T
|
||||
<REPEAT ((NL <REST .AL>) (OL .AL))
|
||||
#DECL ((NL) LIST (OL) <LIST ANY>)
|
||||
<COND (<==? <1 .NL> .OBJ>
|
||||
<PUTREST .OL <REST .NL>>
|
||||
<RETURN .AL>)
|
||||
(<SET OL .NL> <SET NL <REST .NL>>)>>)>>
|
||||
|
||||
\
|
||||
|
||||
; "These are for debugging only!"
|
||||
|
||||
<DEFINE FLUSH-OBJ ("TUPLE" OBJS "AUX" (WINNER ,WINNER))
|
||||
#DECL ((OBJS) <TUPLE [REST STRING]> (WINNER) ADV)
|
||||
<MAPF <>
|
||||
<FUNCTION (X "AUX" (Y <FIND-OBJ .X>))
|
||||
#DECL ((X) STRING (Y) OBJECT)
|
||||
<AND <MEMQ .Y <AOBJS .WINNER>>
|
||||
<DROP-OBJECT <FIND-OBJ .X> .WINNER>>>
|
||||
.OBJS>>
|
||||
|
||||
<DEFINE CONS-OBJ ("TUPLE" OBJS "AUX" (WINNER ,WINNER))
|
||||
#DECL ((OBJS) <TUPLE [REST STRING]> (WINNER) ADV)
|
||||
<MAPF <>
|
||||
<FUNCTION (X "AUX" (Y <FIND-OBJ .X>))
|
||||
#DECL ((Y) OBJECT (X) STRING)
|
||||
<OR <MEMQ .Y <AOBJS .WINNER>>
|
||||
<TAKE-OBJECT <FIND-OBJ .X> .WINNER>>>
|
||||
.OBJS>>
|
||||
|
||||
|
||||
; "No applause, please."
|
||||
|
||||
<DEFINE PERFORM (FCN VB "OPTIONAL" (OBJ1 <>) (OBJ2 <>)
|
||||
"AUX" R (PV ,PRSVEC) (PRSA <PRSA>) (PRSO <PRSO>) (PRSI <PRSI>))
|
||||
#DECL ((VB PRSA) VERB (OBJ1 OBJ2 PRSO PRSI) <OR FALSE OBJECT>
|
||||
(R) ANY (PV) VECTOR (FCN) <OR ATOM NOFFSET APPLICABLE>)
|
||||
<PUT <PUT <PUT .PV 3 .OBJ2> 2 .OBJ1> 1 .VB>
|
||||
<SET R <COND (<TYPE? .FCN ATOM NOFFSET> <APPLY-RANDOM .FCN>)
|
||||
(<APPLY .FCN>)>>
|
||||
<PUT <PUT <PUT .PV 3 .PRSI> 2 .PRSO> 1 .PRSA>
|
||||
.R>
|
||||
|
||||
|
||||
Reference in New Issue
Block a user