historicalsource
/
zorkzero
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Release 296

master
historicalsource 2019-04-16 09:52:54 -04:00
commit 8b3579aab4
81 changed files with 105623 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
README.md Normal file
View File

@ -0,0 +1 @@
# zorkzero

1062
castle.zabstr Normal file
View File

File diff suppressed because it is too large Load Diff

2732
castle.zap Normal file
View File

File diff suppressed because it is too large Load Diff

4823
castle.zil Normal file
View File

File diff suppressed because it is too large Load Diff

144
chess.zabstr Normal file
View File

@ -0,0 +1,144 @@
<BEGIN-SEGMENT FENSHIRE>
<GLOBAL RANK 2>
<GLOBAL FILE 5>
<GLOBAL PLAIN-LOC 12>
<ROOM PLAIN (LOC ROOMS) (REGION "Region: Unknown") (DESC "Plain") (NORTH PER
PLAIN-MOVEMENT-F) (NE PER PLAIN-MOVEMENT-F) (EAST PER PLAIN-MOVEMENT-F) (SE PER
PLAIN-MOVEMENT-F) (SOUTH PER PLAIN-MOVEMENT-F) (SW PER PLAIN-MOVEMENT-F) (WEST
PER PLAIN-MOVEMENT-F) (NW PER PLAIN-MOVEMENT-F) (FLAGS RLANDBIT OUTSIDEBIT
ONBIT) (VALUE 16) (ACTION PLAIN-F)>
<DEFINE-ROUTINE PLAIN-F>
<DEFINE-ROUTINE PLAIN-MOVEMENT-F>
<OBJECT BLACK-KNIGHT (DESC "mounted soldier") (LDESC
"There is a soldier on horseback here. His armor is made of the dullest
metals, and his steed is darker than the night.") (SYNONYM SOLDIER KNIGHT HORSE
MAN) (ADJECTIVE MOUNTED BLACK) (FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT
BLACKBIT) (ACTION PIECE-F)>
<OBJECT WHITE-KNIGHT (DESC "mounted soldier") (LDESC
"There is a soldier on horseback here. His armor is made of the shiniest
metals, and his steed is lighter than drifted snow.") (SYNONYM SOLDIER KNIGHT
HORSE MAN) (ADJECTIVE MOUNTED WHITE) (FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT
WHITEBIT) (ACTION PIECE-F)>
<OBJECT BLACK-PAWN (DESC "foot soldier") (LDESC
"You spot a solitary, bored-looking foot soldier. His face is smudged with
coal dust, his uniform is sewn from deeply dyed wool, and the handle of his
sword is solid obsidian.") (SYNONYM SOLDIER PAWN MAN) (ADJECTIVE FOOT BLACK) (
FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT) (ACTION PIECE-F)>
<OBJECT BLACK-QUEEN (DESC "queen") (LDESC
"A regal woman proudly surveys the landscape in all directions. Her skin
is dark; her royal garments even darker.") (SYNONYM QUEEN WOMAN) (ADJECTIVE
REGAL PROUD DARK BLACK) (FLAGS ACTORBIT FEMALEBIT CONTBIT OPENBIT SEARCHBIT
BLACKBIT) (ACTION PIECE-F)>
<OBJECT WHITE-CASTLE (DESC "man atop a castle tower") (LDESC
"Nearby rises a small tower keep, made of creamy marble. Between the
crenellations of the parapet you spot a man, dressed in an ivory chain
mail and carrying a crossbow made of birch.") (SYNONYM MAN TOWER CASTLE ROOK) (
ADJECTIVE CASTLE WHITE) (FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT) (
ACTION PIECE-F)>
<OBJECT BLACK-BISHOP (DESC "high priest") (LDESC
"You hear a sing-song prayer chant and turn to see a high priest of some sort.
His tall, ebony headpiece bears a religious cipher, and his vestments seem to
soak up all light.") (SYNONYM PRIEST BISHOP MAN) (ADJECTIVE HIGH BLACK) (FLAGS
ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT) (ACTION PIECE-F)>
<OBJECT WHITE-PAWN (DESC "foot soldier") (LDESC
"You spot a solitary, bored-looking foot soldier. His face is smudged with
flour, his uniform is sewn from pure undyed cotton, and the handle of his
sword is solid quartz.") (SYNONYM SOLDIER PAWN MAN) (ADJECTIVE WHITE FOOT) (
FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT) (ACTION PIECE-F)>
<OBJECT WHITE-QUEEN (DESC "queen") (LDESC
"A regal woman proudly surveys the landscape in all directions. Her royal
garments are as white as her pale complexion.") (SYNONYM QUEEN WOMAN) (
ADJECTIVE REGAL PROUD WHITE) (FLAGS ACTORBIT FEMALEBIT CONTBIT OPENBIT
SEARCHBIT WHITEBIT) (ACTION PIECE-F)>
<OBJECT WHITE-KING (DESC "royal leader") (LDESC
"A tall man wearing princely robes stands nearby. His bearing indicates that
this is a man accustomed to command. His linen robes are trimmed with ermine,
and his crown is studded with diamonds and opals.") (SYNONYM LEADER KING MAN) (
ADJECTIVE ROYAL WHITE TALL) (FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-KING-CROWN (LOC WHITE-KING) (DESC "crown") (SYNONYM CROWN) (FLAGS
NDESCBIT)>
<OBJECT WHITE-KING-ROBE (LOC WHITE-KING) (DESC "robe") (SYNONYM ROBE) (FLAGS
NDESCBIT)>
<OBJECT BLACK-KING (DESC "royal leader") (LDESC
"A tall man wearing princely robes stands nearby. His bearing indicates that
this is a man accustomed to command. His velvet robes are trimmed with mink,
and his crown is studded with polished onyx.") (SYNONYM LEADER KING MAN) (
ADJECTIVE ROYAL BLACK TALL) (FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT)
(ACTION PIECE-F)>
<OBJECT BLACK-KING-ROBE (LOC BLACK-KING) (DESC "robe") (SYNONYM ROBE) (FLAGS
NDESCBIT)>
<OBJECT BLACK-KING-CROWN (LOC BLACK-KING) (DESC "crown") (SYNONYM CROWN) (FLAGS
NDESCBIT)>
<BEGIN-SEGMENT 0>
<GLOBAL DIR-CNT 0>
<DEFINE-ROUTINE PIECE-F>
<DEFINE-ROUTINE PIECE-TAKES-PIGEON>
<CONSTANT PIECE-MOVE-TABLE <TABLE 0 0 0 0 0 0 0 0>>
<DEFINE-ROUTINE MOVE-PIECE>
<DEFINE-ROUTINE DIR-TO-STRING>
<DEFINE-ROUTINE PIECE-SNARF>
<DEFINE-ROUTINE TAKE-PIECE?>
<DEFINE-ROUTINE ILLEGAL-MOVE?>
<DEFINE-ROUTINE PIECE-AT-NEW-LOC?>
<DEFINE-ROUTINE OBSTRUCTION>
<END-SEGMENT>
<BEGIN-SEGMENT LOWER>
<ROOM FIELD-OFFICE (LOC ROOMS) (DESC "Field Office") (REGION "Flatheadia") (
LDESC "This is a temporary headquarters for a construction site to the west.
Another exit leads east.") (EAST TO EXIT) (WEST PER CONSTRUCTION-ENTER-F) (
FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <PTABLE LOWER-LEVEL-MAP-NUM MAP-GEN-Y-7
MAP-GEN-X-4>)>
<DEFINE-ROUTINE CONSTRUCTION-ENTER-F>
<OBJECT BLUEPRINT (LOC FIELD-OFFICE) (DESC "blueprint") (SYNONYM BLUEPRINT) (
FLAGS TAKEBIT BURNBIT READBIT) (SIZE 2) (TEXT
"[This is the blueprint from your ZORK ZERO package.]")>
<BEGIN-SEGMENT 0>
<OBJECT HAMMER (DESC "hammer") (SYNONYM HAMMER) (FLAGS TAKEBIT) (SIZE 16) (
ACTION HAMMER-F)>
<DEFINE-ROUTINE HAMMER-F>
<END-SEGMENT>
<BEGIN-SEGMENT LOWER>
<ROOM CONSTRUCTION (LOC ROOMS) (DESC "Construction") (REGION "Flatheadia") (
NORTH PER CONSTRUCTION-MOVEMENT-F) (NE PER CONSTRUCTION-MOVEMENT-F) (EAST PER
CONSTRUCTION-MOVEMENT-F) (SE PER CONSTRUCTION-MOVEMENT-F) (SOUTH PER
CONSTRUCTION-MOVEMENT-F) (SW PER CONSTRUCTION-MOVEMENT-F) (WEST PER
CONSTRUCTION-MOVEMENT-F) (NW PER CONSTRUCTION-MOVEMENT-F) (FLAGS RLANDBIT
UNDERGROUNDBIT) (ACTION CONSTRUCTION-F)>
<DEFINE-ROUTINE CONSTRUCTION-F>
<DEFINE-ROUTINE AND-OR-COMMA>
<DEFINE-ROUTINE CONSTRUCTION-MOVEMENT-F>
<GLOBAL CONSTRUCTION-LOC 47>
<CONSTANT NORTH-EXITS <TABLE 99 20 33 37 40 46 48 50 55 59 61>>
<CONSTANT NE-EXITS <TABLE 12 13 14 20 22 27 28 29 33 36 41 43 46 49 50 53 54>>
<CONSTANT EAST-EXITS <TABLE 5 6 12 22 26 30 34 38 42 44 51 56 57 61 62>>
<CONSTANT SE-EXITS <TABLE 99 17 40 43 48 51 54>>
<OBJECT HARDHAT (DESC "hardhat") (SYNONYM HARDHAT HAT) (ADJECTIVE HARD) (FLAGS
TAKEBIT WEARBIT) (GENERIC G-HAT-F) (VALUE 25)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE REMOVE-ANY-PIECE>
<CONSTANT STORAGE-TABLE <TABLE 301 BLACK-KNIGHT 314 BLACK-PAWN 315 WHITE-KNIGHT
328 BLACK-BISHOP 337 BLACK-KING 349 WHITE-PAWN 357 WHITE-KING 363 WHITE-CASTLE
400 HARDHAT 461 HAMMER 1004 MEMO 3019 T-SQUARE 4193 INSTRUCTION-BOOKLET 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0>>
<CONSTANT PLAIN-OFFSET 300>
<CONSTANT CONSTRUCTION-OFFSET 400>
<CONSTANT OFFICES-OFFSET 1000>
<CONSTANT OFFICES-N-OFFSET 2000>
<CONSTANT OFFICES-S-OFFSET 3000>
<CONSTANT OFFICES-E-OFFSET 4000>
<CONSTANT OFFICES-W-OFFSET 5000>
<CONSTANT STORAGE-TABLE-LENGTH 200>
<DEFINE-ROUTINE PUT-IN-STORAGE>
<END-SEGMENT>
<BEGIN-SEGMENT LOWER>
<BEGIN-SEGMENT FENSHIRE>
<BEGIN-SEGMENT VILLAGE>
<DEFINE-ROUTINE STORE>
<DEFINE-ROUTINE UNSTORE>
<END-SEGMENT>

753
chess.zap Normal file
View File

@ -0,0 +1,753 @@
.SEGMENT "FENSHIRE"
.FUNCT PLAIN-F,RARG,PIECE
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "You are on an amazingly flat plain of "
ADD RANK,FILE
MOD STACK,2
ZERO? STACK \?CCL6
PRINTI "sun-bleached sand"
JUMP ?CND4
?CCL6: PRINTI "deep, rich loam"
?CND4: PRINTI ". The plain seems to stretch endlessly in all directions"
EQUAL? RANK,1,8 /?CCL8
EQUAL? FILE,1,8 \?CND7
?CCL8: PRINTI ", except to the "
EQUAL? RANK,1 \?CCL13
PRINTI "north"
EQUAL? FILE,1 \?CCL16
PRINTI " and west"
JUMP ?CND11
?CCL16: EQUAL? FILE,8 \?CND11
PRINTI " and east"
JUMP ?CND11
?CCL13: EQUAL? RANK,8 \?CCL19
PRINTI "south"
EQUAL? FILE,1 \?CCL22
PRINTI " and west"
JUMP ?CND11
?CCL22: EQUAL? FILE,8 \?CND11
PRINTI " and east"
JUMP ?CND11
?CCL19: EQUAL? FILE,1 \?CCL25
PRINTI "west"
JUMP ?CND11
?CCL25: PRINTI "east"
?CND11: PRINTI ", where the world seems to end in a gray void"
?CND7: PRINTC 46
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
CALL FIND-IN,HERE,BLACKBIT >PIECE
ZERO? PIECE \?PEN31
CALL FIND-IN,HERE,WHITEBIT >PIECE
?PEN31: ZERO? PIECE /FALSE
FSET? PIECE,TOUCHBIT /FALSE
FSET PIECE,TOUCHBIT
RANDOM 100
LESS? 30,STACK /FALSE
PRINTI " The "
ICALL2 DPRINT,PIECE
PRINTR " notices your cloak and bows gracefully. ""Greetings, Lordship. It's been a long time between moves -- I'll bet you've got a great one planned!"""
.FUNCT PLAIN-MOVEMENT-F,RARG
ZERO? RARG \FALSE
EQUAL? RANK,1 \?PRD6
EQUAL? PRSO,P?NW,P?NE,P?NORTH /?CCL4
?PRD6: EQUAL? RANK,8 \?PRD9
EQUAL? PRSO,P?SW,P?SE,P?SOUTH /?CCL4
?PRD9: EQUAL? FILE,8 \?PRD12
EQUAL? PRSO,P?SE,P?NE,P?EAST /?CCL4
?PRD12: EQUAL? FILE,1 \?CND1
EQUAL? PRSO,P?SW,P?NW,P?WEST \?CND1
?CCL4: PRINTI "The world ends at a gray void in that direction."
CRLF
RFALSE
?CND1: EQUAL? PRSO,P?NW,P?NE,P?NORTH \?CND17
DEC 'RANK
?CND17: EQUAL? PRSO,P?SW,P?SE,P?SOUTH \?CND19
INC 'RANK
?CND19: EQUAL? PRSO,P?NE,P?SE,P?EAST \?CND21
INC 'FILE
?CND21: EQUAL? PRSO,P?NW,P?SW,P?WEST \?CND23
DEC 'FILE
?CND23: ICALL STORE,PLAIN-OFFSET,PLAIN-LOC
SUB RANK,1
MUL STACK,8
ADD STACK,FILE
SUB STACK,1 >PLAIN-LOC
ICALL UNSTORE,PLAIN-OFFSET,PLAIN-LOC
RETURN PLAIN
.SEGMENT "0"
.FUNCT PIECE-F,ARG,CNT
FSET? WINNER,BLACKBIT /?CTR2
FSET? WINNER,WHITEBIT \?CCL3
?CTR2: ZERO? TIME-STOPPED /?CCL8
SET 'P-CONT,-1
PRINTI "Seemingly frozen,"
ICALL2 TPRINT,WINNER
PRINTR " is unresponsive."
?CCL8: EQUAL? PRSA,V?WALK \?CCL10
EQUAL? PRSO,P?UP,P?OUT,P?IN /?CTR9
EQUAL? PRSO,P?DOWN \?CCL10
?CTR9: SET 'DIR-CNT,0
PRINT CANNOT-TRAVEL
ICALL1 STOP
RTRUE
?CCL10: EQUAL? PRSA,V?WALK \?PRD18
ZERO? P-WALK-DIR \?CCL16
?PRD18: EQUAL? PRSA,V?MOVE \?CTR15
EQUAL? PRSO,INTDIR /?CCL16
?CTR15: SET 'DIR-CNT,0
EQUAL? PRSA,V?WALK \?CCL25
CALL NOUN-USED?,PRSO,W?ONE
ZERO? STACK /?CCL25
PRINTI "[The proper way to ask"
ICALL2 TPRINT,WINNER
PRINTR " to move is simply to tell the direction(s), as in >CHARACTER, NW.NW]"
?CCL25: SET 'P-CONT,-1
PRINTR """You can tell me directions. That's it."""
?CCL16: EQUAL? HERE,PLAIN,CONSTRUCTION /?CCL29
SET 'P-CONT,-1
PRINTR """The terrain is strange and unfamiliar; I am too terrified to move!"""
?CCL29: EQUAL? DIR-CNT,7 \?CCL31
SET 'DIR-CNT,0
SET 'P-CONT,-1
PRINTR """Too many directions!"""
?CCL31: EQUAL? PRSA,V?MOVE \?CND32
CALL1 DIRECTION-CONVERSION >PRSO
?CND32: PUT PIECE-MOVE-TABLE,DIR-CNT,PRSO
IGRTR? 'DIR-CNT,1 \?CCL36
EQUAL? WINNER,WHITE-KNIGHT,BLACK-KNIGHT /?CCL36
SUB DIR-CNT,2
GET PIECE-MOVE-TABLE,STACK
EQUAL? PRSO,STACK /?CCL36
SET 'DIR-CNT,0
COPYT PIECE-MOVE-TABLE,0,16
PRINT CANNOT-TRAVEL
ICALL1 STOP
RTRUE
?CCL36: ZERO? P-CONT \?CTR40
ZERO? M-PTR /?CCL41
?CTR40: SET 'CLOCK-WAIT,TRUE-VALUE
RTRUE
?CCL41: SET 'DIR-CNT,0
ICALL1 MOVE-PIECE
RTRUE
?CCL3: EQUAL? PRSA,V?ENTER \?CCL45
EQUAL? PRSO,WHITE-CASTLE \?CCL45
CALL NOUN-USED?,WHITE-CASTLE,W?MAN
ZERO? STACK \?CCL45
PRINTR "Oddly, there doesn't seem to be any entrance."
?CCL45: EQUAL? PRSA,V?ENTER \?CCL50
EQUAL? PRSO,BLACK-KNIGHT,WHITE-KNIGHT \?CCL50
CALL NOUN-USED?,PRSO,W?HORSE
ZERO? STACK /?CCL50
PRINTR "The horse isn't large enough for two riders."
?CCL50: EQUAL? PRSA,V?MOVE \?CCL55
PRINTI "Perhaps you should tell"
ICALL1 TPRINT-PRSO
PRINTR " the direction(s)."
?CCL55: EQUAL? PRSA,V?GIVE \?CCL57
FSET? PRSO,TRYTAKEBIT /?CCL57
CALL FIND-IN,PRSO,TRYTAKEBIT
ZERO? STACK \?CCL57
FSET? PRSI,WHITEBIT /?CTR56
FSET? PRSI,BLACKBIT \?CCL57
?CTR56: ZERO? TIME-STOPPED /?CND64
ICALL PERFORM,V?TELL,PRSI
RTRUE
?CND64: MOVE PRSO,PRSI
PRINTI "The "
ICALL2 DPRINT,PRSI
PRINTI " takes"
ICALL1 TPRINT-PRSO
PRINTC 46
EQUAL? PRSO,PIGEON \?CCL68
CALL2 META-LOC,PERCH
EQUAL? HERE,STACK /?CCL68
EQUAL? HERE,OUBLIETTE \?CTR67
EQUAL? REMOVED-PERCH-LOC,OUBLIETTE /?CCL68
?CTR67: CALL2 PIECE-TAKES-PIGEON,PRSI
RSTACK
?CCL68: PRINTR " ""Your graciousness is not unappreciated, your Lordship."""
?CCL57: EQUAL? PRSA,V?ASK-FOR \FALSE
LOC PRSI
FSET? STACK,WHITEBIT /?CCL75
LOC PRSI
FSET? STACK,BLACKBIT \FALSE
?CCL75: ICALL PERFORM,V?TAKE,PRSI
RTRUE
.FUNCT PIECE-TAKES-PIGEON,PIECE,DO-CR
ASSIGNED? 'DO-CR /?CND1
SET 'DO-CR,TRUE-VALUE
?CND1: ICALL2 MOVE-TO-PERCH,PIECE
PRINTI " Instantly,"
EQUAL? PIECE,WHITE-CASTLE \?CCL5
PRINTI " the tower"
JUMP ?CND3
?CCL5: ICALL2 TPRINT,PIECE
?CND3: PRINTI " seems to grow more distant without moving. Within seconds,"
EQUAL? PIECE,WHITE-CASTLE \?CCL8
PRINTI " the tower"
JUMP ?CND6
?CCL8: ICALL2 TPRINT,PIECE
?CND6: PRINTI " is gone."
ZERO? DO-CR /TRUE
CRLF
RTRUE
.FUNCT MOVE-PIECE,CNT,DIR,NEW-RANK,NEW-FILE,NEW-LOC,X,OFFSET,BLOCK,?TMP1
SET 'NEW-RANK,RANK
SET 'NEW-FILE,FILE
SUB NEW-RANK,1
MUL STACK,8 >?TMP1
SUB NEW-FILE,1
ADD ?TMP1,STACK >NEW-LOC
SET 'CNT,0
?PRG1: GET PIECE-MOVE-TABLE,CNT >DIR
EQUAL? DIR,FALSE-VALUE /?REP2
EQUAL? DIR,P?NORTH,P?NE,P?NW \?CND5
DEC 'NEW-RANK
?CND5: EQUAL? DIR,P?EAST,P?NE,P?SE \?CND7
INC 'NEW-FILE
?CND7: EQUAL? DIR,P?SOUTH,P?SE,P?SW \?CND9
INC 'NEW-RANK
?CND9: EQUAL? DIR,P?WEST,P?SW,P?NW \?CND11
DEC 'NEW-FILE
?CND11: INC 'CNT
EQUAL? HERE,CONSTRUCTION \?CND13
EQUAL? WINNER,BLACK-KNIGHT,WHITE-KNIGHT /?CND13
CALL OBSTRUCTION,NEW-LOC,DIR
ZERO? STACK /?CND13
SET 'BLOCK,TRUE-VALUE
EQUAL? DIR,P?EAST \?CCL20
EQUAL? NEW-LOC,47 \?CCL20
PRINTI """Appearances deceive you -- such a move would send me off the edge of the world!"""
CRLF
JUMP ?REP2
?CCL20: PRINTI """My word! There appears to be a wall in the way!"""
CRLF
JUMP ?REP2
?CND13: SUB NEW-RANK,1
MUL STACK,8 >?TMP1
SUB NEW-FILE,1
ADD ?TMP1,STACK >NEW-LOC
GET PIECE-MOVE-TABLE,CNT
ZERO? STACK /?PRG1
EQUAL? WINNER,BLACK-KNIGHT,WHITE-KNIGHT /?PRG1
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC
ZERO? STACK /?PRG1
SET 'BLOCK,TRUE-VALUE
PRINTI """Alas, the path between here and there is not unobstructed."""
CRLF
?REP2: GET PIECE-MOVE-TABLE,0
CALL2 DIR-TO-STRING,STACK >DIR
COPYT PIECE-MOVE-TABLE,0,16
ZERO? BLOCK \TRUE
CALL ILLEGAL-MOVE?,NEW-LOC,NEW-RANK,NEW-FILE >X
EQUAL? X,M-FATAL \?CCL32
PRINTR """That land is occupied!"""
?CCL32: ZERO? X /?CCL34
PRINT CANNOT-TRAVEL
CALL1 STOP
RSTACK
?CCL34: GRTR? NEW-RANK,8 /?CTR35
GRTR? NEW-FILE,8 /?CTR35
LESS? NEW-RANK,1 /?CTR35
LESS? NEW-FILE,1 \?CCL36
?CTR35: PRINTI """You would have me plunge off the end of the world"
EQUAL? HERE,CONSTRUCTION \?CND41
PRINTI " -- or whatever passes for the end of the world in this forsaken badland"
?CND41: PRINTR "!"""
?CCL36: CALL2 TAKE-PIECE?,NEW-LOC
ZERO? STACK \FALSE
REMOVE WINNER
PRINTI """I'm off!"" The "
PRINTD WINNER
EQUAL? WINNER,WHITE-KNIGHT,BLACK-KNIGHT \?CCL47
PRINTI " and his steed jump high into the air and vanish! A moment later, you hear a proud whinny in the distance."
JUMP ?CND45
?CCL47: PRINTI " moves out of sight to the "
PRINT DIR
PRINTC 46
?CND45: CRLF
EQUAL? WINNER,WHITE-PAWN \?CCL50
EQUAL? HERE,PLAIN \?CCL50
LESS? NEW-LOC,8 \?CCL50
ICALL ROB,WHITE-PAWN,WHITE-QUEEN
SET 'WINNER,WHITE-QUEEN
JUMP ?CND48
?CCL50: EQUAL? WINNER,BLACK-PAWN \?CND48
EQUAL? HERE,PLAIN \?CND48
GRTR? NEW-LOC,55 \?CND48
ICALL ROB,BLACK-PAWN,BLACK-QUEEN
SET 'WINNER,BLACK-QUEEN
?CND48: EQUAL? HERE,PLAIN \?CCL60
SET 'OFFSET,PLAIN-OFFSET
JUMP ?CND58
?CCL60: SET 'OFFSET,CONSTRUCTION-OFFSET
?CND58: ADD NEW-LOC,OFFSET
ICALL PIECE-SNARF,STACK,WINNER
CALL PUT-IN-STORAGE,OFFSET,WINNER,NEW-LOC
RSTACK
.FUNCT DIR-TO-STRING,DIR
EQUAL? DIR,P?UP \?CCL3
RETURN STR?912
?CCL3: EQUAL? DIR,P?DOWN \?CCL5
RETURN STR?913
?CCL5: EQUAL? DIR,P?NORTH \?CCL7
RETURN STR?198
?CCL7: EQUAL? DIR,P?NE \?CCL9
RETURN STR?828
?CCL9: EQUAL? DIR,P?EAST \?CCL11
RETURN STR?827
?CCL11: EQUAL? DIR,P?SE \?CCL13
RETURN STR?263
?CCL13: EQUAL? DIR,P?SOUTH \?CCL15
RETURN STR?199
?CCL15: EQUAL? DIR,P?SW \?CCL17
RETURN STR?826
?CCL17: EQUAL? DIR,P?WEST \?CCL19
RETURN STR?824
?CCL19: EQUAL? DIR,P?NW \FALSE
RETURN STR?825
.FUNCT PIECE-SNARF,NEW-LOC,SNARFER,OBJ,CNT,TOOK-PIGEON
?PRG1: LESS? CNT,STORAGE-TABLE-LENGTH \?REP2
GET STORAGE-TABLE,CNT
EQUAL? STACK,NEW-LOC \?CND3
ADD CNT,1
GET STORAGE-TABLE,STACK >OBJ
FSET? OBJ,TAKEBIT \?CND3
FSET? OBJ,TRYTAKEBIT /?CND3
CALL FIND-IN,OBJ,TRYTAKEBIT
ZERO? STACK \?CND3
EQUAL? OBJ,PIGEON \?CND12
SET 'TOOK-PIGEON,TRUE-VALUE
?CND12: MOVE OBJ,SNARFER
PUT STORAGE-TABLE,CNT,0
ADD CNT,1
PUT STORAGE-TABLE,STACK,0
?CND3: ADD CNT,2 >CNT
JUMP ?PRG1
?REP2: ZERO? TOOK-PIGEON /FALSE
CALL2 MOVE-TO-PERCH,SNARFER
RSTACK
.FUNCT TAKE-PIECE?,NEW-LOC,TAKEE,VAL
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC >TAKEE
ZERO? TAKEE \?CCL3
RETURN VAL
?CCL3: FSET? TAKEE,WHITEBIT \?PRD7
FSET? WINNER,WHITEBIT /?CTR4
?PRD7: FSET? TAKEE,BLACKBIT \?CCL5
FSET? WINNER,BLACKBIT \?CCL5
?CTR4: PRINTI """I cannot attack one of my own side!"""
CRLF
SET 'VAL,TRUE-VALUE
RETURN VAL
?CCL5: ICALL PIECE-AT-NEW-LOC?,NEW-LOC,TRUE-VALUE
RETURN VAL
.FUNCT ILLEGAL-MOVE?,NEW-LOC,NEW-RANK,NEW-FILE,TAKEE,OLD-LOC
EQUAL? HERE,PLAIN \?CCL3
SET 'OLD-LOC,PLAIN-LOC
JUMP ?CND1
?CCL3: SET 'OLD-LOC,CONSTRUCTION-LOC
?CND1: EQUAL? WINNER,WHITE-KNIGHT,BLACK-KNIGHT \?CCL6
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,6,10,15 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,17,-6,-10 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,-15,-17 /FALSE
RTRUE
?CCL6: EQUAL? WINNER,WHITE-KING,BLACK-KING \?CCL14
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,1,7,8 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,9,-1,-7 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,-8,-9 /FALSE
RTRUE
?CCL14: EQUAL? WINNER,BLACK-BISHOP \?CCL22
GRTR? OLD-LOC,NEW-LOC \?CCL25
SUB OLD-LOC,NEW-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB OLD-LOC,NEW-LOC
MOD STACK,9
ZERO? STACK /FALSE
RTRUE
?CCL25: SUB NEW-LOC,OLD-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB NEW-LOC,OLD-LOC
MOD STACK,9
ZERO? STACK /FALSE
RTRUE
?CCL22: EQUAL? WINNER,WHITE-CASTLE \?CCL37
EQUAL? RANK,NEW-RANK /FALSE
EQUAL? FILE,NEW-FILE /FALSE
RTRUE
?CCL37: EQUAL? WINNER,WHITE-QUEEN,BLACK-QUEEN \?CCL44
EQUAL? RANK,NEW-RANK /FALSE
EQUAL? FILE,NEW-FILE /FALSE
GRTR? NEW-LOC,OLD-LOC \?CCL51
SUB NEW-LOC,OLD-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB NEW-LOC,OLD-LOC
MOD STACK,9
ZERO? STACK /FALSE
?CCL51: GRTR? OLD-LOC,NEW-LOC \TRUE
SUB OLD-LOC,NEW-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB OLD-LOC,NEW-LOC
MOD STACK,9
ZERO? STACK /FALSE
RTRUE
?CCL44: EQUAL? WINNER,BLACK-PAWN \?CCL63
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC >TAKEE
EQUAL? OLD-LOC,14 \?CCL66
EQUAL? NEW-LOC,30 \?CCL66
ZERO? TAKEE /FALSE
RETURN 2
?CCL66: SUB NEW-LOC,OLD-LOC
EQUAL? STACK,7,9 \?CCL75
ZERO? TAKEE \FALSE
RTRUE
?CCL75: SUB NEW-LOC,OLD-LOC
EQUAL? STACK,8 \TRUE
ZERO? TAKEE /FALSE
RETURN 2
?CCL63: EQUAL? WINNER,WHITE-PAWN \?CCL87
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC >TAKEE
EQUAL? OLD-LOC,49 \?CCL90
EQUAL? NEW-LOC,33 \?CCL90
ZERO? TAKEE /FALSE
RETURN 2
?CCL90: SUB OLD-LOC,NEW-LOC
EQUAL? STACK,7,9 \?CCL99
ZERO? TAKEE \FALSE
RTRUE
?CCL99: SUB OLD-LOC,NEW-LOC
EQUAL? STACK,8 \TRUE
ZERO? TAKEE /FALSE
RETURN 2
?CCL87: PRINTR "Bug7"
.FUNCT PIECE-AT-NEW-LOC?,NEW-LOC,TAKE-PIECE,CNT,TAKEE
EQUAL? HERE,CONSTRUCTION \?CCL3
PUSH CONSTRUCTION-OFFSET
JUMP ?CND1
?CCL3: PUSH PLAIN-OFFSET
?CND1: ADD NEW-LOC,STACK >NEW-LOC
?PRG4: GET STORAGE-TABLE,CNT
EQUAL? NEW-LOC,STACK \?CND6
ADD CNT,1
GET STORAGE-TABLE,STACK >TAKEE
FSET? TAKEE,WHITEBIT /?CCL9
FSET? TAKEE,BLACKBIT \?CND6
?CCL9: ZERO? TAKE-PIECE /?REP5
ICALL ROB,TAKEE,WINNER
PUT STORAGE-TABLE,CNT,0
JUMP ?REP5
?CND6: ADD CNT,2 >CNT
LESS? CNT,STORAGE-TABLE-LENGTH /?PRG4
?REP5: ZERO? TAKEE /FALSE
FSET? TAKEE,WHITEBIT /?CTR19
FSET? TAKEE,BLACKBIT \FALSE
?CTR19: RETURN TAKEE
.FUNCT OBSTRUCTION,L,DIR,CALLED-BY-EXIT-F,CHANGE
EQUAL? DIR,P?NORTH \?CCL3
INTBL? L,NORTH-EXITS,11 /?CTR2
ADD L,100
INTBL? STACK,NORTH-EXITS,11 \?CCL3
?CTR2: SET 'CHANGE,-8
JUMP ?CND1
?CCL3: EQUAL? DIR,P?NE \?CCL9
INTBL? L,NE-EXITS,17 \?CCL9
SET 'CHANGE,-7
JUMP ?CND1
?CCL9: EQUAL? DIR,P?EAST \?CCL13
EQUAL? L,47 \?CCL16
ZERO? CALLED-BY-EXIT-F /?CCL16
SET 'CHANGE,100
JUMP ?CND1
?CCL16: INTBL? L,EAST-EXITS,15 \?CND1
SET 'CHANGE,1
JUMP ?CND1
?CCL13: EQUAL? DIR,P?SE \?CCL21
INTBL? L,SE-EXITS,7 /?CTR20
ADD L,100
INTBL? STACK,SE-EXITS,7 \?CCL21
?CTR20: SET 'CHANGE,9
JUMP ?CND1
?CCL21: EQUAL? DIR,P?SOUTH \?CCL27
ADD L,8
INTBL? STACK,NORTH-EXITS,11 /?CTR26
ADD L,108
INTBL? STACK,NORTH-EXITS,11 \?CCL27
?CTR26: SET 'CHANGE,8
JUMP ?CND1
?CCL27: EQUAL? DIR,P?SW \?CCL33
ADD L,7
INTBL? STACK,NE-EXITS,17 \?CCL33
SET 'CHANGE,7
JUMP ?CND1
?CCL33: EQUAL? DIR,P?WEST \?CCL37
SUB L,1
INTBL? STACK,EAST-EXITS,15 \?CCL37
SET 'CHANGE,-1
JUMP ?CND1
?CCL37: EQUAL? DIR,P?NW \?CND1
SUB L,9
INTBL? STACK,SE-EXITS,7 /?CCL40
ADD L,91
INTBL? STACK,SE-EXITS,7 \?CND1
?CCL40: SET 'CHANGE,-9
?CND1: ZERO? CALLED-BY-EXIT-F /?CCL47
RETURN CHANGE
?CCL47: ZERO? CHANGE /TRUE
RFALSE
.ENDSEG
.SEGMENT "LOWER"
.FUNCT CONSTRUCTION-ENTER-F,RARG
ZERO? RARG \FALSE
SET 'CONSTRUCTION-LOC,47
RETURN CONSTRUCTION
.SEGMENT "0"
.FUNCT HAMMER-F
EQUAL? PRSA,V?KILL \?CCL3
EQUAL? PRSI,HAMMER \?CCL3
ICALL PERFORM,V?MUNG,PRSO,HAMMER
RTRUE
?CCL3: EQUAL? PRSA,V?MUNG \FALSE
EQUAL? PRSI,HAMMER \FALSE
FSET? PRSO,ANIMATEDBIT \FALSE
PRINTI "Fortunately,"
ICALL1 TPRINT-PRSO
PRINTR " evades your blow."
.ENDSEG
.SEGMENT "LOWER"
.FUNCT CONSTRUCTION-F,RARG,CNT
EQUAL? RARG,M-LOOK \?CCL3
INTBL? CONSTRUCTION-LOC,NORTH-EXITS,11 \?CND4
INC 'CNT
?CND4: INTBL? CONSTRUCTION-LOC,NE-EXITS,17 \?CND6
INC 'CNT
?CND6: INTBL? CONSTRUCTION-LOC,EAST-EXITS,15 \?CND8
INC 'CNT
?CND8: INTBL? CONSTRUCTION-LOC,SE-EXITS,7 \?CND10
INC 'CNT
?CND10: ADD CONSTRUCTION-LOC,8
INTBL? STACK,NORTH-EXITS,11 \?CND12
INC 'CNT
?CND12: ADD CONSTRUCTION-LOC,7
INTBL? STACK,NE-EXITS,17 \?CND14
INC 'CNT
?CND14: SUB CONSTRUCTION-LOC,1
INTBL? STACK,EAST-EXITS,15 \?CND16
INC 'CNT
?CND16: SUB CONSTRUCTION-LOC,9
INTBL? STACK,SE-EXITS,7 \?CND18
INC 'CNT
?CND18: PRINTI "You are in an abandoned underground construction site, roughly octagonal in shape. "
GRTR? CNT,0 \?CND20
PRINTI "There "
EQUAL? CNT,1 \?CCL24
PRINTI "is an exit"
JUMP ?CND22
?CCL24: PRINTI "are exits"
?CND22: PRINTI " to the "
INTBL? CONSTRUCTION-LOC,NORTH-EXITS,11 \?CND25
PRINTI "north"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND25: INTBL? CONSTRUCTION-LOC,NE-EXITS,17 \?CND27
PRINTI "northeast"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND27: INTBL? CONSTRUCTION-LOC,EAST-EXITS,15 \?CND29
PRINTI "east"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND29: INTBL? CONSTRUCTION-LOC,SE-EXITS,7 \?CND31
PRINTI "southeast"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND31: ADD CONSTRUCTION-LOC,8
INTBL? STACK,NORTH-EXITS,11 \?CND33
PRINTI "south"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND33: ADD CONSTRUCTION-LOC,7
INTBL? STACK,NE-EXITS,17 \?CND35
PRINTI "southwest"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND35: SUB CONSTRUCTION-LOC,1
INTBL? STACK,EAST-EXITS,15 \?CND37
PRINTI "west"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND37: SUB CONSTRUCTION-LOC,9
INTBL? STACK,SE-EXITS,7 \?CND39
PRINTI "northwest"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND39: PRINTI ". "
?CND20: EQUAL? CONSTRUCTION-LOC,47 \?CND41
PRINTI "Also, a heavily used passage leads east. "
?CND41: PRINTI "Engraved on the wall is the number "
PRINTN CONSTRUCTION-LOC
PRINTC 46
RTRUE
?CCL3: EQUAL? RARG,M-ENTER \FALSE
DIV CONSTRUCTION-LOC,8
ADD STACK,1 >RANK
MOD CONSTRUCTION-LOC,8
ADD STACK,1 >FILE
CALL UNSTORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
RSTACK
.FUNCT AND-OR-COMMA,CNT
EQUAL? CNT,1 \?CCL3
PRINTI " and "
RTRUE
?CCL3: GRTR? CNT,1 \FALSE
PRINTI ", "
RTRUE
.FUNCT CONSTRUCTION-MOVEMENT-F,RARG,CHANGE
ZERO? RARG \FALSE
ICALL STORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
CALL OBSTRUCTION,CONSTRUCTION-LOC,PRSO,TRUE-VALUE >CHANGE
EQUAL? CHANGE,100 \?CND3
RETURN FIELD-OFFICE
?CND3: DIV CONSTRUCTION-LOC,8
ADD STACK,1 >RANK
MOD CONSTRUCTION-LOC,8
ADD STACK,1 >FILE
ZERO? CHANGE \?CCL7
ICALL UNSTORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
ICALL1 CANT-GO
RFALSE
?CCL7: ADD CONSTRUCTION-LOC,CHANGE >CONSTRUCTION-LOC
ICALL UNSTORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
RETURN CONSTRUCTION
.SEGMENT "0"
.FUNCT REMOVE-ANY-PIECE,L,TAKER,TAKEE,CNT
?PRG1: LESS? CNT,STORAGE-TABLE-LENGTH \TRUE
GET STORAGE-TABLE,CNT
EQUAL? STACK,L \?CND3
ADD CNT,1
GET STORAGE-TABLE,STACK >TAKEE
FSET? TAKEE,WHITEBIT /?CCL8
FSET? TAKEE,BLACKBIT \?CND3
?CCL8: ICALL ROB,TAKEE,TAKER
PUT STORAGE-TABLE,CNT,0
ADD CNT,1
PUT STORAGE-TABLE,STACK,0
?CND3: ADD CNT,2 >CNT
JUMP ?PRG1
.FUNCT PUT-IN-STORAGE,OFFSET,OBJ,L,CNT
?PRG1: GET STORAGE-TABLE,CNT
ZERO? STACK \?CCL5
ADD L,OFFSET
PUT STORAGE-TABLE,CNT,STACK
ADD CNT,1
PUT STORAGE-TABLE,STACK,OBJ
RTRUE
?CCL5: ADD CNT,2 >CNT
JUMP ?PRG1
.ENDSEG
.SEGMENT "VILLAGE"
.SEGMENT "FENSHIRE"
.SEGMENT "LOWER"
.FUNCT STORE,OFFSET,L,RM,CNT,F,N
ASSIGNED? 'RM /?CND1
SET 'RM,HERE
?CND1: FIRST? RM >F /?PRG4
?PRG4: ZERO? F /TRUE
NEXT? F >N /?CND6
?CND6: EQUAL? F,PROTAGONIST /?CND10
?PRG12: EQUAL? F,JESTER \?CCL16
ICALL1 REMOVE-J
JUMP ?CND10
?CCL16: GET STORAGE-TABLE,CNT
ZERO? STACK \?CCL18
ADD L,OFFSET
PUT STORAGE-TABLE,CNT,STACK
ADD CNT,1
PUT STORAGE-TABLE,STACK,F
ADD CNT,2 >CNT
REMOVE F
?CND10: SET 'F,N
JUMP ?PRG4
?CCL18: ADD CNT,2 >CNT
JUMP ?PRG12
.FUNCT UNSTORE,OFFSET,L,RM,CNT,?TMP1
ASSIGNED? 'RM /?PRG3
SET 'RM,HERE
?PRG3: LESS? CNT,STORAGE-TABLE-LENGTH \TRUE
GET STORAGE-TABLE,CNT >?TMP1
ADD L,OFFSET
EQUAL? ?TMP1,STACK \?CND5
ADD CNT,1
GET STORAGE-TABLE,STACK
MOVE STACK,RM
PUT STORAGE-TABLE,CNT,0
ADD CNT,1
PUT STORAGE-TABLE,STACK,0
?CND5: ADD CNT,2 >CNT
JUMP ?PRG3
.ENDSEG
.ENDI

937
chess.zil Normal file
View File

@ -0,0 +1,937 @@
"CHESS for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<BEGIN-SEGMENT FENSHIRE>
<GLOBAL RANK 2> ;"used for both Plain and Construction"
<GLOBAL FILE 5> ;"used for both Plain and Construction"
<GLOBAL PLAIN-LOC 12>
<ROOM PLAIN
(LOC ROOMS)
(REGION "Region: Unknown")
(DESC "Plain")
(NORTH PER PLAIN-MOVEMENT-F)
(NE PER PLAIN-MOVEMENT-F)
(EAST PER PLAIN-MOVEMENT-F)
(SE PER PLAIN-MOVEMENT-F)
(SOUTH PER PLAIN-MOVEMENT-F)
(SW PER PLAIN-MOVEMENT-F)
(WEST PER PLAIN-MOVEMENT-F)
(NW PER PLAIN-MOVEMENT-F)
(FLAGS RLANDBIT OUTSIDEBIT ONBIT)
(VALUE 16)
(ACTION PLAIN-F)>
;"if the sum of RANK and FILE is even, you're on a white square. If the sum
is odd, you're on a black square."
<ROUTINE PLAIN-F ("OPT" (RARG <>) "AUX" PIECE)
<COND (<EQUAL? .RARG ,M-LOOK>
<TELL "You are on an amazingly flat plain of ">
<COND (<EQUAL? <MOD <+ ,RANK ,FILE> 2> 0>
<TELL "sun-bleached sand">)
(T
<TELL "deep, rich loam">)>
<TELL
". The plain seems to stretch endlessly in all directions">
<COND (<OR <EQUAL? ,RANK 1 8>
<EQUAL? ,FILE 1 8>>
<TELL ", except to the ">
<COND (<EQUAL? ,RANK 1>
<TELL "north">
<COND (<EQUAL? ,FILE 1>
<TELL " and west">)
(<EQUAL? ,FILE 8>
<TELL " and east">)>)
(<EQUAL? ,RANK 8>
<TELL "south">
<COND (<EQUAL? ,FILE 1>
<TELL " and west">)
(<EQUAL? ,FILE 8>
<TELL " and east">)>)
(<EQUAL? ,FILE 1>
<TELL "west">)
(T
<TELL "east">)>
<TELL ", where the world seems to end in a gray void">)>
<TELL ".">)
(<AND <EQUAL? .RARG ,M-END>
<SET PIECE <OR <FIND-IN ,HERE ,BLACKBIT>
<FIND-IN ,HERE ,WHITEBIT>>>
<NOT <FSET? .PIECE ,TOUCHBIT>>>
<FSET .PIECE ,TOUCHBIT>
<COND (<PROB 30>
<TELL
" The " D .PIECE " notices your cloak and bows gracefully. \"Greetings,
Lordship. It's been a long time between moves -- I'll bet you've got a great
one planned!\"" CR>)>)>>
<ROUTINE PLAIN-MOVEMENT-F ("OPTIONAL" (RARG <>)) ;"called by NEXT-ROOM?"
<COND (.RARG
<RFALSE>)
(<OR <AND <EQUAL? ,RANK 1>
<PRSO? ,P?NORTH ,P?NE ,P?NW>>
<AND <EQUAL? ,RANK 8>
<PRSO? ,P?SOUTH ,P?SE ,P?SW>>
<AND <EQUAL? ,FILE 8>
<PRSO? ,P?EAST ,P?NE ,P?SE>>
<AND <EQUAL? ,FILE 1>
<PRSO? ,P?WEST ,P?NW ,P?SW>>>
<TELL "The world ends at a gray void in that direction." CR>
<RFALSE>)>
<COND (<PRSO? ,P?NORTH ,P?NE ,P?NW>
<SETG RANK <- ,RANK 1>>)>
<COND (<PRSO? ,P?SOUTH ,P?SE ,P?SW>
<SETG RANK <+ ,RANK 1>>)>
<COND (<PRSO? ,P?EAST ,P?SE ,P?NE>
<SETG FILE <+ ,FILE 1>>)>
<COND (<PRSO? ,P?WEST ,P?SW ,P?NW>
<SETG FILE <- ,FILE 1>>)>
<STORE ,PLAIN-OFFSET ,PLAIN-LOC>
<SETG PLAIN-LOC <- <+ <* <- ,RANK 1> 8> ,FILE> 1>>
<UNSTORE ,PLAIN-OFFSET ,PLAIN-LOC>
,PLAIN>
<OBJECT BLACK-KNIGHT
(DESC "mounted soldier")
(LDESC
"There is a soldier on horseback here. His armor is made of the dullest
metals, and his steed is darker than the night.")
(SYNONYM SOLDIER KNIGHT HORSE MAN)
(ADJECTIVE MOUNTED BLACK)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-KNIGHT
(DESC "mounted soldier")
(LDESC
"There is a soldier on horseback here. His armor is made of the shiniest
metals, and his steed is lighter than drifted snow.")
(SYNONYM SOLDIER KNIGHT HORSE MAN)
(ADJECTIVE MOUNTED WHITE)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT)
(ACTION PIECE-F)>
<OBJECT BLACK-PAWN
(DESC "foot soldier")
(LDESC
"You spot a solitary, bored-looking foot soldier. His face is smudged with
coal dust, his uniform is sewn from deeply dyed wool, and the handle of his
sword is solid obsidian.")
(SYNONYM SOLDIER PAWN MAN)
(ADJECTIVE FOOT BLACK)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT)
(ACTION PIECE-F)>
<OBJECT BLACK-QUEEN
(DESC "queen")
(LDESC
"A regal woman proudly surveys the landscape in all directions. Her skin
is dark; her royal garments even darker.")
(SYNONYM QUEEN WOMAN)
(ADJECTIVE REGAL PROUD DARK BLACK)
(FLAGS ACTORBIT FEMALEBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-CASTLE
(DESC "man atop a castle tower")
(LDESC
"Nearby rises a small tower keep, made of creamy marble. Between the
crenellations of the parapet you spot a man, dressed in an ivory chain
mail and carrying a crossbow made of birch.")
(SYNONYM MAN TOWER CASTLE ROOK)
(ADJECTIVE CASTLE WHITE)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT)
(ACTION PIECE-F)>
<OBJECT BLACK-BISHOP
(DESC "high priest")
(LDESC
"You hear a sing-song prayer chant and turn to see a high priest of some sort.
His tall, ebony headpiece bears a religious cipher, and his vestments seem to
soak up all light.")
(SYNONYM PRIEST BISHOP MAN)
(ADJECTIVE HIGH BLACK)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-PAWN
(DESC "foot soldier")
(LDESC
"You spot a solitary, bored-looking foot soldier. His face is smudged with
flour, his uniform is sewn from pure undyed cotton, and the handle of his
sword is solid quartz.")
(SYNONYM SOLDIER PAWN MAN)
(ADJECTIVE WHITE FOOT)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-QUEEN
(DESC "queen")
(LDESC
"A regal woman proudly surveys the landscape in all directions. Her royal
garments are as white as her pale complexion.")
(SYNONYM QUEEN WOMAN)
(ADJECTIVE REGAL PROUD WHITE)
(FLAGS ACTORBIT FEMALEBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-KING
(DESC "royal leader")
(LDESC
"A tall man wearing princely robes stands nearby. His bearing indicates that
this is a man accustomed to command. His linen robes are trimmed with ermine,
and his crown is studded with diamonds and opals.")
(SYNONYM LEADER KING MAN)
(ADJECTIVE ROYAL WHITE TALL)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT WHITEBIT)
(ACTION PIECE-F)>
<OBJECT WHITE-KING-CROWN
(LOC WHITE-KING)
(DESC "crown")
(SYNONYM CROWN)
(FLAGS NDESCBIT)>
<OBJECT WHITE-KING-ROBE
(LOC WHITE-KING)
(DESC "robe")
(SYNONYM ROBE)
(FLAGS NDESCBIT)>
<OBJECT BLACK-KING
(DESC "royal leader")
(LDESC
"A tall man wearing princely robes stands nearby. His bearing indicates that
this is a man accustomed to command. His velvet robes are trimmed with mink,
and his crown is studded with polished onyx.")
(SYNONYM LEADER KING MAN)
(ADJECTIVE ROYAL BLACK TALL)
(FLAGS ACTORBIT CONTBIT OPENBIT SEARCHBIT BLACKBIT)
(ACTION PIECE-F)>
<OBJECT BLACK-KING-ROBE
(LOC BLACK-KING)
(DESC "robe")
(SYNONYM ROBE)
(FLAGS NDESCBIT)>
<OBJECT BLACK-KING-CROWN
(LOC BLACK-KING)
(DESC "crown")
(SYNONYM CROWN)
(FLAGS NDESCBIT)>
<BEGIN-SEGMENT 0>
;<BEGIN-SEGMENT VILLAGE>
;<BEGIN-SEGMENT LOWER>
<GLOBAL DIR-CNT 0>
<ROUTINE PIECE-F ("OPT" (ARG <>) "AUX" CNT)
<COND (<OR <FSET? ,WINNER ,BLACKBIT>
<FSET? ,WINNER ,WHITEBIT>>
<COND (,TIME-STOPPED
<SETG P-CONT -1>
<TELL
"Seemingly frozen," T ,WINNER " is unresponsive." CR>)
(<AND <VERB? WALK>
<PRSO? ,P?IN ,P?OUT ,P?UP ,P?DOWN>>
<SETG DIR-CNT 0>
<TELL ,CANNOT-TRAVEL>
<STOP>)
(<AND <NOT <AND <VERB? WALK>
<T? ,P-WALK-DIR>>>
<NOT <AND <VERB? MOVE>
<PRSO? ,INTDIR>>>>
<SETG DIR-CNT 0>
<COND (<AND <VERB? WALK> ;"as in >ROOK, GO SOUTH ONE"
;<PRSO? ,WALL>
<NOUN-USED? ,PRSO ,W?ONE>>
<TELL
"[The proper way to ask" T ,WINNER " to move is simply to tell
the direction(s), as in >CHARACTER, NW.NW]" CR>)
(T
<SETG P-CONT -1>
<TELL
"\"You can tell me directions. That's it.\"" CR>)>)
(<NOT <EQUAL? ,HERE ,PLAIN ,CONSTRUCTION>>
<SETG P-CONT -1>
<TELL
"\"The terrain is strange and unfamiliar; I am too terrified to move!\"" CR>)
(<EQUAL? ,DIR-CNT 7>
<SETG DIR-CNT 0>
<SETG P-CONT -1>
<TELL "\"Too many directions!\"" CR>)
(T
<COND (<VERB? MOVE>
<SETG PRSO <DIRECTION-CONVERSION>>)>
<PUT ,PIECE-MOVE-TABLE ,DIR-CNT ,PRSO>
<SETG DIR-CNT <+ ,DIR-CNT 1>>
<COND (<AND <G? ,DIR-CNT 1>
<NOT <EQUAL? ,WINNER
,WHITE-KNIGHT
,BLACK-KNIGHT>>
<NOT <EQUAL? ,PRSO
<GET ,PIECE-MOVE-TABLE
<- ,DIR-CNT 2>>>>>
;"checks to make sure that all directions given
are the same, except in the case of knights"
<SETG DIR-CNT 0>
<COPYT ,PIECE-MOVE-TABLE 0 16>
<TELL ,CANNOT-TRAVEL>
<STOP>)
(<OR ,P-CONT ,M-PTR>
<SETG CLOCK-WAIT T>)
(T
<SETG DIR-CNT 0>
<MOVE-PIECE>)>)>
<RTRUE>)
(<AND <VERB? ENTER>
<PRSO? ,WHITE-CASTLE>
<NOT <NOUN-USED? ,WHITE-CASTLE ,W?MAN>>>
<TELL "Oddly, there doesn't seem to be any entrance." CR>)
(<AND <VERB? ENTER>
<PRSO? ,WHITE-KNIGHT ,BLACK-KNIGHT>
<NOUN-USED? ,PRSO ,W?HORSE>>
<TELL "The horse isn't large enough for two riders." CR>)
(<VERB? MOVE>
<TELL
"Perhaps you should tell" T ,PRSO " the direction(s)." CR>)
(<AND <VERB? GIVE>
<NOT <FSET? ,PRSO ,TRYTAKEBIT>>
<NOT <FIND-IN ,PRSO ,TRYTAKEBIT>>
<OR <FSET? ,PRSI ,WHITEBIT>
<FSET? ,PRSI ,BLACKBIT>>>
<COND (,TIME-STOPPED
<PERFORM ,V?TELL ,PRSI>
<RTRUE>)>
<MOVE ,PRSO ,PRSI>
<TELL "The " D ,PRSI " takes" T ,PRSO ".">
<COND (<AND <PRSO? ,PIGEON>
<NOT <EQUAL? ,HERE <META-LOC ,PERCH>>>
<OR <NOT <EQUAL? ,HERE ,OUBLIETTE>>
<NOT <EQUAL? ,REMOVED-PERCH-LOC ,OUBLIETTE>>>>
<PIECE-TAKES-PIGEON ,PRSI>)
(T
<TELL
" \"Your graciousness is not unappreciated, your Lordship.\"" CR>)>)
(<AND <VERB? ASK-FOR>
<OR <FSET? <LOC ,PRSI> ,WHITEBIT>
<FSET? <LOC ,PRSI> ,BLACKBIT>>>
<PERFORM ,V?TAKE ,PRSI>
<RTRUE>)>>
<ROUTINE PIECE-TAKES-PIGEON (PIECE "OPTIONAL" (DO-CR T))
<MOVE-TO-PERCH .PIECE>
<TELL " Instantly,">
<COND (<EQUAL? .PIECE ,WHITE-CASTLE>
<TELL " the tower">)
(T
<TELL T .PIECE>)>
<TELL " seems to grow more distant without moving. Within seconds,">
<COND (<EQUAL? .PIECE ,WHITE-CASTLE>
<TELL " the tower">)
(T
<TELL T .PIECE>)>
<TELL " is gone.">
<COND (.DO-CR
<CRLF>)>
<RTRUE>>
<CONSTANT PIECE-MOVE-TABLE
<TABLE 0 0 0 0 0 0 0 0>>
<ROUTINE MOVE-PIECE
("AUX" CNT DIR NEW-RANK NEW-FILE NEW-LOC X OFFSET BLOCK)
<SET NEW-RANK ,RANK>
<SET NEW-FILE ,FILE>
<SET NEW-LOC <+ <* <- .NEW-RANK 1> 8> <- .NEW-FILE 1>>>
<SET CNT 0>
<REPEAT ()
<SET DIR <GET ,PIECE-MOVE-TABLE .CNT>>
<COND (<EQUAL? .DIR <>>
<RETURN>)>
<COND (<EQUAL? .DIR ,P?NORTH ,P?NE ,P?NW>
<SET NEW-RANK <- .NEW-RANK 1>>)>
<COND (<EQUAL? .DIR ,P?EAST ,P?NE ,P?SE>
<SET NEW-FILE <+ .NEW-FILE 1>>)>
<COND (<EQUAL? .DIR ,P?SOUTH ,P?SE ,P?SW>
<SET NEW-RANK <+ .NEW-RANK 1>>)>
<COND (<EQUAL? .DIR ,P?WEST ,P?SW ,P?NW>
<SET NEW-FILE <- .NEW-FILE 1>>)>
<SET CNT <+ .CNT 1>>
<COND (<AND <EQUAL? ,HERE ,CONSTRUCTION>
<NOT <EQUAL? ,WINNER ,BLACK-KNIGHT ,WHITE-KNIGHT>>
<OBSTRUCTION .NEW-LOC .DIR>>
<SET BLOCK T>
<COND (<AND <EQUAL? .DIR ,P?EAST>
<EQUAL? .NEW-LOC 47>>
<TELL
"\"Appearances deceive you -- such a move would send me
off the edge of the world!\"" CR>)
(T
<TELL
"\"My word! There appears to be a wall in the way!\"" CR>)>
<RETURN>)>
<SET NEW-LOC <+ <* <- .NEW-RANK 1> 8> <- .NEW-FILE 1>>>
<COND (<AND <GET ,PIECE-MOVE-TABLE .CNT>
<NOT <EQUAL? ,WINNER ,BLACK-KNIGHT ,WHITE-KNIGHT>>
<PIECE-AT-NEW-LOC? .NEW-LOC>>
<SET BLOCK T>
<TELL
"\"Alas, the path between here and there is not unobstructed.\"" CR>
<RETURN>)>>
<SET DIR <DIR-TO-STRING <GET ,PIECE-MOVE-TABLE 0>>>
;"for later use, after chess piece says 'I'm off!'"
<COPYT ,PIECE-MOVE-TABLE 0 16>
<COND (.BLOCK ;"obstructed path to new square"
<RTRUE>)>
<SET X <ILLEGAL-MOVE? .NEW-LOC .NEW-RANK .NEW-FILE>>
<COND (<EQUAL? .X ,M-FATAL> ;"pawn blocked by another piece"
<TELL "\"That land is occupied!\"" CR>
<RTRUE>)
(.X
<TELL ,CANNOT-TRAVEL>
<STOP>)
(<OR <G? .NEW-RANK 8>
<G? .NEW-FILE 8>
<L? .NEW-RANK 1>
<L? .NEW-FILE 1>>
<TELL
"\"You would have me plunge off the end of the world">
<COND (<EQUAL? ,HERE ,CONSTRUCTION>
<TELL
" -- or whatever passes for the end of the world in this forsaken badland">)>
<TELL "!\"" CR>)
(<NOT <TAKE-PIECE? .NEW-LOC>>
<REMOVE ,WINNER>
<TELL "\"I'm off!\" The " 'WINNER>
<COND (<EQUAL? ,WINNER ,WHITE-KNIGHT ,BLACK-KNIGHT>
<TELL
" and his steed jump high into the air and vanish! A moment later, you hear
a proud whinny in the distance.">)
(T
<TELL " moves out of sight to the " .DIR ".">)>
<CRLF>
<COND (<AND <EQUAL? ,WINNER ,WHITE-PAWN>
<EQUAL? ,HERE ,PLAIN>
<L? .NEW-LOC 8>> ;"promote pawn to queen"
<ROB ,WHITE-PAWN ,WHITE-QUEEN>
<SETG WINNER ,WHITE-QUEEN>)
(<AND <EQUAL? ,WINNER ,BLACK-PAWN>
<EQUAL? ,HERE ,PLAIN>
<G? .NEW-LOC 55>> ;"promote pawn to queen"
<ROB ,BLACK-PAWN ,BLACK-QUEEN>
<SETG WINNER ,BLACK-QUEEN>)>
<COND (<EQUAL? ,HERE ,PLAIN>
<SET OFFSET ,PLAIN-OFFSET>)
(T
<SET OFFSET ,CONSTRUCTION-OFFSET>)>
<PIECE-SNARF <+ .NEW-LOC .OFFSET> ,WINNER>
<PUT-IN-STORAGE .OFFSET ,WINNER .NEW-LOC>)>>
<ROUTINE DIR-TO-STRING (DIR)
<COND (<EQUAL? .DIR ,P?UP>
<RETURN "up">)
(<EQUAL? .DIR ,P?DOWN>
<RETURN "down">)
(<EQUAL? .DIR ,P?NORTH>
<RETURN "north">)
(<EQUAL? .DIR ,P?NE>
<RETURN "northeast">)
(<EQUAL? .DIR ,P?EAST>
<RETURN "east">)
(<EQUAL? .DIR ,P?SE>
<RETURN "southeast">)
(<EQUAL? .DIR ,P?SOUTH>
<RETURN "south">)
(<EQUAL? .DIR ,P?SW>
<RETURN "southwest">)
(<EQUAL? .DIR ,P?WEST>
<RETURN "west">)
(<EQUAL? .DIR ,P?NW>
<RETURN "northwest">)>>
<ROUTINE PIECE-SNARF (NEW-LOC SNARFER "AUX" OBJ (CNT 0) (TOOK-PIGEON <>))
<REPEAT ()
<COND (<NOT <L? .CNT ,STORAGE-TABLE-LENGTH>>
<RETURN>)
(<EQUAL? <GET ,STORAGE-TABLE .CNT> .NEW-LOC>
<SET OBJ <GET ,STORAGE-TABLE <+ .CNT 1>>>
<COND (<AND <FSET? .OBJ ,TAKEBIT>
<NOT <FSET? .OBJ ,TRYTAKEBIT>>
<NOT <FIND-IN .OBJ ,TRYTAKEBIT>>>
<COND (<EQUAL? .OBJ ,PIGEON>
<SET TOOK-PIGEON T>)>
<MOVE .OBJ .SNARFER>
<PUT ,STORAGE-TABLE .CNT 0>
<PUT ,STORAGE-TABLE <+ .CNT 1> 0>)>)>
<SET CNT <+ .CNT 2>>>
<COND (.TOOK-PIGEON
<MOVE-TO-PERCH .SNARFER>)>>
<ROUTINE TAKE-PIECE? (NEW-LOC "AUX" (TAKEE <>) (VAL <>))
<SET TAKEE <PIECE-AT-NEW-LOC? .NEW-LOC>>
<COND (<NOT .TAKEE>
T)
(<OR <AND <FSET? .TAKEE ,WHITEBIT>
<FSET? ,WINNER ,WHITEBIT>>
<AND <FSET? .TAKEE ,BLACKBIT>
<FSET? ,WINNER ,BLACKBIT>>>
<TELL "\"I cannot attack one of my own side!\"" CR>
<SET VAL T>)
(T ;"take the TAKEE"
<PIECE-AT-NEW-LOC? .NEW-LOC T>)>
<RETURN .VAL> ;"this routine is called by a predicate">
<ROUTINE ILLEGAL-MOVE? (NEW-LOC NEW-RANK NEW-FILE "AUX" (TAKEE <>) OLD-LOC)
<SET OLD-LOC <COND (<EQUAL? ,HERE ,PLAIN>
,PLAIN-LOC)
(T
,CONSTRUCTION-LOC)>>
<COND (<EQUAL? ,WINNER ,WHITE-KNIGHT ,BLACK-KNIGHT>
<COND (<EQUAL? <- .OLD-LOC .NEW-LOC>
6 10 15 17 -6 -10 -15 -17>
<RFALSE>)
(T
<RTRUE>)>)
(<EQUAL? ,WINNER ,WHITE-KING ,BLACK-KING>
<COND (<EQUAL? <- .OLD-LOC .NEW-LOC>
1 7 8 9 -1 -7 -8 -9>
<RFALSE>)
(T
<RTRUE>)>)
(<EQUAL? ,WINNER ,BLACK-BISHOP>
<COND (<G? .OLD-LOC .NEW-LOC>
<COND (<EQUAL? <MOD <- .OLD-LOC .NEW-LOC> 7> 0>
<RFALSE>)
(<EQUAL? <MOD <- .OLD-LOC .NEW-LOC> 9> 0>
<RFALSE>)
(T
<RTRUE>)>)
(T
<COND (<EQUAL? <MOD <- .NEW-LOC .OLD-LOC> 7> 0>
<RFALSE>)
(<EQUAL? <MOD <- .NEW-LOC .OLD-LOC> 9> 0>
<RFALSE>)
(T
<RTRUE>)>)>)
(<EQUAL? ,WINNER ,WHITE-CASTLE>
<COND (<AND <NOT <EQUAL? ,RANK .NEW-RANK>>
<NOT <EQUAL? ,FILE .NEW-FILE>>>
<RTRUE>)
(T
<RFALSE>)>)
(<EQUAL? ,WINNER ,WHITE-QUEEN ,BLACK-QUEEN>
<COND (<OR <EQUAL? ,RANK .NEW-RANK>
<EQUAL? ,FILE .NEW-FILE>>
<RFALSE>)
(<AND <G? .NEW-LOC .OLD-LOC>
<OR <EQUAL? <MOD <- .NEW-LOC .OLD-LOC> 7> 0>
<EQUAL? <MOD <- .NEW-LOC .OLD-LOC> 9> 0>>>
<RFALSE>)
(<AND <G? .OLD-LOC .NEW-LOC>
<OR <EQUAL? <MOD <- .OLD-LOC .NEW-LOC> 7> 0>
<EQUAL? <MOD <- .OLD-LOC .NEW-LOC> 9> 0>>>
<RFALSE>)
(T
<RTRUE>)>)
(<EQUAL? ,WINNER ,BLACK-PAWN>
<SET TAKEE <PIECE-AT-NEW-LOC? .NEW-LOC>>
<COND (<AND <EQUAL? .OLD-LOC 14>
<EQUAL? .NEW-LOC 30>>
;"pawn can move two spaces on first move"
<COND (.TAKEE
<RFATAL>)
(T
<RFALSE>)>)
(<EQUAL? <- .NEW-LOC .OLD-LOC> 7 9>
<COND (<NOT .TAKEE>
<RTRUE>)
(T
<RFALSE>)>)
(<EQUAL? <- .NEW-LOC .OLD-LOC> 8>
<COND (.TAKEE
<RFATAL>)
(T
<RFALSE>)>)
(T
<RTRUE>)>)
(<EQUAL? ,WINNER ,WHITE-PAWN>
<SET TAKEE <PIECE-AT-NEW-LOC? .NEW-LOC>>
<COND (<AND <EQUAL? .OLD-LOC 49>
<EQUAL? .NEW-LOC 33>>
;"pawn can move two spaces on first move"
<COND (.TAKEE
<RFATAL>)
(T
<RFALSE>)>)
(<EQUAL? <- .OLD-LOC .NEW-LOC> 7 9>
<COND (.TAKEE
<RFALSE>)
(T
<RTRUE>)>)
(<EQUAL? <- .OLD-LOC .NEW-LOC> 8>
<COND (.TAKEE
<RFATAL>)
(T
<RFALSE>)>)
(T
<RTRUE>)>)
(T
<TELL "Bug7" CR>)>>
<ROUTINE PIECE-AT-NEW-LOC?
(NEW-LOC "OPTIONAL" (TAKE-PIECE <>) "AUX" (CNT 0) (TAKEE <>))
<SET NEW-LOC <+ .NEW-LOC <COND (<EQUAL? ,HERE ,CONSTRUCTION>
,CONSTRUCTION-OFFSET)
(T
,PLAIN-OFFSET)>>>
<REPEAT ()
<COND (<EQUAL? .NEW-LOC <GET ,STORAGE-TABLE .CNT>>
<SET TAKEE <GET ,STORAGE-TABLE <+ .CNT 1>>>
<COND (<OR <FSET? .TAKEE ,WHITEBIT>
<FSET? .TAKEE ,BLACKBIT>>
<COND (.TAKE-PIECE
<ROB .TAKEE ,WINNER>
<PUT ,STORAGE-TABLE .CNT 0>)>
<RETURN>)>)>
<SET CNT <+ .CNT 2>>
<COND (<NOT <L? .CNT ,STORAGE-TABLE-LENGTH>>
<RETURN>)>>
<COND (<NOT .TAKEE>
<RFALSE>)
(<OR <FSET? .TAKEE ,WHITEBIT>
<FSET? .TAKEE ,BLACKBIT>>
<RETURN .TAKEE>)
(T
<RFALSE>)>>
<ROUTINE OBSTRUCTION (L DIR "OPT" (CALLED-BY-EXIT-F <>) "AUX" (CHANGE 0))
<COND (<AND <EQUAL? .DIR ,P?NORTH>
<OR <INTBL? .L ,NORTH-EXITS 11>
<INTBL? <+ .L 100> ,NORTH-EXITS 11>>>
<SET CHANGE -8>)
(<AND <EQUAL? .DIR ,P?NE>
<INTBL? .L ,NE-EXITS 17>>
<SET CHANGE -7>)
(<EQUAL? .DIR ,P?EAST>
<COND (<AND <EQUAL? .L 47>
.CALLED-BY-EXIT-F>
<SET CHANGE 100> ;"kludge")
(<INTBL? .L ,EAST-EXITS 15>
<SET CHANGE 1>)>)
(<AND <EQUAL? .DIR ,P?SE>
<OR <INTBL? .L ,SE-EXITS 7>
<INTBL? <+ .L 100> ,SE-EXITS 7>>>
<SET CHANGE 9>)
(<AND <EQUAL? .DIR ,P?SOUTH>
<OR <INTBL? <+ .L 8> ,NORTH-EXITS 11>
<INTBL? <+ .L 108> ,NORTH-EXITS 11>>>
<SET CHANGE 8>)
(<AND <EQUAL? .DIR ,P?SW>
<INTBL? <+ .L 7> ,NE-EXITS 17>>
<SET CHANGE 7>)
(<AND <EQUAL? .DIR ,P?WEST>
<INTBL? <- .L 1> ,EAST-EXITS 15>>
<SET CHANGE -1>)
(<AND <EQUAL? .DIR ,P?NW>
<OR <INTBL? <- .L 9> ,SE-EXITS 7>
<INTBL? <+ .L 91> ,SE-EXITS 7>>>
<SET CHANGE -9>)>
<COND (.CALLED-BY-EXIT-F
<RETURN .CHANGE>)
(<EQUAL? .CHANGE 0>
<RTRUE>)
(T
<RFALSE>)>>
<END-SEGMENT>
<BEGIN-SEGMENT LOWER>
<ROOM FIELD-OFFICE
(LOC ROOMS)
(DESC "Field Office")
(REGION "Flatheadia")
(LDESC
"This is a temporary headquarters for a construction site to the west.
Another exit leads east.")
(EAST TO EXIT)
(WEST PER CONSTRUCTION-ENTER-F)
(FLAGS RLANDBIT UNDERGROUNDBIT)
(MAP-LOC <PTABLE LOWER-LEVEL-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-4>)>
<ROUTINE CONSTRUCTION-ENTER-F ("OPTIONAL" (RARG <>)) ;"called by NEXT-ROOM?"
<COND (.RARG
<RFALSE>)>
<SETG CONSTRUCTION-LOC 47>
,CONSTRUCTION>
<OBJECT BLUEPRINT
(LOC FIELD-OFFICE)
(DESC "blueprint")
(SYNONYM BLUEPRINT)
(FLAGS TAKEBIT BURNBIT READBIT)
(SIZE 2)
(TEXT "[This is the blueprint from your ZORK ZERO package.]")>
<BEGIN-SEGMENT 0>
<OBJECT HAMMER ;"in table, at Construction room #61"
(DESC "hammer")
(SYNONYM HAMMER)
(FLAGS TAKEBIT)
(SIZE 16)
(ACTION HAMMER-F)>
<ROUTINE HAMMER-F ()
<COND (<AND <VERB? KILL>
<PRSI? ,HAMMER>> ;"hit object with hammer"
<PERFORM ,V?MUNG ,PRSO ,HAMMER>
<RTRUE>)
(<AND <VERB? MUNG>
<PRSI? ,HAMMER>
<FSET? ,PRSO ,ANIMATEDBIT>>
<TELL "Fortunately," T ,PRSO " evades your blow." CR>)>>
<END-SEGMENT>
<BEGIN-SEGMENT LOWER>
<ROOM CONSTRUCTION
(LOC ROOMS)
(DESC "Construction")
(REGION "Flatheadia")
(NORTH PER CONSTRUCTION-MOVEMENT-F)
(NE PER CONSTRUCTION-MOVEMENT-F)
(EAST PER CONSTRUCTION-MOVEMENT-F)
(SE PER CONSTRUCTION-MOVEMENT-F)
(SOUTH PER CONSTRUCTION-MOVEMENT-F)
(SW PER CONSTRUCTION-MOVEMENT-F)
(WEST PER CONSTRUCTION-MOVEMENT-F)
(NW PER CONSTRUCTION-MOVEMENT-F)
(FLAGS RLANDBIT UNDERGROUNDBIT)
(ACTION CONSTRUCTION-F)>
<ROUTINE CONSTRUCTION-F ("OPT" (RARG <>) "AUX" (CNT 0))
<COND (<EQUAL? .RARG ,M-LOOK>
<COND (<INTBL? ,CONSTRUCTION-LOC ,NORTH-EXITS 11>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? ,CONSTRUCTION-LOC ,NE-EXITS 17>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? ,CONSTRUCTION-LOC ,EAST-EXITS 15>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? ,CONSTRUCTION-LOC ,SE-EXITS 7>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? <+ ,CONSTRUCTION-LOC 8> ,NORTH-EXITS 11>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? <+ ,CONSTRUCTION-LOC 7> ,NE-EXITS 17>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? <- ,CONSTRUCTION-LOC 1> ,EAST-EXITS 15>
<SET CNT <+ .CNT 1>>)>
<COND (<INTBL? <- ,CONSTRUCTION-LOC 9> ,SE-EXITS 7>
<SET CNT <+ .CNT 1>>)>
<TELL
"You are in an abandoned underground construction site, roughly
octagonal in shape. ">
<COND (<G? .CNT 0>
<TELL "There ">
<COND (<EQUAL? .CNT 1>
<TELL "is an exit">)
(T
<TELL "are exits">)>
<TELL " to the ">
<COND (<INTBL? ,CONSTRUCTION-LOC ,NORTH-EXITS 11>
<TELL "north">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? ,CONSTRUCTION-LOC ,NE-EXITS 17>
<TELL "northeast">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? ,CONSTRUCTION-LOC ,EAST-EXITS 15>
<TELL "east">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? ,CONSTRUCTION-LOC ,SE-EXITS 7>
<TELL "southeast">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? <+ ,CONSTRUCTION-LOC 8> ,NORTH-EXITS 11>
<TELL "south">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? <+ ,CONSTRUCTION-LOC 7> ,NE-EXITS 17>
<TELL "southwest">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? <- ,CONSTRUCTION-LOC 1> ,EAST-EXITS 15>
<TELL "west">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<COND (<INTBL? <- ,CONSTRUCTION-LOC 9> ,SE-EXITS 7>
<TELL "northwest">
<SET CNT <- .CNT 1>>
<AND-OR-COMMA .CNT>)>
<TELL ". ">)>
<COND (<EQUAL? ,CONSTRUCTION-LOC 47>
<TELL "Also, a heavily used passage leads east. ">)>
<TELL
"Engraved on the wall is the number " N ,CONSTRUCTION-LOC ".">)
(<EQUAL? .RARG ,M-ENTER>
<SETG RANK <+ </ ,CONSTRUCTION-LOC 8> 1>>
<SETG FILE <+ <MOD ,CONSTRUCTION-LOC 8> 1>>
<UNSTORE ,CONSTRUCTION-OFFSET ,CONSTRUCTION-LOC>)>>
<ROUTINE AND-OR-COMMA (CNT)
<COND (<EQUAL? .CNT 1>
<TELL " and ">)
(<G? .CNT 1>
<TELL ", ">)>>
<ROUTINE CONSTRUCTION-MOVEMENT-F ("OPT" (RARG <>) "AUX" (CHANGE 0))
<COND (.RARG
<RFALSE>)>
<STORE ,CONSTRUCTION-OFFSET ,CONSTRUCTION-LOC>
<SET CHANGE <OBSTRUCTION ,CONSTRUCTION-LOC ,PRSO T>>
<COND (<EQUAL? .CHANGE 100>
<RETURN ,FIELD-OFFICE>)>
<SETG RANK <+ </ ,CONSTRUCTION-LOC 8> 1>>
<SETG FILE <+ <MOD ,CONSTRUCTION-LOC 8> 1>>
<COND (<EQUAL? .CHANGE 0>
<UNSTORE ,CONSTRUCTION-OFFSET ,CONSTRUCTION-LOC>
<CANT-GO>
<RFALSE>)
(T
<SETG CONSTRUCTION-LOC <+ ,CONSTRUCTION-LOC .CHANGE>>
<UNSTORE ,CONSTRUCTION-OFFSET ,CONSTRUCTION-LOC>
,CONSTRUCTION)>>
<GLOBAL CONSTRUCTION-LOC 47>
<CONSTANT NORTH-EXITS ;"10 rooms plus placeholder for FM passage = 11 entries"
<TABLE 99 ;"placeholder" 20 33 37 40 46 48 50 55 59 61>>
<CONSTANT NE-EXITS ;"17 rooms"
<TABLE 12 13 14 20 22 27 28 29 33 36 41 43 46 49 50 53 54>>
<CONSTANT EAST-EXITS ;"15 rooms"
<TABLE 5 6 12 22 26 30 34 38 42 44 51 56 57 61 62>>
<CONSTANT SE-EXITS ;"6 rooms plus one placeholder = 7 entries"
<TABLE 99 ;"placeholder" 17 40 43 48 51 54>>
<OBJECT HARDHAT ;"in table, at Construction room #0"
(DESC "hardhat")
(SYNONYM HARDHAT HAT)
(ADJECTIVE HARD)
(FLAGS TAKEBIT WEARBIT)
(GENERIC G-HAT-F)
(VALUE 25)>
<BEGIN-SEGMENT 0>
<ROUTINE REMOVE-ANY-PIECE (L TAKER "AUX" TAKEE (CNT 0))
<REPEAT ()
<COND (<NOT <L? .CNT ,STORAGE-TABLE-LENGTH>>
<RETURN>)
(<EQUAL? <GET ,STORAGE-TABLE .CNT> .L>
<SET TAKEE <GET ,STORAGE-TABLE <+ .CNT 1>>>
<COND (<OR <FSET? .TAKEE ,WHITEBIT>
<FSET? .TAKEE ,BLACKBIT>>
<ROB .TAKEE .TAKER>
<PUT ,STORAGE-TABLE .CNT 0>
<PUT ,STORAGE-TABLE <+ .CNT 1> 0>)>)>
<SET CNT <+ .CNT 2>>>>
;"codes for putting items in storage in fake rooms, shared by Plain,
Construction, and all five FrobozzCo Building fake rooms"
<CONSTANT STORAGE-TABLE
<TABLE 301 BLACK-KNIGHT
314 BLACK-PAWN
315 WHITE-KNIGHT
328 BLACK-BISHOP
337 BLACK-KING
349 WHITE-PAWN
357 WHITE-KING
363 WHITE-CASTLE
400 HARDHAT
461 HAMMER
1004 MEMO
3019 T-SQUARE
4193 INSTRUCTION-BOOKLET
0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0>>
<CONSTANT PLAIN-OFFSET 300>
<CONSTANT CONSTRUCTION-OFFSET 400>
<CONSTANT OFFICES-OFFSET 1000>
<CONSTANT OFFICES-N-OFFSET 2000>
<CONSTANT OFFICES-S-OFFSET 3000>
<CONSTANT OFFICES-E-OFFSET 4000>
<CONSTANT OFFICES-W-OFFSET 5000>
<CONSTANT STORAGE-TABLE-LENGTH 200>
<ROUTINE PUT-IN-STORAGE (OFFSET OBJ L "AUX" (CNT 0))
<REPEAT ()
<COND (<EQUAL? <GET ,STORAGE-TABLE .CNT> 0>
<PUT ,STORAGE-TABLE .CNT <+ .L .OFFSET>>
<PUT ,STORAGE-TABLE <+ .CNT 1> .OBJ>
<RETURN>)
(T
<SET CNT <+ .CNT 2>>)>>>
<END-SEGMENT>
<BEGIN-SEGMENT LOWER>
<BEGIN-SEGMENT FENSHIRE>
<BEGIN-SEGMENT VILLAGE>
<ROUTINE STORE (OFFSET L "OPT" (RM ,HERE) "AUX" (CNT 0) F N)
<SET F <FIRST? .RM>>
<REPEAT ()
<COND (.F
<SET N <NEXT? .F>>)
(T
<RETURN>)>
<COND (<NOT <EQUAL? .F ,PROTAGONIST>>
<REPEAT ()
<COND (<EQUAL? .F ,JESTER>
<REMOVE-J>
<RETURN>)
(<EQUAL? <GET ,STORAGE-TABLE .CNT> 0>
<PUT ,STORAGE-TABLE .CNT <+ .L .OFFSET>>
<PUT ,STORAGE-TABLE <+ .CNT 1> .F>
<SET CNT <+ .CNT 2>>
<REMOVE .F>
<RETURN>)
(T
<SET CNT <+ .CNT 2>>)>>)>
<SET F .N>>>
<ROUTINE UNSTORE (OFFSET L "OPT" (RM ,HERE) "AUX" (CNT 0))
<REPEAT ()
<COND (<NOT <L? .CNT ,STORAGE-TABLE-LENGTH>>
<RETURN>)
(<EQUAL? <GET ,STORAGE-TABLE .CNT> <+ .L .OFFSET>>
<MOVE <GET ,STORAGE-TABLE <+ .CNT 1>> .RM>
<PUT ,STORAGE-TABLE .CNT 0>
<PUT ,STORAGE-TABLE <+ .CNT 1> 0>)>
<SET CNT <+ .CNT 2>>>>
<END-SEGMENT>

505
clues.zap Normal file
View File

@ -0,0 +1,505 @@
.SEGMENT "HINTS"
.FUNCT DO-HINTS,Q,WIN,FCLR,WCLR,CHR,TMP,MAXC,?TMP1
HLIGHT H-NORMAL
CALL1 INIT-HINT-SCREEN >WIN
WINGET -3,WFSIZE
SHIFT STACK,-8 >Q
WINGET -3,WTOP
SUB STACK,1
DIV STACK,Q
ADD 1,STACK >TOP-HINT-LINE
WINGET -3,WHIGH
DIV STACK,Q
SUB STACK,1 >BOTTOM-HINT-NUM
WINGET -3,WFSIZE
BAND STACK,255 >Q
WINGET -3,WLEFT
SUB STACK,1
DIV STACK,Q
ADD 2,STACK >LEFT-HINT-COLUMN
?PRG1: CLEAR S-TEXT
SCREEN WIN
WINGET WIN,WCOLOR >WCLR
GET 0,0
BTST STACK,1 \?CCL5
ICALL CCURSET,2,9
COLOR 1,-1
JUMP ?CND3
?CCL5: COLOR 1,1
?CND3: ICALL HINT-TITLE,INVISICLUES,WIN
SCREEN S-FULL
WINGET S-FULL,WCOLOR >FCLR
WINGET S-TEXT,WCOLOR
BAND STACK,255 >?TMP1
WINGET S-TEXT,WCOLOR
SHIFT STACK,-8
COLOR ?TMP1,STACK
DIROUT D-TABLE-ON,SLINE
DIROUT D-TABLE-OFF
SET 'GET-HINT-ROUTINE,H-CHAPT-NAME
GET HINTS,0
ICALL2 H-PUT-UP-FROBS,STACK
ICALL2 H-NEW-CURSOR,H-CHAPT-NUM
GET HINTS,0 >MAXC
?PRG6: ZERO? DEMO-VERSION? /?CCL10
CALL2 INPUT-DEMO,1 >CHR
JUMP ?CND8
?CCL10: INPUT 1 >CHR
?CND8: EQUAL? CHR,CLICK1,CLICK2 \?CND11
CALL1 SELECT-HINT-BY-MOUSE >TMP
GRTR? TMP,0 /?CND11
EQUAL? TMP,-1 \?CCL17
SET 'CHR,78
JUMP ?CND11
?CCL17: EQUAL? TMP,-2 \?CCL19
SET 'CHR,80
JUMP ?CND11
?CCL19: EQUAL? TMP,-3 \?CCL21
SET 'CHR,13
JUMP ?CND11
?CCL21: EQUAL? TMP,-4 \?CCL23
SET 'CHR,81
?CND11: EQUAL? CHR,77,109,81 /?CTR25
EQUAL? CHR,113 \?CCL26
?CTR25: SET 'Q,TRUE-VALUE
JUMP ?REP7
?CCL23: SOUND S-BEEP
JUMP ?PRG6
?CCL26: EQUAL? CHR,78,110,DOWN-ARROW \?CCL30
ICALL H-NEW-CURSOR,H-CHAPT-NUM,TRUE-VALUE
EQUAL? H-CHAPT-NUM,MAXC \?CCL33
SET 'H-CHAPT-NUM,1
JUMP ?CND31
?CCL33: INC 'H-CHAPT-NUM
?CND31: SET 'H-QUEST-NUM,1
ICALL2 H-NEW-CURSOR,H-CHAPT-NUM
JUMP ?PRG6
?CCL30: EQUAL? CHR,80,112,UP-ARROW \?CCL35
ICALL H-NEW-CURSOR,H-CHAPT-NUM,TRUE-VALUE
EQUAL? H-CHAPT-NUM,1 \?CCL38
SET 'H-CHAPT-NUM,MAXC
JUMP ?CND36
?CCL38: DEC 'H-CHAPT-NUM
?CND36: SET 'H-QUEST-NUM,1
ICALL2 H-NEW-CURSOR,H-CHAPT-NUM
JUMP ?PRG6
?CCL35: EQUAL? CHR,13,10,32 \?CCL40
CALL1 H-PICK-QUESTION >Q
JUMP ?REP7
?CCL40: EQUAL? CHR,CLICK1,CLICK2 \?CCL42
GRTR? TMP,MAXC \?CCL45
SOUND S-BEEP
JUMP ?PRG6
?CCL45: ICALL H-NEW-CURSOR,H-CHAPT-NUM,TRUE-VALUE
SET 'H-CHAPT-NUM,TMP
SET 'H-QUEST-NUM,1
ICALL2 H-NEW-CURSOR,H-CHAPT-NUM
EQUAL? CHR,CLICK2 \?PRG6
CALL1 H-PICK-QUESTION >Q
?REP7: ZERO? Q /?PRG1
CLEAR -1
SCREEN WIN
BAND WCLR,255 >?TMP1
SHIFT WCLR,-8
COLOR ?TMP1,STACK
SCREEN S-FULL
BAND FCLR,255 >?TMP1
SHIFT FCLR,-8
COLOR ?TMP1,STACK
SCREEN S-TEXT
HLIGHT H-NORMAL
ICALL1 INIT-STATUS-LINE
PRINTI "Back to the story..."
CRLF
RETURN 2
?CCL42: SOUND S-BEEP
JUMP ?PRG6
.FUNCT H-PICK-QUESTION,CHR,MAXQ,Q,WID,TMP
?FCN: CATCH >PARSE-SENTENCE-ACTIVATION
HLIGHT H-NORMAL
CLEAR S-TEXT
GET HINTS,H-CHAPT-NUM
GET STACK,1
ICALL HINT-TITLE,STACK,S-WINDOW
CALL CENTER-LINE,M-MAIN-HINT-MENU,2 >WID
GET HINTS,H-CHAPT-NUM
GET STACK,0
SUB STACK,1 >MAXQ
SCREEN S-FULL
SET 'GET-HINT-ROUTINE,H-GET-QUEST
GET HINTS,H-CHAPT-NUM
GET STACK,0
SUB STACK,1
ICALL2 H-PUT-UP-FROBS,STACK
ICALL2 H-NEW-CURSOR,H-QUEST-NUM
?PRG1: ZERO? DEMO-VERSION? /?CCL5
CALL2 INPUT-DEMO,1 >CHR
JUMP ?CND3
?CCL5: INPUT 1 >CHR
?CND3: EQUAL? CHR,CLICK1,CLICK2 \?CND6
CALL2 SELECT-HINT-BY-MOUSE,WID >TMP
GRTR? TMP,0 /?CND6
EQUAL? TMP,-1 \?CCL12
SET 'CHR,78
JUMP ?CND6
?CCL12: EQUAL? TMP,-2 \?CCL14
SET 'CHR,80
JUMP ?CND6
?CCL14: EQUAL? TMP,-3 \?CCL16
SET 'CHR,13
JUMP ?CND6
?CCL16: EQUAL? TMP,-4 \?CCL18
SET 'CHR,81
JUMP ?CND6
?CCL18: EQUAL? TMP,-5 \?CCL20
SET 'CHR,77
?CND6: EQUAL? CHR,81,113 /TRUE
EQUAL? CHR,77,109 \?CCL25
SET 'Q,TRUE-VALUE
JUMP ?REP2
?CCL20: SOUND S-BEEP
JUMP ?PRG1
?CCL25: EQUAL? CHR,78,110,DOWN-ARROW \?CCL27
ICALL H-NEW-CURSOR,H-QUEST-NUM,TRUE-VALUE
EQUAL? H-QUEST-NUM,MAXQ \?CCL30
SET 'H-QUEST-NUM,1
JUMP ?CND28
?CCL30: INC 'H-QUEST-NUM
?CND28: ICALL2 H-NEW-CURSOR,H-QUEST-NUM
JUMP ?PRG1
?CCL27: EQUAL? CHR,80,112,UP-ARROW \?CCL32
ICALL H-NEW-CURSOR,H-QUEST-NUM,TRUE-VALUE
EQUAL? H-QUEST-NUM,1 \?CCL35
SET 'H-QUEST-NUM,MAXQ
JUMP ?CND33
?CCL35: DEC 'H-QUEST-NUM
?CND33: ICALL2 H-NEW-CURSOR,H-QUEST-NUM
JUMP ?PRG1
?CCL32: EQUAL? CHR,CLICK1,CLICK2 \?CCL37
GRTR? TMP,MAXQ \?CCL40
SOUND S-BEEP
JUMP ?PRG1
?CCL40: ICALL H-NEW-CURSOR,H-QUEST-NUM,TRUE-VALUE
SET 'H-QUEST-NUM,TMP
ICALL2 H-NEW-CURSOR,H-QUEST-NUM
EQUAL? CHR,CLICK2 \?PRG1
ICALL1 DISPLAY-HINT
JUMP ?REP2
?CCL37: EQUAL? CHR,13,10,32 \?CCL44
ICALL1 DISPLAY-HINT
?REP2: ZERO? Q /?FCN
RFALSE
?CCL44: SOUND S-BEEP
JUMP ?PRG1
.FUNCT H-NEW-CURSOR,POS,OFF?,Y,X
ADD TOP-HINT-LINE,POS >Y
SET 'X,LEFT-HINT-COLUMN
GRTR? POS,BOTTOM-HINT-NUM \?CND1
SUB Y,BOTTOM-HINT-NUM >Y
GETB 0,33
DIV STACK,2 >X
?CND1: ICALL CCURSET,Y,X
ZERO? OFF? \?CCL5
HLIGHT H-INVERSE
JUMP ?CND3
?CCL5: HLIGHT H-NORMAL
?CND3: CALL GET-HINT-ROUTINE,POS
PRINT STACK
PRINTC 32
ZERO? OFF? \FALSE
HLIGHT H-NORMAL
RTRUE
.FUNCT SELECT-HINT-BY-MOUSE,WID,VAL,MID,X,Y,?TMP1
WINGET -3,WFSIZE
SHIFT STACK,-8 >VAL
GET 0,27
GET STACK,2 >Y
GET 0,27
GET STACK,1 >X
SUB Y,1
DIV STACK,VAL >VAL
GETB 0,33 >?TMP1
WINGET -3,WFSIZE
BAND STACK,255
MUL ?TMP1,STACK
DIV STACK,2 >MID
SUB TOP-HINT-LINE,1
LESS? VAL,STACK \?CCL3
EQUAL? VAL,1 \?CCL6
DIV WID,2 >VAL
ZERO? VAL /?CCL9
SUB MID,VAL
GRTR? X,STACK \?CCL9
ADD MID,VAL
LESS? X,STACK \?CCL9
RETURN -5
?CCL9: GRTR? X,MID /?CCL14
RETURN -1
?CCL14: RETURN -3
?CCL6: EQUAL? VAL,2 \FALSE
GRTR? X,MID /?CCL19
RETURN -2
?CCL19: RETURN -4
?CCL3: ADD 1,VAL
SUB STACK,TOP-HINT-LINE >VAL
GRTR? X,MID \?CND21
ADD VAL,BOTTOM-HINT-NUM >VAL
?CND21: RETURN VAL
.FUNCT INVERSE-LINE,LN,INV
ASSIGNED? 'INV /?CND1
SET 'INV,H-INVERSE
?CND1: ZERO? LN /?CND3
ICALL CCURSET,LN,1
?CND3: HLIGHT INV
ZERO? INV \?CCL7
ERASE 1
RTRUE
?CCL7: FONT 4
GETB 0,39 >LN
WINGET -3,WWIDE
ADD LN,STACK
DIV STACK,LN
ICALL2 PRINT-SPACES,STACK
FONT 1
HLIGHT H-NORMAL
RTRUE
.FUNCT DISPLAY-HINT,H,MX,CNT,CV,SHIFT?,COUNT-OFFS,WID,CURCX,CURC,FLG,?TMP1
SET 'CNT,2
HLIGHT H-NORMAL
CLEAR S-TEXT
SCREEN S-WINDOW
ICALL INVERSE-LINE,3,H-NORMAL
ICALL RIGHT-LINE,Q-RESUME-STORY,3
ICALL INVERSE-LINE,2,H-NORMAL
ICALL RIGHT-LINE,RETURN-SEE-NEW-HINT,2
GET 0,8
BTST STACK,32 \?CND1
ICALL CENTER-LINE,H-OR-USE-MOUSE,3
?CND1: ICALL INVERSE-LINE,1,H-NORMAL
HLIGHT H-BOLD
GET HINTS,H-CHAPT-NUM >?TMP1
ADD H-QUEST-NUM,1
GET ?TMP1,STACK >H
SUB H-CHAPT-NUM,1
GET HINT-COUNTS,STACK >CV
GET H,1
ICALL CENTER-LINE,STACK,1,H-INVERSE
HLIGHT H-NORMAL
CALL CENTER-LINE,M-SEE-HINT-MENU,2 >WID
GET H,0 >MX
SCREEN S-TEXT
CURSET 1,1
MOD H-QUEST-NUM,2 >SHIFT?
SUB H-QUEST-NUM,1
DIV STACK,2 >COUNT-OFFS
GETB CV,COUNT-OFFS >CURCX
ZERO? SHIFT? /?CCL5
SHIFT CURCX,-4
JUMP ?CND3
?CCL5: PUSH CURCX
?CND3: BAND STACK,15
ADD 2,STACK >CURC
?PRG6: EQUAL? CNT,CURC /?REP7
PRINTC 9
GET H,CNT
PRINT STACK
CRLF
INC 'CNT
JUMP ?PRG6
?REP7: SET 'FLG,TRUE-VALUE
?PRG11: ZERO? FLG /?CND13
SET 'FLG,FALSE-VALUE
GRTR? CNT,MX \?CCL17
PRINT NO-MORE-HINTS
CRLF
SCREEN S-WINDOW
ICALL INVERSE-LINE,2,H-NORMAL
ICALL CENTER-LINE,M-SEE-HINT-MENU,2
SCREEN S-TEXT
JUMP ?CND13
?CCL17: SUB MX,CNT
ADD STACK,1
PRINTN STACK
PRINTI "> "
?CND13: ZERO? DEMO-VERSION? /?CCL20
CALL2 INPUT-DEMO,1 >CURC
JUMP ?CND18
?CCL20: INPUT 1 >CURC
?CND18: EQUAL? CURC,CLICK1,CLICK2 \?CND21
CALL2 SELECT-HINT-BY-MOUSE,WID >CURCX
GRTR? CURCX,0 /?CND21
EQUAL? CURCX,-3 \?CCL27
SET 'CURC,13
JUMP ?CND21
?CCL27: EQUAL? CURCX,-4 \?CCL29
SET 'CURC,81
JUMP ?CND21
?CCL29: EQUAL? CURCX,-5 \?CCL31
SET 'CURC,77
?CND21: EQUAL? CURC,77,109,81 /?CTR33
EQUAL? CURC,113 \?CCL34
?CTR33: ZERO? SHIFT? /?CCL39
GETB CV,COUNT-OFFS
BAND STACK,15 >?TMP1
SUB CNT,2
SHIFT STACK,4
BOR ?TMP1,STACK
PUTB CV,COUNT-OFFS,STACK
JUMP ?CND37
?CCL31: SOUND S-BEEP
JUMP ?PRG11
?CCL39: GETB CV,COUNT-OFFS
BAND STACK,240 >?TMP1
SUB CNT,2
BOR ?TMP1,STACK
PUTB CV,COUNT-OFFS,STACK
?CND37: EQUAL? CURC,81,113 \TRUE
THROW TRUE-VALUE,PARSE-SENTENCE-ACTIVATION
JUMP ?PRG11
?CCL34: EQUAL? CURC,13,10 \?CCL44
GRTR? CNT,MX /?CCL47
SET 'FLG,TRUE-VALUE
GET H,CNT
PRINT STACK
CRLF
IGRTR? 'CNT,MX \?PRG11
SET 'FLG,FALSE-VALUE
PRINT NO-MORE-HINTS
CRLF
SCREEN S-WINDOW
ICALL INVERSE-LINE,2,H-NORMAL
ICALL CENTER-LINE,M-SEE-HINT-MENU,2
SCREEN S-TEXT
JUMP ?PRG11
?CCL47: SOUND S-BEEP
JUMP ?PRG11
?CCL44: SOUND S-BEEP
JUMP ?PRG11
.FUNCT H-CHAPT-NAME,N
GET HINTS,N
GET STACK,1
RSTACK
.FUNCT H-GET-QUEST,N,?TMP1
GET HINTS,H-CHAPT-NUM >?TMP1
ADD N,1
GET ?TMP1,STACK
GET STACK,1
RSTACK
.FUNCT H-PUT-UP-FROBS,MX,ST,X,Y
HLIGHT H-NORMAL
SET 'X,LEFT-HINT-COLUMN
SET 'Y,TOP-HINT-LINE
?PRG1: IGRTR? 'ST,MX /TRUE
INC 'Y
ICALL CCURSET,Y,X
CALL GET-HINT-ROUTINE,ST
PRINT STACK
EQUAL? ST,BOTTOM-HINT-NUM \?PRG1
SET 'Y,TOP-HINT-LINE
GETB 0,33
DIV STACK,2 >X
JUMP ?PRG1
.FUNCT INIT-HINT-SCREEN
CLEAR -1
SCREEN S-FULL
ZERO? BORDER-ON /?CND1
DISPLAY HINT-BORDER,1,1
?CND1: ICALL2 SPLIT-BY-PICTURE,TEXT-WINDOW-PIC-LOC
SCREEN S-TEXT
RETURN S-WINDOW
.FUNCT HINT-TITLE,TITLE,WIN,THIRD
ASSIGNED? 'THIRD /?CND1
SET 'THIRD,TRUE-VALUE
?CND1: SCREEN WIN
ICALL INVERSE-LINE,1,H-NORMAL
ICALL INVERSE-LINE,2,H-NORMAL
ICALL INVERSE-LINE,3,H-NORMAL
HLIGHT H-BOLD
ICALL CENTER-LINE,TITLE,1,H-INVERSE
HLIGHT H-NORMAL
ICALL LEFT-LINE,2,NEXT-HINT
GET 0,8
BTST STACK,32 \?CND3
ICALL CENTER-LINE,H-OR-USE-MOUSE,3
?CND3: ICALL LEFT-LINE,3,PREVIOUS-HINT
ZERO? THIRD /FALSE
ICALL RIGHT-LINE,RETURN-SEE-HINT,2
CALL RIGHT-LINE,Q-RESUME-STORY,3
RSTACK
.FUNCT LEFT-LINE,LN,STR,INV
ICALL CCURSET,LN,1
ZERO? INV /?CND1
HLIGHT INV
?CND1: PRINT STR
ZERO? INV /FALSE
HLIGHT H-NORMAL
RTRUE
.FUNCT RIGHT-LINE,STR,LN,INV,LEN
CALL JUSTIFIED-LINE,STR,LN,INV,LEN,1
RSTACK
.FUNCT CENTER-LINE,STR,LN,INV,LEN
CALL JUSTIFIED-LINE,STR,LN,INV,LEN,2
RSTACK
.FUNCT JUSTIFIED-LINE,STR,LN,INV,LEN,CTR
ZERO? LN \?CCL3
CURGET SLINE
GET SLINE,0 >LN
JUMP ?CND1
?CCL3: DEC 'LN
WINGET -3,WFSIZE
SHIFT STACK,-8
MUL LN,STACK
ADD 1,STACK >LN
?CND1: ZERO? LEN \?CND4
DIROUT D-TABLE-ON,SLINE
PRINT STR
PRINTC 32
DIROUT D-TABLE-OFF
GET 0,24 >LEN
?CND4: WINGET -3,WWIDE
SUB STACK,LEN
DIV STACK,CTR
CURSET LN,STACK
ZERO? INV /?CND6
HLIGHT INV
?CND6: PRINT STR
PRINTC 32
ZERO? INV \?CCL9
RETURN LEN
?CCL9: HLIGHT H-NORMAL
RETURN LEN
.ENDSEG
.ENDI

538
clues.zil Normal file
View File

@ -0,0 +1,538 @@
"CLUES for LIBRARY
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
"To install:
Add <XFLOAD <ZILLIB>CLUES> to your GAME.ZIL file.
Modify ROUTINE FINISH in VERBS to include Hint.
Add HINT syntaxes (be careful -- you might already have some variety).
Add verb routines for V-HINT and V-HINTS-OFF.
Add HINT to list of verbs in CLOCKER-VERB (a.k.a. GAME-VERB?).
Make sure flag in V-HINTS-OFF syntax is correct (RLANDBIT, KLUDGEBIT, etc.)."
<FILE-FLAGS CLEAN-STACK? MDL-ZIL? ;ZAP-TO-SOURCE-DIRECTORY?>
<DEFAULTS-DEFINED
FIRST-HINT-POS
INIT-HINT-SCREEN>
<BEGIN-SEGMENT HINTS>
<CONSTANT RETURN-SEE-HINT "Hit Return to see hints.">
<CONSTANT RETURN-SEE-NEW-HINT "Hit Return to see a hint.">
<CONSTANT INVISICLUES "InvisiClues (tm)">
<CONSTANT M-MAIN-HINT-MENU "Hit M to see main menu.">
<CONSTANT M-SEE-HINT-MENU "Hit M to see hint menu.">
<CONSTANT PREVIOUS-HINT "Hit P for previous item.">
<CONSTANT NEXT-HINT "Hit N for next item.">
<CONSTANT Q-RESUME-STORY "Hit Q to resume story.">
<CONSTANT H-OR-USE-MOUSE "(Or use your mouse.)">
<CONSTANT NO-MORE-HINTS "[No more hints.]">
"If the first argument is non-false, build a parallel impure table
for storing the count of answers already seen; make it a constant
under the given name."
<DEFINE20 CONSTRUCT-HINTS (COUNT-NAME "TUPLE" STUFF "AUX" (SS <>)
(HL (T)) (HLL .HL) V
(CL (T)) (CLL .CL)
TCL TCLL)
<REPEAT ((CT 0))
<COND (<OR <EMPTY? .STUFF>
<TYPE? <1 .STUFF> STRING>>
;"Chapter break"
<COND
(<NOT .SS>
;"First one, just do setup"
<SET SS .STUFF>
<SET TCL (T)>
<SET TCLL .TCL>
<SET CT 0>)
(T
<SET V <SUBSTRUC .SS 0 <- <LENGTH .SS> <LENGTH .STUFF>>>>
;"One chapter's worth"
<COND (<L? 17 <LENGTH .V>>
<WARN!-ZILCH!-PACKAGE!- "Too many answers for: " <1 .V>>)>
<SET HLL <REST <PUTREST .HLL (<EVAL <FORM PLTABLE !.V>>)>>>
<COND (.COUNT-NAME
<SET CLL <REST <PUTREST .CLL
(<EVAL <FORM TABLE (BYTE)
!<REST .TCL>>>)>>>
<SET TCL (T)>
<SET TCLL .TCL>
<SET CT 0>)>
<SET SS .STUFF>)>
<COND (<EMPTY? .STUFF> <RETURN>)>
<SET STUFF <REST .STUFF>>)
(T
<COND (.COUNT-NAME
<COND (<1? <MOD <SET CT <+ .CT 1>> 2>>
<SET TCLL <REST <PUTREST .TCLL
(0)>>>)>)>
<SET STUFF <REST .STUFF>>)>>
<COND (.COUNT-NAME
<EVAL <FORM CONSTANT .COUNT-NAME
<EVAL <FORM PTABLE !<REST .CL>>>>>)>
<EVAL <FORM PLTABLE !<REST .HL>>>>
"Longest hint topic and longest question can be one line, unless it shares
a line with another such in the other column. Each question can have up to
16 answers but no more."
;<CONSTANT HINTS
<CONSTRUCT-HINTS HINT-COUNTS ;"Put topics in Quotes - followed by PLTABLEs
of Questions and Answers in quotes"
;"17 character wide"
;"this set of quotes is 36 chars. wide"
"Topic/Chapter"
<PLTABLE "Question"
"Hint 1"
"Hint 2">>>
<GLOBAL H-QUEST-NUM 1> "shows in HINTS LTABLE which question it's on"
<GLOBAL H-CHAPT-NUM 1> "shows in HINTS LTABLE which chapter it's on"
<DEFAULT-DEFINITION FIRST-HINT-POS
<CONSTANT FIRST-HINT-LINE 5>
<CONSTANT FIRST-HINT-COLUMN 4>>
<GLOBAL BOTTOM-HINT-NUM:NUMBER 0>
<GLOBAL TOP-HINT-LINE:NUMBER 0>
<GLOBAL LEFT-HINT-COLUMN:NUMBER 0>
<GLOBAL GET-HINT-ROUTINE 0> "APPLY this to get pointer to text"
<DEFINE DO-HINTS ("AUX" Q WIN FCLR WCLR)
<IF-SOUND <SETG SOUND-QUEUED? <>>
<KILL-SOUNDS>>
<HLIGHT ,H-NORMAL>
<SET WIN <INIT-HINT-SCREEN>>
;<WINATTR -3 ,A-SCRIPT ,O-CLEAR>
<SET Q <SHIFT <WINGET -3 ,WFSIZE> -8>> ;"height"
<SETG TOP-HINT-LINE <+ 1 </ <- <WINGET -3 ,WTOP> 1> .Q>>>
<SETG BOTTOM-HINT-NUM <- </ <WINGET -3 ,WHIGH> .Q> 1>>
<SET Q <BAND <WINGET -3 ,WFSIZE> *377*>>
<SETG LEFT-HINT-COLUMN <+ 2 </ <- <WINGET -3 ,WLEFT> 1> .Q>>>
<PROG ()
<CLEAR ,S-TEXT>
<SCREEN .WIN>
<SET WCLR <WINGET .WIN ,WCOLOR>>
<COND (<BAND 1 <LOWCORE ZVERSION>> ;"colors visible?"
<CCURSET 2 9> ;<CURSET 1 1>
<COLOR 1 -1>)
(T
<COLOR 1 1>)>
<HINT-TITLE ,INVISICLUES .WIN>
<SCREEN ,S-FULL>
<SET FCLR <WINGET ,S-FULL ,WCOLOR>>
<COLOR <BAND <WINGET ,S-TEXT ,WCOLOR> *377*>;"Match colors with text screen."
<SHIFT <WINGET ,S-TEXT ,WCOLOR> -8>>
<DIROUT ,D-TABLE-ON ,SLINE ;-80>
<DIROUT ,D-TABLE-OFF> ;"flush TWID"
<SETG GET-HINT-ROUTINE ,H-CHAPT-NAME>
<H-PUT-UP-FROBS <GET ,HINTS 0>>
<H-NEW-CURSOR ,H-CHAPT-NUM>
<REPEAT (CHR TMP (MAXC <GET ,HINTS 0>))
<COND (,DEMO-VERSION?
<SET CHR <INPUT-DEMO 1>>)
(T
<SET CHR <INPUT 1>>)>
<COND (<EQUAL? .CHR ,CLICK1 ,CLICK2>
<SET TMP <SELECT-HINT-BY-MOUSE>>
<COND (<L=? .TMP 0>
<COND (<EQUAL? .TMP -1>
<SET CHR !\N>)
(<EQUAL? .TMP -2>
<SET CHR !\P>)
(<EQUAL? .TMP -3>
<SET CHR 13>)
(<EQUAL? .TMP -4>
<SET CHR !\Q>)
(T
<SOUND ,S-BEEP>
<AGAIN>)>)>)
;(T
<CCURSET ,BOTTOM-HINT-NUM 1>
<TELL "[CHR=" N .CHR "]">)>
<COND (<EQUAL? .CHR !\M !\m !\Q !\q ;,ESCAPE-KEY>
<SET Q T>
<RETURN>)
(<EQUAL? .CHR !\N !\n ,DOWN-ARROW>
<H-NEW-CURSOR ,H-CHAPT-NUM T>
<COND (<EQUAL? ,H-CHAPT-NUM .MAXC>
<SETG H-CHAPT-NUM 1>)
(T
<SETG H-CHAPT-NUM <+ ,H-CHAPT-NUM 1>>)>
<SETG H-QUEST-NUM 1>
<H-NEW-CURSOR ,H-CHAPT-NUM>)
(<EQUAL? .CHR !\P !\p ,UP-ARROW>
<H-NEW-CURSOR ,H-CHAPT-NUM T>
<COND (<EQUAL? ,H-CHAPT-NUM 1>
<SETG H-CHAPT-NUM .MAXC>)
(T
<SETG H-CHAPT-NUM <- ,H-CHAPT-NUM 1>>)>
<SETG H-QUEST-NUM 1>
<H-NEW-CURSOR ,H-CHAPT-NUM>)
(<EQUAL? .CHR 13 10 32>
<SET Q <H-PICK-QUESTION>>
<RETURN>)
(<EQUAL? .CHR ,CLICK1 ,CLICK2>
<COND (<G? .TMP .MAXC>
<SOUND ,S-BEEP>)
;(<EQUAL? ,H-CHAPT-NUM .TMP>
<SET Q <H-PICK-QUESTION>>
<RETURN>) ;"not like Mac"
(T
<H-NEW-CURSOR ,H-CHAPT-NUM T>
<SETG H-CHAPT-NUM .TMP>
<SETG H-QUEST-NUM 1>
<H-NEW-CURSOR ,H-CHAPT-NUM>
<COND (<EQUAL? .CHR ,CLICK2>
<SET Q <H-PICK-QUESTION>>
<RETURN>)>)>)
(T
<SOUND ,S-BEEP>)>>
<COND (<NOT .Q>
<AGAIN>)>>
<CLEAR -1>
<SCREEN .WIN>
<COLOR <BAND .WCLR 255> <SHIFT .WCLR -8>>
<SCREEN ,S-FULL>
<COLOR <BAND .FCLR 255> <SHIFT .FCLR -8>>
<SCREEN ,S-TEXT>
<HLIGHT ,H-NORMAL>
;<WINATTR -3 ,A-SCRIPT ,O-SET>
<INIT-STATUS-LINE>
<TELL "Back to the story..." CR>
<IF-SOUND <COND (,SOUND-ON?
<CHECK-LOOPING>)>>
<RFATAL>>
<DEFINE H-PICK-QUESTION ("AUX" CHR MAXQ (Q <>) ;WIN WID)
<SETG PARSE-SENTENCE-ACTIVATION <CATCH>> ;"for Q command"
<HLIGHT ,H-NORMAL>
<CLEAR ,S-TEXT>
;<SET WIN <INIT-HINT-SCREEN>>
<HINT-TITLE <GET <GET ,HINTS ,H-CHAPT-NUM> 1> ,S-WINDOW ;.WIN>
<SET WID <CENTER-LINE ,M-MAIN-HINT-MENU 2 ;,H-INVERSE>>
<SET MAXQ <- <GET <GET ,HINTS ,H-CHAPT-NUM> 0> 1>>
<SCREEN ,S-FULL>
<SETG GET-HINT-ROUTINE ,H-GET-QUEST>
<H-PUT-UP-FROBS <- <GET <GET ,HINTS ,H-CHAPT-NUM> 0> 1>>
<H-NEW-CURSOR ,H-QUEST-NUM>
<REPEAT (TMP)
<COND (,DEMO-VERSION?
<SET CHR <INPUT-DEMO 1>>)
(T
<SET CHR <INPUT 1>>)>
<COND (<EQUAL? .CHR ,CLICK1 ,CLICK2>
<SET TMP <SELECT-HINT-BY-MOUSE .WID>>
<COND (<L=? .TMP 0>
<COND (<EQUAL? .TMP -1>
<SET CHR !\N>)
(<EQUAL? .TMP -2>
<SET CHR !\P>)
(<EQUAL? .TMP -3>
<SET CHR 13>)
(<EQUAL? .TMP -4>
<SET CHR !\Q>)
(<EQUAL? .TMP -5>
<SET CHR !\M>)
(T
<SOUND ,S-BEEP>
<AGAIN>)>)>)
;(T
<CCURSET ,BOTTOM-HINT-NUM 1>
<TELL "[CHR=" N .CHR "]">)>
<COND (<EQUAL? .CHR !\Q !\q ;,ESCAPE-KEY>
<RTRUE>)
(<EQUAL? .CHR !\M !\m>
<SET Q T>
<RETURN>)
(<EQUAL? .CHR !\N !\n ,DOWN-ARROW>
<H-NEW-CURSOR ,H-QUEST-NUM T>
<COND (<EQUAL? ,H-QUEST-NUM .MAXQ>
<SETG H-QUEST-NUM 1>)
(T
<SETG H-QUEST-NUM <+ ,H-QUEST-NUM 1>>)>
<H-NEW-CURSOR ,H-QUEST-NUM>)
(<EQUAL? .CHR !\P !\p ,UP-ARROW>
<H-NEW-CURSOR ,H-QUEST-NUM T>
<COND (<EQUAL? ,H-QUEST-NUM 1>
<SETG H-QUEST-NUM .MAXQ>)
(T
<SETG H-QUEST-NUM <- ,H-QUEST-NUM 1>>)>
<H-NEW-CURSOR ,H-QUEST-NUM>)
(<EQUAL? .CHR ,CLICK1 ,CLICK2>
<COND (<G? .TMP .MAXQ>
<SOUND ,S-BEEP>)
;(<EQUAL? ,H-QUEST-NUM .TMP>
<DISPLAY-HINT>
<RETURN>) ;"not like Mac"
(T
<H-NEW-CURSOR ,H-QUEST-NUM T>
<SETG H-QUEST-NUM .TMP>
<H-NEW-CURSOR ,H-QUEST-NUM>
<COND (<EQUAL? .CHR ,CLICK2>
<DISPLAY-HINT>
<RETURN>)>)>)
(<EQUAL? .CHR 13 10 32>
<DISPLAY-HINT>
<RETURN>)
(T
<SOUND ,S-BEEP>)>>
<COND (<NOT .Q>
<AGAIN>)>>
<DEFINE H-NEW-CURSOR (POS "OPT" (OFF? <>) "AUX" Y X)
<SET Y <+ ,TOP-HINT-LINE .POS>>
<SET X ,LEFT-HINT-COLUMN>
<COND (<G? .POS ,BOTTOM-HINT-NUM>
<SET Y <- .Y ,BOTTOM-HINT-NUM>>
<SET X </ <LOWCORE SCRH> ;<WINGET -3 ,WWIDE> 2>>)>
<CCURSET .Y .X>
<COND (<NOT .OFF?>
<HLIGHT ,H-INVERSE>)
(T
<HLIGHT ,H-NORMAL>)>
<TELL <ZAPPLY ,GET-HINT-ROUTINE .POS> !\ >
<COND (<NOT .OFF?>
<HLIGHT ,H-NORMAL>)>>
<DEFINE SELECT-HINT-BY-MOUSE ("OPT" (WID 0) "AUX" VAL MID X Y)
<SET VAL <SHIFT <WINGET -3 ,WFSIZE> -8>>
<SET Y <LOWCORE MSLOCY>>
<SET X <LOWCORE MSLOCX>>
;<CCURSET ,BOTTOM-HINT-NUM 1>
;<TELL "[">
<SET VAL </ <- .Y 1> .VAL>>
<SET MID </ <* <LOWCORE SCRH> <BAND <WINGET -3 ,WFSIZE> *377*>>
;<WINGET -3 ,WWIDE>
2>>
;<TELL "LN=" N .VAL " FHL=" N ,TOP-HINT-LINE " X=" N .X " MID=" N .MID " TWID=" N .WID>
<COND (<L? .VAL <- ,TOP-HINT-LINE 1>>
<COND (<EQUAL? .VAL 1>
<COND (<AND <SET VAL </ .WID 2>>
<G? .X <- .MID .VAL>>
<L? .X <+ .MID .VAL>>>
;<TELL " VAL=-5">
<RETURN -5>)
(<L=? .X .MID>
;<TELL " VAL=-1">
<RETURN -1>)
(T
;<TELL " VAL=-3">
<RETURN -3>)>)
(<EQUAL? .VAL 2>
<COND (<L=? .X .MID>
;<TELL " VAL=-2">
<RETURN -2>)
(T
;<TELL " VAL=-4">
<RETURN -4>)>)
(T
<COND (T
;<TELL " VAL=0">
<RETURN 0>)>)>)
(T
<SET VAL <- <+ 1 .VAL> ,TOP-HINT-LINE>>
;<TELL " VAL=" N .VAL>
<COND (<G? .X .MID>
<SET VAL <+ .VAL ,BOTTOM-HINT-NUM>>
;<TELL " -> " N .VAL>)>
;<TELL "]|">
.VAL)>>
<DEFINE INVERSE-LINE ("OPT" (LN 0) (INV ,H-INVERSE))
<COND (<T? .LN>
<CCURSET .LN 1>)>
<HLIGHT .INV>
<COND (<EQUAL? .INV ,H-NORMAL>
<ERASE 1>)
(T
<FONT 4>
<SET LN <LOWCORE (FWRD 1)>>
<PRINT-SPACES </ <+ .LN <WINGET -3 ,WWIDE>> .LN>>
<FONT 1>
<HLIGHT ,H-NORMAL>)>>
<DEFINE DISPLAY-HINT ("AUX" H MX (CNT 2) CV SHIFT? COUNT-OFFS ;WIN WID)
<HLIGHT ,H-NORMAL>
<CLEAR ,S-TEXT>
;<SET WIN <INIT-HINT-SCREEN>>
<SCREEN ,S-WINDOW ;.WIN>
<INVERSE-LINE 3 ,H-NORMAL>
<RIGHT-LINE ,Q-RESUME-STORY 3 ;,H-INVERSE>
<INVERSE-LINE 2 ,H-NORMAL>
<RIGHT-LINE ,RETURN-SEE-NEW-HINT 2 ;,H-INVERSE>
<COND (<NOT <EQUAL? <BAND <LOWCORE FLAGS> 32> 0>>
<CENTER-LINE ,H-OR-USE-MOUSE 3 ;,H-INVERSE>)>
<INVERSE-LINE 1 ,H-NORMAL>
<HLIGHT ,H-BOLD>
<SET H <GET <GET ,HINTS ,H-CHAPT-NUM> <+ ,H-QUEST-NUM 1>>>
;"Byte table to use for showing questions already seen.
Actually a nibble table. The high four bits of each byte are for
H-QUEST-NUM odd; the low four bits are for H-QUEST-NUM even. See SHIFT?
and COUNT-OFFS."
<SET CV <GET ,HINT-COUNTS <- ,H-CHAPT-NUM 1>>>
<CENTER-LINE <GET .H 1> 1 ,H-INVERSE>
<HLIGHT ,H-NORMAL>
<SET WID <CENTER-LINE ,M-SEE-HINT-MENU 2 ;,H-INVERSE>>
<SET MX <GET .H 0>>
<SCREEN ,S-TEXT>
<CURSET 1 1>
;<WINATTR -3 ,A-SCRIPT ,O-SET>
;<PRINT <GET .H 1>>
;<CRLF>
<SET SHIFT? <MOD ,H-QUEST-NUM 2>>
<SET COUNT-OFFS </ <- ,H-QUEST-NUM 1> 2>>
<REPEAT ((CURCX <GETB .CV .COUNT-OFFS>)
(CURC <+ 2 <ANDB <COND (.SHIFT? <LSH .CURCX -4>)
(T .CURCX)> *17*>>))
<COND (<==? .CNT .CURC>
<RETURN>)
(T
<TELL C 9 <GET .H .CNT> CR>
<SET CNT <+ .CNT 1>>)>>
<REPEAT (CHR ;N TMP (FLG T))
<COND (.FLG
<SET FLG <>>
<COND (<G? .CNT .MX>
<PRINT ,NO-MORE-HINTS>
<CRLF>
<SCREEN ,S-WINDOW ;.WIN>
<INVERSE-LINE 2 ,H-NORMAL>
<CENTER-LINE ,M-SEE-HINT-MENU 2 ;,H-INVERSE>
<SCREEN ,S-TEXT>)
(T
<TELL ;"[" N <+ <- .MX .CNT> 1> ;" hint">
;<COND (<NOT <EQUAL? .N 1>>
<TELL "s">)>
<TELL ;" left.] -" "> ">)>)>
<COND (,DEMO-VERSION?
<SET CHR <INPUT-DEMO 1>>)
(T
<SET CHR <INPUT 1>>)>
<COND (<EQUAL? .CHR ,CLICK1 ,CLICK2>
<SET TMP <SELECT-HINT-BY-MOUSE .WID>>
<COND (<L=? .TMP 0>
<COND (<EQUAL? .TMP -3>
<SET CHR 13>)
(<EQUAL? .TMP -4>
<SET CHR !\Q>)
(<EQUAL? .TMP -5>
<SET CHR !\M>)
(T
<SOUND ,S-BEEP>
<AGAIN>)>)>)
;(T
<CCURSET ,BOTTOM-HINT-NUM 1>
<TELL "[CHR=" N .CHR "]">)>
<COND (<EQUAL? .CHR !\M !\m !\Q !\q ;,ESCAPE-KEY>
<COND (.SHIFT?
<PUTB .CV .COUNT-OFFS
<ORB <ANDB <GETB .CV .COUNT-OFFS> *17*>
<LSH <- .CNT 2> 4>>>)
(T
<PUTB .CV .COUNT-OFFS
<ORB <ANDB <GETB .CV .COUNT-OFFS> *360*>
<- .CNT 2>>>)>
<COND (<EQUAL? .CHR !\Q !\q ;,ESCAPE-KEY>
<THROW T ,PARSE-SENTENCE-ACTIVATION>)
(T
;<WINATTR -3 ,A-SCRIPT ,O-CLEAR>
<RETURN>)>)
(<EQUAL? .CHR 13 10 ;"32 ,CLICK1 ,CLICK2">
<COND (<L=? .CNT .MX>
<SET FLG T> ;"CNT starts as 2"
<TELL <GET .H .CNT> CR>
;"3rd = line 7, 4th = line 9, etc."
<COND (<G? <SET CNT <+ .CNT 1>> .MX>
<SET FLG <>>
<PRINT ,NO-MORE-HINTS>
<CRLF>
<SCREEN ,S-WINDOW ;.WIN>
<INVERSE-LINE 2 ,H-NORMAL>
<CENTER-LINE ,M-SEE-HINT-MENU 2 ;,H-INVERSE>
<SCREEN ,S-TEXT>)>)
(T
<SOUND ,S-BEEP>)>)
(T
<SOUND ,S-BEEP>)>>>
<DEFINE H-CHAPT-NAME (N)
<GET <GET ,HINTS .N> 1>>
<DEFINE H-GET-QUEST (N)
<GET <GET <GET ,HINTS ,H-CHAPT-NUM> <+ .N 1>> 1>>
<DEFINE H-PUT-UP-FROBS (MX)
<HLIGHT ,H-NORMAL>
<REPEAT ((ST 0) (X ,LEFT-HINT-COLUMN) (Y ,TOP-HINT-LINE))
<COND (<G? <SET ST <+ .ST 1>> .MX>
<RETURN>)>
<SET Y <+ 1 .Y>>
<CCURSET .Y .X>
<TELL <ZAPPLY ,GET-HINT-ROUTINE .ST>>
<COND (<EQUAL? .ST ,BOTTOM-HINT-NUM>
<SET Y ,TOP-HINT-LINE>
<SET X </ <LOWCORE SCRH> ;<WINGET -3 ,WWIDE> 2>>)>>>
<DEFAULT-DEFINITION INIT-HINT-SCREEN
<DEFINE INIT-HINT-SCREEN ()
<CLEAR -1>
<CSPLIT 4>
<SCREEN ,S-TEXT>
,S-WINDOW>>
<DEFINE HINT-TITLE (TITLE WIN "OPTIONAL" (THIRD T))
<SCREEN .WIN>
<INVERSE-LINE 1 ,H-NORMAL>
<INVERSE-LINE 2 ,H-NORMAL>
<INVERSE-LINE 3 ,H-NORMAL>
<HLIGHT ,H-BOLD>
<CENTER-LINE .TITLE 1 ,H-INVERSE>
<HLIGHT ,H-NORMAL>
<LEFT-LINE 2 ,NEXT-HINT ;,H-INVERSE>
<COND (<NOT <EQUAL? <BAND <LOWCORE FLAGS> 32> 0>>
<CENTER-LINE ,H-OR-USE-MOUSE 3 ;,H-INVERSE>)>
<LEFT-LINE 3 ,PREVIOUS-HINT ;,H-INVERSE>
<COND (.THIRD
<RIGHT-LINE ,RETURN-SEE-HINT 2 ;,H-INVERSE>
<RIGHT-LINE ,Q-RESUME-STORY 3 ;,H-INVERSE>)>>
<DEFINE LEFT-LINE (LN STR "OPTIONAL" (INV <>))
<CCURSET .LN 1>
<COND (.INV
<HLIGHT .INV>)>
<TELL .STR>
<COND (.INV
<HLIGHT ,H-NORMAL>)>>
<DEFINE RIGHT-LINE (STR "OPTIONAL" (LN 0) (INV <>) (LEN 0))
<JUSTIFIED-LINE .STR .LN .INV .LEN 1>>
<DEFINE CENTER-LINE (STR "OPTIONAL" (LN 0) (INV <>) (LEN 0))
<JUSTIFIED-LINE .STR .LN .INV .LEN 2>>
<DEFINE JUSTIFIED-LINE (STR LN INV LEN CTR)
<COND (<ZERO? .LN>
<CURGET ,SLINE>
<SET LN <GET ,SLINE 0>>)
(T
<SET LN <- .LN 1>>
<SET LN <+ 1 <* .LN <SHIFT <WINGET -3 ,WFSIZE> -8>>>>)>
<COND (<ZERO? .LEN>
<DIROUT ,D-TABLE-ON ,SLINE ;-80>
<TELL .STR !\ >
<DIROUT ,D-TABLE-OFF>
<SET LEN <LOWCORE TWID>>)>
<CURSET .LN </ <- <WINGET -3 ,WWIDE> .LEN> .CTR>>
<COND (.INV
<HLIGHT .INV>)>
<TELL .STR !\ >
<COND (.INV
<HLIGHT ,H-NORMAL>)>
.LEN>
<END-SEGMENT>

208
constants.zil Normal file
View File

@ -0,0 +1,208 @@
"CONSTANTS for
Library
Copyright (C)1988 Infocom, Inc. All rights reserved."
"what rfatal returns"
<CONSTANT M-FATAL 2>
"context names"
<CONSTANT M-BEG 1>
<CONSTANT M-END 2>
<CONSTANT M-ENTER 3>
<CONSTANT M-LEAVE 4>
<CONSTANT M-LOOK 5>
<CONSTANT M-FLASH 6>
<CONSTANT M-OBJDESC 7>
<CONSTANT M-CONTAINER 8>
<CONSTANT M-OBJDESC? 9>
<CONSTANT M-SCENE-SETUP 10>
<CONSTANT M-WINNER 11>
<CONSTANT M-SUBJ 12>
"machines"
<CONSTANT DEC-20 1>
<CONSTANT APPLE-2E 2>
<CONSTANT MACINTOSH 3>
<CONSTANT AMIGA 4>
<CONSTANT ATARI-ST 5>
<CONSTANT IBM 6>
<CONSTANT C128 7>
<CONSTANT C64 8>
<CONSTANT APPLE-2C 9>
<CONSTANT APPLE-2GS 10>
"fonts"
<CONSTANT F-OLD 0>
<CONSTANT F-DEFAULT 1>
<CONSTANT F-PICTURES 2>
<CONSTANT F-NEWFONT 3>
"screens"
<CONSTANT S-TEXT 0>
<CONSTANT S-WINDOW 1>
"yzip screen attribute offsets"
<CONSTANT WTOP 0>
<CONSTANT WLEFT 1>
<CONSTANT WHIGH 2>
<CONSTANT WWIDE 3>
<CONSTANT WYPOS 4>
<CONSTANT WXPOS 5>
<CONSTANT WLMARGIN 6>
<CONSTANT WRMARGIN 7>
<CONSTANT WCRFUNC 8>
<CONSTANT WCRCNT 9>
<CONSTANT WHLIGHT 10>
<CONSTANT WCOLOR 11>
<CONSTANT WFONT 12>
<CONSTANT WFSIZE 13>
<CONSTANT WATTRS 14>
<CONSTANT WLCNT 15>
"screen attribute bits"
<CONSTANT A-WRAP 1> ;"screen wrapping attribute"
<CONSTANT A-SCROLL 2> ;"screen scrolling attribute"
<CONSTANT A-SCRIPT 4> ;"screen scripting attribute"
<CONSTANT A-BUFFER 8> ;"screen buffereing attribute"
"screen attribute operations"
<CONSTANT O-MOVE 0> ;"change all attributes"
<CONSTANT O-SET 1> ;"set selected attributes"
<CONSTANT O-CLEAR 2> ;"clear selected attributes"
<CONSTANT O-COMP 3> ;"complement selected attributes"
"sounds"
<CONSTANT S-BEEP 1>
<CONSTANT S-BOOP 2>
"sound operations"
<CONSTANT S-INIT 1>
<CONSTANT S-START 2>
<CONSTANT S-STOP 3>
<CONSTANT S-CLEANUP 4>
"highlighting modes"
<CONSTANT H-NORMAL 0>
<CONSTANT H-INVERSE 1>
<CONSTANT H-BOLD 2>
<CONSTANT H-ITALIC 4>
<CONSTANT H-UNDER 4>
<CONSTANT H-MONO 8>
"device control"
<CONSTANT D-KEYBOARD 0>
<CONSTANT D-COMMAND-FILE 1>
<CONSTANT D-SCREEN 1>
<CONSTANT D-SCREEN-ON 1>
<CONSTANT D-SCREEN-OFF -1>
<CONSTANT D-PRINTER 2>
<CONSTANT D-PRINTER-ON 2>
<CONSTANT D-PRINTER-OFF -2>
<CONSTANT D-TABLE 3>
<CONSTANT D-TABLE-ON 3>
<CONSTANT D-TABLE-OFF -3>
<CONSTANT D-RECORD 4>
<CONSTANT D-RECORD-ON 4>
<CONSTANT D-RECORD-OFF -4>
"colors"
<CONSTANT C-HERE -1>
<CONSTANT C-SAME 0>
<CONSTANT C-DEFAULT 1>
<CONSTANT C-BLACK 2>
<CONSTANT C-RED 3>
<CONSTANT C-GREEN 4>
<CONSTANT C-YELLOW 5>
<CONSTANT C-BLUE 6>
<CONSTANT C-MAGENTA 7>
<CONSTANT C-CYAN 8>
<CONSTANT C-WHITE 9>
"function keys"
<CONSTANT UP-ARROW 129>
<CONSTANT DOWN-ARROW 130>
<CONSTANT LEFT-ARROW 131>
<CONSTANT RIGHT-ARROW 132>
<CONSTANT F1 133>
<CONSTANT F2 134>
<CONSTANT F3 135>
<CONSTANT F4 136>
<CONSTANT F5 137>
<CONSTANT F6 138>
<CONSTANT F7 139>
<CONSTANT F8 140>
<CONSTANT F9 141>
<CONSTANT F10 142>
<CONSTANT F11 143>
<CONSTANT F12 144>
<CONSTANT PAD0 145>
<CONSTANT PAD1 146>
<CONSTANT PAD2 147>
<CONSTANT PAD3 148>
<CONSTANT PAD4 149>
<CONSTANT PAD5 150>
<CONSTANT PAD6 151>
<CONSTANT PAD7 152>
<CONSTANT PAD8 153>
<CONSTANT PAD9 154>
<CONSTANT CLICKM 252> ;"mouse clicked on a menu item"
<CONSTANT CLICK2 253> ;"mouse second/double click"
<CONSTANT CLICK1 254> ;"mouse first/single click"
"MODE byte bits"
<CONSTANT M-COLOR 1>
<CONSTANT M-DISPLAY 2>
<CONSTANT M-BOLD 4>
<CONSTANT M-UNDERLINE 8>
<CONSTANT M-MONOSPACE 16>
<CONSTANT M-SOUND 32>
<DEFMAC MODE-ON? ('F)
<FORM NOT <FORM ZERO? <FORM BAND <FORM LOWCORE MODE> .F>>>>
"FLAGS word bits"
<CONSTANT F-SCRIPT 1>
<CONSTANT F-FIXED 2>
<CONSTANT F-STATUS 4>
<CONSTANT F-REFRESH 4>
<CONSTANT F-DISPLAY 8>
<CONSTANT F-UNDO 16>
<CONSTANT F-MOUSE 32>
<CONSTANT F-COLOR 64>
<CONSTANT F-SOUND 128>
<CONSTANT F-MENU 256>
<DEFMAC FLAG-ON? ('F)
<FORM NOT <FORM ZERO? <FORM BAND <FORM LOWCORE FLAGS> .F>>>>
<DEFMAC HIGH-BYTE ('W)
<FORM SHIFT .W -8>>
<DEFMAC LOW-BYTE ('W)
<FORM BAND .W 255>>
<DEFMAC SET-HIGH-BYTE ('W 'B)
<FORM BOR <FORM SHIFT .B 8> <FORM BAND .W 255>>>
<DEFMAC SET-LOW-BYTE ('W 'B)
<FORM BOR <FORM BAND .W 65280> .W>>

132
defs.zil Normal file
View File

@ -0,0 +1,132 @@
"DEFS to replace parser's versions for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<BEGIN-SEGMENT 0>
<INCLUDE "SYMBOLS">
<COMPILATION-FLAG P-DEBUGGING-PARSER <>>
<ADD-TELL-TOKENS D * <DPRINT .X>>
<DELAY-DEFINITION CAPITAL-NOUN?>
<REPLACE-DEFINITION FIRST-HINT-POS
<CONSTANT FIRST-HINT-LINE 5>
<CONSTANT FIRST-HINT-COLUMN 7>>
<DELAY-DEFINITION READ-INPUT>
<DELAY-DEFINITION GAME-VERB?>
<DELAY-DEFINITION LIT?>
<REPLACE-DEFINITION NO-M-WINNER-VERB?
<DEFMAC NO-M-WINNER-VERB? ()
'<VERB? ASK-ABOUT ;MAKE-WITH SRIDE-DIR SSEARCH-OBJECT-FOR
;SGIVE SPUT-ON SSHOW STHROW SWRAP ;TELL-ABOUT STOUCH>>>
<REPLACE-DEFINITION NOT-HERE-VERB?
<ROUTINE NOT-HERE-VERB? (V)
<EQUAL? .V ,V?WALK-TO ,V?RESEARCH>>>
<REPLACE-DEFINITION OWNERS
<CONSTANT OWNERS <TABLE (PURE LENGTH) JESTER WALL>>>
<REPLACE-DEFINITION PARSER-REPORT <CONSTANT PARSER-REPORT <>>>
<REPLACE-DEFINITION PERSONBIT <CONSTANT PERSONBIT ACTORBIT>>
<REPLACE-DEFINITION PLAYER <CONSTANT PLAYER PROTAGONIST>>
<REPLACE-DEFINITION PRINT-INTQUOTE <CONSTANT PRINT-INTQUOTE 0>>
<DELAY-DEFINITION REFRESH>
<REPLACE-DEFINITION ROOMSBIT <CONSTANT ROOMSBIT KLUDGEBIT>>
<REPLACE-DEFINITION SEE-VERB?
<ROUTINE SEE-VERB? ()
<VERB? CHASTISE COUNT EXAMINE FIND TAKE
;INVENTORY LOOK LOOK-BEHIND LOOK-DOWN LOOK-INSIDE
LOOK-UNDER READ SEARCH>>>
<COMPILATION-FLAG P-APOSTROPHE-BREAKS-WORDS <>>
<REPLACE-DEFINITION SIBREAKS <SETG20 SIBREAKS ".,\"!?">>
<REPLACE-DEFINITION SETUP-ORPHAN-NP <CONSTANT SETUP-ORPHAN-NP 0>>
<REPLACE-DEFINITION SPEAKING-VERB?
<ROUTINE SPEAKING-VERB? ("OPT" (A ,PRSA))
<COND (<EQUAL? .A ;,V?ANSWER ,V?ASK-ABOUT ,V?ASK-FOR ,V?HELLO
,V?NO ;,V?REPLY ,V?TELL ,V?TELL-ABOUT ,V?YES>
<RTRUE>)>>>
<DELAY-DEFINITION STATUS-LINE>
<REPLACE-DEFINITION TELL-TOO-DARK
<ROUTINE TELL-TOO-DARK ()
<SETG P-CONT -1> ;<RFATAL>
<TELL ,TOO-DARK>
<COND (<VERB? LOOK>
<GRUE-PIT-WARNING>)
(T
<CRLF>)>>>
<COMPILATION-FLAG P-TITLE-ABBRS T>
<REPLACE-DEFINITION TITLE-ABBR?
<DEFMAC TITLE-ABBR?!- ('WRD) <FORM EQUAL? .WRD ',W?ST ',W?D ',W?J ',W?A>>>
<DELAY-DEFINITION VERB-ALL-TEST>
<REPLACE-DEFINITION YES? <CONSTANT YES? 0>>
<COMPILATION-FLAG P-PS-ADV T>
<COMPILATION-FLAG P-PS-COMMA T>
<COMPILATION-FLAG P-PS-OFWORD T>
;<COMPILATION-FLAG P-PS-THEWORD T>
<COMPILATION-FLAG P-PS-QUOTE T>
<TERMINALS VERB NOUN ADJ ;"keep these three in order! -- SWG"
DIR
PARTICLE PREP ;"keep these two in order! -- SWG"
ASKWORD ;7
OFWORD ;ARTICLE QUOTE COMMA
ADV QUANT MISCWORD>
<PROPDEF DIRECTIONS <>
(DIR TO R:ROOM =
(UEXIT 1) ;444 #SEMI "UNCONDITIONAL EXIT"
(REXIT <ROOM .R>) #SEMI "TO ROOM")
(DIR S:STRING =
(NEXIT 2) ;99 #SEMI "IMPOSSIBLE EXIT"
(NEXITSTR <STRING .S>) #SEMI "FAILURE MESSAGE")
(DIR SORRY S:STRING =
(NEXIT 2) #SEMI "IMPOSSIBLE EXIT"
(NEXITSTR <STRING .S>) #SEMI "FAILURE MESSAGE")
(DIR PER F:FCN =
(FEXIT 3) ;53 #SEMI "CONDITIONAL EXIT"
(FEXITFCN <WORD .F>) #SEMI "PER FUNCTION"
<BYTE 0>)
(DIR TO R:ROOM IF F:GLOBAL "OPT" ELSE S:STRING =
(CEXIT 4) ;7 #SEMI "CONDITIONAL EXIT"
(REXIT <ROOM .R>) #SEMI "TO ROOM"
(CEXITFLAG <GLOBAL .F>) #SEMI "IF FLAG IS TRUE"
(CEXITSTR <STRING .S>) #SEMI "FAILURE MESSAGE")
(DIR TO R:ROOM IF O:OBJECT IS OPEN "OPT" ELSE S:STRING =
(DEXIT 5) ;15 #SEMI "CONDITIONAL EXIT"
(DEXITOBJ <OBJECT .O>) #SEMI "IF DOOR IS OPEN"
(DEXITSTR <STRING .S>) #SEMI "FAILURE MESSAGE"
(DEXITRM <ROOM .R>) #SEMI "TO ROOM")>
;<REPLACE-DEFINITION GET-DEXITOBJ
<ROUTINE GET-DEXITOBJ (PT) <ZGET <REST .PT> ,DEXITOBJ>>>
<DIRECTIONS NORTH NE EAST SE SOUTH SW WEST NW UP DOWN IN OUT>
<OBJECT INTDIR
(LOC GLOBAL-OBJECTS)
(DESC "direction")
(SYNONYM NORTH NE EAST SE SOUTH SW WEST NW ;UP ;DOWN)>
;<CONSTANT M-OBJDESC? 10>
<ZSTART GO> ;"else, ZIL gets confused between verb-word GO and routine GO"
<CONSTANT S-FULL 7>
<END-SEGMENT>

69
defs2.zabstr Normal file
View File

@ -0,0 +1,69 @@
<BEGIN-SEGMENT 0>
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
<NEW-ADD-WORD "CAGES" NOUN <VOC "CAGE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "STALLS" NOUN <VOC "STALL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "DOORS" NOUN <VOC "DOOR"> ,PLURAL-FLAG>
<NEW-ADD-WORD "BUTTONS" NOUN <VOC "BUTTON"> ,PLURAL-FLAG>
<NEW-ADD-WORD "ORBS" NOUN <VOC "ORB"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SLABS" NOUN <VOC "SLAB"> ,PLURAL-FLAG>
<NEW-ADD-WORD "WEIGHTS" NOUN <VOC "WEIGHT"> ,PLURAL-FLAG>
<NEW-ADD-WORD "ANIMALS" NOUN <VOC "ANIMAL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SNAKES" NOUN <VOC "SNAKE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "KEYS" NOUN <VOC "KEY"> ,PLURAL-FLAG>
<NEW-ADD-WORD "PEGS" NOUN <VOC "PEG"> ,PLURAL-FLAG>
<NEW-ADD-WORD "POSTS" NOUN <VOC "POST"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SHELLS" NOUN <VOC "SHELL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "FLIES" NOUN <VOC "FLY"> ,PLURAL-FLAG>
<NEW-ADD-WORD "VIALS" NOUN <VOC "VIAL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "TREES" NOUN <VOC "TREE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "ELMS" NOUN <VOC "ELM"> ,PLURAL-FLAG>
<NEW-ADD-WORD "OAKS" NOUN <VOC "OAK"> ,PLURAL-FLAG>
<NEW-ADD-WORD "PINES" NOUN <VOC "PINE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "WITCHES" NOUN <VOC "WITCH"> ,PLURAL-FLAG>
<NEW-ADD-WORD "PASSAGES" NOUN <VOC "PASSAGE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "FLOWERS" NOUN <VOC "FLOWER"> ,PLURAL-FLAG>
<NEW-ADD-WORD "BOARDS" NOUN <VOC "BOARD"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SHUTTERS" NOUN <VOC "SHUTTER"> ,PLURAL-FLAG>
<NEW-ADD-WORD "DIMWIT'S" ADJ DIMWIT ,POSSESSIVE>
<NEW-ADD-WORD "JESTER'S" ADJ JESTER ,POSSESSIVE>
<DEFINE-ROUTINE DIRECTION-CONVERSION>
<REPLACE-DEFINITION MOBY-FIND? <ROUTINE MOBY-FIND? (SEARCH) <COND (<OR <NOT <0?
<ANDB .SEARCH ,SEARCH-MOBY>>> <EQUAL? ,WINNER ,EXECUTIONER>> T)>>>
<REPLACE-DEFINITION WHICH-LIST? <ROUTINE WHICH-LIST? (NP SR "AUX" (CT <
FIND-RES-COUNT .SR>) (V <REST-TO-SLOT .SR FIND-RES-OBJ1>)) <COND (<G? .CT <
FIND-RES-SIZE .SR>> <RFALSE>) (<AND <SET NP <INTBL? ,PSEUDO-OBJECT .V .CT>> <
INTBL? ,PSEUDO-OBJECT <REST .NP 2> <- .CT </ <+ 2 <- .NP .V>> 2>>>> <RFALSE>)>
<REPEAT () <COND (<L? <SET CT <- .CT 1>> 0> <RFALSE>) (<ACCESSIBLE? <ZGET .V 0>
> <RTRUE>) (T <SET V <ZREST .V 2>>)>>>>
<REPLACE-DEFINITION PSEUDO-OBJECTS <PUTPROP THINGS PROPSPEC HACK-PSEUDOS> <
DEFINE20 HACK-PSEUDOS (LIST "AUX" (N 0) (CT 0) NL) <SET LIST <REST .LIST>> <SET
LIST <MAPF ,LIST <FUNCTION (X) <COND (<0? .N> <SET CT <+ .CT 1>> <SET N 1> <
COND (<TYPE? .X ATOM> <TABLE (PURE) 1 <VOC <SPNAME .X> ADJ>>) (<TYPE? .X LIST>
<EVAL <CHTYPE (TABLE (PURE) <LENGTH .X> !<MAPF ,LIST <FUNCTION (Y) <VOC <SPNAME
.Y> ADJ>> .X!>) FORM>>) (T 0)>) (<1? .N> <SET N 2> <COND (<TYPE? .X ATOM> <
TABLE (PURE) 1 <VOC <SPNAME .X> NOUN>>) (<TYPE? .X LIST> <EVAL <CHTYPE (TABLE (
PURE) <LENGTH .X> !<MAPF ,LIST <FUNCTION (Y) <VOC <SPNAME .Y> NOUN>> .X!>) FORM
>>) (T 0)>) (T <SET N 0> .X)>> .LIST>> (<> <EVAL <CHTYPE (TABLE (PURE) .CT !.
LIST) FORM>>)> <DEFINE TEST-THINGS (RM F "AUX" CT (RMG <GETP .RM ,P?THINGS>) (
RMGL <GET .RMG 0>)) <SET RMG <REST .RMG 2>> <COND (<T? <SET CT <FIND-ADJS .F>>>
<SET CT <ADJS-COUNT .CT>>)> <REPEAT (TTBL (NOUN <FIND-NOUN .F>) (V <
REST-TO-SLOT <FIND-ADJS .F> ADJS-COUNT 1>)) <COND (<AND <SET TTBL <GET .RMG 1>>
<OR <EQUAL? .NOUN ,W?ONE> <INTBL? .NOUN <REST .TTBL 2> <GET .TTBL 0>>> <OR <0?
.CT> <AND <SET TTBL <GET .RMG 0>> <INTBL? <ZGET .V 0> <REST .TTBL 2> <GET .TTBL
0>>>> <OR <NOT <FIND-OF .F>> <AND <EQUAL? 1 <FIND-RES-COUNT ,OWNER-SR-HERE>> <
EQUAL? ,PSEUDO-OBJECT <FIND-RES-OBJ1 ,OWNER-SR-HERE>> <EQUAL? ,LAST-PSEUDO-LOC
.RM> <EQUAL? <GETP ,PSEUDO-OBJECT ,P?ACTION> <GET .RMG 2>>>>> <SETG
LAST-PSEUDO-LOC .RM> <PUTP ,PSEUDO-OBJECT ,P?ACTION <GET .RMG 2>> <SET V <ZBACK
<GETPT ,PSEUDO-OBJECT ,P?ACTION> 7>> <COPYT .NOUN .V 6> <ADD-OBJECT ,
PSEUDO-OBJECT .F> <RFALSE>)> <SET RMG <REST .RMG 6>> <COND (<L? <SET RMGL <- .
RMGL 1>> 1> <RTRUE>)>>> <GLOBAL LAST-PSEUDO-LOC:OBJECT <>> <OBJECT
PSEUDO-OBJECT (LOC LOCAL-GLOBALS) (DESC "pseudoxxx") (ACTION 0)>>
<REPLACE-DEFINITION INVALID-OBJECT? <ROUTINE INVALID-OBJECT? (OBJ) <COND (<
EVERYWHERE-VERB?> <RFALSE>)> <COND (<AND <EQUAL? .OBJ ,CEILING> <FSET? ,HERE ,
OUTSIDEBIT> <NOT <EQUAL? ,HERE ,ROOF ,PARAPET>>> <RTRUE>) (<AND <EQUAL? .OBJ ,
LOCK-OBJECT> <NOUN-USED? ,LOCK-OBJECT ,W?KEYHOLE> <EQUAL? ,HERE ,LOWEST-HALL>>
<RTRUE>) (<AND <EQUAL? .OBJ ,WALL> <FSET? ,HERE ,OUTSIDEBIT> <NOT <EQUAL? ,
W?ONE <FIND-NOUN ,FINDER>>> <NOT <EQUAL? ,HERE ,PERIMETER-WALL>>> <RTRUE>) (T <
RFALSE>)>>>
<END-SEGMENT>

13
defs2.zap Normal file
View File

@ -0,0 +1,13 @@
.SEGMENT "0"
.FUNCT DIRECTION-CONVERSION
CALL2 GET-NP,INTDIR
GET STACK,2
GETB STACK,6
RSTACK
.ENDSEG
.ENDI

165
defs2.zil Normal file
View File

@ -0,0 +1,165 @@
"DEFS2 for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<BEGIN-SEGMENT 0>
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
<NEW-ADD-WORD "CAGES" NOUN <VOC "CAGE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "STALLS" NOUN <VOC "STALL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "DOORS" NOUN <VOC "DOOR"> ,PLURAL-FLAG>
<NEW-ADD-WORD "BUTTONS" NOUN <VOC "BUTTON"> ,PLURAL-FLAG>
<NEW-ADD-WORD "ORBS" NOUN <VOC "ORB"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SLABS" NOUN <VOC "SLAB"> ,PLURAL-FLAG>
<NEW-ADD-WORD "WEIGHTS" NOUN <VOC "WEIGHT"> ,PLURAL-FLAG>
<NEW-ADD-WORD "ANIMALS" NOUN <VOC "ANIMAL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SNAKES" NOUN <VOC "SNAKE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "KEYS" NOUN <VOC "KEY"> ,PLURAL-FLAG>
<NEW-ADD-WORD "PEGS" NOUN <VOC "PEG"> ,PLURAL-FLAG>
<NEW-ADD-WORD "POSTS" NOUN <VOC "POST"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SHELLS" NOUN <VOC "SHELL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "FLIES" NOUN <VOC "FLY"> ,PLURAL-FLAG>
<NEW-ADD-WORD "VIALS" NOUN <VOC "VIAL"> ,PLURAL-FLAG>
<NEW-ADD-WORD "TREES" NOUN <VOC "TREE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "ELMS" NOUN <VOC "ELM"> ,PLURAL-FLAG>
<NEW-ADD-WORD "OAKS" NOUN <VOC "OAK"> ,PLURAL-FLAG>
<NEW-ADD-WORD "PINES" NOUN <VOC "PINE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "WITCHES" NOUN <VOC "WITCH"> ,PLURAL-FLAG>
<NEW-ADD-WORD "PASSAGES" NOUN <VOC "PASSAGE"> ,PLURAL-FLAG>
<NEW-ADD-WORD "FLOWERS" NOUN <VOC "FLOWER"> ,PLURAL-FLAG>
<NEW-ADD-WORD "BOARDS" NOUN <VOC "BOARD"> ,PLURAL-FLAG>
<NEW-ADD-WORD "SHUTTERS" NOUN <VOC "SHUTTER"> ,PLURAL-FLAG>
<NEW-ADD-WORD "DIMWIT\'S" ADJ DIMWIT ,POSSESSIVE>
<NEW-ADD-WORD "JESTER\'S" ADJ JESTER ,POSSESSIVE>
<ROUTINE DIRECTION-CONVERSION ()
<WORD-DIR-ID <NP-NAME <GET-NP ,INTDIR>>>>
<REPLACE-DEFINITION MOBY-FIND?
<ROUTINE MOBY-FIND? (SEARCH)
<COND (<OR <NOT <0? <ANDB .SEARCH ,SEARCH-MOBY ;128>>>
<EQUAL? ,WINNER ,EXECUTIONER>>
T)>>>
<REPLACE-DEFINITION WHICH-LIST?
<ROUTINE WHICH-LIST? (NP SR "AUX" (CT <FIND-RES-COUNT .SR>)
(V <REST-TO-SLOT .SR FIND-RES-OBJ1>))
<COND (<G? .CT <FIND-RES-SIZE .SR>>
<RFALSE>)
;(<EQUAL? <NP-NAME .NP> ,W?FLY ,W?FLIES>
<RFALSE>)
(<AND <SET NP <INTBL? ,PSEUDO-OBJECT .V .CT>>
<INTBL? ,PSEUDO-OBJECT <REST .NP 2>
<- .CT </ <+ 2 <- .NP .V>> 2>>>>
<RFALSE>)>
<REPEAT ()
<COND (<L? <SET CT <- .CT 1>> 0>
<RFALSE>)
(<ACCESSIBLE? <ZGET .V 0>>
<RTRUE>)
(T
<SET V <ZREST .V 2>>)>>>>
<REPLACE-DEFINITION PSEUDO-OBJECTS
<PUTPROP THINGS PROPSPEC HACK-PSEUDOS>
<DEFINE20 HACK-PSEUDOS (LIST "AUX" (N 0) (CT 0) NL)
<SET LIST <REST .LIST>>
<SET LIST
<MAPF ,LIST
<FUNCTION (X)
<COND (<0? .N>
<SET CT <+ .CT 1>>
<SET N 1>
<COND (<TYPE? .X ATOM>
<TABLE (PURE ;PATTERN ;(BYTE [REST WORD]))
1
<VOC <SPNAME .X> ADJ>>)
(<TYPE? .X LIST>
<EVAL <CHTYPE (TABLE (PURE ;PATTERN ;(BYTE [REST WORD]))
<LENGTH .X>
!<MAPF ,LIST
<FUNCTION (Y)
<VOC <SPNAME .Y> ADJ>>
.X>) FORM>>)
(T 0)>)
(<1? .N>
<SET N 2>
<COND (<TYPE? .X ATOM>
<TABLE (PURE ;PATTERN ;(BYTE [REST WORD]))
1 <VOC <SPNAME .X> NOUN>>)
(<TYPE? .X LIST>
<EVAL <CHTYPE (TABLE (PURE ;PATTERN ;(BYTE [REST WORD]))
<LENGTH .X>
!<MAPF ,LIST
<FUNCTION (Y)
<VOC <SPNAME .Y> NOUN>>
.X>) FORM>>)
(T 0)>)
(T
<SET N 0>
.X)>>
.LIST>>
(<> <EVAL <CHTYPE (TABLE (PURE ;PATTERN ;(BYTE [REST WORD]))
.CT !.LIST) FORM>>)>
<DEFINE TEST-THINGS (RM F
"AUX" CT (RMG <GETP .RM ,P?THINGS>) (RMGL <GET .RMG 0>))
<SET RMG <REST .RMG 2>>
<COND (<T? <SET CT <FIND-ADJS .F>>>
<SET CT <ADJS-COUNT .CT>>)>
<REPEAT (TTBL (NOUN <FIND-NOUN .F>)
(V <REST-TO-SLOT <FIND-ADJS .F> ADJS-COUNT 1>))
<COND (<AND <SET TTBL <GET .RMG 1>>
<OR <EQUAL? .NOUN ;<> ,W?ONE>
<INTBL? .NOUN <REST .TTBL 2> <GET .TTBL 0>>>
<OR <0? .CT>
<AND <SET TTBL <GET .RMG 0>>
<INTBL? <ZGET .V 0> <REST .TTBL 2> <GET .TTBL 0>>>>
<OR <NOT <FIND-OF .F>>
<AND <EQUAL? 1 <FIND-RES-COUNT ,OWNER-SR-HERE>>
<EQUAL? ,PSEUDO-OBJECT <FIND-RES-OBJ1 ,OWNER-SR-HERE>>
<EQUAL? ,LAST-PSEUDO-LOC .RM>
<EQUAL? <GETP ,PSEUDO-OBJECT ,P?ACTION> <GET .RMG 2>>>>>
<SETG LAST-PSEUDO-LOC .RM>
<PUTP ,PSEUDO-OBJECT ,P?ACTION <GET .RMG 2>>
<SET V <ZBACK <GETPT ,PSEUDO-OBJECT ,P?ACTION> 7>>
<COPYT .NOUN .V 6>
<ADD-OBJECT ,PSEUDO-OBJECT .F>
<RFALSE>)>
<SET RMG <REST .RMG 6>>
<COND (<L? <SET RMGL <- .RMGL 1>> 1>
<RTRUE>)>>>
<GLOBAL LAST-PSEUDO-LOC:OBJECT <>>
<OBJECT PSEUDO-OBJECT
(LOC LOCAL-GLOBALS)
(DESC "pseudoxxx")
(ACTION 0) ;"no other properties!">>
<REPLACE-DEFINITION INVALID-OBJECT?
<ROUTINE INVALID-OBJECT? (OBJ)
<COND (<EVERYWHERE-VERB?>
<RFALSE>)>
<COND (<AND <EQUAL? .OBJ ,CEILING>
<FSET? ,HERE ,OUTSIDEBIT>
<NOT <EQUAL? ,HERE ,ROOF ,PARAPET>>>
<RTRUE>)
(<AND <EQUAL? .OBJ ,LOCK-OBJECT>
<NOUN-USED? ,LOCK-OBJECT ,W?KEYHOLE>
<EQUAL? ,HERE ,LOWEST-HALL>>
<RTRUE>)
(<AND <EQUAL? .OBJ ,WALL>
<FSET? ,HERE ,OUTSIDEBIT>
<NOT <EQUAL? ,W?ONE <FIND-NOUN ,FINDER>>>
<NOT <EQUAL? ,HERE ,PERIMETER-WALL>>>
<RTRUE>)
(T
<RFALSE>)>>>
<END-SEGMENT>

153
fenshire.zabstr Normal file
View File

@ -0,0 +1,153 @@
<BEGIN-SEGMENT FENSHIRE>
<ROOM DIRIGIBLE-HANGAR (LOC ROOMS) (REGION "Flatheadia") (DESC
"Dirigible Hangar") (LDESC
"Even after becoming accustomed to the oversized scale of the castle,
this hangar seems tremendous. The only exit on foot is to the east.") (EAST TO
WEST-WING) (OUT TO WEST-WING) (IN PER DIRIGIBLE-ENTER-F) (FLAGS RLANDBIT ONBIT)
(SYNONYM HANGAR) (ADJECTIVE DIRIGIBLE LARGE) (MAP-LOC <PTABLE MAIN-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-1>) (GLOBAL GONDOLA) (ACTION DIRIGIBLE-HANGAR-F)>
<DEFINE-ROUTINE DIRIGIBLE-ENTER-F>
<DEFINE-ROUTINE DIRIGIBLE-HANGAR-F>
<OBJECT DIRIGIBLE (LOC DIRIGIBLE-HANGAR) (DESC "dirigible") (LDESC
"A tremendous dirigible is moored here. The gondola is just a few inches
off the ground.") (SYNONYM DIRIGIBLE) (FLAGS VEHBIT) (ACTION DIRIGIBLE-F)>
<DEFINE-ROUTINE DIRIGIBLE-F>
<ROOM GONDOLA (LOC ROOMS) (REGION "Flatheadia") (DESC "Gondola") (OUT PER
GONDOLA-EXIT-F) (FLAGS RLANDBIT ONBIT) (SYNONYM GONDOLA) (GLOBAL WINDOW
DIRIGIBLE DIRIGIBLE-HANGAR SMALLER-HANGAR) (MAP-LOC <TABLE MAIN-MAP-NUM
GONDOLA-AT-FLATHEADIA-LOC MAP-GEN-X-1>) (ICON GONDOLA-ICON) (ACTION GONDOLA-F)>
<DEFINE-ROUTINE GONDOLA-F>
<CONSTANT GONDOLA-CONTROLS-DESC
"The controls consist of merely two buttons: the left button
is marked \"Flatheadia\" and the right button is marked \"Fenshire.\"">
<OBJECT GONDOLA-CONTROLS (LOC GONDOLA) (DESC "controls") (SYNONYM CONTROL
CONTROLS) (FLAGS NDESCBIT) (ACTION GONDOLA-CONTROLS-F)>
<DEFINE-ROUTINE GONDOLA-CONTROLS-F>
<OBJECT LEFT-GONDOLA-BUTTON (LOC GONDOLA) (DESC "left button") (SYNONYM BUTTON)
(ADJECTIVE LEFT) (FLAGS NDESCBIT) (ACTION GONDOLA-BUTTON-F)>
<OBJECT RIGHT-GONDOLA-BUTTON (LOC GONDOLA) (DESC "right button") (SYNONYM
BUTTON) (ADJECTIVE RIGHT) (FLAGS NDESCBIT) (ACTION GONDOLA-BUTTON-F)>
<DEFINE-ROUTINE GONDOLA-BUTTON-F>
<DEFINE-ROUTINE GONDOLA-EXIT-F>
<GLOBAL DESTINATION <>>
<GLOBAL DIRIGIBLE-COUNTER 0>
<DEFINE-ROUTINE I-DIRIGIBLE>
<CONSTANT DIRIGIBLE-TRIP-DESCS <PTABLE
"It is now passing over a thickly tangled woods, stretching for miles in every
direction." "You are now above the Frigid River. Cliffs crowd the river on both sides. To
the south, you can just make out the spray of Aragain Falls."
"The dirigible rises even higher as it crosses the Flathead Mountains. Jagged,
snow-topped peaks slide by below."
"Below you are vast square bloits of dismal swampland: the endless marshes of
Fenshire.">>
<ROOM SMALLER-HANGAR (LOC ROOMS) (REGION "Fenshire") (DESC "Smaller Hangar") (
LDESC "This hangar, though still large, is smaller than the one in Flatheadia.
The only exit is south.") (SOUTH TO DESERTED-CASTLE) (IN PER DIRIGIBLE-ENTER-F)
(OUT TO DESERTED-CASTLE) (FLAGS RLANDBIT ONBIT) (SYNONYM HANGAR) (ADJECTIVE
SMALLER) (GLOBAL GONDOLA) (VALUE 6) (MAP-LOC <PTABLE FENSHIRE-MAP-NUM
MAP-GEN-Y-3 MAP-GEN-X-2>) (ACTION 0)>
<DEFINE-ROUTINE SMALLER-HANGAR-F>
<ROOM DESERTED-CASTLE (LOC ROOMS) (REGION "Fenshire") (DESC "Deserted Castle")
(LDESC "The summer palace of the Kings of Quendor now lies in ruins, unoccupied
and uncared for, forgotten for many years. What's left of the castle can
be entered to the east, and a hangar lies to the north.") (NORTH TO
SMALLER-HANGAR) (EAST TO RUINED-HALL) (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (GLOBAL
SMALLER-HANGAR) (MAP-LOC <PTABLE FENSHIRE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-2>) (
ACTION 0)>
<DEFINE-ROUTINE DESERTED-CASTLE-F>
<ROOM RUINED-HALL (LOC ROOMS) (REGION "Fenshire") (DESC "Ruined Hall") (NORTH
TO MARSH IF ARCHWAY-OPEN ELSE "That archway has crumbled!") (SOUTH TO HOTHOUSE)
(WEST TO DESERTED-CASTLE) (EAST TO SECRET-ROOM IF SECRET-ROOM-REVEALED) (UP
SORRY "The stairs have crumbled beyond use.") (FLAGS RLANDBIT ONBIT) (GLOBAL
STAIRS) (MAP-LOC <PTABLE FENSHIRE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-3>) (ICON
RUINED-HALL-ICON) (ACTION RUINED-HALL-F)>
<DEFINE-ROUTINE RUINED-HALL-F>
<OBJECT FIREPLACE (LOC RUINED-HALL) (DESC "fireplace") (SYNONYM FIREPLACE) (
ADJECTIVE CHOKED) (FLAGS NDESCBIT) (ACTION FIREPLACE-F)>
<DEFINE-ROUTINE FIREPLACE-F>
<OBJECT FRESCO (LOC RUINED-HALL) (DESC "fresco") (SYNONYM FRESCO) (ADJECTIVE
FADED) (FLAGS NDESCBIT) (ACTION FRESCO-F)>
<DEFINE-ROUTINE FRESCO-F>
<OBJECT VASE (LOC RUINED-HALL) (DESC "vase") (SYNONYM VASE) (ADJECTIVE SMALL) (
FLAGS NDESCBIT CONTBIT SEARCHBIT OPENBIT TRYTAKEBIT) (ACTION VASE-F)>
<DEFINE-ROUTINE VASE-F>
<GLOBAL SECRET-ROOM-REVEALED <>>
<ROOM SECRET-ROOM (LOC ROOMS) (REGION "Fenshire") (DESC "Secret Room") (LDESC
"You are the first person to breathe the air of this room in uncounted years.
The only exit is west.") (WEST TO RUINED-HALL) (OUT TO RUINED-HALL) (FLAGS
RLANDBIT) (SYNONYM ROOM) (ADJECTIVE SECRET) (MAP-LOC <PTABLE FENSHIRE-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-4>) (ICON SECRET-ROOM-ICON)>
<OBJECT LADDER (LOC SECRET-ROOM) (DESC "ladder") (FDESC
"This room was probably intended as a hiding place for the royal family
in the event of a revolution, and may have once been well-stocked with
supplies. Now, however, the only item here is a small stepladder.") (SYNONYM
LADDER STEPLADDER) (ADJECTIVE SMALL) (CAPACITY 20) (SIZE 20) (FLAGS TAKEBIT
VEHBIT CONTBIT SEARCHBIT SURFACEBIT) (ACTION LADDER-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE LADDER-F>
<END-SEGMENT>
<BEGIN-SEGMENT FENSHIRE>
<GLOBAL ARCHWAY-OPEN T>
<GLOBAL STEPPING-STONES-VISIBLE <>>
<ROOM MARSH (LOC ROOMS) (REGION "Fenshire") (DESC "Marsh") (SOUTH TO
RUINED-HALL IF ARCHWAY-OPEN ELSE
"The archway has collapsed; that way is now impassable.") (NORTH PER
STEPPING-STONES-F) (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (GLOBAL SWAMP ARCH) (ICON
MARSH-ICON) (MAP-LOC <PTABLE FENSHIRE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-3>) (ACTION
MARSH-F)>
<DEFINE-ROUTINE MARSH-F>
<DEFINE-ROUTINE STEPPING-STONES-F>
<ROOM NICE-LUNCH-SPOT (LOC ROOMS) (REGION "Fenshire") (DESC "Nice Lunch Spot")
(LDESC "Maybe the jester likes the ambience here, but to you it just looks like
a slightly drier spot amidst a reedy marsh. The reeds are impassably thick
in every direction, except to the south where a series of stepping stones
offers a way to cross a malodorous patch of quicksand.") (SOUTH TO MARSH) (
FLAGS RLANDBIT ONBIT OUTSIDEBIT) (MAP-LOC <PTABLE FENSHIRE-MAP-NUM MAP-GEN-Y-2
MAP-GEN-X-3>) (ACTION NICE-LUNCH-SPOT-F)>
<DEFINE-ROUTINE NICE-LUNCH-SPOT-F>
<BEGIN-SEGMENT 0>
<OBJECT HEXAGONAL-BLOCK (LOC LOCAL-GLOBALS) (DESC "hexagonal block") (SYNONYM
BLOCK ROCK) (ADJECTIVE SMALL ELONGATED HEXAGONAL HEXAGON-SHAPED) (FLAGS TAKEBIT
) (SIZE 3) (ACTION HEXAGONAL-BLOCK-F)>
<DEFINE-ROUTINE HEXAGONAL-BLOCK-F>
<END-SEGMENT>
<BEGIN-SEGMENT FENSHIRE>
<ROOM HOTHOUSE (LOC ROOMS) (REGION "Fenshire") (DESC "Hothouse") (LDESC
"This enclosed arboretum must have been a breathtaking room at one time. Now,
much of the glass is broken and the foliage has run wild, nearly obscuring the
exit to the north. Despite the broken glass, it's stiflingly hot in here.") (
NORTH TO RUINED-HALL) (OUT TO RUINED-HALL) (FLAGS RLANDBIT ONBIT) (SYNONYM
HOTHOUSE GREENHOUSE ARBORETUM) (GLOBAL WINDOW) (MAP-LOC <PTABLE
FENSHIRE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-3>) (ICON HOTHOUSE-ICON) (ACTION
HOTHOUSE-F)>
<DEFINE-ROUTINE HOTHOUSE-F>
<CONSTANT SN-PICSET-TBL <TABLE BOX-1 BOX-2 BOX-3 BOX-4 BOX-5 BOX-6 BOX-7 BOX-8
BOX-9 DIM-BOX-1 DIM-BOX-2 DIM-BOX-3 DIM-BOX-4 DIM-BOX-5 DIM-BOX-6 DIM-BOX-7
DIM-BOX-8 DIM-BOX-9 PILE-OF-0 PILE-OF-1 PILE-OF-2 PILE-OF-3 PILE-OF-4 PILE-OF-5
PILE-OF-6 PILE-OF-7 PILE-OF-8 PILE-OF-9 R-FLOWERS-0 R-FLOWERS-1 R-FLOWERS-2
R-FLOWERS-3 R-FLOWERS-4 R-FLOWERS-5 R-FLOWERS-6 R-FLOWERS-7 R-FLOWERS-8
R-FLOWERS-9 L-FLOWERS-0 L-FLOWERS-1 L-FLOWERS-2 L-FLOWERS-3 L-FLOWERS-4 0>>
<DEFINE-ROUTINE I-SN>
<DEFINE-ROUTINE SETUP-SN>
<DEFINE-ROUTINE DRAW-SN-BOXES>
<CONSTANT BOX-TBL <PTABLE 0 BOX-1 BOX-2 BOX-3 BOX-4 BOX-5 BOX-6 BOX-7 BOX-8
BOX-9>>
<CONSTANT DIM-BOX-TBL <PTABLE 0 DIM-BOX-1 DIM-BOX-2 DIM-BOX-3 DIM-BOX-4
DIM-BOX-5 DIM-BOX-6 DIM-BOX-7 DIM-BOX-8 DIM-BOX-9>>
<CONSTANT PILE-TABLE <TABLE 0 0 0 0 0>>
<DEFINE-ROUTINE DRAW-PILE>
<DEFINE-ROUTINE DRAW-FLOWERS>
<DEFINE-ROUTINE SNARFEM>
<DEFINE-ROUTINE SN-CLICK>
<DEFINE-ROUTINE COUNTDOWN-PILE>
<CONSTANT BINARY-TABLE <PTABLE 0 1 10 11 100 101 110 111 1000 1001>>
<DEFINE-ROUTINE SAFE-NUMBER?>
<CONSTANT TEMP-TABLE <TABLE 0 0 0 0 0>>
<DEFINE-ROUTINE J-MOVE>
<DEFINE-ROUTINE END-SN?>
<OBJECT FAN (DESC "fan") (SYNONYM FAN) (ADJECTIVE DELICATE DAINTY PAPER) (FLAGS
TAKEBIT TRYTAKEBIT MAGICBIT) (VALUE 0) (ACTION FAN-F)>
<DEFINE-ROUTINE FAN-F>
<END-SEGMENT>

948
fenshire.zap Normal file
View File

@ -0,0 +1,948 @@
.SEGMENT "FENSHIRE"
.FUNCT DIRIGIBLE-ENTER-F,RARG
IN? DIRIGIBLE,HERE \?CCL3
RETURN GONDOLA
?CCL3: ZERO? RARG \FALSE
ICALL1 V-WALK-AROUND
RFALSE
.FUNCT DIRIGIBLE-HANGAR-F,RARG
ZERO? DEMO-VERSION? /FALSE
EQUAL? RARG,M-END \FALSE
CALL1 END-DEMO
RSTACK
.FUNCT DIRIGIBLE-F
EQUAL? PRSA,V?PUT-THROUGH,V?THROW-FROM \?CCL3
EQUAL? PRSI,DIRIGIBLE \?CCL3
CALL PERFORM-PRSA,PRSO,GONDOLA
RSTACK
?CCL3: EQUAL? PRSA,V?EXAMINE \?CCL7
EQUAL? HERE,GONDOLA \?CCL10
CALL1 V-LOOK
RSTACK
?CCL10: GETP DIRIGIBLE,P?LDESC
PRINT STACK
CRLF
RTRUE
?CCL7: EQUAL? PRSA,V?LOOK-INSIDE \?CCL12
EQUAL? HERE,GONDOLA \?CCL15
PRINT LOOK-AROUND
RTRUE
?CCL15: PRINTR "You can't see much from out here."
?CCL12: EQUAL? PRSA,V?ENTER \FALSE
CALL2 GOTO,GONDOLA
RSTACK
.FUNCT GONDOLA-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "You are in the luxurious gondola of the dirigible. A window wraps completely around the gondola. "
PRINT GONDOLA-CONTROLS-DESC
RTRUE
?CCL3: ZERO? RARG \FALSE
EQUAL? PRSA,V?EXAMINE \?CCL7
CALL2 PERFORM-PRSA,DIRIGIBLE
RSTACK
?CCL7: EQUAL? PRSA,V?ENTER \?CCL9
EQUAL? HERE,GONDOLA /?CCL9
CALL2 DO-WALK,P?IN
RSTACK
?CCL9: EQUAL? PRSA,V?EXIT,V?LEAP-OFF \?CCL13
EQUAL? HERE,GONDOLA \?CCL13
CALL2 DO-WALK,P?OUT
RSTACK
?CCL13: EQUAL? PRSA,V?LOOK-INSIDE \?CCL17
CALL2 PERFORM-PRSA,DIRIGIBLE
RSTACK
?CCL17: EQUAL? PRSA,V?PUT-THROUGH,V?THROW-FROM \FALSE
EQUAL? PRSI,GLOBAL-HERE,GONDOLA \FALSE
IN? DIRIGIBLE,DIRIGIBLE-HANGAR /?CTR23
IN? DIRIGIBLE,SMALLER-HANGAR \?CCL24
?CTR23: LOC DIRIGIBLE
MOVE PRSO,STACK
JUMP ?CND22
?CCL24: EQUAL? PRSO,PERCH /?CCL28
CALL ULTIMATELY-IN?,PERCH,PRSO
ZERO? STACK /?CND27
?CCL28: SET 'REMOVED-PERCH-LOC,GROUND
?CND27: REMOVE PRSO
?CND22: PRINTI "You fling"
ICALL1 TPRINT-PRSO
PRINTR " out of the gondola."
.FUNCT GONDOLA-CONTROLS-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINT GONDOLA-CONTROLS-DESC
CRLF
RTRUE
.FUNCT GONDOLA-BUTTON-F
EQUAL? PRSA,V?PUSH \FALSE
ZERO? TIME-STOPPED \?CTR5
FSET? OUTER-GATE,OPENBIT /?CTR5
GRTR? DIRIGIBLE-COUNTER,0 /?CTR5
EQUAL? PRSO,LEFT-GONDOLA-BUTTON \?PRD11
IN? DIRIGIBLE,DIRIGIBLE-HANGAR /?CTR5
?PRD11: EQUAL? PRSO,RIGHT-GONDOLA-BUTTON \?CCL6
IN? DIRIGIBLE,SMALLER-HANGAR \?CCL6
?CTR5: PRINT NOTHING-HAPPENS
RTRUE
?CCL6: ICALL QUEUE,I-DIRIGIBLE,-1
SET 'DIRIGIBLE-COUNTER,1
ZERO? BORDER-ON /?CND16
GETB 0,30
EQUAL? STACK,DEC-20 /?CND16
ICALL1 CLEAR-BORDER
ICALL2 INIT-STATUS-LINE,TRUE-VALUE
?CND16: PRINTI "The dirigible rises out of the hangar and sails "
IN? DIRIGIBLE,DIRIGIBLE-HANGAR \?CCL22
SET 'DESTINATION,SMALLER-HANGAR
PRINTI "ea"
JUMP ?CND20
?CCL22: SET 'DESTINATION,DIRIGIBLE-HANGAR
PRINTI "we"
?CND20: PUTP GONDOLA,P?REGION,STR?939
GETP GONDOLA,P?MAP-LOC
PUT STACK,0,FALSE-VALUE
FSET DIRIGIBLE,NDESCBIT
MOVE DIRIGIBLE,GONDOLA
PRINTR "stward."
.FUNCT GONDOLA-EXIT-F,RARG
GRTR? DIRIGIBLE-COUNTER,0 \?CCL3
ZERO? RARG \FALSE
CALL2 JIGS-UP,STR?940
RSTACK
?CCL3: LOC DIRIGIBLE
RSTACK
.FUNCT I-DIRIGIBLE,TBL
EQUAL? HERE,GONDOLA \?CND1
ICALL1 RETURN-FROM-MAP
PRINTI " "
?CND1: EQUAL? DIRIGIBLE-COUNTER,5 \?CCL5
GETP GONDOLA,P?MAP-LOC >TBL
EQUAL? DESTINATION,SMALLER-HANGAR \?CCL8
PUT TBL,0,FENSHIRE-MAP-NUM
PUT TBL,1,GONDOLA-AT-FENSHIRE-LOC
PUT TBL,2,MAP-GEN-X-2
PUTP GONDOLA,P?REGION,STR?249
JUMP ?CND6
?CCL8: PUT TBL,0,MAIN-MAP-NUM
PUT TBL,1,GONDOLA-AT-FLATHEADIA-LOC
PUT TBL,2,MAP-GEN-X-1
PUTP GONDOLA,P?REGION,STR?250
?CND6: MOVE DIRIGIBLE,DESTINATION
FCLEAR DIRIGIBLE,NDESCBIT
ICALL2 DEQUEUE,I-DIRIGIBLE
SET 'DIRIGIBLE-COUNTER,0
ZERO? BORDER-ON /?CND9
EQUAL? HERE,GONDOLA \?CND9
GETB 0,30
EQUAL? STACK,DEC-20 /?CND9
ICALL1 CLEAR-BORDER
SET 'CURRENT-BORDER,CASTLE-BORDER
SCREEN S-FULL
ICALL2 INIT-STATUS-LINE,TRUE-VALUE
SCREEN S-TEXT
?CND9: EQUAL? HERE,GONDOLA \?CCL16
PRINTR "The dirigible descends into a hangar and comes to a stop."
?CCL16: EQUAL? HERE,DESTINATION \FALSE
ICALL1 RETURN-FROM-MAP
PRINTR " A dirigible descends into the hangar."
?CCL5: EQUAL? HERE,GONDOLA /?CCL20
INC 'DIRIGIBLE-COUNTER
RFALSE
?CCL20: ICALL1 RETURN-FROM-MAP
PRINTI "The dirigible continues to glide along. "
EQUAL? DESTINATION,DIRIGIBLE-HANGAR \?CCL23
SUB 4,DIRIGIBLE-COUNTER
GET DIRIGIBLE-TRIP-DESCS,STACK
PRINT STACK
JUMP ?CND21
?CCL23: SUB DIRIGIBLE-COUNTER,1
GET DIRIGIBLE-TRIP-DESCS,STACK
PRINT STACK
?CND21: INC 'DIRIGIBLE-COUNTER
CRLF
RTRUE
.FUNCT SMALLER-HANGAR-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? SMALLER-HANGAR,TOUCHBIT /FALSE
CALL QUEUE,I-FOX,-1
RSTACK
.FUNCT DESERTED-CASTLE-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? DESERTED-CASTLE,TOUCHBIT /FALSE
CALL QUEUE,I-ROOSTER,-1
RSTACK
.FUNCT RUINED-HALL-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "The entrance hall of the summer castle retains but a shadow of its former elegance; the ceiling has partially collapsed, and myriad weeds grow amongst the debris that covers the floor. A fireplace is choked with the rubble of its collapsed chimney. Above the fireplace is a faded fresco, and next to that, a tiny vase is mounted on the wall. Arched openings lead "
ZERO? ARCHWAY-OPEN /?CND4
PRINTI "north, "
?CND4: PRINTI "south and west. "
ZERO? ARCHWAY-OPEN \?CND6
PRINTI "The archway to the north"
IN? HEXAGONAL-BLOCK,LOCAL-GLOBALS /?CCL10
SET 'ARCHWAY-OPEN,TRUE-VALUE
PRINTI ", which had earlier crumbled, seems restored to its former condition: decayed but passable! "
JUMP ?CND6
?CCL10: PRINTI " has crumbled to rubble. "
?CND6: ZERO? SECRET-ROOM-REVEALED /?CND11
PRINTI "In addition, a dusty passage leads east. "
?CND11: PRINTI "A stairway once led upwards, but there's little left of it."
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
ZERO? ARCHWAY-OPEN \FALSE
IN? HEXAGONAL-BLOCK,LOCAL-GLOBALS /FALSE
SET 'ARCHWAY-OPEN,TRUE-VALUE
RETURN ARCHWAY-OPEN
.FUNCT FIREPLACE-F
EQUAL? PRSA,V?ENTER \?CCL3
CALL2 DO-FIRST,STR?949
RSTACK
?CCL3: EQUAL? PRSA,V?CLEAN \?CCL5
PRINTR "Not a chance (unless you're actually a team of thirty people, in disguise)."
?CCL5: EQUAL? PRSA,V?LOOK-INSIDE \FALSE
PRINTR "Rubble. Lots of rubble."
.FUNCT FRESCO-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "The fresco depicts the death of Duncanthrax. His spirit is ascending to heaven on a tremendous ladder, surrounded by a host of angels."
.FUNCT VASE-F
EQUAL? PRSA,V?OPEN,V?CLOSE \?CCL3
PRINT HUH
RTRUE
?CCL3: EQUAL? PRSA,V?TAKE \?CCL5
EQUAL? PRSO,VASE \?CCL5
PRINTR "The vase is affixed to the wall."
?CCL5: EQUAL? PRSA,V?PUT \FALSE
EQUAL? PRSO,FLOWER \FALSE
ZERO? SECRET-ROOM-REVEALED \FALSE
SET 'SECRET-ROOM-REVEALED,TRUE-VALUE
SET 'COMPASS-CHANGED,TRUE-VALUE
MOVE FLOWER,VASE
PRINTI "The flower seems to grow fuller, its colors richer. You hear a noise, and turn to see a passageway opening to the east!"
CRLF
CALL2 INC-SCORE,16
RSTACK
.SEGMENT "0"
.FUNCT LADDER-F,VARG
ZERO? VARG \FALSE
EQUAL? PRSA,V?EXAMINE,V?CLOSE,V?OPEN \?CCL5
PRINTR "The stepladder seems to be stuck in the open position."
?CCL5: EQUAL? PRSA,V?PUT-UNDER \?CCL7
EQUAL? PRSO,MEGABOZ-TRAP-DOOR \?CCL7
PRINTR "The ladder is now standing beneath the trap door."
?CCL7: EQUAL? PRSA,V?CLIMB-ON,V?CLIMB,V?STAND-ON \FALSE
ICALL PERFORM,V?ENTER,LADDER
RTRUE
.ENDSEG
.SEGMENT "FENSHIRE"
.FUNCT MARSH-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "The swamps of Fenshire have encroached on this once-beautiful garden. The garden wall is now just a pile of mossy stones, and the garden terraces are ankle-deep with squishy mud. A c"
ZERO? ARCHWAY-OPEN /?CCL6
PRINTI "rumbling archway leads"
JUMP ?CND4
?CCL6: PRINTI "ollapsed archway blocks the exit to the"
?CND4: PRINTI " south. To the north"
ZERO? STEPPING-STONES-VISIBLE /?CCL9
PRINTI ", stepping stones lead across a field of quicksand."
RTRUE
?CCL9: PRINTI " is a wide expanse of fetid quicksand."
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
IN? JESTER,HERE \?CCL14
CALL2 VISIBLE?,ROOSTER
ZERO? STACK /?CCL14
FSET? ROOSTER,ANIMATEDBIT \?CCL14
CALL2 VISIBLE?,FOX
ZERO? STACK /?CCL14
FSET? FOX,ANIMATEDBIT \?CCL14
CALL2 VISIBLE?,WORM
ZERO? STACK /?CCL14
FSET? WORM,ANIMATEDBIT \?CCL14
MOVE JESTER,NICE-LUNCH-SPOT
MOVE COOKPOT,NICE-LUNCH-SPOT
MOVE COOKFIRE,NICE-LUNCH-SPOT
SET 'ARCHWAY-OPEN,FALSE-VALUE
SET 'STEPPING-STONES-VISIBLE,TRUE-VALUE
SET 'COMPASS-CHANGED,TRUE-VALUE
FSET RUINED-HALL,REDESCBIT
ICALL1 RETURN-FROM-MAP
PRINTR " The jester looks delighted. ""Sacre bleu! At last! All zee ingredients for Borphbelly Stew! But zee ambience here eesn't quite right."" He picks up his cookpot AND his cookfire, and dashes across the quicksand to the north, using a series of stepping stones which you'd swear weren't there a minute ago. This flurry of activity seems to have been too much for the archway behind you; it crumbles into a pile of rubble, blocking the exit to the south.
The jester, out of sight amongst the reeds to the north, shouts, ""Yoo hoo! I've found a lovely spot for lunch! Bring over zee ingredients!"""
?CCL14: IN? JESTER,HERE /FALSE
IN? HEXAGONAL-BLOCK,LOCAL-GLOBALS \FALSE
ZERO? ARCHWAY-OPEN /FALSE
ICALL2 DEQUEUE,I-JESTER
ICALL2 THIS-IS-IT,JESTER
MOVE JESTER,HERE
MOVE COOKPOT,HERE
MOVE COOKFIRE,HERE
PRINTI " A string of eloquent cursing in a foreign tongue assaults you, and you spy the jester "
PRINT COOK-DESC
PRINTR " He is stirring a cookpot which sits upon a roaring cookfire. ""Impossible!"" he shrieks, switching to a more familiar language. ""Eet is impossible to cook a Borphbelly Stew weethout zee proper ingredients! Impossible, impossible, impossible!"""
.FUNCT STEPPING-STONES-F,RARG
ZERO? STEPPING-STONES-VISIBLE \?CCL3
ZERO? RARG \FALSE
PRINTI "You'd be sucked into the quicksand!"
CRLF
RFALSE
?CCL3: CALL2 CCOUNT,PROTAGONIST
GRTR? STACK,1 \?CCL7
ZERO? RARG \FALSE
PRINTI "It's difficult to balance on the stepping stones with all you're carrying. You try, but after almost falling into the quicksand, you give up."
CRLF
RFALSE
?CCL7: EQUAL? HERE,MARSH \?CCL11
RETURN NICE-LUNCH-SPOT
?CCL11: RETURN MARSH
.FUNCT NICE-LUNCH-SPOT-F,RARG
EQUAL? RARG,M-END \FALSE
CALL2 VISIBLE?,ROOSTER
ZERO? STACK /FALSE
FSET? ROOSTER,ANIMATEDBIT \FALSE
CALL2 VISIBLE?,FOX
ZERO? STACK /FALSE
FSET? FOX,ANIMATEDBIT \FALSE
CALL2 VISIBLE?,WORM
ZERO? STACK /FALSE
FSET? WORM,ANIMATEDBIT \FALSE
MOVE HEXAGONAL-BLOCK,SMALLER-HANGAR
FSET SMALLER-HANGAR,REDESCBIT
FSET RUINED-HALL,REDESCBIT
REMOVE WORM
REMOVE FOX
REMOVE ROOSTER
REMOVE COOKPOT
REMOVE COOKFIRE
ICALL2 DEQUEUE,I-FOX
ICALL2 DEQUEUE,I-ROOSTER
ICALL1 RETURN-FROM-MAP
PRINTI " The jester says, ""Excellent! Zee ingredients for Borphbelly Stew and a "
ICALL2 DPRINT,HERE
PRINTI " to enjoy eet!"" He tosses the animals into the cookpot, and begins dishing out two generous portions of stew. Before you can eat it, a tremendous weariness comes over you. The last thing you hear is the jester saying, ""Waiter? Check, please!""
You awake from a deep sleep and struggle to your feet. As your head clears you realize that you're not where you were when you fell asleep"
PRINT ELLIPSIS
ICALL2 GOTO,SMALLER-HANGAR
CALL2 INC-SCORE,9
RSTACK
.SEGMENT "0"
.FUNCT HEXAGONAL-BLOCK-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "It's just a small rock which has been neatly carved into the shape of an elongated hexagon."
.ENDSEG
.SEGMENT "FENSHIRE"
.FUNCT HOTHOUSE-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? FAN,TRYTAKEBIT \FALSE
CALL QUEUE,I-SN,1
RSTACK
.FUNCT I-SN,?TMP3,?TMP2,?TMP1
EQUAL? HERE,HOTHOUSE \FALSE
ZERO? ALLIGATOR /?CND1
ICALL QUEUE,I-SN,1
RFALSE
?CND1: ICALL1 RETURN-FROM-MAP
ICALL1 UPDATE-STATUS-LINE
PRINTI " The jester steps out from behind some tropical vines, fanning himself with a dainty paper fan. ""Hot enough for you? I know just the thing to take your mind off this heat! It's one of my favorite games, Snarfem.
""The rules: I'll produce four piles of pebbles. Each of us, starting with you, will remove as many pebbles as we feel like -- as long as they come from the same pile. You must take at least one pebble each turn. The player who takes the last pebble wins. It's that simple!"""
CRLF
CRLF
ICALL2 HIT-ANY-KEY,STR?955
ICALL SPLIT-BY-PICTURE,SN-SPLIT,TRUE-VALUE
ICALL2 ADJUST-TEXT-WINDOW,SN-BOTTOM
?PRG5: RANDOM 9
PUT PILE-TABLE,1,STACK
?PRG7: RANDOM 9
PUT PILE-TABLE,2,STACK
GET PILE-TABLE,2 >?TMP1
GET PILE-TABLE,1
EQUAL? ?TMP1,STACK \?PRG14
GET PILE-TABLE,2
ADD STACK,1
PUT PILE-TABLE,2,STACK
GET PILE-TABLE,2
EQUAL? STACK,10 \?PRG7
PUT PILE-TABLE,2,1
JUMP ?PRG7
?PRG14: RANDOM 9
PUT PILE-TABLE,3,STACK
GET PILE-TABLE,3 >?TMP2
GET PILE-TABLE,2 >?TMP1
GET PILE-TABLE,1
EQUAL? ?TMP2,?TMP1,STACK \?PRG21
GET PILE-TABLE,3
ADD STACK,1
PUT PILE-TABLE,3,STACK
GET PILE-TABLE,3
EQUAL? STACK,10 \?PRG14
PUT PILE-TABLE,3,1
JUMP ?PRG14
?PRG21: RANDOM 9
PUT PILE-TABLE,4,STACK
GET PILE-TABLE,4 >?TMP3
GET PILE-TABLE,3 >?TMP2
GET PILE-TABLE,2 >?TMP1
GET PILE-TABLE,1
EQUAL? ?TMP3,?TMP2,?TMP1,STACK \?REP22
GET PILE-TABLE,4
ADD STACK,1
PUT PILE-TABLE,4,STACK
GET PILE-TABLE,4
EQUAL? STACK,10 \?PRG21
PUT PILE-TABLE,4,1
JUMP ?PRG21
?REP22: CALL2 SAFE-NUMBER?,PILE-TABLE
ZERO? STACK \?PRG5
ICALL1 SETUP-SN
CRLF
ICALL1 SNARFEM
ICALL2 INIT-SL-WITH-SPLIT,TEXT-WINDOW-PIC-LOC
FSET? FAN,TRYTAKEBIT \?CCL32
PRINTI "The jester claps you on the back and says, ""He who wins and runs away, returns to let you win another day!"""
CALL1 J-EXITS
RSTACK
?CCL32: MOVE FAN,HERE
ICALL1 REMOVE-J
PRINTI """You're undoubtedly not a flash in the pan; you've turned me into your biggest fan!"" The jester is suddenly wearing a cap and sweater bearing your initials, and waving a pennant with your name on it. Still chanting a cheer, he vanishes, and you notice a delicate paper fan lying at your feet."
CRLF
CALL2 INC-SCORE,12
RSTACK
.FUNCT SETUP-SN
SCREEN S-FULL
DISPLAY SN-BORDER,1,1
SCREEN S-WINDOW
PICSET SN-PICSET-TBL
ICALL2 DRAW-PILE,1
ICALL2 DRAW-PILE,2
ICALL2 DRAW-PILE,3
ICALL2 DRAW-PILE,4
CALL1 DRAW-FLOWERS
RSTACK
.FUNCT DRAW-SN-BOXES,PILE,X,Y,SPACE,CNT,TBL
SET 'CNT,1
SCREEN S-WINDOW
ICALL2 PICINF-PLUS-ONE,BOX-1-LOC
GET PICINF-TBL,0 >Y
GET PICINF-TBL,1 >X
PICINF SN-BOX-SPACE,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,1 >SPACE
?PRG2: ZERO? PILE \?CCL6
GRTR? CNT,4 \?CCL9
SET 'TBL,DIM-BOX-TBL
JUMP ?CND4
?CCL9: GET PILE-TABLE,CNT
ZERO? STACK \?CCL11
SET 'TBL,DIM-BOX-TBL
JUMP ?CND4
?CCL11: SET 'TBL,BOX-TBL
JUMP ?CND4
?CCL6: GET PILE-TABLE,PILE
GRTR? CNT,STACK \?CCL13
SET 'TBL,DIM-BOX-TBL
JUMP ?CND4
?CCL13: SET 'TBL,BOX-TBL
?CND4: GET TBL,CNT
DISPLAY STACK,Y,X
EQUAL? CNT,9 /?REP3
ADD X,SPACE >X
INC 'CNT
JUMP ?PRG2
?REP3: SCREEN S-TEXT
RTRUE
.FUNCT DRAW-PILE,PILE,NUM,PIC,?TMP1
SCREEN S-WINDOW
GET PILE-TABLE,PILE >NUM
EQUAL? PILE,1 \?CCL3
PUSH PILE-1-PIC-LOC
JUMP ?CND1
?CCL3: EQUAL? PILE,2 \?CCL5
PUSH PILE-2-PIC-LOC
JUMP ?CND1
?CCL5: EQUAL? PILE,3 \?CCL7
PUSH PILE-3-PIC-LOC
JUMP ?CND1
?CCL7: PUSH PILE-4-PIC-LOC
?CND1: ICALL2 PICINF-PLUS-ONE,STACK
ZERO? NUM \?CCL10
SET 'PIC,PILE-OF-0
JUMP ?CND8
?CCL10: EQUAL? NUM,1 \?CCL12
SET 'PIC,PILE-OF-1
JUMP ?CND8
?CCL12: EQUAL? NUM,2 \?CCL14
SET 'PIC,PILE-OF-2
JUMP ?CND8
?CCL14: EQUAL? NUM,3 \?CCL16
SET 'PIC,PILE-OF-3
JUMP ?CND8
?CCL16: EQUAL? NUM,4 \?CCL18
SET 'PIC,PILE-OF-4
JUMP ?CND8
?CCL18: EQUAL? NUM,5 \?CCL20
SET 'PIC,PILE-OF-5
JUMP ?CND8
?CCL20: EQUAL? NUM,6 \?CCL22
SET 'PIC,PILE-OF-6
JUMP ?CND8
?CCL22: EQUAL? NUM,7 \?CCL24
SET 'PIC,PILE-OF-7
JUMP ?CND8
?CCL24: EQUAL? NUM,8 \?CCL26
SET 'PIC,PILE-OF-8
JUMP ?CND8
?CCL26: SET 'PIC,PILE-OF-9
?CND8: GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY PIC,?TMP1,STACK
SCREEN S-TEXT
RTRUE
.FUNCT DRAW-FLOWERS,PILE,NUM,LEFT,RIGHT,?TMP1,?TMP2,?TMP3,?TMP4
SET 'PILE,1
SET 'NUM,1
CALL2 SAFE-NUMBER?,PILE-TABLE
ZERO? STACK /?PRG4
SET 'LEFT,L-FLOWERS-0
SET 'RIGHT,R-FLOWERS-0
JUMP ?CND1
?PRG4: ADD TEMP-TABLE,2
COPYT PILE-TABLE+2,STACK,8
GET PILE-TABLE,PILE
ZERO? STACK \?CCL8
INC 'PILE
JUMP ?PRG4
?CCL8: GET PILE-TABLE,1 >?TMP4
GET PILE-TABLE,2
ADD ?TMP4,STACK >?TMP3
GET PILE-TABLE,3
ADD ?TMP3,STACK >?TMP2
GET PILE-TABLE,4
ADD ?TMP2,STACK >?TMP1
GET PILE-TABLE,PILE
EQUAL? ?TMP1,STACK \?CCL10
GET PILE-TABLE,PILE >NUM
?REP5: EQUAL? PILE,1 \?CCL18
SET 'LEFT,L-FLOWERS-1
JUMP ?CND16
?CCL10: GET TEMP-TABLE,PILE
SUB STACK,NUM
PUT TEMP-TABLE,PILE,STACK
CALL2 SAFE-NUMBER?,TEMP-TABLE
ZERO? STACK \?REP5
GET PILE-TABLE,PILE
SUB STACK,NUM
ZERO? STACK \?CCL15
SET 'NUM,1
INC 'PILE
JUMP ?PRG4
?CCL15: INC 'NUM
JUMP ?PRG4
?CCL18: EQUAL? PILE,2 \?CCL20
SET 'LEFT,L-FLOWERS-2
JUMP ?CND16
?CCL20: EQUAL? PILE,3 \?CCL22
SET 'LEFT,L-FLOWERS-3
JUMP ?CND16
?CCL22: EQUAL? PILE,4 /?CCL24
SET 'LEFT,0
JUMP ?CND16
?CCL24: SET 'LEFT,L-FLOWERS-4
?CND16: EQUAL? NUM,1 \?CCL27
SET 'RIGHT,R-FLOWERS-1
JUMP ?CND1
?CCL27: EQUAL? NUM,2 \?CCL29
SET 'RIGHT,R-FLOWERS-2
JUMP ?CND1
?CCL29: EQUAL? NUM,3 \?CCL31
SET 'RIGHT,R-FLOWERS-3
JUMP ?CND1
?CCL31: EQUAL? NUM,4 \?CCL33
SET 'RIGHT,R-FLOWERS-4
JUMP ?CND1
?CCL33: EQUAL? NUM,5 \?CCL35
SET 'RIGHT,R-FLOWERS-5
JUMP ?CND1
?CCL35: EQUAL? NUM,6 \?CCL37
SET 'RIGHT,R-FLOWERS-6
JUMP ?CND1
?CCL37: EQUAL? NUM,7 \?CCL39
SET 'RIGHT,R-FLOWERS-7
JUMP ?CND1
?CCL39: EQUAL? NUM,8 \?CCL41
SET 'RIGHT,R-FLOWERS-8
JUMP ?CND1
?CCL41: EQUAL? NUM,9 /?CCL43
SET 'RIGHT,0
JUMP ?CND1
?CCL43: SET 'RIGHT,R-FLOWERS-9
?CND1: SCREEN S-WINDOW
ICALL2 PICINF-PLUS-ONE,L-FLOWERS-PIC-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY LEFT,?TMP1,STACK
ICALL2 PICINF-PLUS-ONE,R-FLOWERS-PIC-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY RIGHT,?TMP1,STACK
SCREEN S-TEXT
RTRUE
.FUNCT SNARFEM,X,NUM,PILE,STOP-SN
?PRG1: ZERO? STOP-SN \TRUE
ZERO? PILE /?CCL7
CLEAR S-TEXT
ZERO? ACTIVE-MOUSE /?CND8
ICALL2 DRAW-SN-BOXES,PILE
?CND8: PRINTI "Type a number "
ZERO? ACTIVE-MOUSE /?CND10
PRINTI "(or click on one of the numbered boxes with your mouse) "
?CND10: PRINTI "to indicate how many pebbles you want to remove from Pile #"
PRINTN PILE
PRINTC 46
?PRG12: INPUT 'X >X
ICALL1 MOUSE-INPUT?
EQUAL? X,CLICK1,CLICK2 \?CCL16
CALL2 SN-CLICK,TRUE-VALUE >X
JUMP ?CND14
?CCL16: GRTR? X,144 \?CCL18
LESS? X,155 \?CCL18
SUB X,145 >X
JUMP ?CND14
?CCL18: SUB X,48 >X
?CND14: GRTR? X,9 /?CTR22
LESS? X,1 \?CCL23
?CTR22: CLEAR S-TEXT
PRINT TYPE-A-NUMBER
PRINTC 57
ZERO? ACTIVE-MOUSE /?CND26
PRINTI " (or click on one of the numbered boxes with your mouse)"
?CND26: PRINTC 46
JUMP ?PRG12
?CCL23: GRTR? X,NUM \?CCL29
CLEAR S-TEXT
PRINTI "There "
EQUAL? NUM,1 \?CCL32
PRINTI "is"
JUMP ?CND30
?CCL32: PRINTI "are"
?CND30: PRINTI " only "
PRINTN NUM
PRINTI " pebble"
EQUAL? NUM,1 /?CND33
PRINTC 115
?CND33: PRINTI " in Pile #"
PRINTN PILE
PRINTC 46
JUMP ?PRG12
?CCL29: CLEAR S-TEXT
PRINTI "You remove "
PRINTN X
PRINTI " pebble"
EQUAL? X,1 /?CND35
PRINTC 115
?CND35: PRINTI " from Pile #"
PRINTN PILE
PRINTC 46
ICALL COUNTDOWN-PILE,PILE,NUM,X
ICALL1 DRAW-FLOWERS
SET 'PILE,FALSE-VALUE
CALL1 END-SN?
ZERO? STACK /?CCL39
SET 'STOP-SN,TRUE-VALUE
FCLEAR FAN,TRYTAKEBIT
CRLF
CRLF
ICALL1 HIT-ANY-KEY
JUMP ?PRG1
?CCL39: CRLF
PRINTI " "
ICALL1 J-MOVE
CALL1 END-SN?
ZERO? STACK /?CCL42
SET 'STOP-SN,TRUE-VALUE
CRLF
CRLF
ICALL1 HIT-ANY-KEY
JUMP ?PRG1
?CCL42: CRLF
PRINTI " "
JUMP ?PRG1
?CCL7: ZERO? ACTIVE-MOUSE /?CND43
ICALL1 DRAW-SN-BOXES
?CND43: PRINTI "Type a number "
ZERO? ACTIVE-MOUSE /?CND45
PRINTI "(or click on one of the numbered boxes with your mouse) "
?CND45: PRINTI "to select the pile from which you'd like to remove a pebble or pebbles."
?PRG47: INPUT 'X >X
ICALL1 MOUSE-INPUT?
EQUAL? X,CLICK1,CLICK2 \?CCL51
CALL1 SN-CLICK >X
JUMP ?CND49
?CCL51: GRTR? X,144 \?CCL53
LESS? X,155 \?CCL53
SUB X,145 >X
JUMP ?CND49
?CCL53: SUB X,48 >X
?CND49: GRTR? X,4 /?CTR57
LESS? X,1 \?CCL58
?CTR57: CLEAR S-TEXT
PRINT TYPE-A-NUMBER
PRINTC 52
ZERO? ACTIVE-MOUSE /?CND61
PRINTI " (or click on one of the numbered boxes with your mouse)"
?CND61: PRINTC 46
JUMP ?PRG47
?CCL58: GET PILE-TABLE,X
ZERO? STACK \?CCL64
CLEAR S-TEXT
PRINTI "There are no longer any pebbles in Pile #"
PRINTN X
PRINTC 46
JUMP ?PRG47
?CCL64: SET 'PILE,X
GET PILE-TABLE,PILE >NUM
JUMP ?PRG1
.FUNCT SN-CLICK,ALREADY-PICKED-PILE,TL-X,TL-Y,BR-X,BR-Y,BOX-WIDTH,BOX-HEIGHT,CNT,HIT-SPOT
SET 'CNT,1
PICINF BOX-1,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,1 >BOX-WIDTH
GET PICINF-TBL,0 >BOX-HEIGHT
ICALL2 PICINF-PLUS-ONE,BOX-1-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-Y,BOX-HEIGHT >BR-Y
PICINF SN-BOX-SPACE,PICINF-TBL /?PRG3
?PRG3: ADD TL-X,BOX-WIDTH >BR-X
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CCL7
SET 'HIT-SPOT,TRUE-VALUE
?REP4: ZERO? HIT-SPOT /?CCL12
RETURN CNT
?CCL7: EQUAL? CNT,9 /?REP4
INC 'CNT
GET PICINF-TBL,1
ADD TL-X,STACK >TL-X
JUMP ?PRG3
?CCL12: ZERO? ALREADY-PICKED-PILE \FALSE
ICALL2 PICINF-PLUS-ONE,PILE-OF-1
GET PICINF-TBL,1 >BOX-WIDTH
GET PICINF-TBL,0 >BOX-HEIGHT
ICALL2 PICINF-PLUS-ONE,PILE-1-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND14
SET 'CNT,1
SET 'HIT-SPOT,TRUE-VALUE
?CND14: ZERO? HIT-SPOT \?CND16
ICALL2 PICINF-PLUS-ONE,PILE-2-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND16
SET 'CNT,2
SET 'HIT-SPOT,TRUE-VALUE
?CND16: ZERO? HIT-SPOT \?CND20
ICALL2 PICINF-PLUS-ONE,PILE-3-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND20
SET 'CNT,3
SET 'HIT-SPOT,TRUE-VALUE
?CND20: ZERO? HIT-SPOT \?CND24
ICALL2 PICINF-PLUS-ONE,PILE-4-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND24
SET 'CNT,4
SET 'HIT-SPOT,TRUE-VALUE
?CND24: ZERO? HIT-SPOT /FALSE
RETURN CNT
.FUNCT COUNTDOWN-PILE,PILE,NUM,X
?PRG1: GET PILE-TABLE,PILE
SUB STACK,1
PUT PILE-TABLE,PILE,STACK
ICALL2 DRAW-PILE,PILE
DEC 'X
ZERO? X \?PRG1
RTRUE
.FUNCT SAFE-NUMBER?,TBL,X,?TMP1,?TMP2,?TMP3
GET TBL,1
GET BINARY-TABLE,STACK >?TMP3
GET TBL,2
GET BINARY-TABLE,STACK
ADD ?TMP3,STACK >?TMP2
GET TBL,3
GET BINARY-TABLE,STACK
ADD ?TMP2,STACK >?TMP1
GET TBL,4
GET BINARY-TABLE,STACK
ADD ?TMP1,STACK >X
MOD X,2
ZERO? STACK \FALSE
DIV X,10
MOD STACK,2
ZERO? STACK \FALSE
DIV X,100
MOD STACK,2
ZERO? STACK \FALSE
DIV X,1000
MOD STACK,2
ZERO? STACK /TRUE
RFALSE
.FUNCT J-MOVE,PILE,NUM,?TMP1,?TMP2,?TMP3,?TMP4
SET 'PILE,1
SET 'NUM,1
PRINTI "The jester peruses the piles, considering his move."
CRLF
CRLF
ICALL1 HIT-ANY-KEY
CLEAR S-TEXT
CALL2 SAFE-NUMBER?,PILE-TABLE
ZERO? STACK /?PRG12
?PRG4: RANDOM 4 >PILE
GET PILE-TABLE,PILE
ZERO? STACK \?REP5
EQUAL? PILE,4 \?CCL11
SET 'PILE,0
JUMP ?PRG4
?CCL11: INC 'PILE
JUMP ?PRG4
?REP5: GET PILE-TABLE,PILE
RANDOM STACK >NUM
JUMP ?CND1
?PRG12: COPYT PILE-TABLE+2,TEMP-TABLE+2,8
GET PILE-TABLE,PILE
ZERO? STACK \?CCL16
INC 'PILE
JUMP ?PRG12
?CCL16: GET PILE-TABLE,1 >?TMP4
GET PILE-TABLE,2
ADD ?TMP4,STACK >?TMP3
GET PILE-TABLE,3
ADD ?TMP3,STACK >?TMP2
GET PILE-TABLE,4
ADD ?TMP2,STACK >?TMP1
GET PILE-TABLE,PILE
EQUAL? ?TMP1,STACK \?CCL18
GET PILE-TABLE,PILE >NUM
?CND1: PRINTI "The jester removes "
PRINTN NUM
PRINTI " pebble"
EQUAL? NUM,1 /?CND24
PRINTC 115
?CND24: PRINTI " from Pile #"
PRINTN PILE
PRINTC 46
GET PILE-TABLE,PILE
ICALL COUNTDOWN-PILE,PILE,STACK,NUM
CALL1 DRAW-FLOWERS
RSTACK
?CCL18: GET TEMP-TABLE,PILE
SUB STACK,NUM
PUT TEMP-TABLE,PILE,STACK
CALL2 SAFE-NUMBER?,TEMP-TABLE
ZERO? STACK \?CND1
GET PILE-TABLE,PILE
SUB STACK,NUM
ZERO? STACK \?CCL23
SET 'NUM,1
INC 'PILE
JUMP ?PRG12
?CCL23: INC 'NUM
JUMP ?PRG12
.FUNCT END-SN?
GET PILE-TABLE,1
ZERO? STACK \FALSE
GET PILE-TABLE,2
ZERO? STACK \FALSE
GET PILE-TABLE,3
ZERO? STACK \FALSE
GET PILE-TABLE,4
ZERO? STACK /TRUE
RFALSE
.FUNCT FAN-F
EQUAL? PRSA,V?POINT \FALSE
EQUAL? P-PRSA-WORD,W?WAVE \FALSE
PRINTR "You produce a light breeze."
.ENDSEG
.ENDI

1122
fenshire.zil Normal file
View File

File diff suppressed because it is too large Load Diff

499
find.zap Normal file
View File

@ -0,0 +1,499 @@
.SEGMENT "0"
.FUNCT FIND-DESCENDANTS,PARENT,FLAGS,F,FOBJ
SET 'F,FINDER
EQUAL? PARENT,GLOBAL-HERE \?CND1
SET 'PARENT,HERE
?CND1: FIRST? PARENT >FOBJ \TRUE
?PRG6: CALL2 VISIBLE?,FOBJ
ZERO? STACK /?CND8
BTST FLAGS,8 /?CND10
BTST FLAGS,1 \?PRF16
PUSH 1
JUMP ?PEN14
?PRF16: PUSH 0
?PEN14: CALL MATCH-OBJECT,FOBJ,F,STACK
ZERO? STACK /FALSE
?CND10: BTST FLAGS,4 \?CND8
FIRST? FOBJ \?CND8
EQUAL? FOBJ,WINNER /?CND8
FSET? FOBJ,SEARCHBIT \?PRD24
FSET? FOBJ,OPENBIT /?CCL18
FSET? FOBJ,TRANSBIT /?CCL18
?PRD24: FSET? FOBJ,SURFACEBIT \?CND8
?CCL18: BTST FLAGS,1 \?CCL33
PUSH 5
JUMP ?CND31
?CCL33: PUSH 4
?CND31: CALL FIND-DESCENDANTS,FOBJ,STACK
ZERO? STACK /FALSE
?CND8: NEXT? FOBJ >FOBJ /?PRG6
RTRUE
.FUNCT EXCLUDED?,FOBJ,F,EXC,PHRASE,CT,VEC,VV
GET F,8 >EXC
ZERO? EXC /FALSE
GET EXC,3 >PHRASE
GET PHRASE,1 >CT
ADD PHRASE,6 >VEC
?PRG6: DLESS? 'CT,0 \?CND8
SET 'VV,FALSE-VALUE
JUMP ?REP7
?CND8: GET VEC,0
EQUAL? FOBJ,STACK \?CND10
SET 'VV,TRUE-VALUE
?REP7: ZERO? VV \TRUE
GET EXC,1 >EXC
ZERO? EXC /FALSE
GET EXC,3 >PHRASE
GET PHRASE,1 >CT
ADD PHRASE,6 >VEC
JUMP ?PRG6
?CND10: ADD VEC,4 >VEC
JUMP ?PRG6
.FUNCT MATCH-OBJECT,FOBJ,F,INCLUDE?,NOUN,ADJS,APP,TB,RES,?TMP1
GET F,9 >RES
FSET? FOBJ,INVISIBLE /TRUE
GET F,6 >NOUN
EQUAL? NOUN,FALSE-VALUE,W?ONE /?PRD6
GETPT FOBJ,P?SYNONYM >TB
ZERO? TB /TRUE
PTSIZE TB
DIV STACK,2
INTBL? NOUN,TB,STACK \TRUE
?PRD6: GET F,7 >ADJS
ZERO? ADJS /?PRD11
CALL CHECK-ADJS,FOBJ,F,ADJS
ZERO? STACK /TRUE
?PRD11: GET F,5 >ADJS
ZERO? ADJS /?PRD14
CALL CHECK-ADJS,FOBJ,F,ADJS
ZERO? STACK /TRUE
?PRD14: CALL EXCLUDED?,FOBJ,F
ZERO? STACK \TRUE
GET F,1
BTST STACK,1 /?CTR2
CALL2 INVALID-OBJECT?,FOBJ
ZERO? STACK \TRUE
?CTR2: ZERO? INCLUDE? /TRUE
GET F,5 >ADJS
ZERO? ADJS /?CCL24
GET ADJS,4 >?TMP1
GETPT FOBJ,P?ADJECTIVE
PTSIZE STACK
DIV STACK,2
EQUAL? ?TMP1,STACK \?CCL24
PUT RES,1,1
PUT RES,2,FALSE-VALUE
PUT RES,4,FOBJ
EQUAL? FOBJ,HERE \FALSE
PUT RES,4,GLOBAL-HERE
RFALSE
?CCL24: GET F,0 >APP
ZERO? APP /?CCL31
GET F,1
BTST STACK,1 /?CCL31
GET RES,1
ZERO? STACK /?CTR35
GET F,2
ZERO? STACK /?CCL36
?CTR35: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL36: CALL TEST-OBJECT,FOBJ,APP,F
ZERO? STACK /FALSE
GET RES,1
EQUAL? STACK,1 \?CCL43
GET RES,4
CALL TEST-OBJECT,STACK,APP,F
ZERO? STACK \?CCL46
PUT RES,4,FOBJ
EQUAL? FOBJ,HERE \TRUE
PUT RES,4,GLOBAL-HERE
RTRUE
?CCL46: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL43: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL31: ZERO? APP \?CCL50
GET F,1
BTST STACK,1 \?CTR52
GET F,2
ZERO? STACK /TRUE
?CTR52: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL50: CALL TEST-OBJECT,FOBJ,APP,F
ZERO? STACK /TRUE
CALL ADD-OBJECT,FOBJ,F
RSTACK
.FUNCT TEST-OBJECT,FOBJ,APP,F,N,NN,?TMP1
BAND APP,65280
ZERO? STACK \?CCL3
BTST APP,128 \?CCL6
BAND APP,63
FSET? FOBJ,STACK /FALSE
RTRUE
?CCL6: FSET? FOBJ,APP /TRUE
RFALSE
?CCL3: GET APP,1
BTST STACK,256 \?CND12
GET APP,1
BAND STACK,63
GETP FOBJ,STACK >?TMP1
GET APP,2
EQUAL? ?TMP1,STACK /TRUE
RFALSE
?CND12: GET APP,0 >N
?PRG17: GET APP,N >NN
BTST NN,128 \?CCL21
BAND NN,63
FSET? FOBJ,STACK /?CND19
RTRUE
?CCL21: FSET? FOBJ,NN /TRUE
?CND19: DLESS? 'N,1 \?PRG17
RFALSE
.FUNCT ADD-OBJECT,OBJ,F,VEC,NC,DOIT?,SYN,WHICH,?TMP1
GET F,9 >VEC
SET 'DOIT?,TRUE-VALUE
GET F,3 >SYN
GET F,4 >WHICH
EQUAL? OBJ,HERE \?CND1
SET 'OBJ,GLOBAL-HERE
?CND1: GET F,2
ZERO? STACK \?CND3
ZERO? SYN /?CND3
GET VEC,1
EQUAL? 1,STACK \?CND3
CALL MULTIPLE-EXCEPTION?,OBJ,SYN,WHICH,F
ZERO? STACK /?CCL10
SET 'DOIT?,FALSE-VALUE
JUMP ?CND3
?CCL10: GET VEC,4
CALL MULTIPLE-EXCEPTION?,STACK,SYN,WHICH,F
ZERO? STACK /?CND3
PUT VEC,4,OBJ
SET 'DOIT?,FALSE-VALUE
?CND3: ZERO? DOIT? /TRUE
GET F,2
ZERO? STACK /?PRD17
GET F,3
ZERO? STACK /?PRD17
GET F,3 >?TMP1
GET F,4
CALL MULTIPLE-EXCEPTION?,OBJ,?TMP1,STACK,F
ZERO? STACK \TRUE
?PRD17: CALL NOT-IN-FIND-RES?,OBJ,VEC >WHICH
ZERO? WHICH /TRUE
GET VEC,1
ADD 1,STACK
PUT VEC,1,STACK
PUT WHICH,0,OBJ
GET F,2
EQUAL? STACK,NP-QUANT-A /FALSE
RTRUE
.FUNCT NOT-IN-FIND-RES?,OBJ,VEC,NO-CHANGE?,CT,SZ,ANS,NVEC,NEW-OBJECT
GET VEC,1 >CT
GET VEC,0 >SZ
?PRG1: ADD VEC,8 >ANS
LESS? CT,1 \?CCL5
RETURN ANS
?CCL5: GRTR? CT,SZ \?CCL7
SUB CT,SZ >CT
JUMP ?CND3
?CCL7: SET 'SZ,CT
?CND3: INTBL? OBJ,ANS,SZ /FALSE
GET VEC,2 >NVEC
ZERO? NVEC /?CCL12
SET 'VEC,NVEC
SET 'SZ,FIND-RES-MAXOBJ
JUMP ?PRG1
?CCL12: LESS? SZ,FIND-RES-MAXOBJ \?CCL14
MUL 2,SZ
ADD ANS,STACK
RSTACK
?CCL14: ZERO? NO-CHANGE? \TRUE
SET 'SZ,FIND-RES-MAXOBJ
CALL DO-PMEM-ALLOC,7,9 >NEW-OBJECT
SET 'NVEC,NEW-OBJECT
PUT VEC,2,NVEC
ADD NVEC,8
RSTACK
.FUNCT EVERYWHERE-VERB?,WHICH,SYNTAX,SYN
ASSIGNED? 'WHICH /?CND1
GET FINDER,4 >WHICH
?CND1: ASSIGNED? 'SYNTAX /?CND3
GET PARSE-RESULT,3 >SYNTAX
?CND3: EQUAL? WHICH,1 \?CCL7
GETB SYNTAX,5 >SYN
JUMP ?CND5
?CCL7: GETB SYNTAX,9 >SYN
?CND5: BTST SYN,128 \FALSE
BTST SYN,64 \TRUE
RFALSE
.FUNCT MULTIPLE-EXCEPTION?,OBJ,SYNTAX,WHICH,F,L,VB
LOC OBJ >L
GET SYNTAX,0 >VB
EQUAL? OBJ,FALSE-VALUE,ROOMS \?CCL3
INC 'P-NOT-HERE
RTRUE
?CCL3: CALL EVERYWHERE-VERB?,WHICH,SYNTAX
ZERO? STACK \?CCL5
CALL2 ACCESSIBLE?,OBJ
ZERO? STACK /TRUE
?CCL5: EQUAL? VB,V?TAKE \?CCL9
GET F,6
ZERO? STACK \?CCL9
EQUAL? WHICH,1 \?CCL9
FSET? OBJ,TAKEBIT /?CCL15
FSET? OBJ,TRYTAKEBIT \TRUE
?CCL15: EQUAL? L,WINNER /TRUE
RFALSE
?CCL9: EQUAL? VB,V?DROP \FALSE
IN? OBJ,WINNER \TRUE
RFALSE
.FUNCT CHECK-ADJS,OBJ,F,ADJS,CNT,TMP,OWNER,ID,VEC,CT,ADJ,FL,OADJS,NUM,?TMP1
GETP OBJ,P?OWNER >OWNER
GETB ADJS,1
EQUAL? STACK,2 /?CCL2
GET ADJS,2 >TMP
ZERO? TMP /?CND1
?CCL2: SET 'ID,OWNER
LESS? 0,ID \?CCL7
SET 'ID,OWNER
GRTR? ID,LAST-OBJECT /?CCL7
EQUAL? OWNER,TMP,OBJ /?CND1
EQUAL? OWNER,ROOMS \?CCL14
GET OWNER-SR-HERE,4 >ID
JUMP ?CND1
?CCL14: GET OWNER-SR-THERE,1 >TMP
ZERO? TMP /FALSE
INTBL? OWNER,OWNER-SR-THERE+8,TMP /?CND1
RFALSE
?CCL7: ZERO? OWNER /?CCL19
GET OWNER-SR-HERE,1 >CNT
ZERO? CNT \?CCL22
SET 'ID,PLAYER
JUMP ?CND1
?CCL22: ADD OWNER,2 >TMP
SET 'VEC,OWNER-SR-HERE+8
?PRG24: DLESS? 'CNT,0 /FALSE
GET VEC,0 >?TMP1
GET OWNER,0
INTBL? ?TMP1,TMP,STACK >ID \?CCL30
GET ID,0 >ID
JUMP ?CND1
?CCL30: ADD VEC,2 >VEC
JUMP ?PRG24
?CCL19: LESS? 0,TMP \?CCL32
GRTR? TMP,LAST-OBJECT /?CCL32
CALL HELD?,OBJ,TMP
ZERO? STACK \?CND1
RFALSE
?CCL32: GET OWNER-SR-HERE,1 >TMP
ZERO? TMP /FALSE
LOC OBJ
INTBL? STACK,OWNER-SR-HERE+8,TMP >ID \FALSE
?CND1: EQUAL? ID,0,OBJ /?CND41
GET F,9
PUT STACK,3,ID
?CND41: GETB ADJS,1
EQUAL? STACK,2 /TRUE
ADD ADJS,10 >VEC
GET ADJS,4 >CT
GETPT OBJ,P?ADJECTIVE >OADJS
PTSIZE OADJS
DIV STACK,2 >NUM
?PRG45: DLESS? 'CT,0 /TRUE
GET VEC,CT >ADJ
SET 'ID,ADJ
EQUAL? ADJ,W?NO.WORD /?PRG45
INTBL? ID,OADJS,NUM /?PRG45
EQUAL? ID,W?CLOSED,W?SHUT \?CCL54
FSET? OBJ,OPENBIT \?PRG45
?CCL54: EQUAL? ID,W?OPEN \FALSE
FSET? OBJ,OPENBIT /?PRG45
RFALSE
.FUNCT FIND-OBJECTS,SEARCH,PARENT,GLBS,CONT?,N,RES,NEW-OBJECT,LOSING?,FLAG,?PR-FLAG,O,OBJ
ASSIGNED? 'SEARCH /?CND1
GET FINDER,4
EQUAL? 1,STACK \?CCL5
GET PARSE-RESULT,3
GETB STACK,5 >SEARCH
JUMP ?CND1
?CCL5: GET PARSE-RESULT,3
GETB STACK,9 >SEARCH
?CND1: SET 'CONT?,TRUE-VALUE
GET FINDER,9 >RES
PUT RES,1,0
PUT RES,2,FALSE-VALUE
ZERO? PARENT /?CCL8
CALL FIND-DESCENDANTS,PARENT,7
ZERO? STACK /?CND6
GET RES,1
ZERO? STACK \?CND6
?CCL8: ZERO? PARENT /?CND13
GET FINDER,5 >GLBS
ZERO? GLBS \?CND15
CALL DO-PMEM-ALLOC,1,8 >NEW-OBJECT
SET 'GLBS,NEW-OBJECT
PUT FINDER,5,GLBS
?CND15: GET GLBS,2
ZERO? STACK \?CND13
PUT GLBS,2,PARENT
?CND13: BTST SEARCH,128 \?CND19
BTST SEARCH,64 /?CND19
FIRST? GENERIC-OBJECTS \?CND19
FIRST? GENERIC-OBJECTS >NEW-OBJECT /?PRG25
?PRG25: CALL MATCH-OBJECT,NEW-OBJECT,FINDER,TRUE-VALUE
ZERO? STACK /?REP26
NEXT? NEW-OBJECT >NEW-OBJECT /?PRG25
?REP26: GET RES,1 >CONT?
ZERO? CONT? /?CND19
EQUAL? CONT?,1 /TRUE
RFALSE
?CND19: SET 'LOSING?,FALSE-VALUE
?PRG35: ZERO? LOSING? \?PRD40
BAND SEARCH,12
ZERO? STACK \?CCL38
?PRD40: ZERO? LOSING? /?CND37
?CCL38: ZERO? LOSING? \?CTR44
BTST SEARCH,8 \?CCL45
?CTR44: SET '?PR-FLAG,6
JUMP ?CND43
?CCL45: SET '?PR-FLAG,2
?CND43: ZERO? LOSING? \?CTR49
BAND SEARCH,12
ZERO? STACK /?CCL50
?CTR49: BOR 1,?PR-FLAG >FLAG
JUMP ?CND48
?CCL50: BAND ?PR-FLAG,-2 >FLAG
?CND48: ZERO? LOSING? \?CCL55
BTST SEARCH,4 /?CCL55
BOR 8,FLAG
JUMP ?CND53
?CCL55: BAND FLAG,-9
?CND53: CALL FIND-DESCENDANTS,WINNER,STACK >CONT?
?CND37: ZERO? LOSING? \?CCL59
BAND SEARCH,3
ZERO? STACK /?CND58
?CCL59: ZERO? LOSING? \?CTR63
BAND SEARCH,3
ZERO? STACK /?CCL64
?CTR63: SET '?PR-FLAG,3
JUMP ?CND62
?CCL64: SET '?PR-FLAG,2
?CND62: ZERO? LOSING? \?CTR69
BTST SEARCH,2 \?CCL70
?CTR69: BOR 4,?PR-FLAG >FLAG
JUMP ?CND68
?CCL70: BAND ?PR-FLAG,-5 >FLAG
?CND68: ZERO? LOSING? \?CCL75
BTST SEARCH,1 /?CCL75
BOR 8,FLAG
JUMP ?CND73
?CCL75: BAND FLAG,-9
?CND73: CALL FIND-DESCENDANTS,HERE,STACK >CONT?
?CND58: GET RES,1
ZERO? STACK \?CND6
BTST SEARCH,15 /?CND78
ZERO? LOSING? \?CND78
GET TLEXV,0 >GLBS
ZERO? GLBS /?CCL86
GETB GLBS,8
BTST STACK,128 /?CCL93
GETB GLBS,8
JUMP ?CND91
?CCL93: GETB GLBS,8
BAND STACK,127
SHIFT STACK,7
?CND91: ZERO? STACK \?CTR85
GET GLBS,3
ZERO? STACK /?CCL86
?CTR85: SET 'LOSING?,TRUE-VALUE
JUMP ?PRG35
?CCL86: BTST SEARCH,64 \?CND78
BTST SEARCH,128 \FALSE
?CND78: GETPT HERE,P?GLOBAL >GLBS
ZERO? GLBS /?CND97
PTSIZE GLBS
DIV STACK,2 >N
?PRG100: DLESS? 'N,0 /?CND97
GET GLBS,N >O
CALL MATCH-OBJECT,O,FINDER,TRUE-VALUE >CONT?
ZERO? CONT? /?CND97
FIRST? O \?PRG100
CALL SEARCH-IN-LG?,O
ZERO? STACK /?PRG100
BTST SEARCH,2 \?PRG100
CALL FIND-DESCENDANTS,O,FD-INCLUDE? >CONT?
ZERO? CONT? \?PRG100
?CND97: ZERO? CONT? /?CND114
CALL1 EXCLUDE-HERE-OBJECT?
ZERO? STACK \?CND114
CALL MATCH-OBJECT,HERE,FINDER,TRUE-VALUE >CONT?
?CND114: ZERO? CONT? /?CND118
GETP HERE,P?THINGS
ZERO? STACK /?CND118
CALL TEST-THINGS,HERE,FINDER >CONT?
?CND118: GET RES,1
ZERO? STACK /?CND122
SET 'CONT?,FALSE-VALUE
?CND122: ZERO? CONT? /?CND124
BTST SEARCH,2 \?CCL128
PUSH 5
JUMP ?CND126
?CCL128: PUSH 1
?CND126: CALL FIND-DESCENDANTS,GLOBAL-OBJECTS,STACK >CONT?
?CND124: ZERO? CONT? /?CND129
GET RES,1
ZERO? STACK \?CND129
GETP HERE,P?ADJACENT >GLBS
ZERO? GLBS /?CND129
GETB GLBS,0 >N
BAND SEARCH,-193 >O
?PRG134: GETB GLBS,N
ZERO? STACK /?CCL138
DEC 'N
GETB GLBS,N
ICALL FIND-OBJECTS,O,STACK
JUMP ?CND136
?CCL138: DEC 'N
?CND136: DLESS? 'N,1 \?PRG134
GET RES,1
ZERO? STACK /?CND129
SET 'CONT?,FALSE-VALUE
?CND129: ZERO? CONT? /?CND6
GET RES,1
ZERO? STACK \?CND6
CALL MOBY-FIND?,SEARCH
ZERO? STACK /?CND6
SET 'OBJ,1
?PRG148: FSET? OBJ,INVISIBLE /?CND150
CALL MATCH-OBJECT,OBJ,FINDER,TRUE-VALUE
ZERO? STACK /?CND6
?CND150: IGRTR? 'OBJ,LAST-OBJECT \?PRG148
?CND6: GET RES,1
EQUAL? STACK,1 /TRUE
RFALSE
.ENDSEG
.ENDI

555
find.zil Normal file
View File

@ -0,0 +1,555 @@
"FIND file for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<ZZSECTION "FIND">
<INCLUDE "BASEDEFS" "PDEFS" "PBITDEFS">
<USE "NEWSTRUC" "PARSER" "PMEM">
<FILE-FLAGS MDL-ZIL? CLEAN-STACK? ;ZAP-TO-SOURCE-DIRECTORY?>
<BEGIN-SEGMENT 0>
<PUT-DECL BOOLEAN '<OR ATOM FALSE>>
<DEFMAC FD-FLAG (WHICH 'VAL "OPT" 'NEW)
<COND (<ASSIGNED? NEW>
<COND (<OR <TYPE? .NEW ATOM FALSE>
<AND <TYPE? .NEW FORM>
<EMPTY? .NEW>>>
<COND (<TYPE? .NEW ATOM>
;"Just turning flag on"
<FORM ORB ,.WHICH .VAL>)
(T
<FORM ANDB .VAL <XORB ,.WHICH -1>>)>)
(<TYPE? .VAL FIX LVAL GVAL>
<FORM COND
(.NEW
<FORM ORB .VAL ,.WHICH>)
(T
<FORM ANDB .VAL <XORB ,.WHICH -1>>)>)
(T
<FORM BIND ((FLAG .VAL))
<FORM COND
(.NEW
<FORM ORB ,.WHICH '.FLAG>)
(T
<FORM ANDB '.FLAG <XORB ,.WHICH -1>>)>>)>)
(T
<FORM NOT <FORM 0? <FORM ANDB .VAL ,.WHICH>>>)>>
<MSETG FIND-FLAGS-GWIM 1>
<DEFMAC FIND-GWIM? ('F)
<FORM NOT <FORM 0? <FORM ANDB <FORM FIND-FLAGS .F> ,FIND-FLAGS-GWIM>>>>
<CONSTANT FINDER <MAKE-FINDER>>
<GLOBAL P-NOT-HERE:NUMBER ;BYTE 0>
"FIND-DESCENDANTS, MATCH-OBJECT, and ADD-OBJECT all return false when the
search should be stopped prematurely because some object was an exact
match. If there's a big red book and a big ugly red book, BIG RED BOOK
will get the former, since it's the only way to do so."
<DEFINE FIND-DESCENDANTS FD
(PARENT:OBJECT FLAGS:FIX ;"INCLUDE, SEARCH, NEST, NOTOP"
"AUX" (F ,FINDER) FOBJ:<OR FALSE OBJECT>)
<COND (<EQUAL? .PARENT ,GLOBAL-HERE>
<SET PARENT ,HERE>)>
<COND (<SET FOBJ <FIRST? .PARENT>>
;"This guy contains something"
<REPEAT ()
;"See if the current object matches: if so, add it to the list"
<COND
(<VISIBLE? .FOBJ>
<COND (<AND <NOT <FD-FLAG FD-NOTOP? .FLAGS> ;<BTST .FLAGS 8>>
<NOT <MATCH-OBJECT .FOBJ .F
<FD-FLAG FD-INCLUDE? .FLAGS>
;<BTST .FLAGS 1>>>>
<RETURN <> .FD>)>
<COND (<AND <FD-FLAG FD-NEST? .FLAGS> ;<BTST .FLAGS 4>
<FIRST? .FOBJ>
<N==? .FOBJ ,WINNER>
<OR ;,P-MOBY-FLAG
<AND <FSET? .FOBJ ,SEARCHBIT>
<OR <FSET? .FOBJ ,OPENBIT>
<FSET? .FOBJ ,TRANSBIT>>>
<FSET? .FOBJ ,SURFACEBIT>>>
;"Check its contents"
<COND (<NOT <FIND-DESCENDANTS .FOBJ
<FD-FLAG FD-INCLUDE? ,FD-NEST?
<FD-FLAG FD-INCLUDE? .FLAGS>>
;<COND (<BTST .FLAGS 1> 5) (T 4)>>>
<RETURN <> .FD>)>)>)>
;"Check next sibling"
<COND (<NOT <SET FOBJ <NEXT? .FOBJ>>>
<RETURN T .FD>)>>)
(T)>>
<DEFINE EXCLUDED? EX (FOBJ:OBJECT F:FINDER
"AUX" (EXC:<OR FALSE PMEM> <FIND-EXCEPTIONS .F>))
<COND (.EXC
<REPEAT ((PHRASE:PMEM <NPP-NOUN-PHRASE .EXC>)
(CT:FIX <NOUN-PHRASE-COUNT .PHRASE>)
(VEC <REST-TO-SLOT .PHRASE NOUN-PHRASE-OBJ1>) VV)
<REPEAT ()
<COND (<L? <SET CT <- .CT 1>> 0>
<SET VV <>>
<RETURN>)>
<COND (<==? .FOBJ <ZGET .VEC 0>>
<SET VV T>
<RETURN>)>
<SET VEC <ZREST .VEC 4 ;2>>>
<COND (.VV
<RETURN T .EX>)
(<SET EXC <NPP-NEXT .EXC>>
<SET PHRASE <NPP-NOUN-PHRASE .EXC>>
<SET CT <NOUN-PHRASE-COUNT .PHRASE>>
<SET VEC <REST-TO-SLOT .PHRASE NOUN-PHRASE-OBJ1>>)
(T
<RETURN <> .EX>)>>)>>
<DEFINE MATCH-OBJECT (FOBJ:OBJECT F:FINDER INCLUDE?:BOOLEAN
"AUX" NOUN ADJS APP TB (RES <FIND-RES .F>))
<COND (<AND <NOT <FSET? .FOBJ ,INVISIBLE>>
<OR <EQUAL? <SET NOUN <FIND-NOUN .F>> <> ,W?ONE>
<AND <SET TB <GETPT .FOBJ ,P?SYNONYM>>
<ZMEMQ .NOUN .TB </ <PTSIZE .TB>:FIX 2>>>>
<OR <NOT <SET ADJS <FIND-OF .F>>>
<CHECK-ADJS .FOBJ .F .ADJS>>
<OR <NOT <SET ADJS <FIND-ADJS .F>>>
<CHECK-ADJS .FOBJ .F .ADJS>>
<NOT <EXCLUDED? .FOBJ .F>>
<OR <FIND-GWIM? .F>
<NOT <INVALID-OBJECT? .FOBJ>>>>
;"This object matches the words used..."
<COND (<NOT .INCLUDE?> ;"location didn't match the syntax bits"
T)
(<AND <T? <SET ADJS <FIND-ADJS .F>>>
<EQUAL? <ADJS-COUNT .ADJS>
<COND (T ;<CHECK-EXTENDED?>
</ <PTSIZE <GETPT .FOBJ ,P?ADJECTIVE>> 2>)
;(T <- <PTSIZE <GETPT .FOBJ ,P?ADJECTIVE>> 1>)>>>
;"the only way to do so."
<FIND-RES-COUNT .RES 1>
<FIND-RES-NEXT .RES <>>
<FIND-RES-OBJ1 .RES .FOBJ>
<COND (<EQUAL? .FOBJ ,HERE>
<FIND-RES-OBJ1 .RES ,GLOBAL-HERE>)>
<>)
(<AND <T? <SET APP <FIND-APPLIC .F>>>
<NOT <FIND-GWIM? .F>>>
;"We're not GWIMming, so apply the test only if there's an
ambiguity"
<COND (<OR <0? <FIND-RES-COUNT .RES>>
<FIND-QUANT .F>>
;"Don't have anything yet"
<ADD-OBJECT .FOBJ .F>)
(<TEST-OBJECT .FOBJ .APP .F>
;"We already have something, so first find out if
this one's OK"
<COND (<1? <FIND-RES-COUNT .RES>>
;"There's only one other object"
<COND (<NOT <TEST-OBJECT
<FIND-RES-OBJ1 .RES>
.APP .F>>
;"The other object doesn't match, so just
replace it"
<FIND-RES-OBJ1 .RES .FOBJ>
<COND (<EQUAL? .FOBJ ,HERE>
<FIND-RES-OBJ1 .RES ,GLOBAL-HERE>)>
T)
(T
;"The other object also matches, so
we're stuck"
<ADD-OBJECT .FOBJ .F>)>)
(T
;"We already have more than one object, so
we're losing"
<ADD-OBJECT .FOBJ .F>)>)>)
(<F? .APP>
<COND (<OR <NOT <FIND-GWIM? .F>>
<FIND-QUANT .F>> ;"DETERMINE-OBJ w/ PICK"
<ADD-OBJECT .FOBJ .F>)
(T)>)
(<TEST-OBJECT .FOBJ .APP .F>
<ADD-OBJECT .FOBJ .F>)
(T)>)
(T)>>
<MSETG SYN-FIND-PROP *400*> ;"If set, look for this property"
<DEFINE TEST-OBJECT TO (FOBJ:OBJECT APP:<OR FIX TABLE> F:FINDER)
<COND (<NOT <TABLE? .APP>>
<COND (<NOT <0? <ANDB .APP ,SYN-FIND-NEGATE>>>
<NOT <FSET? .FOBJ <ANDB .APP *77*>>>)
(T
<FSET? .FOBJ .APP>)>)
(T
<COND (<NOT <0? <ANDB <ZGET .APP 1> ,SYN-FIND-PROP>>>
<COND (<EQUAL? <GETP .FOBJ <ANDB <ZGET .APP 1> *77*>>
<ZGET .APP 2>>
<RETURN T .TO>)
(T <RETURN <> .TO>)>)>
<REPEAT ((N:FIX <ZGET .APP 0>) NN)
<SET NN <ZGET .APP .N>>
<COND (<NOT <0? <ANDB .NN ,SYN-FIND-NEGATE>>>
<COND (<NOT <FSET? .FOBJ <ANDB .NN *77*>>>
<RETURN T .TO>)>)
(<FSET? .FOBJ .NN>
<RETURN T .TO>)>
<COND (<L? <SET N <- .N 1>> 1>
<RETURN <> .TO>)>>)>>
"Object matches all other tests. Here do checks with quantities
(all, one, etc.), then add if OK."
<DEFINE ADD-OBJECT (OBJ:OBJECT F:FINDER "AUX" (VEC <FIND-RES .F>) NC
(DOIT? T) (SYN <FIND-SYNTAX .F>) (WHICH <FIND-WHICH .F>))
<COND (<EQUAL? .OBJ ,HERE>
<SET OBJ ,GLOBAL-HERE>)> ;"per PDL 29-Apr-88"
<COND (<AND <NOT <FIND-QUANT .F>>
.SYN
<==? 1 <FIND-RES-COUNT .VEC>:FIX>>
<COND (<MULTIPLE-EXCEPTION? .OBJ .SYN .WHICH .F>
<SET DOIT? <>>)
(<MULTIPLE-EXCEPTION? <FIND-RES-OBJ1 .VEC> .SYN .WHICH .F>
<FIND-RES-OBJ1 .VEC .OBJ>
<SET DOIT? <>>)>)>
<COND (<AND .DOIT?
<OR <NOT <FIND-QUANT .F>>
<NOT <FIND-SYNTAX .F>>
<NOT <MULTIPLE-EXCEPTION? .OBJ ;"wrong theory of ALL?"
<FIND-SYNTAX .F>
<FIND-WHICH .F>
.F>>>
;"In case an object gets found twice..."
<SET WHICH <NOT-IN-FIND-RES? .OBJ .VEC>>>
<FIND-RES-COUNT .VEC ;<SET NC > <+ 1 <FIND-RES-COUNT .VEC>>>
<COND ;(<AND <IN? <SET NC <META-LOC .OBJ>> ,ROOMS>
<NOT <EQUAL? .NC <META-LOC ,WINNER>>>>
<ZPUT .WHICH 0 <- 0 .OBJ>>) ;"adjacent room"
(T
<ZPUT .WHICH 0 .OBJ>)>
;<COND (<L=? .NC <FIND-RES-SIZE .VEC>>
<ZPUT <REST-TO-SLOT .VEC FIND-RES-OBJ1>
<- .NC 1>
.OBJ>)>
<N==? <FIND-QUANT .F> ,NP-QUANT-A>)
(T)>>
<DEFINE NOT-IN-FIND-RES? ACT (OBJ VEC "OPT" (NO-CHANGE? <>))
<REPEAT ((CT <FIND-RES-COUNT .VEC>)
(SZ <FIND-RES-SIZE .VEC>) ANS NVEC)
<SET ANS <REST-TO-SLOT .VEC FIND-RES-OBJ1>>
<COND (<L? .CT 1>
<RETURN .ANS .ACT>)
(<G? .CT .SZ>
<SET CT <- .CT .SZ>>)
(T <SET SZ .CT>)>
<COND (<INTBL? .OBJ .ANS .SZ>
<RETURN <> .ACT>)
(<T? <SET NVEC <FIND-RES-NEXT .VEC>>>
<SET VEC .NVEC>
<SET SZ ,FIND-RES-MAXOBJ ;<OBJLIST-SIZE .VEC>>)
(<L? .SZ ,FIND-RES-MAXOBJ ;<FIND-RES-SIZE .VEC>>
<RETURN <ZREST .ANS <* 2 .SZ>> .ACT>)
(<T? .NO-CHANGE?>
<RETURN T .ACT>)
(T
<SET SZ ,FIND-RES-MAXOBJ ;<FIND-RES-SIZE .VEC>>
<SET NVEC <PMEM-ALLOC OBJLIST
;"SIZE .SZ"
LENGTH <- ,FIND-RES-LENGTH 1>>>
<FIND-RES-NEXT .VEC .NVEC>
<RETURN <REST-TO-SLOT .NVEC FIND-RES-OBJ1> .ACT>)>>>
"EVERYWHERE-VERB? -- separately defined so game can call it"
<DEFINE EVERYWHERE-VERB? ("OPT" (WHICH <FIND-WHICH ,FINDER>)
(SYNTAX <PARSE-SYNTAX ,PARSE-RESULT>)
"AUX" SYN)
<COND (<==? .WHICH 1>
<SET SYN <SYNTAX-SEARCH .SYNTAX 1>>)
(T
<SET SYN <SYNTAX-SEARCH .SYNTAX 2>>)>
<COND (<AND <ANDB ,SEARCH-MOBY .SYN>
<NOT <ANDB ,SEARCH-MUST-HAVE .SYN>>>
T)>>
"MULTIPLE-EXCEPTION? -- return true if an object found by ALL should not
be include when the crunch comes."
<DEFINE MULTIPLE-EXCEPTION? (OBJ:OBJECT SYNTAX:VERB-SYNTAX WHICH:FIX F:FINDER
"AUX" (L <LOC .OBJ>) (VB <SYNTAX-ID .SYNTAX>))
<COND (<EQUAL? .OBJ <> ,ROOMS ;,NOT-HERE-OBJECT>
<SETG P-NOT-HERE <+ 1 ,P-NOT-HERE>>
T)
(<AND <0? <EVERYWHERE-VERB? .WHICH .SYNTAX>>
<NOT <ACCESSIBLE? .OBJ>>>
T)
(<AND <==? .VB ,V?TAKE>
<ZERO? <FIND-NOUN .F>>
<1? .WHICH>>
<COND (<AND <NOT <FSET? .OBJ ,TAKEBIT>>
<NOT <FSET? .OBJ ,TRYTAKEBIT>>>
T)
(<EQUAL? .L ,WINNER>
;<AND <NOT <EQUAL? .L ,WINNER <LOC ,WINNER> ,HERE>>
<NOT <FSET? .L ,SURFACEBIT>>
<NOT <FSET? .L ,SEARCHBIT>>>
T)>)
(<==? .VB ,V?DROP>
<COND (<NOT <IN? .OBJ ,WINNER>>
T)>)
;(<AND ,PRSI
<==? ,PRSO ,PRSI>>
;"VERB ALL and prso = prsi"
<RTRUE>)
;(<AND <==? .VB ,V?PUT>
<NOT <IN? .OBJ ,WINNER>>
<HELD? ,PRSO ,PRSI>>
;"PUT ALL IN X and object already in x"
<RTRUE>)>>
<ADD-WORD OPEN ADJ>
<ADD-WORD CLOSED ADJ>
<ADD-WORD SHUT ADJ>
<DEFINE CHECK-ADJS CA (OBJ:OBJECT F ADJS:PMEM
"AUX" CNT (TMP <>) OWNER (ID <>) VEC)
<SET OWNER <GETP .OBJ ,P?OWNER>>
<COND (<OR <PMEM-TYPE? .ADJS NP> ;"it's NP-OF"
<SET TMP <ADJS-POSS .ADJS>>>
<COND (<OBJECT? <SET ID .OWNER>>
<COND (<EQUAL? .OWNER .TMP .OBJ>
T)
(<EQUAL? .OWNER ,ROOMS ;"any">
<SET ID <FIND-RES-OBJ1 ,OWNER-SR-HERE>> ;"real owner")
(<ZERO? <SET TMP <FIND-RES-COUNT ,OWNER-SR-THERE>>>
<RETURN <> .CA>)
(<NOT <INTBL? .OWNER
<REST-TO-SLOT ,OWNER-SR-THERE FIND-RES-OBJ1>
.TMP>>
<RETURN <> .CA>)>)
(<T? .OWNER> ;"table for multiple owners (body parts)"
;<SET ID <>>
<COND (<AND ;<ZERO? .ID>
<ZERO? <SET CNT <FIND-RES-COUNT ,OWNER-SR-HERE>>>
;<SET ID <INTBL? ,PLAYER .TMP <ZGET .OWNER 0>>>>
<SET ID ,PLAYER> ;"default owner of body part"
;<SET ID <ZGET .ID 0>>)
(T
<SET TMP <ZREST .OWNER 2>>
<SET VEC <REST-TO-SLOT ,OWNER-SR-HERE FIND-RES-OBJ1>>
<REPEAT ()
<COND (<DLESS? CNT 0>
<RETURN <> .CA>)
(<SET ID
<INTBL? <ZGET .VEC 0> .TMP <ZGET .OWNER 0>>>
<SET ID <ZGET .ID 0>>
<RETURN>)
(T <SET VEC <ZREST .VEC 2>>)>>)>)
(<OBJECT? .TMP> ;"possession"
<COND (<NOT <HELD? .OBJ .TMP>>
<RETURN <> .CA>)>)
(T ;"possession"
<COND (<ZERO? <SET TMP <FIND-RES-COUNT ,OWNER-SR-HERE>>>
<RETURN <> .CA>)
(<NOT <SET ID <INTBL? <LOC .OBJ>
<REST-TO-SLOT ,OWNER-SR-HERE FIND-RES-OBJ1>
.TMP>>>
<RETURN <> .CA>)
;(T <SET ID <ZGET .ID 0>>)>)>)>
<COND (<NOT <EQUAL? .ID 0 .OBJ>> ;<T? .ID>
<FIND-RES-OWNER <FIND-RES .F> .ID>)>
<COND (<NOT <PMEM-TYPE? .ADJS NP>>
<SET VEC <REST-TO-SLOT .ADJS ADJS-COUNT 1>>
<REPEAT ((CT <ADJS-COUNT .ADJS>) ADJ FL
(OADJS <GETPT .OBJ ,P?ADJECTIVE>)
(NUM </ <PTSIZE .OADJS>:FIX 2>))
<COND (<L? <SET CT <- .CT 1>> 0>
<RETURN>)>
<COND
(T ;<CHECK-EXTENDED?>
<SET ADJ <ZGET .VEC .CT>>
<SET ID .ADJ>)
;(T
<COND (<0? <SET ID <WORD-ADJ-ID <SET ADJ <ZGET .VEC .CT>>>>>
<COND (<NOT <IF-MUDDLE <COND (<GASSIGNED? SPECIAL-ADJ-CHECK>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>)>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>>>
<RETURN <> .CA>)>)>)>
<COND (<EQUAL? .ADJ ,W?NO.WORD>
<AGAIN>)
(<ZMEMQ .ID .OADJS .NUM>
;<COND (T ;<CHECK-EXTENDED?>
)
;(T <ZMEMQB .ID .OADJS <- <PTSIZE .OADJS>:FIX 1>>)>)
(<AND <EQUAL? .ID ,W?CLOSED ,W?SHUT>
<NOT <FSET? .OBJ ,OPENBIT>>>)
(<AND <EQUAL? .ID ,W?OPEN>
<FSET? .OBJ ,OPENBIT>>)
;(<VERSION? (ZIP <>)
(T
<IF-MUDDLE <AND <GASSIGNED? SPECIAL-ADJ-CHECK>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>>)>)
(T
<RETURN <> .CA>)>>)>
T>
<OBJECT GENERIC-OBJECTS
(ADJACENT 0) ;"to establish property">
<DEFINE FIND-OBJECTS ("OPT" (SEARCH:FIX
<COND (<==? 1 <FIND-WHICH ,FINDER>>
<SYNTAX-SEARCH <PARSE-SYNTAX ,PARSE-RESULT>
1>)
(T
<SYNTAX-SEARCH <PARSE-SYNTAX ,PARSE-RESULT>
2>)>)
(PARENT:<OR OBJECT FALSE> <>)
"AUX" GLBS (CONT? T) N:FIX (RES <FIND-RES ,FINDER>))
;<MAKE-FIND-RES 'FIND-RES .RES 'FIND-RES-COUNT 0>
<FIND-RES-COUNT .RES 0>
<FIND-RES-NEXT .RES <>>
;"Initialize world"
<COND (<AND .PARENT
;<NOT <IN? .PARENT ,GLOBAL-OBJECTS>>
<OR <NOT <FIND-DESCENDANTS .PARENT
<ORB ,FD-INCLUDE? ,FD-SEARCH? ,FD-NEST?>;7>>
<NOT <0? <FIND-RES-COUNT .RES>:FIX>>>>
;"In case we have `the foo in the bar' or `a picture on the wall'"
;<SET CONT? <>>
T)
(T
<COND (.PARENT
<COND (<NOT <SET GLBS <FIND-ADJS ,FINDER>>>
<FIND-ADJS ,FINDER
<SET GLBS <PMEM-ALLOC ADJS>>>)>
<COND (<NOT <ADJS-POSS .GLBS>>
<ADJS-POSS .GLBS .PARENT>)>)>
<COND (<AND <T? <ANDB .SEARCH ,SEARCH-MOBY ;128>>
<F? <ANDB .SEARCH ,SEARCH-MUST-HAVE>>
<FIRST? ,GENERIC-OBJECTS>
;<NOT <FIND-DESCENDANTS ,GENERIC-OBJECTS .SEARCH>>>
<REPEAT ((OBJ <FIRST? ,GENERIC-OBJECTS>))
<COND (<NOT <MATCH-OBJECT .OBJ ,FINDER T>>
<RETURN>)
(<NOT <SET OBJ <NEXT? .OBJ>>>
<RETURN>)>>
<COND (<NOT <0? <SET CONT? <FIND-RES-COUNT .RES>>:FIX>>
<RETURN <1? .CONT?:FIX>>)>)>
<PROG ((LOSING? <>))
<COND
(<OR <AND <NOT .LOSING?> ;"redundant?"
<NOT <0? <ANDB .SEARCH ,SEARCH-CARRIED ;12>>>>
.LOSING?>
<SET CONT?
<FIND-DESCENDANTS ,WINNER
<FD-FLAG FD-NOTOP?
<FD-FLAG FD-INCLUDE?
<FD-FLAG FD-NEST? ,FD-SEARCH?
<OR .LOSING? ;"search pockets?"
<NOT <0? <ANDB .SEARCH ,SEARCH-POCKETS ;8>>>>>
<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-CARRIED ;12>>>>>
<AND <NOT .LOSING?>
<0? <ANDB .SEARCH ,SEARCH-HELD ;4>>>>>>)>
<COND
(<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-IN-ROOM ;3>>>>
<SET CONT?
<FIND-DESCENDANTS ,HERE
<FD-FLAG FD-NOTOP?
<FD-FLAG FD-NEST?
<FD-FLAG FD-INCLUDE? ,FD-SEARCH?
<AND ;,LIT
<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-IN-ROOM ;3>>>>>>
<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-OFF-GROUND ;2>>>>>
<AND <NOT .LOSING?>
<0? <ANDB .SEARCH ,SEARCH-ON-GROUND ;1>>>>>>)>
<COND (<NOT <0? <FIND-RES-COUNT .RES>>>
<RETURN>)
(<AND <NOT <BTST .SEARCH ,SEARCH-ALL>>
<NOT .LOSING?>>
<COND (<AND <SET GLBS <LEXV-WORD ,TLEXV>>
<OR <T? <WORD-CLASSIFICATION-NUMBER .GLBS>>
<T? <WORD-SEMANTIC-STUFF .GLBS>>>>
<SET LOSING? T> ;"not a sample command"
<AGAIN>)
(<AND <BAND ,SEARCH-MUST-HAVE .SEARCH>
<NOT <BAND ,SEARCH-MOBY .SEARCH>>>
<RFALSE>)>)>
<COND (<SET GLBS <GETPT ,HERE ,P?GLOBAL>>
<COND (T ;<CHECK-EXTENDED?>
<SET N </ <PTSIZE .GLBS>:FIX 2>>)
;(T <SET N <- <PTSIZE .GLBS>:FIX 1>>)>
<REPEAT (O:OBJECT)
<COND (<L? <SET N <- .N 1>> 0>
<RETURN>)
(<NOT <SET CONT?
<MATCH-OBJECT
<COND (T ;<CHECK-EXTENDED?>
<SET O <ZGET .GLBS .N>>)
;(T <SET O <GETB .GLBS .N>>)>
,FINDER T>>>
<RETURN>)
(<AND <FIRST? .O>
<ZAPPLY ,SEARCH-IN-LG? .O>
<NOT <0? <ANDB .SEARCH ,SEARCH-OFF-GROUND>>>>
<COND
(<NOT
<SET CONT?
<FIND-DESCENDANTS .O ,FD-INCLUDE? ;1>>>
<RETURN>)>)>>)>
<COND (<AND .CONT?
<NOT <EXCLUDE-HERE-OBJECT?>>>
<SET CONT? <MATCH-OBJECT ,HERE ,FINDER T>>)>
<COND (<AND .CONT? <GETP ,HERE ,P?THINGS>>
<SET CONT? <ZAPPLY ,TEST-THINGS ,HERE ,FINDER>>)>
<COND (<NOT <0? <FIND-RES-COUNT .RES>>>
<SET CONT? <>>)>
<COND (.CONT?
<SET CONT?
<FIND-DESCENDANTS ,GLOBAL-OBJECTS
<FD-FLAG FD-NEST? ,FD-INCLUDE?
<NOT <0? <ANDB .SEARCH ,SEARCH-OFF-GROUND ;2>>>>
;<COND (<BTST .SEARCH 2> 5) (T 1)>>>)>
<COND (<AND .CONT?
<0? <FIND-RES-COUNT .RES>:FIX>
;<BTST .SEARCH ,SEARCH-ADJACENT>
<SET GLBS <GETP ,HERE ,P?ADJACENT>>>
<SET N <GETB .GLBS 0>>
;<SET LOSING? ,HERE>
<REPEAT ((SCH <ANDB .SEARCH <XORB -1 ,SEARCH-ADJACENT>>))
<COND (<T? <GETB .GLBS .N>> ;"room visible now?"
;<SETG HERE <GETB .GLBS <SET N <- .N 1>>>>
<FIND-OBJECTS .SCH <GETB .GLBS <SET N <- .N 1>>>>)
(T
<SET N <- .N 1>>)>
<COND (<L? <SET N <- .N 1>> 1>
<RETURN>)>>
;<SETG HERE .LOSING?>
<COND (<NOT <0? <FIND-RES-COUNT .RES>:FIX>>
<SET CONT? <>>)>)>
<COND
(<AND .CONT?
<0? <FIND-RES-COUNT .RES>:FIX>
<ZAPPLY ,MOBY-FIND? .SEARCH>>
<REPEAT ((OBJ 1))
<COND (<AND <NOT <FSET? .OBJ ,INVISIBLE>>
;<NOT <IN? .OBJ ,ROOMS>>>
<COND (<NOT <MATCH-OBJECT .OBJ ,FINDER T>>
<RETURN>)>)>
<COND (<G? <SET OBJ <+ .OBJ 1>> ,LAST-OBJECT>
<RETURN>)>>)>>)>
;<COND (<AND <L? 1 <FIND-RES-COUNT .RES>:FIX>
<FIND-OF ,FINDER>>
<MATCH-OF-OBJECTS .RES>)>
<1? <FIND-RES-COUNT .RES>:FIX>>
<END-SEGMENT>
<END-DEFINITIONS>

271
globals.zabstr Normal file
View File

@ -0,0 +1,271 @@
<INCLUDE "BASEDEFS" "FIND" "PDEFS">
<ADJ-SYNONYM LARGE HUGE BIG GIANT GIGANTIC TREMENDOUS MIGHTY MASSIVE ENORMOUS>
<ADJ-SYNONYM SMALL SMALLER TINY TINIER LITTLE PETITE TEENSY WEENSY>
<GLOBAL LIT T>
<GLOBAL MOVES 0>
<GLOBAL SCORE 0>
<GLOBAL HERE:OBJECT BANQUET-HALL>
<OBJECT GLOBAL-OBJECTS (DESC "it") (FLAGS INVISIBLE TOUCHBIT SURFACEBIT
TRYTAKEBIT OPENBIT SEARCHBIT TRANSBIT WEARBIT ONBIT LIGHTBIT RLANDBIT WORNBIT
INTEGRALBIT VEHBIT OUTSIDEBIT CONTBIT VOWELBIT LOCKEDBIT NDESCBIT DOORBIT
ACTORBIT PARTBIT INBIT FEMALEBIT KLUDGEBIT DROPBIT BURNBIT ORBBIT FLAMEBIT
NALLBIT KEYBIT UNDERGROUNDBIT REDESCBIT)>
<OBJECT LOCAL-GLOBALS (LOC GLOBAL-OBJECTS) (DESC "it")>
<OBJECT ROOMS (DESC "it")>
<OBJECT INTNUM (LOC GLOBAL-OBJECTS) (DESC "number") (SYNONYM NUMBER NUMBERS
INT.NUM) (ADJECTIVE INT.NUM INT.TIM) (ACTION INTNUM-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE INTNUM-F>
<END-SEGMENT>
<OBJECT IT (LOC GLOBAL-OBJECTS) (SYNONYM IT) (DESC "it") (FLAGS VOWELBIT
NARTICLEBIT TOUCHBIT)>
<OBJECT HIM (LOC GLOBAL-OBJECTS) (SYNONYM HIM HIMSELF) (DESC "him") (FLAGS
NARTICLEBIT TOUCHBIT)>
<OBJECT HER (LOC GLOBAL-OBJECTS) (SYNONYM HER HERSELF) (DESC "her") (FLAGS
NARTICLEBIT TOUCHBIT)>
<OBJECT LEFT-RIGHT (LOC GLOBAL-OBJECTS) (DESC "that way") (SYNONYM LEFT RIGHT)
(FLAGS NARTICLEBIT) (ACTION LEFT-RIGHT-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE LEFT-RIGHT-F>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT GRUE (LOC GLOBAL-OBJECTS) (SYNONYM GRUE GRUES) (ADJECTIVE LURKING
SINISTER HUNGRY SILENT) (DESC "lurking grue") (RESEARCH
"\"The grue was once a sinister, lurking presence in the dark places of the
earth. Its favorite diet was adventurers, but its insatiable appetite was
tempered by its fear of light. No grue was ever seen by the light of day,
and few ever survived its fearsome jaws to tell the tale.\"|
The encyclopedia goes on to say, \"Grues were eradicated from the face of
the world during the time of Entharion, many by his own hand and his legendary
blade Grueslayer. Although it has now been many a century since the last grue
sighting, old hags still delight in scaring children by telling them that
grues still lurk in the bottomless pits of the Empire, and will one day lurk
forth again.\"") (ACTION GRUE-F)>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE GRUE-F>
<OBJECT SAILOR (LOC GLOBAL-OBJECTS) (DESC "sailor") (SYNONYM SAILOR) (ACTION
SAILOR-F)>
<DEFINE-ROUTINE SAILOR-F>
<OBJECT GLOBAL-SLEEP (LOC GLOBAL-OBJECTS) (DESC "sleep") (SYNONYM SLEEP NAP
SNOOZE) (FLAGS NARTICLEBIT) (ACTION GLOBAL-SLEEP-F)>
<DEFINE-ROUTINE GLOBAL-SLEEP-F>
<OBJECT LULLABY (LOC GLOBAL-OBJECTS) (DESC "lullaby") (SYNONYM LULLABY LULLABYE
SONG) (ACTION LULLABY-F)>
<DEFINE-ROUTINE LULLABY-F>
<OBJECT GROUND (LOC GLOBAL-OBJECTS) (SYNONYM FLOOR GROUND SAND) (SDESC "ground"
) (ACTION GROUND-F)>
<DEFINE-ROUTINE GROUND-F>
<DEFINE-ROUTINE SET-GROUND-DESC>
<OBJECT GLOBAL-HOLE (LOC GLOBAL-OBJECTS) (DESC "hole") (SYNONYM HOLE) (ACTION
GLOBAL-HOLE-F)>
<DEFINE-ROUTINE GLOBAL-HOLE-F>
<OBJECT WALL (LOC GLOBAL-OBJECTS) (DESC "wall") (SYNONYM WALL WALLS) (ADJECTIVE
NORTH NE EAST SE SOUTH SW WEST NW REAR FAR) (FLAGS NDESCBIT TOUCHBIT) (ACTION
WALL-F)>
<DEFINE-ROUTINE WALL-F>
<DEFINE-ROUTINE PASSAGE-THERE>
<DEFINE-ROUTINE REPELLED>
<OBJECT GLOBAL-PASSAGE (LOC GLOBAL-OBJECTS) (DESC "passage") (SYNONYM PASSAGE
PASSAGEWAY TUNNEL) (ADJECTIVE GLOOMY DARK SECRET HIDDEN WIDE NARROW LOW STEEP
SLOPING DUSTY UNEVEN WINDING FORBIDDING GRAVELLY HALF-BURIED HIGHWAY POORLY-DUG
) (ACTION GLOBAL-PASSAGE-F)>
<DEFINE-ROUTINE GLOBAL-PASSAGE-F>
<OBJECT CEILING (LOC GLOBAL-OBJECTS) (FLAGS NDESCBIT TOUCHBIT) (DESC "ceiling")
(SYNONYM CEILING ROOF) (ADJECTIVE LOW HIGH) (ACTION CEILING-F)>
<DEFINE-ROUTINE CEILING-F>
<OBJECT SLIME (LOC LOCAL-GLOBALS) (DESC "slime") (SYNONYM SLIME) (ADJECTIVE
THICK BLACK) (FLAGS NARTICLEBIT) (ACTION SLIME-F)>
<DEFINE-ROUTINE SLIME-F>
<OBJECT WATER (LOC GLOBAL-OBJECTS) (DESC "water") (SYNONYM WATER WATERS GLOOP
GLOOPS) (ADJECTIVE ONE TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE INT.NUM) (FLAGS
NARTICLEBIT) (GENERIC G-VIAL-WATER-F) (OWNER <>) (ACTION WATER-F)>
<DEFINE-ROUTINE WATER-F>
<DEFINE-ROUTINE FIND-WATER>
<OBJECT SMALL-VIAL-WATER (DESC "water in the small vial") (SYNONYM WATER GLOOP
GLOOPS) (ADJECTIVE ONE TWO THREE FOUR INT.NUM) (FLAGS NARTICLEBIT) (GENERIC
G-VIAL-WATER-F) (ACTION VIAL-WATER-F)>
<OBJECT LARGE-VIAL-WATER (DESC "water in the large vial") (SYNONYM WATER GLOOP
GLOOPS) (ADJECTIVE ONE TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE INT.NUM) (FLAGS
NARTICLEBIT) (GENERIC G-VIAL-WATER-F) (ACTION VIAL-WATER-F)>
<DEFINE-ROUTINE VIAL-WATER-F>
<DEFINE-ROUTINE G-VIAL-WATER-F>
<CONSTANT BODY-PART-OWNERS <TABLE (PURE LENGTH) PROTAGONIST DIMWIT JESTER
EXECUTIONER SICKLY-WITCH PRICKLY-WITCH>>
<OBJECT HANDS (LOC GLOBAL-OBJECTS) (SYNONYM HANDS HAND PALM FINGER FINGERS) (
ADJECTIVE BARE YOUR) (DESC "hands") (OWNER BODY-PART-OWNERS) (FLAGS NDESCBIT
PLURALBIT TOUCHBIT PARTBIT) (ACTION HANDS-F)>
<DEFINE-ROUTINE HANDS-F>
<DEFINE-ROUTINE OPEN-SECRET-PASSAGE?>
<OBJECT FEET (LOC GLOBAL-OBJECTS) (SYNONYM FEET FOOT TOE TOES) (ADJECTIVE YOUR)
(DESC "feet") (OWNER BODY-PART-OWNERS) (FLAGS NDESCBIT PLURALBIT TOUCHBIT
PARTBIT) (ACTION FEET-F)>
<DEFINE-ROUTINE FEET-F>
<OBJECT HEAD (LOC GLOBAL-OBJECTS) (DESC "head") (SYNONYM HEAD) (OWNER
BODY-PART-OWNERS) (FLAGS PARTBIT)>
<OBJECT EYES (LOC GLOBAL-OBJECTS) (DESC "eyes") (SYNONYM EYE EYES) (ADJECTIVE
MY MINE ORACLE\'S AMULET\'S FIRST SECOND THIRD FOURTH ONE TWO THREE FOUR) (
OWNER BODY-PART-OWNERS) (FLAGS PLURALBIT PARTBIT) (ACTION EYES-F)>
<DEFINE-ROUTINE EYES-F>
<OBJECT NOSE (LOC GLOBAL-OBJECTS) (DESC "nose") (SYNONYM NOSE NOSTRIL) (
ADJECTIVE YOUR) (OWNER BODY-PART-OWNERS) (FLAGS PARTBIT) (ACTION NOSE-F)>
<DEFINE-ROUTINE NOSE-F>
<OBJECT MOUTH (LOC GLOBAL-OBJECTS) (DESC "mouth") (SYNONYM MOUTH) (ADJECTIVE
YOUR) (OWNER BODY-PART-OWNERS) (FLAGS PARTBIT) (ACTION MOUTH-F)>
<DEFINE-ROUTINE MOUTH-F>
<OBJECT PROTAGONIST (LOC BANQUET-HALL) (DESC "self") (SIZE 1) (FLAGS NDESCBIT
TRANSBIT SEARCHBIT)>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT ME (LOC GLOBAL-OBJECTS) (SYNONYM ME MYSELF SELF) (DESC "yourself") (
FLAGS TOUCHBIT NARTICLEBIT) (RESEARCH
"Son of a gun! There's no entry about you! This is one worthless
encyclopedia, huh? Why, you're about as famous as they come! At
least a third of the people in your village have heard of you, for
instance...") (ACTION ME-F)>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE ME-F>
<OBJECT GLOBAL-HERE (LOC GLOBAL-OBJECTS) (DESC "room") (SYNONYM ROOM PLACE
LOCATION!-PDEFS!-PACKAGE HALL AREA THERE HERE) (ACTION GLOBAL-HERE-F)>
<DEFINE-ROUTINE GLOBAL-HERE-F>
<OBJECT GLOBAL-BLDG (LOC LOCAL-GLOBALS) (DESC "building") (SYNONYM BUILDING
CLUSTER) (ADJECTIVE NEW SMALL STONE IMPRESSIVE) (ACTION GLOBAL-BLDG-F)>
<DEFINE-ROUTINE GLOBAL-BLDG-F>
<OBJECT ARCH (LOC LOCAL-GLOBALS) (DESC "arch") (SYNONYM ARCH ARCHWAY) (
ADJECTIVE STONE CRUMBLING) (FLAGS VOWELBIT) (ACTION ARCH-F)>
<DEFINE-ROUTINE ARCH-F>
<OBJECT WINDOW (LOC LOCAL-GLOBALS) (DESC "window") (SYNONYM WINDOW WINDOWS
GLASS PANE PANES) (ADJECTIVE NARROW WIDER SLITTED GLASS BROKEN WINDOW) (FLAGS
NDESCBIT) (ACTION WINDOW-F)>
<DEFINE-ROUTINE WINDOW-F>
<OBJECT LOCK-OBJECT (LOC LOCAL-GLOBALS) (DESC "lock") (SYNONYM LOCK KEYHOLE
HOLE) (ADJECTIVE LARGE BASIC COMBINATION KEY) (ACTION LOCK-OBJECT-F)>
<DEFINE-ROUTINE LOCK-OBJECT-F>
<OBJECT SIGN (LOC LOCAL-GLOBALS) (DESC "sign") (SYNONYM SIGN) (ADJECTIVE LARGE
EYE-CATCHING) (FLAGS READBIT) (ACTION SIGN-F)>
<DEFINE-ROUTINE SIGN-F>
<OBJECT STAIRS (LOC LOCAL-GLOBALS) (DESC "stair") (SYNONYM FLIGHT STAIR STAIRS
STAIRWAY STEP STEPS STAIRCASE GANGWAY) (ADJECTIVE STEEP OMINOUS DARK WIDE STONE
CIRCULAR WINDING SPIRAL COBWEBBY CRUDE FORBIDDING DECREPIT) (ACTION STAIRS-F)>
<DEFINE-ROUTINE STAIRS-F>
<OBJECT FIXED-LADDER (LOC LOCAL-GLOBALS) (DESC "ladder") (SYNONYM LADDER) (
ADJECTIVE RICKETY) (ACTION FIXED-LADDER-F)>
<DEFINE-ROUTINE FIXED-LADDER-F>
<OBJECT BONES (LOC LOCAL-GLOBALS) (OWNER BONES) (DESC "pile of old bones") (
SYNONYM BONE BONES PILE CREATURE ADVENTURER SKELETON SKELETONS) (ADJECTIVE
ADVENTURER CREATURE OLD) (FLAGS NDESCBIT) (ACTION BONES-F)>
<DEFINE-ROUTINE BONES-F>
<DEFINE-ROUTINE CLEAR-BORDER>
<DEFINE-ROUTINE ADJUST-TEXT-WINDOW>
<DEFINE-ROUTINE SPLIT-BY-PICTURE>
<DEFINE-ROUTINE INIT-SL-WITH-SPLIT>
<REPLACE-DEFINITION STATUS-LINE <ROUTINE INIT-STATUS-LINE>>
<DEFINE-ROUTINE SET-BORDER>
<DEFINE-ROUTINE PRINT-SPACES>
<CONSTANT SLINE <ITABLE NONE 41>>
<GLOBAL OLD-HERE <>>
<GLOBAL OLD-REGION <>>
<GLOBAL SL-SCORE -1>
<GLOBAL WIDTH 0>
<GLOBAL COMPASS-CHANGED T>
<CONSTANT TITLE-SCREEN-PICTURE 1>
<GLOBAL ACTIVE-MOUSE <>>
<GLOBAL CURRENT-SPLIT <>>
<DEFINE-ROUTINE UPDATE-STATUS-LINE>
<CONSTANT COMPASS-PICSET-TBL <TABLE N-HL NE-HL E-HL SE-HL S-HL SW-HL W-HL NW-HL
N-UNHL NE-UNHL E-UNHL SE-UNHL S-UNHL SW-UNHL W-UNHL NW-UNHL U-BOX D-BOX
BOX-COVER 0>>
<DEFINE-ROUTINE DRAW-COMPASS-ROSE>
<DEFINE-ROUTINE SHOW-DIRECTION?>
<DEFINE-ROUTINE COMPASS-CLICK>
<DEFINE-ROUTINE MAC-CLICK>
<CONSTANT TANGENT-VALUE 41>
<DEFINE-ROUTINE MAC-II-CLICK>
<DEFINE-ROUTINE SAY-HERE>
<DEFINE-ROUTINE CENTER-1>
<DEFINE-ROUTINE CENTER-2>
<DEFINE-ROUTINE CENTER-3>
<DEFINE-ROUTINE TOUCHING?>
<DEFINE-ROUTINE HANDLE>
<DEFINE-ROUTINE CANT-SEE>
<DEFINE-ROUTINE PRSO-PRINT>
<DEFINE-ROUTINE PRSI-PRINT>
<DEFINE-ROUTINE CANT-VERB-A-PRSO>
<DEFINE-ROUTINE TELL-HIT-HEAD>
<DEFINE-ROUTINE OPEN-CLOSED>
<DEFINE-ROUTINE CANT-REACH>
<DEFINE-ROUTINE DO-FIRST>
<DEFINE-ROUTINE NOT-IN>
<DEFINE-ROUTINE PART-OF>
<DEFINE-ROUTINE RECOGNIZE>
<DEFINE-ROUTINE PRONOUN>
<DEFINE-ROUTINE HIT-ANY-KEY>
<DEFINE-ROUTINE LOCKED-UNLOCKED>
<DEFINE-ROUTINE CANT-TURN>
<DEFINE-ROUTINE YOU-MUST-TELL-ME>
<DEFINE-ROUTINE GRUE-PIT-WARNING>
<DEFINE-ROUTINE DARK-DEATH>
<CONSTANT TOO-DARK "It's too dark to see a thing.">
<CONSTANT YNH "You're not holding">
<CONSTANT THERES-NOTHING "There's nothing ">
<CONSTANT YOU-SEE "You can see">
<CONSTANT IT-SEEMS-THAT "It seems that">
<CONSTANT YOU-CANT-SEE-ANY "[You can't see any ">
<CONSTANT YOU-CANT "You can't ">
<CONSTANT YOULL-HAVE-TO "You'll have to ">
<CONSTANT LOOK-AROUND "Look around you.|">
<CONSTANT CANT-FROM-HERE "You can't do that from here.|">
<CONSTANT HOLDING-IT "You're holding it!|">
<CONSTANT PERIOD-CR ".|">
<CONSTANT ELLIPSIS "...||">
<CONSTANT FAILED "Failed.|">
<CONSTANT OK "Okay.|">
<CONSTANT HUH "Huh?|">
<CONSTANT NOTHING-HAPPENS "Nothing happens.|">
<CONSTANT ALREADY-IS "It already is!|">
<CONSTANT NOTHING-NEW "This reveals nothing new.|">
<CONSTANT ONLY-BLACKNESS "You see only blackness.|">
<CONSTANT NO-VERB "[There was no verb in that sentence!]|">
<CONSTANT WEARING-IT "You're wearing it!|">
<CONSTANT YACHT-MOORED "; the royal yacht is moored at the dock">
<CONSTANT WHICH-WATER
"[You'll have to specify which water you mean by referring to the vial
that contains it.]|">
<CONSTANT MEGABOZ-CEILING-DESC
"In the center of the ceiling, a small trap door is visible.">
<CONSTANT CELL-WALL-DESC "Thick cobwebs obscure the rear wall.">
<CONSTANT POORLY-CONFIGURED
"You nearly make it, but the branches are just too poorly configured for
climbing.|">
<CONSTANT CANNOT-TRAVEL "\"I regret that I cannot travel that way.\"|">
<CONSTANT ANSWER-MY-RIDDLE "\"You'll have to answer my riddle first!\"|">
<CONSTANT SOME-LIGHT "You can see some light through the crack.|">
<CONSTANT TYPE-A-NUMBER "Please type a number between 1 and ">
<CONSTANT DROWN " Since you have no diving gear, and you are not amphibious, you drown
in a swift but still unpleasant fashion.">
<CONSTANT FUDGE "A faint smell of fudge hangs in the air.">
<CONSTANT TALK-TO-BROGMOID
"The brogmoid could no more hear your shouting than you could hear the
shouting of a bacterium.|">
<CONSTANT ALREADY-AT "You're already at the ">
<CONSTANT WITCH-REMOVES-J
" Immediately, the witches begin beating at the jester with brushes and
broomsticks. \"Scat, you filthy jester, scat!\" He vanishes hastily.|">
<CONSTANT BY-THAT-NAME "There's no one here by that name.|">
<CONSTANT NOTHING-IN-REACH "You reach in as far as you can, but feel nothing.|"
>
<CONSTANT WONT-BUDGE "It won't budge.|">
<CONSTANT COOK-DESC
"garbed in a white apron and wearing a puffy white chef's hat.">
<CONSTANT BOOKKEEPER-DESC
"is hunched over one of the desks, wearing suspenders, a bow tie, thick
eyeglasses, and a green visor.">
<CONSTANT ERE-YOU-PASS
"\"'Ere you pass to the west, you must first pass this test! Show me an object
which no one has ever seen before and which no one will ever see again!\"|">
<CONSTANT CARPENTERS
"Not a chance -- unless you have a team of carpenters in your pocket.|">
<CONSTANT DEEPLY-ROOTED "The spenseweed is deeply rooted.|">
<END-SEGMENT>

2131
globals.zap Normal file
View File

File diff suppressed because it is too large Load Diff

2460
globals.zil Normal file
View File

File diff suppressed because it is too large Load Diff

187
gram.zil Normal file
View File

@ -0,0 +1,187 @@
"GRAM file: imitates old parser and worth an ounce of cure.
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<USE "LALR" "PSTACK" "REDS">
<IFFLAG (IN-ZILCH
<USE "ZILCH">)
(T <USE "ZIL">)>
<INCLUDE "SYMBOLS" "BASEDEFS" "LALRDEFS">
"TERMINALS are defined in DEFS, so they'll be around for compiling
stuff. This resets everything else, so we can regenerate the grammar."
<RESET-SYMBOLS ;"!-SYMBOLS!-PACKAGE">
<ADD-WORD END.OF.INPUT END-OF-INPUT>
<ADD-WORD "." END-OF-INPUT>
<ADD-WORD "?" END-OF-INPUT>
<ADD-WORD "!" END-OF-INPUT>
<ADD-WORD "THEN" END-OF-INPUT>
<ADD-WORD ONE NOUN>
<ADD-WORD BUT PREP>
<ADD-WORD NOT PREP>
<ADD-WORD EXCEPT PREP>
<COMPILATION-FLAG-DEFAULT P-PS-COMMA <>>
<ADD-WORD AND <IFFLAG (P-PS-COMMA COMMA) (T MISCWORD)>>
;<ADD-WORD OR <IFFLAG (P-PS-COMMA COMMA) (T MISCWORD)>>
<ADD-WORD "," <IFFLAG (P-PS-COMMA COMMA) (T MISCWORD)>>
<COMPILATION-FLAG-DEFAULT P-PS-APOSTR <>>
<ADD-WORD "'" <IFFLAG (P-PS-APOSTR APOSTR) (T MISCWORD)>>
<COMPILATION-FLAG-DEFAULT P-PS-OFWORD <>>
<ADD-WORD OF <IFFLAG (P-PS-OFWORD OFWORD) (T MISCWORD ;PREP)>>
<COMPILATION-FLAG-DEFAULT P-PS-THEWORD <>>
<ADD-WORD THE <IFFLAG (P-PS-THEWORD ARTICLE) (T MISCWORD)>>
<ADD-WORD FROM PREP>
<ADD-WORD IN PREP>
<ADD-WORD ON PREP>
<IF-P-PS-ADV
<ADD-WORD ONCE ADV>
<ADD-WORD TWICE ADV>
<ADD-WORD THRICE ADV>
<ADD-WORD "DON'T" ADV>>
<IFFLAG (P-PS-ADV <PRODUCTION RED-SP SP 1 (?PERS S ?ADV)>)
(T <PRODUCTION RED-SP SP 1 (?PERS S)>)>
<PRODUCTION RED-SV S 2 (VP ?PARTICLE)>
<PRODUCTION RED-SVN S 2 (VP ?PARTICLE NPP)>
<PRODUCTION RED-SVNP S 2 (VP NPP PARTICLE)>
<PRODUCTION RED-SVPNN S 2 (VP ?PARTICLE NPP NPP)>
<PRODUCTION RED-SVNPN S 2 (VP NPP ?PARTICLE NPP)>
<PRODUCTION RED-SVPNPN S 2 (VP ?PARTICLE NPP ?PARTICLE NPP)>
<PRODUCTION RED-SD S 2 (DIR)>
<PRODUCTION RED-SVD S 2 (VP DIR)>
<IFFLAG (P-BE-VERB
<IFFLAG (P-PS-ADV
<PRODUCTION RED-VP VP 3 (?CANDO ?ADV VERB ?ADV)>)
(T
<PRODUCTION RED-VP VP 3 (?CANDO VERB)>)>
<PRODUCTION RED-CANDO ?CANDO 3 ()
(NP)
(?QW1 CANDO NP ?NOT)
(?QW1 CANDO NOT NP)>)
(T
<IFFLAG (P-PS-ADV
<PRODUCTION RED-VP VP 3 (?ADV VERB ?ADV)>)
(T
<PRODUCTION RED-VP VP 3 (VERB)>)>)>
<IFFLAG (P-PS-OFWORD
<PRODUCTION RED-PART ?PARTICLE 1 ()
(PARTICLE OFWORD)
(PARTICLE ?PARTICLE)>)
(T
<PRODUCTION RED-PART ?PARTICLE 1 ()
(PARTICLE MISCWORD ;"OF")
(PARTICLE ?PARTICLE)>)>
<IF-P-PS-ADV <PRODUCTION RED-FCN ?ADV 1 () (ADV)>>
<IFFLAG (P-PS-COMMA
<PRODUCTION RED-NPP NPP 4 (NP)
(NPP PP)
(NPP COMMA NP)>)
(T
<PRODUCTION RED-NPP NPP 4 (NP)
(NPP PP)
(NPP MISCWORD NP)>)>
<PRODUCTION RED-NP NP 6 (;?DET ADJ* NOUN)>
<IFFLAG (P-PS-OFWORD <PRODUCTION RED-OF NP 5 (NP OFWORD NP)>)
(T <PRODUCTION RED-OF NP 5 (NP MISCWORD NP)>)>
<PRODUCTION RED-QT NP 7 (QUANT)>
<PRODUCTION RED-QN NP 5 (QUANT NP)>
<COMPILATION-FLAG-DEFAULT P-PS-QUOTE <>>
<ADD-WORD \" <IFFLAG (P-PS-QUOTE QUOTE) (T MISCWORD)>>
<IFFLAG (P-PS-QUOTE
<PRODUCTION RED-QUOTE NP 7 (QUOTE)>)
(T
<PRODUCTION RED-QUOTE NP 7 (MISCWORD)>)>
<IFFLAG (P-PS-OFWORD
<PRODUCTION RED-PP PP 3 (PREP NPP)
(PARTICLE NPP)
(PREP OFWORD NPP)
(PARTICLE OFWORD NPP)>)
(T
<PRODUCTION RED-PP PP 3 (PREP NPP)
(PARTICLE NPP)
(PREP MISCWORD;"OF" NPP)
(PARTICLE MISCWORD;"OF" NPP)>)>
<IFFLAG (P-PS-THEWORD
<PRODUCTION RED-ADJ ADJ* 8 ()
(ADJ ADJ*) ;"switched by SWG"
(ARTICLE ADJ*)
(POSSESSIVE ADJ*)>)
(T
<PRODUCTION RED-ADJ ADJ* 8 ()
(ADJ ADJ*) ;"switched by SWG"
(MISCWORD ADJ*) ;"article"
(POSSESSIVE ADJ*)>)>
<IFFLAG (P-PS-APOSTR
<PRODUCTION RED-POSS POSSESSIVE 8 (NP APOSTR MISCWORD) ;"FOO'S"
;(ADJ) ;"HER HIS etc.">)
(T
<PRODUCTION RED-POSS POSSESSIVE 8 (NP MISCWORD MISCWORD) ;"FOO'S"
;(ADJ) ;"HER HIS etc.">)>
<IF-P-BE-VERB
<PRODUCTION RED-BE-FORM BE-FORM 3 (TOBE)>
<PRODUCTION RED-SNBN S 2 (NP BE-FORM ?NOT ?BE NPP)>
<PRODUCTION RED-SNBA S 2 (NP BE-FORM ?NOT ?BE ADJ)>
<PRODUCTION RED-SNBP S 2 (NP BE-FORM ?NOT ?BE PP)>
<PRODUCTION RED-FCN ?QW1 3 () (QWORD)>
<PRODUCTION RED-SQBN S 2 (QWORD BE-FORM NP)>
;<PRODUCTION RED-SQBA S 2 (QWORD BE-FORM ADJ)>
;<PRODUCTION RED-SQBP S 2 (QWORD BE-FORM PP)>
<PRODUCTION RED-SBNN S 2 (?QW1 BE-FORM NP ?NOT ?BE NPP)
(?QW1 BE-FORM NOT NP ?BE NPP)>
<PRODUCTION RED-SBNA S 2 (?QW1 BE-FORM NP ?NOT ?BE ADJ)
(?QW1 BE-FORM NOT NP ?BE ADJ)>
<PRODUCTION RED-SBNP S 2 (?QW1 BE-FORM NP ?NOT ?BE PP)
(?QW1 BE-FORM NOT NP ?BE PP)>
<ADD-WORD BE MISCWORD>
<PRODUCTION RED-BE ?BE 3 () (MISCWORD ;"BE")>
<ADD-WORD NOT MISCWORD>
<PRODUCTION RED-NOT ?NOT 3 () (MISCWORD ;"NOT")>
<PRODUCTION RED-NOT NOT 3 (MISCWORD ;"NOT")>
>
<IFFLAG (P-PS-COMMA
<PRODUCTION RED-PERS ?PERS 2 ()
(NPP COMMA)
(ASKWORD NPP PARTICLE ;"TO")>)
(T
<PRODUCTION RED-PERS ?PERS 2 ()
(NPP MISCWORD)
(ASKWORD NPP PARTICLE ;"TO")>)>
<PRODUCTION RED-O-NP S 1 (NP) ;"was NPP"
(NP PP)>
<PRODUCTION RED-O-ADJ S 1 (;ADJ ADJ*)>
<PRODUCTION RED-O-PP S 1 (PP)
(PARTICLE NP)>
<STARTING-SYMBOL SP>
<MAKE-TABLES <LALR>>

406
highway.zabstr Normal file
View File

@ -0,0 +1,406 @@
<BEGIN-SEGMENT LOWER>
<ROOM G-U-HIGHWAY (LOC ROOMS) (REGION "Flatheadia") (DESC
"Great Underground Highway") (LDESC
"This is the northern terminus of one of the branches of the Great Underground
Highway system, one of the ambitious construction projects conceived by King
Duncanthrax and executed by the Frobozz Magic Cave Company. A tunnel leads
northeast.") (NE TO LOWER-HALL) (SOUTH TO EXIT) (FLAGS RLANDBIT UNDERGROUNDBIT)
(MAP-LOC <PTABLE LOWER-LEVEL-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-5>) (ICON
G-U-HIGHWAY-ICON)>
<ROOM EXIT (LOC ROOMS) (REGION "Flatheadia") (DESC "Exit") (LDESC
"A wide underground road runs north and south. There's an eye-catching sign
next to a tunnel leading west.") (WEST TO FIELD-OFFICE) (NORTH TO G-U-HIGHWAY)
(SOUTH TO CROSSROADS) (FLAGS RLANDBIT UNDERGROUNDBIT) (GLOBAL SIGN) (MAP-LOC <
PTABLE LOWER-LEVEL-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-5>) (ICON EXIT-ICON)>
<END-SEGMENT>
<BEGIN-SEGMENT FOOZLE>
<ROOM CROSSROADS (LOC ROOMS) (REGION "Somewhere Along the GUH") (DESC
"Crossroads") (LDESC
"You stand at the junction of two underground highways, one north-south
and the other east-west. A sign hangs in the center of the junction.") (NORTH
TO EXIT) (SOUTH TO TOLL-PLAZA) (EAST TO CAVE-IN) (WEST TO POTHOLES) (FLAGS
RLANDBIT UNDERGROUNDBIT) (GLOBAL SIGN) (MAP-LOC <PTABLE FOOZLE-MAP-NUM
MAP-GEN-Y-3 MAP-GEN-X-7>) (ICON CROSSROADS-ICON)>
<ROOM CAVE-IN (LOC ROOMS) (DESC "Cave-In") (REGION "Somewhere Along the GUH") (
LDESC "Just ahead, the roof of the highway tunnel has collapsed, creating a dead
end. (Decades of non-maintenance of the Empire's infrastructure are taking
their toll.) Your only choice is to return to the west.") (WEST TO CROSSROADS)
(OUT TO CROSSROADS) (FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <PTABLE
FOOZLE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-8>) (ACTION CAVE-IN-F)>
<DEFINE-ROUTINE CAVE-IN-F>
<BEGIN-SEGMENT 0>
<OBJECT PIT-BOMB (LOC LOCAL-GLOBALS) (DESC "anti-pit bomb") (FDESC
"Sitting on a piece of rubble is an anti-pit bomb.") (SYNONYM BOMB LABEL) (
ADJECTIVE BOTTOMLESS ANTI-PIT) (FLAGS TAKEBIT READBIT VOWELBIT) (TEXT
"\"Is your cavern infested with bottomless pits? If so, this anti-pit bomb is
the answer to your prayers! Instructions: simply enter the pitted room and
throw the bomb. All pit-filling agents are harmless; no protective gear is
required!|
Another fine product of the Frobozz Magic Bottomless Pit Bomb Company.\"") (
ACTION PIT-BOMB-F)>
<DEFINE-ROUTINE PIT-BOMB-F>
<GLOBAL PIT-BOMB-LOC <>>
<END-SEGMENT>
<BEGIN-SEGMENT FOOZLE>
<ROOM TOLL-PLAZA (LOC ROOMS) (DESC "Toll Plaza") (REGION
"Somewhere Along the GUH") (NORTH TO CROSSROADS) (SOUTH TO FISSURE-EDGE IF
TOLL-GATE IS OPEN) (FLAGS RLANDBIT UNDERGROUNDBIT) (SYNONYM PLAZA) (ADJECTIVE
TOLL) (GLOBAL SIGN) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-7>) (
ICON TOLL-PLAZA-ICON) (ACTION TOLL-PLAZA-F)>
<DEFINE-ROUTINE TOLL-PLAZA-F>
<OBJECT TOLL-BOOTH (LOC TOLL-PLAZA) (DESC "toll booth") (SYNONYM BOOTH) (
ADJECTIVE TOLL) (FLAGS NDESCBIT) (ACTION TOLL-BOOTH-F)>
<DEFINE-ROUTINE TOLL-BOOTH-F>
<OBJECT TOLL-GATE (LOC TOLL-PLAZA) (DESC "toll gate") (SYNONYM GATE) (ADJECTIVE
TOLL) (FLAGS NDESCBIT DOORBIT) (ACTION TOLL-GATE-F)>
<DEFINE-ROUTINE TOLL-GATE-F>
<OBJECT BASKET (LOC TOLL-PLAZA) (DESC "exact change basket") (SYNONYM BASKET) (
ADJECTIVE EXACT CHANGE) (FLAGS VOWELBIT NDESCBIT CONTBIT OPENBIT SEARCHBIT) (
ACTION BASKET-F)>
<DEFINE-ROUTINE BASKET-F>
<ROOM FISSURE-EDGE (LOC ROOMS) (DESC "Fissure's Edge") (REGION
"Somewhere Along the GUH") (LDESC
"To the south, the road is rent by a wide fissure, the reminder of a recent
quake. Judging by the footprints in the dust, many travellers have reached
this point, only to turn around and head back to the north. The quake has
also opened a narrow crack in the eastern wall of the tunnel; you might be
able to squeeze into it.") (NORTH TO TOLL-PLAZA) (EAST TO TIGHT-SQUEEZE) (SOUTH
SORRY "The fissure is uncrossable.") (DOWN SORRY
"A plunge into the fissure would be fatal.") (FLAGS RLANDBIT UNDERGROUNDBIT) (
MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-7>) (ICON
FISSURES-EDGE-ICON) (THINGS NARROW CRACK FISSURE-CRACK-PS WIDE FISSURE
FISSURE-PS)>
<DEFINE-ROUTINE FISSURE-PS>
<DEFINE-ROUTINE FISSURE-CRACK-PS>
<ROOM TIGHT-SQUEEZE (LOC ROOMS) (DESC "Tight Squeeze") (REGION
"Region: Unknown") (LDESC
"You are in a narrow fissure which widens to the west. A cool breeze seems
to blow upon you from below.") (WEST TO FISSURE-EDGE) (DOWN TO ORB-ROOM) (
SYNONYM FISSURE) (ADJECTIVE NARROW) (FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <
PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-8>)>
<ROOM ORB-ROOM (LOC ROOMS) (DESC "Orb Room") (REGION "Region: Unknown") (LDESC
"The air is chilly, the walls are covered with ice, and the floor is piled
high with crystal spheres of varying sizes and colors; most are chipped or
shattered. Your light reveals no visible exits, although a trickle of warm,
dry air caresses you from above.") (UP TO TIGHT-SQUEEZE) (OUT TO TIGHT-SQUEEZE)
(FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-5
MAP-GEN-X-9>) (ICON ORB-ROOM-ICON) (THINGS <> ICE ICE-PS)>
<DEFINE-ROUTINE ICE-PS>
<BEGIN-SEGMENT 0>
<OBJECT MILKY-ORB (LOC ORB-ROOM) (DESC "milky orb") (FDESC
"The only intact orbs seem to be a milky orb, a fiery orb, a glittery orb,
and a smoky orb.") (SYNONYM ORB) (ADJECTIVE MILKY WHITE) (FLAGS TAKEBIT
TRYTAKEBIT) (ACTION ORB-F)>
<OBJECT FIERY-ORB (LOC ORB-ROOM) (DESC "fiery orb") (SYNONYM ORB) (ADJECTIVE
FIERY ORANGE) (FLAGS TAKEBIT TRYTAKEBIT NDESCBIT) (ACTION ORB-F)>
<OBJECT SMOKY-ORB (LOC ORB-ROOM) (DESC "smoky orb") (SYNONYM ORB) (ADJECTIVE
SMOKY GRAY) (FLAGS TAKEBIT TRYTAKEBIT NDESCBIT) (ACTION ORB-F)>
<OBJECT GLITTERY-ORB (LOC ORB-ROOM) (DESC "glittery orb") (SYNONYM ORB) (
ADJECTIVE GLITTERY GOLD GOLDEN) (FLAGS TAKEBIT TRYTAKEBIT NDESCBIT) (ACTION
ORB-F)>
<DEFINE-ROUTINE ORB-F>
<END-SEGMENT>
<BEGIN-SEGMENT FOOZLE>
<ROOM POTHOLES (LOC ROOMS) (DESC "Potholes") (REGION "Somewhere Along the GUH")
(LDESC "The road, which runs east to west, is in bad shape here, pitted with
holes and ruts.") (EAST TO CROSSROADS) (WEST TO REST-STOP) (FLAGS RLANDBIT
UNDERGROUNDBIT) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-6>)>
<ROOM REST-STOP (LOC ROOMS) (DESC "Rest Stop") (REGION
"Somewhere Along the GUH") (LDESC
"By the north side of the road is a rest stop, closed and boarded up. The road
continues east and southwest.") (EAST TO POTHOLES) (SW TO FORK) (FLAGS RLANDBIT
UNDERGROUNDBIT) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-5>) (ICON
REST-STOP-ICON) (THINGS REST STOP REST-STOP-PS <> BOARD SHUTTER-PS <> SHUTTER
SHUTTER-PS)>
<DEFINE-ROUTINE REST-STOP-PS>
<DEFINE-ROUTINE SHUTTER-PS>
<ROOM FORK (LOC ROOMS) (DESC "Fork") (REGION "Somewhere Along the GUH") (LDESC
"The tunnel forks here, with roads leading northeast, west, and southwest.") (
NE TO REST-STOP) (WEST TO FISHY-ODOR) (SW TO SALTY-SMELL) (FLAGS RLANDBIT
UNDERGROUNDBIT) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-4>) (ICON
FORK-ICON)>
<ROOM FISHY-ODOR (LOC ROOMS) (DESC "Fishy Odor") (REGION "Port Foozle") (LDESC
"The tunnel narrows toward a spot of light to the west. The stench of dead,
rotting fish hangs in the air.") (EAST TO FORK) (WEST TO FISHING-VILLAGE) (
FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-4
MAP-GEN-X-3>) (ICON FISHY-ODOR-ICON)>
<ROOM SALTY-SMELL (LOC ROOMS) (DESC "Salty Smell") (REGION "Port Foozle") (
LDESC "The tunnel from the northeast is narrower here, and pervaded with the scent
of the sea. You can hear breakers to the southwest.") (NE TO FORK) (SW TO
QUILBOZZA-BEACH) (FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <PTABLE
FOOZLE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-3>)>
<ROOM FISHING-VILLAGE (LOC ROOMS) (DESC "Fishing Village") (REGION
"Port Foozle") (LDESC
"This once-busy port, on the shore of the Great Sea, lies deserted. A tunnel
opens to the east, the shoreline can be followed south along the ocean's edge,
and a wharf juts into the harbor to the west. A newly constructed stone
building lies to the north; an eye-catching sign has been erected next to its
entrance.") (EAST TO FISHY-ODOR) (WEST TO WHARF) (SOUTH TO SANDBAR) (NORTH TO
INQUISITION) (IN TO INQUISITION) (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (GLOBAL
VILLAGE SIGN FLATHEAD-OCEAN WHARF GLOBAL-BLDG) (MAP-LOC <PTABLE FOOZLE-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-2>) (ICON FISHING-VILLAGE-ICON) (ACTION FISHING-VILLAGE-F
)>
<DEFINE-ROUTINE FISHING-VILLAGE-F>
<DEFINE-ROUTINE I-INQ>
<CONSTANT DOABLE-REQUESTS <LTABLE 0 "sing a song" "kick me" "kiss me">>
<CONSTANT UNDOABLE-REQUESTS <LTABLE 0 "give me a thousand zorkmids"
"give me Ursula Flathead" "send me to Antharia">>
<GLOBAL INQ-NUMBER 0>
<GLOBAL NUMBER-ON-LINE 0>
<GLOBAL NUMBER-TAKEN 0>
<GLOBAL INQ-SCORE 25>
<ROOM INQUISITION (LOC ROOMS) (DESC "Inquisition") (REGION "Port Foozle") (
SOUTH SORRY "A trollish guard blocks the exit. \"No one leave!\"") (OUT SORRY
"A trollish guard blocks the exit. \"No one leave!\"") (FLAGS RLANDBIT ONBIT) (
GLOBAL SIGN GLOBAL-BLDG) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-2>) (ACTION INQUISITION-F)>
<DEFINE-ROUTINE INQUISITION-F>
<BEGIN-SEGMENT 0>
<OBJECT TICKET (LOC INQUISITION) (DESC "ticket") (SYNONYM TICKET NUMBER) (OWNER
PROTAGONIST) (FLAGS TAKEBIT READBIT TRYTAKEBIT NDESCBIT BURNBIT) (SIZE 1) (
ACTION TICKET-F)>
<DEFINE-ROUTINE TICKET-F>
<OBJECT BOX (LOC INQUISITION) (DESC "box") (PLURAL "boxes") (FDESC
"One of the sinners has apparently dropped a box here. The box has some
writing on it.") (SYNONYM BOX WRITING) (ADJECTIVE SMALL) (FLAGS TAKEBIT CONTBIT
READBIT SEARCHBIT) (SIZE 3) (CAPACITY 3) (OWNER BOX) (TEXT
"\"Squid Repellent! Contents: 1 pellet. Dissolves slowly in water, keeps
squid away for hours! Another fine product of the Frobozz Magic Squid
Repellent Company.\"")>
<OBJECT SQUID-REPELLENT (LOC BOX) (OWNER SQUID-REPELLENT) (DESC
"pellet of squid repellent") (SYNONYM PELLET REPELLENT) (ADJECTIVE LARGE SQUID)
(FLAGS TAKEBIT) (SIZE 1) (ACTION SQUID-REPELLENT-F)>
<DEFINE-ROUTINE SQUID-REPELLENT-F>
<END-SEGMENT>
<BEGIN-SEGMENT FOOZLE>
<OBJECT EXECUTIONER (LOC INQUISITION) (DESC "executioner") (SYNONYM EXECUTIONER
MAN) (FLAGS ACTORBIT VOWELBIT NDESCBIT ANIMATEDBIT) (ACTION EXECUTIONER-F)>
<DEFINE-ROUTINE EXECUTIONER-F>
<DEFINE-ROUTINE DOABLE-REQUEST>
<DEFINE-ROUTINE UNDOABLE-REQUEST>
<OBJECT THOUSAND-ZORKMIDS (LOC LOCAL-GLOBALS) (DESC "lots of zorkmids") (
SYNONYM ZORKMIDS) (ADJECTIVE HUNDRED THOUSAND MILLION INT.NUM) (FLAGS
NARTICLEBIT)>
<ROOM WHARF (LOC ROOMS) (DESC "Wharf") (REGION "Port Foozle") (LDESC
"This wharf extends into the harbor from a village to the east. Along the
north side of the wharf, a building rests on piers over the water.") (EAST TO
FISHING-VILLAGE) (NORTH TO CASINO) (WEST SORRY
"The wharf ends a few steps to the west.") (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (
SYNONYM WHARF) (GLOBAL VILLAGE GLOBAL-BLDG FLATHEAD-OCEAN) (MAP-LOC <PTABLE
FOOZLE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-1>) (ICON WHARF-ICON)>
<ROOM CASINO (LOC ROOMS) (DESC "Casino") (REGION "Port Foozle") (LDESC
"This is the Port Foozle Casino, once a world-famous gambling spot, but
now deserted and showing the effects of years of ocean storms. The casino
has been heavily looted; only a single card table seems untouched. An exit
leads south.") (SOUTH TO WHARF) (OUT TO WHARF) (FLAGS RLANDBIT ONBIT) (SYNONYM
CASINO) (GLOBAL GLOBAL-BLDG) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-1>) (ACTION CASINO-F)>
<DEFINE-ROUTINE CASINO-F>
<OBJECT DOUBLE-FANUCCI (LOC GLOBAL-OBJECTS) (DESC "Double Fanucci") (SYNONYM
FANUCCI FANNUCCI) (ADJECTIVE DOUBLE) (RESEARCH
"\"Legend has it that Double Fanucci (or Fannucci) was invented by the deposed
Zilbo III in the late seventh century. A game of tremendous complexity and
almost infinite rules, King Mumberthrax proclaimed it the national sport of
the Empire in 757 GUE. The annual Double Fanucci Championships, held in
Borphee during early autumn, frequently leave thousands homeless.\"") (ACTION
DOUBLE-FANUCCI-F)>
<DEFINE-ROUTINE DOUBLE-FANUCCI-F>
<OBJECT CARD-TABLE (LOC CASINO) (DESC "card table") (SYNONYM TABLE CHAIR) (
ADJECTIVE CARD) (FLAGS NDESCBIT SURFACEBIT CONTBIT OPENBIT SEARCHBIT VEHBIT) (
CAPACITY 50) (ACTION CARD-TABLE-F)>
<DEFINE-ROUTINE CARD-TABLE-F>
<DEFINE-ROUTINE F-START>
<DEFINE-ROUTINE SETUP-CARDS>
<CONSTANT F-PICSET-TBL <TABLE F-CARD-BACK F-CARD F-INKBLOTS F-PLUNGERS F-BUGS
F-ZURFS F-EARS F-TOPS F-RAIN F-HIVES F-FACES F-MAZES F-LAMPS F-TIME F-BOOKS
F-SCYTHES F-FROMPS F-RV-INKBLOTS F-RV-PLUNGERS F-RV-BUGS F-RV-ZURFS F-RV-EARS
F-RV-TOPS F-RV-RAIN F-RV-HIVES F-RV-FACES F-RV-MAZES F-RV-LAMPS F-RV-TIME
F-RV-BOOKS F-RV-SCYTHES F-RV-FROMPS F-0 F-1 F-2 F-3 F-4 F-5 F-6 F-7 F-8 F-9
F-INFINITY F-RV-0 F-RV-1 F-RV-2 F-RV-3 F-RV-4 F-RV-5 F-RV-6 F-RV-7 F-RV-8
F-RV-9 F-RV-INFINITY F-GRANOLA F-LOBSTER F-SNAIL F-JESTER F-HOURGLASS F-LIGHT
F-BEAUTY F-DEATH F-GRUE 0>>
<DEFINE-ROUTINE SETUP-FANUCCI>
<CONSTANT F-PIC-LOCS <PTABLE ,F-DISCARD-PIC-LOC ,F-1-PIC-LOC ,F-2-PIC-LOC ,
F-3-PIC-LOC ,F-4-PIC-LOC>>
<DEFINE-ROUTINE DRAW-CARDS>
<CONSTANT PICTURE-CARD-PROB 20>
<DEFINE-ROUTINE PICK-RANK>
<CONSTANT F-FACE-CARD-PIC-TBL <PTABLE ,F-GRANOLA ,F-LOBSTER ,F-SNAIL ,F-JESTER
,F-HOURGLASS ,F-LIGHT ,F-BEAUTY ,F-DEATH ,F-GRUE>>
<DEFINE-ROUTINE DISPLAY-OFFSET>
<DEFINE-ROUTINE DRAW-CARD>
<DEFINE-ROUTINE FANUCCI>
<DEFINE-ROUTINE UPDATE-SCORES>
<DEFINE-ROUTINE SCORE-CHECK>
<GLOBAL J-CARDS 4>
<GLOBAL J-DISCARD-FROMP-PROB 0>
<GLOBAL F-WIN-COUNT 0>
<CONSTANT DRAW-CARDS-TABLE <TABLE 1 1 1 1 1>>
<CONSTANT J-LAST-CARD <TABLE 0 0>>
<CONSTANT FROMP-SUIT 15>
<CONSTANT TREBLED-RANK 11>
<DEFINE-ROUTINE J-PLAY>
<CONSTANT J-PLAY-TABLE <PTABLE "shrugs. \"Just a simple Borphee Bluff.\""
"smiles. \"A devilish Kovalli Hustle, don't you think?\""
"shudders. \"Babe would turn over in his grave if he could see my playing.\""
"looks satisfied. \"That ought to up the ante toward a Doubleton Duck.\""
"resists an urge to spike his cards. \"You fell for my Festeron Finesse! I get Honors!\""
"shouts, \"Whangdoogle! Four to the kitty! Minor ruff!\" and massages the resulting torn shoulder muscle."
"kicks himself. \"I should've revoked a Singleton in the third frame!\""
"snickers at you. \"Bet you didn't see that Segmented Shuffle coming!\""
"complains. \"Shy Openers! All I get are Shy Openers!\""
"applauds with delight. \"Zilbo's Half-Renege! I love it!\""
"sighs. \"I came so close to a Full Foozle Progression.\""
"produces two large mallard ducks out of thin air, thus Royal Bidding
his play." "takes a third of the deck and burns it. \"Unlimited Singleton Bids for
the rest of the game!\""
"invokes the Grand Slam clause and reshuffles the deck. \"Slice and Call,\"
he claims." "exhales a deep breath. \"I wasn't sure I'd have time for that Inside
Duo-Trick.\"" "gulps. \"I came close to having to invoke the Golden Fromp clause!\""
"scowls. \"An Unrejuvenated Slamboozle!\" To repent, he changes shape
to a hawk, then a milk cow, then a large carpenter ant, and finally back
to a jester. \"Full repentance; losses halved,\" he states.">>
<CONSTANT J-PLAY-SCORES <PTABLE -10 -78 44 -21 -95 -31 22 -42 34 -56 -4 -28 -16
-37 -25 15 -22>>
<DEFINE-ROUTINE PICK-PLAY>
<DEFINE-ROUTINE UNBOLD-MOVE>
<DEFINE-ROUTINE BOLD-MOVE>
<DEFINE-ROUTINE PLAY-SELECTED>
<DEFINE-ROUTINE F-MOUSE-CARD-PICK>
<DEFINE-ROUTINE PRINT-CARD-NAME>
<CONSTANT F-PLAY-TABLE <PTABLE "DRAW " "DISCARD " "DIVIDE " "REVERSE " "TRUMP "
"UNDERTRUMP " "COMBINE " "PASS " "OVERPASS " "SINGLE-PLAY " "DOUBLE-PLAY "
"MUTTONATE " "IONIZE " "CHEAT " "RESIGN ">>
<CONSTANT F-PLAY-TABLE-LC <PTABLE "draw" "discard" "divide" "reverse" "trump"
"undertrump" "combine" "pass" "overpass" "single-play" "double-play"
"muttonate" "ionize" "cheat" "resign">>
<CONSTANT RANK-PIC-TBL <PTABLE <> F-4 F-5 F-6 F-7 F-8 F-9 F-0 F-INFINITY F-1
F-2 F-3>>
<CONSTANT RANK-REV-TBL <PTABLE <> F-RV-4 F-RV-5 F-RV-6 F-RV-7 F-RV-8 F-RV-9
F-RV-0 F-RV-INFINITY F-RV-1 F-RV-2 F-RV-3>>
<CONSTANT F-RANK-TABLE <PTABLE <> "the Four of" "the Five of" "the Six of"
"the Seven of" "the Eight of" "the Nine of" "the Naught of" "Infinite"
"Singled" "Doubled" "Trebled" "Granola" "the Lobster" "the Snail" "the Jester"
"Time" "Light" "Beauty" "Death" "the Grue">>
<CONSTANT SUIT-PIC-TBL <PTABLE <> F-INKBLOTS F-PLUNGERS F-BUGS F-ZURFS F-EARS
F-TOPS F-RAIN F-HIVES F-FACES F-MAZES F-LAMPS F-TIME F-BOOKS F-SCYTHES F-FROMPS
>>
<CONSTANT SUIT-REV-TBL <PTABLE <> F-RV-INKBLOTS F-RV-PLUNGERS F-RV-BUGS
F-RV-ZURFS F-RV-EARS F-RV-TOPS F-RV-RAIN F-RV-HIVES F-RV-FACES F-RV-MAZES
F-RV-LAMPS F-RV-TIME F-RV-BOOKS F-RV-SCYTHES F-RV-FROMPS>>
<CONSTANT F-SUIT-TABLE <PTABLE <> "Inkblots" "Plungers" "Bugs" "Zurfs" "Ears"
"Tops" "Rain" "Hives" "Faces" "Mazes" "Lamps" "Time" "Books" "Scythes" "Fromps"
>>
<CONSTANT F-CARD-TABLE <TABLE <> <> <> <> <> <> <> <> <> <>>>
<GLOBAL YOUR-SCORE 0>
<GLOBAL J-SCORE 0>
<GLOBAL F-PLAYS 0>
<DEFINE-ROUTINE CHEAT-RESULT>
<DEFINE-ROUTINE F-SCORE>
<CONSTANT CHEAT-WINS <PTABLE 3
"You catch the jester looking out the window, and take the opportunity to
alter the scores." 45 "You distract the jester by faking a muscle cramp." 23
"You successfully slip a card out of your sleeve." 19>>
<CONSTANT CHEAT-LOSSES <PTABLE 3
"The jester seems to doze off for a moment, and you try to take advantage by
fudging the scores. However, the jester stirs, and in your haste you help the
jester instead of yourself!" -60
"The jester catches you marking the cards, and assesses a stiff penalty." -47
"You substitute a card from the middle of the deck, but the new card places
you in an even worse position!" -33>>
<CONSTANT J-RESPONSES <PTABLE "during the middle third of Mumberber!\""
"before a New Sun!\"" "in a two-person game!\"" "cries, \"Daring move!\""
"looks bored. \"The old Oddzio Gambit.\"" "says, \"A gutsy play!\""
"applauds. \"A brilliant Festeron Feint!\""
"sneers. \"A transparent maneuver.\""
"shakes his head. \"A poorly executed Antharian Attack.\""
"exclaims, \"A skillful finesse!\""
"is obviously impressed. \"A spectacular Bloodworm Defense!\""
"sniffs. \"A weak response.\""
"smiles mysteriously. \"An unusual Balsawood Convention!\""
"looks impressed. \"That was a stroke of genius!\""
"taps his fingers impatiently. \"A typical Egreth Convention.\""
"whispers, \"Crude, but effective.\""
"tips his hat to you. \"A well-executed Zilbo Standard!\""
"looks unimpressed. \"Just a lucky stroke!\""
"smirks. \"A poorly timed Forborn Chisel, wouldn't you say?\""
"laughs. \"That was a sign of panic on your part, if you ask me.\""
"peruses your move. \"Ah, yes. The Accardi Variation. I haven't seen that one in a while.\""
"bows his head with respect. \"You're a regular Fanuccimeister, eh?\""
"salutes you. \"A well-timed Frotz Factor! Bravo!\""
"scratches his head. \"A thoroughly mystifying maneuver.\""
"yawns. \"The dependable Zibble Ploy.\""
"laughs derisively. \"An amateurish blunder!\""
"says, \"A classic Frotzen Ploy.\""
"shrugs. \"Oh, well... If people never made mistakes, they wouldn't put
erasers on pencils...\""
"looks at you with scorn. \"A lukewarm Porridge Variation.\""
"blinks. Then blinks again. \"Now I've seen EVERYTHING!\""
"nods knowingly. \"An obvious Fublian Gambit.\""
"offers you some advice. \"Remember the words of Leo 'the Lip' Flathead: 'Nice
guys finish last.'\"" "under Miznian rules!\""
"without a note from your doctor!\""
"except after a third-level Hamster Substitution!\""
"in a coastal city without first eating the rind of a burnt casaba melon!\""
"chortles gratingly. \"Who taught you how to play cards? Vanna Flathead?\"">>
<CONSTANT F-SCORES <PTABLE 0 0 0 24 10 28 41 -12 -81 37 54 -29 17 66 -35 14 18
13 -79 -41 -15 60 64 -99 10 -73 12 -55 -20 -77 -11 -14 0 0 0 0 -38>>
<OBJECT BROOM (LOC LOCAL-GLOBALS) (DESC "broom") (SYNONYM BROOM) (SIZE 10) (
FLAGS TAKEBIT TRYTAKEBIT)>
<ROOM SANDBAR (LOC ROOMS) (DESC "Sandbar") (REGION "Port Foozle") (LDESC
"You are on a wide sandbar, which almost certainly vanishes at high tide.
The only ways off the sandbar are to the north and south.") (NORTH TO
FISHING-VILLAGE) (SOUTH TO QUILBOZZA-BEACH) (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (
SYNONYM SANDBAR) (GLOBAL FLATHEAD-OCEAN) (MAP-LOC <PTABLE FOOZLE-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-2>)>
<ROOM QUILBOZZA-BEACH (LOC ROOMS) (DESC "Quilbozza Beach") (REGION
"Port Foozle") (LDESC
"You are on a wide beach of fine pinkish-white sand. The ocean stretches
west to the horizon. Due to the low tide, it looks as if you could travel
north. In addition, tunnels open to the northeast and southeast.") (NORTH TO
SANDBAR) (NE TO SALTY-SMELL) (SE TO WARNING-ROOM) (FLAGS RLANDBIT ONBIT
OUTSIDEBIT) (SYNONYM BEACH) (ADJECTIVE QUILBOZZA) (GLOBAL FLATHEAD-OCEAN) (
RESEARCH "\"Quilbozza, just south of Port Foozle, is considered the nicest beachfront
in the eastlands, if not all of Quendor.\"") (MAP-LOC <PTABLE FOOZLE-MAP-NUM
MAP-GEN-Y-6 MAP-GEN-X-2>) (ICON QUILBOZZA-BEACH-ICON) (ACTION QUILBOZZA-BEACH-F
)>
<DEFINE-ROUTINE QUILBOZZA-BEACH-F>
<ROOM WARNING-ROOM (LOC ROOMS) (DESC "Warning Room") (REGION "Port Foozle") (
LDESC "You are in a tunnel which curves northwest and northeast. The tunnel rises
at the latter end, and passes a large, eye-catching sign.") (NW TO
QUILBOZZA-BEACH) (DOWN TO QUILBOZZA-BEACH) (NE TO ROOM-OF-THREE-DOORS) (UP TO
ROOM-OF-THREE-DOORS) (FLAGS RLANDBIT UNDERGROUNDBIT) (GLOBAL SIGN) (ICON
WARNING-ROOM-ICON) (MAP-LOC <PTABLE FOOZLE-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-3>)>
<ROOM ROOM-OF-THREE-DOORS (LOC ROOMS) (DESC "Room of Three Doors") (REGION
"Port Foozle") (SW TO WARNING-ROOM) (OUT TO WARNING-ROOM) (IN SORRY
"Pick a door... any door...") (FLAGS RLANDBIT UNDERGROUNDBIT) (MAP-LOC <PTABLE
FOOZLE-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-4>) (ICON ROOM-OF-3-DOORS-ICON) (ACTION
ROOM-OF-THREE-DOORS-F)>
<GLOBAL VERITASSI-DOOR <>>
<GLOBAL PREVARICON-DOOR <>>
<GLOBAL WISHYFOO-DOOR <>>
<GLOBAL WRITING-CHANGED <>>
<DEFINE-ROUTINE ROOM-OF-THREE-DOORS-F>
<OBJECT LEFT-DOOR (LOC ROOM-OF-THREE-DOORS) (DESC "left door") (SYNONYM DOOR
WRITING) (ADJECTIVE LEFT FIRST) (FLAGS DOORBIT NDESCBIT) (OWNER LEFT-DOOR) (
ACTION THREE-DOORS-F)>
<OBJECT RIGHT-DOOR (LOC ROOM-OF-THREE-DOORS) (DESC "right door") (SYNONYM DOOR
WRITING) (ADJECTIVE RIGHT THIRD) (FLAGS DOORBIT NDESCBIT) (OWNER RIGHT-DOOR) (
ACTION THREE-DOORS-F)>
<OBJECT CENTER-DOOR (LOC ROOM-OF-THREE-DOORS) (DESC "center door") (SYNONYM
DOOR WRITING) (ADJECTIVE CENTER MIDDLE SECOND) (FLAGS DOORBIT NDESCBIT) (OWNER
CENTER-DOOR) (ACTION THREE-DOORS-F)>
<DEFINE-ROUTINE THREE-DOORS-F>
<ROOM WISHYFOO-TERRITORY (LOC ROOMS) (DESC "Wishyfoo Territory") (REGION
"Port Foozle") (LDESC
"You are in a medium-sized cavern, which appears to have been recently
occupied. The steep passage which brought you here leads southwest. Also,
a passage just large enough to fit through leads downward.") (SW SORRY
"The passage is too steep to climb back.") (UP SORRY
"The passage is too steep to climb back.") (DOWN TO FORK) (FLAGS RLANDBIT
UNDERGROUNDBIT) (VALUE 6) (MAP-LOC <PTABLE FOOZLE-MAP-NUM WISHYFOO-ICON-LOC
MAP-GEN-X-4>) (ICON WISHYFOO-ICON)>
<OBJECT SHOVEL (LOC WISHYFOO-TERRITORY) (DESC "shovel") (SYNONYM SHOVEL) (SIZE
20) (FLAGS TAKEBIT)>
<END-SEGMENT>

1392
highway.zap Normal file
View File

File diff suppressed because it is too large Load Diff

2196
highway.zil Normal file
View File

File diff suppressed because it is too large Load Diff

1121
hints.zil Normal file
View File

File diff suppressed because it is too large Load Diff

50
input.zabstr Normal file
View File

@ -0,0 +1,50 @@
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE READ-INPUT>
<DEFINE-ROUTINE ADD-TO-INPUT>
<DEFINE-ROUTINE SCRIPT-INBUF>
<GLOBAL WIDTH 80>
<CONSTANT TCHARS <TABLE (BYTE) 255 0>>
<END-SEGMENT>
<BEGIN-SEGMENT SOFT>
<CONSTANT DIROUT-TABLE <ITABLE 80 <BYTE 0>>>
<DEFINE-ROUTINE PRINT-CENTER-TABLE>
<DEFINE SOFT-KEYS ("ARGS" TUP "AUX" (CNT 0) (DL (0)) L) <SET L <MAPF ,LIST <
FUNCTION ("AUX" VAL STR STRL) <COND (<EMPTY? .TUP> <MAPSTOP>)> <SET VAL <NTH .
TUP 1>> <SET STR <NTH .TUP 2>> <SET TUP <REST .TUP 2>> <COND (<TYPE? .STR
STRING> <SET STRL <LENGTH .STR>> <SET DL (.VAL .STRL .STR !.DL)> <COND (<L? .
STRL ,FLEN> <SET STR <STRING .STR <ISTRING <- ,FLEN .STRL> !\ >>>)> <SET CNT <+
.CNT 1>> <MAPRET .VAL <TABLE (STRING) ,FLEN .STRL .STR>>) (ELSE <MAPRET .VAL <
EVAL .STR>>)>>>> <CONSTANT FKEY-TBL <NTH .L 2>> <CONSTANT FKEYS-STRTABLE-LEN <*
.CNT <+ ,FLEN 2>>> <CONSTANT DEFAULT-FKEYS <TABLE (STRING) !.DL>> <CONSTANT
FKEYS <LTABLE !.L>>>
<CONSTANT FNAMES <LTABLE ,UP-ARROW " UP" ,DOWN-ARROW " DN" ,LEFT-ARROW " LF" ,
RIGHT-ARROW " RT" ,F1 " F1" ,F2 " F2" ,F3 " F3" ,F4 " F4" ,F5 " F5" ,F6 " F6" ,
F7 " F7" ,F8 " F8" ,F9 " F9" ,F10 "F10">>
<SYNTAX DEFINE = V-DEFINE>
<GLOBAL DONE-DEFINE? <>>
<DEFINE-ROUTINE V-DEFINE>
<DEFINE-ROUTINE IN-WINDOW?>
<DEFINE-ROUTINE DISPLAY-SOFTS>
<DEFINE-ROUTINE DISPLAY-SOFT>
<DEFINE-ROUTINE SOFT-RESET-DEFAULTS>
<CONSTANT DEFS-NAME <LTABLE (STRING) "DEFS">>
<DEFINE-ROUTINE SOFT-SAVE-DEFS>
<DEFINE-ROUTINE SOFT-RESTORE-DEFS>
<DEFINE-ROUTINE SOFT-EXIT>
<CONSTANT FLEN 30>
<CONSTANT SOFT-WINDOW 2>
<SOFT-KEYS ,UP-ARROW "n " ,DOWN-ARROW "s " ,LEFT-ARROW "w " ,RIGHT-ARROW "e " ,F1 "take " ,F2 "take all " ,F3 "drop " ,F4 "look around " ,F5 "inventory " ,F6 "unlock door " ,F7 "jester, " ,F8 "give magic locket to moose " ,F9 "read about " ,F10 "examine " -4 <TABLE "Save Defs" SOFT-SAVE-DEFS> -5 <
TABLE "Restore Defs" SOFT-RESTORE-DEFS> -6 <TABLE "Reset Defaults"
SOFT-RESET-DEFAULTS> -2 <TABLE "Exit" SOFT-EXIT>>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE Y?>
<DEFINE-ROUTINE BLINK>
<GLOBAL TYPED-TIMED-OUT <>>
<DEFINE-ROUTINE TYPED?>
<DEFINE-ROUTINE PICINF-PLUS-ONE>
<GLOBAL MOUSE-LOC-X <>>
<GLOBAL MOUSE-LOC-Y <>>
<DEFINE-ROUTINE MOUSE-INPUT?>
<END-SEGMENT>

490
input.zap Normal file
View File

@ -0,0 +1,490 @@
.SEGMENT "0"
.FUNCT READ-INPUT,TRM,TMP,N,M,FDEF,DIR,?TMP1
PUTB P-INBUF,1,0
?PRG1: ZERO? DEMO-VERSION? /?CCL5
CALL READ-DEMO,P-INBUF,FALSE-VALUE >TRM
JUMP ?CND3
?CCL5: READ P-INBUF,FALSE-VALUE >TRM
?CND3: ICALL1 MOUSE-INPUT?
EQUAL? TRM,PAD0 \?CCL8
SET 'TRM,F10
JUMP ?CND6
?CCL8: LESS? TRM,PAD1 /?CND6
GRTR? TRM,PAD9 /?CND6
SUB TRM,PAD1
ADD F1,STACK >TRM
?CND6: EQUAL? TRM,CLICK1,CLICK2 \?CCL14
CALL COMPASS-CLICK,COMPASS-PIC-LOC,N-HL >DIR
ZERO? DIR /?PRG1
DIROUT D-TABLE-ON,O-INBUF
CALL2 DIR-TO-STRING,DIR
PRINT STACK
DIROUT D-TABLE-OFF
PUTB O-INBUF,0,INBUF-LENGTH
ADD O-INBUF,1 >?TMP1
GETB O-INBUF,1
ICALL ADD-TO-INPUT,?TMP1,13,STACK
JUMP ?REP2
?CCL14: EQUAL? TRM,13,10 /?REP2
ADD FKEYS,2 >?TMP1
GET FKEYS,0
INTBL? TRM,?TMP1,STACK >TMP \?CCL20
GET TMP,1 >FDEF
ZERO? FDEF /?CCL20
ADD 1,FDEF >?TMP1
GETB FDEF,1
CALL ADD-TO-INPUT,?TMP1,TRM,STACK >TRM
EQUAL? TRM,13,10 /?REP2
JUMP ?PRG1
?CCL20: SOUND S-BEEP
JUMP ?PRG1
?REP2: ICALL1 SCRIPT-INBUF
LEX P-INBUF,P-LEXV
RTRUE
.FUNCT ADD-TO-INPUT,FDEF,TRM,M,N,TMP,?TMP1
GETB P-INBUF,1 >N
GETB FDEF,M
EQUAL? STACK,13,10 \?CND1
SET 'TRM,13
DEC 'M
?CND1: INC 'FDEF
ADD N,2
ADD P-INBUF,STACK >TMP
ADD M,N >?TMP1
GETB P-INBUF,0
LESS? ?TMP1,STACK /?CND3
SOUND 1
GETB P-INBUF,0
SUB STACK,N
SUB STACK,1 >M
?CND3: COPYT FDEF,TMP,M
PUTB TMP,M,0
WINATTR -3,A-SCRIPT,O-CLEAR
PRINTT FDEF,M
ADD N,M
PUTB P-INBUF,1,STACK
EQUAL? TRM,13,10 \?CND5
CRLF
?CND5: WINATTR -3,A-SCRIPT,O-SET
RETURN TRM
.FUNCT SCRIPT-INBUF,BUF,CNT,N,CHR
GETB P-INBUF,1 >N
DIROUT D-SCREEN-OFF
ADD 1,P-INBUF >BUF
?PRG1: IGRTR? 'CNT,N /?REP2
GETB BUF,CNT >CHR
LESS? CHR,97 /?CCL8
GRTR? CHR,122 /?CCL8
SUB CHR,32
PRINTC STACK
JUMP ?PRG1
?CCL8: PRINTC CHR
JUMP ?PRG1
?REP2: CRLF
DIROUT D-SCREEN-ON
RTRUE
.ENDSEG
.SEGMENT "SOFT"
.FUNCT PRINT-CENTER-TABLE,?TMP2,?TMP1
DIROUT D-TABLE-OFF
WINGET -3,WYPOS >?TMP1
WINGET -3,WWIDE >?TMP2
GET 0,24
SUB ?TMP2,STACK
DIV STACK,2
ADD STACK,1
CURSET ?TMP1,STACK
GET DIROUT-TABLE,0
PRINTT DIROUT-TABLE+2,STACK
RTRUE
.FUNCT V-DEFINE,LINE,LINMAX,CHR,TMP,NLINE,FKEY,FDEF,LEFT,FY,FX,?TMP1
ZERO? DONE-DEFINE? \?CND1
SET 'DONE-DEFINE?,TRUE-VALUE
PRINTI "Software Function Key definition. "
GETB 0,30
EQUAL? STACK,MACINTOSH \?CND3
PRINTI "(NOTE: if your Macintosh has no function keys, use Command-1 thru Command-0 instead.) "
?CND3: PRINTI "Use the arrow keys"
ZERO? ACTIVE-MOUSE /?CND5
PRINTI " or the mouse"
?CND5: PRINTI " to select the key to define or the operation to perform. Hit the RETURN/ENTER key"
ZERO? ACTIVE-MOUSE /?CND7
PRINTI " or double-click the mouse"
?CND7: PRINTI " to perform operations."
CRLF
ICALL1 HIT-ANY-KEY
?CND1: CLEAR -1
MUL 4,LINE
ADD 2,STACK
ADD FKEYS,STACK >FKEY
GET FKEY,1 >FDEF
GETB 0,33 >?TMP1
GETB FDEF,0
SUB ?TMP1,STACK
DIV STACK,2 >LEFT
GET FKEYS,0
DIV STACK,2 >LINMAX
CLEAR -1
SCREEN SOFT-WINDOW
FONT 4
WINGET SOFT-WINDOW,WFSIZE >TMP
SHIFT TMP,-8 >FY
BAND TMP,255 >FX
GETB 0,32
SUB STACK,LINMAX
DIV STACK,2
MUL FY,STACK >?TMP1
MUL FX,LEFT
WINPOS SOFT-WINDOW,?TMP1,STACK
ADD LINMAX,1
MUL FY,STACK >?TMP1
ADD FLEN,4
MUL FX,STACK
ADD 1,STACK
WINSIZE SOFT-WINDOW,?TMP1,STACK
ICALL2 DISPLAY-SOFTS,LINE
ICALL DISPLAY-SOFT,FKEY,LINE,FALSE-VALUE
?PRG9: ZERO? DEMO-VERSION? /?CCL13
CALL2 INPUT-DEMO,1 >CHR
JUMP ?CND11
?CCL13: INPUT 1 >CHR
?CND11: SET 'NLINE,LINE
EQUAL? CHR,CLICK1,CLICK2 \?CND14
CALL2 IN-WINDOW?,SOFT-WINDOW >TMP
ZERO? TMP /?CND14
GRTR? TMP,1 \?CND14
SUB TMP,2 >NLINE
EQUAL? LINE,NLINE /?CND19
ICALL DISPLAY-SOFT,FKEY,LINE,TRUE-VALUE
MUL 4,NLINE
ADD 2,STACK
ADD FKEYS,STACK
ICALL DISPLAY-SOFT,STACK,NLINE,FALSE-VALUE
SET 'LINE,NLINE
MUL 4,LINE
ADD 2,STACK
ADD FKEYS,STACK >FKEY
GET FKEY,1 >FDEF
?CND19: EQUAL? CHR,CLICK2 \?CND14
GET FKEY,0
LESS? STACK,0 \?CND14
SET 'CHR,13
?CND14: EQUAL? CHR,CLICK1,CLICK2 /?CND25
EQUAL? CHR,13 \?CCL28
GET FKEY,0
LESS? STACK,0 \?CCL28
SET 'NLINE,0
GET FDEF,1
CALL STACK
ZERO? STACK /?CCL33
SCREEN 0
CLEAR 0
ICALL1 V-$REFRESH
RTRUE
?CCL33: SUB LINMAX,1 >NLINE
ICALL2 DISPLAY-SOFTS,LINE
JUMP ?CND25
?CCL28: EQUAL? CHR,DOWN-ARROW,13 \?CCL35
INC 'NLINE
LESS? NLINE,LINMAX /?CND25
SET 'NLINE,0
JUMP ?CND25
?CCL35: EQUAL? CHR,UP-ARROW \?CCL39
DLESS? 'NLINE,0 \?CND25
SUB LINMAX,1 >NLINE
JUMP ?CND25
?CCL39: ADD FKEYS,2 >?TMP1
GET FKEYS,0
INTBL? CHR,?TMP1,STACK >TMP \?CCL43
SUB TMP,FKEYS
DIV STACK,4 >NLINE
JUMP ?CND25
?CCL43: EQUAL? CHR,8,127 \?CCL45
GETB FDEF,1 >TMP
ZERO? TMP /?CCL48
DEC 'TMP
PUTB FDEF,1,TMP
ADD TMP,2
PUTB FDEF,STACK,32
ADD LINE,2 >?TMP1
ADD TMP,5
ICALL CCURSET,?TMP1,STACK
ERASE 1
JUMP ?CND25
?CCL48: SOUND S-BEEP
JUMP ?CND25
?CCL45: LESS? CHR,32 /?CCL50
LESS? CHR,127 \?CCL50
GETB FDEF,1 >TMP
GETB FDEF,0
EQUAL? TMP,STACK \?CCL55
SOUND S-BEEP
JUMP ?CND25
?CCL55: ADD FDEF,2 >?TMP1
GETB FDEF,1
INTBL? 13,?TMP1,STACK,1 \?CCL57
SOUND S-BEEP
JUMP ?CND25
?CCL57: EQUAL? CHR,124,33 \?CND58
SET 'CHR,13
?CND58: ADD TMP,1
PUTB FDEF,1,STACK
LESS? CHR,65 /?CND60
GRTR? CHR,90 /?CND60
ADD CHR,32 >CHR
?CND60: ADD TMP,2
PUTB FDEF,STACK,CHR
EQUAL? CHR,13 \?CCL66
PRINTC 124
JUMP ?CND25
?CCL66: PRINTC CHR
JUMP ?CND25
?CCL50: SOUND S-BEEP
?CND25: EQUAL? LINE,NLINE /?PRG9
ICALL DISPLAY-SOFT,FKEY,LINE,TRUE-VALUE
MUL 4,NLINE
ADD 2,STACK
ADD FKEYS,STACK
ICALL DISPLAY-SOFT,STACK,NLINE,FALSE-VALUE
SET 'LINE,NLINE
MUL 4,LINE
ADD 2,STACK
ADD FKEYS,STACK >FKEY
GET FKEY,1 >FDEF
JUMP ?PRG9
.FUNCT IN-WINDOW?,W,X,Y,TOP,LEFT
GET 0,27
GET STACK,2 >Y
GET 0,27
GET STACK,1 >X
WINGET W,WTOP >TOP
LESS? Y,TOP /FALSE
WINGET W,WLEFT >LEFT
LESS? X,LEFT /FALSE
SUB Y,TOP >Y
SUB X,LEFT >X
WINGET W,WHIGH
GRTR? Y,STACK /FALSE
WINGET W,WWIDE
GRTR? X,STACK /FALSE
DIV Y,FONT-Y
ADD 1,STACK >Y
RETURN Y
.FUNCT DISPLAY-SOFTS,LINE,L,F,N,FKEY,CNT
GET FKEYS,0 >L
DIV L,2 >L
SCREEN SOFT-WINDOW
CURSET 1,1
DIROUT D-TABLE-ON,DIROUT-TABLE
FONT 1
PRINTI "Function Keys"
ICALL1 PRINT-CENTER-TABLE
FONT 4
ADD FKEYS,2 >FKEY
?PRG1: LESS? CNT,L \TRUE
EQUAL? CNT,LINE \?CCL8
PUSH FALSE-VALUE
JUMP ?CND6
?CCL8: PUSH TRUE-VALUE
?CND6: ICALL DISPLAY-SOFT,FKEY,CNT,STACK
ADD FKEY,4 >FKEY
INC 'CNT
JUMP ?PRG1
.FUNCT DISPLAY-SOFT,FKEY,CNT,INV?,FDEF,S,N,M,TMP,Y,X,?TMP1
GET FKEY,1 >FDEF
ADD CNT,2 >Y
GET FKEY,0
LESS? STACK,0 \?CCL3
ICALL CCURSET,Y,1
ZERO? INV? /?CND4
HLIGHT H-INVERSE
?CND4: FONT 1
DIROUT D-TABLE-ON,DIROUT-TABLE
GET FDEF,0
PRINT STACK
ICALL1 PRINT-CENTER-TABLE
FONT 4
JUMP ?CND1
?CCL3: GETB FDEF,0 >S
GETB FDEF,1 >N
ICALL CCURSET,Y,1
GET FKEY,0 >?TMP1
GET FNAMES,0
INTBL? ?TMP1,FNAMES+2,STACK >TMP \?CND6
ZERO? INV? /?CCL10
HLIGHT H-NORMAL
JUMP ?CND8
?CCL10: HLIGHT H-INVERSE
?CND8: GET TMP,1
PRINT STACK
HLIGHT H-NORMAL
PRINTC 32
ZERO? INV? /?CCL13
HLIGHT H-INVERSE
JUMP ?CND6
?CCL13: HLIGHT H-NORMAL
?CND6: ADD FDEF,2 >FDEF
ZERO? N /?CND14
SUB N,1 >M
GETB FDEF,M
EQUAL? STACK,13 \?CND14
PRINTT FDEF,M
PRINTC 124
ADD FDEF,N >FDEF
SUB S,N >S
?CND14: PRINTT FDEF,S
ZERO? INV? \?CND1
ADD N,5
ICALL CCURSET,Y,STACK
?CND1: HLIGHT H-NORMAL
RTRUE
.FUNCT SOFT-RESET-DEFAULTS,K,L,KEYS,DEF,KL,TMP,?TMP1
GET FKEYS,0 >KL
SET 'DEF,DEFAULT-FKEYS
?PRG1: GETB DEF,0 >K
ZERO? K /FALSE
INC 'DEF
GETB DEF,0
ADD 1,STACK >L
ADD FKEYS,2
INTBL? K,STACK,KL >KEYS \?CND5
GET KEYS,1 >KEYS
ADD 1,KEYS >TMP
PUTB TMP,0,32
ADD 1,TMP >?TMP1
GETB KEYS,0
SUB 0,STACK
COPYT TMP,?TMP1,STACK
ADD 1,KEYS
COPYT DEF,STACK,L
?CND5: ADD DEF,L >DEF
JUMP ?PRG1
.FUNCT SOFT-SAVE-DEFS
CLEAR 0
SCREEN 0
SAVE FKEY-TBL,FKEYS-STRTABLE-LEN,DEFS-NAME
ZERO? STACK \?CND1
PRINTI "Failed."
?CND1: CLEAR 0
SCREEN SOFT-WINDOW
RFALSE
.FUNCT SOFT-RESTORE-DEFS
CLEAR 0
SCREEN 0
RESTORE FKEY-TBL,FKEYS-STRTABLE-LEN,DEFS-NAME
ZERO? STACK \?CND1
PRINTI "Failed."
?CND1: CLEAR 0
SCREEN SOFT-WINDOW
RFALSE
.FUNCT SOFT-EXIT
RTRUE
.ENDSEG
.SEGMENT "0"
.FUNCT Y?,X
?PRG1: ZERO? DEMO-VERSION? /?CCL5
CALL2 INPUT-DEMO,1 >X
JUMP ?CND3
?CCL5: INPUT 1 >X
?CND3: EQUAL? X,89,121,CLICK1 /?CTR7
EQUAL? X,CLICK2 \?CCL8
?CTR7: SET 'X,TRUE-VALUE
JUMP ?REP2
?CCL8: EQUAL? X,78,110 \?CCL12
SET 'X,FALSE-VALUE
?REP2: CRLF
RETURN X
?CCL12: CRLF
PRINTI "[Please type Y or N] >"
JUMP ?PRG1
.FUNCT BLINK,PIC1,PIC2,Y,X,SCR,CHAR,LAST,CNT
SCREEN SCR
DISPLAY PIC2,Y,X
SCREEN S-TEXT
SET 'LAST,PIC2
?PRG1: SET 'TYPED-TIMED-OUT,FALSE-VALUE
INPUT 1,3,TYPED? >CHAR
ICALL1 MOUSE-INPUT?
ZERO? TYPED-TIMED-OUT /?CCL5
SCREEN SCR
EQUAL? LAST,PIC1 \?CCL8
SET 'LAST,PIC2
PUSH PIC2
JUMP ?CND6
?CCL8: SET 'LAST,PIC1
PUSH PIC1
?CND6: DISPLAY STACK,Y,X
INC 'CNT
EQUAL? CNT,4 \?CND9
ZERO? ROSE-NEEDS-UPDATING /?CND9
EQUAL? CURRENT-SPLIT,MAP-TOP-LEFT-LOC \?CND9
ICALL1 UPDATE-MAP-ROSE
?CND9: SCREEN S-TEXT
JUMP ?PRG1
?CCL5: EQUAL? LAST,PIC2 /?CCL15
RETURN CHAR
?CCL15: SCREEN SCR
DISPLAY PIC1,Y,X
SCREEN S-TEXT
RETURN CHAR
.FUNCT TYPED?
SET 'TYPED-TIMED-OUT,TRUE-VALUE
RTRUE
.FUNCT PICINF-PLUS-ONE,PIC
PICINF PIC,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,0
ADD STACK,1
PUT PICINF-TBL,0,STACK
GET PICINF-TBL,1
ADD STACK,1
PUT PICINF-TBL,1,STACK
RTRUE
.FUNCT MOUSE-INPUT?
GET 0,27
GET STACK,1 >MOUSE-LOC-X
GET 0,27
GET STACK,2 >MOUSE-LOC-Y
RETURN MOUSE-LOC-Y
.ENDSEG
.ENDI

500
input.zil Normal file
View File

@ -0,0 +1,500 @@
"INPUT for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<BEGIN-SEGMENT 0>
<ROUTINE READ-INPUT ("AUX" TRM TMP N M FDEF DIR)
<PUTB ,P-INBUF 1 0>
<REPEAT ()
<COND (,DEMO-VERSION?
<SET TRM <READ-DEMO ,P-INBUF <>>>)
(T
<SET TRM <READ ,P-INBUF <>>>)>
<MOUSE-INPUT?>
<COND (<EQUAL? .TRM ,PAD0>
<SET TRM ,F10>)
(<AND <G=? .TRM ,PAD1>
<L=? .TRM ,PAD9>>
<SET TRM <+ ,F1 <- .TRM ,PAD1>>>)>
<COND (<EQUAL? .TRM ,CLICK1 ,CLICK2>
<COND (<SET DIR <COMPASS-CLICK ,COMPASS-PIC-LOC ,N-HL>>
;<SET TMP <COND (<EQUAL? .DIR ,P?NORTH ,P?SOUTH> 5)
(<EQUAL? .DIR ,P?WEST ,P?EAST> 4)
(T 9)>>
<DIROUT ,D-TABLE-ON ,O-INBUF>
<TELL <DIR-TO-STRING .DIR>>
<DIROUT ,D-TABLE-OFF>
<PUTB ,O-INBUF 0 ,INBUF-LENGTH>
<ADD-TO-INPUT <REST ,O-INBUF 1> 13 <GETB ,O-INBUF 1>>
<RETURN>)>)
(<EQUAL? .TRM 13 10>
<RETURN>)
(<AND <SET TMP
<INTBL? .TRM <REST ,FKEYS 2> <GET ,FKEYS 0>>>
<SET FDEF <GET .TMP 1>>> ;"key def"
<SET TRM <ADD-TO-INPUT <REST .FDEF> .TRM <GETB .FDEF 1>>>
<COND (<EQUAL? .TRM 13 10> <RETURN>)>)
(T
<SOUND ,S-BEEP>)>>
<SCRIPT-INBUF>
<LEX ,P-INBUF ,P-LEXV>>
<ROUTINE ADD-TO-INPUT (FDEF TRM M "AUX" N TMP)
;<SET M <GETB .FDEF 1>> ;"number chars in def"
<SET N <GETB ,P-INBUF 1>> ;"number chars already"
;<SET FDEF <REST .FDEF>>
<COND (<EQUAL? <GETB .FDEF .M> 13 10>
<SET TRM 13> ;"this def is a terminator"
<SET M <- .M 1>>)>
<SET FDEF <REST .FDEF>>
<SET TMP <REST ,P-INBUF <+ .N 2>>>
<COND (<G=? <+ .M .N> <GETB ,P-INBUF 0>> ;"overflowed input buffer"
<SOUND 1>
<SET M <- <GETB ,P-INBUF 0> .N 1>>)>
<COPYT .FDEF .TMP .M>
<PUTB .TMP .M 0>
<WINATTR -3 ,A-SCRIPT ,O-CLEAR>
<PRINTT .FDEF .M>
<PUTB ,P-INBUF 1 <+ .N .M>>
<COND (<EQUAL? .TRM 13 10>
<CRLF>)>
<WINATTR -3 ,A-SCRIPT ,O-SET>
.TRM>
<ROUTINE SCRIPT-INBUF ("AUX" BUF (CNT 0) (N <GETB ,P-INBUF 1>) CHR)
<DIROUT ,D-SCREEN-OFF>
<SET BUF <REST ,P-INBUF>>
<REPEAT ()
<COND (<IGRTR? CNT .N> <RETURN>)
(ELSE
<SET CHR <GETB .BUF .CNT>>
<COND (<AND <G=? .CHR !\a>
<L=? .CHR !\z>>
<PRINTC <- .CHR 32>>)
(ELSE <PRINTC .CHR>)>)>>
<CRLF>
<DIROUT ,D-SCREEN-ON>>
<GLOBAL WIDTH 80>
<CONSTANT TCHARS <TABLE (BYTE) 255 0>>
<END-SEGMENT>
;"function key stuff"
<BEGIN-SEGMENT SOFT>
<CONSTANT DIROUT-TABLE <ITABLE 80 <BYTE 0>>>
<ROUTINE PRINT-CENTER-TABLE ()
<DIROUT ,D-TABLE-OFF>
<CURSET <WINGET -3 ,WYPOS>
<+ </ <- <WINGET -3 ,WWIDE>
<LOWCORE TWID>>
2>
1>>
<PRINTT <REST ,DIROUT-TABLE 2> <GET ,DIROUT-TABLE 0>>>
"MDL routine to create a set of soft-key tables and defaults"
<DEFINE SOFT-KEYS ("ARGS" TUP "AUX" (CNT 0) (DL (0)) L)
<SET L
<MAPF ,LIST
<FUNCTION ("AUX" VAL STR STRL)
<COND (<EMPTY? .TUP> <MAPSTOP>)>
<SET VAL <NTH .TUP 1>>
<SET STR <NTH .TUP 2>>
<SET TUP <REST .TUP 2>>
<COND (<TYPE? .STR STRING>
<SET STRL <LENGTH .STR>>
<SET DL (.VAL .STRL .STR !.DL)>
<COND (<L? .STRL ,FLEN>
<SET STR
<STRING .STR
<ISTRING <- ,FLEN .STRL>
!\ >>>)>
<SET CNT <+ .CNT 1>>
<MAPRET .VAL <TABLE (STRING) ,FLEN .STRL .STR>>)
(ELSE
<MAPRET .VAL <EVAL .STR>>)>>>>
<CONSTANT FKEY-TBL <NTH .L 2>>
<CONSTANT FKEYS-STRTABLE-LEN <* .CNT <+ ,FLEN 2>>>
<CONSTANT DEFAULT-FKEYS <TABLE (STRING) !.DL>>
<CONSTANT FKEYS <LTABLE !.L>>>
<CONSTANT FNAMES
<LTABLE ,UP-ARROW " UP"
,DOWN-ARROW " DN"
,LEFT-ARROW " LF"
,RIGHT-ARROW " RT"
;"vt100 keypad keys"
,F1 " F1"
,F2 " F2"
,F3 " F3"
,F4 " F4"
,F5 " F5"
,F6 " F6"
,F7 " F7"
,F8 " F8"
,F9 " F9"
,F10 "F10">>
<SYNTAX DEFINE = V-DEFINE>
<GLOBAL DONE-DEFINE? <>>
<ROUTINE V-DEFINE ("AUX" (LINE 0) LINMAX CHR TMP NLINE FKEY FDEF LEFT FY FX)
<COND (<NOT ,DONE-DEFINE?>
<SETG DONE-DEFINE? T>
<TELL "Software Function Key definition. ">
<COND (<EQUAL? <LOWCORE INTID> ,MACINTOSH>
<TELL
"(NOTE: if your Macintosh has no function keys, use Command-1 thru
Command-0 instead.) ">)>
<TELL "Use the arrow keys">
<COND (,ACTIVE-MOUSE
<TELL " or the mouse">)>
<TELL
" to select the key to define or the operation to perform. Hit
the RETURN/ENTER key">
<COND (,ACTIVE-MOUSE
<TELL " or double-click the mouse">)>
<TELL " to perform operations." CR>
<HIT-ANY-KEY>)>
<CLEAR -1>
<SET FKEY <REST ,FKEYS <+ 2 <* 4 .LINE>>>>
<SET FDEF <GET .FKEY 1>>
<SET LEFT </ <- <LOWCORE SCRH> <GETB .FDEF 0>> 2>>
<SET LINMAX </ <GET ,FKEYS 0> 2>>
<CLEAR -1>
<SCREEN ,SOFT-WINDOW>
<FONT 4>
<SET TMP <WINGET ,SOFT-WINDOW ,WFSIZE>>
<SET FY <SHIFT .TMP -8>>
<SET FX <BAND .TMP 255>>
<WINPOS ,SOFT-WINDOW
<* .FY </ <- <LOWCORE SCRV> .LINMAX> 2>>
<* .FX .LEFT>>
<WINSIZE ,SOFT-WINDOW
<* .FY <+ .LINMAX 1>>
<+ 1 <* .FX <+ ,FLEN 4>>>>
<DISPLAY-SOFTS .LINE>
<DISPLAY-SOFT .FKEY .LINE <>>
<REPEAT ()
<COND (,DEMO-VERSION?
<SET CHR <INPUT-DEMO 1>>)
(T
<SET CHR <INPUT 1>>)>
<SET NLINE .LINE>
<COND (<AND <EQUAL? .CHR ,CLICK1 ,CLICK2>
<SET TMP <IN-WINDOW? ,SOFT-WINDOW>>
<G? .TMP 1>>
<SET NLINE <- .TMP 2>>
<COND (<NOT <EQUAL? .LINE .NLINE>>
<DISPLAY-SOFT .FKEY .LINE T>
<DISPLAY-SOFT <REST ,FKEYS <+ 2 <* 4 .NLINE>>>
.NLINE <>>
<SET LINE .NLINE>
<SET FKEY <REST ,FKEYS <+ 2 <* 4 .LINE>>>>
<SET FDEF <GET .FKEY 1>>)>
<COND (<AND <EQUAL? .CHR ,CLICK2>
<L? <GET .FKEY 0> 0>>
<SET CHR 13>)>)>
<COND (<EQUAL? .CHR ,CLICK1 ,CLICK2>)
(<AND <EQUAL? .CHR 13>
<L? <GET .FKEY 0> 0>>
<SET NLINE 0>
<COND (<APPLY <GET .FDEF 1>>
<SCREEN 0>
<CLEAR 0>
<V-$REFRESH>
<RTRUE>)
(ELSE
<SET NLINE <- .LINMAX 1>>
<DISPLAY-SOFTS .LINE>)>)
(<EQUAL? .CHR ,DOWN-ARROW 13>
<COND (<L? <SET NLINE <+ .NLINE 1>> .LINMAX>)
(ELSE <SET NLINE 0>)>)
(<EQUAL? .CHR ,UP-ARROW>
<COND (<G=? <SET NLINE <- .NLINE 1>> 0>)
(ELSE
<SET NLINE <- .LINMAX 1>>)>)
(<SET TMP
<INTBL? .CHR <REST ,FKEYS 2> <GET ,FKEYS 0>>>
<SET NLINE </ <- .TMP ,FKEYS> 4>>)
(<EQUAL? .CHR 8 127>
<SET TMP <GETB .FDEF 1>>
<COND (<NOT <ZERO? .TMP>>
<SET TMP <- .TMP 1>>
<PUTB .FDEF 1 .TMP>
<PUTB .FDEF <+ .TMP 2> !\ >
<CCURSET <+ .LINE 2>
<+ .TMP 5>>
<ERASE 1>)
(ELSE <SOUND ,S-BEEP>)>)
(<AND <G=? .CHR !\ > <L? .CHR 127>>
<SET TMP <GETB .FDEF 1>>
<COND (<EQUAL? .TMP <GETB .FDEF 0>>
<SOUND ,S-BEEP>)
(<INTBL? 13
<REST .FDEF 2>
<GETB .FDEF 1>
1>
<SOUND ,S-BEEP>)
(ELSE
<COND (<EQUAL? .CHR !\| !\!> <SET CHR 13>)>
<PUTB .FDEF 1 <+ .TMP 1>>
<COND (<AND <G=? .CHR !\A>
<L=? .CHR !\Z>>
<SET CHR <+ .CHR 32>>)>
<PUTB .FDEF <+ .TMP 2> .CHR>
<COND (<EQUAL? .CHR 13>
<PRINTC !\|>)
(ELSE <PRINTC .CHR>)>)>)
(ELSE <SOUND ,S-BEEP>)>
<COND (<NOT <EQUAL? .LINE .NLINE>>
<DISPLAY-SOFT .FKEY .LINE T>
<DISPLAY-SOFT <REST ,FKEYS <+ 2 <* 4 .NLINE>>>
.NLINE <>>
<SET LINE .NLINE>
<SET FKEY <REST ,FKEYS <+ 2 <* 4 .LINE>>>>
<SET FDEF <GET .FKEY 1>>)>>
<FONT 1>
<SCREEN 0>
<V-$REFRESH>>
"given a window, returns line hit with mouse click, or false if not in that
window."
<ROUTINE IN-WINDOW? (W "AUX" X Y TOP LEFT)
<SET Y <LOWCORE MSLOCY>>
<SET X <LOWCORE MSLOCX>>
<COND (<OR <L? .Y <SET TOP <WINGET .W ,WTOP>>>
<L? .X <SET LEFT <WINGET .W ,WLEFT>>>>
<RFALSE>)
(ELSE
<SET Y <- .Y .TOP>>
<SET X <- .X .LEFT>>
<COND (<OR <G? .Y <WINGET .W ,WHIGH>>
<G? .X <WINGET .W ,WWIDE>>>
<RFALSE>)>
<SET Y <+ 1 </ .Y ,FONT-Y>>>
<RETURN .Y>)>>
<ROUTINE DISPLAY-SOFTS (LINE "AUX" (L <GET ,FKEYS 0>) (F 0) N FKEY (CNT 0))
<SET L </ .L 2>>
<SCREEN ,SOFT-WINDOW>
<CURSET 1 1>
<DIROUT ,D-TABLE-ON ,DIROUT-TABLE>
<FONT 1>
<TELL "Function Keys">
<PRINT-CENTER-TABLE>
<FONT 4>
<SET FKEY <REST ,FKEYS 2>>
<REPEAT ()
<COND (<L? .CNT .L>
<DISPLAY-SOFT .FKEY .CNT
<COND (<EQUAL? .CNT .LINE> <>)
(ELSE T)>>
<SET FKEY <REST .FKEY 4>>)
(ELSE <RETURN>)>
<SET CNT <+ .CNT 1>>>>
<ROUTINE DISPLAY-SOFT (FKEY CNT INV?
"AUX" (FDEF <GET .FKEY 1>) S N M TMP
(Y <+ .CNT 2>) X)
<COND (<L? <GET .FKEY 0> 0> ;"constant string"
<CCURSET .Y 1>
<COND (.INV? <HLIGHT ,H-INVERSE>)>
<FONT 1>
<DIROUT ,D-TABLE-ON ,DIROUT-TABLE>
<TELL <GET .FDEF 0>>
<PRINT-CENTER-TABLE>
<FONT 4>)
(ELSE
<SET S <GETB .FDEF 0>>
<SET N <GETB .FDEF 1>>
<CCURSET .Y 1>
<COND (<SET TMP
<INTBL? <GET .FKEY 0>
<REST ,FNAMES 2>
<GET ,FNAMES 0>>>
<COND (.INV? <HLIGHT ,H-NORMAL>)
(ELSE <HLIGHT ,H-INVERSE>)>
<TELL <GET .TMP 1>>
<HLIGHT ,H-NORMAL>
<TELL " ">
<COND (.INV? <HLIGHT ,H-INVERSE>)
(ELSE <HLIGHT ,H-NORMAL>)>)>
<SET FDEF <REST .FDEF 2>> ;"get past header bytes"
<COND (.N ;"any definition?"
<SET M <- .N 1>>
<COND (<EQUAL? <GETB .FDEF .M> 13> ;"last character CR?"
<PRINTT .FDEF .M>
<PRINTC !\|>
<SET FDEF <REST .FDEF .N>>
<SET S <- .S .N>>)>)>
<PRINTT .FDEF .S>
<COND (<NOT .INV?>
<CCURSET .Y <+ .N 5>>)>)>
<HLIGHT ,H-NORMAL>>
<ROUTINE SOFT-RESET-DEFAULTS ("AUX" K L KEYS DEF KL TMP)
<SET KL <GET ,FKEYS 0>>
<SET DEF ,DEFAULT-FKEYS>
<REPEAT ()
<SET K <GETB .DEF 0>>
<COND (<ZERO? .K> <RETURN>)>
<SET DEF <REST .DEF>>
<SET L <+ 1 <GETB .DEF 0>>>
<COND (<SET KEYS <INTBL? .K <REST ,FKEYS 2> .KL>>
<SET KEYS <GET .KEYS 1>>
<SET TMP <REST .KEYS>>
<PUTB .TMP 0 !\ >
<COPYT .TMP <REST .TMP> <- <GETB .KEYS 0>>>
<COPYT .DEF <REST .KEYS> .L>)>
<SET DEF <REST .DEF .L>>>
<RFALSE>>
<CONSTANT DEFS-NAME <LTABLE (STRING) "DEFS">>
<ROUTINE SOFT-SAVE-DEFS ()
<CLEAR 0>
<SCREEN 0>
<COND (<NOT <SAVE ,FKEY-TBL
,FKEYS-STRTABLE-LEN
,DEFS-NAME>>
<TELL "Failed.">)>
<CLEAR 0>
<SCREEN ,SOFT-WINDOW>
<RFALSE>>
<ROUTINE SOFT-RESTORE-DEFS ()
<CLEAR 0>
<SCREEN 0>
<COND (<NOT <RESTORE ,FKEY-TBL ,FKEYS-STRTABLE-LEN ,DEFS-NAME>>
<TELL "Failed.">)>
<CLEAR 0>
<SCREEN ,SOFT-WINDOW>
<RFALSE>>
<ROUTINE SOFT-EXIT ()
<RTRUE>>
<CONSTANT FLEN 30> ;"max length of a key definition"
<CONSTANT SOFT-WINDOW 2> ;"window to use for defining"
"table containing string definitions for each function key.
contiguous so it can be written out or read in."
<SOFT-KEYS ,UP-ARROW "n "
,DOWN-ARROW "s "
,LEFT-ARROW "w "
,RIGHT-ARROW "e "
;"vt100 keypad keys"
,F1 "take "
,F2 "take all "
,F3 "drop "
,F4 "look around "
,F5 "inventory "
,F6 "unlock door "
,F7 "jester, "
,F8 "give magic locket to moose "
,F9 "read about "
,F10 "examine "
-4 <TABLE "Save Defs" SOFT-SAVE-DEFS>
-5 <TABLE "Restore Defs" SOFT-RESTORE-DEFS>
-6 <TABLE "Reset Defaults" SOFT-RESET-DEFAULTS>
-2 <TABLE "Exit" SOFT-EXIT>>
;<CONSTANT FKEYS-STRTABLE-LEN <* 14 <+ ,FLEN 2>>>
;<CONSTANT MTBL <ITABLE 4 0>>
;<CONSTANT SOFT-TOP 3>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<ROUTINE Y? ("AUX" X)
<REPEAT ()
<COND (,DEMO-VERSION?
<SET X <INPUT-DEMO 1>>)
(T
<SET X <INPUT 1>>)>
;<MOUSE-INPUT?>
<COND (<EQUAL? .X !\Y !\y ,CLICK1 ,CLICK2>
<SET X T>
<RETURN>)
(<EQUAL? .X !\N !\n>
<SET X <>>
<RETURN>)
(T
<TELL CR "[Please type Y or N] >">)>>
<CRLF>
<RETURN .X>>
<ROUTINE BLINK (PIC1 PIC2 Y X SCR "AUX" CHAR LAST (CNT 0))
<SCREEN .SCR>
<DISPLAY .PIC2 .Y .X>
<SCREEN ,S-TEXT>
<SET LAST .PIC2>
<REPEAT ()
<SETG TYPED-TIMED-OUT <>>
<SET CHAR <INPUT 1 3 ;"three-tenths of a second" ,TYPED?>>
<MOUSE-INPUT?>
<COND (,TYPED-TIMED-OUT
<SCREEN .SCR>
<DISPLAY <COND (<EQUAL? .LAST .PIC1>
<SET LAST .PIC2>
.PIC2)
(T
<SET LAST .PIC1>
.PIC1)> .Y .X>
<SET CNT <+ .CNT 1>>
<COND (<AND <EQUAL? .CNT 4>
,ROSE-NEEDS-UPDATING
<EQUAL? ,CURRENT-SPLIT ,MAP-TOP-LEFT-LOC>>
<UPDATE-MAP-ROSE>)>
<SCREEN ,S-TEXT>)
(T
<COND (<EQUAL? .LAST .PIC2> ;"leave unhighlited pic up"
<SCREEN .SCR>
<DISPLAY .PIC1 .Y .X>
<SCREEN ,S-TEXT>)>
<RETURN .CHAR>)>>>
<GLOBAL TYPED-TIMED-OUT <>>
<ROUTINE TYPED? ()
<SETG TYPED-TIMED-OUT T>
<RTRUE>>
<ROUTINE PICINF-PLUS-ONE (PIC)
<PICINF .PIC ,PICINF-TBL>
<PUT ,PICINF-TBL 0 <+ <GET ,PICINF-TBL 0> 1>>
<PUT ,PICINF-TBL 1 <+ <GET ,PICINF-TBL 1> 1>>>
<GLOBAL MOUSE-LOC-X <>> ;"X-coordinate of most recent mouse click"
<GLOBAL MOUSE-LOC-Y <>> ;"Y-coordinate of most recent mouse click"
<ROUTINE MOUSE-INPUT? ()
<SETG MOUSE-LOC-X <LOWCORE MSLOCX>>
<SETG MOUSE-LOC-Y <LOWCORE MSLOCY>>>
;<CONSTANT CENTER-TABLE <ITABLE 80 <BYTE 0>>>
;<ROUTINE PRINT-CENTER-TABLE ()
<DIROUT ,D-TABLE-OFF>
<CURSET <WINGET -3 ,WYPOS>
<+ </ <- <WINGET -3 ,WWIDE>
<LOWCORE TWID>>
2>
1>>
<PRINTT <REST ,CENTER-TABLE 2> <GET ,CENTER-TABLE 0>>>
<END-SEGMENT>

222
jester.zabstr Normal file
View File

@ -0,0 +1,222 @@
<BEGIN-SEGMENT 0>
<OBJECT JESTER (DESC "jester") (DESCFCN JESTER-F) (SYNONYM JESTER JESTERS JOKER
MAN) (FLAGS ACTORBIT SEARCHBIT CONTBIT OPENBIT ANIMATEDBIT) (ACTION JESTER-F)>
<DEFINE-ROUTINE JESTER-F>
<BEGIN-SEGMENT CASTLE>
<DEFINE-ROUTINE J-ENTRY>
<GLOBAL MID-NAME-NUM <>>
<CONSTANT MID-NAMES <PTABLE "Hideoz" "Bivotar" "Urgwitz" "Foofoonap" "Elderbar"
"Goozums" "Syovar" "Buck" "Spike" "Zippy" "Magglebar" "Barfoo">>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<CONSTANT MID-NAME-WORDS <PTABLE <VOC "HIDEOZ" NOUN> <VOC "BIVOTAR" NOUN> <VOC
"URGWITZ" NOUN> <VOC "FOOFOONAP" NOUN> <VOC "ELDERBAR" NOUN> <VOC "GOOZUMS"
NOUN> <VOC "SYOVAR" NOUN> <VOC "BUCK" NOUN> <VOC "SPIKE" NOUN> <VOC "ZIPPY"
NOUN> <VOC "MAGGLEBAR" NOUN> <VOC "BARFOO" NOUN>>>
<OBJECT MID-NAME (LOC GLOBAL-OBJECTS) (DESC "middle name") (SYNONYM HIDEOZ
BIVOTAR URGWITZ FOOFOONAP ELDERBAR GOOZUMS SYOVAR BUCK SPIKE ZIPPY MAGGLEBAR
BARFOO) (ACTION MID-NAME-F)>
<DEFINE-ROUTINE MID-NAME-F>
<OBJECT OTHER-J-NAMES (LOC GLOBAL-OBJECTS) (DESC "jester's name") (SYNONYM
BARBAZZO FERNAP) (ACTION OTHER-J-NAMES-F)>
<DEFINE-ROUTINE OTHER-J-NAMES-F>
<OBJECT J-POCKET (LOC JESTER) (DESC "jester's pocket") (SYNONYM POCKET) (
ADJECTIVE HIS JESTER\'S) (OWNER JESTER) (FLAGS NDESCBIT) (ACTION J-GARMENT-F)>
<OBJECT J-HAT (LOC JESTER) (DESC "jester's hat") (SYNONYM HAT BELL BELLS) (
ADJECTIVE HIS JESTER\'S SMALL GAUDY) (OWNER JESTER) (FLAGS NDESCBIT) (GENERIC
G-HAT-F) (ACTION J-GARMENT-F)>
<OBJECT J-SHOE (LOC JESTER) (DESC "jester's shoe") (SYNONYM SHOE) (ADJECTIVE
HIS JESTER\'S) (OWNER JESTER) (FLAGS NDESCBIT) (ACTION J-GARMENT-F)>
<DEFINE-ROUTINE J-GARMENT-F>
<OBJECT J-SUIT (LOC JESTER) (DESC "jester's suit") (SYNONYM SUIT) (ADJECTIVE
GREEN SKIN-TIGHT) (OWNER JESTER) (FLAGS NDESCBIT)>
<DEFINE-ROUTINE I-JESTER>
<DEFINE-ROUTINE J-EXITS>
<DEFINE-ROUTINE BEYOND-LAKE?>
<GLOBAL J-APPEAR-PROB 0>
<GLOBAL DO-J <>>
<DEFINE-ROUTINE REMOVE-J>
<DEFINE-ROUTINE DONT-CRY>
<GLOBAL J-INQ-SCENE <>>
<GLOBAL J-ON-RAFT <>>
<GLOBAL FUNNY-PAPER-PROB 20>
<GLOBAL SLATE-PROB 33>
<GLOBAL SCROLL-PROB 33>
<GLOBAL GUESSES 0>
<GLOBAL ALLIGATOR <>>
<DEFINE-ROUTINE I-UNALLIGATOR>
<GLOBAL SUFFOCATE-COUNTER 0>
<DEFINE-ROUTINE I-SUFFOCATE>
<DEFINE-ROUTINE I-FUNNY-PAPER>
<DEFINE-ROUTINE I-REMOVE-FUNNY-PAPER>
<OBJECT FUNNY-PAPER (LOC LOCAL-GLOBALS) (DESC "funny paper") (SYNONYM PAPER
PIECE NEWSPAPER COMICS) (ADJECTIVE COLORFUL FUNNY) (FLAGS TAKEBIT BURNBIT
READBIT) (SIZE 2) (ACTION FUNNY-PAPER-F)>
<DEFINE-ROUTINE FUNNY-PAPER-F>
<OBJECT BEDBUG (DESC "giant bedbug") (SYNONYM BUG BEDBUG) (ADJECTIVE LARGE BED)
(ACTION BEDBUG-F)>
<DEFINE-ROUTINE BEDBUG-F>
<OBJECT CLOWN-NOSE (DESC "red clown nose") (SYNONYM NOSE) (ADJECTIVE RED CLOWN)
(FLAGS WEARBIT TAKEBIT) (SIZE 2) (ACTION CLOWN-NOSE-F)>
<DEFINE-ROUTINE CLOWN-NOSE-F>
<OBJECT SLATE (LOC LOCAL-GLOBALS) (DESC "dusty slate") (SYNONYM SLATE) (
ADJECTIVE DUSTY SMALL SILLY OLD) (FLAGS READBIT TAKEBIT) (ACTION SLATE-F)>
<GLOBAL STUMP-X 0>
<GLOBAL STUMP-Y 0>
<DEFINE-ROUTINE SLATE-F>
<OBJECT SCROLL (LOC LOCAL-GLOBALS) (DESC "scroll") (SYNONYM SCROLL PAPER) (
FLAGS READBIT TAKEBIT BURNBIT) (SIZE 2) (ACTION SCROLL-F)>
<DEFINE-ROUTINE SCROLL-F>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT SHELL-TABLE (DESC "small table") (SYNONYM TABLE) (ADJECTIVE SMALL) (
FLAGS SURFACEBIT CONTBIT OPENBIT SEARCHBIT)>
<OBJECT LEFT-SHELL (LOC SHELL-TABLE) (DESC "left shell") (SYNONYM SHELL) (
ADJECTIVE LEFT FIRST) (ACTION SHELL-F)>
<OBJECT CENTER-SHELL (LOC SHELL-TABLE) (DESC "center shell") (SYNONYM SHELL) (
ADJECTIVE CENTER MIDDLE SECOND) (ACTION SHELL-F)>
<OBJECT RIGHT-SHELL (LOC SHELL-TABLE) (DESC "right shell") (SYNONYM SHELL) (
ADJECTIVE RIGHT THIRD) (ACTION SHELL-F)>
<DEFINE-ROUTINE SHELL-F>
<DEFINE-ROUTINE ANOTHER-SHELL-GAME>
<DEFINE-ROUTINE SEE-BILL?>
<OBJECT ZORKMID-BILL (LOC LOCAL-GLOBALS) (DESC "zorkmid bill") (SYNONYM BILL
MONEY) (ADJECTIVE ZORKMID) (FLAGS TAKEBIT BURNBIT READBIT MAGICBIT) (SIZE 1) (
VALUE 0) (TEXT "The denomination of the bill is 100,000 zorkmids. Only one such bill
was ever printed, and that was at the personal request of J. Pierpont
Flathead.")>
<ROOM JESTERS-QUARTERS (LOC ROOMS) (REGION "Flatheadia") (DESC
"Jester's Quarters") (DOWN TO SERVANTS-QUARTERS) (OUT TO SERVANTS-QUARTERS) (
NORTH TO WEIRD IF LARGE-DOOR IS OPEN) (SOUTH PER SMALL-DOOR-ENTER-F) (FLAGS
RLANDBIT) (SYNONYM QUARTERS) (OWNER JESTER) (GLOBAL STAIRS LARGE-DOOR
SMALL-DOOR) (MAP-LOC <PTABLE MAIN-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-10>) (ICON
J-QUARTER-ICON) (ACTION JESTERS-QUARTERS-F)>
<DEFINE-ROUTINE JESTERS-QUARTERS-F>
<DEFINE-ROUTINE SMALL-DOOR-ENTER-F>
<OBJECT LARGE-DOOR (LOC LOCAL-GLOBALS) (DESC "large arched door") (SYNONYM DOOR
) (ADJECTIVE LARGE ARCHED) (FLAGS DOORBIT) (GENERIC G-J-DOOR-F) (ACTION
LARGE-DOOR-F)>
<DEFINE-ROUTINE LARGE-DOOR-F>
<DEFINE-ROUTINE G-J-DOOR-F>
<OBJECT SMALL-DOOR (LOC LOCAL-GLOBALS) (DESC "small louvered door") (SYNONYM
DOOR) (ADJECTIVE SMALL SOUTH LOUVERED) (FLAGS NDESCBIT) (GENERIC G-J-DOOR-F) (
ACTION SMALL-DOOR-F)>
<DEFINE-ROUTINE SMALL-DOOR-F>
<OBJECT T-OF-B (OWNER T-OF-B) (DESC "Tower of Bozbar") (SYNONYM TOWER BOZBAR) (
FLAGS CONTBIT OPENBIT SEARCHBIT) (RESEARCH
"The Tower of Bozbar, an ancient game of unknown origin, consists of three pegs
and a pile of weights. The goal is to move the pile from one peg to another,
moving one weight at a time, with the constraint that no weight can ever be
placed atop a smaller weight. Many people say that the Tower of Bozbar is a
superb method of mental relaxation. [Obviously, none of these people have ever
played Zork Zero.]")>
<OBJECT LEFT-PEG (LOC T-OF-B) (DESC "left peg") (SYNONYM PEG POST) (ADJECTIVE
FIRST LEFT) (FLAGS NDESCBIT CONTBIT OPENBIT SEARCHBIT)>
<OBJECT CENTER-PEG (LOC T-OF-B) (DESC "center peg") (SYNONYM PEG POST) (
ADJECTIVE SECOND CENTER MIDDLE) (FLAGS NDESCBIT CONTBIT OPENBIT SEARCHBIT)>
<OBJECT RIGHT-PEG (LOC T-OF-B) (DESC "right peg") (SYNONYM PEG POST) (ADJECTIVE
THIRD RIGHT) (FLAGS NDESCBIT CONTBIT OPENBIT SEARCHBIT)>
<OBJECT 1-WEIGHT (LOC CENTER-PEG) (DESC "1-ugh weight") (SYNONYM WEIGHT) (
ADJECTIVE 1-UGH) (FLAGS NDESCBIT) (SIZE 1) (ACTION WEIGHT-F)>
<OBJECT 2-WEIGHT (LOC CENTER-PEG) (DESC "2-ugh weight") (SYNONYM WEIGHT) (
ADJECTIVE 2-UGH) (FLAGS NDESCBIT) (SIZE 2) (ACTION WEIGHT-F)>
<OBJECT 3-WEIGHT (LOC CENTER-PEG) (DESC "3-ugh weight") (SYNONYM WEIGHT) (
ADJECTIVE 3-UGH) (FLAGS NDESCBIT) (SIZE 3) (ACTION WEIGHT-F)>
<OBJECT 4-WEIGHT (LOC CENTER-PEG) (DESC "4-ugh weight") (SYNONYM WEIGHT) (
ADJECTIVE 4-UGH) (FLAGS NDESCBIT) (SIZE 4) (ACTION WEIGHT-F)>
<OBJECT 5-WEIGHT (LOC CENTER-PEG) (DESC "5-ugh weight") (SYNONYM WEIGHT) (
ADJECTIVE 5-UGH) (FLAGS NDESCBIT) (SIZE 5) (ACTION WEIGHT-F)>
<OBJECT 6-WEIGHT (LOC CENTER-PEG) (DESC "6-ugh weight") (SYNONYM WEIGHT) (
ADJECTIVE 6-UGH) (FLAGS NDESCBIT) (SIZE 6) (ACTION WEIGHT-F)>
<DEFINE-ROUTINE WEIGHT-F>
<GLOBAL TOWER-BEATEN <>>
<GLOBAL TOWER-CHANGED <>>
<DEFINE-ROUTINE TOWER-MODE>
<DEFINE-ROUTINE B-MOUSE-PEG-PICK>
<DEFINE-ROUTINE B-MOUSE-WEIGHT-PICK>
<DEFINE-ROUTINE TOWER-WIN-CHECK>
<DEFINE-ROUTINE SET-PEG-TABLE>
<DEFINE-ROUTINE NOT-TOP-WEIGHT>
<DEFINE-ROUTINE MOVE-WEIGHT>
<DEFINE-ROUTINE CRUSH-WEIGHT>
<DEFINE-ROUTINE B-SAVE>
<DEFINE-ROUTINE B-RESTORE>
<CONSTANT B-X-TBL <TABLE <> <> <>>>
<CONSTANT B-Y-TBL <TABLE <> <> <> <> <> <>>>
<CONSTANT TOWER-UNDO-TABLE <TABLE 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0>>
<CONSTANT LEFT-PEG-TABLE <TABLE 0 0 0 0 0 0>>
<CONSTANT CENTER-PEG-TABLE <TABLE 6-WEIGHT 5-WEIGHT 4-WEIGHT 3-WEIGHT 2-WEIGHT
1-WEIGHT>>
<CONSTANT RIGHT-PEG-TABLE <TABLE 0 0 0 0 0 0>>
<CONSTANT B-PICSET-TBL <TABLE B-RESTORE-PEG 1-WEIGHT 2-WEIGHT 3-WEIGHT 4-WEIGHT
5-WEIGHT 6-WEIGHT 0>>
<DEFINE-ROUTINE DRAW-TOWER>
<DEFINE-ROUTINE DRAW-PEG>
<DEFINE-ROUTINE SET-B-PIC>
<ROOM WEIRD (LOC ROOMS) (REGION "Flatheadia") (DESC "Weird Passageway") (SOUTH
TO JESTERS-QUARTERS IF LARGE-DOOR IS OPEN) (NORTH PER WEIRD-EXIT-F) (WEST PER
WEIRD-EXIT-F) (EAST PER WEIRD-EXIT-F) (FLAGS RLANDBIT) (GLOBAL LARGE-DOOR) (
MAP-LOC <PTABLE MAIN-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-10>) (ACTION WEIRD-F)>
<DEFINE-ROUTINE WEIRD-EXIT-F>
<DEFINE-ROUTINE WEIRD-ENTER-F>
<DEFINE-ROUTINE WEIRD-F>
<ROOM PYRAMID (LOC ROOMS) (REGION "Flatheadia") (DESC "Pyramid Room") (SOUTH
PER WEIRD-ENTER-F) (OUT PER WEIRD-ENTER-F) (FLAGS RLANDBIT) (VALUE 7) (MAP-LOC
<PTABLE MAIN-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-10>) (ICON PYRAMID-ICON) (ACTION
PYRAMID-F)>
<BEGIN-SEGMENT 0>
<OBJECT GOGGLES (LOC PYRAMID) (OWNER GOGGLES) (DESC "pair of goggles") (PLURAL
"goggles") (SYNONYM GOGGLES PAIR ETCHING) (FLAGS PLURALBIT TAKEBIT WEARBIT
TRANSBIT) (ACTION GOGGLES-F)>
<DEFINE-ROUTINE GOGGLES-F>
<DEFINE-ROUTINE DISCOVER-X-RAY>
<GLOBAL DONT-KNOW-ABOUT-XRAY T>
<OBJECT CRATE (LOC PYRAMID) (DESC "crate") (LDESC
"Sitting in the corner is a wooden shipping crate with some writing
stencilled across the top.") (SYNONYM CRATE WRITING) (ADJECTIVE WOODEN SHIPPING
STENCILLED) (FLAGS READBIT BURNBIT CONTBIT SEARCHBIT TAKEBIT) (CAPACITY 100) (
OWNER CRATE) (SIZE 80) (TEXT
"\"1000 Clown Noses, Red|
Frobozz Magic Clown Nose Company\"")>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<ROOM PYRAMID-R (LOC ROOMS) (REGION "Flatheadia") (DESC "Pyramid Room") (WEST
PER WEIRD-ENTER-F) (OUT PER WEIRD-ENTER-F) (FLAGS RLANDBIT) (VALUE 7) (MAP-LOC
<PTABLE MAIN-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-11>) (ICON PYRAMID-ICON) (ACTION
PYRAMID-F)>
<OBJECT MANUSCRIPT (LOC PYRAMID-R) (DESC "manuscript") (SYNONYM MANUSCRIPT) (
FLAGS READBIT TAKEBIT BURNBIT MAGICBIT) (VALUE 12) (TEXT
"The manuscript is entitled \"On the Discoloration of Roadside Slush.\" You
try reading it, but keep dozing off on the third or fourth word.")>
<ROOM PYRAMID-L (LOC ROOMS) (REGION "Flatheadia") (DESC "Pyramid Room") (EAST
PER WEIRD-ENTER-F) (OUT PER WEIRD-ENTER-F) (FLAGS RLANDBIT) (VALUE 7) (MAP-LOC
<PTABLE MAIN-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-9>) (ICON PYRAMID-ICON) (ACTION
PYRAMID-F)>
<DEFINE-ROUTINE PYRAMID-F>
<BEGIN-SEGMENT 0>
<OBJECT CUP (LOC PYRAMID-L) (DESC "cup") (SYNONYM CUP) (FLAGS TAKEBIT CONTBIT
SEARCHBIT OPENBIT) (ACTION CUP-F)>
<DEFINE-ROUTINE CUP-F>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT POTION (LOC CUP) (DESC "magic potion") (SYNONYM POTION POTIONS LIQUID)
(ADJECTIVE MAGIC YELLOW-GREEN) (FLAGS NARTICLEBIT) (RESEARCH
"\"Potions are the most accessible form of magic for the masses, since
they are simply drunk like water. No lessons in complicated spell-casting
are required.\"") (ACTION POTION-F)>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<GLOBAL POTION-GULPS 4>
<GLOBAL PLANT-TALKER <>>
<DEFINE-ROUTINE POTION-F>
<DEFINE-ROUTINE I-POTION>
<DEFINE-ROUTINE PLANT-STUNNED>
<END-SEGMENT>
<BEGIN-SEGMENT FENSHIRE>
<OBJECT COOKPOT (DESC "cookpot") (SYNONYM COOKPOT POT) (FLAGS CONTBIT OPENBIT
SEARCHBIT) (CAPACITY 50) (ACTION COOKPOT-F)>
<DEFINE-ROUTINE COOKPOT-F>
<OBJECT COOKFIRE (DESC "cookfire") (SYNONYM COOKFIRE FIRE) (FLAGS FLAMEBIT)>
<END-SEGMENT>

1467
jester.zap Normal file
View File

File diff suppressed because it is too large Load Diff

1836
jester.zil Normal file
View File

File diff suppressed because it is too large Load Diff

452
lake.zabstr Normal file
View File

@ -0,0 +1,452 @@
<BEGIN-SEGMENT LAKE>
<ROOM WEST-SHORE (LOC ROOMS) (DESC "West Shore") (REGION "Flatheadia") (EAST
SORRY "These waters are known for their hungry denizens.") (WEST TO ROYAL-ZOO)
(FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (GLOBAL LAKE-FLATHEAD STAIRS) (MAP-LOC <
PTABLE LAKE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-3>) (ICON WEST-SHORE-ICON) (ACTION
WEST-SHORE-F)>
<DEFINE-ROUTINE WEST-SHORE-F>
<OBJECT WEST-DOCK (LOC WEST-SHORE) (DESC "yellow dock") (SYNONYM DOCK) (
ADJECTIVE YELLOW WEST) (CAPACITY 200) (FLAGS NDESCBIT VEHBIT DROPBIT OPENBIT
SEARCHBIT CONTBIT SURFACEBIT) (ACTION DOCK-F)>
<ROOM NORTH-SHORE (LOC ROOMS) (DESC "North Shore") (REGION "Flatheadia") (SOUTH
SORRY "These waters are known for their hungry denizens.") (NORTH TO PHIL-HALL)
(NE TO THEATRE) (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (GLOBAL LAKE-FLATHEAD
STAIRS) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-4>) (ICON
NORTH-SHORE-ICON) (ACTION NORTH-SHORE-F)>
<DEFINE-ROUTINE NORTH-SHORE-F>
<OBJECT NORTH-DOCK (LOC NORTH-SHORE) (DESC "red dock") (SYNONYM DOCK) (
ADJECTIVE RED NORTH) (CAPACITY 200) (FLAGS NDESCBIT VEHBIT DROPBIT OPENBIT
SEARCHBIT CONTBIT SURFACEBIT) (ACTION DOCK-F)>
<ROOM EAST-SHORE (LOC ROOMS) (REGION "Flatheadia") (DESC "East Shore") (WEST
SORRY "These waters are known for their hungry denizens.") (EAST TO
BASE-OF-MOUNTAIN) (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (GLOBAL LAKE-FLATHEAD
STAIRS G-U-MOUNTAIN) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-5>) (
ICON EAST-SHORE-ICON) (ACTION EAST-SHORE-F)>
<DEFINE-ROUTINE EAST-SHORE-F>
<OBJECT EAST-DOCK (LOC EAST-SHORE) (DESC "blue dock") (SYNONYM DOCK) (ADJECTIVE
BLUE EAST) (CAPACITY 200) (FLAGS NDESCBIT VEHBIT DROPBIT OPENBIT SEARCHBIT
CONTBIT SURFACEBIT) (ACTION DOCK-F)>
<ROOM SOUTH-SHORE (LOC ROOMS) (DESC "South Shore") (REGION "Flatheadia") (NORTH
SORRY "These waters are known for their hungry denizens.") (SOUTH TO
EDGE-OF-DESERT) (WEST TO STREAM) (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (GLOBAL
LAKE-FLATHEAD STAIRS) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-4>) (
ICON SOUTH-SHORE-ICON) (ACTION SOUTH-SHORE-F)>
<DEFINE-ROUTINE SOUTH-SHORE-F>
<OBJECT SOUTH-DOCK (LOC SOUTH-SHORE) (DESC "green dock") (SYNONYM DOCK) (
ADJECTIVE GREEN SOUTH) (CAPACITY 200) (FLAGS NDESCBIT VEHBIT DROPBIT OPENBIT
SEARCHBIT CONTBIT SURFACEBIT) (ACTION DOCK-F)>
<DEFINE-ROUTINE DOCK-F>
<OBJECT YACHT (LOC WEST-SHORE) (DESC "royal yacht") (LDESC
"The royal yacht sits by the dock, bobbing gently in the swell of the lake.") (
SYNONYM YACHT BOAT) (ADJECTIVE ROYAL) (CAPACITY 200) (FLAGS VEHBIT DROPBIT
OPENBIT SEARCHBIT CONTBIT SURFACEBIT) (ACTION YACHT-F)>
<DEFINE-ROUTINE YACHT-F>
<OBJECT YACHT-CONTROLS (LOC YACHT) (DESC "controls") (SYNONYM CONTROL CONTROLS
ROSE COMPASS) (ADJECTIVE COMPASS) (FLAGS NDESCBIT NARTICLEBIT PLURALBIT) (
ACTION YACHT-CONTROLS-F)>
<DEFINE-ROUTINE YACHT-CONTROLS-F>
<OBJECT YACHT-PLAQUE (LOC YACHT) (DESC "brass plaque") (SYNONYM PLAQUE) (
ADJECTIVE SMALL BRASS) (FLAGS READBIT NDESCBIT) (TEXT
"\"Made by the Frobozz Magic Royal Yacht Company.\"")>
<OBJECT RED-BUTTON (LOC YACHT) (DESC "red button") (SYNONYM BUTTON) (ADJECTIVE
RED) (FLAGS NDESCBIT) (ACTION YACHT-BUTTON-F)>
<OBJECT BLUE-BUTTON (LOC YACHT) (DESC "blue button") (SYNONYM BUTTON) (
ADJECTIVE BLUE) (FLAGS NDESCBIT) (ACTION YACHT-BUTTON-F)>
<OBJECT GREEN-BUTTON (LOC YACHT) (DESC "green button") (SYNONYM BUTTON) (
ADJECTIVE GREEN) (FLAGS NDESCBIT) (ACTION YACHT-BUTTON-F)>
<OBJECT YELLOW-BUTTON (LOC YACHT) (DESC "yellow button") (SYNONYM BUTTON) (
ADJECTIVE YELLOW) (FLAGS NDESCBIT) (ACTION YACHT-BUTTON-F)>
<OBJECT WHITE-BUTTON (LOC YACHT) (DESC "white button") (SYNONYM BUTTON) (
ADJECTIVE WHITE FIFTH CENTER MIDDLE) (FLAGS NDESCBIT) (ACTION YACHT-BUTTON-F)>
<DEFINE-ROUTINE YACHT-BUTTON-F>
<GLOBAL YACHT-DESTINATION <>>
<DEFINE-ROUTINE I-YACHT>
<ROOM HOLD (LOC ROOMS) (REGION "Flatheadia") (DESC "Hold") (LDESC
"You are in a cabin under the deck of the royal yacht. A steep gangway leads
upward.") (UP PER YACHT-ENTER-F) (IN PER DB-ENTER-F) (FLAGS RLANDBIT
UNDERGROUNDBIT) (GLOBAL STAIRS) (SYNONYM HOLD) (MAP-LOC <PTABLE LAKE-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-1>) (ICON HOLD-ICON)>
<DEFINE-ROUTINE YACHT-ENTER-F>
<DEFINE-ROUTINE DB-ENTER-F>
<OBJECT DB (LOC HOLD) (DESC "bathysphere") (SYNONYM SPHERE BATHYSPHERE DOOR
HATCH BELL) (ADJECTIVE DIVING) (CAPACITY 200) (FLAGS VEHBIT INBIT DROPBIT
CONTBIT SEARCHBIT TRANSBIT) (ACTION DB-F)>
<GLOBAL DB-CONTROLS-DESCRIBED <>>
<DEFINE-ROUTINE DB-F>
<OBJECT DB-CONTROLS (LOC DB) (DESC "controls") (SYNONYM CONTROL CONTROLS) (
FLAGS NDESCBIT NARTICLEBIT PLURALBIT) (GENERIC G-DB-HOLE-F) (ACTION
DB-CONTROLS-F)>
<DEFINE-ROUTINE DB-CONTROLS-F>
<OBJECT DB-PLAQUE (LOC DB) (DESC "brass plaque") (SYNONYM PLAQUE) (ADJECTIVE
SMALL BRASS) (FLAGS READBIT NDESCBIT) (TEXT
"\"A product of the Frobozz Magic Bathysphere Company, designed by
Jacques Yves Flathead.\"")>
<DEFINE-ROUTINE G-DB-HOLE-F>
<OBJECT PORTHOLE (LOC DB) (DESC "porthole") (SYNONYM PORTHOLE PORT HOLE) (
ADJECTIVE PORT) (FLAGS NDESCBIT) (GENERIC G-DB-HOLE-F) (ACTION PORTHOLE-F)>
<DEFINE-ROUTINE PORTHOLE-F>
<OBJECT RUBY (LOC LAKE-BOTTOM) (DESC "moby ruby") (PLURAL "rubies") (FDESC
"A ruby of incredible size and beauty is buried in the sand.") (SYNONYM RUBY
JEWEL) (ADJECTIVE RED MOBY LARGE BEAUTIFUL) (FLAGS TRYTAKEBIT TAKEBIT READBIT)
(VALUE 25) (SIZE 3) (TEXT
"This ruby must surely be the largest jewel in the land.")>
<OBJECT EXTERIOR-LIGHT (LOC DB) (DESC "exterior light") (SYNONYM LIGHT LIGHTS)
(ADJECTIVE EXTERIOR) (FLAGS LIGHTBIT NDESCBIT VOWELBIT)>
<OBJECT WALDO (LOC HOLD) (DESC "waldo") (SYNONYM WALDO) (ADJECTIVE EXTERIOR) (
FLAGS NDESCBIT CONTBIT SEARCHBIT OPENBIT) (ACTION WALDO-F)>
<DEFINE-ROUTINE WALDO-F>
<GLOBAL HAND-IN-WALDO <>>
<OBJECT HAND-HOLE (LOC DB) (DESC "hand-hole") (SYNONYM HOLE HAND-HOLE CONTROL)
(ADJECTIVE HAND WALDO) (FLAGS NDESCBIT) (GENERIC G-DB-HOLE-F) (ACTION
HAND-HOLE-F)>
<DEFINE-ROUTINE HAND-HOLE-F>
<DEFINE-ROUTINE WALDO-TAKE>
<OBJECT LEVER (LOC DB) (DESC "up-down lever") (SYNONYM LEVER) (ADJECTIVE
UP-DOWN) (FLAGS NDESCBIT VOWELBIT) (ACTION LEVER-F)>
<GLOBAL DB-DIRECTION 0>
<GLOBAL DB-DEPTH 0>
<GLOBAL PIECE-DROWNED 0>
<DEFINE-ROUTINE LEVER-F>
<DEFINE-ROUTINE GLANCE>
<DEFINE-ROUTINE I-DB>
<ROOM LAKE-FLATHEAD (LOC ROOMS) (REGION "Flatheadia") (DESC "Lake Flathead") (
LDESC "You are in the center of a once-handsome lake, lit from the roof high
overhead. On the distant shores, you can spot docks in all four
cardinal directions.") (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT NARTICLEBIT
WATERBIT) (SYNONYM LAKE FLATHEAD) (ADJECTIVE FLATHEAD LAKE PLACID CLEAR CRYSTAL
) (VALUE 18) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-4>) (GLOBAL
STAIRS) (ICON LAKE-FLATHEAD-ICON) (RESEARCH
"\"This large and handsome lake lies entirely within the royal castle at
Flatheadia.\"") (ACTION LAKE-FLATHEAD-F)>
<DEFINE-ROUTINE LAKE-FLATHEAD-F>
<ROOM UNDERWATER (LOC ROOMS) (REGION "Flatheadia") (DESC "Underwater") (LDESC
"Here, between the surface and floor of Lake Flathead, the water is somewhat
clearer.") (FLAGS RLANDBIT UNDERGROUNDBIT) (GLOBAL LAKE-FLATHEAD) (MAP-LOC <
PTABLE LAKE-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-1>) (ICON UNDERWATER-ICON)>
<ROOM LAKE-BOTTOM (LOC ROOMS) (REGION "Flatheadia") (DESC "Lake Bottom") (LDESC
"You have reached the sandy bottom at the deepest point of Lake Flathead.
Beautiful freshwater fish swim among slowly waving spenseweeds.") (FLAGS
RLANDBIT UNDERGROUNDBIT) (GLOBAL LAKE-FLATHEAD) (MAP-LOC <PTABLE LAKE-MAP-NUM
MAP-GEN-Y-7 MAP-GEN-X-1>) (ICON LAKE-BOTTOM-ICON) (ACTION LAKE-BOTTOM-F)>
<DEFINE-ROUTINE LAKE-BOTTOM-F>
<OBJECT LAKE-BOTTOM-FISH (LOC LAKE-BOTTOM) (DESC "freshwater fish") (SYNONYM
FISH) (ADJECTIVE BEAUTIFUL FRESHWATER) (FLAGS NDESCBIT) (ACTION
LAKE-BOTTOM-FISH-F)>
<DEFINE-ROUTINE LAKE-BOTTOM-FISH-F>
<ROOM BASE-OF-MOUNTAIN (LOC ROOMS) (REGION "Flatheadia") (DESC
"Base of Mountain") (LDESC
"In a rare moment of restraint, Dimwit scaled back his plans for putting
an entire mountain range in the castle, settling for merely a single mountain.
A difficult trail leads east up the mountain; easier paths head north, west,
and south.") (NORTH TO STABLE) (SOUTH TO G-U-WOODS) (WEST TO EAST-SHORE) (EAST
PER G-U-MOUNTAIN-ENTER-F) (UP PER G-U-MOUNTAIN-ENTER-F) (FLAGS RLANDBIT ONBIT
UNDERGROUNDBIT) (GLOBAL G-U-MOUNTAIN) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-5
MAP-GEN-X-6>) (ICON BASE-OF-MT-ICON)>
<DEFINE-ROUTINE G-U-MOUNTAIN-ENTER-F>
<ROOM STABLE (LOC ROOMS) (REGION "Flatheadia") (DESC "Stable") (LDESC
"The stalls here once held thousands of royal mounts. The only exit is south.")
(SOUTH TO BASE-OF-MOUNTAIN) (OUT TO BASE-OF-MOUNTAIN) (FLAGS RLANDBIT
UNDERGROUNDBIT) (SYNONYM STABLE) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-4
MAP-GEN-X-6>) (ICON STABLE-ICON) (THINGS <> STALL STALL-PS) (ACTION STABLE-F)>
<DEFINE-ROUTINE STABLE-F>
<DEFINE-ROUTINE STALL-PS>
<OBJECT SADDLE (LOC STABLE) (DESC "saddle") (FDESC
"A well-worn unicorn saddle, of military style, is hanging at the far
end of the stable.") (SYNONYM SADDLE) (ADJECTIVE WELL-WORN UNICORN MILITARY) (
FLAGS TAKEBIT MAGICBIT READBIT) (SIZE 15) (VALUE 12) (TEXT
"You can barely make out the name \"Wilma.\"") (ACTION SADDLE-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE SADDLE-F>
<OBJECT ROOSTER (LOC STABLE) (DESC "rooster") (FDESC
"There's not a horse in sight. However, there is a rooster here, strutting
back and forth between the stalls.") (SYNONYM ROOSTER BIRD VANE) (ADJECTIVE
WEATHER) (FLAGS TAKEBIT TRYTAKEBIT ANIMATEDBIT) (INANIMATE-DESC "weather vane")
(WAND-TEXT "The rooster stops moving and takes on the complexion of wrought iron."
) (ANIMATE-ROUTINE I-W-ROOSTER) (SIZE 10) (ACTION ROOSTER-F)>
<DEFINE-ROUTINE ROOSTER-F>
<DEFINE-ROUTINE I-W-ROOSTER>
<GLOBAL ROOSTER-PROB 100>
<GLOBAL ROOSTER-BURP <>>
<DEFINE-ROUTINE I-ROOSTER>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<ROOM G-U-MOUNTAIN (LOC ROOMS) (REGION "Flatheadia") (DESC
"Great Underground Mountain") (WEST TO BASE-OF-MOUNTAIN) (DOWN TO
BASE-OF-MOUNTAIN) (NORTH PER CAVE-ENTER-F) (IN PER CAVE-ENTER-F) (FLAGS
RLANDBIT ONBIT UNDERGROUNDBIT) (SYNONYM MOUNTAIN) (ADJECTIVE GREAT UNDERGROUND)
(RESEARCH "\"One of the many awe-inspiring features of Dimwit's castle in Flatheadia.\""
) (GLOBAL LAKE-FLATHEAD) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-7>
) (ICON G-U-MOUNTAIN-ICON) (ACTION G-U-MOUNTAIN-F)>
<DEFINE-ROUTINE G-U-MOUNTAIN-F>
<DEFINE-ROUTINE CAVE-ENTER-F>
<OBJECT BOULDER (LOC G-U-MOUNTAIN) (DESC "boulder") (SYNONYM BOULDER ROCK) (
ADJECTIVE LARGE) (FLAGS NDESCBIT) (ACTION BOULDER-F)>
<DEFINE-ROUTINE BOULDER-F>
<OBJECT CAVE-OBJECT (DESC "cave") (SYNONYM CAVE) (ADJECTIVE TINY) (FLAGS
NDESCBIT) (ACTION CAVE-OBJECT-F)>
<DEFINE-ROUTINE CAVE-OBJECT-F>
<ROOM GROTTO (LOC ROOMS) (REGION "Region: Unknown") (DESC "Grotto") (LDESC
"You are in a damp grotto near the peak of the Great Underground Mountain.
Slimy moss covers the irregular rock walls. Winding passages lead south and
northeast, and a steep gravelly passage leads downward at an alarming angle.")
(SOUTH TO G-U-MOUNTAIN) (NE TO SHRINE) (DOWN PER LOWEST-HALL-ENTER-F) (WEST PER
LOWEST-HALL-ENTER-F) (FLAGS RLANDBIT UNDERGROUNDBIT) (SYNONYM GROTTO) (MAP-LOC
<PTABLE LAKE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-7>)>
P
<OBJECT GROTTO-REBUS-BUTTON (LOC GROTTO) (SDESC "blinking key-shaped button") (
FDESC "Imbedded in the rocky wall is a blinking button in the shape of a key.")
(SYNONYM BUTTON) (ADJECTIVE KEY-SHAPED BLINKING) (ACTION REBUS-BUTTON-F)>
<DEFINE-ROUTINE LOWEST-HALL-ENTER-F>
<OBJECT GRAVEL (LOC LOCAL-GLOBALS) (DESC "gravel") (PLURAL "gravel") (SYNONYM
GRAVEL) (GENERIC G-GRAVEL-F) (FLAGS TAKEBIT NARTICLEBIT) (ACTION GRAVEL-F)>
<OBJECT MORE-GRAVEL (LOC LOCAL-GLOBALS) (DESC "more gravel") (PLURAL "gravel")
(SYNONYM GRAVEL) (ADJECTIVE MORE) (GENERIC G-GRAVEL-F) (FLAGS TAKEBIT
NARTICLEBIT) (ACTION GRAVEL-F)>
<OBJECT EVEN-MORE-GRAVEL (LOC LOCAL-GLOBALS) (DESC "even more gravel") (PLURAL
"gravel") (SYNONYM GRAVEL) (ADJECTIVE EVEN MORE) (GENERIC G-GRAVEL-F) (FLAGS
TAKEBIT NARTICLEBIT) (ACTION GRAVEL-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE G-GRAVEL-F>
<DEFINE-ROUTINE GRAVEL-F>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<ROOM SHRINE (LOC ROOMS) (DESC "Shrine") (REGION "Region: Unknown") (LDESC
"You have stumbled upon a long-hidden shrine to Saint Foobus of Galepath.
An idol of Foobus is carved from the very rock that forms this cave. The only
exit is southwest.") (SW TO GROTTO) (OUT TO GROTTO) (FLAGS RLANDBIT
UNDERGROUNDBIT) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-8>) (ICON
SHRINE-ICON)>
<OBJECT IDOL (LOC SHRINE) (DESC "idol") (SYNONYM ST SAINT IDOL FOOBUS GALEPATH
SHRINE) (ADJECTIVE SAINT ST) (FLAGS NDESCBIT VOWELBIT) (RESEARCH
"\"The legendary Saint Foobus was said to have power over lowly insects.\"") (
ACTION IDOL-F)>
<DEFINE-ROUTINE IDOL-F>
<OBJECT BOWL (LOC SHRINE) (DESC "bowl") (LDESC
"Sitting before the idol is a translucent bowl, extremely tall and narrow,
like a carafe.") (SYNONYM BOWL CARAFE) (ADJECTIVE TRANSLUCENT TALL NARROW) (
FLAGS TRYTAKEBIT CONTBIT OPENBIT SEARCHBIT) (CAPACITY 25) (ACTION BOWL-F)>
<DEFINE-ROUTINE BOWL-F>
<DEFINE-ROUTINE GRAVEL-COUNT>
<OBJECT ELIXIR (LOC BOWL) (DESC "elixir") (SYNONYM ELIXIR LIQUID) (ADJECTIVE
MILKY) (FLAGS VOWELBIT) (ACTION ELIXIR-F)>
<DEFINE-ROUTINE ELIXIR-F>
<ROOM BATS-LAIR (LOC ROOMS) (DESC "Bat's Lair") (REGION "Region: Unknown") (
LDESC "Only a deranged bat would live in this disgusting nesting space, caked with
layer upon layer of dried guano. A precarious path leads down to the west;
there's little chance you'd be able to climb back.") (DOWN PER LAIR-EXIT-F) (
OUT PER LAIR-EXIT-F) (WEST PER LAIR-EXIT-F) (FLAGS RLANDBIT UNDERGROUNDBIT) (
SYNONYM LAIR) (ADJECTIVE BAT\'S) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-6
MAP-GEN-X-7>) (ICON BATS-LAIR-ICON)>
<DEFINE-ROUTINE LAIR-EXIT-F>
<ROOM G-U-WOODS (LOC ROOMS) (DESC "Great Underground Woods") (REGION
"Flatheadia") (LDESC
"You are surrounded by tall oaks and wide pines. Birds chirp in the distance.
Trails wind north and southwest among the trees.") (NORTH TO BASE-OF-MOUNTAIN)
(SW TO G-U-SAVANNAH) (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (SYNONYM WOODS) (
ADJECTIVE GREAT UNDERGROUND) (RESEARCH
"\"One of the many awe-inspiring features of Dimwit's castle in Flatheadia.\"")
(MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-6>) (THINGS TALL OAK
TREE-PS WIDE PINE TREE-PS PINE TREE TREE-PS OAK TREE TREE-PS) (ACTION
G-U-WOODS-F)>
<DEFINE-ROUTINE G-U-WOODS-F>
<BEGIN-SEGMENT 0>
<OBJECT FOX (LOC G-U-WOODS) (DESC "fox") (PLURAL "foxes") (FDESC
"A fox is leaning against a nearby tree, looking sly.") (SYNONYM FOX STOLE) (
ADJECTIVE FOX) (FLAGS TAKEBIT TRYTAKEBIT ANIMATEDBIT) (INANIMATE-DESC
"fox stole") (WAND-TEXT "The fox's eyes turn glassy.") (ANIMATE-ROUTINE I-W-FOX
) (SIZE 15) (ACTION FOX-F)>
<DEFINE-ROUTINE FOX-F>
<DEFINE-ROUTINE WOULDNT-MIND>
<DEFINE-ROUTINE I-W-FOX>
<GLOBAL FOX-PROB 100>
<GLOBAL FOX-BURP <>>
<DEFINE-ROUTINE I-FOX>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<ROOM G-U-SAVANNAH (LOC ROOMS) (REGION "Flatheadia") (DESC
"Great Underground Savannah") (LDESC
"Dimwit's mania for including every conceivable ecosystem under his roof
continues here. This flat grassland ends at woods to the northeast, and
at a desert to the west. A herd of unicorns is grazing nearby.") (NE TO
G-U-WOODS) (WEST TO EDGE-OF-DESERT) (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (
SYNONYM SAVANNAH) (ADJECTIVE GREAT UNDERGROUND) (RESEARCH
"\"One of the many awe-inspiring features of Dimwit's castle in Flatheadia.\"")
(MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-5>) (ICON G-U-SAVANNAH-ICON
) (ACTION FLY-ROOM-F)>
<OBJECT UNICORNS (LOC G-U-SAVANNAH) (OWNER UNICORNS) (DESC "herd of unicorns")
(SYNONYM UNICORN UNICORNS HERD) (ADJECTIVE GRAZING) (FLAGS NDESCBIT) (RESEARCH
"\"A magical beast, sometimes used as a combat mount.\"") (ACTION UNICORNS-F)>
<DEFINE-ROUTINE UNICORNS-F>
<ROOM STREAM (LOC ROOMS) (DESC "Stream") (REGION "Flatheadia") (EAST TO
SOUTH-SHORE) (WEST PER BRIDGE-ENTER-F) (FLAGS RLANDBIT ONBIT UNDERGROUNDBIT) (
GLOBAL LAKE-FLATHEAD) (RIDDLE
"|
'One night four men sat down to play;|
They played and played till break of day.|
They played for money; not for fun,|
With separate scores for every one.|
And when time came to square accounts,|
They all had made quite nice amounts!'|
What were the men playing?\" As the jester awaits your answer, you notice
that he is holding the framed document.") (MAP-LOC <PTABLE LAKE-MAP-NUM
MAP-GEN-Y-6 MAP-GEN-X-3>) (ACTION CAMEL-DRINK-ROOM-F)>
<OBJECT BRIDGE (LOC STREAM) (DESC "odd green bridge") (SYNONYM BRIDGE) (
ADJECTIVE STRANGE ODD UNUSUAL GREEN) (FLAGS VOWELBIT NDESCBIT) (ACTION BRIDGE-F
)>
<DEFINE-ROUTINE BRIDGE-F>
<DEFINE-ROUTINE BRIDGE-ENTER-F>
<OBJECT MUSIC (LOC GLOBAL-OBJECTS) (DESC "music") (SYNONYM MUSIC INSTRUMENTS) (
ADJECTIVE MUSICAL) (FLAGS NARTICLEBIT) (ACTION MUSIC-F)>
<DEFINE-ROUTINE MUSIC-F>
<OBJECT STREAM-OBJECT (LOC STREAM) (DESC "stream") (SYNONYM STREAM) (FLAGS
NDESCBIT WATERBIT) (ACTION STREAM-OBJECT-F)>
<DEFINE-ROUTINE STREAM-OBJECT-F>
<DEFINE-ROUTINE CAMEL-DRINK-ROOM-F>
<OBJECT DIPLOMA (LOC STREAM) (DESC "diploma") (SYNONYM DIPLOMA DOCUMENT) (
ADJECTIVE FRAMED) (FLAGS TAKEBIT TRYTAKEBIT READBIT NDESCBIT MAGICBIT) (VALUE 0
) (TEXT "The diploma is from the Borphee Business School, but the name of the
recipient is too faded to read.") (SIZE 2) (ACTION DIPLOMA-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE DIPLOMA-F>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<ROOM EDGE-OF-DESERT (LOC ROOMS) (DESC "Edge of Desert") (REGION "Flatheadia")
(LDESC "Dimwit wanted a sandbox, but thanks to his lack of perspective he ended up
with a desert. The bulk of the desert lies to the south; paths lead in the
other cardinal directions.") (NORTH TO SOUTH-SHORE) (NE SORRY
"Sand dunes block your way.") (EAST TO G-U-SAVANNAH) (SE SORRY
"Sand dunes block your way.") (WEST TO RING-OF-DUNES) (SW SORRY
"Sand dunes block your way.") (SOUTH PER DESERT-ENTER-F) (NW SORRY
"Sand dunes block your way.") (FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (
GLOBAL G-U-DESERT) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-4>) (
ACTION DESERT-ROOM-F)>
<ROOM RING-OF-DUNES (LOC ROOMS) (DESC "Ring of Dunes") (REGION "Flatheadia") (
LDESC "You are surrounded by sand dunes on all sides but the east.") (NORTH
SORRY "Sand dunes block your way.") (NE SORRY "Sand dunes block your way.") (
EAST TO EDGE-OF-DESERT) (SE SORRY "Sand dunes block your way.") (SOUTH SORRY
"Sand dunes block your way.") (SW SORRY "Sand dunes block your way.") (WEST
SORRY "Sand dunes block your way.") (NW SORRY "Sand dunes block your way.") (
FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (GLOBAL G-U-DESERT) (MAP-LOC <
PTABLE LAKE-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-3>) (ICON RING-OF-DUNES-ICON) (ACTION
DESERT-ROOM-F)>
<OBJECT CAMEL (LOC RING-OF-DUNES) (DESC "camel") (SYNONYM CAMEL FIXTURE) (
ADJECTIVE MERRY-GO-ROUND) (FLAGS ACTORBIT VEHBIT SEARCHBIT OPENBIT ANIMATEDBIT)
(RESEARCH "\"A desert animal.\"") (GENERIC G-CAMEL-F) (INANIMATE-DESC
"merry-go-round fixture") (WAND-TEXT
"The camel, never a speed demon to begin with, becomes still. His coloring
grows gaudier, and a few bars of honky-tonk music drift through the air.") (
ANIMATE-ROUTINE I-W-CAMEL) (ACTION CAMEL-F)>
<DEFINE-ROUTINE G-CAMEL-F>
<GLOBAL CAMEL-THIRSTY T>
<DEFINE-ROUTINE CAMEL-F>
<DEFINE-ROUTINE I-W-CAMEL>
<DEFINE-ROUTINE DESERT-ENTER-F>
<ROOM G-U-DESERT (LOC ROOMS) (DESC "Great Underground Desert") (REGION
"Flatheadia") (LDESC
"You are in the midst of a searingly hot desert. Trails snake amongst
the dunes in many directions.") (NORTH TO EDGE-OF-DESERT) (NE SORRY
"Sand dunes block your way.") (EAST SORRY "Sand dunes block your way.") (SE
SORRY "Sand dunes block your way.") (SOUTH TO CACTUS-PATCH) (SW TO
WINDBLOWN-SANDS) (WEST SORRY "Sand dunes block your way.") (NW SORRY
"Sand dunes block your way.") (FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (
SYNONYM DESERT) (ADJECTIVE GREAT UNDERGROUND) (RESEARCH
"\"One of the many awe-inspiring features of Dimwit's castle in Flatheadia.\"")
(MAP-LOC <PTABLE DESERT-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-6>) (ACTION DESERT-ROOM-F
)>
<ROOM WINDBLOWN-SANDS (LOC ROOMS) (DESC "Windblown Sands") (REGION "Flatheadia"
) (LDESC "You are in the midst of a searingly hot desert. Trails snake amongst
the dunes in many directions.") (NORTH SORRY "Sand dunes block your way.") (NE
TO G-U-DESERT) (EAST TO CACTUS-PATCH) (SE TO DESERT-PLAIN) (SOUTH SORRY
"Sand dunes block your way.") (SW SORRY "Sand dunes block your way.") (WEST
SORRY "Sand dunes block your way.") (NW SORRY "Sand dunes block your way.") (
FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (GLOBAL G-U-DESERT) (MAP-LOC <
PTABLE DESERT-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-5>) (ACTION DESERT-ROOM-F)>
<ROOM CACTUS-PATCH (LOC ROOMS) (DESC "Cactus Patch") (REGION "Flatheadia") (
LDESC "You are in the midst of a searingly hot desert. Trails snake amongst
the dunes in many directions.") (NORTH TO G-U-DESERT) (NE SORRY
"Sand dunes block your way.") (EAST SORRY "Sand dunes block your way.") (SE
SORRY "Sand dunes block your way.") (SOUTH SORRY "Sand dunes block your way.")
(SW SORRY "Sand dunes block your way.") (WEST TO WINDBLOWN-SANDS) (NW SORRY
"Sand dunes block your way.") (FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (
GLOBAL G-U-DESERT) (MAP-LOC <PTABLE DESERT-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-6>) (
ICON CACTUS-PATCH-ICON) (ACTION DESERT-ROOM-F)>
<OBJECT CACTI (LOC CACTUS-PATCH) (DESC "cactus") (SYNONYM CACTUS CACTI) (FLAGS
NDESCBIT PLANTBIT) (ACTION CACTI-F)>
<DEFINE-ROUTINE CACTI-F>
<ROOM DESERT-PLAIN (LOC ROOMS) (DESC "Desert Plain") (REGION "Flatheadia") (
LDESC "You are in the midst of a searingly hot desert. Trails snake amongst
the dunes in many directions.") (NORTH SORRY "Sand dunes block your way.") (NE
SORRY "Sand dunes block your way.") (EAST TO TALL-DUNES) (SE TO RIPPLED-SANDS)
(SOUTH SORRY "Sand dunes block your way.") (SW SORRY
"Sand dunes block your way.") (WEST SORRY "Sand dunes block your way.") (NW TO
WINDBLOWN-SANDS) (FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (GLOBAL
G-U-DESERT) (MAP-LOC <PTABLE DESERT-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-6>) (ACTION
DESERT-ROOM-F)>
<ROOM TALL-DUNES (LOC ROOMS) (DESC "Tall Dunes") (REGION "Flatheadia") (LDESC
"You are in the midst of a searingly hot desert. Trails snake amongst
the dunes in many directions.") (NORTH SORRY "Sand dunes block your way.") (NE
SORRY "Sand dunes block your way.") (EAST SORRY "Sand dunes block your way.") (
SE SORRY "Sand dunes block your way.") (SOUTH TO RIPPLED-SANDS) (SW SORRY
"Sand dunes block your way.") (WEST TO DESERT-PLAIN) (NW SORRY
"Sand dunes block your way.") (FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (
GLOBAL G-U-DESERT) (MAP-LOC <PTABLE DESERT-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-7>) (
ICON TALL-DUNES-ICON) (ACTION DESERT-ROOM-F)>
<ROOM RIPPLED-SANDS (LOC ROOMS) (DESC "Rippled Sands") (REGION "Flatheadia") (
LDESC "You are in the midst of a searingly hot desert. Trails snake amongst
the dunes in many directions.") (NORTH TO TALL-DUNES) (NE TO OASIS) (EAST SORRY
"Sand dunes block your way.") (SE SORRY "Sand dunes block your way.") (SOUTH
SORRY "Sand dunes block your way.") (SW SORRY "Sand dunes block your way.") (
WEST SORRY "Sand dunes block your way.") (NW TO DESERT-PLAIN) (FLAGS RLANDBIT
ONBIT DESERTBIT UNDERGROUNDBIT) (GLOBAL G-U-DESERT) (MAP-LOC <PTABLE
DESERT-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-7>) (ACTION DESERT-ROOM-F)>
<GLOBAL DESERT-DEATH 0>
<DEFINE-ROUTINE DESERT-ROOM-F>
<DEFINE-ROUTINE I-DESERT-RESET>
<ROOM OASIS (LOC ROOMS) (DESC "Great Underground Oasis") (REGION "Flatheadia")
(SW TO RIPPLED-SANDS) (FLAGS RLANDBIT ONBIT DESERTBIT UNDERGROUNDBIT) (GLOBAL
G-U-DESERT) (VALUE 8) (MAP-LOC <PTABLE DESERT-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-8>)
(ICON G-U-OASIS-ICON) (ACTION CAMEL-DRINK-ROOM-F)>
<OBJECT OASIS-OBJECT (LOC OASIS) (DESC "oasis") (SYNONYM OASIS POOL SPRING) (
ADJECTIVE GREAT UNDERGROUND INCREDIBLY CLEAR COLD) (FLAGS VOWELBIT NDESCBIT
WATERBIT)>
<ROOM PHIL-HALL (LOC ROOMS) (DESC "Frobozz Philharmonic Hall") (REGION
"Flatheadia") (NORTH PER FR-BASEMENT-ENTER-F) (SOUTH TO NORTH-SHORE) (EAST TO
THEATRE) (FLAGS RLANDBIT ONBIT) (SYNONYM HALL ORCHESTRA) (ADJECTIVE FROBOZZ
PHILHARMONIC) (RESEARCH
"\"Frobozz Philharmonic Hall is the home of the renowned Frobozz Philharmonic
Orchestra.\"") (GLOBAL FR-BLDG) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-4>) (ACTION PHIL-HALL-F) (THINGS LONE SPOTLIGHT SPOTLIGHT-PS <>
SHADOW PHIL-SHADOW-PS)>
<DEFINE-ROUTINE PHIL-HALL-F>
<DEFINE-ROUTINE PHIL-SHADOW-PS>
<DEFINE-ROUTINE SPOTLIGHT-PS>
<OBJECT CONDUCTOR-STAND (LOC PHIL-HALL) (DESC "conductor's stand") (SYNONYM
STAND PLATFORM) (ADJECTIVE CONDUCTOR RECTANGULAR) (CAPACITY 50) (FLAGS NDESCBIT
VEHBIT CONTBIT OPENBIT SURFACEBIT SEARCHBIT) (ACTION CONDUCTOR-STAND-F)>
<DEFINE-ROUTINE CONDUCTOR-STAND-F>
<ROOM CONDUCTOR-PIT (LOC ROOMS) (DESC "Conductor's Pit") (REGION "Flatheadia")
(LDESC "You are in a tiny space beneath the stage. There are no visible exits."
) (OUT SORRY "There are no visible exits.") (UP SORRY
"There are no visible exits.") (FLAGS RLANDBIT) (SYNONYM PIT) (ADJECTIVE
CONDUCTOR) (MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-3>) (ACTION
CONDUCTOR-PIT-F)>
<DEFINE-ROUTINE CONDUCTOR-PIT-F>
<OBJECT VIOLIN (LOC CONDUCTOR-PIT) (DESC "fancy violin") (FDESC
"Sitting by the edge of the stand is a beautiful, handmade violin; possibly
a Stradivarius.") (SYNONYM STRADIVARIUS VIOLIN) (ADJECTIVE FANCY BEAUTIFUL
HANDMADE STRADIVARIUS) (FLAGS TAKEBIT BURNBIT MAGICBIT) (SIZE 10) (VALUE 12) (
ACTION VIOLIN-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE VIOLIN-F>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<ROOM THEATRE (LOC ROOMS) (DESC "Theatre") (REGION "Flatheadia") (LDESC
"This twenty-thousand-seat theatre was renowned for its terrible acoustics,
although Dimwit always claimed he could \"hear things great\" from his box
in the front of the theatre. Exits lead west and southwest.") (WEST TO
PHIL-HALL) (SW TO NORTH-SHORE) (FLAGS RLANDBIT ONBIT) (SYNONYM THEATRE THEATER)
(MAP-LOC <PTABLE LAKE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-5>) (THINGS DIMWIT\'S BOX
DIMWIT-BOX-PS)>
<DEFINE-ROUTINE DIMWIT-BOX-PS>
<END-SEGMENT>

1351
lake.zap Normal file
View File

File diff suppressed because it is too large Load Diff

2231
lake.zil Normal file
View File

File diff suppressed because it is too large Load Diff

281
library.zabstr Normal file
View File

@ -0,0 +1,281 @@
<INCLUDE "PDEFS">
<BEGIN-SEGMENT CASTLE>
<ROOM LIBRARY (LOC ROOMS) (REGION "Flatheadia") (DESC "Library") (LDESC
"This dust-filled chamber once contained copies of every book ever written,
but all of them have been taken by the fleeing populace as reading material
for their long journeys to safe havens. The only exit is south.") (SOUTH TO
EAST-WING) (OUT TO EAST-WING) (FLAGS RLANDBIT ONBIT) (SYNONYM LIBRARY) (MAP-LOC
<PTABLE MAIN-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-8>) (ICON LIBRARY-ICON) (ACTION
LIBRARY-F) (THINGS <> (ANSWER RIDDLE)
"\"Nice try, but no help here! (signed) The Jester.\"" FROBOZZCO (FROBOZZCO
INTERNATIONAL) "\"FrobozzCo International is a vast conglomerate of thousands upon thousands
of companies. It can trace its origin to the Frobozz Magic Cave Company, which
was formed at the behest of King Duncanthraz in 668 GUE. Headquartered in the
400-story FrobozzCo Building in Flatheadia, FrobozzCo's corporate motto is
'You name it, we do it!'\"" (GREAT UNDERGROUND) (HIGHWAY TOLL)
"\"The Great Underground Highway is a system of toll roads stretching
thoughout both the eastland and westland provinces.\"" <> SQUID
"\"A bottom-dwelling aquatic creature.\"" <> HELLHOUND
"\"When you spot a hellhound, run in the other direction as fast as you can!
Hellhounds are fast, fierce, and capable of devouring a human twelve times
their size in three-and-a-half seconds. They normally inhabit burnt-out or
enchanted woods and rarely venture beyond their turf, even in pursuit of
prey.\"" <> SNARFEM
"\"Snarfem, a two-player game of removing pebbles, originated in
Mithicus and comes from an ancient Mithican word meaning 'to collect
pebbles or small stones.'\"" <> FISHA
"\"Fisha is a small wand producer in Foozle, specializing in Wands of
Inanimation. Their wands tend to have a very limited life.\"" (BOZBO MUMBO
ZILBO) (BOZBO MUMBO ZILBO II III IV)
"\"One of the kings of the Entharion Dynasty.\"" <> (BELWIT MUMBERTHRAX PHLOID)
"\"One of the kings of the Flathead Dynasty.\"" <> (ESTUARY FROBUARY ARCH MAGE
JAM JELLY AUGUR SUSPENDUR OTTOBUR MUMBERBUR DISMEMBUR)
"\"A month of the year.\"" <> (EASTLAND EASTLANDS)
"\"The eastlands comprise those provinces which lie on the eastern
shore of the Great Sea, such as Flatheadia and the Fublio Valley.\"" <> (
WESTLAND WESTLANDS)
"\"The westlands comprise those provinces which lie on the western
shore of the Great Sea, such as Borphee, Gurth and Frobozz.\"" MITHICAN
CHAMELEON "\"A Mithican chameleon skin's is said to be able to imitate any color
the eye can see... and more.\"" CURSE (CURSE DAY)
"\"Curse Day is the anniversary of the death of Lord Dimwit Flathead the
Excessive. Some aver that, on that day in 779 GUE, a great wizard cast a
mighty Curse, and that on the 94th anniversary of that day the Empire will
collapse. Historians today dismiss this as a silly schoolyard legend.\"" <> (
ZORKMID ZORKMIDS)
"\"The Zorkmid is the unit of currency of the Great Underground Empire.\""
ENCHANTER (ENCHANTER GUILD)
"\"The Enchanter's Guild has several thousand members scattered in chapters
throughout the land. Amongst the more influential chapters are the ones
located in Thriff and Accardi.\"" FROBLO PARK
"\"Froblo Park was Thomas Alva Edison's laboratory.\"" BOSWELL BARWELL
"\"The official biographer of the Flatheads, Boswell Barwell is the author
of such notable works as THE LIVES OF THE TWELVE FLATHEADS and MUMBERTHRAX:
THE MAN BEHIND THE LEGEND.\"" <> MINX "\"An irrestibly cuddly animal.\"" <>
WINDCAT "\"The fleetest land animal.\"" ENDLESS FIRE
"\"The Endless Fire destroyed Mareilon in 773 GUE.\"" <> ZORK
"There's no entry for \"Zork.\" Not surprising. This is just the prequel;
it hasn't been written yet!" <> DAVMAR
"\"Davmar was the great Thaumaturgist who discovered that the power of
magic spells could be stored on paper scrolls.\"" <> PHEEBOR
"\"Along with Borphee, Pheebor was one of the great city-states that lay at
the convergence of the Bor River and the Phee River. Borphee defeated Pheebor
in a massive battle that took place long before the age of Entharion.\"" <> (
BLOIT BLOITS) "\"The bloit is the Empire's most common unit for measuring distances. The
bloit is defined as the distance the king's favorite pet runs in an hour.
As the discerning reader can tell from this definition, the length of the
bloit changes dramatically from ruler to ruler. (Rarely more dramatically
than in 619 GUE, when Bozbo IV -- who adored his windcat -- died, and was
succeeded by Mumbo II -- who was equally enamored of his very, very ancient
turtle). Land is usually measured in square bloits.\"" FUBLIO VALLEY
"\"Once a richly verdant area at the southern tip of the Flathead Mountains,
the valley was defoliated in the late eighth century. For some odd reason, it
has always been a favorite spot for wizards who enjoy a hermitic lifestyle.\""
<> KORBOZ "\"A moderately famous hermit enchanter.\"" <> GUMBOZ
"\"A very obscure hermit enchanter.\"" (FLOOD CONTROL DAM FCD) (\#3 FCD\#3 DAM)
"The entry describes Flood Control Dam #3 as a great engineering feat of the
late 8th century, made possible by a grant of 37 million zorkmids from Dimwit
Flathead the Excessive. The dam forms a huge reservoir, and its spillover is
the source of the Frigid River. The article goes into construction techniques,
the dam's appeal as a tourist attraction, and the financial impact of the
dam's cost on the economy of the GUE." DIABLO MASSACRE
"\"The Diablo Massacre occured at the Zorbel Pass in 666 GUE when the invading
armies of King Duncanthrax met a native militia of trollish warriors. The
invaders were outnumbered but well-armed; the natives were equipped only with
wooden clubs and a large piece of very strong garlic. Military historians
consider the routing of the native militia as a key moment in the conquering
of the eastlands.\"" ZORBIUS BLATTUS
"\"Greatest of the modern philosophers, Zorbius Blattus is a popular debunker
of Brogmoidism and other strange religious sects.\"" <> (SHADOWLAND LAND SHADOW
) "\"The Shadowland (a.k.a. the Land of Shadow) is a barren area of rolling
hills, south of Flatheadia and deep underground. It lies near the point where
the Flathead Ocean's eastern shore dips underground.\"" ROYAL MUSEUM
"\"The Royal Museum, built by Lord Dimwit Flathead in 777 GUE, houses
the crown jewels, a technology display, and a famous royal puzzle-maze.\""
ROCKVILLE (ESTATES CONSTRUCTION)
"\"Rockville Estates is an upscale housing complex being planned by the
Frobozz Magic Construction Company for a piece of prime cavern space on
the Great Underground Highway near Flatheadia. It was designed by the
renowned architect, Zylo Pickthorn.\"" ZYLO PICKTHORN
"\"An architect known for his underground condominium complexes, Pickthorn
is an avid enthusiast of jousting, chess, and tiddlywinks, and has been
known to incorporate some or all of these themes into his designs.\"" MOUNT
FOOBIA "\"Foobia is the tallest peak in the Flathead Mountains, perhaps in the entire
world. It lies toward the southern end of the range, near the Zorbel Pass, and
its apex is always hidden by clouds. It is believed that no one has ever
scaled this mighty peak.\"" (STEVE STEVEN) MERETZKY
"\"A mysterious mage who is said to live in the lands beyond the borders
of the world.\"" <> INFOCOM
"The entry simply reads, \"There are some things that man was not meant
to know.\"" (FRIGID RIVER) VALLEY
"\"The Frigid River Valley, a province of the Great Underground Empire,
encompasses the 15,322 square bloits which form the runoff basin of the
Frigid River.\"" POLAR GUMFFBEAST
"\"A creature, possibly mythical, said to live in the extreme northlands
of Quendor.\"" <> DUNCANTHRAX
"\"Duncanthrax the Bellicose, the first king of the Flathead Dynasty, took
the throne from Zilbo III during a palace revolt on the last day of 659 GUE.
Duncanthrax expanded the kingdom by conquering Antharia and most of the
eastlands. He also moved the capital from Largoneth to Egreth.\"" (EGRETH
CASTLE) (EGRETH CASTLE)
"\"The Castle Egreth served as the seat of royal power from the reign of
Duncanthrax (who moved the capital from Largoneth in 660 GUE) through the
reign of Dimwit (who moved the capital to Flatheadia in 771 GUE). Egreth was,
and still is, reputed to be the most dangerous locale in the kingdom.\"" (
LARGONETH CASTLE) (CASTLE LARGONETH)
"\"The Castle Largoneth was built by Entharion the Wise back in the misty
times at the dawn of the empire. It served as the capital of the kingdom
until Duncanthrax constructed Egreth in 660 GUE. Largoneth still stands,
lonely and deserted, on the coast of Frobozz.\"" FROBESIUS (FROBESIUS FUBLIUS)
"\"Frobesius Fublius was a painter who specialized in rebuses. A mysterious
figure, he reputedly lived near the Zorbel Pass and vanished toward the end
of the eighth century.\"" BORPHBELLY (STEW INGREDIENTS) BORPHBELLY-TEXT <>
FENSHIRE "\"Fenshire is a swampy region which stretches east of the Flathead Mountains
to the edge of the world. The summer castle of the Flatheads is located
in a remote section of Fenshire.\"" <> CHESS
"\"An ancient game of warfare, playing on a checkered field of 64 squares.\"" <
> CURSE "According to this article, Megaboz was a mysterious wizard who lived a
hermit's life in the Fublio Valley. It is said he cast a Curse which will
someday bring down the Empire, but royal spokesmen have denied all such
rumors. Megaboz vanished in 789 GUE; some say the effort of casting the
Curse destroyed him." <> (TREATY ZNURG)
"\"The Treaty of Znurg, signed in 474 GUE, ended the Zucchini Wars.\"" ZUCCHINI
(WAR WARS) "\"The Zucchini Wars, which devastated seven provinces during the fifth
century, were finally ended by the Treaty of Znurg.\"" RAGWEED (BATTLE GULCH)
"\"The Battle of Ragweed Gulch, fought in 789 GUE, is most notable for the
death of Stonewall Flathead.\"" <> (BARBEL BERKNIP BARSAP)
"\"A respected member of the Enchanters Guild.\"" GREATER BORPHEE
"\"Borphee, a large industrial city in the westlands, is the capital of the
Greater Borphee province.\"" <> INQUISITION
"\"A crackpot religious sect; its followers believe that the Curse of Megaboz
can be forestalled by executing every person in the Empire.\"" <> (GRUBBO
GRUBBO-BY-THE-SEA ACCARDI ACCARDI-BY-THE-SEA)
"\"A small village in the westlands.\"" <> (WISHYFOO WISHYFOOS)
"\"The Wishyfoo, who live in the vicinity of Port Foozle, alternately tell
the truth and tell a lie with every successive statement they make. Sometimes
they start with a lie, sometimes with a truth, but they always alternate
thereafter.\"" <> PREVARICON
"\"The Prevaricons, who dwell near Port Foozle, have two interesting quirks:
They always lie, and they feed unwelcome visitors to ravenous hellhounds.\"" <>
(VERITASSI VERITASS)
"\"The Veritassi, who dwell near Port Foozle, have two interesting quirks:
They never lie, and they feed unwelcome visitors to ravenous hellhounds.\"" <>
MIZNIA "\"A province at the southern fringe of the westlands, mostly jungle. Its
capital is Mizniaport.\"" <> MIZNIAPORT
"\"The capital and largest city in Miznia.\"" <> GURTH
"\"This province, which lies to the north of Miznia and Mithicus, is chiefly
woods and farmland. The Fields of Frotzen, in central Gurth, are known as the
Breadbasket of Quendor. The capital of the province is Gurth City.\"" GURTH
CITY "\"Gurth City is the capital of Gurth province.\"" <> MITHICUS
"\"This small, mountainous province, sandwiched between Gurth and Miznia,
is a popular vacation spot.\"" <> (FIELDS FROTZEN)
"\"The Fields of Frotzen, fertile farmland in the heart of Gurth province,
produces an annual bounty of grain and are freqently referred to as the
Breadbasket of Quendor.\"" <> FESTERON "\"A small village in Antharia.\"" <>
THRIFF "\"The strange wandering village of Thriff has, at one time or another, been
located in most of the provinces of the westlands. Rumor has it that the
Guildmaster of Thriff's enchanters constantly moves the town in an attempt
to find a more benevolent climate for his terrible hayfever.\"" <> ENTHARION
"\"Entharion the Wise united the warring city-states of Galepath and Mareilon,
forming the kingdom of Quendor. As Quendor's first king, Entharion built the
castle Largoneth, and ruled over a kingdom which was little more than what is
currently the province of Frobozz. Our current calendar dates from the first
year of Entharion's reign.\"" <> (GALEPATH MAREILON)
"\"Galepath and Mareilon were the two ancient cities of Quendor, which were
united by Entharion the Wise in the distant past. Mareilon was destroyed in
773 GUE by the Endless Fire.\"" <> ANTHARIA
"\"Antharia, the island province, is located in the middle of the Flathead
Ocean. It is known for its shipbuilding, marble cutting, and granola mining
industries, and is the home of Flathead Stadium. The capital is Anthar.\"" <>
ANTHAR "\"The capital of Antharia.\"" GRANOLA (MINES RIOTS)
"\"The granola mines in northern Antharia once supplied seemingly limitless
quantities of granola. Since the Granola Riots of 865 GUE, the causes of
which are well known, the output of the mines has fallen sharply.\"" FLATHEAD
STADIUM "The entry calls Flathead Stadium \"The House that Babe Built,\" a tribute to
Babe Flathead's popularity as a gate attraction. Located just outside Anthar,
the stadium was supposedly large enough to hold every man, woman, and child in
Quendor." PORT FOOZLE
"\"Foozle, which lies several bloits west of Flatheadia, is the primary
seaport of the Frigid River Valley, and is a common departure point for
ships to Antharia.\"" <> BELBOZ
"A tiny entry mentions that Belboz is the name of a young enchanter in
the Accardi chapter of the Enchanter's Guild." ZORBEL PASS
"\"This wide pass through the Flathead Mountains, at the southern end of
the range, connects the Fublio and Frigid River valleys. The Zorbel Pass
was the site of the Diablo Massacre in 666 GUE.\"" <> QUENDOR
"\"See GREAT UNDERGROUND EMPIRE.\"" (GREAT UNDERGROUND) (EMPIRE GUE)
"\"The kingdom of Quendor was renamed the Great Underground Empire by Lord
Dimwit Flathead when he became ruler in 770 GUE. It encompasses all the
lands on both sides of the Great Sea, although most of the underground
portions of the empire are in the eastlands.\"" GREAT SEA
"\"See FLATHEAD OCEAN.\"" ARAGAIN FALLS
"The article calls Aragain Falls the most breathtaking and awesome waterfall
in all the known lands. Found toward the northern part of the Frigid River,
the falls are a popular honeymoon spot." TWELVE FLATHEADS
"[Please see \"The Lives of the Twelve Flatheads Calendar\" that came in your
Zork Zero package.]")>
<CONSTANT BORPHBELLY-TEXT
"\"A popular lunchtime meal in the province of Fenshire, Borphbelly Stew
is made from fox, fowl, and earthworm. Proper preparation mandates the
simultaneous addition of the ingredients to a boiling cookpot.\"">
<DEFINE-ROUTINE LIBRARY-F>
<OBJECT ENCYCLOPEDIA (LOC LIBRARY) (DESC "Encyclopedia Frobozzica") (LDESC
"A copy of the Encyclopedia Frobozzica is the only book still left in the
Library, probably because it's so huge that it can't be moved except by
a team of mules.") (SYNONYM ENCYCLOPEDIA FROBOZZICA BOOK) (ADJECTIVE LARGE
ENCYCLOPEDIA) (FLAGS READBIT VOWELBIT) (TEXT
"The cover reads \"Encyclopedia Frobozzica, Illustrated Edition. Copyright
882 GUE. A publication of the Frobozz Magic Encyclopedia Company.\" It would
take weeks to read the entire encyclopedia, but you could read about specific
persons or things.") (ACTION ENCYCLOPEDIA-F)>
<GLOBAL VOLUME-USED <>>
<DEFINE-ROUTINE ENCYCLOPEDIA-F>
<OBJECT FOUR-FLIES (LOC GENERIC-OBJECTS) (DESC "it") (SYNONYM FLIES FAMATHRIA)
(ADJECTIVE FOUR FANTASTIC INT.NUM) (OWNER FOUR-FLIES) (PICTURE FOUR-FLIES-ILL)
(RESEARCH "The Four Fantastic Flies of Famathria, each bigger and more succulent than
the last, is a legend fabricated by a race of toad creatures who once lived
somewhere beyond the oceans of the world. Seafarers report that these toads
were ugly, cantankerous, and eternally hungry.") (ACTION ENC-ENTRY-F)>
<OBJECT ZILBEETHA (LOC GENERIC-OBJECTS) (SYNONYM ZILBEETHA) (PICTURE
ZILBEETHA-ILL) (RESEARCH
"This is one of the oldest and dearest legends in the annals of Quendor.
Zilbeetha, a beautiful maiden, somehow angered an evil mage, and was placed
under enchantment and turned into a crystal orb on the very day that she was
to be wed. The heartbroken groom, who is always depicted holding a fragile
bloom, sought help from the wizard's goodly twin. The good wizard turned the
groom to stone, that he might stay young until the day Zilbeetha was returned
to him. The legend also has an ominous note; returning a false orb would
result in death.") (ACTION ENC-ENTRY-F)>
<OBJECT BROGMOIDISM (LOC GENERIC-OBJECTS) (SYNONYM BROGMOIDISM) (PICTURE
BROGMOIDISM-ILL) (RESEARCH
"Brogmoidists, followers of the tenets of Brogmoidism, believe that a Great
Brogmoid supports the world upon his shoulders. The religion, which originated
sometime during the fourth century, is commonly ridiculed nowadays, and has
lost most of its adherents.") (ACTION ENC-ENTRY-F)>
<OBJECT FLATHEADIA (LOC GENERIC-OBJECTS) (SYNONYM FLATHEADIA) (PICTURE
FLATHEADIA-ILL) (RESEARCH
"Flatheadia has been the capital of the Great Underground Empire since Dimwit
built his castle there in 770 GUE. (The former seat of royal government was
Egreth, in the Westlands.) Although still the largest population center in
the Eastlands, Flatheadia has been in a steady decline since a Curse cast by
Megaboz toward the end of the last century.") (ACTION ENC-ENTRY-F)>
<DEFINE-ROUTINE ENC-ENTRY-F>
<DEFINE-ROUTINE PICTURED-ENTRY>
<OBJECT OTHER-FLATHEADS (DESC "member of the Flathead family") (SYNONYM
FLATHEAD) (ADJECTIVE MICHAEL WURB KING OLIVER WENDELL) (ACTION
OTHER-FLATHEADS-F)>
<DEFINE-ROUTINE OTHER-FLATHEADS-F>
<OBJECT SAINTS (DESC "saint") (SYNONYM SAINT ST BALHU HONKO QUAKKO BOVUS WISKUS
) (ADJECTIVE SAINT ST) (FLAGS NDESCBIT VOWELBIT) (ACTION SAINTS-F)>
<DEFINE-ROUTINE SAINTS-F>
<OBJECT WIZARD-OF-FROBOZZ (DESC "Wiazard of Frobozz") (SYNONYM WIZARD FROBOZZ)
(OWNER WIZARD-OF-FROBOZZ) (ACTION WIZARD-OF-FROBOZZ-F)>
<DEFINE-ROUTINE WIZARD-OF-FROBOZZ-F>
<OBJECT ARMOR (LOC LIBRARY) (OWNER ARMOR) (DESC "suit of armor") (SYNONYM SUIT
ARMOR ARMOUR) (FLAGS TRYTAKEBIT) (ACTION ARMOR-F)>
<GLOBAL ARMOR-TOUCH 0>
<DEFINE-ROUTINE ARMOR-F>
<OBJECT LANCE (DESC "lance") (SYNONYM LANCE) (FLAGS TAKEBIT MAGICBIT) (SIZE 10)
(VALUE 0)>
<END-SEGMENT>

166
library.zap Normal file
View File

@ -0,0 +1,166 @@
.SEGMENT "CASTLE"
.FUNCT LIBRARY-F,RARG
EQUAL? RARG,M-BEG \FALSE
EQUAL? PSEUDO-OBJECT,PRSO,PRSI \FALSE
EQUAL? PRSA,V?RESEARCH \?CCL8
ZERO? LIT /?CCL8
EQUAL? PRSI,FALSE-VALUE,ENCYCLOPEDIA,ROOMS \?CCL8
SET 'VOLUME-USED,TRUE-VALUE
GETP PRSO,P?ACTION
PRINT STACK
CRLF
RTRUE
?CCL8: PUTP PSEUDO-OBJECT,P?ACTION,FALSE-VALUE
RFALSE
.FUNCT ENCYCLOPEDIA-F
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTI "The volume lies open to "
ZERO? VOLUME-USED /?CCL6
PRINTR "a random entry."
?CCL6: PRINTI "an entry about Double Fanucci: "
ICALL PERFORM,V?RESEARCH,DOUBLE-FANUCCI
PRINTR " You could probably read about all sorts of other interesting people, places, and things by looking them up in the encyclopedia."
?CCL3: EQUAL? PRSA,V?RESEARCH \?CCL8
EQUAL? PRSI,ENCYCLOPEDIA \?CCL8
PRINTR """The Encyclopedia Frobozzica, a publication of the Frobozz Magic Encyclopedia Company, is the finest of its kind in the known world. All entries are meticulously compiled by the Frobozz Magic Encyclopedia Research Company, the illustrations are faithfully reproduced by the Frobozz Magic Encyclopedia Illustration Company, and the facts are all double, triple, and quadruple-checked by the Frobozz Magic Encyclopedia Accuracy and Verification Company. No library should be without one!"""
?CCL8: EQUAL? PRSA,V?OPEN \?CCL12
PRINTR "It is."
?CCL12: EQUAL? PRSA,V?CLOSE \?CCL14
PRINTR "Why bother?"
?CCL14: EQUAL? PRSA,V?TAKE \?CCL16
PRINTR "Do you have a team of mules handy?"
?CCL16: EQUAL? PRSA,V?LOOK-INSIDE \FALSE
ICALL PERFORM,V?READ,PRSO
RTRUE
.FUNCT ENC-ENTRY-F,?TMP1
EQUAL? PRSA,V?RESEARCH \FALSE
EQUAL? PRSO,FOUR-FLIES \?CND4
CALL ADJ-USED?,FOUR-FLIES,W?INT.NUM
ZERO? STACK /?CND4
EQUAL? P-NUMBER,4 /?CND4
SET 'PRSO,FALSE-VALUE
RFALSE
?CND4: GETP PRSO,P?PICTURE >?TMP1
GETP PRSO,P?RESEARCH
CALL PICTURED-ENTRY,?TMP1,STACK
RSTACK
.FUNCT PICTURED-ENTRY,ENC-PIC,ENC-TEXT,NO-WAIT,?TMP1
CLEAR -1
SCREEN S-FULL
SET 'CURRENT-SPLIT,ENC-PIC-LOC
DISPLAY ENC-BORDER,1,1
ICALL2 PICINF-PLUS-ONE,ENC-PIC-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY ENC-PIC,?TMP1,STACK
ICALL2 PICINF-PLUS-ONE,ENC-TXT-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
WINPOS 3,?TMP1,STACK
PICINF ENC-TXT-WINDOW-SIZE,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
WINSIZE 3,?TMP1,STACK
WINATTR 3,15
SCREEN 3
CURSET 1,1
COLOR 1,-1
ZERO? ENC-TEXT /?CCL4
PRINT ENC-TEXT
JUMP ?CND2
?CCL4: ICALL1 J-ENTRY
?CND2: COLOR 1,1
ZERO? NO-WAIT \TRUE
ZERO? DEMO-VERSION? /?CCL9
ICALL2 INPUT-DEMO,1
JUMP ?CND7
?CCL9: INPUT 1
?CND7: ICALL1 MOUSE-INPUT?
SET 'CURRENT-SPLIT,TEXT-WINDOW-PIC-LOC
SCREEN S-TEXT
ICALL1 V-$REFRESH
RTRUE
.FUNCT OTHER-FLATHEADS-F
EQUAL? PRSA,V?RESEARCH \FALSE
CALL ADJ-USED?,OTHER-FLATHEADS,W?MICHAEL
ZERO? STACK /?CCL6
PRINTR """A popular musician, formerly of the Flathead Five."""
?CCL6: CALL ADJ-USED?,OTHER-FLATHEADS,W?KING,W?WURB
ZERO? STACK /?CCL8
PRINTR """Wurb Flathead, son of Idwit Oogle Flathead, is the current ruler of the Great Underground Empire. The twelfth king in the Flathead dynasty, Wurb assumed the throne in 881 GUE."""
?CCL8: CALL ADJ-USED?,OTHER-FLATHEADS,W?OLIVER,W?WENDELL
ZERO? STACK /?CCL10
PRINTR """A noted judge."""
?CCL10: ICALL PERFORM,V?RESEARCH,BABE-PORTRAIT
RTRUE
.FUNCT SAINTS-F
EQUAL? PRSA,V?RESEARCH \FALSE
PRINTI """The patron saint of "
CALL NOUN-USED?,SAINTS,W?BALHU
ZERO? STACK /?CCL6
PRINTI "circus performers"
JUMP ?CND4
?CCL6: CALL NOUN-USED?,SAINTS,W?HONKO
ZERO? STACK /?CCL8
PRINTI "people who play very odd musical instruments"
JUMP ?CND4
?CCL8: CALL NOUN-USED?,SAINTS,W?QUAKKO
ZERO? STACK /?CCL10
PRINTI "people who aren't sure of things"
JUMP ?CND4
?CCL10: CALL NOUN-USED?,SAINTS,W?WISKUS
ZERO? STACK /?CCL12
PRINTI "all those who raise meat animals"
JUMP ?CND4
?CCL12: PRINTI "those who design fine slate patios"
?CND4: PRINTR "."""
.FUNCT WIZARD-OF-FROBOZZ-F
EQUAL? PRSA,V?RESEARCH \FALSE
CALL2 GET-NP,WIZARD-OF-FROBOZZ
GET STACK,4
ZERO? STACK /?CCL6
PRINTR """A former member of the Circle of Enchanters, the Wizard of Frobozz was removed for forgetfulness bordering on senility. Among his other failings, he developed an inability to cast any spells other than those beginning with the letter 'F'. He was banished to an obscure corner of the Empire after he accidentally turned the entire West Wing of Dimwit Flathead's castle into a mountain of Fudge."""
?CCL6: PRINTR """An ancient province in the northern part of the westlands, Frobozz is the site of many historic sites such as Galepath, Mareilon, and the Castle Largoneth."""
.FUNCT ARMOR-F
EQUAL? PRSA,V?TOUCH \?CCL3
INC 'ARMOR-TOUCH
EQUAL? ARMOR-TOUCH,3 \?CCL6
IN? SCROLL,LOCAL-GLOBALS \?CND7
REMOVE SCROLL
?CND7: MOVE LANCE,HERE
PRINTI "The armor opens and a lance falls out!"
CRLF
CALL2 INC-SCORE,12
RSTACK
?CCL6: EQUAL? ARMOR-TOUCH,1,2 \FALSE
PRINTI "It "
EQUAL? ARMOR-TOUCH,2 \?CND11
PRINTI "still "
?CND11: PRINTR "feels like metal."
?CCL3: EQUAL? PRSA,V?TAKE \?CCL14
PRINTR "The armor is permanently mounted as part of the library decor."
?CCL14: EQUAL? PRSA,V?ENTER \?CCL16
PRINTR "The armor was made for a much shorter person -- or at least a person with a much flatter head."
?CCL16: EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "This battle-scarred armor is the sort that was worn around the time of the Battle of Ragweed Gulch."
.ENDSEG
.ENDI

585
library.zil Normal file
View File

@ -0,0 +1,585 @@
"LIBRARY for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<INCLUDE "PDEFS">
<BEGIN-SEGMENT CASTLE>
<ROOM LIBRARY
(LOC ROOMS)
(REGION "Flatheadia")
(DESC "Library")
(LDESC
"This dust-filled chamber once contained copies of every book ever written,
but all of them have been taken by the fleeing populace as reading material
for their long journeys to safe havens. The only exit is south.")
(SOUTH TO EAST-WING)
(OUT TO EAST-WING)
(FLAGS RLANDBIT ONBIT)
(SYNONYM LIBRARY)
(MAP-LOC <PTABLE MAIN-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-8>)
(ICON LIBRARY-ICON)
(ACTION LIBRARY-F)
(THINGS
<> ( ANSWER RIDDLE)
"\"Nice try, but no help here! (signed) The Jester.\""
FROBOZZCO ( FROBOZZCO INTERNATIONAL)
"\"FrobozzCo International is a vast conglomerate of thousands upon thousands
of companies. It can trace its origin to the Frobozz Magic Cave Company, which
was formed at the behest of King Duncanthraz in 668 GUE. Headquartered in the
400-story FrobozzCo Building in Flatheadia, FrobozzCo's corporate motto is
'You name it, we do it!'\""
( GREAT UNDERGROUND) ( HIGHWAY TOLL)
"\"The Great Underground Highway is a system of toll roads stretching
thoughout both the eastland and westland provinces.\""
<> SQUID
"\"A bottom-dwelling aquatic creature.\""
<> HELLHOUND
"\"When you spot a hellhound, run in the other direction as fast as you can!
Hellhounds are fast, fierce, and capable of devouring a human twelve times
their size in three-and-a-half seconds. They normally inhabit burnt-out or
enchanted woods and rarely venture beyond their turf, even in pursuit of
prey.\""
<> SNARFEM
"\"Snarfem, a two-player game of removing pebbles, originated in
Mithicus and comes from an ancient Mithican word meaning 'to collect
pebbles or small stones.'\""
<> FISHA
"\"Fisha is a small wand producer in Foozle, specializing in Wands of
Inanimation. Their wands tend to have a very limited life.\""
( BOZBO MUMBO ZILBO) ( BOZBO MUMBO ZILBO II III IV)
"\"One of the kings of the Entharion Dynasty.\""
<> ( BELWIT MUMBERTHRAX PHLOID)
"\"One of the kings of the Flathead Dynasty.\""
<> ( ESTUARY FROBUARY ARCH ;ORACLE MAGE JAM JELLY AUGUR SUSPENDUR
OTTOBUR MUMBERBUR DISMEMBUR)
"\"A month of the year.\""
<> ( EASTLAND EASTLANDS)
"\"The eastlands comprise those provinces which lie on the eastern
shore of the Great Sea, such as Flatheadia and the Fublio Valley.\""
<> ( WESTLAND WESTLANDS)
"\"The westlands comprise those provinces which lie on the western
shore of the Great Sea, such as Borphee, Gurth and Frobozz.\""
MITHICAN CHAMELEON
"\"A Mithican chameleon skin's is said to be able to imitate any color
the eye can see... and more.\""
CURSE ( CURSE DAY)
"\"Curse Day is the anniversary of the death of Lord Dimwit Flathead the
Excessive. Some aver that, on that day in 779 GUE, a great wizard cast a
mighty Curse, and that on the 94th anniversary of that day the Empire will
collapse. Historians today dismiss this as a silly schoolyard legend.\""
<> ( ZORKMID ZORKMIDS)
"\"The Zorkmid is the unit of currency of the Great Underground Empire.\""
ENCHANTER ( ENCHANTER GUILD)
"\"The Enchanter's Guild has several thousand members scattered in chapters
throughout the land. Amongst the more influential chapters are the ones
located in Thriff and Accardi.\""
FROBLO PARK
"\"Froblo Park was Thomas Alva Edison's laboratory.\""
BOSWELL BARWELL
"\"The official biographer of the Flatheads, Boswell Barwell is the author
of such notable works as THE LIVES OF THE TWELVE FLATHEADS and MUMBERTHRAX:
THE MAN BEHIND THE LEGEND.\""
<> MINX
"\"An irrestibly cuddly animal.\""
<> WINDCAT
"\"The fleetest land animal.\""
ENDLESS FIRE
"\"The Endless Fire destroyed Mareilon in 773 GUE.\""
<> ZORK
"There's no entry for \"Zork.\" Not surprising. This is just the prequel;
it hasn't been written yet!"
<> DAVMAR
"\"Davmar was the great Thaumaturgist who discovered that the power of
magic spells could be stored on paper scrolls.\""
<> PHEEBOR
"\"Along with Borphee, Pheebor was one of the great city-states that lay at
the convergence of the Bor River and the Phee River. Borphee defeated Pheebor
in a massive battle that took place long before the age of Entharion.\""
<> ( BLOIT BLOITS)
"\"The bloit is the Empire's most common unit for measuring distances. The
bloit is defined as the distance the king's favorite pet runs in an hour.
As the discerning reader can tell from this definition, the length of the
bloit changes dramatically from ruler to ruler. (Rarely more dramatically
than in 619 GUE, when Bozbo IV -- who adored his windcat -- died, and was
succeeded by Mumbo II -- who was equally enamored of his very, very ancient
turtle). Land is usually measured in square bloits.\""
FUBLIO VALLEY
"\"Once a richly verdant area at the southern tip of the Flathead Mountains,
the valley was defoliated in the late eighth century. For some odd reason, it
has always been a favorite spot for wizards who enjoy a hermitic lifestyle.\""
<> KORBOZ
"\"A moderately famous hermit enchanter.\""
<> GUMBOZ
"\"A very obscure hermit enchanter.\""
( FLOOD CONTROL DAM FCD) ( \#3 FCD\#3 DAM)
"The entry describes Flood Control Dam #3 as a great engineering feat of the
late 8th century, made possible by a grant of 37 million zorkmids from Dimwit
Flathead the Excessive. The dam forms a huge reservoir, and its spillover is
the source of the Frigid River. The article goes into construction techniques,
the dam's appeal as a tourist attraction, and the financial impact of the
dam's cost on the economy of the GUE."
DIABLO MASSACRE
"\"The Diablo Massacre occured at the Zorbel Pass in 666 GUE when the invading
armies of King Duncanthrax met a native militia of trollish warriors. The
invaders were outnumbered but well-armed; the natives were equipped only with
wooden clubs and a large piece of very strong garlic. Military historians
consider the routing of the native militia as a key moment in the conquering
of the eastlands.\""
ZORBIUS BLATTUS
"\"Greatest of the modern philosophers, Zorbius Blattus is a popular debunker
of Brogmoidism and other strange religious sects.\""
<> ( SHADOWLAND LAND SHADOW)
"\"The Shadowland (a.k.a. the Land of Shadow) is a barren area of rolling
hills, south of Flatheadia and deep underground. It lies near the point where
the Flathead Ocean's eastern shore dips underground.\""
ROYAL MUSEUM
"\"The Royal Museum, built by Lord Dimwit Flathead in 777 GUE, houses
the crown jewels, a technology display, and a famous royal puzzle-maze.\""
ROCKVILLE ( ESTATES CONSTRUCTION)
"\"Rockville Estates is an upscale housing complex being planned by the
Frobozz Magic Construction Company for a piece of prime cavern space on
the Great Underground Highway near Flatheadia. It was designed by the
renowned architect, Zylo Pickthorn.\""
ZYLO PICKTHORN
"\"An architect known for his underground condominium complexes, Pickthorn
is an avid enthusiast of jousting, chess, and tiddlywinks, and has been
known to incorporate some or all of these themes into his designs.\""
MOUNT FOOBIA
"\"Foobia is the tallest peak in the Flathead Mountains, perhaps in the entire
world. It lies toward the southern end of the range, near the Zorbel Pass, and
its apex is always hidden by clouds. It is believed that no one has ever
scaled this mighty peak.\""
( STEVE STEVEN) MERETZKY
"\"A mysterious mage who is said to live in the lands beyond the borders
of the world.\""
<> INFOCOM
"The entry simply reads, \"There are some things that man was not meant
to know.\""
( FRIGID RIVER) VALLEY
"\"The Frigid River Valley, a province of the Great Underground Empire,
encompasses the 15,322 square bloits which form the runoff basin of the
Frigid River.\""
POLAR GUMFFBEAST
"\"A creature, possibly mythical, said to live in the extreme northlands
of Quendor.\""
<> DUNCANTHRAX
"\"Duncanthrax the Bellicose, the first king of the Flathead Dynasty, took
the throne from Zilbo III during a palace revolt on the last day of 659 GUE.
Duncanthrax expanded the kingdom by conquering Antharia and most of the
eastlands. He also moved the capital from Largoneth to Egreth.\""
( EGRETH CASTLE) ( EGRETH CASTLE)
"\"The Castle Egreth served as the seat of royal power from the reign of
Duncanthrax (who moved the capital from Largoneth in 660 GUE) through the
reign of Dimwit (who moved the capital to Flatheadia in 771 GUE). Egreth was,
and still is, reputed to be the most dangerous locale in the kingdom.\""
( LARGONETH CASTLE) ( CASTLE LARGONETH)
"\"The Castle Largoneth was built by Entharion the Wise back in the misty
times at the dawn of the empire. It served as the capital of the kingdom
until Duncanthrax constructed Egreth in 660 GUE. Largoneth still stands,
lonely and deserted, on the coast of Frobozz.\""
FROBESIUS ( FROBESIUS FUBLIUS)
"\"Frobesius Fublius was a painter who specialized in rebuses. A mysterious
figure, he reputedly lived near the Zorbel Pass and vanished toward the end
of the eighth century.\""
BORPHBELLY ( STEW INGREDIENTS)
BORPHBELLY-TEXT
<> FENSHIRE
"\"Fenshire is a swampy region which stretches east of the Flathead Mountains
to the edge of the world. The summer castle of the Flatheads is located
in a remote section of Fenshire.\""
<> CHESS
"\"An ancient game of warfare, playing on a checkered field of 64 squares.\""
<> CURSE
"According to this article, Megaboz was a mysterious wizard who lived a
hermit's life in the Fublio Valley. It is said he cast a Curse which will
someday bring down the Empire, but royal spokesmen have denied all such
rumors. Megaboz vanished in 789 GUE; some say the effort of casting the
Curse destroyed him."
<> ( TREATY ZNURG)
"\"The Treaty of Znurg, signed in 474 GUE, ended the Zucchini Wars.\""
ZUCCHINI ( WAR WARS)
"\"The Zucchini Wars, which devastated seven provinces during the fifth
century, were finally ended by the Treaty of Znurg.\""
RAGWEED ( BATTLE GULCH)
"\"The Battle of Ragweed Gulch, fought in 789 GUE, is most notable for the
death of Stonewall Flathead.\""
<> ( BARBEL BERKNIP BARSAP)
"\"A respected member of the Enchanters Guild.\""
GREATER BORPHEE
"\"Borphee, a large industrial city in the westlands, is the capital of the
Greater Borphee province.\""
<> INQUISITION
"\"A crackpot religious sect; its followers believe that the Curse of Megaboz
can be forestalled by executing every person in the Empire.\""
<> ( GRUBBO GRUBBO-BY-THE-SEA ACCARDI ACCARDI-BY-THE-SEA)
"\"A small village in the westlands.\""
<> ( WISHYFOO WISHYFOOS)
"\"The Wishyfoo, who live in the vicinity of Port Foozle, alternately tell
the truth and tell a lie with every successive statement they make. Sometimes
they start with a lie, sometimes with a truth, but they always alternate
thereafter.\""
<> PREVARICON
"\"The Prevaricons, who dwell near Port Foozle, have two interesting quirks:
They always lie, and they feed unwelcome visitors to ravenous hellhounds.\""
<> ( VERITASSI VERITASS)
"\"The Veritassi, who dwell near Port Foozle, have two interesting quirks:
They never lie, and they feed unwelcome visitors to ravenous hellhounds.\""
<> MIZNIA
"\"A province at the southern fringe of the westlands, mostly jungle. Its
capital is Mizniaport.\""
<> MIZNIAPORT
"\"The capital and largest city in Miznia.\""
<> GURTH
"\"This province, which lies to the north of Miznia and Mithicus, is chiefly
woods and farmland. The Fields of Frotzen, in central Gurth, are known as the
Breadbasket of Quendor. The capital of the province is Gurth City.\""
GURTH CITY
"\"Gurth City is the capital of Gurth province.\""
<> MITHICUS
"\"This small, mountainous province, sandwiched between Gurth and Miznia,
is a popular vacation spot.\""
<> ( FIELDS FROTZEN)
"\"The Fields of Frotzen, fertile farmland in the heart of Gurth province,
produces an annual bounty of grain and are freqently referred to as the
Breadbasket of Quendor.\""
<> FESTERON
"\"A small village in Antharia.\""
<> THRIFF
"\"The strange wandering village of Thriff has, at one time or another, been
located in most of the provinces of the westlands. Rumor has it that the
Guildmaster of Thriff's enchanters constantly moves the town in an attempt
to find a more benevolent climate for his terrible hayfever.\""
<> ENTHARION
"\"Entharion the Wise united the warring city-states of Galepath and Mareilon,
forming the kingdom of Quendor. As Quendor's first king, Entharion built the
castle Largoneth, and ruled over a kingdom which was little more than what is
currently the province of Frobozz. Our current calendar dates from the first
year of Entharion's reign.\""
<> ( GALEPATH MAREILON)
"\"Galepath and Mareilon were the two ancient cities of Quendor, which were
united by Entharion the Wise in the distant past. Mareilon was destroyed in
773 GUE by the Endless Fire.\""
<> ANTHARIA
"\"Antharia, the island province, is located in the middle of the Flathead
Ocean. It is known for its shipbuilding, marble cutting, and granola mining
industries, and is the home of Flathead Stadium. The capital is Anthar.\""
<> ANTHAR
"\"The capital of Antharia.\""
GRANOLA ( MINES RIOTS)
"\"The granola mines in northern Antharia once supplied seemingly limitless
quantities of granola. Since the Granola Riots of 865 GUE, the causes of
which are well known, the output of the mines has fallen sharply.\""
FLATHEAD STADIUM
"The entry calls Flathead Stadium \"The House that Babe Built,\" a tribute to
Babe Flathead's popularity as a gate attraction. Located just outside Anthar,
the stadium was supposedly large enough to hold every man, woman, and child in
Quendor."
PORT FOOZLE
"\"Foozle, which lies several bloits west of Flatheadia, is the primary
seaport of the Frigid River Valley, and is a common departure point for
ships to Antharia.\""
<> BELBOZ
"A tiny entry mentions that Belboz is the name of a young enchanter in
the Accardi chapter of the Enchanter's Guild."
ZORBEL PASS
"\"This wide pass through the Flathead Mountains, at the southern end of
the range, connects the Fublio and Frigid River valleys. The Zorbel Pass
was the site of the Diablo Massacre in 666 GUE.\""
<> QUENDOR
"\"See GREAT UNDERGROUND EMPIRE.\""
( GREAT UNDERGROUND) ( EMPIRE GUE)
"\"The kingdom of Quendor was renamed the Great Underground Empire by Lord
Dimwit Flathead when he became ruler in 770 GUE. It encompasses all the
lands on both sides of the Great Sea, although most of the underground
portions of the empire are in the eastlands.\""
GREAT SEA
"\"See FLATHEAD OCEAN.\""
ARAGAIN FALLS
"The article calls Aragain Falls the most breathtaking and awesome waterfall
in all the known lands. Found toward the northern part of the Frigid River,
the falls are a popular honeymoon spot."
TWELVE FLATHEADS
"[Please see \"The Lives of the Twelve Flatheads Calendar\" that came in your
Zork Zero package.]")>
<CONSTANT BORPHBELLY-TEXT
"\"A popular lunchtime meal in the province of Fenshire, Borphbelly Stew
is made from fox, fowl, and earthworm. Proper preparation mandates the
simultaneous addition of the ingredients to a boiling cookpot.\"">
<ROUTINE LIBRARY-F ("OPT" (RARG <>))
<COND (<AND <EQUAL? .RARG ,M-BEG>
<EQUAL? ,PSEUDO-OBJECT ,PRSO ,PRSI>>
<COND (<AND <VERB? RESEARCH>
,LIT
<EQUAL? ,PRSI <> ,ENCYCLOPEDIA ,ROOMS>>
<SETG VOLUME-USED T>
;"in DEFS2, TEST-THINGS stuffs the encyclopedia text
into the PSEUDO-OBJECT's ACTION property -- only
in this case"
<TELL <GETP ,PRSO ,P?ACTION> CR>)
(T
<PUTP ,PSEUDO-OBJECT ,P?ACTION <>>
<>)>)>>
<OBJECT ENCYCLOPEDIA
(LOC LIBRARY)
(DESC "Encyclopedia Frobozzica")
(LDESC
"A copy of the Encyclopedia Frobozzica is the only book still left in the
Library, probably because it's so huge that it can't be moved except by
a team of mules.")
(SYNONYM ENCYCLOPEDIA FROBOZZICA BOOK)
(ADJECTIVE LARGE ENCYCLOPEDIA)
(FLAGS READBIT VOWELBIT)
(TEXT
"The cover reads \"Encyclopedia Frobozzica, Illustrated Edition. Copyright
882 GUE. A publication of the Frobozz Magic Encyclopedia Company.\" It would
take weeks to read the entire encyclopedia, but you could read about specific
persons or things.")
(ACTION ENCYCLOPEDIA-F)>
<GLOBAL VOLUME-USED <>>
<ROUTINE ENCYCLOPEDIA-F ()
<COND (<VERB? EXAMINE>
<TELL "The volume lies open to ">
<COND (,VOLUME-USED
<TELL "a random entry." CR>)
(T
<TELL "an entry about Double Fanucci: ">
<PERFORM ,V?RESEARCH ,DOUBLE-FANUCCI>
<TELL
" You could probably read about all sorts of other interesting people,
places, and things by looking them up in the encyclopedia." CR>)>)
(<AND <VERB? RESEARCH>
<PRSI? ,ENCYCLOPEDIA>>
<TELL
"\"The Encyclopedia Frobozzica, a publication of the Frobozz Magic Encyclopedia
Company, is the finest of its kind in the known world. All entries are
meticulously compiled by the Frobozz Magic Encyclopedia Research Company, the
illustrations are faithfully reproduced by the Frobozz Magic Encyclopedia
Illustration Company, and the facts are all double, triple, and
quadruple-checked by the Frobozz Magic Encyclopedia Accuracy and Verification
Company. No library should be without one!\"" CR>)
(<VERB? OPEN>
<TELL "It is." CR>)
(<VERB? CLOSE>
<TELL "Why bother?" CR>)
(<VERB? TAKE>
<TELL "Do you have a team of mules handy?" CR>)
(<VERB? LOOK-INSIDE>
<PERFORM ,V?READ ,PRSO>
<RTRUE>)>>
<OBJECT FOUR-FLIES
(LOC GENERIC-OBJECTS)
(DESC "it")
(SYNONYM FLIES FAMATHRIA)
(ADJECTIVE FOUR FANTASTIC INT.NUM)
(OWNER FOUR-FLIES)
(PICTURE FOUR-FLIES-ILL)
(RESEARCH
"The Four Fantastic Flies of Famathria, each bigger and more succulent than
the last, is a legend fabricated by a race of toad creatures who once lived
somewhere beyond the oceans of the world. Seafarers report that these toads
were ugly, cantankerous, and eternally hungry.")
(ACTION ENC-ENTRY-F)>
<OBJECT ZILBEETHA
(LOC GENERIC-OBJECTS)
(SYNONYM ZILBEETHA)
(PICTURE ZILBEETHA-ILL)
(RESEARCH
"This is one of the oldest and dearest legends in the annals of Quendor.
Zilbeetha, a beautiful maiden, somehow angered an evil mage, and was placed
under enchantment and turned into a crystal orb on the very day that she was
to be wed. The heartbroken groom, who is always depicted holding a fragile
bloom, sought help from the wizard's goodly twin. The good wizard turned the
groom to stone, that he might stay young until the day Zilbeetha was returned
to him. The legend also has an ominous note; returning a false orb would
result in death.")
(ACTION ENC-ENTRY-F)>
<OBJECT BROGMOIDISM
(LOC GENERIC-OBJECTS)
(SYNONYM BROGMOIDISM)
(PICTURE BROGMOIDISM-ILL)
(RESEARCH
"Brogmoidists, followers of the tenets of Brogmoidism, believe that a Great
Brogmoid supports the world upon his shoulders. The religion, which originated
sometime during the fourth century, is commonly ridiculed nowadays, and has
lost most of its adherents.")
(ACTION ENC-ENTRY-F)>
<OBJECT FLATHEADIA
(LOC GENERIC-OBJECTS)
(SYNONYM FLATHEADIA)
(PICTURE FLATHEADIA-ILL)
(RESEARCH
"Flatheadia has been the capital of the Great Underground Empire since Dimwit
built his castle there in 770 GUE. (The former seat of royal government was
Egreth, in the Westlands.) Although still the largest population center in
the Eastlands, Flatheadia has been in a steady decline since a Curse cast by
Megaboz toward the end of the last century.")
(ACTION ENC-ENTRY-F)>
<ROUTINE ENC-ENTRY-F ()
<COND (<VERB? RESEARCH>
<COND (<AND <PRSO? ,FOUR-FLIES>
<ADJ-USED? ,FOUR-FLIES ,W?INT.NUM>
<NOT <EQUAL? ,P-NUMBER 4>>>
<SETG PRSO <>>
<RFALSE>)>
<PICTURED-ENTRY <GETP ,PRSO ,P?PICTURE> <GETP ,PRSO ,P?RESEARCH>>)>>
<ROUTINE PICTURED-ENTRY (ENC-PIC ENC-TEXT "OPT" (NO-WAIT <>))
<CLEAR -1>
<SCREEN ,S-FULL>
<SETG CURRENT-SPLIT ,ENC-PIC-LOC>
<DISPLAY ,ENC-BORDER 1 1>
<PICINF-PLUS-ONE ,ENC-PIC-LOC>
<DISPLAY .ENC-PIC <GET ,PICINF-TBL 0> <GET ,PICINF-TBL 1>>
<PICINF-PLUS-ONE ,ENC-TXT-LOC>
<WINPOS 3 <GET ,PICINF-TBL 0> <GET ,PICINF-TBL 1>>
<PICINF ,ENC-TXT-WINDOW-SIZE ,PICINF-TBL>
<WINSIZE 3 <GET ,PICINF-TBL 0> <GET ,PICINF-TBL 1>>
<WINATTR 3 15>
<SCREEN 3>
<CURSET 1 1>
<COLOR 1 -1>
<COND (.ENC-TEXT
<TELL .ENC-TEXT>)
(T
<J-ENTRY>)>
<COLOR 1 1>
<COND (.NO-WAIT
<RTRUE>)>
<COND (,DEMO-VERSION?
<INPUT-DEMO 1>)
(T
<INPUT 1>)>
<MOUSE-INPUT?>
<SETG CURRENT-SPLIT ,TEXT-WINDOW-PIC-LOC>
<SCREEN ,S-TEXT>
<V-$REFRESH>
<RTRUE>>
<OBJECT OTHER-FLATHEADS
(DESC "member of the Flathead family")
(SYNONYM FLATHEAD)
(ADJECTIVE MICHAEL WURB KING OLIVER WENDELL)
(ACTION OTHER-FLATHEADS-F)>
<ROUTINE OTHER-FLATHEADS-F ()
<COND (<VERB? RESEARCH>
<COND (<ADJ-USED? ,OTHER-FLATHEADS ,W?MICHAEL>
<TELL
"\"A popular musician, formerly of the Flathead Five.\"" CR>)
(<ADJ-USED? ,OTHER-FLATHEADS ,W?KING ,W?WURB>
<TELL
"\"Wurb Flathead, son of Idwit Oogle Flathead, is the current ruler of the
Great Underground Empire. The twelfth king in the Flathead dynasty, Wurb
assumed the throne in 881 GUE.\"" CR>)
(<ADJ-USED? ,OTHER-FLATHEADS ,W?OLIVER ,W?WENDELL>
<TELL "\"A noted judge.\"" CR>)
(T
<PERFORM ,V?RESEARCH ,BABE-PORTRAIT>
<RTRUE>)>)>>
<OBJECT SAINTS
(DESC "saint")
(SYNONYM SAINT ST BALHU HONKO QUAKKO BOVUS WISKUS)
(ADJECTIVE SAINT ST)
(FLAGS NDESCBIT VOWELBIT)
(ACTION SAINTS-F)>
<ROUTINE SAINTS-F ()
<COND (<VERB? RESEARCH>
<TELL "\"The patron saint of ">
<COND (<NOUN-USED? ,SAINTS ,W?BALHU>
<TELL "circus performers">)
(<NOUN-USED? ,SAINTS ,W?HONKO>
<TELL "people who play very odd musical instruments">)
(<NOUN-USED? ,SAINTS ,W?QUAKKO>
<TELL "people who aren't sure of things">)
(<NOUN-USED? ,SAINTS ,W?WISKUS>
<TELL "all those who raise meat animals">)
(T ;Wiskus
<TELL "those who design fine slate patios">)>
<TELL ".\"" CR>)>>
<OBJECT WIZARD-OF-FROBOZZ
(DESC "Wiazard of Frobozz")
(SYNONYM WIZARD FROBOZZ)
(OWNER WIZARD-OF-FROBOZZ)
(ACTION WIZARD-OF-FROBOZZ-F)>
<ROUTINE WIZARD-OF-FROBOZZ-F ()
<COND (<VERB? RESEARCH>
<COND (<NP-OF <GET-NP ,WIZARD-OF-FROBOZZ>>
;"input was READ ABOUT WIZARD OF FROBOZZ"
<TELL
"\"A former member of the Circle of Enchanters, the Wizard of Frobozz was
removed for forgetfulness bordering on senility. Among his other failings,
he developed an inability to cast any spells other than those beginning with
the letter 'F'. He was banished to an obscure corner of the Empire after
he accidentally turned the entire West Wing of Dimwit Flathead's castle into
a mountain of Fudge.\"" CR>)
(T
;"input was READ ABOUT FROBOZZ"
<TELL
"\"An ancient province in the northern part of the westlands, Frobozz
is the site of many historic sites such as Galepath, Mareilon, and the
Castle Largoneth.\"" CR>)>)>>
<OBJECT ARMOR
(LOC LIBRARY)
(OWNER ARMOR)
(DESC "suit of armor")
(SYNONYM SUIT ARMOR ARMOUR)
(FLAGS TRYTAKEBIT)
(ACTION ARMOR-F)>
<GLOBAL ARMOR-TOUCH 0>
<ROUTINE ARMOR-F ()
<COND (<VERB? TOUCH>
<SETG ARMOR-TOUCH <+ ,ARMOR-TOUCH 1>>
<COND (<EQUAL? ,ARMOR-TOUCH 3>
<COND (<IN? ,SCROLL ,LOCAL-GLOBALS>
;"don't bother having jester deliver it"
<REMOVE ,SCROLL>)>
<MOVE ,LANCE ,HERE>
<TELL "The armor opens and a lance falls out!" CR>
<INC-SCORE 12>)
(<EQUAL? ,ARMOR-TOUCH 1 2>
<TELL "It ">
<COND (<EQUAL? ,ARMOR-TOUCH 2>
<TELL "still ">)>
<TELL "feels like metal." CR>)
(T
<RFALSE>)>)
(<VERB? TAKE>
<TELL
"The armor is permanently mounted as part of the library decor." CR>)
(<VERB? ENTER>
<TELL
"The armor was made for a much shorter person -- or at least a person with
a much flatter head." CR>)
(<VERB? EXAMINE>
<TELL
"This battle-scarred armor is the sort that was worn around the time of
the Battle of Ragweed Gulch." CR>)>>
<OBJECT LANCE
(DESC "lance")
(SYNONYM LANCE)
(FLAGS TAKEBIT MAGICBIT)
(SIZE 10)
(VALUE 0) ;"12 points given elsewhere">
<END-SEGMENT>

65
misc.zabstr Normal file
View File

@ -0,0 +1,65 @@
<BEGIN-SEGMENT 0>
<INCLUDE "PDEFS">
<TELL-TOKENS (CRLF CR) <CRLF> D * <DPRINT .X> A * <APRINT .X> T ,PRSO <
TPRINT-PRSO> T ,PRSI <TPRINT-PRSI> T * <TPRINT .X> AR * <ARPRINT .X> TR * <
TRPRINT .X> N * <PRINTN .X> C * <PRINTC .X> T-IS-ARE * <IS-ARE-PRINT .X>>
<DEFMAC VERB? ("ARGS" ATMS) <MULTIFROB PRSA .ATMS>>
<DEFMAC PRSO? ("ARGS" ATMS) <MULTIFROB PRSO .ATMS>>
<DEFMAC PRSI? ("ARGS" ATMS) <MULTIFROB PRSI .ATMS>>
<DEFMAC ROOM? ("ARGS" ATMS) <MULTIFROB HERE .ATMS>>
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) ATM) <REPEAT () <COND
(<EMPTY? .ATMS> <RETURN <COND (<LENGTH? .OO 1> <ERROR .X>) (<LENGTH? .OO 2> <
NTH .OO 2>) (ELSE <CHTYPE .OO FORM>)>>)> <REPEAT () <COND (<EMPTY? .ATMS> <
RETURN>)> <SET ATM <NTH .ATMS 1>> <SET L (<COND (<TYPE? .ATM ATOM> <CHTYPE <
COND (<==? .X PRSA> <PARSE <STRING "V?" <SPNAME .ATM>>>) (ELSE .ATM)> GVAL>) (
ELSE .ATM)> !.L)> <SET ATMS <REST .ATMS>> <COND (<==? <LENGTH .L> 3> <RETURN>)>
> <SET O <REST <PUTREST .O (<FORM EQUAL? <CHTYPE .X GVAL> !.L>)>>> <SET L ()>>>
<DEFMAC BSET ('OBJ "ARGS" BITS) <MULTIBITS FSET .OBJ .BITS>>
<DEFMAC BCLEAR ('OBJ "ARGS" BITS) <MULTIBITS FCLEAR .OBJ .BITS>>
<DEFMAC BSET? ('OBJ "ARGS" BITS) <MULTIBITS FSET? .OBJ .BITS>>
<DEFINE MULTIBITS (X OBJ ATMS "AUX" (O ()) ATM) <REPEAT () <COND (<EMPTY? .ATMS
> <RETURN <COND (<LENGTH? .O 1> <NTH .O 1>) (<EQUAL? .X FSET?> <FORM OR !.O>) (
ELSE <FORM PROG () !.O>)>>)> <SET ATM <NTH .ATMS 1>> <SET ATMS <REST .ATMS>> <
SET O (<FORM .X .OBJ <COND (<TYPE? .ATM FORM> .ATM) (ELSE <FORM GVAL .ATM>)>>
!.O)>>>
<DEFMAC PROB ('BASE?) <FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>
<DEFINE-ROUTINE PICK-ONE>
<DEFINE-ROUTINE DPRINT>
<DEFINE-ROUTINE APRINT>
<DEFINE-ROUTINE TPRINT>
<DEFINE-ROUTINE TPRINT-PRSO>
<DEFINE-ROUTINE TPRINT-PRSI>
<DEFINE-ROUTINE ARPRINT>
<DEFINE-ROUTINE TRPRINT>
<DEFINE-ROUTINE IS-ARE-PRINT>
<REPLACE-DEFINITION VERB-ALL-TEST <ROUTINE VERB-ALL-TEST>>
<REPLACE-DEFINITION GAME-VERB? <ROUTINE GAME-VERB?>>
<DEFINE-ROUTINE THIS-IS-IT>
<DEFINE-ROUTINE DONT-IT>
<GLOBAL P-NUMBER 0>
<DEFINE-ROUTINE PERFORM-PRSA>
<REPLACE-DEFINITION CAPITAL-NOUN? <ROUTINE CAPITAL-NOUN?>>
<REPLACE-DEFINITION LIT? <ROUTINE LIT?>>
<CONSTANT C-TABLE <ITABLE NONE 30>>
<GLOBAL CLOCK-WAIT <>>
<GLOBAL C-INTS 60>
<GLOBAL C-MAXINTS 60>
<GLOBAL CLOCK-HAND <>>
<CONSTANT C-TABLELEN 60>
<CONSTANT C-INTLEN 4>
<CONSTANT C-RTN 0>
<CONSTANT C-TICK 1>
<DEFINE-ROUTINE DEQUEUE>
<DEFINE-ROUTINE QUEUED?>
<DEFINE-ROUTINE RUNNING?>
<DEFINE-ROUTINE QUEUE>
<DEFINE-ROUTINE CLOCKER>
<GLOBAL FONT-X 7>
<GLOBAL FONT-Y 10>
<CONSTANT PICINF-TBL <TABLE 0 0>>
<DEFINE-ROUTINE C-PIXELS>
<DEFINE-ROUTINE L-PIXELS>
<DEFINE-ROUTINE CCURSET>
<END-SEGMENT>

424
misc.zap Normal file
View File

@ -0,0 +1,424 @@
.SEGMENT "0"
.FUNCT PICK-ONE,TBL,LENGTH,CNT,RND,MSG,RFROB
GET TBL,0 >LENGTH
GET TBL,1 >CNT
DEC 'LENGTH
ADD TBL,2 >TBL
MUL CNT,2
ADD TBL,STACK >RFROB
SUB LENGTH,CNT
RANDOM STACK >RND
GET RFROB,RND >MSG
GET RFROB,1
PUT RFROB,RND,STACK
PUT RFROB,1,MSG
INC 'CNT
EQUAL? CNT,LENGTH \?CND1
SET 'CNT,0
?CND1: PUT TBL,0,CNT
RETURN MSG
.FUNCT DPRINT,OBJ
GETP OBJ,P?INANIMATE-DESC
ZERO? STACK /?CCL3
FSET? OBJ,ANIMATEDBIT /?CCL3
GETP OBJ,P?INANIMATE-DESC
PRINT STACK
RTRUE
?CCL3: GETP OBJ,P?SDESC
ZERO? STACK /?CCL7
GETP OBJ,P?SDESC
PRINT STACK
RTRUE
?CCL7: PRINTD OBJ
RTRUE
.FUNCT APRINT,OBJ,NOSP,LEN
ZERO? NOSP \?CND1
PRINTC 32
?CND1: CALL2 GET-OWNER,OBJ >LEN
ZERO? LEN /?CCL5
GETP OBJ,P?OWNER
EQUAL? LEN,STACK /?CCL5
EQUAL? LEN,PROTAGONIST \?CCL10
PRINTI "your "
JUMP ?CND3
?CCL10: EQUAL? LEN,OBJ /?CND3
ICALL APRINT,LEN,TRUE-VALUE
PRINTI "'s "
JUMP ?CND3
?CCL5: FSET? OBJ,NARTICLEBIT /?CND3
FSET? OBJ,VOWELBIT \?CCL15
PRINTI "an "
JUMP ?CND3
?CCL15: PRINTI "a "
?CND3: CALL2 DPRINT,OBJ
RSTACK
.FUNCT TPRINT,OBJ,NOSP,LEN
ZERO? NOSP \?CND1
PRINTC 32
?CND1: CALL2 GET-OWNER,OBJ >LEN
ZERO? LEN /?CCL5
GETP OBJ,P?OWNER
EQUAL? LEN,STACK /?CCL5
EQUAL? LEN,PROTAGONIST \?CCL10
PRINTI "your "
JUMP ?CND3
?CCL10: EQUAL? LEN,OBJ /?CND3
ICALL TPRINT,LEN,TRUE-VALUE
PRINTI "'s "
JUMP ?CND3
?CCL5: FSET? OBJ,NARTICLEBIT /?CND3
PRINTI "the "
?CND3: CALL2 DPRINT,OBJ
RSTACK
.FUNCT TPRINT-PRSO
CALL2 TPRINT,PRSO
RSTACK
.FUNCT TPRINT-PRSI
CALL2 TPRINT,PRSI
RSTACK
.FUNCT ARPRINT,OBJ
ICALL2 APRINT,OBJ
PRINT PERIOD-CR
RTRUE
.FUNCT TRPRINT,OBJ
ICALL2 TPRINT,OBJ
PRINT PERIOD-CR
RTRUE
.FUNCT IS-ARE-PRINT,OBJ
FSET? OBJ,NARTICLEBIT \?CCL3
PRINTC 32
JUMP ?CND1
?CCL3: PRINTI " the "
?CND1: ICALL2 DPRINT,OBJ
FSET? OBJ,PLURALBIT \?CCL6
PRINTI " are "
RTRUE
?CCL6: PRINTI " is "
RTRUE
.FUNCT VERB-ALL-TEST,OO,II,L
LOC OO >L
EQUAL? OO,ROOMS \?CCL3
INC 'P-NOT-HERE
RFALSE
?CCL3: EQUAL? PRSA,V?TAKE \?CCL5
ZERO? II /?CCL5
IN? OO,II \FALSE
?CCL5: ZERO? II /?CCL11
EQUAL? PRSO,II /FALSE
?CCL11: EQUAL? PRSA,V?TAKE \?CCL15
FSET? OO,TAKEBIT /?CCL18
FSET? OO,TRYTAKEBIT \FALSE
?CCL18: FSET? OO,NALLBIT /FALSE
ZERO? II \TRUE
CALL2 ULTIMATELY-IN?,OO
ZERO? STACK /TRUE
RFALSE
?CCL15: EQUAL? PRSA,V?PUT-ON,V?PUT,V?DROP /?PRD30
EQUAL? PRSA,V?SGIVE,V?GIVE \?CCL28
?PRD30: IN? OO,WINNER \FALSE
?CCL28: EQUAL? PRSA,V?PUT-ON,V?PUT \?CCL34
IN? OO,WINNER /?CCL34
CALL ULTIMATELY-IN?,OO,II
ZERO? STACK \FALSE
?CCL34: EQUAL? PRSA,V?WEAR \?CCL39
FSET? OO,WORNBIT /FALSE
FSET? OO,WEARBIT \FALSE
?CCL39: EQUAL? OO,II /FALSE
RTRUE
.FUNCT GAME-VERB?
EQUAL? PRSA,V?$COMMAND,V?$UNRECORD,V?$RECORD /TRUE
EQUAL? PRSA,V?$REFRESH,V?$VERIFY,V?$RANDOM /TRUE
EQUAL? PRSA,V?RESTART,V?RESTORE,V?SAVE /TRUE
EQUAL? PRSA,V?UNSCRIPT,V?SCRIPT,V?QUIT /TRUE
EQUAL? PRSA,V?VERBOSE,V?SUPERBRIEF,V?BRIEF /TRUE
EQUAL? PRSA,V?NOTIFY,V?CREDITS,V?VERSION /TRUE
EQUAL? PRSA,V?SCORE,V?COLOR,V?HINT /TRUE
EQUAL? PRSA,V?DEFINE,V?MAP,V?TIME /TRUE
EQUAL? PRSA,V?MODE /TRUE
RFALSE
.FUNCT THIS-IS-IT,OBJ
EQUAL? PRSA,V?WALK \?PRD5
EQUAL? PRSO,OBJ /TRUE
?PRD5: EQUAL? OBJ,FALSE-VALUE,ROOMS,ME /TRUE
EQUAL? OBJ,PROTAGONIST /TRUE
CALL DONT-IT,OBJ,LOBSTER,W?NUTCRACKER
ZERO? STACK \TRUE
CALL DONT-IT,OBJ,SNAKE,W?ROPE
ZERO? STACK \TRUE
FSET? OBJ,FEMALEBIT \?CCL14
EQUAL? P-HER-OBJECT,OBJ /?CND15
FCLEAR HER,TOUCHBIT
?CND15: SET 'P-HER-OBJECT,OBJ
RETURN P-HER-OBJECT
?CCL14: FSET? OBJ,ACTORBIT /?CTR17
EQUAL? OBJ,LITTLE-FUNGUS \?CCL18
?CTR17: EQUAL? P-HIM-OBJECT,OBJ /?CND21
FCLEAR HIM,TOUCHBIT
?CND21: SET 'P-HIM-OBJECT,OBJ
EQUAL? OBJ,JESTER,EXECUTIONER /FALSE
EQUAL? P-IT-OBJECT,OBJ /?CND26
FCLEAR IT,TOUCHBIT
?CND26: SET 'P-IT-OBJECT,OBJ
RETURN P-IT-OBJECT
?CCL18: EQUAL? P-IT-OBJECT,OBJ /?CND28
FCLEAR IT,TOUCHBIT
?CND28: SET 'P-IT-OBJECT,OBJ
RETURN P-IT-OBJECT
.FUNCT DONT-IT,OBJ1,OBJ2,WRD
EQUAL? OBJ1,OBJ2 \FALSE
CALL NOUN-USED?,OBJ2,WRD
ZERO? STACK /FALSE
FSET? OBJ2,ANIMATEDBIT \FALSE
CALL2 VISIBLE?,OBJ2
ZERO? STACK \FALSE
RTRUE
.FUNCT PERFORM-PRSA,O,I
ICALL PERFORM,PRSA,O,I
RTRUE
.FUNCT CAPITAL-NOUN?,WRD,TBL
EQUAL? WRD,W?FLATHEAD,W?DIMWIT,W?URSULA /TRUE
EQUAL? WRD,W?MEGABOZ,W?JOHN,W?PIERPONT /TRUE
EQUAL? WRD,W?STONEWALL,W?LUCREZIA,W?SEBASTIAN /TRUE
EQUAL? WRD,W?DAVISON,W?THOMAS,W?ALVA /TRUE
EQUAL? WRD,W?LEONARDO,W?JOHANN,W?RALPH /TRUE
EQUAL? WRD,W?PAUL,W?FRANK,W?LLOYD /TRUE
EQUAL? WRD,W?BABE,W?ZILBO,W?MERETZKY /TRUE
EQUAL? WRD,W?FOOBUS,W?BARBAZZO,W?FERNAP /TRUE
EQUAL? WRD,W?MUMBERTHRAX,W?BOZBO,W?MUMBO /TRUE
EQUAL? WRD,W?PHLOID,W?BELWIT /TRUE
GETPT SAINTS,P?SYNONYM >TBL
ZERO? TBL /?CCL15
PTSIZE TBL
DIV STACK,2
INTBL? WRD,TBL,STACK /TRUE
?CCL15: INTBL? WRD,FUNGUS-WORDS,12 /TRUE
INTBL? WRD,MID-NAME-WORDS,12 /TRUE
RFALSE
.FUNCT LIT?,RM,RMBIT,OHERE,LIT,RES,OLD-OBJECT
ASSIGNED? 'RMBIT /?CND1
SET 'RMBIT,TRUE-VALUE
?CND1: SET 'RES,SEARCH-RES
EQUAL? HERE,UNDERWATER,LAKE-BOTTOM \?CND3
FSET? EXTERIOR-LIGHT,ONBIT \FALSE
?CND3: ZERO? RM \?CND7
SET 'RM,HERE
?CND7: SET 'OHERE,HERE
SET 'HERE,RM
ZERO? RMBIT /?CCL11
FSET? RM,ONBIT \?CCL11
SET 'LIT,HERE
JUMP ?CND9
?CCL11: FSET? WINNER,ONBIT \?CCL15
CALL ULTIMATELY-IN?,WINNER,RM
ZERO? STACK /?CCL15
SET 'LIT,WINNER
JUMP ?CND9
?CCL15: SET 'OLD-OBJECT,RES
PUT OLD-OBJECT,1,0
PUT OLD-OBJECT,2,FALSE-VALUE
PUT OLD-OBJECT,3,FALSE-VALUE
PUT OLD-OBJECT,4,FALSE-VALUE
SET 'OLD-OBJECT,FINDER
PUT OLD-OBJECT,0,ONBIT
PUT OLD-OBJECT,1,FIND-FLAGS-GWIM
PUT OLD-OBJECT,2,FALSE-VALUE
PUT OLD-OBJECT,3,FALSE-VALUE
PUT OLD-OBJECT,4,0
PUT OLD-OBJECT,5,FALSE-VALUE
PUT OLD-OBJECT,6,FALSE-VALUE
PUT OLD-OBJECT,7,FALSE-VALUE
PUT OLD-OBJECT,8,FALSE-VALUE
PUT OLD-OBJECT,9,RES
PUT OLD-OBJECT,10,0
EQUAL? OHERE,RM \?CND18
ICALL FIND-DESCENDANTS,WINNER,7
EQUAL? WINNER,PROTAGONIST /?CND18
IN? PROTAGONIST,RM \?CND18
ICALL FIND-DESCENDANTS,PROTAGONIST,7
?CND18: GET RES,1
ZERO? STACK \?CND24
LOC WINNER
FSET? STACK,VEHBIT \?CND26
LOC WINNER
FSET? STACK,OPENBIT /?CND26
LOC WINNER
ICALL FIND-DESCENDANTS,STACK,7
?CND26: ICALL FIND-DESCENDANTS,RM,7
?CND24: GET RES,1
GRTR? STACK,0 \?CND9
GET RES,4 >LIT
?CND9: SET 'HERE,OHERE
RETURN LIT
.FUNCT DEQUEUE,RTN
CALL2 QUEUED?,RTN >RTN
ZERO? RTN /FALSE
PUT RTN,C-RTN,0
RTRUE
.FUNCT QUEUED?,RTN,C,E
SET 'E,C-TABLE+60
ADD C-TABLE,C-INTS >C
?PRG1: EQUAL? C,E /FALSE
GET C,C-RTN
EQUAL? STACK,RTN \?CND3
GET C,C-TICK
ZERO? STACK /FALSE
RETURN C
?CND3: ADD C,C-INTLEN >C
JUMP ?PRG1
.FUNCT RUNNING?,RTN,C,E
SET 'E,C-TABLE+60
ADD C-TABLE,C-INTS >C
?PRG1: EQUAL? C,E /FALSE
GET C,C-RTN
EQUAL? STACK,RTN \?CND3
GET C,C-TICK
ZERO? STACK /FALSE
GET C,C-TICK
GRTR? STACK,1 /FALSE
RTRUE
?CND3: ADD C,C-INTLEN >C
JUMP ?PRG1
.FUNCT QUEUE,RTN,TICK,C,E,INT
SET 'E,C-TABLE+60
ADD C-TABLE,C-INTS >C
?PRG1: EQUAL? C,E \?CCL5
ZERO? INT /?CCL8
SET 'C,INT
JUMP ?CND6
?CCL8: LESS? C-INTS,C-INTLEN \?CND9
PRINTI "**Too many ints!**"
CRLF
?CND9: SUB C-INTS,C-INTLEN >C-INTS
LESS? C-INTS,C-MAXINTS \?CND11
SET 'C-MAXINTS,C-INTS
?CND11: ADD C-TABLE,C-INTS >INT
?CND6: PUT INT,C-RTN,RTN
JUMP ?REP2
?CCL5: GET C,C-RTN
EQUAL? STACK,RTN \?CCL14
SET 'INT,C
?REP2: ZERO? CLOCK-HAND /?CND16
GRTR? INT,CLOCK-HAND \?CND16
ADD TICK,3
SUB 0,STACK >TICK
?CND16: PUT INT,C-TICK,TICK
RETURN INT
?CCL14: GET C,C-RTN
ZERO? STACK \?CND3
SET 'INT,C
?CND3: ADD C,C-INTLEN >C
JUMP ?PRG1
.FUNCT CLOCKER,E,TICK,RTN,FLG,Q?,OWINNER
ZERO? CLOCK-WAIT /?CCL3
SET 'CLOCK-WAIT,FALSE-VALUE
RFALSE
?CCL3: ZERO? TIME-STOPPED /?CND1
INC 'MOVES
RFALSE
?CND1: ADD C-TABLE,C-INTS >CLOCK-HAND
SET 'E,C-TABLE+60
SET 'OWINNER,WINNER
SET 'WINNER,PROTAGONIST
?PRG5: EQUAL? CLOCK-HAND,E \?CCL9
SET 'CLOCK-HAND,E
INC 'MOVES
SET 'WINNER,OWINNER
RETURN FLG
?CCL9: GET CLOCK-HAND,C-RTN
ZERO? STACK /?CND7
GET CLOCK-HAND,C-TICK >TICK
LESS? TICK,-1 \?CCL13
SUB 0,TICK
SUB STACK,3
PUT CLOCK-HAND,C-TICK,STACK
SET 'Q?,CLOCK-HAND
JUMP ?CND7
?CCL13: ZERO? TICK /?CND7
GRTR? TICK,0 \?CND15
DEC 'TICK
PUT CLOCK-HAND,C-TICK,TICK
?CND15: ZERO? TICK /?CND17
SET 'Q?,CLOCK-HAND
?CND17: GRTR? TICK,0 /?CND7
GET CLOCK-HAND,C-RTN >RTN
ZERO? TICK \?CND21
PUT CLOCK-HAND,C-RTN,0
?CND21: CALL RTN
ZERO? STACK /?CND23
SET 'FLG,TRUE-VALUE
?CND23: ZERO? Q? \?CND7
GET CLOCK-HAND,C-RTN
ZERO? STACK /?CND7
SET 'Q?,TRUE-VALUE
?CND7: ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND
ZERO? Q? \?PRG5
ADD C-INTS,C-INTLEN >C-INTS
JUMP ?PRG5
.FUNCT C-PIXELS,X
SUB X,1
MUL STACK,FONT-X
ADD STACK,1
RSTACK
.FUNCT L-PIXELS,Y
SUB Y,1
MUL STACK,FONT-Y
ADD STACK,1
RSTACK
.FUNCT CCURSET,Y,X,?TMP1
CALL2 L-PIXELS,Y >?TMP1
CALL2 C-PIXELS,X
CURSET ?TMP1,STACK
RTRUE
.ENDSEG
.ENDI

644
misc.zil Normal file
View File

@ -0,0 +1,644 @@
"MISC for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<BEGIN-SEGMENT 0>
<INCLUDE "PDEFS">
;"macros"
<TELL-TOKENS (CRLF CR) <CRLF>
;[D ,SIDEKICK <DPRINT-SIDEKICK>]
D * <DPRINT .X>
A * <APRINT .X>
T ,PRSO <TPRINT-PRSO>
T ,PRSI <TPRINT-PRSI>
T * <TPRINT .X>
AR * <ARPRINT .X>
TR * <TRPRINT .X>
N * <PRINTN .X>
C * <PRINTC .X>
T-IS-ARE * <IS-ARE-PRINT .X>>
<DEFMAC VERB? ("ARGS" ATMS)
<MULTIFROB PRSA .ATMS>>
<DEFMAC PRSO? ("ARGS" ATMS)
<MULTIFROB PRSO .ATMS>>
<DEFMAC PRSI? ("ARGS" ATMS)
<MULTIFROB PRSI .ATMS>>
<DEFMAC ROOM? ("ARGS" ATMS)
<MULTIFROB HERE .ATMS>>
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) ATM)
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .OO 1> <ERROR .X>)
(<LENGTH? .OO 2> <NTH .OO 2>)
(ELSE <CHTYPE .OO FORM>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L
(<COND (<TYPE? .ATM ATOM>
<CHTYPE <COND (<==? .X PRSA>
<PARSE
<STRING "V?"
<SPNAME .ATM>>>)
(ELSE .ATM)> GVAL>)
(ELSE .ATM)>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O <REST <PUTREST .O
(<FORM EQUAL? <CHTYPE .X GVAL> !.L>)>>>
<SET L ()>>>
<DEFMAC BSET ('OBJ "ARGS" BITS)
<MULTIBITS FSET .OBJ .BITS>>
<DEFMAC BCLEAR ('OBJ "ARGS" BITS)
<MULTIBITS FCLEAR .OBJ .BITS>>
<DEFMAC BSET? ('OBJ "ARGS" BITS)
<MULTIBITS FSET? .OBJ .BITS>>
<DEFINE MULTIBITS (X OBJ ATMS "AUX" (O ()) ATM)
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1>
<NTH .O 1>)
(<EQUAL? .X FSET?>
<FORM OR !.O>)
(ELSE
<FORM PROG () !.O>)>>)>
<SET ATM <NTH .ATMS 1>>
<SET ATMS <REST .ATMS>>
<SET O
(<FORM .X
.OBJ
<COND (<TYPE? .ATM FORM> .ATM)
(ELSE <FORM GVAL .ATM>)>>
!.O)>>>
<DEFMAC PROB ('BASE?)
<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>
;"PICK-NEXT expects an LTABLE of strings, with an initial element of 2."
;<ROUTINE PICK-NEXT (TBL "AUX" CNT STR)
<SET CNT <GET .TBL 1>>
<SET STR <GET .TBL .CNT>>
<INC CNT>
<COND (<G? .CNT <GET .TBL 0>>
<SET CNT 2>)>
<PUT .TBL 1 .CNT>
<RETURN .STR>>
<ROUTINE PICK-ONE (TBL "AUX" LENGTH CNT RND MSG RFROB)
<SET LENGTH <GET .TBL 0>>
<SET CNT <GET .TBL 1>>
<SET LENGTH <- .LENGTH 1>>
<SET TBL <REST .TBL 2>>
<SET RFROB <REST .TBL <* .CNT 2>>>
<SET RND <RANDOM <- .LENGTH .CNT>>>
<SET MSG <GET .RFROB .RND>>
<PUT .RFROB .RND <GET .RFROB 1>>
<PUT .RFROB 1 .MSG>
<SET CNT <+ .CNT 1>>
<COND (<==? .CNT .LENGTH>
<SET CNT 0>)>
<PUT .TBL 0 .CNT>
.MSG>
<ROUTINE DPRINT (OBJ)
<COND (<AND <GETP .OBJ ,P?INANIMATE-DESC>
<NOT <FSET? .OBJ ,ANIMATEDBIT>>>
<TELL <GETP .OBJ ,P?INANIMATE-DESC>>)
(<GETP .OBJ ,P?SDESC>
<TELL <GETP .OBJ ,P?SDESC>>)
(T
<PRINTD .OBJ>)>>
<ROUTINE APRINT (OBJ "OPT" (NOSP <>) "AUX" LEN)
<COND (<NOT .NOSP>
<TELL !\ >)>
<COND (<AND <SET LEN <GET-OWNER .OBJ>>
<NOT <EQUAL? .LEN <GETP .OBJ ,P?OWNER>>>>
<COND (<EQUAL? .LEN ,PROTAGONIST>
<TELL "your ">)
(<NOT <EQUAL? .LEN .OBJ>>
<APRINT .LEN T>
<TELL "'s ">)>)
(<NOT <FSET? .OBJ ,NARTICLEBIT>>
<COND (<FSET? .OBJ ,VOWELBIT>
<TELL "an ">)
(T
<TELL "a ">)>)>
<DPRINT .OBJ>>
<ROUTINE TPRINT (OBJ "OPT" (NOSP <>) "AUX" LEN)
<COND (<NOT .NOSP>
<TELL !\ >)>
<COND (<AND <SET LEN <GET-OWNER .OBJ>>
<NOT <EQUAL? .LEN <GETP .OBJ ,P?OWNER>>>>
<COND (<EQUAL? .LEN ,PROTAGONIST>
<TELL "your ">)
(<NOT <EQUAL? .LEN .OBJ>>
<TPRINT .LEN T>
<TELL "'s ">)>)
(<NOT <FSET? .OBJ ,NARTICLEBIT>>
<TELL "the ">)>
<DPRINT .OBJ>>
<ROUTINE TPRINT-PRSO ()
<TPRINT ,PRSO>>
<ROUTINE TPRINT-PRSI ()
<TPRINT ,PRSI>>
<ROUTINE ARPRINT (OBJ)
<APRINT .OBJ>
<TELL ,PERIOD-CR>>
<ROUTINE TRPRINT (OBJ)
<TPRINT .OBJ>
<TELL ,PERIOD-CR>>
<ROUTINE IS-ARE-PRINT (OBJ)
<COND (<FSET? .OBJ ,NARTICLEBIT>
<TELL " ">)
(T
<TELL " the ">)>
<DPRINT .OBJ>
<COND (<FSET? .OBJ ,PLURALBIT>
<TELL " are ">)
(T
<TELL " is ">)>>
;<ROUTINE CLEAR-SCREEN ("AUX" (CNT 24))
<REPEAT ()
<CRLF>
<SET CNT <- .CNT 1>>
<COND (<0? .CNT>
<RETURN>)>>>
<REPLACE-DEFINITION VERB-ALL-TEST
<ROUTINE VERB-ALL-TEST (OO II "AUX" (L <LOC .OO>))
;"RTRUE if OO should be included in the ALL, otherwise RFALSE"
<COND (<EQUAL? .OO ,ROOMS ;,NOT-HERE-OBJECT>
<SETG P-NOT-HERE <+ ,P-NOT-HERE 1>>
<RFALSE>)
(<AND <VERB? TAKE> ;"TAKE prso FROM prsi and prso isn't in prsi"
<T? .II>
<NOT <IN? .OO .II>>>
<RFALSE>)
;(<NOT <ACCESSIBLE? .OO>> ;"can't get at object"
<RFALSE>)
(T ;<EQUAL? ,P-GETFLAGS ,P-ALL> ;"cases for ALL"
<COND (<AND .II
<PRSO? .II>>
<RFALSE>)
(<VERB? TAKE>
;"TAKE ALL and object not accessible or takeable"
<COND (<AND <NOT <FSET? .OO ,TAKEBIT>>
<NOT <FSET? .OO ,TRYTAKEBIT>>>
<RFALSE>)
(<FSET? .OO ,NALLBIT>
<RFALSE>)
;(<AND <NOT <EQUAL? .L ,WINNER ,HERE .II>>
<NOT <EQUAL? .L <LOC ,WINNER>>>>
<COND (<AND <FSET? .L ,SURFACEBIT>
<NOT <FSET? .L ,TAKEBIT>>> ;"tray"
<RTRUE>)
(T
<RFALSE>)>)
(<AND <NOT .II>
<ULTIMATELY-IN? .OO>> ;"already have it"
<RFALSE>)
(T
<RTRUE>)>)
(<AND <VERB? DROP PUT PUT-ON GIVE SGIVE>
;"VERB ALL, object not held"
<NOT <IN? .OO ,WINNER>>>
<RFALSE>)
(<AND <VERB? PUT PUT-ON> ;"PUT ALL IN X,obj already in x"
<NOT <IN? .OO ,WINNER>>
<ULTIMATELY-IN? .OO .II>>
<RFALSE>)
(<AND <VERB? WEAR>
<OR <FSET? .OO ,WORNBIT>
<NOT <FSET? .OO ,WEARBIT>>>>
;"try to wear only wearable-but-not-yet-worn objects"
<RFALSE>)
(<EQUAL? .OO .II>
;"i.e. PUT ALL IN BOX shouldn't try to put box in box"
<RFALSE>)
(T
<RTRUE>)>)>>>
;<GLOBAL FIRST-BUFFER <ITABLE BYTE 100>>
;<ROUTINE SAVE-INPUT (TBL "AUX" (OFFS 0) CNT TMP)
<SET CNT <+ <GETB ,P-LEXV <SET TMP <* 4 ,P-INPUT-WORDS>>>
<GETB ,P-LEXV <+ .TMP 1>>>>
<COND (<EQUAL? .CNT 0> ;"failed"
<RFALSE>)>
<SET CNT <- .CNT 1>>
<REPEAT ()
<COND (<EQUAL? .OFFS .CNT>
<PUTB .TBL .OFFS 0>
<RETURN>)
(T
<PUTB .TBL .OFFS <GETB ,P-INBUF <+ .OFFS 1>>>)>
<SET OFFS <+ .OFFS 1>>>
<RTRUE>>
;<ROUTINE RESTORE-INPUT (TBL "AUX" CHR)
<REPEAT ()
<COND (<EQUAL? <SET CHR <GETB .TBL 0>> 0>
<RETURN>)
(T
<PRINTC .CHR>
<SET TBL <REST .TBL>>)>>>
<REPLACE-DEFINITION GAME-VERB?
<ROUTINE GAME-VERB? () ;"should the verb not run the clock?"
<COND (<VERB? $RECORD $UNRECORD $COMMAND $RANDOM $VERIFY $REFRESH
SAVE RESTORE RESTART QUIT SCRIPT UNSCRIPT
BRIEF SUPERBRIEF VERBOSE VERSION CREDITS
NOTIFY HINT COLOR SCORE TIME MAP DEFINE MODE>
<RTRUE>)>>>
<ROUTINE THIS-IS-IT (OBJ)
<COND (<OR <AND <VERB? WALK>
<PRSO? .OBJ>> ;"PRSO is a direction"
<EQUAL? .OBJ <> ,ROOMS ;,NOT-HERE-OBJECT ,ME ,PROTAGONIST>>
<RTRUE>)
(<DONT-IT .OBJ ,LOBSTER ,W?NUTCRACKER>
;"or else FIND NUTCRACKER followed by TAKE IT returns
[But the lobster isn't here!]"
<RTRUE>)
(<DONT-IT .OBJ ,SNAKE ,W?ROPE>
<RTRUE>)
(<FSET? .OBJ ,FEMALEBIT>
<COND (<NOT <EQUAL? ,P-HER-OBJECT .OBJ>>
<FCLEAR ,HER ,TOUCHBIT>)>
<SETG P-HER-OBJECT .OBJ>)
(<OR <FSET? .OBJ ,ACTORBIT>
<EQUAL? .OBJ ,LITTLE-FUNGUS>>
<COND (<NOT <EQUAL? ,P-HIM-OBJECT .OBJ>>
<FCLEAR ,HIM ,TOUCHBIT>)>
<SETG P-HIM-OBJECT .OBJ>
<COND (<NOT <EQUAL? .OBJ ,JESTER ,EXECUTIONER>>
;"basically, animals"
<COND (<NOT <EQUAL? ,P-IT-OBJECT .OBJ>>
<FCLEAR ,IT ,TOUCHBIT>)>
<SETG P-IT-OBJECT .OBJ>)>)
(T
<COND (<NOT <EQUAL? ,P-IT-OBJECT .OBJ>>
<FCLEAR ,IT ,TOUCHBIT>)>
<SETG P-IT-OBJECT .OBJ>)>>
<ROUTINE DONT-IT (OBJ1 OBJ2 WRD)
<COND (<AND <EQUAL? .OBJ1 .OBJ2>
<NOUN-USED? .OBJ2 .WRD>
<FSET? .OBJ2 ,ANIMATEDBIT>
<NOT <VISIBLE? .OBJ2>>>
<RTRUE>)
(T
<RFALSE>)>>
;<REPLACE-DEFINITION NUMBER?
;"from suspect"
<GLOBAL P-EXCHANGE 0>
<ROUTINE NUMBER? (PTR "AUX" CNT BPTR CHR (SUM 0) (TIM <>) (EXC <>))
<SET CNT <GETB <REST ,P-LEXV <* .PTR 2>> 2>>
<SET BPTR <GETB <REST ,P-LEXV <* .PTR 2>> 3>>
<REPEAT ()
<COND (<L? <SET CNT <- .CNT 1>> 0>
<RETURN>)
(T
<SET CHR <GETB ,P-INBUF .BPTR>>
<COND (<==? .CHR 58>
<COND (.EXC
<RFALSE>)>
<SET TIM .SUM>
<SET SUM 0>)
(<==? .CHR 45 %<ASCII !\/>>
<COND (.TIM
<RFALSE>)>
<SET EXC .SUM>
<SET SUM 0>)
(<G? .SUM 9999>
<RFALSE>)
(<AND <L? .CHR 58>
<G? .CHR 47>>
<SET SUM <+ <* .SUM 10> <- .CHR 48>>>)
(T
<RFALSE>)>
<SET BPTR <+ .BPTR 1>>)>>
<PUT ,P-LEXV .PTR ,W?NUMBER>
<COND (<G? .SUM 9999>
<RFALSE>)
(.EXC
<SETG P-EXCHANGE .EXC>)
(.TIM
<SETG P-EXCHANGE 0>
<COND (<G? .TIM 23>
<RFALSE>)
(<G? .TIM 19>
T)
(<G? .TIM 12>
<RFALSE>)
(<G? .TIM 7>
T)
(T
<SET TIM <+ 12 .TIM>>)>
<SET SUM <+ .SUM <* .TIM 60>>>)
(T
<SETG P-EXCHANGE 0>)>
<SETG P-NUMBER .SUM>
,W?NUMBER>>
<GLOBAL P-NUMBER 0>
<ROUTINE PERFORM-PRSA ("OPTIONAL" (O <>) (I <>))
<PERFORM ,PRSA .O .I>
<RTRUE>>
;<ROUTINE CANT-USE (PTR "AUX" BUF)
<TELL "[You used the word \"">
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
<GETB <REST ,P-LEXV .BUF> 3>>
<TELL "\" in a way that I don't understand.]" CR>
;<SETG QUOTE-FLAG <>>
<SETG P-OFLAG <>>>
<REPLACE-DEFINITION CAPITAL-NOUN?
<ROUTINE CAPITAL-NOUN? (WRD "AUX" TBL)
<COND (<EQUAL? .WRD ,W?FLATHEAD ,W?DIMWIT ,W?URSULA ,W?MEGABOZ ,W?JOHN
,W?PIERPONT ,W?STONEWALL ,W?LUCREZIA ,W?SEBASTIAN
,W?DAVISON ,W?THOMAS ,W?ALVA ,W?LEONARDO ,W?JOHANN
,W?RALPH ,W?PAUL ,W?FRANK ,W?LLOYD ,W?BABE ,W?ZILBO
,W?MERETZKY ,W?FOOBUS ,W?BARBAZZO ,W?FERNAP
,W?MUMBERTHRAX ,W?BOZBO ,W?MUMBO ,W?PHLOID ,W?BELWIT>
<RTRUE>)
(<AND <SET TBL <GETPT ,SAINTS ,P?SYNONYM>>
<INTBL? .WRD .TBL </ <PTSIZE .TBL> 2>>>
<RTRUE>)
(<INTBL? .WRD ,FUNGUS-WORDS 12>
<RTRUE>)
(<INTBL? .WRD ,MID-NAME-WORDS 12>
<RTRUE>)
(T
<RFALSE>)>>>
<REPLACE-DEFINITION LIT?
<ROUTINE LIT? ("OPT" (RM <>) (RMBIT T) "AUX" OHERE (LIT <>) (RES ,SEARCH-RES))
<COND (<AND <EQUAL? ,HERE ,UNDERWATER ,LAKE-BOTTOM>
<NOT <FSET? ,EXTERIOR-LIGHT ,ONBIT>>>
<RFALSE>)>
<COND (<NOT .RM>
<SET RM ,HERE>)>
<SET OHERE ,HERE>
<SETG HERE .RM>
<COND (<AND .RMBIT
<FSET? .RM ,ONBIT>>
<SET LIT ,HERE>)
(<AND <FSET? ,WINNER ,ONBIT>
<ULTIMATELY-IN? ,WINNER .RM>>
<SET LIT ,WINNER>)
(T
<MAKE-FIND-RES 'FIND-RES .RES 'FIND-RES-COUNT 0>
<MAKE-FINDER 'FINDER ,FINDER 'FIND-APPLIC ,ONBIT
'FIND-RES .RES
'FIND-FLAGS ,FIND-FLAGS-GWIM>
<COND (<EQUAL? .OHERE .RM>
<FIND-DESCENDANTS ,WINNER
%<ORB ,FD-INCLUDE? ,FD-SEARCH?
,FD-NEST? ;,FD-NOTOP?>>
<COND (<AND <NOT <EQUAL? ,WINNER ,PROTAGONIST>>
<IN? ,PROTAGONIST .RM>>
<FIND-DESCENDANTS ,PROTAGONIST
%<ORB ,FD-INCLUDE? ,FD-SEARCH?
,FD-NEST? ;,FD-NOTOP?>>)>)>
<COND (<0? <FIND-RES-COUNT .RES>:FIX>
<COND (<AND <FSET? <LOC ,WINNER> ,VEHBIT>
<NOT <FSET? <LOC ,WINNER> ,OPENBIT>>>
<FIND-DESCENDANTS <LOC ,WINNER>
%<ORB ,FD-INCLUDE? ,FD-SEARCH?
,FD-NEST? ;,FD-NOTOP?>>)>
<FIND-DESCENDANTS .RM %<ORB ,FD-INCLUDE? ,FD-SEARCH?
,FD-NEST? ;,FD-NOTOP?>>)>
<COND (<G? <FIND-RES-COUNT .RES>:FIX 0>
<SET LIT <FIND-RES-OBJ1 .RES>>)>)>
<SETG HERE .OHERE>
.LIT>>
;"CLOCKER and related routines"
<CONSTANT C-TABLE %<COND (<GASSIGNED? ZILCH>
'<ITABLE NONE 30>)
(T
'<ITABLE NONE 60>)>> ;"2x largest num of interrupts"
<GLOBAL CLOCK-WAIT <>>
<GLOBAL C-INTS 60> ;"2x largest number of concurrent of interrupts"
<GLOBAL C-MAXINTS 60> ;"2x largest number of concurrent of interrupts"
<GLOBAL CLOCK-HAND <>>
<CONSTANT C-TABLELEN 60>
<CONSTANT C-INTLEN 4> ;"length of an interrupt entry"
<CONSTANT C-RTN 0> ;"offset of routine name"
<CONSTANT C-TICK 1> ;"offset of count"
<ROUTINE DEQUEUE (RTN)
<COND (<SET RTN <QUEUED? .RTN>>
<PUT .RTN ,C-RTN 0>)>>
<ROUTINE QUEUED? (RTN "AUX" C E)
<SET E <REST ,C-TABLE ,C-TABLELEN>>
<SET C <REST ,C-TABLE ,C-INTS>>
<REPEAT ()
<COND (<EQUAL? .C .E>
<RFALSE>)
(<EQUAL? <GET .C ,C-RTN> .RTN>
<COND (<ZERO? <GET .C ,C-TICK>>
<RFALSE>)
(T
<RETURN .C>)>)>
<SET C <REST .C ,C-INTLEN>>>>
<ROUTINE RUNNING? (RTN "AUX" C E)
<SET E <REST ,C-TABLE ,C-TABLELEN>>
<SET C <REST ,C-TABLE ,C-INTS>>
<REPEAT ()
<COND (<EQUAL? .C .E>
<RFALSE>)
(<EQUAL? <GET .C ,C-RTN> .RTN>
<COND (<OR <ZERO? <GET .C ,C-TICK>>
<G? <GET .C ,C-TICK> 1>>
<RFALSE>)
(T
<RTRUE>)>)>
<SET C <REST .C ,C-INTLEN>>>>
<ROUTINE QUEUE (RTN TICK "AUX" C E (INT <>)) ;"automatically enables as well"
<SET E <REST ,C-TABLE ,C-TABLELEN>>
<SET C <REST ,C-TABLE ,C-INTS>>
<REPEAT ()
<COND (<EQUAL? .C .E>
<COND (.INT
<SET C .INT>)
(T
<COND (<L? ,C-INTS ,C-INTLEN>
<TELL "**Too many ints!**" CR>)>
<SETG C-INTS <- ,C-INTS ,C-INTLEN>>
<COND (<L? ,C-INTS ,C-MAXINTS>
<SETG C-MAXINTS ,C-INTS>)>
<SET INT <REST ,C-TABLE ,C-INTS>>)>
<PUT .INT ,C-RTN .RTN>
<RETURN>)
(<EQUAL? <GET .C ,C-RTN> .RTN>
<SET INT .C>
<RETURN>)
(<ZERO? <GET .C ,C-RTN>>
<SET INT .C>)>
<SET C <REST .C ,C-INTLEN>>>
<COND (<AND ,CLOCK-HAND
%<COND (<GASSIGNED? ZILCH>
'<G? .INT ,CLOCK-HAND>)
(T
'<L? <LENGTH .INT> <LENGTH ,CLOCK-HAND>>)>>
<SET TICK <- <+ .TICK 3>>>)>
<PUT .INT ,C-TICK .TICK>
.INT>
<ROUTINE CLOCKER ("AUX" E TICK RTN (FLG <>) (Q? <>) OWINNER)
<COND (,CLOCK-WAIT
<SETG CLOCK-WAIT <>>
<RFALSE>)
(,TIME-STOPPED
;"don't run interrupts, but do increment moves"
<SETG MOVES <+ ,MOVES 1>>
<RFALSE>)>
<SETG CLOCK-HAND <REST ,C-TABLE ,C-INTS>>
<SET E <REST ,C-TABLE ,C-TABLELEN>>
<SET OWINNER ,WINNER>
<SETG WINNER ,PROTAGONIST>
<REPEAT ()
<COND (<EQUAL? ,CLOCK-HAND .E>
<SETG CLOCK-HAND .E>
<SETG MOVES <+ ,MOVES 1>>
<SETG WINNER .OWINNER>
<RETURN .FLG>)
(<NOT <ZERO? <GET ,CLOCK-HAND ,C-RTN>>>
<SET TICK <GET ,CLOCK-HAND ,C-TICK>>
<COND (<L? .TICK -1>
<PUT ,CLOCK-HAND ,C-TICK <- <- .TICK> 3>>
<SET Q? ,CLOCK-HAND>)
(<NOT <ZERO? .TICK>>
<COND (<G? .TICK 0>
<SET TICK <- .TICK 1>>
<PUT ,CLOCK-HAND ,C-TICK .TICK>)>
<COND (<NOT <ZERO? .TICK>>
<SET Q? ,CLOCK-HAND>)>
<COND (<NOT <G? .TICK 0>>
<SET RTN
%<COND (<GASSIGNED? ZILCH>
'<GET ,CLOCK-HAND ,C-RTN>)
(ELSE
'<NTH ,CLOCK-HAND
<+ <* ,C-RTN 2>
1>>)>>
<COND (<ZERO? .TICK>
<PUT ,CLOCK-HAND ,C-RTN 0>)>
<COND (<APPLY .RTN>
<SET FLG T>)>
<COND (<AND <NOT .Q?>
<NOT
<ZERO?
<GET ,CLOCK-HAND
,C-RTN>>>>
<SET Q? T>)>)>)>)>
<SETG CLOCK-HAND <REST ,CLOCK-HAND ,C-INTLEN>>
<COND (<NOT .Q?>
<SETG C-INTS <+ ,C-INTS ,C-INTLEN>>)>>>
"stuff for handling opcodes that want pixels"
<GLOBAL FONT-X 7>
<GLOBAL FONT-Y 10>
<CONSTANT PICINF-TBL
<TABLE 0 0>>
<ROUTINE C-PIXELS (X)
<+ <* <- .X 1> ,FONT-X> 1>>
<ROUTINE L-PIXELS (Y)
<+ <* <- .Y 1> ,FONT-Y> 1>>
;<ROUTINE PIXELS-C (X)
<+ </ <- .X 1> ,FONT-X> 1>>
;<ROUTINE PIXELS-L (Y)
<+ </ <- .Y 1> ,FONT-Y> 1>>
;<ROUTINE PIXELS-LR (Y)
</ <- <+ .Y ,FONT-Y> 1> ,FONT-Y>>
<ROUTINE CCURSET (Y X)
<CURSET <L-PIXELS .Y> <C-PIXELS .X>>>
;<ROUTINE CCURGET (TBL)
<CURGET .TBL>
<PUT .TBL 0 <PIXELS-L <GET .TBL 0>>>
<PUT .TBL 1 <PIXELS-C <GET .TBL 1>>>
.TBL>
;<ROUTINE CSPLIT (Y)
<SPLIT <* .Y ,FONT-Y>>>
;<ROUTINE CWINPOS (W Y X)
<WINPOS .W <L-PIXELS .Y> <C-PIXELS .X>>>
;<ROUTINE CWINSIZE (W Y X)
<WINSIZE .W <* .Y ,FONT-Y> <* .X ,FONT-X>>>
;<ROUTINE CMARGIN (L R)
<MARGIN <* .L ,FONT-X> <* .R ,FONT-X>>>
;<ROUTINE CPICINF (P TBL)
<PICINF .P .TBL>
<PUT .TBL 0 </ <GET .TBL 0> ,FONT-Y>>
<PUT .TBL 1 </ <GET .TBL 1> ,FONT-X>>>
;<ROUTINE CDISPLAY (P Y X)
<DISPLAY .P
<COND (<ZERO? .Y> 0)
(ELSE <L-PIXELS .Y>)>
<COND (<ZERO? .X> 0)
(ELSE <C-PIXELS .X>)>>>
;<ROUTINE CDCLEAR (P Y X)
<DCLEAR .P
<COND (<ZERO? .Y> 0)
(ELSE <L-PIXELS .Y>)>
<COND (<ZERO? .X> 0)
(ELSE <C-PIXELS .X>)>>>
;<ROUTINE CSCROLL (W Y)
<SCROLL .W <* .Y ,FONT-Y>>>
<END-SEGMENT>

807
oracle.zabstr Normal file
View File

@ -0,0 +1,807 @@
<BEGIN-SEGMENT SECRET>
<INCLUDE "BASEDEFS" "PDEFS">
<ROOM ORACLE (LOC ROOMS) (DESC "Oracle") (REGION "Region: Unknown") (UP TO
CRYPT) (OUT TO CRYPT) (FLAGS RLANDBIT UNDERGROUNDBIT) (GLOBAL SLIME) (VALUE 10)
(ICON ORACLE-ICON) (MAP-LOC <PTABLE SECRET-WING-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-10>) (THINGS <> SHADOW PHIL-SHADOW-PS) (ACTION ORACLE-F)>
<DEFINE-ROUTINE ORACLE-F>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT ORACLE-OBJECT (LOC ORACLE) (DESC "oracle") (SYNONYM ORACLE BARGTH MOUTH
HEAD) (ADJECTIVE HUGE ORACLE\'S SERPENT\'S) (FLAGS NDESCBIT VOWELBIT VEHBIT
INBIT CONTBIT OPENBIT SEARCHBIT DROPBIT) (CAPACITY 100) (OWNER ORACLE-OBJECT) (
RESEARCH "The encyclopedia scoffs at this silly little legend about an oracle which
offered bits of wisdom and could transport believers to distant regions.") (
ACTION ORACLE-OBJECT-F)>
<END-SEGMENT>
<BEGIN-SEGMENT SECRET>
<DEFINE-ROUTINE ORACLE-OBJECT-F>
<DEFINE-ROUTINE D-ORACLE>
<OBJECT DEPRESSION (LOC ORACLE) (DESC "depression") (SYNONYM DEPRESSION) (FLAGS
NDESCBIT CONTBIT OPENBIT SEARCHBIT) (ACTION DEPRESSION-F)>
<DEFINE-ROUTINE DEPRESSION-F>
<GLOBAL ORACLE-USED <>>
<GLOBAL ORACLE-SCORE 9>
<CONSTANT ORACLE-TABLE <PTABLE CRAG GLACIER DELTA-1 FOOT-OF-STATUE
MINE-ENTRANCE>>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<OBJECT AMULET (LOC G-U-MOUNTAIN) (DESC "amulet") (SYNONYM AMULET) (FLAGS
TAKEBIT WEARBIT VOWELBIT) (ACTION AMULET-F)>
<DEFINE-ROUTINE AMULET-F>
<GLOBAL ORACLE-EXIT-NUMBER 5>
<CONSTANT EYE-TABLE <PTABLE "None" "One" "Two" "Three" "All">>
<DEFINE-ROUTINE I-AMULET>
<END-SEGMENT>
\
<BEGIN-SEGMENT ORACLE>
<OBJECT FLATHEAD-MOUNTAINS (LOC LOCAL-GLOBALS) (DESC "Flathead Mountains") (
SYNONYM MOUNTAIN MOUNTAINS) (ADJECTIVE FLATHEAD) (RESEARCH
"\"This towering range runs north to south, forming the eastern border of the
Frigid River Valley. Beyond the mountains, uninhabitable swamps extend to the
edge of the world. Near the southern end of the range, the Zorbel Pass permits
passage to the Fublio Valley.\"") (ACTION FLATHEAD-MOUNTAINS-F)>
<DEFINE-ROUTINE FLATHEAD-MOUNTAINS-F>
<ROOM CRAG (LOC ROOMS) (DESC "Crag") (REGION "Flathead Mountains") (LDESC
"You are high in the mountains, surrounded by jagged, rocky peaks. Paths
squeeze northeast, southeast, and southwest, and it looks like you could
also climb down.") (SW TO HOLLOW) (DOWN TO UPPER-LEDGE) (NE TO NATURAL-ARCH) (
SE TO NATURAL-ARCH) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL
FLATHEAD-MOUNTAINS) (SYNONYM CRAG) (VALUE 10) (MAP-LOC <PTABLE FJORD-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-4>) (ICON CRAG-ICON)>
<OBJECT CRAG-REBUS-BUTTON (LOC CRAG) (SDESC "blinking key-shaped button") (
FDESC "Imbedded in the rocky wall is a blinking button in the shape of a key.")
(SYNONYM BUTTON) (ADJECTIVE KEY-SHAPED BLINKING) (ACTION REBUS-BUTTON-F)>
<ROOM HOLLOW (LOC ROOMS) (DESC "Hollow") (REGION "Flathead Mountains") (NE TO
CRAG) (SOUTH TO IRON-MINE IF IRON-MINE-OPEN) (FLAGS RLANDBIT ONBIT BEYONDBIT
OUTSIDEBIT) (GLOBAL FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FJORD-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-3>) (THINGS IRON MINE IRON-MINE-PS) (ACTION HOLLOW-F)>
<DEFINE-ROUTINE HOLLOW-F>
<GLOBAL IRON-MINE-OPEN <>>
<OBJECT RUNES (LOC HOLLOW) (DESC "runes") (SYNONYM RUNES) (ADJECTIVE STRANGE
FRIGHTENING) (FLAGS READBIT NDESCBIT NARTICLEBIT) (TEXT
"The runes are in an ancient and unfamiliar language; you can translate only
a handful of phrases: \"accursed sapphire\" and \"sealed their tomb\" and
\"death awaits.\"")>
<OBJECT HEXAGONAL-HOLE (LOC HOLLOW) (DESC "six-sided hole") (SYNONYM HOLE) (
ADJECTIVE SMALL SIX-SIDED HEXAGONAL) (FLAGS NDESCBIT) (ACTION HEXAGONAL-HOLE-F)
>
<DEFINE-ROUTINE HEXAGONAL-HOLE-F>
<OBJECT BIRCH (LOC HOLLOW) (DESC "birch tree") (FDESC
"A stubborn birch tree has been eking out an existence in this rocky hollow
for, judging by its size, fifty to a hundred years -- though, in this barren
spot, who can guess the growth rate of a tree?") (SYNONYM TREE BIRCH) (
ADJECTIVE BIRCH) (FLAGS PLANTBIT) (ACTION BIRCH-F)>
<DEFINE-ROUTINE BIRCH-F>
<ROOM IRON-MINE (LOC ROOMS) (DESC "Iron Mine") (REGION "Flathead Mountains") (
LDESC "This appears to have been a mine for the excavation of iron ore, possibly
dating to the earliest days of recorded history. There seems to have been a
struggle here, in the distant past: two decayed skeletons locked in vicious
combat. The rusty strips of metal by their side may have once been weapons.") (
NORTH TO HOLLOW) (OUT TO HOLLOW) (FLAGS RLANDBIT BEYONDBIT UNDERGROUNDBIT) (
SYNONYM MINE) (ADJECTIVE IRON) (GLOBAL BONES BODIES FLATHEAD-MOUNTAINS) (THINGS
IRON MINE IRON-MINE-PS <> IRON IRON-PS IRON ORE IRON-PS) (MAP-LOC <PTABLE
FJORD-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-3>) (ICON IRON-MINE-ICON)>
<DEFINE-ROUTINE IRON-PS>
<DEFINE-ROUTINE IRON-MINE-PS>
<BEGIN-SEGMENT CASTLE>
<OBJECT SAPPHIRE (LOC IRON-MINE) (DESC "sapphire") (FDESC
"In the bony hand of one of the skeletons, locked in its death grip, is
a stunningly beautiful sapphire.") (SYNONYM SAPPHIRE JEWEL JERRIMORE) (
ADJECTIVE STUNNING STUNNINGLY BEAUTIFUL CURSED ACCURSED) (FLAGS TAKEBIT
TRYTAKEBIT) (SIZE 3) (OWNER SAPPHIRE) (RESEARCH
"\"The legend of the accursed Jewel of Jerrimore can trace its origins to
the third century B.E. in the northlands of Frobozz. This jewel, which in
most versions of the legend is a star sapphire, is said to have been cursed
by the Mage of Jerrimore as he lay upon his deathbed.|
As he sickened, this powerful but twisted wizard became convinced that
his enemies had poisoned him to gain possession of his greatest treasure,
the Jewel of Jerrimore. With his dying breath, he loosed a great and evil
curse upon the Jewel and all who would possess it.|
After the Mage's death, each of his heirs took possession of the jewel;
each held it jealously, mistrusting any who might look upon it; each became
obsessed with the greed and treachery they perceived around them; and each
came to early and horrible deaths. Thus grew the legend of the cursed Jewel.|
Although the legends vary, all versions say that the Jewel travelled
through many lands, always leaving a wake of misery and death, and finally
became lost in a forgotten iron mine.\"") (ACTION SAPPHIRE-F)>
<DEFINE-ROUTINE SAPPHIRE-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM NATURAL-ARCH (LOC ROOMS) (DESC "Natural Arch") (REGION
"Flathead Mountains") (LDESC
"You are on a windswept rock mesa. Paths lead northwest and southwest around
an outcropping. A slender bridge of sandstone arcs gracefully above you.
Beneath the center of the arch, timeworn stairs lead down into a dark cave.") (
NW TO CRAG) (SW TO CRAG) (DOWN TO ENCHANTED-CAVE) (FLAGS RLANDBIT ONBIT
BEYONDBIT OUTSIDEBIT) (GLOBAL FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE
FJORD-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-6>) (ICON NATURAL-ARCH-ICON)>
<OBJECT NATURAL-ARCH-OBJECT (LOC NATURAL-ARCH) (DESC "sandstone arch") (SYNONYM
ARCH BRIDGE) (ADJECTIVE SANDSTONE NATURAL SLENDER GRACEFUL) (FLAGS NDESCBIT) (
ACTION NATURAL-ARCH-OBJECT-F)>
<DEFINE-ROUTINE NATURAL-ARCH-OBJECT-F>
<ROOM ENCHANTED-CAVE (LOC ROOMS) (DESC "Enchanted Cave") (REGION
"Flathead Mountains") (UP TO NATURAL-ARCH) (OUT TO NATURAL-ARCH) (FLAGS
RLANDBIT BEYONDBIT UNDERGROUNDBIT) (SYNONYM CAVE) (ADJECTIVE ENCHANTED) (GLOBAL
BONES FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FJORD-MAP-NUM MAP-GEN-Y-4
MAP-GEN-X-7>) (ICON ENCHANTED-CAVE-ICON) (ACTION ENCHANTED-CAVE-F)>
<DEFINE-ROUTINE ENCHANTED-CAVE-F>
<CONSTANT STATUE-DESC
"Behind the altar is a statue of a young man holding a frail flower. His face
shows heartbreak and despair, with a single tear just beginning to slide down
his cheek.">
<OBJECT STATUE (LOC ENCHANTED-CAVE) (DESC "statue") (SYNONYM STATUE MAN) (
ADJECTIVE YOUNG) (FLAGS NDESCBIT) (GENERIC G-DIMWIT-F) (ACTION STATUE-F)>
<DEFINE-ROUTINE STATUE-F>
<OBJECT ALTAR (LOC ENCHANTED-CAVE) (DESC "altar") (SYNONYM ALTAR) (FLAGS
NDESCBIT VOWELBIT SURFACEBIT SEARCHBIT CONTBIT OPENBIT) (ACTION ALTAR-F)>
<DEFINE-ROUTINE ALTAR-F>
<BEGIN-SEGMENT 0>
<OBJECT FLOWER (LOC ENCHANTED-CAVE) (DESC "flower") (SYNONYM FLOWER) (FLAGS
NDESCBIT TAKEBIT TRYTAKEBIT PLANTBIT) (ACTION FLOWER-F)>
<DEFINE-ROUTINE FLOWER-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM UPPER-LEDGE (LOC ROOMS) (DESC "Upper Ledge") (REGION "Flathead Mountains"
) (LDESC "You are on a mountain ledge with a spectacular view of the Flathead Fjord,
which separates the Flathead Mountains (which you are at the northern tip of)
from the Gray Mountains, across the fjord to the north. The ocean, to the west,
is lost amidst the dense fog which rolls up the fjord. A rocky spire stands
like a finger at the very edge of the ledge. A steep path climbs farther up
the mountain. A short distance below is another, smaller ledge.") (UP TO CRAG)
(DOWN TO LOWER-LEDGE IF ROPE-PLACED ELSE
"There are no handholds to climb down.") (FLAGS RLANDBIT ONBIT BEYONDBIT
OUTSIDEBIT) (SYNONYM LEDGE) (ADJECTIVE UPPER) (GLOBAL FJORD LOWER-LEDGE
FLATHEAD-MOUNTAINS GRAY-MOUNTAINS) (MAP-LOC <PTABLE FJORD-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-4>) (ICON UPPER-LEDGE-ICON)>
<GLOBAL ROPE-PLACED <>>
<OBJECT SPIRE (LOC UPPER-LEDGE) (DESC "rocky spire") (SYNONYM SPIRE ROCK) (
ADJECTIVE ROCKY) (FLAGS NDESCBIT)>
<ROOM LOWER-LEDGE (LOC ROOMS) (DESC "Lower Ledge") (REGION "Flathead Mountains"
) (LDESC "The view of the fjord isn't as good, as you are surrounded on three sides by
nearly vertical cliffs. There don't seem to be any exits.") (UP SORRY
"You can't even see the rope anymore, let alone reach it.") (DOWN SORRY
"It's still a good five hundred foot drop to the fjord!") (FLAGS RLANDBIT ONBIT
BEYONDBIT OUTSIDEBIT) (SYNONYM LEDGE) (ADJECTIVE LOWER) (GLOBAL FJORD
UPPER-LEDGE FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FJORD-MAP-NUM MAP-GEN-Y-2
MAP-GEN-X-4>) (ICON LOWER-LEDGE-ICON) (ACTION LOWER-LEDGE-F) (THINGS NARROW
CRACK NARROW-CRACK-PS)>
<DEFINE-ROUTINE LOWER-LEDGE-F>
<DEFINE-ROUTINE NARROW-CRACK-PS>
<OBJECT EASLE (LOC LOWER-LEDGE) (DESC "easel") (FDESC
"Despite the inferior view, someone has been painting here. An easel
is set up on the ledge.") (SYNONYM EASLE EASEL) (FLAGS TAKEBIT MAGICBIT CONTBIT
SEARCHBIT SURFACEBIT OPENBIT VOWELBIT) (SIZE 10) (VALUE 12)>
<BEGIN-SEGMENT 0>
<OBJECT LANDSCAPE (LOC EASLE) (DESC "landscape") (SYNONYM LANDSCAPE PAINTING) (
FLAGS TAKEBIT MAGICBIT) (VALUE 12) (GENERIC G-PAINTING-F) (ACTION LANDSCAPE-F)>
<DEFINE-ROUTINE LANDSCAPE-F>
<DEFINE-ROUTINE G-PAINTING-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<OBJECT FJORD (LOC LOCAL-GLOBALS) (DESC "the Flathead Fjord") (SYNONYM FJORD) (
ADJECTIVE FLATHEAD) (FLAGS NARTICLEBIT WATERBIT) (RESEARCH
"\"The beautiful Flathead Fjord is an ocean inlet which divides the great
mountains of the eastlands into two ranges: the Gray Mountains, on the north
side of the fjord, and the Flathead Mountains, south of the fjord.\"") (ACTION
FJORD-F)>
<DEFINE-ROUTINE FJORD-F>
\
<OBJECT GRAY-MOUNTAINS (LOC LOCAL-GLOBALS) (DESC "Gray Mountains") (SYNONYM
MOUNTAINS) (ADJECTIVE GRAY GREY) (RESEARCH
"\"The Gray Mountains refer to both a mountain range and a province. Lying
in the far northern part of the eastlands, the Gray Mountains are a harsh
environment, but a mecca for winter sport enthusiasts.\"") (ACTION
FLATHEAD-MOUNTAINS-F)>
<ROOM GLACIER (LOC ROOMS) (DESC "Glacier") (REGION "Gray Mountains") (LDESC
"You are on a glacier high atop the Gray Mountains. Far below is a frozen
lake, brilliantly reflective in the midday sunshine. The climb down looks
extremely hazardous.") (DOWN PER GLACIER-DEATH) (FLAGS RLANDBIT OUTSIDEBIT
ONBIT BEYONDBIT) (SYNONYM GLACIER) (GLOBAL GRAY-MOUNTAINS) (VALUE 10) (MAP-LOC
<PTABLE GRAY-MOUNTAINS-MAP-NUM MAP-GEN-Y-1 MAP-GEN-X-10>)>
<DEFINE-ROUTINE GLACIER-DEATH>
<ROOM MIRROR-LAKE (LOC ROOMS) (DESC "Mirror Lake") (REGION "Gray Mountains") (
LDESC "You are in the center of a lake whose frozen surface is more reflective than
the finest mirror. It's almost impossible to tell where the sky ends and the
ice begins. Worse, the surface is so smooth it's impossible to move!|
Looking into the mirror, everything seems somehow... different.") (NORTH
SORRY "Slip. Slide. No Progress.") (NE SORRY "Slip. Slide. No Progress.") (EAST
SORRY "Slip. Slide. No Progress.") (SE SORRY "Slip. Slide. No Progress.") (
SOUTH SORRY "Slip. Slide. No Progress.") (SW SORRY "Slip. Slide. No Progress.")
(WEST SORRY "Slip. Slide. No Progress.") (NW SORRY "Slip. Slide. No Progress.")
(FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL GRAY-MOUNTAINS) (MAP-LOC <
PTABLE GRAY-MOUNTAINS-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-8>) (ICON MIRROR-LAKE-ICON)
(ACTION MIRROR-LAKE-F)>
<DEFINE-ROUTINE MIRROR-LAKE-F>
<DEFINE-ROUTINE LEAVE-MIRROR>
<GLOBAL MIRROR-SCORE 14>
<OBJECT MIRROR (LOC MIRROR-LAKE) (DESC "mirror") (SYNONYM MIRROR LAKE SURFACE
ICE) (ADJECTIVE MIRROR FROZEN SMOOTH REFLECTIVE) (FLAGS NDESCBIT) (RESEARCH
"\"Mirror Lake, in the Gray Mountains, is believed to possess certain magical
powers. Frank Lloyd Flathead's ski chalet was located nearby.\"") (ACTION
MIRROR-F)>
<DEFINE-ROUTINE MIRROR-F>
<OBJECT REFLECTION (LOC MIRROR-LAKE) (OWNER ROOMS) (DESC "reflection") (SYNONYM
REFLECTION) (FLAGS NDESCBIT) (ACTION REFLECTION-F)>
<DEFINE-ROUTINE REFLECTION-F>
<GLOBAL ORB-FOUND <>>
<GLOBAL ENCHANTED-ORB <>>
<GLOBAL ORBS-EXAMINED 0>
<ROOM EAST-OF-MIRROR (LOC ROOMS) (DESC "East of Mirror") (REGION
"Gray Mountains") (WEST SORRY "The surface of the lake is too slippery.") (NW
TO NORTH-OF-MIRROR) (SW TO SOUTH-OF-MIRROR) (FLAGS RLANDBIT ONBIT OUTSIDEBIT
BEYONDBIT) (GLOBAL GRAY-MOUNTAINS) (MAP-LOC <PTABLE GRAY-MOUNTAINS-MAP-NUM
MAP-GEN-Y-3 MAP-GEN-X-9>) (ACTION EAST-OF-MIRROR-F)>
<DEFINE-ROUTINE EAST-OF-MIRROR-F>
<DEFINE-ROUTINE MIRRORS-EDGE-DESC>
<ROOM WEST-OF-MIRROR (LOC ROOMS) (DESC "West of Mirror") (REGION
"Gray Mountains") (EAST SORRY "The surface of the lake is too slippery.") (WEST
TO CHALET) (NE TO NORTH-OF-MIRROR) (SE TO SOUTH-OF-MIRROR) (FLAGS RLANDBIT
ONBIT OUTSIDEBIT BEYONDBIT) (GLOBAL CHALET GRAY-MOUNTAINS) (MAP-LOC <PTABLE
GRAY-MOUNTAINS-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-7>) (ACTION WEST-OF-MIRROR-F)>
<DEFINE-ROUTINE WEST-OF-MIRROR-F>
<ROOM NORTH-OF-MIRROR (LOC ROOMS) (DESC "North of Mirror") (REGION
"Gray Mountains") (SOUTH SORRY "The surface of the lake is too slippery.") (SE
TO EAST-OF-MIRROR) (SW TO WEST-OF-MIRROR) (FLAGS RLANDBIT ONBIT OUTSIDEBIT
BEYONDBIT) (GLOBAL GRAY-MOUNTAINS) (MAP-LOC <PTABLE GRAY-MOUNTAINS-MAP-NUM
MAP-GEN-Y-2 MAP-GEN-X-8>) (ACTION NORTH-OF-MIRROR-F)>
<DEFINE-ROUTINE NORTH-OF-MIRROR-F>
<ROOM SOUTH-OF-MIRROR (LOC ROOMS) (DESC "South of Mirror") (REGION
"Gray Mountains") (NORTH SORRY "The surface of the lake is too slippery.") (NE
TO EAST-OF-MIRROR) (NW TO WEST-OF-MIRROR) (FLAGS RLANDBIT ONBIT OUTSIDEBIT
BEYONDBIT) (GLOBAL GRAY-MOUNTAINS) (MAP-LOC <PTABLE GRAY-MOUNTAINS-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-8>) (ACTION SOUTH-OF-MIRROR-F)>
<DEFINE-ROUTINE SOUTH-OF-MIRROR-F>
<ROOM CHALET (LOC ROOMS) (DESC "Chalet") (REGION "Gray Mountains") (LDESC
"You are in a handsomely designed vacation chalet, with an exit to the east.")
(EAST TO WEST-OF-MIRROR) (OUT TO WEST-OF-MIRROR) (FLAGS RLANDBIT ONBIT
BEYONDBIT) (GLOBAL GRAY-MOUNTAINS) (SYNONYM CHALET) (ADJECTIVE SKI) (MAP-LOC <
PTABLE GRAY-MOUNTAINS-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-6>) (ICON CHALET-ICON)>
<OBJECT SCALE-MODEL (LOC CHALET) (DESC "scale model") (FDESC
"Leaning unobtrusively in one corner is a scale model of the FrobozzCo World
Headquarters Building. The scale appears to be around 1:1000.") (SYNONYM MODEL)
(ADJECTIVE SCALE) (FLAGS TAKEBIT MAGICBIT) (SIZE 20) (VALUE 12)>
\
<OBJECT SWAMP (LOC LOCAL-GLOBALS) (DESC "swamp") (SYNONYM SWAMP BAYOU DELTA
MARSH MUCK BOG) (ADJECTIVE SWAMPY MAZE-LIKE FOGGY MIST-COVERED) (FLAGS WATERBIT
)>
<ROOM DELTA-1 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH TO DELTA-3) (NE TO DELTA-4) (
EAST SORRY "The path dead ends as the growth closes to an unpassable tangle.")
(SE SORRY "The path dead ends as the growth closes to an unpassable tangle.") (
SOUTH SORRY "The path dead ends as the growth closes to an unpassable tangle.")
(SW TO DELTA-2) (WEST SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NW TO
DELTA-2) (FLAGS RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT DELTABIT) (GLOBAL SWAMP) (
VALUE 10) (MAP-LOC <PTABLE DELTA-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-10>) (ICON
DELTA-ICON)>
<ROOM DELTA-2 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NE TO
DELTA-1) (EAST SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SE TO
DELTA-1) (SOUTH TO DELTA-7) (SW TO DELTA-7) (WEST SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NW TO
DELTA-3) (FLAGS RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT DELTABIT) (GLOBAL SWAMP) (
MAP-LOC <PTABLE DELTA-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-8>) (ICON DELTA-ICON)>
<ROOM DELTA-3 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH TO DELTA-4) (NE TO DELTA-4) (
EAST TO DELTA-1) (SE SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SOUTH
SORRY "The path dead ends as the growth closes to an unpassable tangle.") (SW
TO DELTA-2) (WEST TO DELTA-5) (NW TO DELTA-5) (FLAGS RLANDBIT OUTSIDEBIT ONBIT
BEYONDBIT DELTABIT) (GLOBAL SWAMP) (MAP-LOC <PTABLE DELTA-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-8>) (ICON DELTA-ICON)>
<ROOM DELTA-4 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NE TO
RIVERS-END) (EAST TO DELTA-1) (SE SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SOUTH
SORRY "The path dead ends as the growth closes to an unpassable tangle.") (SW
TO DELTA-3) (WEST TO DELTA-3) (NW TO DELTA-5) (FLAGS RLANDBIT OUTSIDEBIT ONBIT
BEYONDBIT DELTABIT) (GLOBAL SWAMP) (MAP-LOC <PTABLE DELTA-MAP-NUM MAP-GEN-Y-2
MAP-GEN-X-9>) (ICON DELTA-ICON)>
<ROOM DELTA-5 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NE TO
DELTA-4) (EAST SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SE TO
DELTA-3) (SOUTH TO DELTA-3) (SW TO DELTA-6) (WEST SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NW SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (FLAGS
RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT DELTABIT) (GLOBAL SWAMP) (MAP-LOC <PTABLE
DELTA-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-7>) (ICON DELTA-ICON)>
<ROOM DELTA-6 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH TO DELTA-5) (NE SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (EAST SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SE TO
DELTA-7) (SOUTH SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SW SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (WEST TO
DELTA-7) (NW SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (FLAGS
RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT DELTABIT) (GLOBAL SWAMP) (MAP-LOC <PTABLE
DELTA-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-6>) (ICON DELTA-ICON)>
<OBJECT LARGE-LILY-PAD (LOC DELTA-6) (DESC "huge lily pad") (SYNONYM PAD) (
ADJECTIVE LARGE LILY) (FLAGS PLANTBIT SURFACEBIT CONTBIT OPENBIT SEARCHBIT) (
CAPACITY 100) (ACTION LILY-PAD-F)>
<DEFINE-ROUTINE LILY-PAD-F>
<OBJECT OTTO (LOC LARGE-LILY-PAD) (DESC "ugly toad") (SYNONYM TOAD OTTO) (
ADJECTIVE UGLY LARGE BLUE GRUMPY) (FLAGS ACTORBIT VOWELBIT CONTBIT OPENBIT
SEARCHBIT) (ACTION OTTO-F)>
<DEFINE-ROUTINE OTTO-F>
<GLOBAL OTTO-NAME-COUNTER 0>
<DEFINE-ROUTINE I-STONE-TO-OTTO>
<OBJECT SMALL-LILY-PAD (LOC DELTA-6) (DESC "small lily pad") (SYNONYM PAD) (
ADJECTIVE SMALL LILY) (FLAGS PLANTBIT SURFACEBIT CONTBIT OPENBIT SEARCHBIT) (
CAPACITY 20) (ACTION LILY-PAD-F)>
<BEGIN-SEGMENT 0>
<OBJECT SPYGLASS (LOC SMALL-LILY-PAD) (DESC "spyglass") (PLURAL "spyglasses") (
SYNONYM SPYGLASS TELESCOPE) (FLAGS TAKEBIT MAGICBIT TRYTAKEBIT) (VALUE 12) (
ACTION SPYGLASS-F)>
<DEFINE-ROUTINE SPYGLASS-F>
<OBJECT LARGE-FLY (LOC LOCAL-GLOBALS) (DESC "large fly") (PLURAL "flies") (
SYNONYM FLY) (ADJECTIVE LARGE) (FLAGS TAKEBIT TRYTAKEBIT) (SIZE 1) (ACTION
FLY-F)>
<OBJECT LARGER-FLY (LOC LOCAL-GLOBALS) (DESC "larger fly") (PLURAL "flies") (
SYNONYM FLY) (ADJECTIVE LARGER) (FLAGS TAKEBIT TRYTAKEBIT) (SIZE 1) (ACTION
FLY-F)>
<OBJECT EVEN-LARGER-FLY (LOC LOCAL-GLOBALS) (DESC "even larger fly") (PLURAL
"flies") (SYNONYM FLY) (ADJECTIVE EVEN LARGER) (FLAGS VOWELBIT TAKEBIT
TRYTAKEBIT) (SIZE 1) (ACTION FLY-F)>
<OBJECT LARGEST-FLY (LOC LOCAL-GLOBALS) (DESC "the largest fly") (PLURAL
"flies") (SYNONYM FLY) (ADJECTIVE LARGEST) (FLAGS NARTICLEBIT TAKEBIT
TRYTAKEBIT) (SIZE 1) (ACTION FLY-F)>
<GLOBAL FLIES-EATEN 0>
<DEFINE-ROUTINE FLY-F>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<BEGIN-SEGMENT SECRET>
<BEGIN-SEGMENT ORACLE>
<DEFINE-ROUTINE FLY-ROOM-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM DELTA-7 (LOC ROOMS) (DESC "Delta") (REGION "Frigid River Valley") (LDESC
"You are in the midst of the maze-like, swampy bayou where the Frigid
River dumps its silt before reaching the sea. Twisting paths appear to
lead into the growth in all directions.") (NORTH SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (NE TO
DELTA-2) (EAST TO DELTA-2) (SE SORRY
"The path dead ends as the growth closes to an unpassable tangle.") (SOUTH
SORRY "The path dead ends as the growth closes to an unpassable tangle.") (SW
TO OCEANS-EDGE) (WEST TO DELTA-6) (NW TO DELTA-6) (FLAGS RLANDBIT OUTSIDEBIT
ONBIT BEYONDBIT DELTABIT) (GLOBAL SWAMP) (MAP-LOC <PTABLE DELTA-MAP-NUM
MAP-GEN-Y-6 MAP-GEN-X-7>) (ICON DELTA-ICON)>
<ROOM RIVERS-END (LOC ROOMS) (DESC "River's End") (REGION "Frigid River Valley"
) (LDESC "The Frigid River ends its long journey from Flood Control Dam #3 here,
losing its speed and turning into a delta of meandering channels to the
southwest. To continue northeast up the river, you'd need a boat and a
number of strong oarsmen.") (NE SORRY "Where's the boat? Where're the oarsmen?"
) (SW TO DELTA-4) (FLAGS RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT) (MAP-LOC <PTABLE
DELTA-MAP-NUM MAP-GEN-Y-1 MAP-GEN-X-10>) (ICON RIVERS-END-ICON) (ACTION
FLY-ROOM-F)>
<OBJECT FRIGID-RIVER (LOC RIVERS-END) (DESC "the Frigid River") (SYNONYM RIVER)
(ADJECTIVE FRIGID) (FLAGS NDESCBIT NARTICLEBIT WATERBIT) (RESEARCH
"\"The Frigid River, the mightiest in the Great Underground Empire, forms
at the spilloff of Flood Control Dam #3, pours over Aragain Falls, and finally
empties into the Great Sea at the southern end of the Frigid River Valley. The
total length, from dam to river delta, is over 150 bloits.\"")>
<ROOM OCEANS-EDGE (LOC ROOMS) (DESC "Ocean's Edge") (REGION
"Frigid River Valley") (LDESC
"The channels of the river trickle into the mighty Flathead Ocean, which
extends west to the horizon. A path leads into the delta to the northeast.") (
NE TO DELTA-7) (FLAGS RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT) (GLOBAL
FLATHEAD-OCEAN) (MAP-LOC <PTABLE DELTA-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-6>) (ICON
OCEANS-EDGE-ICON)>
<OBJECT FLATHEAD-OCEAN (LOC LOCAL-GLOBALS) (DESC "the Flathead Ocean") (SYNONYM
OCEAN SEA) (ADJECTIVE FLATHEAD MIGHTY GREAT) (FLAGS NARTICLEBIT WATERBIT) (
RESEARCH "\"The Flathead Ocean divides the world into the eastlands and westlands. It
was called the Great Sea until the time of Dimwit Flathead, and it is still
known by its earlier name in many parts of the kingdom.\"")>
\
<ROOM FOOT-OF-STATUE (LOC ROOMS) (REGION "Fublio Valley") (DESC
"Foot of Statue") (SW TO VIEW-OF-STATUE) (FLAGS RLANDBIT OUTSIDEBIT ONBIT
BEYONDBIT) (GLOBAL DIMWIT-STATUE) (VALUE 10) (MAP-LOC <PTABLE FUBLIO-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-8>) (ICON FOOT-OF-STATUE-ICON) (ACTION FOOT-OF-STATUE-F)>
<DEFINE-ROUTINE FOOT-OF-STATUE-F>
<OBJECT DIMWIT-STATUE (LOC LOCAL-GLOBALS) (OWNER DIMWIT-STATUE) (DESC
"statue of Dimwit Flathead") (SYNONYM STATUE DIMWIT FLATHEAD) (ADJECTIVE LORD
DIMWIT) (GENERIC G-DIMWIT-F) (ACTION DIMWIT-STATUE-F)>
<DEFINE-ROUTINE DIMWIT-STATUE-F>
<CONSTANT NEAR-STATUE-DESC
"Towering above you is a statue so tall that you can't see much beyond
the knees.">
<CONSTANT DISTANT-STATUE-DESC
"To the northeast, a huge statue of Dimwit Flathead casts a dark shadow across
the land. The statue is beginning to deteriorate; vines cover the lower bloit
or so, and some pterodactyls have begun nesting on the flat top of the statue's
head.">
<ROOM VIEW-OF-STATUE (LOC ROOMS) (REGION "Fublio Valley") (DESC
"View of Statue") (NE TO FOOT-OF-STATUE) (WEST TO BASE-OF-MOUNTAINS) (SE TO
CAIRN) (SOUTH TO OUTSIDE-HUT) (FLAGS RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT) (
GLOBAL DIMWIT-STATUE) (MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-7>)
(THINGS <> SHADOW PHIL-SHADOW-PS SMALL TREES TREE-PS) (ACTION VIEW-OF-STATUE-F)
>
<DEFINE-ROUTINE TREE-PS>
<DEFINE-ROUTINE VIEW-OF-STATUE-F>
<ROOM OUTSIDE-HUT (LOC ROOMS) (REGION "Fublio Valley") (DESC "Outside Hut") (
LDESC "A trail from the north ends here. To the west is a decaying hut.") (
NORTH TO VIEW-OF-STATUE) (WEST TO MEGABOZ-HUT) (IN TO MEGABOZ-HUT) (FLAGS
RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT) (GLOBAL MEGABOZ-HUT) (MAP-LOC <PTABLE
FUBLIO-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-7>) (ICON OUTSIDE-HUT-ICON)>
<ROOM MEGABOZ-HUT (LOC ROOMS) (REGION "Fublio Valley") (DESC "Megaboz's Hut") (
EAST TO OUTSIDE-HUT) (OUT TO OUTSIDE-HUT) (UP PER ATTIC-ENTER-F) (SYNONYM HUT)
(OWNER MEGABOZ) (GLOBAL MEGABOZ-TRAP-DOOR) (FLAGS RLANDBIT BEYONDBIT) (MAP-LOC
<PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-6>) (ACTION MEGABOZ-HUT-F)>
<DEFINE-ROUTINE MEGABOZ-HUT-F>
<DEFINE-ROUTINE ATTIC-ENTER-F>
<OBJECT POEM (LOC MEGABOZ-HUT) (DESC "poem") (SYNONYM POEM) (FLAGS NDESCBIT
READBIT) (TEXT "\"She stood in the shade of a _ _ _ _ _ _ _ _ _|
She held the prize of an _ _ _ _ _ _ _ _|
And all beheld that she proudly _ _ _ _|
A relic found in a _ _ _ _ _ _ _ _ _ _\"")>
<OBJECT WALL-HANGINGS (LOC MEGABOZ-HUT) (DESC "wall hangings") (SYNONYM HANGING
HANGINGS) (ADJECTIVE EMBROIDER WALL) (FLAGS NDESCBIT READBIT) (TEXT
"One hanging reads \"Hut Sweet Hut\" and the other reads \"Forget the rest;
Megaboz is the best.\"")>
<OBJECT MEGABOZ-TRAP-DOOR (LOC LOCAL-GLOBALS) (DESC "trap door") (SYNONYM DOOR)
(ADJECTIVE TRAP) (FLAGS DOORBIT) (ACTION MEGABOZ-TRAP-DOOR-F)>
<DEFINE-ROUTINE MEGABOZ-TRAP-DOOR-F>
<ROOM ATTIC (LOC ROOMS) (REGION "Fublio Valley") (DESC "Attic") (LDESC
"This musty little room is barely more than a crawl space beneath the roof of
the hut.") (DOWN TO MEGABOZ-HUT IF MEGABOZ-TRAP-DOOR IS OPEN) (FLAGS RLANDBIT
BEYONDBIT) (GLOBAL MEGABOZ-TRAP-DOOR LOCK-OBJECT) (VALUE 8) (SYNONYM ATTIC) (
MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-5>) (ICON ATTIC-ICON) (
THINGS <> SHADOW PHIL-SHADOW-PS)>
<OBJECT ATTIC-REBUS-BUTTON (LOC ATTIC) (SDESC "blinking key-shaped button") (
SYNONYM BUTTON) (ADJECTIVE KEY-SHAPED BLINKING) (ACTION REBUS-BUTTON-F)>
<OBJECT TRUNK (LOC ATTIC) (DESC "trunk") (LDESC
"In the shadows under the eaves, you spot an ancient trunk, covered with
dust and cobwebs.") (SYNONYM TRUNK) (ADJECTIVE ANCIENT DUSTY) (FLAGS TRYTAKEBIT
CONTBIT SEARCHBIT LOCKEDBIT) (CAPACITY 75) (ACTION TRUNK-F)>
<DEFINE-ROUTINE TRUNK-F>
<GLOBAL FLY-IN-TRUNK T>
<OBJECT ROBE (LOC MEGABOZ) (DESC "wizardly robe") (SYNONYM ROBE) (ADJECTIVE
WIZARDLY) (FLAGS WEARBIT)>
<BEGIN-SEGMENT 0>
<OBJECT PAN (LOC TRUNK) (DESC "saucepan") (SYNONYM SAUCEPAN PAN) (FLAGS TAKEBIT
CONTBIT OPENBIT SEARCHBIT) (ACTION PAN-F)>
<DEFINE-ROUTINE PAN-F>
<OBJECT NOTEBOOK (LOC TRUNK) (DESC "notebook") (SYNONYM NOTEBOOK) (FLAGS
TAKEBIT READBIT) (ACTION NOTEBOOK-F)>
<DEFINE-ROUTINE NOTEBOOK-F>
<GLOBAL SACRED-WORD-NUMBER 10>
<CONSTANT SACRED-WORDS <PTABLE "sizul" "fzorty" "xzilch" "fublitskee" "zastic"
"aulderfoo" "lizowurt" "eldablitz" "mordex" "hildebud">>
<CONSTANT SACRED-WORD-WORDS-LENGTH 10>
<CONSTANT SACRED-WORD-WORDS <PTABLE <VOC "SIZUL" <>> <VOC "FZORTY" <>> <VOC
"XZILCH" <>> <VOC "FUBLITSKEE" <>> <VOC "ZASTIC" <>> <VOC "AULDERFOO" <>> <VOC
"LIZOWURT" <>> <VOC "ELDABLITZ" <>> <VOC "MORDEX" <>> <VOC "HILDEBUD" <>>>>
<OBJECT SACRED-WORD-OBJ (DESC "sacred word") (SYNONYM SIZUL FZORTY XZILCH
FUBLITSKEE ZASTIC AULDERFOO LIZOWURT ELDABLITZ MORDEX HILDEBUD)>
<OBJECT HARMONICA (LOC TRUNK) (DESC "harmonica") (SYNONYM HARMONICA) (FLAGS
TAKEBIT) (SIZE 3) (ACTION HARMONICA-F)>
<DEFINE-ROUTINE HARMONICA-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM CAIRN (LOC ROOMS) (REGION "Fublio Valley") (DESC "Cairn") (LDESC
"Paths lead around this haphazard pile of stones to the northwest, east,
and south.") (NW TO VIEW-OF-STATUE) (EAST TO OUTSIDE-SHACK) (SOUTH TO
QUARRYS-EDGE) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (MAP-LOC <PTABLE
FUBLIO-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-8>) (ICON CAIRN-ICON)>
<OBJECT CAIRN-OBJECT (LOC CAIRN) (DESC "pile of stones") (SYNONYM PILE STONE
STONES CAIRN) (ADJECTIVE HAPHAZARD) (FLAGS NDESCBIT) (ACTION CAIRN-OBJECT-F)>
<DEFINE-ROUTINE CAIRN-OBJECT-F>
<ROOM OUTSIDE-SHACK (LOC ROOMS) (REGION "Fublio Valley") (DESC "Outside Shack")
(LDESC "To the northeast is a run-down little shack. A sign is posted by the
entrance, and a path runs off to the west.") (WEST TO CAIRN) (NE TO
GUMBOZ-SHACK) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL GUMBOZ-SHACK
SIGN) (MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-9>)>
<ROOM GUMBOZ-SHACK (LOC ROOMS) (REGION "Fublio Valley") (DESC "Gumboz's Shack")
(LDESC "You are in a small shack, the home of an obscure magician named Gumboz. The
only exit is southwest.") (SW PER SHACK-EXIT-F) (OUT PER SHACK-EXIT-F) (FLAGS
RLANDBIT BEYONDBIT) (SYNONYM SHACK) (ADJECTIVE GUMBOZ\'S) (MAP-LOC <PTABLE
FUBLIO-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-10>) (ACTION GUMBOZ-SHACK-F)>
<DEFINE-ROUTINE GUMBOZ-SHACK-F>
<DEFINE-ROUTINE SHACK-EXIT-F>
<GLOBAL HUNGER-SPELL-CAST <>>
<GLOBAL HUNGER-COUNT 0>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE CAST-HUNGER-SPELL>
<DEFINE-ROUTINE I-HUNGER>
<OBJECT SMALL-VIAL (LOC GUMBOZ-SHACK) (DESC "four-gloop vial") (SYNONYM VIAL
WRITING) (ADJECTIVE FOUR-GLOOP 4-GLOOP FOUR GLOOP SMALL INT.NUM) (FLAGS TAKEBIT
READBIT TRYTAKEBIT) (SIZE 3) (OWNER SMALL-VIAL) (GENERIC G-VIAL-F) (ACTION
VIAL-F)>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM QUARRYS-EDGE (LOC ROOMS) (REGION "Fublio Valley") (DESC "Quarry's Edge")
(LDESC "The trail curves north and east around an abandoned quarry.|
An ancient pine clings to the rim of the quarry. Its needles are brown with
age, and its drooping branches cast a dark shadow across the quarry below.") (
NORTH TO CAIRN) (DOWN TO QUARRY) (EAST TO OUTSIDE-HOVEL) (FLAGS RLANDBIT ONBIT
BEYONDBIT OUTSIDEBIT) (GLOBAL TIRED-PINE QUARRY) (MAP-LOC <PTABLE
FUBLIO-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-8>) (ICON QUARRYS-EDGE-ICON) (THINGS <>
SHADOW QUARRY-SHADOW-PS)>
<OBJECT TIRED-PINE (LOC LOCAL-GLOBALS) (DESC "ancient pine tree") (SYNONYM TREE
PINE) (ADJECTIVE PINE TIRED ANCIENT OLD LARGE) (FLAGS VOWELBIT PLANTBIT) (
ACTION TIRED-PINE-F)>
<DEFINE-ROUTINE TIRED-PINE-F>
<ROOM QUARRY (LOC ROOMS) (DESC "Quarry") (REGION "Fublio Valley") (LDESC
"The branches of a weary old pine cast a dark shadow across the floor
of this old stone quarry.") (UP TO QUARRYS-EDGE) (OUT TO QUARRYS-EDGE) (FLAGS
RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (SYNONYM QUARRY) (ADJECTIVE ABANDONED OLD
STONE) (GLOBAL TIRED-PINE) (MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-7
MAP-GEN-X-7>) (ICON QUARRY-ICON) (THINGS <> SHADOW QUARRY-SHADOW-PS) (ACTION
QUARRY-F)>
<DEFINE-ROUTINE QUARRY-F>
<DEFINE-ROUTINE QUARRY-SHADOW-PS>
<BEGIN-SEGMENT 0>
<OBJECT RUSTY-KEY (LOC LOCAL-GLOBALS) (DESC "rusty key") (SYNONYM KEY) (
ADJECTIVE RUSTY OLD) (FLAGS TAKEBIT KEYBIT) (SIZE 2) (ACTION RUSTY-KEY-F)>
<DEFINE-ROUTINE RUSTY-KEY-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM OUTSIDE-HOVEL (LOC ROOMS) (REGION "Fublio Valley") (DESC "Outside Hovel")
(LDESC "A trail from the west ends here at this tiny structure. Next to the
hovel's entrance, to the east, is a faded sign.") (WEST TO QUARRYS-EDGE) (EAST
TO KORBOZ-HOVEL) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL SIGN
KORBOZ-HOVEL) (MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-9>)>
<ROOM KORBOZ-HOVEL (LOC ROOMS) (REGION "Fublio Valley") (DESC "Korboz's Hovel")
(LDESC "This tiny shack looks like the living quarters of a hermit wizard. The
only exit is west.") (WEST TO OUTSIDE-HOVEL) (OUT TO OUTSIDE-HOVEL) (FLAGS
RLANDBIT BEYONDBIT) (SYNONYM HOVEL) (ADJECTIVE KORBOZ\'S) (MAP-LOC <PTABLE
FUBLIO-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-10>)>
<ROOM BASE-OF-MOUNTAINS (LOC ROOMS) (REGION "Fublio Valley") (DESC
"Base of Mountains") (LDESC
"You are near the base of the mighty Flathead Mountains, toward the
southernmost end of the range. The mountains run approximately northeast
to southwest here. The path turns here, heading east into the valley
and north into the foothills.") (NORTH TO FOOTHILLS) (UP TO FOOTHILLS) (EAST TO
VIEW-OF-STATUE) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL
FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-6>) (
ICON BASE-OF-MTS-ICON)>
<ROOM FOOTHILLS (LOC ROOMS) (REGION "Flathead Mountains") (DESC "Foothills") (
LDESC "You are in the foothills of the Flathead Mountains, at the entrance to the
Zorbel Pass. The pass rises to the northwest, and a path leads downward to
the south.") (NW TO ZORBEL-PASS) (UP TO ZORBEL-PASS) (SOUTH TO
BASE-OF-MOUNTAINS) (DOWN TO BASE-OF-MOUNTAINS) (FLAGS RLANDBIT ONBIT BEYONDBIT
OUTSIDEBIT) (GLOBAL FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FUBLIO-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-6>)>
<ROOM ZORBEL-PASS (LOC ROOMS) (REGION "Flathead Mountains") (DESC "Zorbel Pass"
) (LDESC "This pass is reputed to be the only crossable point along the entire range.
You are now far above the valley floor, which spreads out below you like a
map, but you have still not reached the highest point of the pass.") (DOWN TO
FOOTHILLS) (SE TO FOOTHILLS) (NW TO AVALANCHE) (UP TO AVALANCHE) (FLAGS
RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL FLATHEAD-MOUNTAINS) (MAP-LOC <
PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-5>) (ICON ZORBEL-PASS-ICON)>
<ROOM AVALANCHE (LOC ROOMS) (REGION "Flathead Mountains") (DESC "Avalanche") (
LDESC "As you near the highest point of the pass, you find it blocked by a recent
avalanche. Though you can travel no farther to the northwest, the avalanche
has revealed an ancient ravine leading up the side of the mountain.") (DOWN TO
ZORBEL-PASS) (UP TO TIMBERLINE) (NW SORRY "The way is blocked by an avalanche."
) (SE TO ZORBEL-PASS) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL
FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-4>) (
ICON AVALANCHE-ICON)>
<ROOM TIMBERLINE (LOC ROOMS) (REGION "Flathead Mountains") (DESC "Timberline")
(LDESC "You are on the slopes of Mount Foobia, the tallest peak in the Flathead
Mountains. A narrow ravine leads almost straight downward. The vegetation
thins out here, and the air is getting a bit thin as well. Not too far
above you, the slope disappears into the thick clouds which eternally
shroud the apex of Foobia.") (UP TO AMONGST-THE-CLOUDS) (DOWN TO AVALANCHE) (
FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL FLATHEAD-MOUNTAINS) (MAP-LOC
<PTABLE FUBLIO-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-3>) (ICON TIMBERLINE-ICON)>
<ROOM AMONGST-THE-CLOUDS (LOC ROOMS) (REGION "Flathead Mountains") (DESC
"Amongst the Clouds") (LDESC
"You are surrounded by the thick white clouds which perpetually hide the peak
of Mount Foobia. Visibility is severely limited; you can only assume that the
slope continues to be climbable above you. Breathing here is a chore.") (UP TO
ON-TOP-OF-THE-WORLD) (DOWN TO TIMBERLINE) (FLAGS RLANDBIT ONBIT BEYONDBIT
OUTSIDEBIT) (GLOBAL FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FUBLIO-MAP-NUM
MAP-GEN-Y-2 MAP-GEN-X-2>) (ICON AMONGST-CLOUDS-ICON)>
<ROOM ON-TOP-OF-THE-WORLD (LOC ROOMS) (REGION "Flathead Mountains") (DESC
"On Top of the World") (LDESC
"You have emerged above the cloud layer, at a plateau which forms the apex of
Foobia. There is no sign that anyone has ever been here before. Nearby is a
huge object, which vanishes into the mists above. It's difficult to be certain,
but it looks a bit like a piece of a corner of an edge of a toe of an
enormously tremendous brogmoid. A huge colony of fungus clogs the cracks in
the toe.") (DOWN TO AMONGST-THE-CLOUDS) (UP SORRY
"The brogmoid toe is unclimbable.") (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT)
(GLOBAL BROGMOID FLATHEAD-MOUNTAINS) (MAP-LOC <PTABLE FUBLIO-MAP-NUM
MAP-GEN-Y-2 MAP-GEN-X-1>) (ICON ON-TOP-OF-WORLD-ICON)>
<OBJECT TOE-FUNGUS (LOC ON-TOP-OF-THE-WORLD) (DESC "toe fungus") (SYNONYM
FUNGUS FUNGI) (ADJECTIVE TOE) (FLAGS NDESCBIT PLANTBIT) (GENERIC G-FUNGUS-F) (
RESEARCH "\"A class of saprophytic parasitical plants which lack chlorophyll and are
frequently found in the less hygienic cavities of brogmoids.\"") (ACTION
TOE-FUNGUS-F)>
<DEFINE-ROUTINE TOE-FUNGUS-F>
<DEFINE-ROUTINE GET-LITTLE-FUNGUS>
<BEGIN-SEGMENT 0>
<OBJECT LITTLE-FUNGUS (LOC GLOBAL-OBJECTS) (DESC "little fungus") (SYNONYM
SEYMOUR SHERMAN IRVING SAMMY MYRON BORIS MELVIN LESTER JULIUS RICARDO OMAR
BARNABY FUNGUS COUSIN) (ADJECTIVE SMALL) (FLAGS PLANTBIT) (GENERIC G-FUNGUS-F)
(RESEARCH "\"A class of saprophytic parasitical plants which lack chlorophyll and are
frequently found in the less hygienic cavities of brogmoids.\"") (ACTION
LITTLE-FUNGUS-F)>
<DEFINE-ROUTINE LITTLE-FUNGUS-F>
<END-SEGMENT>
\
<BEGIN-SEGMENT ORACLE>
<ROOM MINE-ENTRANCE (LOC ROOMS) (REGION "Antharia") (DESC "Mine Entrance") (
LDESC "The Antharian granola mines can be entered to the east, and a major
road leads west. Signs of the granola riots are everywhere. Speaking of
signs, there's one next to the mine entrance.") (WEST TO COAST-ROAD) (EAST TO
RUBBLE-ROOM) (IN TO RUBBLE-ROOM) (FLAGS RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT) (
GLOBAL SIGN GRANOLA-MINE) (VALUE 10) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-8>) (ICON MINE-ENTRANCE-ICON)>
<ROOM COAST-ROAD (LOC ROOMS) (REGION "Antharia") (DESC "Coast Road") (LDESC
"This is a bend in a wide dirt road running along the ocean's edge. You can
go east or southwest.") (EAST TO MINE-ENTRANCE) (SW TO FLATHEAD-STADIUM) (FLAGS
RLANDBIT OUTSIDEBIT ONBIT BEYONDBIT) (GLOBAL FLATHEAD-OCEAN) (MAP-LOC <PTABLE
ANTHARIA-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-7>) (ICON COAST-ROAD-ICON)>
<ROOM FLATHEAD-STADIUM (LOC ROOMS) (REGION "Antharia") (DESC "Flathead Stadium"
) (LDESC "This was one of Dimwit's most impressive projects: a stadium which would
hold the entire population of the Great Underground Empire. A whole range
of sporting matches were held here, from dragonfights to Double Fanucci
tournaments. Arched exits lead northeast, southeast, and south.") (NE TO
COAST-ROAD) (SE TO EDGE-OF-BOG) (SOUTH TO NORTH-OF-ANTHAR) (FLAGS RLANDBIT
OUTSIDEBIT ONBIT BEYONDBIT) (SYNONYM STADIUM) (ADJECTIVE FLATHEAD LARGE) (
MAP-LOC <PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-6>) (ICON STADIUM-ICON)>
<BEGIN-SEGMENT 0>
<OBJECT BAT (LOC FLATHEAD-STADIUM) (DESC "wooden club") (FDESC
"A long wooden club lies on the turf. There is something engraved on the
club's thick end.") (SYNONYM CLUB BAT) (ADJECTIVE WOODEN BASEBALL) (FLAGS
TRYTAKEBIT TAKEBIT BURNBIT READBIT MAGICBIT) (SIZE 10) (VALUE 12) (TEXT
"A symbol which resembles a winged rodent is engraved on the barrel
of the club.") (ACTION BAT-F)>
<GLOBAL BAT-SWINGS 0>
<DEFINE-ROUTINE BAT-F>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM NORTH-OF-ANTHAR (LOC ROOMS) (REGION "Antharia") (DESC "North of Anthar")
(LDESC "You are on a road at the fringe of Anthar. The road continues north and
south. In the latter direction, a hastily constructed fence of rock and
wire blocks the road. A sign is posted in front of the fence. A smaller
path heads eastward.") (SOUTH SORRY
"The fence is very tall and covered with sharp nasties.") (NORTH TO
FLATHEAD-STADIUM) (EAST TO EDGE-OF-BOG) (FLAGS RLANDBIT ONBIT BEYONDBIT
OUTSIDEBIT) (GLOBAL SIGN) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-6
MAP-GEN-X-6>) (THINGS <> FENCE FENCE-PS)>
<DEFINE-ROUTINE FENCE-PS>
<ROOM EDGE-OF-BOG (LOC ROOMS) (REGION "Antharia") (DESC "Edge of Bog") (LDESC
"A series of flat stones leads east into a mist-covered marsh. Paths lead
northwest and west.") (EAST TO CLIFF-BOTTOM) (WEST TO NORTH-OF-ANTHAR) (NW TO
FLATHEAD-STADIUM) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (GLOBAL SWAMP) (
MAP-LOC <PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-7>)>
<ROOM CLIFF-BOTTOM (LOC ROOMS) (REGION "Antharia") (DESC "Cliff Bottom") (LDESC
"You are at the bottom of a sheer granite cliff. A foggy swamp lies to
the west. Rough handholds have been carved into the face of the cliff.") (WEST
TO EDGE-OF-BOG) (UP TO PRECIPICE) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (
GLOBAL SWAMP) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-6 MAP-GEN-X-8>) (ICON
CLIFF-BOTTOM-ICON)>
<ROOM PRECIPICE (LOC ROOMS) (REGION "Antharia") (DESC "Precipice") (LDESC
"This is a tiny shelf of granite atop a sheer cliff. Below, you can see a
misty bog and, beyond that, the ocean. Far to the northwest is a large
stadium; to the southwest, a town. A path leads east into a hollow.") (DOWN TO
CLIFF-BOTTOM) (EAST TO AERIE) (FLAGS RLANDBIT ONBIT BEYONDBIT OUTSIDEBIT) (
GLOBAL SWAMP FLATHEAD-OCEAN FLATHEAD-STADIUM GLOBAL-BLDG) (MAP-LOC <PTABLE
ANTHARIA-MAP-NUM MAP-GEN-Y-5 MAP-GEN-X-8>) (ICON PRECIPICE-ICON)>
<ROOM AERIE (LOC ROOMS) (REGION "Antharia") (DESC "Aerie") (LDESC
"You are in a natural bowl-shaped depression, hollowed out by eons of howling
wind. At the bottom is a huge bird nest, built of myriad bits of scavenged
twigs and debris. Beyond the nest, to the southeast, is a dark opening. A
trail leads west.") (WEST TO PRECIPICE) (SE TO ICKY-CAVE) (FLAGS RLANDBIT ONBIT
BEYONDBIT OUTSIDEBIT) (SYNONYM AERIE) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-9>) (ICON AERIE-ICON) (ACTION AERIE-F)>
<DEFINE-ROUTINE AERIE-F>
<DEFINE-ROUTINE FIND-LANTERN>
<OBJECT NEST (LOC AERIE) (DESC "nest") (SYNONYM NEST) (ADJECTIVE LARGE BIRD
BIRD\'S) (FLAGS NDESCBIT VEHBIT CONTBIT OPENBIT SEARCHBIT) (ACTION NEST-F)>
<DEFINE-ROUTINE NEST-F>
<OBJECT SILK-TIE (LOC LOCAL-GLOBALS) (DESC "silk tie") (SYNONYM TIE) (ADJECTIVE
FADED GRAY) (FLAGS TAKEBIT MAGICBIT WEARBIT READBIT) (TEXT
"Although terribly old and faded, you can tell that the tie was once gray with
little green zorkmid symbols all over it.") (VALUE 12)>
<ROOM ICKY-CAVE (LOC ROOMS) (REGION "Antharia") (DESC "Icky Cave") (NW TO AERIE
) (OUT TO AERIE) (FLAGS RLANDBIT BEYONDBIT UNDERGROUNDBIT) (SYNONYM CAVE CAVERN
) (ADJECTIVE ICKY SMALL) (GLOBAL SLIME) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM
MAP-GEN-Y-6 MAP-GEN-X-10>) (ICON ICKY-CAVE-ICON) (ACTION ICKY-CAVE-F)>
<DEFINE-ROUTINE ICKY-CAVE-F>
<OBJECT SICKLY-WITCH (DESC "sickly witch") (LDESC
"In the dimmest corner of the cave huddle a pair of witches. One looks
healthier but less friendly than the other.") (SYNONYM WITCH) (ADJECTIVE SICKLY
FRIENDLY UNHEALTHY) (FLAGS ACTORBIT FEMALEBIT ANIMATEDBIT) (ACTION WITCH-F)>
<OBJECT PRICKLY-WITCH (DESC "prickly witch") (SYNONYM WITCH) (ADJECTIVE PRICKLY
UNFRIENDLY HEALTHY) (FLAGS ACTORBIT FEMALEBIT ANIMATEDBIT NDESCBIT) (ACTION
WITCH-F)>
<DEFINE-ROUTINE WITCH-F>
<CONSTANT FINISH-ENCHANTMENT
" Camel sweat! Rotgrub heart! The enchantment begone!\" A palpable wave of
magic sweeps over you and out of the cave.|">
<GLOBAL VIAL-GIVEN <>>
<GLOBAL EARWAX-GIVEN <>>
<BEGIN-SEGMENT 0>
<OBJECT LARGE-VIAL (LOC LOCAL-GLOBALS) (DESC "nine-gloop vial") (SYNONYM VIAL
WRITING) (ADJECTIVE NINE-GLOOP 9-GLOOP NINE GLOOP LARGE INT.NUM) (FLAGS TAKEBIT
READBIT) (GENERIC G-VIAL-F) (OWNER LARGE-VIAL) (ACTION VIAL-F)>
<DEFINE-ROUTINE G-VIAL-F>
<GLOBAL SMALL-VIAL-GLOOPS 0>
<GLOBAL LARGE-VIAL-GLOOPS 0>
<GLOBAL SMALL-VIAL-TAINTED <>>
<GLOBAL LARGE-VIAL-TAINTED <>>
<GLOBAL SMALL-VIAL-IMPRECISE <>>
<GLOBAL LARGE-VIAL-IMPRECISE <>>
<CONSTANT INTEGERS <PLTABLE <VOC "ONE"> <VOC "TWO"> <VOC "THREE"> <VOC "FOUR">
<VOC "FIVE"> <VOC "SIX"> <VOC "SEVEN"> <VOC "EIGHT"> <VOC "NINE">>>
<DEFINE-ROUTINE CONVERT-NUMBER>
<DEFINE-ROUTINE VIAL-F>
<DEFINE-ROUTINE NO-GRADATIONS>
<DEFINE-ROUTINE PRINT-GLOOP>
<DEFINE-ROUTINE POUR-VIALS>
<END-SEGMENT>
<BEGIN-SEGMENT ORACLE>
<ROOM RUBBLE-ROOM (LOC ROOMS) (REGION "Antharia") (DESC "Rubble Room") (LDESC
"You are just within the mouth of a granola mine. Daylight is visible to the
west. Tunnels wind downward to the north, northeast, and east. Chunks of
loose rubble, disturbed by the first visitor since the granola riots, fall
from the roof of the mine.") (WEST TO MINE-ENTRANCE) (OUT TO MINE-ENTRANCE) (
EAST TO HEART-OF-MINE) (NORTH TO HEART-OF-MINE) (NE TO HEART-OF-MINE) (FLAGS
RLANDBIT BEYONDBIT UNDERGROUNDBIT) (GLOBAL GRANOLA GRANOLA-MINE) (MAP-LOC <
PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-9>) (ACTION RUBBLE-ROOM-F)>
<GLOBAL RUBBLE-SCORE 9>
<DEFINE-ROUTINE RUBBLE-ROOM-F>
<ROOM HEART-OF-MINE (LOC ROOMS) (REGION "Antharia") (DESC "Heart of Mine") (
LDESC "You are in a major granola mine. Half-mined granola is everywhere. The remains
of a vast transportation system lies in ruins. Tunnels wind south, southwest,
and west, and a tiny half-buried tunnel leads downward to the north.") (SOUTH
TO RUBBLE-ROOM) (SW TO RUBBLE-ROOM) (WEST TO RUBBLE-ROOM) (NORTH TO CRAWL) (
FLAGS RLANDBIT BEYONDBIT UNDERGROUNDBIT) (GLOBAL GRANOLA GRANOLA-MINE) (MAP-LOC
<PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-10>)>
<ROOM CRAWL (LOC ROOMS) (REGION "Antharia") (DESC "Crawl") (LDESC
"You are in a poorly dug tunnel, not even tall enough to stand up in. The
tunnel curves slightly, running from south to northwest.") (SOUTH TO
HEART-OF-MINE) (NW TO DEAD-END) (FLAGS RLANDBIT BEYONDBIT UNDERGROUNDBIT) (
GLOBAL GRANOLA GRANOLA-MINE) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-2
MAP-GEN-X-10>)>
<OBJECT CRAWL-REBUS-BUTTON (LOC CRAWL) (SDESC "blinking key-shaped button") (
FDESC "Imbedded in the rocky wall is a blinking button in the shape of a key.")
(SYNONYM BUTTON) (ADJECTIVE KEY-SHAPED BLINKING) (ACTION REBUS-BUTTON-F)>
<ROOM DEAD-END (LOC ROOMS) (REGION "Antharia") (DESC "Dead End") (LDESC
"The low tunnel ends here in a small cul-de-sac. The way back is southeast.") (
SE TO CRAWL) (OUT TO CRAWL) (FLAGS RLANDBIT BEYONDBIT UNDERGROUNDBIT) (GLOBAL
GRANOLA GRANOLA-MINE) (MAP-LOC <PTABLE ANTHARIA-MAP-NUM MAP-GEN-Y-1 MAP-GEN-X-9
>) (ICON DEAD-END-ICON)>
<OBJECT QUILL-PEN (LOC DEAD-END) (DESC "quill pen") (SYNONYM PEN QUILL) (
ADJECTIVE QUILL) (VALUE 12) (SIZE 3) (FLAGS TAKEBIT MAGICBIT)>
<OBJECT GRANOLA-MINE (LOC LOCAL-GLOBALS) (DESC "granola mine") (SYNONYM MINE) (
ADJECTIVE GRANOLA) (RESEARCH
"\"The granola mines in northern Antharia once supplied seemingly limitless
quantities of granola. Since the Granola Riots of 865 GUE, the causes of
which are well known, the output of the mines has fallen sharply.\"") (ACTION
GRANOLA-MINE-F)>
<DEFINE-ROUTINE GRANOLA-MINE-F>
<OBJECT GRANOLA (LOC LOCAL-GLOBALS) (DESC "granola") (SYNONYM GRANOLA) (FLAGS
NARTICLEBIT) (RESEARCH
"\"The granola mines in northern Antharia once supplied seemingly limitless
quantities of granola. Since the Granola Riots of 865 GUE, the causes of
which are well known, the output of the mines has fallen sharply.\"") (ACTION
GRANOLA-F)>
<DEFINE-ROUTINE GRANOLA-F>
<DEFINE-ROUTINE STEP-IN-IT>

1801
oracle.zap Normal file
View File

File diff suppressed because it is too large Load Diff

3376
oracle.zil Normal file
View File

File diff suppressed because it is too large Load Diff

1045
parser.zap Normal file
View File

File diff suppressed because it is too large Load Diff

1719
parser.zil Normal file
View File

File diff suppressed because it is too large Load Diff

296
pdefs.zil Normal file
View File

@ -0,0 +1,296 @@
"PDEFS file for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<ZZSECTION "PDEFS">
<USE "NEWSTRUC" "PMEM">
<INCLUDE "BASEDEFS">
<FILE-FLAGS MDL-ZIL? ZAP-TO-SOURCE-DIRECTORY?>
"Defaults for ZIL-type DEFSTRUCTs"
<SET-DEFSTRUCT-FILE-DEFAULTS ('START-OFFSET 0) ('NTH ZGET) ('PUT ZPUT)
'NODECL>
<BLOCK (<ROOT>)>
ZMEMQ
ZMEMQB
<ENDBLOCK>
<COND (<OR <CHECK-VERSION? XZIP>
<CHECK-VERSION? YZIP>>
<DEFMAC ZMEMQB ('OBJ 'TBL 'LEN)
<FORM INTBL? .OBJ .TBL .LEN 1>>)
(T
<ROUTINE ZMEMQB ZM (OBJ:ANY TBL:TABLE LEN:FIX)
<REPEAT ((N 0))
<COND (<==? <GETB .TBL .N> .OBJ>
<RETURN <ZREST .TBL .N> .ZM>)>
<COND (<G=? <SET N <+ .N 1>> .LEN>
<RETURN <> .ZM>)>>>)>
<COND (<CHECK-VERSION? ZIP>
<ROUTINE ZMEMQ (OBJ:ANY TBL:TABLE LEN:FIX)
<REPEAT ((N 0))
<COND (<==? <ZGET .TBL .N> .OBJ>
<RETURN <ZREST .TBL <* .N 2>>>)>
<COND (<G=? <SET N <+ .N 1>> .LEN>
<RETURN <>>)>>>)
(T
<DEFMAC ZMEMQ ('OBJ 'TBL 'LEN)
<FORM INTBL? .OBJ .TBL .LEN>>)>
<SETG20 PDEFS-INTERNAL-OBLIST .OBLIST>
;<MSETG PARSER-ERROR-ARG-PMEM 1>
;<MSETG PARSER-ERROR-ARG-VWORD 2>
<MSETG PARSER-ERROR-TMNOUN 247>
<MSETG PARSER-ERROR-NOOBJ 248>
;<MSETG PARSER-ERROR-NOOBJ2 249>
<MSETG PARSER-ERROR-ORPH-NP 250>
<MSETG PARSER-ERROR-ORPH-S 251>
<MSETG PARSER-ERROR-NOMULT 252>
<MSETG PARSER-ERROR-NOUND 253>
;<MSETG PARSER-ERROR-QUIET 254>
<MSETG PARSER-RESULT-DEAD 0>
<MSETG PARSER-RESULT-FAILED 1>
<MSETG PARSER-RESULT-WON 2>
<MSETG PARSER-RESULT-AGAIN 3>
<MSETG FD-INCLUDE? 1>
<MSETG FD-SEARCH? 2>
<MSETG FD-NEST? 4>
<MSETG FD-NOTOP? 8>
"Definitions for various PMEMs"
<MSETG ADJS-MAX-COUNT 4>
<PM-TYPE ADJS ;1 <+ 4 ,ADJS-MAX-COUNT>
(LEXPTR FIX)
(POSS ANY ;<OR FALSE OBJECT PMEM ;"noun">)
(QUANT <OR FALSE FIX>)
(COUNT FIX 0)>
<CONSTANT ORPHAN-ADJS <ITABLE <+ 1 <+ 4 ,ADJS-MAX-COUNT>> 0>>
<MSETG NP-LENGTH 9>
<PM-TYPE NP ;2 ,NP-LENGTH
(ADJS <OR FALSE PMEM>)
(NAME <OR FALSE VWORD>)
(QUANT <OR FALSE FIX>)
(OF <OR FALSE PMEM>)
(LOC <OR FALSE PMEM>)
(EXCEPT <OR FALSE PMEM>)
(LEXBEG <OR FALSE FIX>)
(LEXEND <OR FALSE FIX>)>
<CONSTANT ORPHAN-NP <ITABLE <+ 1 ,NP-LENGTH> 0>>
<CONSTANT ORPHAN-NP2 <ITABLE <+ 1 ,NP-LENGTH> 0>>
<PM-TYPE NPP ;3 3
(NEXT <OR FALSE PMEM ;NPP>)
(NOUN <OR FALSE PMEM ;NP>)
(NOUN-PHRASE <OR FALSE PMEM>)>
<PM-TYPE NOUN-PHRASE ;4 <>
(COUNT FIX 0)
(FLAGS FIX 0)
(OBJ1 <OR FALSE FIX ;OBJECT>)
(NP1 <OR FALSE PMEM ;NP>)>
<MSETG NP-FLAG-MULTI 1>
;<DEFMAC NP-MULTI? ('NOUN-PHRASE)
<FORM NOT <FORM 0? <FORM ANDB <FORM NOUN-PHRASE-FLAGS .NOUN-PHRASE>
,NP-FLAG-MULTI>>>>
<MSETG NOUN-PHRASE-ENTLENB 4>
<MSETG NOUN-PHRASE-ENTLEN 2>
<MSETG NOUN-PHRASE-HEADER-LEN 3>
<MSETG NOUN-PHRASE-MIN-LENGTH 4>
<PM-TYPE PP ;5 2
(PREP VWORD NONE)
(NOUN PMEM ;<OR NP NPP> NONE)>
<PM-TYPE LOCATION ;6 2
(PREP VWORD NONE)
(OBJECT PMEM NONE)>
<PM-TYPE OBJLIST ;7 <>
(SIZE FIX)
;(COUNT <OR FALSE FIX>)
(NEXT <OR FALSE PMEM>)
(OWNER ANY) ;"for compatibility with FIND-RES"
(OBJ1 ANY)>
"NP-QUANT slot"
<MSETG NP-QUANT-NONE <>>
<MSETG NP-QUANT-A 1>
;<MSETG NP-QUANT-SOME 2>
<MSETG NP-QUANT-ALL 3>
<MSETG NP-QUANT-BOTH 4>
<MSETG NP-QUANT-NOTHING 5>
<MSETG NP-QUANT-PLURAL 6>
<ADD-WORD ALL QUANT>
<ADD-WORD A QUANT>
<ADD-WORD AN QUANT>
<ADD-WORD ANY QUANT>
<ADD-WORD EITHER QUANT>
;<ADD-WORD SOME QUANT> "It's a can of some worms."
<CONSTANT NP-QUANT-TBL-LEN 6>
<CONSTANT NP-QUANT-TBL
<PTABLE NP-QUANT-ALL <VOC "ALL">
NP-QUANT-BOTH <VOC "BOTH">
NP-QUANT-A <VOC "ONE">
NP-QUANT-A <VOC "EITHER">
NP-QUANT-A <VOC "ANY">
;NP-QUANT-SOME ;<VOC "SOME">
;NP-QUANT-NOTHING ;<VOC "NONE">>>
<GDECL (VALID-VERB-CLASSES VALID-QUESTION-CLASSES) <VECTOR [REST FIX]>>
ADJ-CLASS
NOUN-CLASS
<MSETG FIRST-PERSON 8>
<MSETG PLURAL-FLAG 16>
<MSETG SECOND-PERSON 32>
<MSETG THIRD-PERSON 64>
<MSETG PRESENT-TENSE 256>
<MSETG PAST-TENSE 512>
<MSETG FUTURE-TENSE 1024>
<MSETG POSSESSIVE 16384>
;"<MSETG PERSON-PNF 4096>
<MSETG THING-PNF 8192>
<MSETG DONT-ORPHAN 32768>
<MSETG DEFAULT-OBJECT 65536>"
<COND (<OR <CHECK-VERSION? XZIP>
<CHECK-VERSION? YZIP>>
<DEFMAC ZSUBSTRUC ('OT 'CT 'NT)
<FORM COPYT .OT .NT <FORM * .CT 2>>>)
(T
<ROUTINE ZSUBSTRUC (OT:<PRIMTYPE TABLE> CT:FIX NT:<PRIMTYPE TABLE>)
<REPEAT ()
<COND (<L? <SET CT <- .CT 1>> 0> <RETURN>)>
<ZPUT .NT .CT <ZGET .OT .CT>>>
.NT>)>
<DEFSTRUCT PARSE-RESULT
(TABLE
('PRINTTYPE TABLE-PRINT))
;0 (PARSE-ADV <OR FALSE VWORD>)
(PARSE-VERB <OR FALSE VWORD>)
(PARSE-VERB-LEXV <OR FALSE TABLE>)
;6 (PARSE-SYNTAX <OR FALSE VERB-SYNTAX>)
(PARSE-ACTION <OR FALSE FIX>)
(PARSE-OBJ1 <OR FALSE PMEM ;NOUN-PHRASE>)
;12(PARSE-OBJ2 <OR FALSE PMEM>)
(PARSE-PARTICLE1 <OR FALSE VWORD>)
(PARSE-PARTICLE2 <OR FALSE VWORD>)
;18(PARSE-LOC <OR FALSE PMEM ;PP>)
(PARSE-QW <OR FALSE VWORD>)
(PARSE-ADJ <OR FALSE VWORD>)
;24(PARSE-CHOMPER <OR FALSE PMEM ;NOUN-PHRASE ;OBJECT>)
(PARSE-SUBJ <OR FALSE PMEM>)
(PARSE-QUERY <OR FALSE VWORD>)
;30(PARSE-QUERY-SYNTAX <OR FALSE VERB-SYNTAX>)
(PARSE-FLAGS FIX)>
<MSETG PARSE-NOT 1>
<MSETG PARSE-QUESTION 2>
<CONSTANT ORPHAN-S <ITABLE 7 0>>
<CONSTANT O-VERB 0 ;<OR FALSE VWORD>>
<CONSTANT O-LEXPTR 1 ;<OR FALSE TABLE>>
<CONSTANT O-SYNTAX 2 ;<OR FALSE VERB-SYNTAX>>
<CONSTANT O-WHICH 3 ;<OR FALSE FIX>>
<CONSTANT O-PART 4 ;<OR FALSE VWORD>>
<CONSTANT O-OBJECT 5 ;<OR FALSE OBJECT>>
<CONSTANT O-SUBJECT 6 ;<OR FALSE OBJECT>>
"Objects are inserted (starting at find-res-obj1 until the vector is full;
then additional objects go into an objlist allocated from pmem;
the TOTAL count goes in find-res-count..."
<DEFSTRUCT FIND-RES
(TABLE 'NOTYPE)
;(FIND-RES-HEADER FIX 'NONE)
(FIND-RES-SIZE FIX 'NONE) ;( 'NTH GETB 'PUT PUTB 'OFFSET 0)
(FIND-RES-COUNT FIX 0) ;( 'NTH GETB 'PUT PUTB 'OFFSET 1)
(FIND-RES-NEXT <OR PMEM FALSE>)
(FIND-RES-OWNER ANY <>) ;"owner found for body part"
(FIND-RES-OBJ1 ANY <>)
;(FIND-RES-OBJ2 ANY <>)>
<MSETG FIND-RES-LENGTH 10 ;13>
<MSETG FIND-RES-MAXOBJ 6 ;7>
<CONSTANT SEARCH-RES
<MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
'FIND-RES-SIZE ,FIND-RES-MAXOBJ
'FIND-RES-COUNT 0>>
<CONSTANT ORPHAN-SR
<MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
'FIND-RES-SIZE ,FIND-RES-MAXOBJ
'FIND-RES-COUNT 0>>
<CONSTANT OWNER-SR-HERE
<MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
'FIND-RES-SIZE ,FIND-RES-MAXOBJ
'FIND-RES-COUNT 0>>
<CONSTANT OWNER-SR-THERE
<MAKE-FIND-RES 'FIND-RES <ITABLE ,FIND-RES-LENGTH 0>
'FIND-RES-SIZE ,FIND-RES-MAXOBJ
'FIND-RES-COUNT 0>>
<DEFSTRUCT FINDER
TABLE
;0 (FIND-APPLIC <OR TABLE FIX> 0) ;"Thing to call to check object"
(FIND-FLAGS FIX) ;"Gwimming, search globals, etc."
(FIND-QUANT <OR FIX FALSE>) ;"All, one, etc."
;6 (FIND-SYNTAX <OR FALSE VERB-SYNTAX>)
(FIND-WHICH FIX) ;"Which argument of the verb we're getting"
(FIND-ADJS <OR PMEM FALSE>)
;12(FIND-NOUN <OR VWORD FALSE>)
(FIND-OF <OR FALSE PMEM>)
(FIND-EXCEPTIONS <OR PMEM FALSE>)
;18(FIND-RES <OR FIND-RES FALSE>)
;"Where to put result, whatever it is."
(FIND-NUM FIX)>
;"<DEFMAC WT? ('PTR 'BIT 'OPT' 'B1)
<COND (<AND <TYPE? .BIT GVAL>
<=? <MEMBER 'PS?' <SPNAME <CHTYPE .BIT ATOM>>>
<SPNAME <CHTYPE .BIT ATOM>>>>
<SET BIT <REST <SPNAME <CHTYPE .BIT ATOM>> 3>>)>
<SET BIT <GET-CLASSIFICATION .BIT>>
<COND (<OR <NOT <ASSIGNED? B1>>
<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION NOUN>>>
<FORM COMPARE-WORD-TYPES <FORM WORD-CLASSIFICATION-NUMBER .PTR>
.BIT>)
(T
<COND (<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION ADJ>>
<COND (T ;<CHECK-EXTENDED?>
<FORM COMPARE-WORD-TYPES .BIT
<FORM WORD-CLASSIFICATION-NUMBER .PTR>>)
;(T
<FORM COND (<FORM COMPARE-WORD-TYPES .BIT
<FORM WORD-CLASSIFICATION-NUMBER
.PTR>>
<FORM WORD-ADJ-ID .PTR>)>)>)
(<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION VERB>>
<FORM COND (<FORM COMPARE-WORD-TYPES .BIT
<FORM WORD-CLASSIFICATION-NUMBER .PTR>>
<FORM WORD-VERB-STUFF .PTR>)>)
(<COMPARE-WORD-TYPES .BIT <GET-CLASSIFICATION DIR>>
<FORM COND (<FORM COMPARE-WORD-TYPES .BIT
<FORM WORD-CLASSIFICATION-NUMBER .PTR>>
<FORM WORD-DIR-ID .PTR>)>)
(T
<FORM COMPARE-WORD-TYPES .BIT
<FORM WORD-CLASSIFICATION-NUMBER .PTR>>)>)>>"
<DEFMAC OBJECT? ('N)
<FORM AND <FORM L? 0 .N> <FORM L=? .N ',LAST-OBJECT>>>
<END-DEFINITIONS>

13
pic.zabstr Normal file
View File

@ -0,0 +1,13 @@
<BEGIN-SEGMENT STARTUP>
<DEFINE-ROUTINE TITLE-SCREEN>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<CONSTANT YX-TBL <TABLE 0 0>>
<CONSTANT WIN-TBL <TABLE 0 0 0>>
<DEFINE-ROUTINE YCEILING>
<DEFINE-ROUTINE XCEILING>
<CONSTANT WTBL <LTABLE 0>>
<DEFINE-ROUTINE MARGINAL-PIC>
<DEFINE-ROUTINE RESET-MARGIN>
<END-SEGMENT>

100
pic.zap Normal file
View File

@ -0,0 +1,100 @@
.SEGMENT "STARTUP"
.FUNCT TITLE-SCREEN
CLEAR -1
PICINF P-TITLE,YX-TBL /?BOGUS1
?BOGUS1: SET 'CURRENT-SPLIT,TITLE-SCREEN-PICTURE
GET YX-TBL,0
SPLIT STACK
SCREEN 1
DISPLAY P-TITLE,1,1
SCREEN 0
RTRUE
.ENDSEG
.SEGMENT "0"
.FUNCT YCEILING,Y
SUB FONT-Y,1
ADD Y,STACK
DIV STACK,FONT-Y
MUL FONT-Y,STACK
RSTACK
.FUNCT XCEILING,X
SUB FONT-X,1
ADD X,STACK
DIV STACK,FONT-X
MUL FONT-X,STACK
RSTACK
.FUNCT MARGINAL-PIC,P,X,Y,YLEFT,HIGH,YLOC,WWIDTH,?TMP1,?TMP2
PICINF P,YX-TBL /?BOGUS1
?BOGUS1: GET YX-TBL,0
CALL2 YCEILING,STACK >Y
GET YX-TBL,1
CALL2 XCEILING,STACK >X
WINGET S-TEXT,WHIGH >HIGH
WINGET S-TEXT,WWIDE >WWIDTH
WINGET S-TEXT,WYPOS
SUB STACK,1 >YLEFT
SUB HIGH,YLEFT >YLEFT
GRTR? Y,YLEFT \?CND2
CURGET YX-TBL
GET YX-TBL,0 >YLOC
SUB Y,YLEFT
CALL2 YCEILING,STACK >YLEFT
SCROLL S-TEXT,YLEFT
SUB YLOC,YLEFT >YLOC
GRTR? YLOC,0 /?CND4
SET 'YLOC,1
?CND4: GET YX-TBL,1
CURSET YLOC,STACK
?CND2: WINGET S-TEXT,WYPOS
ADD Y,STACK >YLEFT
PICINF ICON-OFFSET,PICINF-TBL /?BOGUS6
?BOGUS6: WINGET S-TEXT,WYPOS >?TMP2
GET PICINF-TBL,0
ADD ?TMP2,STACK >?TMP1
GET PICINF-TBL,1
ADD 1,STACK
DISPLAY P,?TMP1,STACK
ADD X,FONT-X >X
LESS? X,WWIDTH /?CCL9
CURSET YLEFT,1
ZERO? DEMO-VERSION? /?CCL12
ICALL2 INPUT-DEMO,1
JUMP ?CND10
?CCL12: INPUT 1
?CND10: ICALL1 MOUSE-INPUT?
SUB HIGH,YLEFT
GRTR? STACK,FONT-Y /FALSE
SCROLL S-TEXT,FONT-Y
RTRUE
?CCL9: MARGIN X,0
DIV Y,FONT-Y >Y
SUB WWIDTH,X
DIV STACK,FONT-X >WWIDTH
GRTR? WWIDTH,INBUF-LENGTH \?CCL18
PUSH INBUF-LENGTH
JUMP ?CND16
?CCL18: PUSH WWIDTH
?CND16: PUTB P-INBUF,0,STACK
WINPUT 0,WCRCNT,Y
WINPUT 0,WCRFUNC,RESET-MARGIN
RTRUE
.FUNCT RESET-MARGIN
MARGIN 0,0
RTRUE
.ENDSEG
.ENDI

96
pic.zil Normal file
View File

@ -0,0 +1,96 @@
"PIC for
Library
(c) Copyright 1987 Infocom, Inc. All Rights Reserved."
<BEGIN-SEGMENT STARTUP>
<ROUTINE TITLE-SCREEN ()
<CLEAR -1>
<PICINF ,P-TITLE ,YX-TBL>
<SETG CURRENT-SPLIT ,TITLE-SCREEN-PICTURE>
<SPLIT <GET ,YX-TBL 0>>
<SCREEN 1>
<DISPLAY ,P-TITLE 1 1>
;<CENTER-PIC ,P-TITLE>
<SCREEN 0>>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<CONSTANT YX-TBL <TABLE 0 0>>
;<ROUTINE CENTER-PIC (P "AUX" X (CENTER </ ,WIDTH 2>))
<CPICINF .P ,YX-TBL>
<SET X <GET ,YX-TBL 1>>
<CDISPLAY .P 1 <- .CENTER </ .X 2>>>>
<CONSTANT WIN-TBL <TABLE 0 0 0>>
<ROUTINE YCEILING (Y)
<* ,FONT-Y </ <+ .Y <- ,FONT-Y 1>> ,FONT-Y>>>
<ROUTINE XCEILING (X)
<* ,FONT-X </ <+ .X <- ,FONT-X 1>> ,FONT-X>>>
<CONSTANT WTBL <LTABLE 0>>
;<ROUTINE WINPROP (WIN PROP)
<WINGET .WIN ,WTBL .PROP>
<GET ,WTBL 1>>
<ROUTINE MARGINAL-PIC (P "AUX" X Y YLEFT HIGH YLOC WWIDTH)
<PICINF .P ,YX-TBL>
;"Integral character height of the picture"
<SET Y <YCEILING <GET ,YX-TBL 0>>>
;"Round up to integral character width"
<SET X <XCEILING <GET ,YX-TBL 1>>>
<SET HIGH <WINGET ,S-TEXT ,WHIGH>>
<SET WWIDTH <WINGET ,S-TEXT ,WWIDE>>
<SET YLEFT <- <WINGET ,S-TEXT ,WYPOS> 1>>
<SET YLEFT <- .HIGH .YLEFT>>
<COND (<G? .Y .YLEFT>
<CURGET ,YX-TBL>
<SET YLOC <GET ,YX-TBL 0>>
<SET YLEFT <YCEILING <- .Y .YLEFT>>>
<SCROLL ,S-TEXT .YLEFT>
<SET YLOC <- .YLOC .YLEFT>>
<COND (<L=? .YLOC 0> <SET YLOC 1>)>
<CURSET .YLOC <GET ,YX-TBL 1>>)>
<SET YLEFT <+ .Y <WINGET ,S-TEXT ,WYPOS>>>
<PICINF ,ICON-OFFSET ,PICINF-TBL>
<DISPLAY .P <+ <WINGET ,S-TEXT ,WYPOS> <GET ,PICINF-TBL 0>>
<+ 1 <GET ,PICINF-TBL 1>>>
<SET X <+ .X ,FONT-X>>
<COND (<G=? .X .WWIDTH>
<CURSET .YLEFT 1>
<COND (,DEMO-VERSION?
<INPUT-DEMO 1>)
(T
<INPUT 1>)>
<MOUSE-INPUT?>
<COND (<L=? <- .HIGH .YLEFT> ,FONT-Y>
<SCROLL ,S-TEXT ,FONT-Y>)>)
(T
;<COND (.RIGHT?
<MARGIN 0 .X>)
(T
<MARGIN .X 0>)>
<MARGIN .X 0>
<SET Y </ .Y ,FONT-Y>>
<SET WWIDTH </ <- .WWIDTH .X> ,FONT-X>>
<PUTB ,P-INBUF 0
<COND (<G? .WWIDTH ,INBUF-LENGTH>
,INBUF-LENGTH)
(T
.WWIDTH)>>
;<PUT ,WIN-TBL 0 2>
;<PUT ,WIN-TBL 1 ,RESET-MARGIN>
;<PUT ,WIN-TBL 2 .Y ;<+ .Y 1>>
<WINPUT 0 ,WCRCNT .Y>
<WINPUT 0 ,WCRFUNC ,RESET-MARGIN>)>>
<ROUTINE RESET-MARGIN ()
<MARGIN 0 0>>
<END-SEGMENT>

484
picdef.zil Normal file
View File

@ -0,0 +1,484 @@
<CONSTANT P-TITLE 1>
<CONSTANT PROLOGUE-LETTER 2>
<CONSTANT MAIN-LETTER 3>
<CONSTANT EPILOGUE-LETTER 4>
<CONSTANT CASTLE-BORDER 5>
<CONSTANT OUTSIDE-BORDER 6>
<CONSTANT UNDERGROUND-BORDER 7>
<CONSTANT HINT-BORDER 8>
<CONSTANT N-HL 9>
<CONSTANT NE-HL 10>
<CONSTANT E-HL 11>
<CONSTANT SE-HL 12>
<CONSTANT S-HL 13>
<CONSTANT SW-HL 14>
<CONSTANT W-HL 15>
<CONSTANT NW-HL 16>
<CONSTANT N-UNHL 17>
<CONSTANT NE-UNHL 18>
<CONSTANT E-UNHL 19>
<CONSTANT SE-UNHL 20>
<CONSTANT S-UNHL 21>
<CONSTANT SW-UNHL 22>
<CONSTANT W-UNHL 23>
<CONSTANT NW-UNHL 24>
<CONSTANT ENC-BORDER 25>
<CONSTANT ZILBEETHA-ILL 26>
<CONSTANT BROGMOIDISM-ILL 27>
<CONSTANT DIMWIT-ILL 28>
<CONSTANT MEGABOZ-ILL 29>
<CONSTANT J-ILL 30>
<CONSTANT FLATHEADIA-ILL 31>
<CONSTANT FR-ILL 32>
<CONSTANT FOUR-FLIES-ILL 33>
<CONSTANT REBUS-0 34>
<CONSTANT REBUS-1 35>
<CONSTANT REBUS-2 36>
<CONSTANT REBUS-3 37>
<CONSTANT REBUS-4 38>
<CONSTANT REBUS-5 39>
<CONSTANT REBUS-6 40>
<CONSTANT B-BORDER 41>
<CONSTANT B-RESTORE-PEG 42>
<CONSTANT B-1-WEIGHT 43>
<CONSTANT B-2-WEIGHT 44>
<CONSTANT B-3-WEIGHT 45>
<CONSTANT B-4-WEIGHT 46>
<CONSTANT B-5-WEIGHT 47>
<CONSTANT B-6-WEIGHT 48>
<CONSTANT PBOZ-BORDER 49>
<CONSTANT UNHL-PEG 50>
<CONSTANT HL-PEG 51>
<CONSTANT BG-A 52>
<CONSTANT BG-B 53>
<CONSTANT BG-C 54>
<CONSTANT BG-D 55>
<CONSTANT BG-E 56>
<CONSTANT BG-F 57>
<CONSTANT BG-G 58>
<CONSTANT BG-H 59>
<CONSTANT BG-I 60>
<CONSTANT BG-J 61>
<CONSTANT BG-K 62>
<CONSTANT BG-L 63>
<CONSTANT BG-M 64>
<CONSTANT BG-N 65>
<CONSTANT BG-O 66>
<CONSTANT BG-P 67>
<CONSTANT BG-Q 68>
<CONSTANT BG-R 69>
<CONSTANT BG-S 70>
<CONSTANT BG-T 71>
<CONSTANT BG-U 72>
<CONSTANT SN-BORDER 73>
<CONSTANT PILE-OF-0 74>
<CONSTANT PILE-OF-1 75>
<CONSTANT PILE-OF-2 76>
<CONSTANT PILE-OF-3 77>
<CONSTANT PILE-OF-4 78>
<CONSTANT PILE-OF-5 79>
<CONSTANT PILE-OF-6 80>
<CONSTANT PILE-OF-7 81>
<CONSTANT PILE-OF-8 82>
<CONSTANT PILE-OF-9 83>
<CONSTANT R-FLOWERS-0 84>
<CONSTANT R-FLOWERS-1 85>
<CONSTANT R-FLOWERS-2 86>
<CONSTANT R-FLOWERS-3 87>
<CONSTANT R-FLOWERS-4 88>
<CONSTANT R-FLOWERS-5 89>
<CONSTANT R-FLOWERS-6 90>
<CONSTANT R-FLOWERS-7 91>
<CONSTANT R-FLOWERS-8 92>
<CONSTANT R-FLOWERS-9 93>
<CONSTANT L-FLOWERS-0 94>
<CONSTANT L-FLOWERS-1 95>
<CONSTANT L-FLOWERS-2 96>
<CONSTANT L-FLOWERS-3 97>
<CONSTANT L-FLOWERS-4 98>
<CONSTANT F-BORDER 99>
<CONSTANT F-CARD-BACK 100>
<CONSTANT F-CARD 101>
<CONSTANT F-INKBLOTS 102>
<CONSTANT F-PLUNGERS 103>
<CONSTANT F-BUGS 104>
<CONSTANT F-ZURFS 105>
<CONSTANT F-EARS 106>
<CONSTANT F-TOPS 107>
<CONSTANT F-RAIN 108>
<CONSTANT F-HIVES 109>
<CONSTANT F-FACES 110>
<CONSTANT F-MAZES 111>
<CONSTANT F-LAMPS 112>
<CONSTANT F-TIME 113>
<CONSTANT F-BOOKS 114>
<CONSTANT F-SCYTHES 115>
<CONSTANT F-FROMPS 116>
<CONSTANT F-RV-INKBLOTS 117>
<CONSTANT F-RV-PLUNGERS 118>
<CONSTANT F-RV-BUGS 119>
<CONSTANT F-RV-ZURFS 120>
<CONSTANT F-RV-EARS 121>
<CONSTANT F-RV-TOPS 122>
<CONSTANT F-RV-RAIN 123>
<CONSTANT F-RV-HIVES 124>
<CONSTANT F-RV-FACES 125>
<CONSTANT F-RV-MAZES 126>
<CONSTANT F-RV-LAMPS 127>
<CONSTANT F-RV-TIME 128>
<CONSTANT F-RV-BOOKS 129>
<CONSTANT F-RV-SCYTHES 130>
<CONSTANT F-RV-FROMPS 131>
<CONSTANT F-0 132>
<CONSTANT F-1 133>
<CONSTANT F-2 134>
<CONSTANT F-3 135>
<CONSTANT F-4 136>
<CONSTANT F-5 137>
<CONSTANT F-6 138>
<CONSTANT F-7 139>
<CONSTANT F-8 140>
<CONSTANT F-9 141>
<CONSTANT F-INFINITY 142>
<CONSTANT F-RV-0 143>
<CONSTANT F-RV-1 144>
<CONSTANT F-RV-2 145>
<CONSTANT F-RV-3 146>
<CONSTANT F-RV-4 147>
<CONSTANT F-RV-5 148>
<CONSTANT F-RV-6 149>
<CONSTANT F-RV-7 150>
<CONSTANT F-RV-8 151>
<CONSTANT F-RV-9 152>
<CONSTANT F-RV-INFINITY 153>
<CONSTANT F-GRANOLA 154>
<CONSTANT F-LOBSTER 155>
<CONSTANT F-SNAIL 156>
<CONSTANT F-JESTER 157>
<CONSTANT F-HOURGLASS 158>
<CONSTANT F-LIGHT 159>
<CONSTANT F-BEAUTY 160>
<CONSTANT F-DEATH 161>
<CONSTANT F-GRUE 162>
<CONSTANT MAP-BORDER 163>
<CONSTANT MAIN-TITLE 164>
<CONSTANT SECRET-WING-TITLE 165>
<CONSTANT VILLAGE-TITLE 166>
<CONSTANT LOWER-LEVEL-TITLE 167>
<CONSTANT LAKE-TITLE 168>
<CONSTANT DESERT-TITLE 169>
<CONSTANT FOOZLE-TITLE 170>
<CONSTANT FENSHIRE-TITLE 171>
<CONSTANT FJORD-TITLE 172>
<CONSTANT GRAY-MTS-TITLE 173>
<CONSTANT DELTA-TITLE 174>
<CONSTANT FUBLIO-TITLE 175>
<CONSTANT ANTHARIA-TITLE 176>
<CONSTANT FOOZLE-MAP-ILL 177>
<CONSTANT FENSHIRE-MAP-ILL 178>
<CONSTANT FJORD-MAP-ILL 179>
<CONSTANT GRAY-MTS-MAP-ILL 180>
<CONSTANT DELTA-MAP-ILL 181>
<CONSTANT ANTHARIA-MAP-ILL 182>
<CONSTANT HORIZONTAL-LEGEND 183>
<CONSTANT VERTICAL-LEGEND 184>
<CONSTANT N-S-CON 185>
<CONSTANT E-W-CON 186>
<CONSTANT NE-SW-CON 187>
<CONSTANT NW-SE-CON 188>
<CONSTANT DOWN-NORTH-SYMBOL 189>
<CONSTANT DOWN-SOUTH-SYMBOL 190>
<CONSTANT DOWN-EAST-SYMBOL 191>
<CONSTANT DOWN-WEST-SYMBOL 192>
<CONSTANT DOWN-NE-SYMBOL 193>
<CONSTANT DOWN-NW-SYMBOL 194>
<CONSTANT DOWN-SW-SYMBOL 195>
<CONSTANT DOWN-SE-SYMBOL 196>
<CONSTANT TELEPORT-ARROW 197>
<CONSTANT RV-TELEPORT-ARROW 198>
<CONSTANT ARCH-N-CON 199>
<CONSTANT ARCH-S-CON 200>
<CONSTANT RUBBLE-NW-CON 201>
<CONSTANT RUBBLE-SE-CON 202>
<CONSTANT ICONLESS-ROOM-BOX 203>
<CONSTANT YOU-ARE-HERE-SYMBOL 204>
<CONSTANT GONDOLA-ICON 205>
<CONSTANT PEG-ROOM-ICON 206>
<CONSTANT WEST-WING-ICON 207>
<CONSTANT GYM-ICON 208>
<CONSTANT TORCH-ROOM-ICON 209>
<CONSTANT ROOF-ICON 210>
<CONSTANT PARLOR-ICON 211>
<CONSTANT FORMAL-GARDEN-ICON 212>
<CONSTANT BALCONY-ICON 213>
<CONSTANT GALLERY-ICON 214>
<CONSTANT THRONE-ROOM-ICON 215>
<CONSTANT BANQUET-HALL-ICON 216>
<CONSTANT KITCHEN-ICON 217>
<CONSTANT WINE-CELLAR-ICON 218>
<CONSTANT LIBRARY-ICON 219>
<CONSTANT EAST-WING-ICON 220>
<CONSTANT CHAPEL-ICON 221>
<CONSTANT J-QUARTER-ICON 222>
<CONSTANT PYRAMID-ICON 223>
<CONSTANT DIMWITS-ROOM-ICON 224>
<CONSTANT MAGIC-CLOSET-ICON 225>
<CONSTANT PARAPET-ICON 226>
<CONSTANT BASTION-ICON 227>
<CONSTANT SECRET-PASSAGE-ICON 228>
<CONSTANT TEE-ICON 229>
<CONSTANT TOP-OF-STAIR-ICON 230>
<CONSTANT BOTTOM-OF-STAIR-ICON 231>
<CONSTANT ORACLE-ICON 232>
<CONSTANT DUNGEON-ICON 233>
<CONSTANT CELL-ICON 234>
<CONSTANT PERIMETER-WALL-ICON 235>
<CONSTANT GARRISON-ICON 236>
<CONSTANT OUTER-BAILEY-ICON 237>
<CONSTANT DRAWBRIDGE-ICON 238>
<CONSTANT BARBICAN-ICON 239>
<CONSTANT UPPER-BARBICAN-ICON 240>
<CONSTANT CAUSEWAY-ICON 241>
<CONSTANT INNER-BAILEY-ICON 242>
<CONSTANT URS-OFFICE-ICON 243>
<CONSTANT SHADY-PARK-ICON 244>
<CONSTANT CHURCH-ICON 245>
<CONSTANT COURTROOM-ICON 246>
<CONSTANT POST-OFFICE-ICON 247>
<CONSTANT FR-HQ-ICON 248>
<CONSTANT MAGIC-SHOP-ICON 249>
<CONSTANT BACK-ALLEY-ICON 250>
<CONSTANT OFFICES-ICON 251>
<CONSTANT PENTHOUSE-ICON 252>
<CONSTANT ROOTS-ICON 253>
<CONSTANT EAR-ICON 254>
<CONSTANT MOUTH-OF-CAVE-ICON 255>
<CONSTANT LEDGE-IN-PIT-ICON 256>
<CONSTANT PASSAGE-STORAGE-ICON 257>
<CONSTANT VAULT-ICON 258>
<CONSTANT G-U-HIGHWAY-ICON 259>
<CONSTANT EXIT-ICON 260>
<CONSTANT KENNELS-ICON 261>
<CONSTANT ROYAL-ZOO-ICON 262>
<CONSTANT LABORATORY-ICON 263>
<CONSTANT HOLD-ICON 264>
<CONSTANT UNDERWATER-ICON 265>
<CONSTANT LAKE-BOTTOM-ICON 266>
<CONSTANT EAST-SHORE-ICON 267>
<CONSTANT WEST-SHORE-ICON 268>
<CONSTANT NORTH-SHORE-ICON 269>
<CONSTANT SOUTH-SHORE-ICON 270>
<CONSTANT LAKE-FLATHEAD-ICON 271>
<CONSTANT RING-OF-DUNES-ICON 272>
<CONSTANT G-U-SAVANNAH-ICON 273>
<CONSTANT BATS-LAIR-ICON 274>
<CONSTANT BASE-OF-MT-ICON 275>
<CONSTANT G-U-MOUNTAIN-ICON 276>
<CONSTANT STABLE-ICON 277>
<CONSTANT SHRINE-ICON 278>
<CONSTANT CACTUS-PATCH-ICON 279>
<CONSTANT TALL-DUNES-ICON 280>
<CONSTANT G-U-OASIS-ICON 281>
<CONSTANT WHARF-ICON 282>
<CONSTANT FISHING-VILLAGE-ICON 283>
<CONSTANT QUILBOZZA-BEACH-ICON 284>
<CONSTANT WARNING-ROOM-ICON 285>
<CONSTANT FISHY-ODOR-ICON 286>
<CONSTANT ROOM-OF-3-DOORS-ICON 287>
<CONSTANT FORK-ICON 288>
<CONSTANT WISHYFOO-ICON 289>
<CONSTANT REST-STOP-ICON 290>
<CONSTANT CROSSROADS-ICON 291>
<CONSTANT TOLL-PLAZA-ICON 292>
<CONSTANT FISSURES-EDGE-ICON 293>
<CONSTANT ORB-ROOM-ICON 294>
<CONSTANT RUINED-HALL-ICON 295>
<CONSTANT SECRET-ROOM-ICON 296>
<CONSTANT HOTHOUSE-ICON 297>
<CONSTANT MARSH-ICON 298>
<CONSTANT CRAG-ICON 299>
<CONSTANT UPPER-LEDGE-ICON 300>
<CONSTANT LOWER-LEDGE-ICON 301>
<CONSTANT IRON-MINE-ICON 302>
<CONSTANT NATURAL-ARCH-ICON 303>
<CONSTANT ENCHANTED-CAVE-ICON 304>
<CONSTANT MIRROR-LAKE-ICON 305>
<CONSTANT CHALET-ICON 306>
<CONSTANT RIVERS-END-ICON 307>
<CONSTANT OCEANS-EDGE-ICON 308>
<CONSTANT DELTA-ICON 309>
<CONSTANT ON-TOP-OF-WORLD-ICON 310>
<CONSTANT AMONGST-CLOUDS-ICON 311>
<CONSTANT TIMBERLINE-ICON 312>
<CONSTANT AVALANCHE-ICON 313>
<CONSTANT ZORBEL-PASS-ICON 314>
<CONSTANT BASE-OF-MTS-ICON 315>
<CONSTANT FOOT-OF-STATUE-ICON 316>
<CONSTANT OUTSIDE-HUT-ICON 317>
<CONSTANT ATTIC-ICON 318>
<CONSTANT CAIRN-ICON 319>
<CONSTANT QUARRYS-EDGE-ICON 320>
<CONSTANT QUARRY-ICON 321>
<CONSTANT STADIUM-ICON 322>
<CONSTANT COAST-ROAD-ICON 323>
<CONSTANT MINE-ENTRANCE-ICON 324>
<CONSTANT DEAD-END-ICON 325>
<CONSTANT CLIFF-BOTTOM-ICON 326>
<CONSTANT PRECIPICE-ICON 327>
<CONSTANT AERIE-ICON 328>
<CONSTANT ICKY-CAVE-ICON 329>
<CONSTANT MAP-N-HL 330>
<CONSTANT MAP-NE-HL 331>
<CONSTANT MAP-E-HL 332>
<CONSTANT MAP-SE-HL 333>
<CONSTANT MAP-S-HL 334>
<CONSTANT MAP-SW-HL 335>
<CONSTANT MAP-W-HL 336>
<CONSTANT MAP-NW-HL 337>
<CONSTANT MAP-N-UNHL 338>
<CONSTANT MAP-NE-UNHL 339>
<CONSTANT MAP-E-UNHL 340>
<CONSTANT MAP-SE-UNHL 341>
<CONSTANT MAP-S-UNHL 342>
<CONSTANT MAP-SW-UNHL 343>
<CONSTANT MAP-W-UNHL 344>
<CONSTANT MAP-NW-UNHL 345>
<CONSTANT LOBBY-OFFICE-CON 346>
<CONSTANT OFFICE-PENTHOUSE-CON 347>
<CONSTANT LOW-HALL-CON 348>
<CONSTANT WISHYFOO-FORK-CON 349>
<CONSTANT GLACIER-MIRROR-CON 350>
<CONSTANT DELTA-6-7-CON 351>
<CONSTANT DELTA-1-3-CON 352>
<CONSTANT DELTA-5-6-CON 353>
<CONSTANT DELTA-2-3-CON 354>
<CONSTANT DELTA-1-4-CON 355>
<CONSTANT DELTA-3-5-CON 356>
<CONSTANT PILE-1-PIC-LOC 357>
<CONSTANT PILE-2-PIC-LOC 358>
<CONSTANT PILE-3-PIC-LOC 359>
<CONSTANT PILE-4-PIC-LOC 360>
<CONSTANT L-FLOWERS-PIC-LOC 361>
<CONSTANT R-FLOWERS-PIC-LOC 362>
<CONSTANT B-1-L-PIC-LOC 363>
<CONSTANT B-2-C-PIC-LOC 364>
<CONSTANT B-3-R-PIC-LOC 365>
<CONSTANT B-4-PIC-LOC 366>
<CONSTANT B-5-PIC-LOC 367>
<CONSTANT B-6-PIC-LOC 368>
<CONSTANT F-DISCARD-PIC-LOC 369>
<CONSTANT F-1-PIC-LOC 370>
<CONSTANT F-2-PIC-LOC 371>
<CONSTANT F-3-PIC-LOC 372>
<CONSTANT F-4-PIC-LOC 373>
<CONSTANT F-RANK-PIC-LOC 374>
<CONSTANT F-REV-RANK-PIC-LOC 375>
<CONSTANT F-SUIT-PIC-LOC 376>
<CONSTANT F-REV-SUIT-PIC-LOC 377>
<CONSTANT ENC-PIC-LOC 378>
<CONSTANT ENC-TXT-LOC 379>
<CONSTANT ENC-TXT-WINDOW-SIZE 380>
<CONSTANT COMPASS-PIC-LOC 381>
<CONSTANT HERE-LOC 382>
<CONSTANT REGION-LOC 383>
<CONSTANT F-MENU-LOC 384>
<CONSTANT J-SCORE-LOC 385>
<CONSTANT YOUR-SCORE-LOC 386>
<CONSTANT TEXT-WINDOW-PIC-LOC 387>
<CONSTANT PBOZ-H-LOC 388>
<CONSTANT PBOZ-I-LOC 389>
<CONSTANT PBOZ-J-LOC 390>
<CONSTANT PBOZ-K-LOC 391>
<CONSTANT PBOZ-L-LOC 392>
<CONSTANT PBOZ-M-LOC 393>
<CONSTANT PBOZ-N-LOC 394>
<CONSTANT PBOZ-O-LOC 395>
<CONSTANT PBOZ-P-LOC 396>
<CONSTANT PBOZ-Q-LOC 397>
<CONSTANT PBOZ-R-LOC 398>
<CONSTANT PBOZ-S-LOC 399>
<CONSTANT PBOZ-T-LOC 400>
<CONSTANT PBOZ-U-LOC 401>
<CONSTANT PBOZ-SPLIT 402>
<CONSTANT MAP-TOP-LEFT-LOC 403>
<CONSTANT MAP-BASIC-ELT-SIZE 404>
<CONSTANT MAP-BOX-SIZE 405>
<CONSTANT MAP-SPACE-SIZE 406>
<CONSTANT GONDOLA-AT-FLATHEADIA-LOC 407>
<CONSTANT 5-FUDGE 408>
<CONSTANT GONDOLA-AT-FENSHIRE-LOC 409>
<CONSTANT ARCH-N-CON-SIZE 410>
<CONSTANT RUBBLE-CON-SIZE 411>
<CONSTANT 2-3-CON-SIZE 412>
<CONSTANT 3-5-CON-SIZE 413>
<CONSTANT 5-6-CON-SIZE 414>
<CONSTANT 6-7-CON-SIZE 415>
<CONSTANT TELEPORT-ARROW-SIZE 416>
<CONSTANT WISHYFOO-ICON-LOC 417>
<CONSTANT EAR-ICON-LOC 418>
<CONSTANT F-DISCARD-LOC 419>
<CONSTANT F-CARD-1-LOC 420>
<CONSTANT F-CARD-SPACE 421>
<CONSTANT F-SPLIT 422>
<CONSTANT F-BOTTOM 423>
<CONSTANT PBOZ-BOTTOM 424>
<CONSTANT SN-BOTTOM 425>
<CONSTANT B-BOTTOM 426>
<CONSTANT SN-SPLIT 427>
<CONSTANT B-SPLIT 428>
<CONSTANT URS-ICON-LOC 429>
<CONSTANT COURTROOM-ICON-LOC 430>
<CONSTANT MAIN-TITLE-LOC 431>
<CONSTANT PBOZ-A-LOC 432>
<CONSTANT PBOZ-B-LOC 433>
<CONSTANT PBOZ-C-LOC 434>
<CONSTANT PBOZ-D-LOC 435>
<CONSTANT PBOZ-E-LOC 436>
<CONSTANT PBOZ-F-LOC 437>
<CONSTANT PBOZ-G-LOC 438>
<CONSTANT LAKE-TITLE-LOC 439>
<CONSTANT TELEPORT-LETTER 440>
<CONSTANT SECRET-WING-TITLE-LOC 441>
<CONSTANT MAP-ROSE-BG 442>
<CONSTANT MAP-ROSE-LOC 443>
<CONSTANT MAP-COMPASS-PIC-LOC 444>
<CONSTANT BOX-1 445>
<CONSTANT BOX-2 446>
<CONSTANT BOX-3 447>
<CONSTANT BOX-4 448>
<CONSTANT BOX-5 449>
<CONSTANT BOX-6 450>
<CONSTANT BOX-7 451>
<CONSTANT BOX-8 452>
<CONSTANT BOX-9 453>
<CONSTANT DIM-BOX-1 454>
<CONSTANT DIM-BOX-2 455>
<CONSTANT DIM-BOX-3 456>
<CONSTANT DIM-BOX-4 457>
<CONSTANT DIM-BOX-5 458>
<CONSTANT DIM-BOX-6 459>
<CONSTANT DIM-BOX-7 460>
<CONSTANT DIM-BOX-8 461>
<CONSTANT DIM-BOX-9 462>
<CONSTANT EXIT-BOX 463>
<CONSTANT SHOW-MOVES-BOX 464>
<CONSTANT UNDO-BOX 465>
<CONSTANT RESTART-BOX 466>
<CONSTANT DIM-SHOW-MOVES-BOX 467>
<CONSTANT DIM-UNDO-BOX 468>
<CONSTANT DIM-RESTART-BOX 469>
<CONSTANT BOX-1-LOC 470>
<CONSTANT SN-BOX-SPACE 471>
<CONSTANT PBOZ-RESTART-BOX-LOC 472>
<CONSTANT PBOZ-SHOW-MOVES-BOX-LOC 473>
<CONSTANT PBOZ-EXIT-BOX-LOC 474>
<CONSTANT TOWER-UNDO-BOX-LOC 475>
<CONSTANT TOWER-EXIT-BOX-LOC 476>
<CONSTANT EXPAND-HOT-SPOT 477>
<CONSTANT ICON-OFFSET 478>
<CONSTANT U-BOX 479>
<CONSTANT D-BOX 480>
<CONSTANT BOX-COVER 481>
<CONSTANT U-BOX-LOC 482>
<CONSTANT D-BOX-LOC 483>

40
pmem.zap Normal file
View File

@ -0,0 +1,40 @@
.SEGMENT "0"
.FUNCT PMEM?,PTR
LESS? PTR,PMEM-STORE /FALSE
LESS? PTR,PMEM-STORE+180 /TRUE
RFALSE
.FUNCT PMEM-RESET,FULL?
ASSIGNED? 'FULL? /?CND1
SET 'FULL?,TRUE-VALUE
?CND1: GRTR? PMEM-WORDS-USED,0 \?CND3
SET 'PMEM-WORDS-USED,0
SUB PMEM-STORE-LENGTH,PMEM-STORE-WORDS
MUL 2,STACK
COPYT PMEM-STORE,0,STACK
?CND3: SET 'PMEM-STORE-WORDS,PMEM-STORE-LENGTH
SET 'PMEM-STORE-POINTER,PMEM-STORE
RTRUE
.FUNCT DO-PMEM-ALLOC,TYPE,LENGTH,STOR,LEFT,NEW
SET 'STOR,PMEM-STORE-POINTER
SET 'LEFT,PMEM-STORE-WORDS
IGRTR? 'LENGTH,LEFT \?CND1
ICALL2 P-NO-MEM-ROUTINE,TYPE
?CND1: ADD PMEM-WORDS-USED,LENGTH >PMEM-WORDS-USED
SUB LEFT,LENGTH >PMEM-STORE-WORDS
MUL LENGTH,2
ADD STOR,STACK >PMEM-STORE-POINTER
DEC 'LENGTH
PUTB STOR,0,LENGTH
PUTB STOR,1,TYPE
RETURN STOR
.ENDSEG
.ENDI

270
pmem.zil Normal file
View File

@ -0,0 +1,270 @@
"PMEM file for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<ZZPACKAGE "PMEM">
<ENTRY PMEM PMEM-ALLOC PMEM-TYPE? PMEM-RESET PM-TYPE MAKE-PM-TYPE
PMEM-WORDS-USED PDEFS-INTERNAL-OBLIST PMEM-STORE-WARN PMEM-STORE-LENGTH>
<INCLUDE "BASEDEFS" "PBITDEFS">
<USE "NEWSTRUC">
<SET-DEFSTRUCT-FILE-DEFAULTS>
<FILE-FLAGS MDL-ZIL? ;ZAP-TO-SOURCE-DIRECTORY?>
<BEGIN-SEGMENT 0>
"All storage allocated by the parser looks like this; the rest of each
block depends on the type field."
<DEFSTRUCT PMEM (TABLE 'CONSTRUCTOR ('PRINTTYPE PRINT-PMEM)
'NODECL
('NTH ZGET)
('PUT ZPUT)
('START-OFFSET 0))
(PM-HEADER <OR FIX FALSE>)
(PM-LENGTH <OR FIX FALSE> 'OFFSET 0 'NTH GETB 'PUT PUTB)
(PM-TYPE-CODE <OR FIX FALSE> 'OFFSET 1 'NTH GETB 'PUT PUTB)>
<MSETG PM-HEADER-LEN 1>
"Only used in muddle world"
<DEFSTRUCT PM-TYPE VECTOR
(PMT-NAME ATOM)
(PMT-CODE FIX)
(PMT-LENGTH <OR FIX FALSE>)
(PMT-ARGS <VECTOR [REST PM-ARG]> [])>
<DEFSTRUCT PM-ARG VECTOR
(PMA-NAME ATOM)
(PMA-OFFS FIX)
(PMA-TYPE ANY)
(PMA-DEFAULT ANY)>
<GDECL (PM-TYPE-COUNT) FIX
(PM-LIST) LIST>
<MSETG PMEM-STORE-LENGTH:FIX 180 ;(160 125 100 300)>
<CONSTANT PMEM-STORE:TABLE <ITABLE ,PMEM-STORE-LENGTH>>
<GLOBAL PMEM-STORE-POINTER PMEM-STORE>
<GLOBAL PMEM-STORE-WORDS:NUMBER PMEM-STORE-LENGTH>
;<DEFINE-GLOBALS PMEM-GLOBALS
(PMEM-STORE-POINTER:<OR TABLE FALSE> <>)
(PMEM-STORE-WORDS:FIX ,PMEM-STORE-LENGTH)>
<IF-P-DEBUGGING-PARSER
<GLOBAL PMEM-STORE-WARN:NUMBER 50>>
<DEFINE PMEM? (PTR)
<AND <G=? .PTR ,PMEM-STORE>
<L? .PTR <+ ,PMEM-STORE ,PMEM-STORE-LENGTH>>>>
<DEFINE20 PM-TYPE (NAME:ATOM LENGTH:<OR FIX FALSE>
"ARGS" STUFF "AUX" ATM CODE TYPE-OBJ (OCT ,PM-HEADER-LEN)
ARGS)
<SET ATM <PARSE <STRING "PM-TYPE-" <SPNAME .NAME>> 10
,PDEFS-INTERNAL-OBLIST>>
<COND (<NOT <GASSIGNED? PM-TYPE-COUNT>>
<SETG PM-TYPE-COUNT 0>
<SETG PM-LIST (T)>)>
<SET CODE <SETG PM-TYPE-COUNT <+ ,PM-TYPE-COUNT 1>>>
<SET TYPE-OBJ <MAKE-PM-TYPE 'PMT-NAME .ATM
'PMT-CODE .CODE
'PMT-LENGTH .LENGTH>>
<EVAL <FORM CONSTANT
<PARSE <STRING "PMEM-TYPE-" <SPNAME .NAME>> 10
,PDEFS-INTERNAL-OBLIST>
.CODE>>
<PUTREST <REST ,PM-LIST <- <LENGTH ,PM-LIST> 1>> (.TYPE-OBJ)>
<SETG .ATM .TYPE-OBJ>
<SET ARGS
<MAPF ,VECTOR
<FUNCTION (ARG:<OR LIST ATOM> "AUX" NATM OFFS (TYPE ANY) (DEFAULT <>)
NNATM)
<COND (<TYPE? .ARG LIST>
<SET NATM <1 .ARG>>
<SET ARG <REST .ARG>>)
(T
<SET NATM .ARG>
<SET ARG ()>)>
<SET NATM <PARSE <STRING <SPNAME .NAME> "-" <SPNAME .NATM>> 10
,PDEFS-INTERNAL-OBLIST>>
<SET NNATM <PARSE <STRING <SPNAME .NAME> "-" <SPNAME .NATM> "-OFFSET">
10 ,PDEFS-INTERNAL-OBLIST>>
<EVAL <FORM DEFMAC .NATM (''OBJ "OPT" ''NEW)
<FORM COND
(<FORM ASSIGNED? NEW>
<FORM FORM ZPUT '.OBJ .OCT '.NEW>)
(T
<FORM FORM ZGET '.OBJ .OCT>)>>>
<SETG .NNATM <SET OFFS .OCT>>
<SET OCT <+ .OCT 1>>
<COND (<EMPTY? .ARG>)
(T
<SET TYPE <1 .ARG>>
<COND (<NOT <LENGTH? .ARG 1>>
<COND (<AND <TYPE? <SET DEFAULT <2 .ARG>> FORM>
<EMPTY? .DEFAULT>>
<SET DEFAULT <>>)>)>
<COND (<AND <NOT <MATCH-KEY .DEFAULT NONE>>
<NOT <TYPE? .DEFAULT FORM>>>
<COND (<NOT <DECL? .DEFAULT .TYPE>>
<COND (<DECL? .DEFAULT <FORM OR FALSE .TYPE>>
<SET TYPE <FORM OR FALSE .TYPE>>)
(T
<ERROR DEFAULT-DOESNT-MATCH-DECL
.TYPE .DEFAULT PM-TYPE>)>)>)>)>
<MAKE-PM-ARG 'PMA-NAME .NATM 'PMA-OFFS .OFFS
'PMA-TYPE .TYPE 'PMA-DEFAULT .DEFAULT>>
.STUFF>>
<PMT-ARGS .TYPE-OBJ .ARGS>>
<DEFINE20 GET-PM-TYPE (TYPE:ATOM "AUX" TEMP)
<COND (<AND <GASSIGNED? .TYPE>
<TYPE? ,.TYPE PM-TYPE>>
,.TYPE)
(T
<SET TEMP <PARSE <STRING "PM-TYPE-" <SPNAME .TYPE>> 10
,PDEFS-INTERNAL-OBLIST>>
<COND (<AND <GASSIGNED? .TEMP>
<TYPE? ,.TEMP PM-TYPE>>
,.TEMP)
(T
<ERROR NOT-A-PMEM-TYPE!-ERRORS .TYPE>)>)>>
<DEFMAC PMEM-TYPE? ('PMEM 'TYPE "OPT" 'TYPE2 "AUX" (ATM <>) (ATM2 <>))
<SET TYPE <GET-PM-TYPE .TYPE>>
<COND (<ASSIGNED? TYPE2>
<SET TYPE2 <GET-PM-TYPE .TYPE2>>)
(T
<SET TYPE2 <>>)>
<COND (<NOT .TYPE2>
<FORM ==? <FORM PM-TYPE-CODE .PMEM> <PMT-CODE .TYPE>>)
(T
<FORM OR <FORM ==? <FORM PM-TYPE .PMEM> <PMT-CODE .TYPE>>
<FORM ==? <FORM PM-TYPE .PMEM> <PMT-CODE .TYPE2>>>)>>
<DEFINE20 PRINT-PMEM (PMEM:PMEM "OPT" (OUTCHAN:CHANNEL .OUTCHAN)
"AUX" (CODE <PM-TYPE-CODE .PMEM>)
(OBJ:PM-TYPE <NTH ,PM-LIST <+ .CODE 1>>))
<PRINT-MANY .OUTCHAN PRINC "#" <PMT-NAME .OBJ> " [">
<REPEAT ((CT <PM-LENGTH .PMEM>) (N 1))
<COND (<L? <SET CT <- .CT 1>> 0>
<RETURN>)>
<PRIN1 <ZGET .PMEM .N>>
<PRINC !\ >
<SET N <+ .N 1>>>
<PRINC !\]>
.PMEM>
<SETG PMEM-WORDS-USED 0>
<GDECL (PMEM-WORDS-USED) FIX>
<DEFINE PMEM-RESET ("OPT" (FULL?:<OR ATOM FALSE> T))
<COND (<G? ,PMEM-WORDS-USED 0>
<SETG PMEM-WORDS-USED 0>
<COPYT ,PMEM-STORE 0
<* 2 <- ,PMEM-STORE-LENGTH ,PMEM-STORE-WORDS>>>)>
<SETG PMEM-STORE-WORDS ,PMEM-STORE-LENGTH>
<SETG PMEM-STORE-POINTER ,PMEM-STORE>
T>
<DEFINE20 MATCH-KEY (FOO BAR)
<AND <TYPE? .FOO ATOM>
<TYPE? .BAR ATOM>
<=? <SPNAME .FOO> <SPNAME .BAR>>>>
<DEFMAC PMEM-ALLOC PA (TYPNAM:ATOM "ARGS" STUFF "AUX" TEMP NT:PM-TYPE
BASE LENARG ATM BL)
<SET NT <GET-PM-TYPE .TYPNAM>>
<COND (<SET TEMP <MEMQ LENGTH .STUFF>>
<SET LENARG <2 .TEMP>>)
(<NOT <SET LENARG <PMT-LENGTH .NT>>>
<ERROR BAD-PMEM-LENGTH-ARG!-ERRORS .TYPNAM PMEM-ALLOC>)>
<SET BASE <FORM BIND ((NEW-OBJECT
<FORM DO-PMEM-ALLOC <PMT-CODE .NT> .LENARG>))>>
<SET BL <REST .BASE>>
<REPEAT ((ARGS <PMT-ARGS .NT>)
(INIT <CHTYPE <STACK <IVECTOR <* 2 <+ <LENGTH .ARGS>
,PM-HEADER-LEN>> NONE>>
TABLE>) THIS-ARG OFFS:FIX FRM)
<COND (<EMPTY? .STUFF>
<MAPF <>
<FUNCTION (ARG:PM-ARG "AUX" (IVAL <ZGET .INIT <PMA-OFFS .ARG>>))
<COND (<AND <MATCH-KEY .IVAL NONE>
<MATCH-KEY <PMA-DEFAULT .ARG> NONE>>
<ERROR NO-VALUE-FOR-MANDATORY-SLOT!-ERRORS .TYPNAM
PMEM-ALLOC>)
(<MATCH-KEY .IVAL NONE>
<COND
(<AND <PMA-DEFAULT .ARG>
<N==? <PMA-DEFAULT .ARG> '<>>
<N==? <PMA-DEFAULT .ARG> 0>>
;"PMEM-RESET zeroes memory, so if something is going
to be defaulted to 0 or false, don't bother."
<SET BL <REST
<PUTREST .BL
(<FORM <PMA-NAME .ARG>
'.NEW-OBJECT
<PMA-DEFAULT .ARG>>)>>>)>)>>
.ARGS>
<RETURN>)>
<COND (<OR <NOT <TYPE? <SET ATM <1 .STUFF>> ATOM>>
<AND <OR <NOT <GASSIGNED? .ATM>>
<NOT <TYPE? ,.ATM FIX MACRO>>>
<SET ATM <PARSE <STRING <SPNAME .TYPNAM> "-" <SPNAME .ATM>>
10 ,PDEFS-INTERNAL-OBLIST>>
<OR <NOT <GASSIGNED? .ATM>>
<NOT <TYPE? ,.ATM FIX MACRO>>>>>
<COND (<N==? <1 .STUFF> LENGTH>
<ERROR BAD-PMEM-ARG!-ERRORS .STUFF PMEM-ALLOC>)>)
(T
<SET FRM <EXPAND <FORM .ATM .INIT T>>>
<ZPUT .INIT <3 .FRM:FORM> T>
<COND (<AND <2 .STUFF>
<N==? <2 .STUFF> '<>>
<N==? <2 .STUFF> 0>>
<SET BL <REST <PUTREST .BL
(<FORM .ATM '.NEW-OBJECT <2 .STUFF>>)>>>)>)>
<SET STUFF <REST .STUFF 2>>>
<PUTREST .BL ('.NEW-OBJECT)>
.BASE>
<DEFINE DO-PMEM-ALLOC PA (TYPE:FIX LENGTH:FIX
"AUX" (STOR ,PMEM-STORE-POINTER)
(LEFT:FIX ,PMEM-STORE-WORDS) NEW)
;<COND (<NOT .STOR>
<SET STOR ,PMEM-STORE>)>
<SET LENGTH <+ .LENGTH 1>> ;"in words"
<DEBUG-CHECK <G? .LENGTH .LEFT>
<COND (<ERROR OUT-OF-MEMORY!-ERRORS
ERRET-T-TO-ALLOCATE-MORE!-ERRORS
PMEM-ALLOC>
<SETG PMEM-STORE-WORDS 500>
<SET LEFT 500>
<PMEM-STORE-LENGTH <+ <PMEM-STORE-LENGTH> 500>>
<PMEM-STORE <SET STOR <ITABLE <PMEM-STORE-LENGTH> 0>>>)
(T
<RETURN <> .PA>)>>
<COND (<G? .LENGTH .LEFT>
<P-NO-MEM-ROUTINE .TYPE>
;<RETURN <> .PA>)>
<SETG PMEM-WORDS-USED <+ ,PMEM-WORDS-USED .LENGTH>>
<SETG PMEM-STORE-WORDS <- .LEFT .LENGTH>>
<IF-P-DEBUGGING-PARSER
<COND (<G? ,PMEM-STORE-WARN ,PMEM-STORE-WORDS>
<SETG PMEM-STORE-WARN ,PMEM-STORE-WORDS>
<PRINTI "[Debugging info: ">
<PRINTI "PMEM: ">
<PRINTN ,PMEM-STORE-WARN ;,PMEM-STORE-WORDS>
<PRINTI " left!]|">)>>
<SETG PMEM-STORE-POINTER <ZREST .STOR <* .LENGTH 2>>>
<PM-LENGTH <CHTYPE-VAL STOR PMEM>
<SET LENGTH <- .LENGTH 1>>>
<PM-TYPE-CODE .STOR .TYPE>
.STOR>
<END-SEGMENT>
<ENDPACKAGE>

1006
prare.zap Normal file
View File

File diff suppressed because it is too large Load Diff

984
prare.zil Normal file
View File

@ -0,0 +1,984 @@
"PRARE file for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<ZZPACKAGE "PARSER">
<RENTRY PRINT-LEXV
TELL-CTHE
TELL-THE>
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
<USE "PMEM" "PSTACK">
<FILE-FLAGS MDL-ZIL? CLEAN-STACK?>
<BEGIN-SEGMENT 0>
<DEFAULTS-DEFINED
CANT-FIND-OBJECT
CANT-USE-MULTIPLE
DONT-UNDERSTAND
PARSER-REPORT
PRINT-INTQUOTE
PRINT-LEXV
REFRESH
;SAMPLE-COMMANDS
SETUP-ORPHAN
SETUP-ORPHAN-NP
TOO-MANY-NOUNS
WHICH-LIST?
WHICH-PRINT
YES?>
<DEFINE TOO-MANY-NEW (WHAT)
<TELL "[Warning: there are too many new " .WHAT "s.]" CR>>
<DEFINE NAKED-OOPS () <TELL "[Please type a word(s) after OOPS.]" CR>>
<DEFINE CANT-OOPS ()
<TELL "[There was no word to replace in that sentence.]" CR>>
<DEFINE CANT-AGAIN () <TELL "[What do you want to do again?]" CR>>
<DEFAULT-DEFINITION CANT-USE-MULTIPLE
<DEFINE CANT-USE-MULTIPLE (LOSS WD)
<SETG CLOCK-WAIT T>
;<COND (<==? .LOSS 2> <TELL "in">)>
;<TELL "direct ">
<TELL "[You can't use more than one object at a time with \"">
<PRINT-VOCAB-WORD .WD>
<TELL "\"!]" CR>>>
<DEFINE MAKE-ROOM-FOR-TOKENS (CNT LEXV WHERE "AUX" LEN)
<SET LEN <* 2 <GETB .LEXV 0>>>
<COND (<L? .LEN <+ .WHERE <* ,P-LEXELEN .CNT>>>
<SET CNT </ <- .LEN .WHERE> ,P-LEXELEN>>
<TOO-MANY-NEW "word">)>
<SET LEN <GETB .LEXV ,P-LEXWORDS>>
<PUTB .LEXV ,P-LEXWORDS <+ .CNT .LEN>> ;"update count"
<COND (T ;<OR <CHECK-EXTENDED? XZIP>
<CHECK-EXTENDED? YZIP>> ;"make space in dest."
<COPYT <SET LEXV <ZREST .LEXV <* 2 .WHERE>>>
<ZREST .LEXV <* .CNT <* 2 ,P-LEXELEN>>>
<* 2 <- <* 2 .LEN> <- .WHERE ,P-LEXSTART>>>>)
;(T
<PROG ()
<SET CNT <* ,P-LEXELEN .CNT>>
<SET LEN <* ,P-LEXELEN .LEN>>
<REPEAT ()
<ZPUT .LEXV <+ .CNT .LEN> <ZGET .LEXV .LEN>>
<COND (<L? <SET LEN <- .LEN 1>> .WHERE>
<RETURN>)>>>)>>
<DEFINE REPLACE-ONE-TOKEN (N FROM-LEXV PTR TO-LEXV WHERE "AUX" CNT)
<SET CNT <- .N 1>>
<COND (<NOT <0? .CNT>>
<MAKE-ROOM-FOR-TOKENS .CNT .TO-LEXV .WHERE>)>
<SET CNT .N>
<REPEAT (X) ;"copy tokens"
<COND (<L? <SET CNT <- .CNT 1>> 0>
<RETURN>)>
<SET PTR <+ .PTR ,P-LEXELEN>>
<ZPUT .TO-LEXV .WHERE <ZGET .FROM-LEXV .PTR>>
<SET X <+ <* .PTR ,P-LEXELEN> 2>>
<COND (<ZERO? <INBUF-ADD <GETB .FROM-LEXV .X>
<GETB .FROM-LEXV <+ .X 1>>
<+ <* .WHERE ,P-LEXELEN> 3>>>
<TOO-MANY-NEW "letter">
<RETURN>)>
<SET WHERE <+ .WHERE ,P-LEXELEN>>>>
<DEFAULT-DEFINITION REFRESH
;<SYNTAX $REFRESH = V-$REFRESH>
<DEFINE V-$REFRESH ()
<LOWCORE FLAGS <BAND <LOWCORE FLAGS> <BCOM ,F-REFRESH>>>
<CLEAR -1>
<INIT-STATUS-LINE>
<RTRUE>>>
<DEFAULT-DEFINITION PRINT-INTQUOTE
<DEFINE PRINT-INTQUOTE ("AUX" (NP <GET-NP ,INTQUOTE>))
<PRINT-LEXV -1
<ZREST <NP-LEXBEG .NP> ,LEXV-ELEMENT-SIZE-BYTES>
<+ -1 </ <- <NP-LEXEND .NP> <NP-LEXBEG .NP>>
,LEXV-ELEMENT-SIZE-BYTES>>>
;<BUFFER-PRINT <ZREST <NP-LEXBEG .NP> <* 2 ,LEXV-ELEMENT-SIZE-BYTES>>
<NP-LEXEND .NP>
<>
T>>>
<DEFAULT-DEFINITION PRINT-LEXV
<DEFINE PRINT-LEXV ("OPT" (QUIET 0)
(X <ZREST ,TLEXV <* .QUIET ,LEXV-ELEMENT-SIZE-BYTES>>)
(LEN <- ,P-LEN .QUIET>))
<COND (<OR <ZERO? .QUIET> <G? 0 ,P-OFLAG>>
<TELL "[In other words:" ;,I-ASSUME>)
;(T
<IFFLAG (P-DEBUGGING-PARSER <PRINTI "[Debugging info: ">)
(T T)>)>
;<BUFFER-PRINT .X <+ .X <* ,P-WORDLEN ,P-LEN>>>
<REPEAT (WD (IN-QUOTE <>)
(OWD <COND (<EQUAL? .QUIET -1> ,W?APOSTROPHE) (T 0)>))
<SET WD <ZGET .X 0>>
<COND (<EQUAL? .WD
,W?PERIOD ,W?COMMA ,W?APOSTROPHE ,W?NO.WORD>
T)
(<EQUAL? .OWD ,W?APOSTROPHE>
T)
(<AND <EQUAL? .OWD ,W?QUOTE>
<F? .IN-QUOTE>>
<SET IN-QUOTE T>)
(<AND <EQUAL? .WD ,W?QUOTE>
<T? .IN-QUOTE>>
<SET IN-QUOTE <>>)
(T
<TELL !\ >)>
<COND (<EQUAL? .WD ,W?NO.WORD>
T)
(<NOT <EQUAL? .WD 0 ,W?INT.NUM ,W?INT.TIM>>
<PRINT-VOCAB-WORD .WD>)
(T
<BUFFER-PRINT .X <+ .X ,P-WORDLEN> <> T>)>
<COND (<DLESS? LEN 1>
<RETURN>)>
<COND (<NOT <EQUAL? .WD ,W?NO.WORD>>
<SET OWD .WD>)>
<SET X <ZREST .X ,LEXV-ELEMENT-SIZE-BYTES>>>
<COND (<OR <ZERO? .QUIET> <G? 0 ,P-OFLAG>>
<TELL "]" CR>)
;(T
<IFFLAG (P-DEBUGGING-PARSER <TELL "]" CR>)
(T T)>)>
;<SETG P-OFLAG <>>>>
<DEFINE COPY-INPUT ("OPT" (QUIET 0) "AUX" LEN)
<COPYT ,G-LEXV ,P-LEXV ,LEXV-LENGTH-BYTES>
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
<SETG TLEXV <ZGET ,OOPS-TABLE ,O-START ;,O-AGAIN>>
<COPYT ,G-INBUF ,P-INBUF <+ 1 ,INBUF-LENGTH>>
<SET LEN <* <* 2 ,P-LEXELEN:FIX>
<GETB ,P-LEXV ,P-LEXWORDS>>>
<ZPUT ,OOPS-TABLE ,O-END
<+ <GETB ,TLEXV <SET LEN <- .LEN 1>>>
<GETB ,TLEXV <SET LEN <- .LEN 1>>>>>
<COND (<NOT .QUIET>
<PRINT-LEXV .QUIET>)>
<SETG P-OFLAG <>>>
<COND (<NOT <OR <CHECK-VERSION? XZIP>
<CHECK-VERSION? YZIP>>>
<DEFINE COPY-INBUF (SRC DEST "AUX" CNT:FIX)
<SET CNT <- <GETB .SRC 0> 1>>
<REPEAT ()
<PUTB .DEST .CNT <GETB .SRC .CNT>>
<COND (<L? <SET CNT <- .CNT 1>> 0>
<RETURN>)>>>
<DEFINE COPY-LEXV (SRC DEST "OPT" (MAX:FIX ,LEXV-LENGTH) "AUX" (CTR:FIX 1))
<PUTB .DEST 0 <GETB .SRC 0>>
<PUTB .DEST 1 <GETB .SRC 1>>
<SET DEST <ZREST .DEST <* ,P-LEXSTART:FIX 2>>>
<SET SRC <ZREST .SRC <* ,P-LEXSTART:FIX 2>>>
<REPEAT ()
<ZPUT .DEST 0 <ZGET .SRC 0>>
<PUTB .DEST 2 <GETB .SRC 2>>
<PUTB .DEST 3 <GETB .SRC 3>>
<COND (<G? <SET CTR <+ .CTR 1>> .MAX>
<RETURN>)>
<SET DEST <ZREST .DEST <* 2 ,P-LEXELEN:FIX>>>
<SET SRC <ZREST .SRC <* 2 ,P-LEXELEN:FIX>>>>>)>
<END-SEGMENT>
;"<DEFAULT-DEFINITION SAMPLE-COMMANDS"
<IFN-P-BE-VERB
<BEGIN-SEGMENT HINTS>
<SYNTAX $NUDGE = V-$NUDGE>
<SYNTAX $NUDGE OBJECT = V-$NUDGE>
<ROUTINE V-$NUDGE ()
<SETG CLOCK-WAIT T>
<LEXV-WORD ,TLEXV ,W?SHOULD> ;"force sample command"
<TELL "[">
;<PRINT "Please use commands">
<TELL-SAMPLE-COMMANDS>
;<TELL ".]" CR>>
<GLOBAL P-ERRS:NUMBER 0>
;<GLOBAL P-THRESH:NUMBER 10>
<DEFINE COUNT-ERRORS ("OPT" (NUM 1)
"AUX" (THRESH <COND (<FSET? ,GREAT-HALL ,TOUCHBIT> 10)
(T 2)>))
<SETG P-ERRS <+ .NUM ,P-ERRS>>
<COND (<G? ,P-ERRS .THRESH>
<SETG P-ERRS 0>
<TELL
"[I'm having trouble understanding you. Maybe it's because you're not
used to the rules for commands. ">
<COND (<AND <NOT <FSET? ,GREAT-HALL ,TOUCHBIT>>
<T? ,PROLOGUE-NOVICE-COUNTER>>
<TELL "Here's the command you should type now:|
"
<ZGET ,NOVICE-MOVES ,PROLOGUE-NOVICE-COUNTER>
"|
Please try that.]" CR>)
(T
<TELL-SAMPLE-COMMANDS>)>)>>
<DEFINE FIND-UEXIT-STR ACT ("AUX" (P 0))
<REPEAT ()
<COND (<L? <SET P <NEXTP ,HERE .P>> ,LOW-DIRECTION>
<RETURN <> .ACT>)
(T
<COND (<EQUAL? <PTSIZE <GETPT ,HERE .P>> ,UEXIT>
<RETURN <DIR-TO-STRING .P> .ACT>)>)>>>
<CONSTANT TELL-SAMPLE-COMMANDS-NUMBER 3>
<DEFINE TELL-SAMPLE-COMMANDS ("AUX" VERB SYN (OBJ <>) (NUM 0))
<TELL
" Commands tell the computer what you want to do in the story.
Here are some commands that you can type right now, although
they may or may not be useful:|">
;"0 objects:"
<REPEAT ((CT <ZGET ,SAMPLE-COMMANDS-TABLE-0 0>)
(N <COND (<T? ,PRSO> .CT) (T ,TELL-SAMPLE-COMMANDS-NUMBER)>))
<SET VERB <ZGET ,SAMPLE-COMMANDS-TABLE-0
<COND (<T? ,PRSO> .N) (T <RANDOM .CT>)>>>
<COND (<DLESS? N 0>
<RETURN>)
(<OR <NOT <EQUAL? .VERB ,W?GO>>
<SET OBJ <FIND-UEXIT-STR>>>
<INC NUM>
<TELL " ">
<PRINT-VOCAB-WORD .VERB>
<COND (.OBJ
<TELL !\ .OBJ>)>
<CRLF>
<COND (<F? ,PRSO>
<RETURN>)>)>>
;"1 object:"
<REPEAT ((CT <ZGET ,SAMPLE-COMMANDS-TABLE-1 0>)
(N <COND (<T? ,PRSO> .CT) (T ,TELL-SAMPLE-COMMANDS-NUMBER)>))
<SET VERB <ZGET ,SAMPLE-COMMANDS-TABLE-1
<COND (<T? ,PRSO> .N) (T <RANDOM .CT>)>>>
<COND (<DLESS? N 0>
<RETURN>)
(<AND <SET SYN <VERB-ONE <WORD-VERB-STUFF .VERB>>>
<GET-SYNTAX .SYN 1 0 T>
<SET OBJ <DETERMINE-OBJ <> 1 T>>
<SET OBJ <NOUN-PHRASE-OBJ1 .OBJ>>>
<INC NUM>
<TELL " ">
<PRINT-VOCAB-WORD .VERB>
<TELL !\ D .OBJ CR>
<COND (<F? ,PRSO>
<RETURN>)>)>>
;"2 objects:"
<REPEAT ((CT </ <ZGET ,SAMPLE-COMMANDS-TABLE-2 0> 2>)
(N <COND (<T? ,PRSO> .CT) (T ,TELL-SAMPLE-COMMANDS-NUMBER)>))
<COND (<0? .N>
<RETURN>)>
<SET VERB <- <* <COND (<T? ,PRSO> .N) (T <RANDOM .CT>)> 2> 1>>
<SET SYN <ZGET ,SAMPLE-COMMANDS-TABLE-2 .VERB>>
<COND (<0? <WORD-CLASSIFICATION-NUMBER .SYN>> ;"a synonym"
<SET SYN <WORD-SEMANTIC-STUFF .SYN>>)>
<COND (<DLESS? N 0>
<RETURN>)
(<AND <SET SYN <VERB-TWO <WORD-VERB-STUFF .SYN>>>
<PARSE-PARTICLE2 ,PARSE-RESULT
<ZGET ,SAMPLE-COMMANDS-TABLE-2 <+ 1 .VERB>>>
<GET-SYNTAX .SYN 2 0 T>
<SET OBJ <DETERMINE-OBJ <> 1 T>>
<SET OBJ <NOUN-PHRASE-OBJ1 .OBJ>>
<SET SYN <DETERMINE-OBJ <> 2 T>>
<SET SYN <NOUN-PHRASE-OBJ1 .SYN>>>
<INC NUM>
<TELL " ">
<PRINT-VOCAB-WORD <ZGET ,SAMPLE-COMMANDS-TABLE-2 .VERB>>
<TELL !\ D .OBJ !\ >
<PRINT-VOCAB-WORD <ZGET ,SAMPLE-COMMANDS-TABLE-2 <+ 1 .VERB>>>
<TELL !\ D .SYN CR>
<COND (<F? ,PRSO>
<RETURN>)>)>>
<COND (<OR <T? ,P-WON> <1? <RANDOM 2>>> ;<NOT <IGRTR? NUM 3>>
<TELL " say \"">
<SET SYN <ZREST ,VOCAB <+ 1 <GETB ,VOCAB 0>>>>
<REPEAT (N (M <GETB .SYN 0>))
<SET N <ZREST .SYN <+ 3 <* .M ;"size of entry"
<- <RANDOM <ZGET <ZREST .SYN 1> 0>
;"number of entries">
1>>>>>
<COND (<AND <G=? .N ,W?A>
<T? <WORD-CLASSIFICATION-NUMBER .N>>
<NOT <EQUAL? .N ,W?END.OF.INPUT ,W?NO.WORD
,W?INT.NUM ,W?INT.TIM>>>
<PRINT-VOCAB-WORD .N>
<RETURN>)>>
<TELL "\"|">)>
<COND (<IN? ,JESTER ,HERE> ;<NOT <IGRTR? NUM 3>>
<TELL " jester, give me the key|">)>
<TELL "Now you can try again.]" CR>>
<CONSTANT SAMPLE-COMMANDS-TABLE-0 <PLTABLE
<VOC "GO"> ;"[a direction]"
<VOC "INVENTORY">
<VOC "LOOK">
<VOC "WAIT">>>
<CONSTANT SAMPLE-COMMANDS-TABLE-1 <PLTABLE
<VOC "TAKE">
<VOC "DROP">
<VOC "EXAMINE"> ;"[a visible object]"
<VOC "READ">
<VOC "OPEN"> ;"[a closed container]"
<VOC "CLOSE"> ;"[an open container]"
<VOC "BOARD"> ;"[a vehicle you're not in]"
<VOC "EXIT"> ;"[a vehicle you're in]"
<VOC "WEAR">
<VOC "REMOVE">>>
<CONSTANT SAMPLE-COMMANDS-TABLE-2 <PLTABLE
<VOC "PUT"> <VOC "IN"> ;"[a held object] INTO [an open container]"
<VOC "GIVE"> <VOC "TO">
<VOC "ASK"> <VOC "ABOUT"> ;"[a character] ABOUT [one of several topics]
[a character], HELLO
[a character], GO [a direction]">>
<END-SEGMENT>
>
;">"
<BEGIN-SEGMENT 0>
<ADD-WORD NO.WORD ADJ>
<DEFINE BUFFER-PRINT (BEG END "OPT" (CP <>) (NOSP <>) ;(ALL <>)
"AUX" WRD NW (FIRST?? T) (PN <>) TMP)
<REPEAT ()
<COND (<EQUAL? .BEG .END> <RETURN>)>
<COND (<OR <T? .NOSP>
<EQUAL? .NW ,W?PERIOD ,W?COMMA ,W?APOSTROPHE>>
<SET NOSP <>>)
(T <TELL !\ >)>
<SET WRD <ZGET .BEG 0>>
<COND (<EQUAL? .END <ZREST .BEG ,P-WORDLEN>>
<SET NW 0>)
(T <SET NW <ZGET .BEG ,P-LEXELEN>>)>
<COND (<EQUAL? .WRD ,W?NO.WORD>
<SET NOSP T>)
(<EQUAL? .WRD ,W?MY>
<PRINTB ,W?YOUR>)
(<EQUAL? .WRD ,W?ME>
<PRINTB ,W?YOU>
<SET PN T>)
(<EQUAL? .WRD ,W?ONE>
<TELL "object">)
(<AND ;<T? .ALL>
<IFFLAG (P-APOSTROPHE-BREAKS-WORDS
<NOT <EQUAL? .WRD <> ,W?ALL ,W?PERIOD ,W?APOSTROPHE>>)
(T
<NOT <EQUAL? .WRD <> ,W?ALL ,W?PERIOD>>)>
<OR <AND <0? <SET TMP <WORD-CLASSIFICATION-NUMBER .WRD>>>
<F? <WORD-SEMANTIC-STUFF .WRD>>> ;"BUZZ"
;<COMPARE-WORD-TYPES .TMP <GET-CLASSIFICATION PREP>>>
<NOT <COMPARE-WORD-TYPES .TMP <GET-CLASSIFICATION ADJ>>>
<NOT <COMPARE-WORD-TYPES .TMP <GET-CLASSIFICATION NOUN>>>>
<SET NOSP T>)
(<CAPITAL-NOUN? .WRD>
<CAPITALIZE .BEG>
<SET PN T>)
(T
<COND (<AND <T? .FIRST??> <ZERO? .PN> <T? .CP>>
<COND (<NOT <EQUAL? .WRD ,W?HER ,W?HIM ,W?YOUR>>
<TELL "the ">)>)>
<COND ;(<AND <T? ,P-OFLAG>
<T? .WRD>>
<PRINT-VOCAB-WORD .WRD>)
(<AND <EQUAL? .WRD ,W?IT>
<VISIBLE? ,P-IT-OBJECT>>
<TELL D ,P-IT-OBJECT>)
(<AND <EQUAL? .WRD ,W?HER>
<ZERO? .PN>>
<TELL D ,P-HER-OBJECT>)
(<AND <EQUAL? .WRD ,W?HIM>
<ZERO? .PN>>
<TELL D ,P-HIM-OBJECT>)
(<EQUAL? .WRD ,W?INT.NUM ,W?INT.TIM>
<TELL N <ZGET .BEG 1>>)
(T
<WORD-PRINT .BEG>)>
<SET FIRST?? <>>)>
<SET BEG <ZREST .BEG ,P-WORDLEN>>>>
<ROUTINE CAPITALIZE (PTR)
<COND ;(<T? ,P-OFLAG>
<PRINT-VOCAB-WORD <LEXV-WORD .PTR>>)
(T
<PRINTC <- <GETB ,P-INBUF <LEXV-WORD-OFFSET .PTR>>
<- !\a !\A>>>
<WORD-PRINT .PTR
<- <LEXV-WORD-LENGTH .PTR> 1>
<+ <LEXV-WORD-OFFSET .PTR> 1>>)>>
<DEFINE PRINT-PARSER-FAILURE ("AUX"
(CLASS <ZGET ,ERROR-ARGS 1>) (OTHER <ZGET ,ERROR-ARGS 2>)
(OTHER2<ZGET ,ERROR-ARGS 3>))
;<ZPUT ,ERROR-ARGS 1 0>
<COND (<==? .CLASS ,PARSER-ERROR-ORPH-S>
<PROG (TMP PR N)
<SETG P-OFLAG </ <- <ZGET ,ORPHAN-S ,O-LEXPTR> ,P-LEXV> 2>>
<COPYT ,G-LEXV ,O-LEXV ,LEXV-LENGTH-BYTES>
<COPYT ,G-INBUF ,O-INBUF <+ 1 ,INBUF-LENGTH>>
<ZPUT ,OOPS-TABLE ,O-AGAIN <ZGET ,OOPS-TABLE ,O-START>>
<MAKE-ROOM-FOR-TOKENS 1 ,O-LEXV ,P-OFLAG>
<ZPUT ,O-LEXV ,P-OFLAG ,W?NO.WORD ;0>
<TELL "[Wh">
<COND (<ZAPPLY ,DIR-VERB-WORD? <ZGET ,ORPHAN-S ,O-VERB>>
<TELL "ere">)
(<==? ,PERSONBIT
<COND (<1? <ZGET ,ORPHAN-S ,O-WHICH>>
<SYNTAX-FIND ;B4
<ZGET ,ORPHAN-S ,O-SYNTAX> 1>)
(T <SYNTAX-FIND ;B8
<ZGET ,ORPHAN-S ,O-SYNTAX> 2>)>>
<TELL "om">)
(T <TELL "at">)>
<TELL !\ >
<COND (<AND <SET PR <ZGET ,ORPHAN-S ,O-SUBJECT>>
<BAND ,PAST-TENSE
<WORD-FLAGS<SET TMP<ZGET ,ORPHAN-S ,O-VERB>>>>>
<TELL "did ">
<TELL-THE .PR>
<TELL !\ >)
(T
<TELL "do you want ">
<COND (<NOT <EQUAL? ,WINNER ,PLAYER>>
<TELL D ,WINNER " ">)>
<TELL "to ">)>
<PRINT-VOCAB-WORD <ROOT-VERB <ZGET ,ORPHAN-S ,O-VERB>>>
<SET TMP <ZGET ,ORPHAN-S ,O-PART>>
<COND (<NOT <EQUAL? .TMP 0 1>>
<TELL !\ >
<PRINT-VOCAB-WORD .TMP>)>
<COND (<SET TMP <ZGET ,ERROR-ARGS 2>>
<TELL !\ >
<COND (<SET PR <ZGET ,ORPHAN-S ,O-OBJECT>>
<TELL-THE .PR>)
(T
<NP-PRINT .TMP>)>
<COND (<SET TMP <ZGET ,ORPHAN-S ,O-SYNTAX>>
<SET TMP <COND (<1? <ZGET ,ORPHAN-S ,O-WHICH>>
<SYNTAX-PREP .TMP 1>)
(T
<SYNTAX-PREP .TMP 2>)>>
<COND (<T? .TMP>
<SET N <GETB ,O-LEXV ,P-LEXWORDS>>
<SET PR <ZGET ,O-LEXV
<- ,P-OFLAG ,P-LEXELEN>>>
<COND (<0? <WORD-CLASSIFICATION-NUMBER .PR>>
;"synonym"
<SET PR <WORD-SEMANTIC-STUFF .PR>>)>
<COND (<N==? .TMP .PR>
<SET N <+ 1 .N>>
<PUTB ,O-LEXV ,P-LEXWORDS .N>
<ZPUT ,O-LEXV ,P-OFLAG .TMP>
<SETG P-OFLAG
<+ ,P-OFLAG ,P-LEXELEN>>)>
<ZPUT ,O-LEXV ,P-OFLAG ,W?NO.WORD ;0>
<INBUF-PRINT .TMP ,O-INBUF
,O-LEXV<+ 1 <* ,P-WORDLEN .N>>>
<TELL !\ >
<PRINT-VOCAB-WORD .TMP>)>)>)>
<TELL "?]" CR>
<RTRUE>>)
(<==? .CLASS ,PARSER-ERROR-ORPH-NP>
<REPEAT ((NP .OTHER)
(PTR <NP-LEXEND .NP>)
(NOUN <NP-NAME .NP>))
<COND (<==? .NOUN <ZGET .PTR 0>>
<SETG P-OFLAG </ <- .PTR ,P-LEXV> 2>>
<COPYT ,G-LEXV ,O-LEXV ,LEXV-LENGTH-BYTES>
<COPYT ,G-INBUF ,O-INBUF <+ 1 ,INBUF-LENGTH>>
<ZPUT ,OOPS-TABLE ,O-AGAIN <ZGET ,OOPS-TABLE ,O-START>>
<WHICH-PRINT .NP>
<RTRUE>)
(<G? ,P-LEXV <SET PTR <- .PTR ,LEXV-ELEMENT-SIZE-BYTES>>>
<RETURN>)>>)>
;<SETG P-OFLAG 0>
<COND ;(<==? .CLASS ,PARSER-ERROR-QUIET>
<RTRUE>)
(<==? .CLASS ,PARSER-ERROR-NOMULT>
<CANT-USE-MULTIPLE .OTHER .OTHER2>
<RTRUE>)
(<EQUAL? .CLASS ,PARSER-ERROR-NOOBJ>
<CANT-FIND-OBJECT .OTHER .OTHER2>
<RTRUE>)
(<EQUAL? .CLASS ,PARSER-ERROR-TMNOUN>
<TOO-MANY-NOUNS <PARSE-VERB ,PARSE-RESULT>>
<RTRUE>)
(T ;<OR <==? .CLASS ,PARSER-ERROR-NOUND>
<NOT <L? ,ERROR-PRIORITY 255>>>
<SET OTHER2 ,OTLEXV> ;"Try to handle PUSH RED --"
<COND (<OR <AND <ZERO? ,P-LEN>
<NAKED-ADJECTIVE? <ZGET .OTHER2 0>>>
<AND <L? ,P-LEXV
<SET OTHER2 <ZBACK ,OTLEXV <* 2 ,P-LEXELEN>>>>
<L? 0 ,P-LEN>
<NAKED-ADJECTIVE? <ZGET .OTHER2 0>>
<WORD-TYPE? <ZGET ,OTLEXV 0>
,P-EOI-CODE ,P-COMMA-CODE>>>
<SET CLASS <+ ,P-LEXELEN </ <- .OTHER2 ,P-LEXV> 2>>>
<MAKE-ROOM-FOR-TOKENS 1 ,P-LEXV .CLASS>
<MAKE-ROOM-FOR-TOKENS 1 ,G-LEXV .CLASS>
<CHANGE-LEXV <ZREST .OTHER2 <* 2 ,P-LEXELEN>> ,W?ONE>
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>
;<+ 1 <ZGET ,OOPS-TABLE ,O-LENGTH>>>
<SETG TLEXV <ZGET ,OOPS-TABLE ,O-START>>
;<PRINT-LEXV>
<RETURN <PARSE-IT <>>>)>
<COND ;"Try to handle TAKE THIS JOB AND SHOVE IT --"
(<AND <G? ,P-LEN 0>
<OR <CHANGE-AND-TO-THEN? <SET OTHER2
<ZBACK ,OTLEXV<* 2 ,P-LEXELEN>>>>
<CHANGE-AND-TO-THEN? <SET OTHER2 ,OTLEXV>>>>
<CHANGE-LEXV .OTHER2 ,W?THEN>
<SETG P-LEN <ZGET ,OOPS-TABLE ,O-LENGTH>>
<SETG TLEXV <ZGET ,OOPS-TABLE ,O-START>>
<PRINT-LEXV>
<RETURN <PARSE-IT <>>>)
(T
<DONT-UNDERSTAND>
;<RTRUE>)>)>>
<DEFINE NAKED-ADJECTIVE? (WD)
<AND <WORD-TYPE? .WD ,P-ADJ-CODE>
<NOT <WORD-TYPE? .WD ,P-DIR-CODE>>
;<NOT <EQUAL? .WD ,W?S>> ;"possessive"
<NOT <EQUAL? .WD ,W?ONE>>>>
<DEFINE CHANGE-AND-TO-THEN? (PTR)
<AND <EQUAL? <ZGET .PTR 0> ,W?AND ,W?COMMA>
<OR <WORD-TYPE? <ZGET <SET PTR <ZREST .PTR <* 2 ,P-LEXELEN>>> 0>
,P-VERB-CODE ,P-DIR-CODE>
<WORD-TYPE? <ZGET .PTR 0> ,P-EOI-CODE>>>>
<DEFAULT-DEFINITION DONT-UNDERSTAND
<DEFINE DONT-UNDERSTAND ()
<SETG CLOCK-WAIT T>
<COND (<AND <EQUAL? 1 <GETB ,P-LEXV ,P-LEXWORDS>>
<WORD-TYPE? <ZGET ,P-LEXV ,P-LEXSTART> ,P-NOUN-CODE ,P-ADJ-CODE>>
<MISSING "verb">
<RETURN T>)>
<IFN-P-BE-VERB
<COND (<COUNT-ERRORS 1>
<RETURN T>)>>
<TELL
"[Sorry, but I don't understand. Please say that another way, or try
something else.]" CR>>>>
<DEFINE MISSING (NV)
<TELL "[I think there's a " .NV " missing in that sentence!]" CR>>
<DEFAULT-DEFINITION CANT-FIND-OBJECT
<DEFINE CANT-FIND-OBJECT (NP PART ;SEARCH "AUX" TMP)
<COND (<ZERO? <NP-QUANT .NP>> ;<EQUAL? .NP ,ORPHAN-NP>
<NP-CANT-SEE .NP>)
(T
<TELL "[There isn't anything to ">
<COND (<SET TMP <PARSE-VERB ,PARSE-RESULT>>
<PRINT-VOCAB-WORD .TMP>
;<SET TMP <PARSE-PARTICLE1 ,PARSE-RESULT>>
<COND (<NOT <EQUAL? .PART ;.TMP 0 1>>
<TELL C !\ >
<PRINT-VOCAB-WORD .TMP>)>)
(T <TELL "do that to">)>
<TELL "!]" CR>)>>
<DEFINE NP-CANT-SEE ("OPT" (NP <GET-NP>) "AUX" TMP)
<COND (<SET TMP <NP-NAME .NP>>
<TELL "[">
<TELL-CTHE ,WINNER>
<TELL " can't see ">
<COND (<OR <CAPITAL-NOUN? .TMP>
<AND <SET TMP <NP-ADJS .NP>>
<ADJS-POSS .TMP>>>
<NP-PRINT .NP T>)
(T
<TELL "any ">
<NP-PRINT .NP>)>
<TELL !\ >
<COND (<AND <SET TMP <NP-LOC .NP>>
<OR <AND ;<EQUAL? .NP ,ORPHAN-NP>
;"removed for HIT MAN ON HEAD WITH ROCK"
<PMEM-TYPE? .TMP NOUN-PHRASE>
<TELL "in">>
<AND <PMEM-TYPE? .TMP LOCATION>
<SET TMP <LOCATION-OBJECT .TMP>>
<PRINT-VOCAB-WORD <LOCATION-PREP .TMP>>>>>
<TELL " ">
<TELL-THE <NOUN-PHRASE-OBJ1 .TMP>>)
(T
<COND ;(<ZAPPLY ,MOBY-FIND? .SEARCH>
<TELL "anyw">)
(T <TELL "right ">)>
<TELL "here">)>
<TELL ".]" CR>)
(T <MORE-SPECIFIC>)>>>
<DEFAULT-DEFINITION WHICH-LIST?
<DEFINE WHICH-LIST? (NP SR)
<COND (<L=? <FIND-RES-COUNT .SR> <FIND-RES-SIZE .SR>>
T)>>>
<DEFAULT-DEFINITION WHICH-PRINT
<DEFINE WHICH-PRINT (NP "AUX" (SR ,ORPHAN-SR)
(LEN <FIND-RES-COUNT .SR>) (SZ <FIND-RES-SIZE .SR>))
<COND (<NOT <==? ,WINNER ,PLAYER>>
<TELL "\"I don't understand ">
<COND (<WHICH-LIST? .NP .SR>
<TELL "if">)
(T
<TELL "which">
<COND (<T? .NP>
;<SETG P-ONE-NOUN <NP-NAME .NP>>
<TELL !\ >
<NP-PRINT .NP>)>)>)
(T
<TELL "[Which">
<COND (<T? .NP>
;<SETG P-ONE-NOUN <NP-NAME .NP>>
<TELL !\ >
<NP-PRINT .NP>)>
<TELL " do">)>
<TELL " you mean">
<COND (<WHICH-LIST? .NP .SR>
<COND (<==? ,WINNER ,PLAYER>
<TELL !\,>)>
<REPEAT ((REM .LEN) (VEC <REST-TO-SLOT .SR FIND-RES-OBJ1>))
<TELL !\ >
<TELL-THE <ZGET .VEC 0>>
<COND (<==? .REM 2>
<COND (<NOT <==? .LEN 2>>
<TELL !\,>)>
<TELL " or">)
(<G? .REM 2>
<TELL !\,>)>
<COND (<L? <SET REM <- .REM 1>> 1>
<RETURN>)
(<L? <SET SZ <- .SZ 1>> 1>
<COND (T ;<ZERO? <SET SR <FIND-RES-NEXT .SR>>>
<RETURN>)>
;<SET SZ ,FIND-RES-MAXOBJ>
;<SET VEC <REST-TO-SLOT .SR OBJLIST-NEXT>>)
(T <SET VEC <ZREST .VEC 2>>)>>)>
<COND (<NOT <==? ,WINNER ,PLAYER>>
<TELL ".\"" CR>)
(T
<TELL "?]" CR>)>>>
<DEFINE NP-PRINT (NP:PMEM "OPT" (DO-QUANT <>) "AUX" LEN)
<COND (<OBJECT? .NP>
<TELL-THE .NP>)
(<PMEM-TYPE? .NP NOUN-PHRASE>
<COND (<SET LEN <NOUN-PHRASE-COUNT .NP>>
<DEC LEN>
<REPEAT (OBJ (CT 0))
<COND (<SET OBJ <ZGET .NP <+ ,NOUN-PHRASE-HEADER-LEN
<* .CT 2>>>>
<TELL-THE .OBJ>)>
<COND (<G? <SET CT <+ .CT 1>> .LEN>
<RETURN>)
(T <TELL ", ">)>>)>)
(T
<COND (<AND <T? .DO-QUANT>
<SET LEN <NP-QUANT .NP>>> ;"sounds bad after 'any'"
<PRINTB <GET-QUANTITY-WORD .LEN>>
<COND (<NP-NAME .NP>
<TELL !\ >)>)>
<COND (<SET LEN <NP-ADJS .NP>>
<ADJS-PRINT .LEN>)>
<COND (<AND <SET LEN <NP-LEXEND .NP>>
<OR <==? <ZGET .LEN 0> <NP-NAME .NP>>
<AND <COMPARE-WORD-TYPES
<WORD-CLASSIFICATION-NUMBER <ZGET .LEN 0>>
<GET-CLASSIFICATION END-OF-INPUT>>
<L? ,P-LEXV
<SET LEN <ZBACK .LEN ,LEXV-ELEMENT-SIZE-BYTES>>>
<==? <ZGET .LEN 0> <NP-NAME .NP>>>>>
<BUFFER-PRINT .LEN <ZREST .LEN ,P-WORDLEN> <> T>)
(<SET LEN <NP-NAME .NP>>
<PRINT-VOCAB-WORD .LEN>)>
<COND (<AND <SET LEN <NP-OF .NP>>
<PMEM? .LEN>
<PMEM-TYPE? .LEN NP>>
<TELL " of ">
<NP-PRINT .LEN>)>
<COND (<AND <SET LEN <NP-EXCEPT .NP>>
<PMEM? .LEN>
<PMEM-TYPE? .LEN NP>>
<TELL " except ">
<NP-PRINT .LEN>)>)>>
<DEFINE ADJS-PRINT (ADJT "AUX" LEN)
<COND (<SET LEN <ADJS-POSS .ADJT>>
<COND (<EQUAL? .LEN ,PLAYER ,ME>
<TELL "your ">)
(T
<NP-PRINT ;TELL-THE .LEN>
<TELL "'s ">)>)>
<COND (<SET LEN <ADJS-COUNT .ADJT>>
<SET ADJT <REST-TO-SLOT .ADJT ADJS-COUNT 1>>
<COND (<G? .LEN ,ADJS-MAX-COUNT>
<SET LEN ,ADJS-MAX-COUNT>)>
<DEC LEN>
<SET ADJT <ZREST .ADJT <* 2 .LEN>>>
<REPEAT (WD (CT 0) TMP)
<SET WD <ZGET .ADJT 0>>
<COND (<EQUAL? .WD ,W?MY>
<TELL "your ">)
(<EQUAL? .WD ,W?INT.NUM ,W?INT.TIM>
<TELL N ,P-NUMBER> ;"good enough?"
<TELL !\ >)
(<NOT <EQUAL? .WD ,W?NO.WORD>>
<COND (<AND <CAPITAL-NOUN? .WD>
<SET TMP <GETB ,P-LEXV ,P-LEXWORDS>>
<SET TMP <INTBL? .WD
<REST-TO-SLOT ,P-LEXV LEXV-START>
.TMP *204*>>>
<CAPITALIZE .TMP>)
(T
<PRINT-VOCAB-WORD .WD>)>
<TELL !\ >)>
<COND (<G? <SET CT <+ .CT 1>> .LEN>
<RETURN>)
(T <SET ADJT <ZBACK .ADJT 2>>)>>)>>
<DEFAULT-DEFINITION TOO-MANY-NOUNS
<DEFINE TOO-MANY-NOUNS (WD)
<TELL "[I can't understand that many nouns with ">
<COND (<T? .WD>
<TELL !\">
<PRINT-VOCAB-WORD .WD>
<TELL !\">)
(T <TELL "that verb">)>
<TELL ".]" CR>>>
<DEFINE INBUF-ADD (LEN:FIX BEG:FIX SLOT:FIX "AUX" DBEG:FIX TMP)
<SET TMP <ZGET ,OOPS-TABLE ,O-END>>
<COND (<T? .TMP>
<SET DBEG .TMP>)
(T
<SET TMP <* ,P-WORDLEN <ZGET ,OOPS-TABLE ,O-LENGTH>>>
<SET DBEG <+ <GETB ,G-LEXV .TMP>
<GETB ,G-LEXV <+ .TMP 1>>>>)>
<COND (<L? ,INBUF-LENGTH <+ .DBEG <- .LEN 1>>>
<RFALSE>)>
<ZPUT ,OOPS-TABLE ,O-END <+ .DBEG .LEN>>
<COND (T ;<OR <CHECK-EXTENDED? XZIP>
<CHECK-EXTENDED? YZIP>>
<COPYT <ZREST ,P-INBUF .BEG> <ZREST ,G-INBUF .DBEG> .LEN>)
;(T
<REPEAT ((CTR:FIX 0))
<PUTB ,G-INBUF <+ .DBEG .CTR>
<GETB ,P-INBUF <+ .BEG .CTR>>>
<SET CTR <+ .CTR 1>>
<COND (<EQUAL? .CTR .LEN>
<RETURN>)>>)>
<PUTB ,G-LEXV .SLOT .DBEG>
<PUTB ,G-LEXV <- .SLOT 1> .LEN>
T>
<DEFINE INBUF-PRINT (WD INBUF LEXV SLOT:FIX
"AUX" DBEG:FIX (CTR:FIX 0) TMP (LEN:FIX 11))
<SET TMP <ZGET ,OOPS-TABLE ,O-END>>
<COND (<T? .TMP>
<SET DBEG .TMP>)
(T
<SET TMP <* ,P-WORDLEN <ZGET ,OOPS-TABLE ,O-LENGTH>>>
<SET DBEG <+ <GETB .LEXV .TMP>
<GETB .LEXV <+ .TMP 1>>>>)>
<COND (<L? <GETB .INBUF 0> <+ .DBEG <- .LEN 1>>>
<RFALSE>)>
<COND ;(<NOT <CHECK-EXTENDED?>> <RFALSE>)
(T
<DIROUT ,D-TABLE-ON <ZREST .INBUF .DBEG>>
<PRINT-VOCAB-WORD .WD>
<DIROUT ,D-TABLE-OFF>
<SET LEN <GETB .INBUF <+ 1 .DBEG>>>)>
<SET DBEG <+ 2 .DBEG>>
<ZPUT ,OOPS-TABLE ,O-END <+ .DBEG .LEN>>
<PUTB .LEXV .SLOT .DBEG>
<PUTB .LEXV <- .SLOT 1> .LEN>
T>
<DEFAULT-DEFINITION YES?
<CONSTANT YES-INBUF <ITABLE 19 (BYTE LENGTH) 0>>
<CONSTANT YES-LEXV <ITABLE 3 (LEXV) 0 0>>
<DEFINE YES? ("OPT" (NO-Q <>) "AUX" WORD VAL)
<COND (<NOT .NO-Q>
<TELL !\?>)>
<REPEAT ()
<TELL "|>">
<COND (T ;<OR <CHECK-EXTENDED? XZIP>
<CHECK-EXTENDED? YZIP>>
<PUTB ,YES-INBUF 1 0>)>
<ZREAD ,YES-INBUF ,YES-LEXV>
<COND (<AND <NOT <0? <GETB ,YES-LEXV ,P-LEXWORDS>>>
<SET WORD <ZGET ,YES-LEXV ,P-LEXSTART>>>
<COND (<COMPARE-WORD-TYPES
<WORD-CLASSIFICATION-NUMBER .WORD>
<GET-CLASSIFICATION VERB>>
<SET VAL <WORD-VERB-STUFF .WORD>>)
(T <SET VAL <>>)>
<COND (<EQUAL? .VAL ,ACT?YES>
<SET VAL T>
<RETURN>)
(<OR <EQUAL? .VAL ,ACT?NO>
<EQUAL? .WORD ,W?N>>
<SET VAL <>>
<RETURN>)
(<EQUAL? .VAL ,ACT?RESTART>
<V-RESTART>)
(<EQUAL? .VAL ,ACT?RESTORE>
<V-RESTORE>)
(<EQUAL? .VAL ,ACT?QUIT>
<V-QUIT>)>)>
<TELL "[Please type YES or NO.]">>
.VAL>>
<DEFAULT-DEFINITION SETUP-ORPHAN
<DEFINE SETUP-ORPHAN (STR "OPT" (A <>) (B <>))
<DIROUT ,D-TABLE-ON ,O-INBUF>
<TELL .STR>
<COND (<T? .A>
<COND (<OBJECT? .A>
<TELL D .A>)
(T <TELL .A>)>
<COND (<T? .B>
<COND (<OBJECT? .B>
<TELL D .B>)
(T <TELL .B>)>)>)>
;<PRINTC 0> ;"Some ZIPs might need this."
<DIROUT ,D-TABLE-OFF>
<PUTB ,O-INBUF 0 ,INBUF-LENGTH>
<LEX ,O-INBUF ,O-LEXV>
<COND (<ZERO? <SET A <GETB ,O-LEXV ,P-LEXWORDS>>> ;"any words?"
<>)
(<INTBL? 0 <ZREST ,O-LEXV <* 2 ,P-LEXSTART>> .A *204*>
;"any unknown words?"
<>)
(T
<SETG P-OFLAG <+ 1 <* ,P-LEXELEN <GETB ,O-LEXV ,P-LEXWORDS>>>>
<MAKE-ROOM-FOR-TOKENS 1 ,O-LEXV ,P-OFLAG>
<ZPUT ,O-LEXV ,P-OFLAG ,W?NO.WORD ;0>
<SETG P-OFLAG <- 0 ,P-OFLAG>> ;"for verbose response"
<ZPUT ,OOPS-TABLE ,O-AGAIN ;,O-START
<ZREST ,P-LEXV <* 2 ,P-LEXSTART>>>
T)>>>
<DEFAULT-DEFINITION SETUP-ORPHAN-NP
;"<SYNTAX SWG = V-SWG>
<DEFINE V-SWG ()
<COND (<SETUP-ORPHAN-NP 'take frob' ,RED-FROB ,GREEN-FROB>
<TELL 'Which frob do you want?' CR>)
(T <TELL 'Nope.' CR>)>>"
<DEFINE SETUP-ORPHAN-NP (STR OBJ1 OBJ2 "OPT" (OBJ3 <>) "AUX" (NUM 2)
(VEC <REST-TO-SLOT ,ORPHAN-SR FIND-RES-OBJ1>))
<DIROUT ,D-TABLE-ON ,O-INBUF>
<TELL .STR>
;<PRINTC 0> ;"Some ZIPs might need this."
<DIROUT ,D-TABLE-OFF>
<PUTB ,O-INBUF 0 ,INBUF-LENGTH>
<LEX ,O-INBUF ,O-LEXV>
<COND (<INTBL? 0 <ZREST ,O-LEXV <* 2 ,P-LEXSTART>>
<GETB ,O-LEXV ,P-LEXWORDS>
*204*> ;"any unknown words?"
<>)
(T
<SETG P-OFLAG <- 1 <* ,P-LEXELEN <GETB ,O-LEXV ,P-LEXWORDS>>>>
<ZPUT ,OOPS-TABLE ,O-START <ZREST ,P-LEXV <* 2 ,P-LEXSTART>>>
<ZPUT .VEC 0 .OBJ1>
<ZPUT .VEC 1 .OBJ2>
<COND (<T? .OBJ3>
<INC NUM>
<ZPUT .VEC 2 .OBJ3>)>
<FIND-RES-COUNT ,ORPHAN-SR .NUM>
T)>>>
<DEFINE INSERT-ADJS (E "AUX" CT (PTR <ABS ,P-OFLAG>))
<COND (<NOT <EQUAL? .E <> T>>
<COND (<SET CT <ADJS-POSS .E>>
<COND (<PMEM? .CT>
<SET CT <NP-NAME .CT>>)
(T
<SET CT <ZGET <GETPT .CT ,P?SYNONYM> 0>>)>
<IFFLAG (P-APOSTROPHE-BREAKS-WORDS
<SET PTR <INSERT-ADJS-WD .PTR .CT>>
<SET PTR <INSERT-ADJS-WD .PTR ,W?APOSTROPHE>>
<SET PTR <INSERT-ADJS-WD .PTR ,W?S>>)
(T ;"Find next word in vocabulary."
<SET CT <+ .CT <GETB <ZREST ,VOCAB
<+ 1 <GETB ,VOCAB 0>>>
0>>>
<COND (T ;<BAND ,POSSESSIVE <WORD-FLAGS .CT>>
<SET PTR <INSERT-ADJS-WD .PTR .CT>>)>)>)>
<COND (<SET CT <ADJS-COUNT .E>>
<SET E <REST-TO-SLOT .E ADJS-COUNT 1>>
<REPEAT (WD)
<COND (<DLESS? CT 0>
<RETURN>)
(<EQUAL? <SET WD <ZGET .E .CT>>
<ZGET ,ERROR-ARGS 3>> ;"e.g. OPEN"
<AGAIN>)>
<SET PTR <INSERT-ADJS-WD .PTR .WD>>>)>)>>
<DEFINE INSERT-ADJS-WD (PTR WD)
<MAKE-ROOM-FOR-TOKENS 1 ,G-LEXV .PTR>
<ZPUT ,G-LEXV .PTR .WD>
<SET PTR <+ .PTR ,P-LEXELEN>>
<INBUF-PRINT .WD ,G-INBUF ,G-LEXV <- <* 2 .PTR> 1>>
.PTR>
<DEFAULT-DEFINITION PARSER-REPORT
<DEFINE PARSER-REPORT ()
<PRINTI "[Parser used: ">
<PRINTN <* 2 <- ,PMEM-STORE-LENGTH ,PMEM-STORE-WARN>>>
<PARSER-REPORT-STACK ,STATE-STACK>
<PARSER-REPORT-STACK ,DATA-STACK>
<PRINTC !\+>
<REPEAT ((PTR <ZREST ,SPLIT-STACK 2>) (N <- ,MAX-PSTACK-SIZE 1>))
<COND (<SET PTR <INTBL? 0 .PTR .N>>
<COND (<AND <0? <ZGET .PTR 1>>
<0? <ZGET .PTR 2>>>
<PRINTN <- .PTR <ZREST ,SPLIT-STACK 2>>>
<RETURN>)
(T
<SET PTR <ZREST .PTR 2>>
<SET N <+ -1 <- ,MAX-PSTACK-SIZE
</ <- .PTR ,SPLIT-STACK> 2>>>>)>)
(T
<PRINTN <* 2 <- ,MAX-PSTACK-SIZE 1>>>
<RETURN>)>>
<PRINTI " bytes.]">
<CRLF>>
<DEFINE PARSER-REPORT-STACK (STK "AUX" N)
<PRINTC !\+>
<SET N ,MAX-PSTACK-SIZE>
<REPEAT ()
<COND (<OR <DLESS? N 1>
<0? <ZGET .STK .N>>>
<PRINTN <* 2 <- <- ,MAX-PSTACK-SIZE .N> 1>>>
<RTRUE>)>>>>
<END-SEGMENT>
<ENDPACKAGE>

158
prologue.zabstr Normal file
View File

@ -0,0 +1,158 @@
<GLOBAL DEMO-VERSION? <>>
<BEGIN-SEGMENT STARTUP>
<DEFINE-ROUTINE SETUP-SCREEN>
<DEFINE-ROUTINE GO>
<DEFINE-ROUTINE CLEAR-CRCNT>
<CONSTANT SLIDE-SHOW-TIMEOUT 150>
<CONSTANT DEMO-TIMEOUT 600>
<DEFINE-ROUTINE SLIDE-SHOW-HANDLER>
<DEFINE-ROUTINE SLIDE-SHOW>
<DEFINE-ROUTINE READ-DEMO>
<DEFINE-ROUTINE INPUT-DEMO>
<DEFINE-ROUTINE END-DEMO>
<OBJECT RECIPE (DESC "recipe card") (SYNONYM RECIPE CARD) (ADJECTIVE RECIPE) (
FLAGS TAKEBIT READBIT) (SIZE 1) (TEXT BORPHBELLY-TEXT)>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT BANQUET-FOOD (LOC GLOBAL-OBJECTS) (DESC "banquet meal") (SYNONYM FOOD
WINE) (ACTION BANQUET-FOOD-F)>
<DEFINE-ROUTINE BANQUET-FOOD-F>
<ROOM BANQUET-HALL (LOC ROOMS) (DESC "Banquet Hall") (REGION "Flatheadia") (
WEST TO ENTRANCE-HALL) (SOUTH TO COURTYARD) (EAST TO KITCHEN) (NE TO SCULLERY)
(FLAGS RLANDBIT ONBIT) (SYNONYM HALL) (ADJECTIVE BANQUET) (MAP-LOC <PTABLE
MAIN-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-6>) (ICON BANQUET-HALL-ICON) (GLOBAL KITCHEN
SCULLERY) (ACTION BANQUET-HALL-F) (THINGS <> SMOKE SMOKE-PS <> VAPOR SMOKE-PS)>
<DEFINE-ROUTINE SMOKE-PS>
<DEFINE-ROUTINE BANQUET-HALL-F>
<ROOM KITCHEN (LOC ROOMS) (DESC "Kitchen") (REGION "Flatheadia") (WEST TO
BANQUET-HALL) (NORTH TO SCULLERY) (DOWN TO ROOT-CELLAR) (FLAGS RLANDBIT ONBIT)
(SYNONYM KITCHEN) (GLOBAL STAIRS BANQUET-HALL SCULLERY) (MAP-LOC <PTABLE
MAIN-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-7>) (ICON KITCHEN-ICON) (ACTION KITCHEN-F)>
<DEFINE-ROUTINE KITCHEN-F>
<ROOM SCULLERY (LOC ROOMS) (DESC "Scullery") (REGION "Flatheadia") (SOUTH TO
KITCHEN) (SW TO BANQUET-HALL) (DOWN TO WINE-CELLAR) (FLAGS RLANDBIT ONBIT) (
SYNONYM SCULLERY) (GLOBAL STAIRS KITCHEN BANQUET-HALL) (MAP-LOC <PTABLE
MAIN-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-7>) (ACTION SCULLERY-F)>
<DEFINE-ROUTINE SCULLERY-F>
<BEGIN-SEGMENT 0>
<OBJECT STRAW (DESC "drinking straw") (SYNONYM STRAW) (ADJECTIVE DRINKING) (
FLAGS TAKEBIT) (SIZE 1) (ACTION STRAW-F)>
<DEFINE-ROUTINE STRAW-F>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<DEFINE-ROUTINE TOUCH-ELIXIR>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<GLOBAL FINGER-ON-STRAW <>>
<GLOBAL ELIXIR-TRAPPED <>>
<DEFINE-ROUTINE I-FINGER-OFF-STRAW>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<ROOM ROOT-CELLAR (LOC ROOMS) (DESC "Root Cellar") (REGION "Flatheadia") (LDESC
"This is where food is stored. A stair leads up, and another part of
the cellar lies to the north.") (UP TO KITCHEN) (NORTH TO WINE-CELLAR) (FLAGS
RLANDBIT ONBIT) (SYNONYM CELLAR) (ADJECTIVE ROOT) (GLOBAL STAIRS) (MAP-LOC <
PTABLE MAIN-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-8>)>
<BEGIN-SEGMENT 0>
<OBJECT UNOPENED-NUT (DESC "unopened walnut") (FDESC
"The cellar has been picked clean by the fleeing thousands -- but wait, what's
this in the corner? Ah, an unopened walnut!") (SYNONYM SHELL NUTSHELL WALNUT
NUT) (ADJECTIVE WALNUT UNOPENED) (FLAGS VOWELBIT TAKEBIT CONTBIT SEARCHBIT) (
SIZE 2) (ACTION UNOPENED-NUT-F)>
<DEFINE-ROUTINE UNOPENED-NUT-F>
<OBJECT NUT-SHELL (DESC "walnut shell") (SYNONYM SHELL NUTSHELL) (ADJECTIVE
WALNUT) (FLAGS TAKEBIT SEARCHBIT CONTBIT OPENBIT) (SIZE 1) (ACTION NUT-SHELL-F)
>
<DEFINE-ROUTINE NUT-SHELL-F>
<OBJECT NUT (LOC UNOPENED-NUT) (DESC "walnut") (SYNONYM WALNUT NUT) (FLAGS
TAKEBIT) (SIZE 1) (ACTION NUT-F)>
<DEFINE-ROUTINE NUT-F>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<ROOM WINE-CELLAR (LOC ROOMS) (DESC "Wine Cellar") (REGION "Flatheadia") (LDESC
"Every keg has been removed, and the floor is mottled with purple stains.
Stone stairs lead upward, and the cellar continues to the south.") (SOUTH TO
ROOT-CELLAR) (UP TO SCULLERY) (FLAGS RLANDBIT ONBIT) (SYNONYM CELLAR) (
ADJECTIVE WINE) (GLOBAL STAIRS) (MAP-LOC <PTABLE MAIN-MAP-NUM MAP-GEN-Y-2
MAP-GEN-X-8>) (ICON WINE-CELLAR-ICON)>
<BEGIN-SEGMENT STARTUP>
<GLOBAL PROLOGUE-COUNTER 0>
<GLOBAL PROLOGUE-NOVICE-COUNTER 1>
<CONSTANT NOVICE-MOVES <PTABLE "wait" "go northeast" "walk south" "go west"
"walk east" "enter the banquet hall" "examine the gaunt man"
"dive under the table" "get out from under the table"
"pick up the scrap of parchment" "north" "southeast">>
<DEFINE-ROUTINE I-PROLOGUE>
<DEFINE-ROUTINE I-TAKE-OBJECT>
<DEFINE-ROUTINE I-GIVE-OBJECT>
<OBJECT HELLHOUND-BONES (OWNER HELLHOUND-BONES) (DESC
"platter of hellhound bones") (SYNONYM BONES PLATTER) (ADJECTIVE HELLHOUND) (
FLAGS TAKEBIT) (ACTION SERVANT-ITEM-F)>
<OBJECT ROC-TERIYAKI (OWNER ROC-TERIYAKI) (DESC "tray of roc teriyaki") (
SYNONYM TERIYAKI TRAY APPETIZER) (ADJECTIVE ROC) (FLAGS TAKEBIT) (ACTION
SERVANT-ITEM-F)>
<OBJECT CAKE (DESC "cake") (SYNONYM CAKE) (FLAGS TAKEBIT) (ACTION
SERVANT-ITEM-F)>
<OBJECT KEG (DESC "wine keg") (SYNONYM KEG WINE) (ADJECTIVE WINE) (FLAGS
TAKEBIT) (ACTION SERVANT-ITEM-F)>
<OBJECT LINEN (DESC "pile of napkins") (OWNER LINEN) (SYNONYM PILE NAPKINS
LINEN) (ADJECTIVE MONOGRAMMED) (FLAGS TAKEBIT READBIT) (TEXT
"The napkin is embroidered with a large, flowery \"F.\"") (ACTION
SERVANT-ITEM-F)>
<DEFINE-ROUTINE SERVANT-ITEM-F>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<OBJECT PARCHMENT (OWNER PARCHMENT) (DESC "scrap of parchment") (PLURAL
"parchments") (SYNONYM PAPER SCRAP PIECE PARCHMENT) (ADJECTIVE PARCHMENT) (
FLAGS NDESCBIT READBIT TAKEBIT BURNBIT) (SIZE 1) (ACTION PARCHMENT-F)>
<DEFINE-ROUTINE PARCHMENT-F>
<OBJECT DIMWIT (LOC BANQUET-HALL) (DESC "Lord Dimwit Flathead the Excessive") (
LDESC "Dimwit is seated at the dais, surrounded by his most trusted advisors.")
(SYNONYM FLATHEAD DIMWIT) (ADJECTIVE LORD DIMWIT EXCESSIVE) (FLAGS NARTICLEBIT
NDESCBIT ACTORBIT CONTBIT OPENBIT SEARCHBIT) (GENERIC G-DIMWIT-F) (ACTION
DIMWIT-F)>
<DEFINE-ROUTINE DIMWIT-F>
<DEFINE-ROUTINE G-DIMWIT-F>
<END-SEGMENT>
<BEGIN-SEGMENT STARTUP>
<OBJECT TABLES (LOC BANQUET-HALL) (DESC "table") (SYNONYM TABLE TABLES) (FLAGS
NDESCBIT SURFACEBIT CONTBIT OPENBIT) (CAPACITY 100) (ACTION TABLES-F)>
<GLOBAL UNDER-TABLE <>>
<DEFINE-ROUTINE TABLES-F>
<END-SEGMENT>
<BEGIN-SEGMENT CASTLE>
<OBJECT CAULDRON (DESC "cauldron") (SYNONYM CAULDRON KETTLE) (ADJECTIVE
BUBBLING ROILING FUMING) (FLAGS CONTBIT OPENBIT) (ACTION CAULDRON-F)>
<DEFINE-ROUTINE CAULDRON-F>
<DEFINE-ROUTINE PUT-ITEM-IN-CAULDRON>
<GLOBAL CAULDRON-MUNGED <>>
<GLOBAL TIME-STOPPED <>>
<GLOBAL NUMBER-OF-ITEMS 0>
<CONSTANT CAULDRON-DESCS <PTABLE "barely bubbling" "bubbling quietly"
"bubbling actively" "bubbling very actively" "bubbling and churning"
"bubbling, churning, and smoking heavily"
"churning actively and emitting large puffs of smoke"
"violently churning and emitting huge puffs of dark smoke"
"churning very violently and giving off clouds of black smoke"
"churning and roiling beneath a whirlpool of thick black smoke"
"boiling violently beneath a gathering storm of noisome smoke"
"boiling with amazing energy, sending steaming geysers shooting
up into the roiling black clouds which swirl around it"
"almost lost amongst the clouds of dark power and energy which
surround the kettle, glowing and expanding from explosions deep within">>
<DEFINE-ROUTINE I-CAULDRON>
<END-SEGMENT>
<BEGIN-SEGMENT STARTUP>
<OBJECT MEGABOZ (DESC "angry wizard") (DESCFCN MEGABOZ-F) (SYNONYM WIZARD
MEGABOZ MAN) (ADJECTIVE GAUNT OLD ANGRY) (FLAGS VOWELBIT ACTORBIT CONTBIT
OPENBIT SEARCHBIT) (ACTION MEGABOZ-F)>
<DEFINE-ROUTINE MEGABOZ-F>
<BEGIN-SEGMENT CASTLE>
<CONSTANT MEGABOZ-TEXT
"Megaboz was a mysterious wizard who lived a hermit's life in the Fublio
Valley. Some say he cast a Curse which will someday destroy the Empire, but
royal spokesmen have denied all such rumors. Megaboz vanished in 789 GUE;
it is said that the effort of casting the Curse destroyed him.">
<END-SEGMENT>

862
prologue.zap Normal file
View File

@ -0,0 +1,862 @@
.SEGMENT "STARTUP"
.FUNCT SETUP-SCREEN,?TMP1
GETB 0,39 >FONT-X
GETB 0,38 >FONT-Y
MOUSE-LIMIT -1
GET 0,8
BTST STACK,32 \?CND1
SET 'ACTIVE-MOUSE,TRUE-VALUE
?CND1: GET 0,18 >?TMP1
GET 0,17
WINSIZE S-FULL,?TMP1,STACK
GETB 0,33 >WIDTH
RETURN WIDTH
.FUNCT GO
?FCN: ICALL1 SETUP-SCREEN
SET 'TOWER-BEATEN,PYRAMID
SET 'CLOAK-LOC,CLOTHES-CLOSET
ZERO? DEMO-VERSION? /?CND1
RANDOM 7
SUB STACK,1
GET SLAB-TABLE,STACK >HOLEY-SLAB
ICALL1 SLIDE-SHOW
JUMP ?FCN
?CND1: SET 'CURRENT-SPLIT,TEXT-WINDOW-PIC-LOC
SET 'CURRENT-BORDER,CASTLE-BORDER
ICALL QUEUE,I-GIVE-OBJECT,-1
ICALL QUEUE,I-PROLOGUE,-1
ICALL QUEUE,I-TAKE-OBJECT,-1
ICALL1 V-$REFRESH
CRLF
ICALL2 MARGINAL-PIC,PROLOGUE-LETTER
DIROUT D-SCREEN-OFF
PRINTC 65
DIROUT D-SCREEN-ON
PRINTI "nother frantic day at the castle; Lord Dimwit Flathead the Excessive has invited a few thousand friends over for dinner. Three hundred dragons have been slaughtered for the occasion, and the kitchen is suffocated by the stench of their roasting flesh."
CRLF
ICALL1 CLEAR-CRCNT
CRLF
ICALL1 V-LOOK
ICALL1 I-PROLOGUE
ICALL1 I-GIVE-OBJECT
ICALL1 MAIN-LOOP
JUMP ?FCN
.FUNCT CLEAR-CRCNT,NUM
WINGET S-TEXT,WCRCNT >NUM
?PRG1: ZERO? NUM /TRUE
CRLF
DEC 'NUM
JUMP ?PRG1
.FUNCT SLIDE-SHOW-HANDLER
SET 'DEMO-VERSION?,1
RTRUE
.FUNCT SLIDE-SHOW,RM,?TMP1
GET 0,18 >?TMP1
GET 0,17
WINSIZE S-TEXT,?TMP1,STACK
ICALL1 TITLE-SCREEN
INPUT 1,SLIDE-SHOW-TIMEOUT,SLIDE-SHOW-HANDLER
CLEAR -1
PRINTI "This is a demonstration version of ZORK ZERO: The Revenge of Megaboz
Copyright (c) 1988 by Infocom, Inc. All rights reserved.
First you will see a few samples of the graphic screens that await you in ZORK ZERO. We've used graphics in surprising new ways to enhance the story without detracting from Infocom's traditional richness and depth.
Then you will be able to interact with a small section of ZORK ZERO. Feel free to try the new friendlier parser, the optional mouse interface, and the on-screen hints. Solve a couple of puzzles. Meet the quizzical jester, who will test you with games, riddles, or tricks.
ZORK ZERO is the ""prequel"" to the ZORK trilogy, the best-selling computer entertainment of all time. In ZORK ZERO the Great Underground Empire is in its heyday, and no adventurer has yet set foot in the ""open field west of a white house."" But the inhabitants are fleeing in the wake of a dread wizard's curse, which has already disposed of the royal Flathead family and threatens to destroy the entire kingdom -- unless you can stop it. Hit any key to begin..."
INPUT 1,DEMO-TIMEOUT,SLIDE-SHOW-HANDLER
CLEAR -1
ICALL PICTURED-ENTRY,MEGABOZ-ILL,MEGABOZ-TEXT,TRUE-VALUE
SCREEN S-FULL
CURSET 1,1
INPUT 1,SLIDE-SHOW-TIMEOUT,SLIDE-SHOW-HANDLER
CLEAR -1
SCREEN S-FULL
DISPLAY REBUS-1,1,1
INPUT 1,SLIDE-SHOW-TIMEOUT,SLIDE-SHOW-HANDLER
CLEAR -1
FIRST? ROOMS >RM /?PRG2
?PRG2: ZERO? RM /?REP3
GETP RM,P?MAP-LOC
GET STACK,0
EQUAL? FOOZLE-MAP-NUM,STACK \?CND4
FSET RM,TOUCHBIT
?CND4: NEXT? RM >RM /?PRG2
JUMP ?PRG2
?REP3: SET 'HERE,CROSSROADS
SET 'MAP-NOTE,TRUE-VALUE
ICALL1 DO-MAP
INPUT 1,SLIDE-SHOW-TIMEOUT,SLIDE-SHOW-HANDLER
CLEAR -1
ICALL1 SETUP-CARDS
PUT F-CARD-TABLE,0,7
PUT F-CARD-TABLE,1,10
PUT F-CARD-TABLE,2,16
PUT F-CARD-TABLE,4,11
PUT F-CARD-TABLE,5,15
PUT F-CARD-TABLE,6,0
PUT F-CARD-TABLE,8,8
PUT F-CARD-TABLE,9,5
ICALL1 SETUP-FANUCCI
SCREEN S-FULL
CURSET 1,1
INPUT 1,SLIDE-SHOW-TIMEOUT,SLIDE-SHOW-HANDLER
CLEAR -1
SET 'CURRENT-SPLIT,TEXT-WINDOW-PIC-LOC
SET 'CURRENT-BORDER,CASTLE-BORDER
ICALL1 V-$REFRESH
PRINTI "Now you are welcome to interact with a demonstration version of
"
ICALL1 V-VERSION
CRLF
MOVE DIRIGIBLE,SMALLER-HANGAR
PUTP GONDOLA,P?REGION,STR?249
MOVE RECIPE,RUINED-HALL
PUTP ROOSTER,P?FDESC,0
MOVE ROOSTER,DESERTED-CASTLE
PUTP DESERTED-CASTLE,P?ACTION,DESERTED-CASTLE-F
PUTP FOX,P?FDESC,0
MOVE FOX,SMALLER-HANGAR
PUTP SMALLER-HANGAR,P?ACTION,SMALLER-HANGAR-F
MOVE WORM,HOTHOUSE
WINPUT S-TEXT,15,-999
SET 'PROLOGUE-NOVICE-COUNTER,0
ICALL2 GOTO,RUINED-HALL
CALL1 MAIN-LOOP
RSTACK
.FUNCT READ-DEMO,ARG1,ARG2,CHR
SET 'DEMO-VERSION?,-1
READ ARG1,ARG2,DEMO-TIMEOUT,SLIDE-SHOW-HANDLER >CHR
EQUAL? DEMO-VERSION?,1 \?CCL4
CALL1 END-DEMO
RSTACK
?CCL4: WINPUT S-TEXT,15,-999
RETURN CHR
.FUNCT INPUT-DEMO,ARG,CHR
SET 'DEMO-VERSION?,-1
INPUT ARG,DEMO-TIMEOUT,SLIDE-SHOW-HANDLER >CHR
EQUAL? DEMO-VERSION?,1 \?CCL4
CALL1 END-DEMO
RSTACK
?CCL4: WINPUT S-TEXT,15,-999
RETURN CHR
.FUNCT END-DEMO
?FCN: CLEAR -1
PRINTI "
You have reached the end of this demonstration version of
"
ICALL1 V-VERSION
PRINTI "
Hit any key to start over..."
INPUT 1,SLIDE-SHOW-TIMEOUT,SLIDE-SHOW-HANDLER
SCREEN S-TEXT
COLOR 1,1
RESTART
PRINT FAILED
JUMP ?FCN
.ENDSEG
.SEGMENT "CASTLE"
.FUNCT BANQUET-FOOD-F
EQUAL? PRSA,V?TASTE,V?DRINK,V?EAT /?CCL3
EQUAL? PRSA,V?TAKE,V?TOUCH \FALSE
?CCL3: PRINTR "The food and drink is for the guests, not the servants."
.FUNCT SMOKE-PS
EQUAL? PRSA,V?SMELL \?CCL3
ICALL PERFORM,V?SMELL,CAULDRON
RTRUE
?CCL3: EQUAL? PRSA,V?ENTER \?CCL5
PRINTR """Choke, choke, cough, cough."""
?CCL5: EQUAL? PRSA,V?PUT \FALSE
EQUAL? PRSO,HANDS \FALSE
PRINT NOTHING-HAPPENS
RTRUE
.FUNCT BANQUET-HALL-F,RARG
EQUAL? RARG,M-LOOK \FALSE
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK /?CCL6
PRINTI "The hall is filled to capacity, and the thousands of reveling guests are raising quite a din"
JUMP ?CND4
?CCL6: PRINTI "Many royal feasts have been held in this hall, which could easily hold ten thousand guests. Legends say that Dimwit's more excessive banquets would require the combined farm outputs of three provinces"
?CND4: PRINTI ". The primary exits are to the west and south; smaller openings lead east and northeast."
RTRUE
.FUNCT KITCHEN-F,RARG
EQUAL? RARG,M-LOOK \FALSE
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK /?CCL6
PRINTI "You are assaulted by waves of greasy odors and buffetted by mobs of bustling cooks and servants"
JUMP ?CND4
?CCL6: PRINTI "Although this is the largest cooking area in the Empire, it must've still been crowded when all 600 of Dimwit's chefs were working at the same time"
?CND4: PRINTI ". There are passages to the west and north, and a stair leads downward"
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK \?CND7
PRINTI " into darkness"
?CND7: PRINTC 46
RTRUE
.FUNCT SCULLERY-F,RARG
EQUAL? RARG,M-LOOK \FALSE
PRINTI "This is where the castle's pots and pans, the output of the forges of Borphee for three years, are cleaned and stored. Passages open to the south and southwest, and a stair descends"
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK \?CND4
PRINTI " into darkness"
?CND4: PRINTC 46
RTRUE
.SEGMENT "0"
.FUNCT STRAW-F
EQUAL? PRSA,V?LOOK-INSIDE \?CCL3
IN? STRAW,BOWL \?CCL6
PRINT ONLY-BLACKNESS
RTRUE
?CCL6: PRINTR "You see a point of light: the far end of the straw."
?CCL3: EQUAL? PRSA,V?SUCK-WITH \?CCL8
EQUAL? PRSI,STRAW \?CCL8
ICALL PERFORM,V?DRINK-WITH,PRSO,STRAW
RTRUE
?CCL8: EQUAL? PRSA,V?SUCK-ON \?CCL12
SET 'FINGER-ON-STRAW,FALSE-VALUE
SET 'ELIXIR-TRAPPED,FALSE-VALUE
IN? STRAW,BOWL \?CCL15
ICALL PERFORM,V?DRINK-WITH,ELIXIR,STRAW
RTRUE
?CCL15: PRINTR "You suck some air through the straw."
?CCL12: EQUAL? PRSA,V?INFLATE \?CCL17
SET 'FINGER-ON-STRAW,FALSE-VALUE
SET 'ELIXIR-TRAPPED,FALSE-VALUE
PRINTI "Air "
IN? STRAW,BOWL \?CCL20
PRINTI "bubbles up through the elixir"
JUMP ?CND18
?CCL20: PRINTI "blows out the far end of the straw"
?CND18: PRINTR ". Wow."
?CCL17: EQUAL? PRSA,V?TAKE \FALSE
ZERO? FINGER-ON-STRAW /FALSE
ZERO? ELIXIR-TRAPPED /FALSE
IN? STRAW,BOWL \FALSE
SET 'FINGER-ON-STRAW,FALSE-VALUE
SET 'ELIXIR-TRAPPED,FALSE-VALUE
MOVE STRAW,PROTAGONIST
PRINTI "As you lift the straw with your finger over the end of it, the elixir within is trapped. Then the suction breaks, and the elixir dribbles onto you. "
CALL1 TOUCH-ELIXIR
RSTACK
.ENDSEG
.SEGMENT "LAKE"
.FUNCT TOUCH-ELIXIR
PRINTI "The liquid feels warm and cleansing."
FSET? LARGE-FLY,TRYTAKEBIT \?CCL3
FCLEAR LARGE-FLY,TRYTAKEBIT
FCLEAR LARGER-FLY,TRYTAKEBIT
FCLEAR EVEN-LARGER-FLY,TRYTAKEBIT
FCLEAR LARGEST-FLY,TRYTAKEBIT
PRINTI " You experience a wave of ecstasy, accompanied by a brief desire to spin a cocoon, collect sap, and eat animal excrement."
CRLF
CALL2 INC-SCORE,16
RSTACK
?CCL3: CRLF
RTRUE
.ENDSEG
.SEGMENT "0"
.FUNCT I-FINGER-OFF-STRAW,TOLD
ZERO? FINGER-ON-STRAW /?CND1
CALL2 VISIBLE?,STRAW
ZERO? STACK /?CND1
ICALL1 RETURN-FROM-MAP
SET 'TOLD,TRUE-VALUE
PRINTI " Your finger gets tired, so you remove it from the end of the straw."
CRLF
?CND1: SET 'FINGER-ON-STRAW,FALSE-VALUE
SET 'ELIXIR-TRAPPED,FALSE-VALUE
ZERO? TOLD \TRUE
RFALSE
.ENDSEG
.SEGMENT "0"
.SEGMENT "CASTLE"
.FUNCT UNOPENED-NUT-F
EQUAL? PRSA,V?SHAKE \?CCL3
PRINTR "A nut rattles around within."
?CCL3: EQUAL? PRSA,V?OPEN \?CCL5
EQUAL? PRSI,HAMMER \?CCL5
ICALL PERFORM,V?MUNG,PRSO,HAMMER
RTRUE
?CCL5: EQUAL? PRSA,V?MUNG,V?LOOK-INSIDE,V?OPEN /?PRD11
EQUAL? PRSA,V?KILL \?CCL9
?PRD11: EQUAL? PRSO,UNOPENED-NUT \?CCL9
EQUAL? PRSA,V?EXAMINE,V?LOOK-INSIDE \?CCL16
FSET? GOGGLES,WORNBIT \?CCL16
ICALL PERFORM,V?LOOK-INSIDE,NUT-SHELL
RTRUE
?CCL16: ZERO? PRSI \?CCL20
PRINTI "This is one tough shell. You can't seem to crack it with your "
ZERO? ALLIGATOR /?CCL23
PRINTI "paws"
JUMP ?CND21
?CCL23: PRINTI "hands"
?CND21: PRINT PERIOD-CR
RTRUE
?CCL20: EQUAL? PRSI,LOBSTER \?CCL25
FSET? PRSI,ANIMATEDBIT /?CCL25
CALL2 VISIBLE?,JESTER
ZERO? STACK /?CND28
PRINTI "The jester watches with interest. "
SET 'NUT-OPENED,TRUE-VALUE
?CND28: LOC UNOPENED-NUT
MOVE NUT-SHELL,STACK
MOVE NUT,NUT-SHELL
ICALL2 THIS-IS-IT,NUT
REMOVE UNOPENED-NUT
PRINTR """Crack!"" Opening the walnut shell reveals a walnut."
?CCL25: EQUAL? PRSA,V?KILL,V?MUNG \?CCL31
GETP PRSI,P?SIZE
GRTR? STACK,15 \?CCL31
REMOVE UNOPENED-NUT
PRINTR "This succeeds in crushing the shell (and its contents) to dust."
?CCL31: PRINT YOU-CANT
PRINTI "open a nutshell with"
CALL2 ARPRINT,PRSI
RSTACK
?CCL9: EQUAL? PRSA,V?PUT-ON \?CCL35
EQUAL? PRSI,UNOPENED-NUT \?CCL35
GETP PRSO,P?SIZE
GRTR? STACK,14 \?CCL35
ICALL PERFORM,V?MUNG,UNOPENED-NUT,PRSO
RTRUE
?CCL35: EQUAL? PRSA,V?STAND-ON \FALSE
FSET? UNOPENED-NUT,OPENBIT /FALSE
PRINTR "Even your full weight is insufficient to crack the shell (you lightweight you)."
.FUNCT NUT-SHELL-F
EQUAL? PRSA,V?CLOSE \FALSE
PRINT YOU-CANT
PRINTR "reclose the shell! Don't fret, though. Instead, remember that old Miznian proverb: ""It's no use crying over cracked nutshells."""
.FUNCT NUT-F
EQUAL? PRSA,V?EAT \FALSE
REMOVE NUT
CALL2 VISIBLE?,JESTER
ZERO? STACK /?CCL6
ZERO? NUT-SHOWN /?CCL9
SET 'NUT-EATEN,TRUE-VALUE
PRINTI """I'm very impressed; you passed my test! When you exit from the West Wing, I'll no longer be molesting."""
ICALL1 J-EXITS
CALL2 INC-SCORE,20
RSTACK
?CCL9: PRINTR "You swallow the walnut. ""I guess you don't win, place, or show!"" comments the jester enigmatically."
?CCL6: PRINTR "The walnut is tasty, but hardly filling."
.ENDSEG
.SEGMENT "STARTUP"
.SEGMENT "CASTLE"
.FUNCT I-PROLOGUE
EQUAL? HERE,BANQUET-HALL \FALSE
INC 'PROLOGUE-COUNTER
ICALL1 RETURN-FROM-MAP
PRINTI " "
EQUAL? PROLOGUE-COUNTER,1 \?CCL5
FCLEAR DIMWIT,NDESCBIT
PRINTR "Dimwit is seated at the dais. His loud voice carries across the crowded hall. ""Now that the statue is done, we must do something ceremonial. I have it! A dedication! We'll give everyone in the kingdom a year off and invite them to the Fublio Valley..."""
?CCL5: EQUAL? PROLOGUE-COUNTER,2 \?CCL7
PRINTR "Dimwit is ranting at his advisors. ""There's not enough in the royal treasury to build my new continent, Lord Feepness? Then we'll increase the tax levy! It's only 98%! That still leaves two percent!""
""With all deference, your Lordship, people are refusing to pay even the 98%. Your decree, 'Anyone withholding payment shall be killed along with everyone they've ever met' simply isn't working. If you increase it to 100%, the people..."""
?CCL7: EQUAL? PROLOGUE-COUNTER,3 \?CCL9
ICALL2 DEQUEUE,I-TAKE-OBJECT
ICALL2 DEQUEUE,I-GIVE-OBJECT
MOVE MEGABOZ,HERE
SET 'PROLOGUE-NOVICE-COUNTER,6
PRINTR """How about this?"" shouts Dimwit with his mouth full of dragon meat. ""I'll adopt everyone in the kingdom... and then I'll announce that they've been naughty and I've cut off their allowance! It's inspired! Lord Feepness, draw up the proclam...""
Dimwit is interrupted by an explosion of billowing smoke in the center of the hall. A gaunt, bearded man strides forth from the smoke!"
?CCL9: EQUAL? PROLOGUE-COUNTER,4 \?CCL11
MOVE PARCHMENT,MEGABOZ
SET 'PROLOGUE-NOVICE-COUNTER,7
PRINTR """Show me the one responsible for the statue!"" bellows the newcomer. ""The statue that now darkens Fublio!"" Every head silently turns toward Dimwit, whose delight at the pyrotechnics is now tinged by fear. ""Go away,"" orders Dimwit, waving a shaky hand at the stranger. ""This is a private function.""
Ignoring the order, the newcomer paces forward, until he is standing almost next to you. A scrap of parchment protrudes from his pocket. ""My favorite grove of shade trees now lies beneath the toe of that cursed statue! No man, be he peasant or king, crosses Megaboz the Magnificent!"" He raises his arms, and every guest who knows how dangerous an angry wizard can be begins diving under the tables."
?CCL11: EQUAL? PROLOGUE-COUNTER,5 \?CCL13
PRINTI """Dimwit, thy kingship is a mockery of all worldly values! I curse your life! I curse your family! And I curse your Empire!"" Sheets of power begin spewing from his fingertips. ""Frobnitz! Frobnosia! Prob Fset Cond! Zmemqb Intbl Foo!"" As the last word is spoken, the wizard turns into a vast fireball which explodes outward, searing everything in its path"
ZERO? UNDER-TABLE \?CCL16
CALL2 JIGS-UP,STR?264
RSTACK
?CCL16: REMOVE MEGABOZ
FCLEAR PARCHMENT,NDESCBIT
MOVE PARCHMENT,HERE
MOVE CAULDRON,HERE
SET 'PROLOGUE-NOVICE-COUNTER,8
PRINTR ". Then, silence.
You slowly open your eyes, and where last you saw Megaboz, there now sits a huge black cauldron, bubbling and roiling and spewing noisome fumes. All eyes are transfixed on the incredible cauldron; you seem to be the only one who notices the parchment scrap which Megaboz has dropped on the stone floor, just beyond your reach."
?CCL13: EQUAL? PROLOGUE-COUNTER,6 \?CCL18
SET 'PROLOGUE-NOVICE-COUNTER,9
PRINTR "Many of the guests are burned and dying. This doesn't seem to bother Dimwit much, but he does seem concerned by the bubbling cauldron. He summons his court magicians, who huddle about the cauldron, sampling the brew, casting exploratory spells, studying the words of Megaboz's spell, and whispering among themselves.
Finally, they seem to reach an agreement. Combining their powers, the magicians chant a long and mysterious spell. Then, drained of energy, they turn to Dimwit."
?CCL18: EQUAL? PROLOGUE-COUNTER,7 \FALSE
PRINTI """We have done our best, your Lordship,"" begins the chief magician, ""but the spell of Megaboz is a mighty one indeed. We delayed its effects for 94 years, but after that time, this castle -- in fact, all the eastlands -- will be destroyed.""
Dimwit shrugs. ""Big deal! I won't be around in 94 years!""
""Truer than you think,"" continues the chief magician. ""There's more to the Curse. Lordship, you and your eleven siblings are doomed!""
""Doomed?"" whines Dimwit. ""As in dead? That's not fair! When?""
""Moonrise, perhaps a bit later..."" The king lurches suddenly and collapses onto his dinner. ""...perhaps a bit sooner.""
Dimwit's personal physician rushes to the stricken king, and then looks solemnly at the assembled guests. ""The king is dead!"""
CRLF
ICALL2 DEQUEUE,I-PROLOGUE
SET 'MOVES,0
SET 'CLOCK-WAIT,TRUE-VALUE
IN? PARCHMENT,PROTAGONIST \?CCL23
MOVE PARCHMENT,GREAT-HALL
JUMP ?CND21
?CCL23: REMOVE PARCHMENT
?CND21: ICALL1 STOP
ICALL2 ROB,PROTAGONIST
REMOVE DIMWIT
REMOVE HELLHOUND-BONES
REMOVE ROC-TERIYAKI
REMOVE CAKE
REMOVE KEG
REMOVE LINEN
MOVE UNOPENED-NUT,ROOT-CELLAR
MOVE STRAW,SCULLERY
MOVE CALENDAR,GREAT-HALL
MOVE PROCLAMATION,ENTRANCE-HALL
FCLEAR BANQUET-HALL,TOUCHBIT
FCLEAR SCULLERY,TOUCHBIT
FCLEAR KITCHEN,TOUCHBIT
FCLEAR ROOT-CELLAR,ONBIT
FCLEAR WINE-CELLAR,ONBIT
SET 'UNDER-TABLE,FALSE-VALUE
REMOVE TABLES
MOVE CROWN,TREASURE-CHEST
FSET CROWN,TAKEBIT
FCLEAR CROWN,NDESCBIT
MOVE ROBE,TRUNK
FSET ROBE,TAKEBIT
RANDOM 12
SUB STACK,1 >MID-NAME-NUM
RANDOM 2400 >DIAL-NUMBER
RANDOM 7
SUB STACK,1
GET SLAB-TABLE,STACK >HOLEY-SLAB
REMOVE BANQUET-FOOD
CRLF
CRLF
ICALL1 HIT-ANY-KEY
ICALL1 TITLE-SCREEN
INPUT 1
ICALL1 MOUSE-INPUT?
SET 'CURRENT-SPLIT,TEXT-WINDOW-PIC-LOC
ICALL1 V-$REFRESH
ICALL1 V-VERSION
HLIGHT H-BOLD
CRLF
PRINTI "94 YEARS LATER"
PRINT ELLIPSIS
HLIGHT H-NORMAL
ICALL2 MARGINAL-PIC,MAIN-LETTER
DIROUT D-SCREEN-OFF
PRINTC 89
DIROUT D-SCREEN-ON
PRINTI "ou awake on a hard stone floor, sorting the chaotic images from yesterday: thousands of Flatheadians fleeing the castle, the last of the royal guard attempting to hold off the looters, pathetic attempts by charlatans to forestall the Curse, and a rowdy party as the remaining peasants broke into the wine cellars"
PRINT ELLIPSIS
CALL2 GOTO,GREAT-HALL
RSTACK
.FUNCT I-TAKE-OBJECT
EQUAL? HERE,BANQUET-HALL \?CCL3
ICALL1 RETURN-FROM-MAP
IN? CAKE,PROTAGONIST \?CCL6
REMOVE CAKE
PRINTR " A head waiter relieves you of the huge cake and delivers it to Dimwit, who claps with delight at his huge private pastry."
?CCL6: IN? KEG,PROTAGONIST \FALSE
REMOVE KEG
PRINTR " A sommelier grabs the wine keg and bustles across the crowded hall."
?CCL3: EQUAL? HERE,KITCHEN \?CCL10
ICALL1 RETURN-FROM-MAP
IN? LINEN,PROTAGONIST \?CCL13
REMOVE LINEN
PRINTR " ""Finally,"" gasps one of the head servants, snatching the linen and dashing off."
?CCL13: IN? ROC-TERIYAKI,PROTAGONIST \FALSE
REMOVE ROC-TERIYAKI
PRINTR " A cook grabs the tray. ""Not well-done enough? Those slobs wouldn't know good roc teriyaki if it flew up and bit them on the..."" The rest of the cook's comment is lost amidst the din of the kitchen."
?CCL10: EQUAL? HERE,SCULLERY \FALSE
ICALL1 RETURN-FROM-MAP
IN? HELLHOUND-BONES,PROTAGONIST \FALSE
REMOVE HELLHOUND-BONES
PRINTR " A scrubwoman grabs the platter, dumps the bones down a chute, and tosses the platter into a scrub basin."
.FUNCT I-GIVE-OBJECT
ICALL1 RETURN-FROM-MAP
PRINTI " "
EQUAL? HERE,BANQUET-HALL \?CCL3
IN? HELLHOUND-BONES,PROTAGONIST \?CCL6
SET 'PROLOGUE-NOVICE-COUNTER,1
PRINTR """I thought I told you to take that platter into the scullery!"""
?CCL6: IN? ROC-TERIYAKI,PROTAGONIST \?CCL8
SET 'PROLOGUE-NOVICE-COUNTER,4
PRINTR """Well? Get that appetizer back to the kitchen!"""
?CCL8: IN? LINEN,PROTAGONIST \?CCL10
SET 'PROLOGUE-NOVICE-COUNTER,4
PRINTR "One of the other servants looks appalled and nods you eastward. ""Clean linen to the kitchen, imbecile!"""
?CCL10: FSET? HELLHOUND-BONES,TOUCHBIT \?CCL12
MOVE ROC-TERIYAKI,PROTAGONIST
SET 'PROLOGUE-NOVICE-COUNTER,4
PRINTR "A tray of roc teriyaki is dumped into your arms. ""This appetizer is undercooked! Bring it back to the kitchen!"" You are nudged eastward."
?CCL12: MOVE HELLHOUND-BONES,PROTAGONIST
FSET HELLHOUND-BONES,TOUCHBIT
ICALL2 THIS-IS-IT,HELLHOUND-BONES
SET 'PROLOGUE-NOVICE-COUNTER,1
PRINTR "Someone thrusts a platter of hellhound bones into your hands. ""Bring this to the scullery, servant!"" An insistent finger points northeast."
?CCL3: EQUAL? HERE,KITCHEN \?CCL14
IN? CAKE,PROTAGONIST /?CTR16
IN? KEG,PROTAGONIST \?CCL17
?CTR16: SET 'PROLOGUE-NOVICE-COUNTER,5
PRINTI """Why haven't you brought that "
IN? CAKE,PROTAGONIST \?CCL22
PRINTI "cake"
JUMP ?CND20
?CCL22: PRINTI "keg"
?CND20: PRINTR " out to the hall? The royal executioners are never too busy for an impudent servant..."""
?CCL17: IN? HELLHOUND-BONES,PROTAGONIST \?CCL24
SET 'PROLOGUE-NOVICE-COUNTER,10
PRINTR """No! No! No!"" someone is shouting at you. ""Garbage and soiled dishware to the scullery!"" A strong arm spins you around to the north."
?CCL24: FSET? CAKE,TOUCHBIT \?CCL26
SET 'PROLOGUE-NOVICE-COUNTER,5
MOVE KEG,PROTAGONIST
PRINTR "A wine steward bounds up the stairs and deposits a huge wine keg onto your shoulder. ""For the banquet hall!"" he calls over his shoulder."
?CCL26: FSET CAKE,TOUCHBIT
MOVE CAKE,PROTAGONIST
SET 'PROLOGUE-NOVICE-COUNTER,5
PRINTR "A baker gives you an enormous cake in the shape of Double Fanucci trebled fromps. ""To the king's table,"" he orders, aiming you westward."
?CCL14: EQUAL? HERE,SCULLERY \?CCL28
IN? ROC-TERIYAKI,PROTAGONIST /?CTR30
IN? CAKE,PROTAGONIST /?CTR30
IN? KEG,PROTAGONIST \?CCL31
?CTR30: PRINTI """Idiot, that goes to the "
IN? ROC-TERIYAKI,PROTAGONIST \?CCL37
SET 'PROLOGUE-NOVICE-COUNTER,2
PRINTI "kitchen"
JUMP ?CND35
?CCL37: SET 'PROLOGUE-NOVICE-COUNTER,11
PRINTI "banquet hall"
?CND35: PRINTI ". Where do we get our servants, the local madhouse?"" An impatient finger points south"
IN? ROC-TERIYAKI,PROTAGONIST /?CND38
PRINTI "west"
?CND38: PRINT PERIOD-CR
RTRUE
?CCL31: IN? LINEN,PROTAGONIST \?CCL41
SET 'PROLOGUE-NOVICE-COUNTER,2
PRINTR """When I give an order, servant, I mean NOW!"" The force of the voice is almost enough to propel you southward."
?CCL41: MOVE LINEN,PROTAGONIST
SET 'PROLOGUE-NOVICE-COUNTER,2
PRINTR "Someone drops a load of monogrammed napkins into your arms and pushes you toward the south. ""Bring these to the kitchen! They're running low!"""
?CCL28: CALL2 JIGS-UP,STR?265
RSTACK
.FUNCT SERVANT-ITEM-F
EQUAL? PRSA,V?THROW,V?DROP \?CCL3
PRINTR "Recalling yesterday's execution of ninety-seven unsatisfactory servants, you change your mind."
?CCL3: EQUAL? PRSA,V?CUT \?CCL5
EQUAL? PRSO,CAKE \?CCL5
ICALL PERFORM,V?DROP,PRSO
RTRUE
?CCL5: EQUAL? PRSA,V?DRINK,V?BITE,V?EAT \FALSE
EQUAL? PRSO,ROC-TERIYAKI \?CCL12
PRINTR "But it's undercooked!"
?CCL12: EQUAL? PRSO,HELLHOUND-BONES \?CCL14
PRINT THERES-NOTHING
PRINTR "left but bones."
?CCL14: ICALL PERFORM,V?DROP,PRSO
RTRUE
.ENDSEG
.SEGMENT "0"
.FUNCT PARCHMENT-F
EQUAL? PRSA,V?WALK-TO \?CCL3
ZERO? UNDER-TABLE /?CCL3
ICALL2 PERFORM,V?STAND
RTRUE
?CCL3: EQUAL? PRSA,V?READ \FALSE
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK \?CND8
PRINTI "The parchment has been in your family for generations, and is now yellowed with age. Family lore claims this parchment was acquired by an ancestor who served in Dimwit's court, and dates from the very day that the Curse of Megaboz was cast! "
?CND8: PRINTR "[You can find this scrap of parchment in your ZORK ZERO package.]"
.FUNCT DIMWIT-F,ARG
EQUAL? ARG,M-WINNER \?CCL3
PRINTI "One of the King's personal attendants gives you a bone-jarring mind-numbing smack on the side of your head as you attempt to speak to the King."
CRLF
CALL1 STOP
RSTACK
?CCL3: EQUAL? PRSA,V?RESEARCH \?CCL5
CALL PICTURED-ENTRY,DIMWIT-ILL,STR?269
RSTACK
?CCL5: EQUAL? PRSA,V?EXAMINE \?CCL7
PRINTR "From his gaudy crown to his 369 course meal, Dimwit is the very model of excessiveness."
?CCL7: EQUAL? PRSA,V?MUNG,V?KICK,V?KILL \FALSE
PRINTR "You'd never get past his legion of personal guards."
.FUNCT G-DIMWIT-F,TBL,F
GET F,6
EQUAL? STACK,W?STATUE \?CCL3
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK /FALSE
RETURN DIMWIT-STATUE
?CCL3: GET F,6
EQUAL? STACK,W?PAINTING /FALSE
RETURN DIMWIT
.ENDSEG
.SEGMENT "STARTUP"
.FUNCT TABLES-F
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTR "The tables are slathered with food and bones and dirty platters and puddles or wine and even a few sleeping bodies. Royal guests don't tend to have the best manners."
?CCL3: EQUAL? PRSA,V?HIDE,V?CRAWL-UNDER \?CCL5
ZERO? UNDER-TABLE /?CCL8
PRINT LOOK-AROUND
RTRUE
?CCL8: SET 'UNDER-TABLE,TRUE-VALUE
SET 'OLD-HERE,FALSE-VALUE
PRINTR "You are now under the table."
?CCL5: EQUAL? PRSA,V?EXIT \FALSE
ZERO? UNDER-TABLE /FALSE
SET 'PRSO,FALSE-VALUE
CALL1 V-STAND
RSTACK
.ENDSEG
.SEGMENT "CASTLE"
.FUNCT CAULDRON-F,CAULDRON-SCORE
EQUAL? PRSA,V?CLOSE \?CCL3
PRINTR "No lid."
?CCL3: EQUAL? PRSA,V?EXAMINE \?CCL5
PRINTI "The cauldron is "
FSET? OUTER-GATE,OPENBIT \?CCL8
PRINTR "cold and empty!"
?CCL8: ZERO? TIME-STOPPED /?CCL10
PRINTR "surrounded by unmoving clouds of smoke!"
?CCL10: DIV NUMBER-OF-ITEMS,2
GET CAULDRON-DESCS,STACK
PRINT STACK
PRINTR "."
?CCL5: EQUAL? PRSA,V?SMELL \?CCL12
PRINTR "Phew!!!"
?CCL12: EQUAL? PRSA,V?ENTER,V?DRINK-FROM,V?DRINK \?CCL14
PRINTR "As you near the cauldron, acrid fumes drive you back."
?CCL14: EQUAL? PRSA,V?LOOK-INSIDE \?CCL16
ZERO? TIME-STOPPED /?CCL19
ICALL PERFORM,V?EXAMINE,CAULDRON
RTRUE
?CCL19: PRINTR "All you can see is churning smoke."
?CCL16: EQUAL? PRSA,V?REACH-IN,V?SEARCH \?CCL21
PRINTR "You feel nothing within the cauldron, but after you withdraw your hand it tingles maddeningly for a few moments."
?CCL21: EQUAL? PRSA,V?PUT \FALSE
CALL2 RUNNING?,I-PROLOGUE
ZERO? STACK /?CCL26
REMOVE PRSO
PRINTI "There is no apparent effect as"
ICALL1 TPRINT-PRSO
PRINTR " vanishes into the cauldron."
?CCL26: ZERO? TIME-STOPPED /?CND24
MOVE PRSO,HERE
PRINTI "As though there were now an invisible bubble around the cauldron,"
ICALL1 TPRINT-PRSO
PRINTR " slides away from it and lands on the floor."
?CND24: PRINTI "With a puff of magically charged smoke,"
ICALL1 TPRINT-PRSO
PRINTI " vanishes amidst the vapors. The cauldron's level of activity seems to increase"
EQUAL? PRSO,CUP \?CND28
IN? POTION,CUP \?CND28
REMOVE POTION
?CND28: CALL2 PUT-ITEM-IN-CAULDRON,PRSO >CAULDRON-SCORE
FSET? PRSO,MAGICBIT /?CCL34
PRINTI " momentarily"
JUMP ?CND32
?CCL34: MOD NUMBER-OF-ITEMS,2
ZERO? STACK \?CND32
PRINTI "; it is now "
DIV NUMBER-OF-ITEMS,2
GET CAULDRON-DESCS,STACK
PRINT STACK
?CND32: PRINTC 46
EQUAL? NUMBER-OF-ITEMS,24 \?CND36
ZERO? CAULDRON-MUNGED \?CND36
ICALL2 DEQUEUE,I-JESTER
FCLEAR GUTTERING-TORCH,ONBIT
FCLEAR GUTTERING-TORCH,FLAMEBIT
FCLEAR FLICKERING-TORCH,ONBIT
FCLEAR FLICKERING-TORCH,FLAMEBIT
FSET CLOSET-REBUS-BUTTON,TOUCHBIT
PUTP CLOSET-REBUS-BUTTON,P?SDESC,STR?270
FSET BASEMENT-REBUS-BUTTON,TOUCHBIT
PUTP BASEMENT-REBUS-BUTTON,P?SDESC,STR?270
FCLEAR IRON-MAIDEN,OPENBIT
FCLEAR SNAKE-PIT,OPENBIT
FCLEAR WATER-CHAMBER,OPENBIT
SET 'TIME-STOPPED,TRUE-VALUE
PRINTI " Suddenly, the smoke stops swirling; in fact, everything in sight has ground to a halt. It is as if time itself has stopped. You don't seem to be affected, however."
IN? JESTER,HERE \?CND36
ICALL1 REMOVE-J
PRINTI " In addition, the jester has vanished."
?CND36: CRLF
CALL2 INC-SCORE,CAULDRON-SCORE
RSTACK
.FUNCT PUT-ITEM-IN-CAULDRON,OBJ,X,N,CAULDRON-SCORE
FIRST? OBJ >X /?PRG2
?PRG2: ZERO? X /?REP3
NEXT? X >N /?BOGUS7
?BOGUS7: FSET? X,NDESCBIT /?CND4
CALL2 PUT-ITEM-IN-CAULDRON,X
ADD CAULDRON-SCORE,STACK >CAULDRON-SCORE
?CND4: SET 'X,N
JUMP ?PRG2
?REP3: FSET? OBJ,MAGICBIT \?CCL12
REMOVE OBJ
INC 'NUMBER-OF-ITEMS
ADD CAULDRON-SCORE,5 >CAULDRON-SCORE
GETP OBJ,P?VALUE
EQUAL? STACK,12 \?CND10
ADD CAULDRON-SCORE,12 >CAULDRON-SCORE
RETURN CAULDRON-SCORE
?CCL12: EQUAL? OBJ,LARGE-VIAL \?CCL17
REMOVE LARGE-VIAL-WATER
SET 'LARGE-VIAL-GLOOPS,0
JUMP ?CND15
?CCL17: EQUAL? OBJ,SMALL-VIAL \?CND15
REMOVE SMALL-VIAL-WATER
SET 'SMALL-VIAL-GLOOPS,0
?CND15: FCLEAR OBJ,ONBIT
ICALL QUEUE,I-CAULDRON,3
EQUAL? OBJ,NUT \?CCL20
IN? NUT,UNOPENED-NUT /?CND19
?CCL20: MOVE OBJ,MEGABOZ
?CND19: EQUAL? PRSO,PERCH \?CND23
SET 'REMOVED-PERCH-LOC,MEGABOZ
?CND23: SUB CAULDRON-SCORE,5 >CAULDRON-SCORE
SET 'CAULDRON-MUNGED,TRUE-VALUE
?CND10: RETURN CAULDRON-SCORE
.FUNCT I-CAULDRON,X,TWO
FIRST? MEGABOZ \FALSE
IN? PERCH,MEGABOZ \?CND1
SET 'REMOVED-PERCH-LOC,FALSE-VALUE
?CND1: EQUAL? HERE,BANQUET-HALL \?CND5
ICALL1 RETURN-FROM-MAP
PRINTI " With a startling belch of green flame and vile-smelling smoke, the cauldron regurgitates"
FIRST? MEGABOZ >X \?CND7
NEXT? X \?CND7
SET 'TWO,TRUE-VALUE
?CND7: ICALL D-CONTENTS,MEGABOZ,2
ZERO? TWO /?CCL13
PRINTI " They "
JUMP ?CND11
?CCL13: PRINTI " It "
?CND11: RANDOM 100
LESS? 15,STACK /?CCL16
ZERO? TWO \?CCL16
GETP X,P?SIZE
GRTR? STACK,4 \?CCL16
ICALL2 JIGS-UP,STR?284
JUMP ?CND5
?CCL16: ZERO? TWO /?CCL22
PRINTI "whiz"
JUMP ?CND20
?CCL22: PRINTI "whizzes"
?CND20: PRINTI " past your ear with alarming velocity."
?CND5: ICALL ROB,MEGABOZ,BANQUET-HALL
EQUAL? HERE,BANQUET-HALL \FALSE
CRLF
RTRUE
.ENDSEG
.SEGMENT "STARTUP"
.FUNCT MEGABOZ-F,ARG
EQUAL? ARG,M-OBJDESC,M-OBJDESC? \?CCL3
EQUAL? ARG,M-OBJDESC? /TRUE
PRINTI " An angry wizard stands defiantly in the center of the hall."
IN? PARCHMENT,MEGABOZ \TRUE
PRINTI " A scrap of parchment sticks out from a pocket of his robe."
RTRUE
?CCL3: EQUAL? ARG,M-WINNER /?CTR8
EQUAL? PRSA,V?TELL \?CCL9
?CTR8: PRINTI "Megaboz ignores you."
CRLF
RETURN 2
?CCL9: EQUAL? PRSA,V?RESEARCH \?CCL15
CALL PICTURED-ENTRY,MEGABOZ-ILL,MEGABOZ-TEXT
RSTACK
?CCL15: EQUAL? PRSA,V?EXAMINE \?CCL17
PRINTR "Even the most ignorant lay observer can see that the gaunt man is a powerful mage. His wizardly robe and cap crackle with magical energy, and his darting eyes seem to see inside everyone he looks at."
?CCL17: EQUAL? PRSA,V?KILL,V?KISS,V?KICK /?PRD21
EQUAL? PRSA,V?MUNG \FALSE
?PRD21: EQUAL? PRSO,MEGABOZ \FALSE
CALL2 JIGS-UP,STR?285
RSTACK
.SEGMENT "CASTLE"
.ENDSEG
.ENDI

1245
prologue.zil Normal file
View File

File diff suppressed because it is too large Load Diff

18
pstack.zap Normal file
View File

@ -0,0 +1,18 @@
.SEGMENT "0"
.FUNCT PEEK-PSTACK,S,OFFS,N,VAL
?PRG1: POP S >VAL
PUSH VAL
INC 'N
DLESS? 'OFFS,0 \?PRG1
?PRG5: DLESS? 'N,0 /?REP6
POP
XPUSH STACK,S /?PRG5
JUMP ?PRG5
?REP6: RETURN VAL
.ENDSEG
.ENDI

116
pstack.zil Normal file
View File

@ -0,0 +1,116 @@
"PSTACK file for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<ZZPACKAGE "PSTACK">
<ENTRY ALLOCATE-PSTACK MAX-PSTACK-SIZE PUSH-PSTACK POP-PSTACK
PEEK-PSTACK PSTACK FLUSH-PSTACK PSTACK-PTR
CLEAR-PSTACK PSTACK-DATA PSTACK-EMPTY?>
<USE "NEWSTRUC">
<FILE-FLAGS ;MDL-ZIL? ;ZAP-TO-SOURCE-DIRECTORY?>
<BEGIN-SEGMENT 0>
<MSETG MAX-PSTACK-SIZE 21 ;32> ;"STATE & DATA could be 11"
<NEWTYPE PSTACK TABLE>
<DEFMAC ALLOCATE-PSTACK () <ITABLE ,MAX-PSTACK-SIZE 0>>
<DEFMAC PSTACK-PTR ('S "OPT" 'NEW)
<COND (<ASSIGNED? NEW>
<FORM ZPUT .S 0 .NEW>)
(T
<CHTYPE [<FORM ZGET .S 0> FIX] ADECL>)>>
<DEFMAC PSTACK-EMPTY? ('PSTACK)
<COND (<CHECK-VERSION? YZIP>
<FORM EQUAL? <- ,MAX-PSTACK-SIZE 1> <FORM PSTACK-PTR .PSTACK>>)
(T
<FORM 0? <FORM PSTACK-PTR .PSTACK>>)>>
<DEFMAC CLEAR-PSTACK ('S)
<COND (<CHECK-VERSION? YZIP>
<FORM PSTACK-PTR <CHTYPE [.S PSTACK] ADECL> <- ,MAX-PSTACK-SIZE 1>>)
(T
<FORM PSTACK-PTR <CHTYPE [.S PSTACK] ADECL> 0>)>>
<DEFINE20 PRINT-PSTACK (S:PSTACK "OPT" (OUTCHAN:CHANNEL .OUTCHAN)
"AUX" (P <PSTACK-PTR .S>))
<PRINT-MANY .OUTCHAN PRINC
"#PSTACK ["
.P
" [">
<REPEAT ((D <ZREST .S 2>))
<COND (<L=? .P 0> <RETURN>)>
<PRIN1 <ZGET .D 0>>
<PRINC " ">
<SET D <ZREST .D 2>>
<SET P <- .P 1>>>
<PRINC "]]">>
<COND (<CHECK-VERSION? YZIP>
<DEFMAC PUSH-PSTACK ('S 'OBJ) <FORM XPUSH .OBJ .S>>)
(T
<IF-P-DEBUGGING-PARSER
<GLOBAL PSTACK-WARN:NUMBER 20>>
<ROUTINE PUSH-PSTACK (S:PSTACK OBJ "AUX" TMP)
<SET TMP <+ 1 <PSTACK-PTR .S>>>
<COND (<L=? ,MAX-PSTACK-SIZE .TMP>
<P-NO-MEM-ROUTINE>
<RFALSE>)>
<IF-P-DEBUGGING-PARSER
<COND (<L? ,PSTACK-WARN .TMP>
<SETG PSTACK-WARN .TMP>
<PRINTI "[PSTACK: ">
<PRINTN <- ,MAX-PSTACK-SIZE .TMP>>
<PRINTI " left!]|">)>>
<PSTACK-PTR .S .TMP>
<ZPUT .S .TMP .OBJ>
.S>)>
<COND (<CHECK-VERSION? YZIP>
<DEFMAC FLUSH-PSTACK ('S "OPT" ('N 1))
<FORM FSTACK .N .S>>)
(T
<ROUTINE FLUSH-PSTACK (S:PSTACK "OPT" (N:FIX 1))
<COND (<G? 0 <SET N <- <PSTACK-PTR .S> .N>>>
<SET N 0>)>
<PSTACK-PTR .S .N>
.S>)>
<COND (<CHECK-VERSION? YZIP>
<DEFMAC POP-PSTACK ('S "OPT" ('N 1))
<COND (<1? .N>
<FORM POP .S>)
(T
<FORM FSTACK .N .S>)>>)
(T
<ROUTINE POP-PSTACK (S:PSTACK "OPT" (N:FIX 1) "AUX" (OBJ <PEEK-PSTACK .S>))
<COND (<NOT <0? .N>>
<FLUSH-PSTACK .S .N>)>
.OBJ>)>
<COND (<CHECK-VERSION? YZIP>
<ROUTINE PEEK-PSTACK (S:PSTACK "OPT" (OFFS:FIX 0) "AUX" (N 0) VAL)
<REPEAT ()
<SET VAL <POP-PSTACK .S>>
<PUSH .VAL>
<INC N>
<COND (<DLESS? OFFS 0>
<RETURN>)>>
<REPEAT ()
<COND (<DLESS? N 0>
<RETURN>)
(T
<PUSH-PSTACK .S <POP>>)>>
.VAL>)
(T
<ROUTINE PEEK-PSTACK (S:PSTACK "OPT" (OFFS:FIX 0))
<ZGET .S <- <PSTACK-PTR .S> .OFFS>>>)>
<END-SEGMENT>
<ENDPACKAGE>

1441
reds.zap Normal file
View File

File diff suppressed because it is too large Load Diff

1334
reds.zil Normal file
View File

File diff suppressed because it is too large Load Diff

823
syntax.zil Normal file
View File

@ -0,0 +1,823 @@
"SYNTAX for
ZORK ZERO (from Nord and Bert)
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<BUZZ PLEASE THIS THAT PRY HERE SOME FRONT>
;"the following make BODY-PARTS-HANDLER work"
<VOC "MAN\'S" ADJ>
<VOC "WOMAN\'S" ADJ>
<ADD-WORD "TOP" PARTICLE ;PREP> ;"for PUT X ON TOP OF Y"
<SYNONYM TO TOWARD>
<SYNONYM WITH USING>
<SYNONYM THROUGH THRU>
<SYNONYM ON ONTO UPON ATOP>
<SYNONYM OUT OUTSIDE>
<SYNONYM IN INSIDE INTO>
<SYNONYM UNDER BELOW BENEATH UNDERNEATH>
<SYNONYM BEFORE NEAR BY NEXT>
<SYNONYM AROUND ALONG>
<SYNONYM ALL BOTH EVERYTHING>
<SYNONYM NORTH N>
<SYNONYM SOUTH S>
<SYNONYM EAST E>
<SYNONYM WEST W>
<SYNONYM DOWN D DOWNSTAIRS BELOWDECKS>
<SYNONYM UP U UPSTAIRS>
<SYNONYM NW NORTHW NORTHWEST>
<SYNONYM NE NORTHE NORTHEAST>
<SYNONYM SW SOUTHW SOUTHWEST>
<SYNONYM SE SOUTHE SOUTHEAST>
;"game commands"
<SYNTAX VERBOSE = V-VERBOSE>
<SYNTAX BRIEF = V-BRIEF>
<SYNTAX SUPERBRIEF = V-SUPERBRIEF>
<SYNTAX COLOR = V-COLOR>
<SYNTAX CREDITS = V-CREDITS>
<VERB-SYNONYM CREDITS CREDIT>
<SYNTAX DIAGNOSE = V-DIAGNOSE>
<SYNTAX INVENTORY = V-INVENTORY>
<VERB-SYNONYM INVENTORY I>
<SYNTAX MODE = V-MODE>
<SYNTAX QUIT = V-QUIT>
<VERB-SYNONYM QUIT Q>
<SYNTAX RESTART = V-RESTART>
<SYNTAX RESTORE = V-RESTORE>
<SYNTAX SAVE = V-SAVE>
<SYNTAX UNDO = V-UNDO>
<SYNTAX SCORE = V-SCORE>
<VERB-SYNONYM SCORE STATUS>
<SYNTAX NOTIFY = V-NOTIFY>
<SYNTAX SCRIPT = V-SCRIPT>
<SYNTAX UNSCRIPT = V-UNSCRIPT>
<SYNTAX VERSION = V-VERSION>
<SYNTAX \#RANDOM OBJECT = V-$RANDOM>
<SYNTAX \#COMMAND = V-$COMMAND>
<SYNTAX \#RECORD = V-$RECORD>
<SYNTAX \#UNRECORD = V-$UNRECORD>
<SYNTAX $REFRESH = V-$REFRESH>
<VERB-SYNONYM $REFRESH REFRESH>
<SYNTAX $VERIFY = V-$VERIFY>
<SYNTAX $VERIFY OBJECT = V-$VERIFY>
<VERB-SYNONYM $VERIFY $VER>
;<SYNTAX $DEBUG = V-$DEBUG>
;<SYNTAX $SKIP = V-$SKIP>
;<SYNTAX $SKIP OBJECT (EVERYWHERE) = V-$SKIP>
;"subtitle real verbs"
;<SYNTAX ANAGRAM OBJECT (EVERYWHERE) = V-ANAGRAM>
;<SYNTAX APPLAUD = V-APPLAUD>
'<SYNTAX APPLAUD OBJECT = V-APPLAUD>
;<VERB-SYNONYM APPLAUD CLAP>
;<SYNTAX APPLY OBJECT (HELD TAKE) = V-APPLY>
;<SYNTAX APPLY OBJECT (HELD MANY) TO OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX APPROACH OBJECT (EVERYWHERE) = V-WALK-TO>
<SYNTAX ASK OBJECT (FIND ACTORBIT) ABOUT OBJECT (EVERYWHERE) = V-ASK-ABOUT>
<SYNTAX ASK OBJECT (FIND ACTORBIT) ON OBJECT (EVERYWHERE) = V-ASK-ABOUT>
<SYNTAX ASK OBJECT (FIND ACTORBIT) FOR OBJECT (EVERYWHERE) = V-ASK-FOR>
<SYNTAX ASK FOR OBJECT (EVERYWHERE) = V-ASK-NO-ONE-FOR>
<SYNTAX ATTACK OBJECT (FIND ACTORBIT) (ON-GROUND IN-ROOM) = V-KILL>
<SYNTAX ATTACK OBJECT (FIND ACTORBIT) (ON-GROUND IN-ROOM)
WITH OBJECT (HELD CARRIED HAVE) = V-KILL>
<VERB-SYNONYM ATTACK KILL MURDER FIGHT SLAP STAB HIT STRIKE ;GORE ;SLAY>
<SYNTAX BEHEAD OBJECT (FIND ACTORBIT) = V-BEHEAD>
;<SYNTAX BEND OBJECT = V-BEND>
;<VERB-SYNONYM BEND SPREAD>
<SYNTAX BITE OBJECT = V-BITE>
<SYNTAX BLOW IN OBJECT = V-INFLATE>
<SYNTAX BLOW UP OBJECT = V-INFLATE>
<SYNTAX BLOW OUT OBJECT (FIND ONBIT) = V-OFF PRE-TOUCH>
<SYNTAX BOARD OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-ENTER PRE-ENTER>
<VERB-SYNONYM BOARD MOUNT>
<SYNTAX BURN OBJECT (FIND BURNBIT) = V-BURN PRE-TOUCH>
<SYNTAX BURN UP OBJECT (FIND BURNBIT) = V-BURN PRE-TOUCH>
<SYNTAX BURN OBJECT (FIND BURNBIT) WITH OBJECT (HAVE) = V-BURN PRE-TOUCH>
<SYNTAX BURN UP OBJECT (FIND BURNBIT) WITH OBJECT (HAVE) = V-BURN PRE-TOUCH>
<SYNTAX BUY OBJECT (EVERYWHERE) = V-BUY>
<SYNTAX BUY OBJECT (EVERYWHERE) FROM OBJECT = V-BUY>
<VERB-SYNONYM BUY ORDER PURCHASE>
<SYNTAX CALL OBJECT (EVERYWHERE) = V-CALL>
<SYNTAX CALL OUT OBJECT (EVERYWHERE) = V-CALL>
<SYNTAX CALL FOR OBJECT (EVERYWHERE) = V-CALL>
<SYNTAX CALL TO OBJECT (EVERYWHERE) = V-CALL>
<SYNTAX CATCH OBJECT (ON-GROUND IN-ROOM) = V-CATCH>
<SYNTAX CATCH OBJECT (ON-GROUND IN-ROOM) IN OBJECT = V-CATCH>
<SYNTAX CATCH OBJECT (ON-GROUND IN-ROOM) WITH OBJECT = V-CATCH>
<VERB-SYNONYM CATCH TRAP>
<SYNTAX CIRCLE OBJECT = V-WALK-AROUND>
<SYNTAX CLIMB OBJECT (ON-GROUND IN-ROOM) = V-CLIMB>
<SYNTAX CLIMB ON OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-CLIMB-ON>
<SYNTAX CLIMB UP OBJECT (FIND KLUDGEBIT) (ON-GROUND IN-ROOM) = V-CLIMB-UP>
<SYNTAX CLIMB DOWN OBJECT (FIND KLUDGEBIT) (ON-GROUND IN-ROOM) = V-CLIMB-DOWN>
<SYNTAX CLIMB OUT OBJECT (FIND KLUDGEBIT) (ON-GROUND IN-ROOM) = V-EXIT>
<SYNTAX CLIMB OFF OBJECT (FIND KLUDGEBIT) (ON-GROUND IN-ROOM) = V-EXIT>
<SYNTAX CLIMB OVER OBJECT (ON-GROUND IN-ROOM) = V-CLIMB-OVER>
<SYNTAX CLIMB IN OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-ENTER PRE-ENTER>
<SYNTAX CLIMB THROUGH OBJECT = V-ENTER PRE-ENTER>
<SYNTAX CLIMB UNDER OBJECT = V-CRAWL-UNDER>
<VERB-SYNONYM CLIMB SCALE>
<SYNTAX CLOSE OBJECT (FIND OPENBIT ;DOORBIT) (HELD CARRIED ON-GROUND IN-ROOM)
= V-CLOSE PRE-TOUCH>
<SYNTAX CLOSE OFF OBJECT (FIND LIGHTBIT) (HELD CARRIED ON-GROUND IN-ROOM TAKE)
= V-OFF PRE-TOUCH>
<SYNTAX CLOSE UP OBJECT (FIND KLUDGEBIT) = V-SHUT-UP PRE-SWITCH>
<SYNTAX CLOSE OBJECT WITH OBJECT (FIND KEYBIT) (HAVE) = V-LOCK PRE-LOCK>
<VERB-SYNONYM CLOSE SHUT SHUTTER>
<SYNTAX CONSULT OBJECT ABOUT OBJECT (EVERYWHERE) = V-SRESEARCH PRE-SWITCH>
<SYNTAX CONSULT OBJECT ON OBJECT (EVERYWHERE) = V-SRESEARCH PRE-SWITCH>
<SYNTAX COUGH = V-COUGH>
<SYNTAX COUNT OBJECT (MANY) = V-COUNT PRE-COUNT>
<SYNTAX COVER OBJECT WITH OBJECT (HELD MANY) = V-SPUT-ON PRE-SWITCH>
<SYNTAX CRAWL UNDER OBJECT = V-CRAWL-UNDER>
<SYNTAX CRAWL OUT OBJECT = V-EXIT>
<SYNTAX CROSS OBJECT = V-CROSS>
<VERB-SYNONYM CROSS FORD>
<SYNTAX DATE = V-DATE>
<SYNTAX DECODE OBJECT = V-DECODE>
<VERB-SYNONYM DECODE DECIPHER ANAGRAM>
;<SYNTAX DEFLATE OBJECT = V-DEFLATE>
;<SYNTAX DEFLATE OBJECT WITH OBJECT (HAVE) = V-DEFLATE>
;<VERB-SYNONYM DEFLATE POP>
<SYNTAX DEMOLISH OBJECT (ON-GROUND IN-ROOM) = V-MUNG PRE-TOUCH>
<SYNTAX DEMOLISH OBJECT WITH OBJECT (HELD CARRIED TAKE) = V-MUNG PRE-TOUCH>
<SYNTAX DEMOLISH OUT OBJECT (FIND KLUDGEBIT) = V-MUNG PRE-TOUCH>
<SYNTAX DEMOLISH DOWN OBJECT = V-KILL>
<SYNTAX DEMOLISH OFF OBJECT = V-MUNG PRE-TOUCH>
<VERB-SYNONYM DEMOLISH DESTROY DAMAGE BREAK CRACK SMASH WRECK>
<SYNTAX DESCEND OBJECT (ON-GROUND IN-ROOM) = V-CLIMB-DOWN>
;<SYNTAX DIG OBJECT = V-DIG>
;<SYNTAX DIG IN OBJECT = V-DIG>
;<SYNTAX DIG THROUGH OBJECT = V-DIG>
;<SYNTAX DIG OBJECT = V-DIG> ;"added by SWG for debugging"
<SYNTAX DIG OBJECT WITH OBJECT (HAVE) = V-DIG>
<SYNTAX DIG UP OBJECT WITH OBJECT (HAVE) = V-DIG>
<SYNTAX DIG IN OBJECT WITH OBJECT (HAVE) = V-DIG>
<SYNTAX DIG THROUGH OBJECT WITH OBJECT (HAVE) = V-DIG>
<SYNTAX DIG WITH OBJECT (HAVE) = V-DIG-WITH>
<SYNTAX DISEMBARK = V-EXIT>
<SYNTAX DISEMBARK OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-EXIT>
<SYNTAX DISEMBARK FROM OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-EXIT>
<VERB-SYNONYM DISEMBARK DEBARK DISMOUNT EXIT DEPART WITHDRAW>
<SYNTAX DOFF OBJECT (MANY) = V-TAKE-OFF>
;<SYNTAX DRESS = V-DRESS>
;<SYNTAX DRESS OBJECT = V-DRESS>
<SYNTAX DRINK OBJECT (HELD CARRIED ON-GROUND IN-ROOM) = V-DRINK PRE-INGEST>
<SYNTAX DRINK FROM OBJECT (HELD CARRIED) = V-DRINK-FROM PRE-INGEST>
<SYNTAX DRINK OBJECT WITH OBJECT = V-DRINK-WITH PRE-INGEST>
<SYNTAX DRINK FROM OBJECT WITH OBJECT = V-DRINK-WITH PRE-INGEST>
<VERB-SYNONYM DRINK SIP>
<SYNTAX DROP OBJECT (HELD MANY HAVE) = V-DROP IDROP>
<SYNTAX DROP OBJECT (HELD MANY) DOWN OBJECT = V-PUT PRE-PUT>
<SYNTAX DROP OBJECT (HELD MANY) IN OBJECT = V-PUT PRE-PUT>
<SYNTAX DROP OBJECT (HELD MANY) ON OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX DROP OBJECT (CARRIED) FROM OBJECT = V-THROW-FROM IDROP>
<SYNTAX DROP OBJECT (CARRIED) OFF OBJECT = V-THROW-FROM IDROP>
<SYNTAX DROP OBJECT (HELD MANY) OUT OBJECT = V-PUT-THROUGH IDROP>
<SYNTAX DROP OBJECT (HELD MANY) THROUGH OBJECT = V-PUT-THROUGH IDROP>
;<SYNTAX DROP OBJECT (HELD CARRIED) BEFORE OBJECT = V-PUT-NEAR IDROP>
;<SYNTAX DROP OBJECT (HELD CARRIED) AT OBJECT = V-PUT-NEAR IDROP>
<VERB-SYNONYM DROP DUMP RELEASE>
<SYNTAX EAT OBJECT (HELD CARRIED ON-GROUND IN-ROOM) = V-EAT PRE-INGEST>
;<SYNTAX EAT ON OBJECT = V-EAT PRE-INGEST>
<VERB-SYNONYM EAT DEVOUR SWALLOW ;INGEST ;GOBBLE ;DINE>
<SYNTAX EMPTY OBJECT (HAVE TAKE) = V-EMPTY PRE-TOUCH>
<SYNTAX EMPTY OUT OBJECT (HAVE TAKE) = V-EMPTY PRE-TOUCH>
;<SYNTAX EMPTY OVER OBJECT (HAVE TAKE) = V-EMPTY PRE-TOUCH>
<SYNTAX EMPTY OBJECT (HAVE TAKE) OVER OBJECT = V-EMPTY PRE-TOUCH>
<SYNTAX EMPTY OBJECT (HAVE TAKE) ON OBJECT = V-EMPTY PRE-TOUCH>
<SYNTAX EMPTY OBJECT (HAVE TAKE) IN OBJECT = V-EMPTY PRE-TOUCH>
<SYNTAX EMPTY OBJECT (HAVE TAKE) TO OBJECT = V-EMPTY PRE-TOUCH>
<SYNTAX EMPTY OBJECT (MANY) FROM OBJECT (HAVE TAKE) = V-EMPTY-FROM>
<SYNTAX EMPTY OBJECT (MANY) OUT OBJECT (HAVE TAKE) = V-EMPTY-FROM>
;<VERB-SYNONYM EMPTY TIP>
<SYNTAX ENTER = V-IN>
<SYNTAX ENTER OBJECT = V-ENTER PRE-ENTER>
<SYNTAX EXAMINE OBJECT (HELD CARRIED ON-GROUND IN-ROOM) = V-EXAMINE PRE-LOOK>
<SYNTAX EXAMINE OBJECT IN OBJECT = V-MIRROR-LOOK>
;<SYNTAX EXAMINE IN OBJECT (HELD CARRIED IN-ROOM ON-GROUND)
= V-LOOK-INSIDE PRE-LOOK>
;<SYNTAX EXAMINE ON OBJECT (HELD CARRIED IN-ROOM ON-GROUND)
= V-LOOK-INSIDE PRE-LOOK>
;<SYNTAX EXAMINE FOR OBJECT (EVERYWHERE) = V-FIND>
<VERB-SYNONYM EXAMINE X INSPECT DESCRIBE STUDY OBSERVE WATCH>
<SYNTAX EXTINGUISH OBJECT (FIND ONBIT) = V-OFF PRE-TOUCH>
<VERB-SYNONYM EXTINGUISH DEACTIVATE>
<SYNTAX FEED OBJECT (FIND ACTORBIT) = V-FEED>
<SYNTAX FEED OBJECT (MANY HELD HAVE) TO OBJECT (FIND ACTORBIT) (ON-GROUND)
= V-GIVE PRE-GIVE>
<SYNTAX FEED OBJECT (FIND ACTORBIT) (ON-GROUND) OBJECT (MANY HELD HAVE)
= V-SGIVE PRE-SWITCH>
<SYNTAX FILL OBJECT (HELD CARRIED HAVE) = V-FILL PRE-FILL>
<SYNTAX FILL OBJECT (HELD CARRIED HAVE) WITH OBJECT = V-FILL PRE-FILL>
<SYNTAX FILL OBJECT (HELD CARRIED HAVE) FROM OBJECT = V-FILL PRE-FILL>
<SYNTAX FILL OBJECT (HELD CARRIED HAVE) IN OBJECT = V-FILL PRE-FILL>
<SYNTAX FIND OBJECT (EVERYWHERE) = V-FIND>
<SYNTAX FIND OBJECT (EVERYWHERE) IN OBJECT = V-SSEARCH-OBJECT-FOR PRE-SWITCH>
<VERB-SYNONYM FIND SEEK>
<SYNTAX FLY = V-FLY>
<SYNTAX FLY OBJECT = V-FLY>
<SYNTAX FOLLOW OBJECT (EVERYWHERE) = V-FOLLOW>
<VERB-SYNONYM FOLLOW PURSUE CHASE>
<SYNTAX HAND OBJECT (MANY HELD HAVE) (FIND TAKEBIT) TO OBJECT (FIND ACTORBIT) (ON-GROUND)
= V-GIVE PRE-GIVE>
<SYNTAX HAND OBJECT (FIND ACTORBIT) (ON-GROUND) OBJECT (MANY HELD HAVE)
= V-SGIVE PRE-SWITCH>
<SYNTAX HAND UP OBJECT (FIND KLUDGEBIT) = V-GIVE-UP>
;<SYNTAX HAND BACK OBJECT (HELD CARRIED HAVE) = V-RETURN>
;<SYNTAX HAND OBJECT (MANY HELD HAVE) BACK OBJECT (FIND ACTORBIT) (ON-GROUND)
= V-GIVE PRE-GIVE>
<VERB-SYNONYM HAND GIVE OFFER ;SELL ;DONATE ;EXTEND>
<SYNTAX HANG OBJECT (FIND ACTORBIT) = V-HANG>
<SYNTAX HEAR OBJECT = V-LISTEN PRE-LISTEN>
<SYNTAX HELLO = V-HELLO>
<SYNTAX HELLO OBJECT = V-HELLO>
<VERB-SYNONYM HELLO HI>
<SYNTAX HELP = V-HINT>
<SYNTAX HELP OFF OBJECT (FIND KLUDGEBIT) = V-HINTS-NO>
<SYNTAX HELP OBJECT = V-SAVE-SOMETHING>
<VERB-SYNONYM HELP HINT HINTS CLUE CLUES INVISICLUES>
<SYNTAX HIDE UNDER OBJECT = V-HIDE>
<SYNTAX HIDE BEHIND OBJECT = V-HIDE>
;<SYNTAX INFLATE OBJECT = V-INFLATE>
<SYNTAX JUMP = V-LEAP>
<SYNTAX JUMP OBJECT = V-LEAP>
<SYNTAX JUMP OVER OBJECT = V-LEAP>
<SYNTAX JUMP ACROSS OBJECT = V-LEAP>
<SYNTAX JUMP IN OBJECT = V-ENTER PRE-ENTER>
<SYNTAX JUMP FROM OBJECT = V-LEAP-OFF>
<SYNTAX JUMP OFF OBJECT = V-LEAP-OFF>
<SYNTAX JUMP ON OBJECT = V-STAND-ON>
;<SYNTAX JUMP ACROSS OBJECT = V-LEAP>
<SYNTAX JUMP OUT OBJECT = V-LEAP-OFF>
<SYNTAX JUMP THROUGH OBJECT = V-ENTER PRE-ENTER>
<SYNTAX JUMP UP OBJECT (FIND KLUDGEBIT) = V-LEAP>
<SYNTAX JUMP DOWN OBJECT (FIND KLUDGEBIT) = V-LEAP>
<SYNTAX JUMP TO OBJECT = V-LEAP>
<SYNTAX JUMP UNDER OBJECT = V-CRAWL-UNDER>
<SYNTAX JUMP OUT OBJECT IN OBJECT = V-LEAP-OFF>
<SYNTAX JUMP FROM OBJECT IN OBJECT = V-LEAP-OFF>
<SYNTAX JUMP FROM OBJECT TO OBJECT = V-LEAP-OFF>
<VERB-SYNONYM JUMP LEAP DIVE VAULT>
<SYNTAX KICK OBJECT = V-KICK>
<SYNTAX KISS OBJECT (FIND ACTORBIT) (ON-GROUND IN-ROOM) = V-KISS PRE-TOUCH>
<SYNTAX KNOCK OBJECT = V-MUNG PRE-TOUCH>
<SYNTAX KNOCK ON OBJECT (FIND DOORBIT) = V-KNOCK>
<SYNTAX KNOCK AT OBJECT (FIND DOORBIT) = V-KNOCK>
<SYNTAX KNOCK DOWN OBJECT (FIND ACTORBIT) (ON-GROUND IN-ROOM) = V-KILL>
<VERB-SYNONYM KNOCK RAP>
;<SYNTAX LAND = V-LAND>
;<SYNTAX LAND OBJECT (FIND VEHBIT) = V-LAND>
;<VERB-SYNONYM LAND MOOR DOCK>
<SYNTAX LEAD OBJECT OBJECT ;(EVERYWHERE) = V-RIDE-DIR>
<SYNTAX LEAD OBJECT TO OBJECT (EVERYWHERE) = V-LEAD-TO>
;<SYNTAX LEAN OBJECT (HAVE) ON OBJECT = V-PUT-AGAINST>
;<SYNTAX LEAN OBJECT (HAVE) AGAINST OBJECT = V-PUT-AGAINST>
<SYNTAX LEAVE = V-EXIT>
<SYNTAX LEAVE OBJECT = V-LEAVE>
<SYNTAX LEAVE OBJECT (HELD MANY) IN OBJECT = V-PUT PRE-PUT>
<SYNTAX LEAVE OBJECT (HELD MANY) ON OBJECT = V-PUT-ON PRE-PUT>
;<SYNTAX LEAVE OBJECT (HELD CARRIED) BEFORE OBJECT = V-PUT-NEAR IDROP>
;<SYNTAX LEAVE OBJECT (HELD CARRIED) AT OBJECT = V-PUT-NEAR IDROP>
<SYNTAX LET GO OBJECT (FIND KLUDGEBIT) (HELD MANY HAVE) = V-DROP IDROP>
<SYNTAX LET OUT OBJECT = V-LET-OUT>
<SYNTAX LET OBJECT (MANY) OUT OBJECT (HAVE TAKE) = V-EMPTY-FROM>
<SYNTAX LIE ON OBJECT (FIND VEHBIT) = V-LIE-DOWN>
<SYNTAX LIE IN OBJECT (FIND VEHBIT) = V-LIE-DOWN>
<SYNTAX LIE DOWN OBJECT (FIND KLUDGEBIT) = V-LIE-DOWN>
<SYNTAX LIGHT OBJECT (FIND LIGHTBIT) = V-ON PRE-TOUCH>
<SYNTAX LIGHT OBJECT (FIND BURNBIT) WITH OBJECT (HELD CARRIED)
= V-BURN PRE-TOUCH>
<VERB-SYNONYM LIGHT START ACTIVATE>
<SYNTAX LISTEN = V-LISTEN PRE-LISTEN>
<SYNTAX LISTEN TO OBJECT = V-LISTEN PRE-LISTEN>
<SYNTAX LOCK OBJECT WITH OBJECT (FIND KEYBIT) (HAVE) = V-LOCK PRE-LOCK>
<SYNTAX LOOK = V-LOOK>
<SYNTAX LOOK AROUND OBJECT (FIND KLUDGEBIT) = V-LOOK>
<SYNTAX LOOK DOWN OBJECT (FIND KLUDGEBIT) = V-LOOK-DOWN PRE-LOOK>
<SYNTAX LOOK AT OBJECT = V-EXAMINE PRE-LOOK>
<SYNTAX LOOK AT OBJECT WITH OBJECT (HAVE) = V-EXAMINE PRE-LOOK>
<SYNTAX LOOK AT OBJECT THROUGH OBJECT (HAVE) = V-EXAMINE PRE-LOOK>
<SYNTAX LOOK THROUGH OBJECT WITH OBJECT (HAVE) = V-EXAMINE PRE-LOOK>
<SYNTAX LOOK ON OBJECT = V-EXAMINE PRE-LOOK>
<SYNTAX LOOK TO OBJECT = V-EXAMINE PRE-LOOK>
<SYNTAX LOOK AT OBJECT IN OBJECT = V-MIRROR-LOOK>
<SYNTAX LOOK THROUGH OBJECT = V-LOOK-INSIDE PRE-LOOK>
<SYNTAX LOOK OUT OBJECT = V-LOOK-INSIDE PRE-LOOK>
<SYNTAX LOOK IN OBJECT = V-LOOK-INSIDE PRE-LOOK>
<SYNTAX LOOK UNDER OBJECT = V-LOOK-UNDER PRE-LOOK>
<SYNTAX LOOK BEHIND OBJECT = V-LOOK-BEHIND PRE-LOOK>
<SYNTAX LOOK OVER OBJECT = V-LOOK-OVER PRE-LOOK>
<SYNTAX LOOK FOR OBJECT (EVERYWHERE) = V-FIND>
<SYNTAX LOOK FOR OBJECT (EVERYWHERE) IN OBJECT
= V-SSEARCH-OBJECT-FOR PRE-SWITCH>
<SYNTAX LOOK UP OBJECT (EVERYWHERE) (FIND KLUDGEBIT) = V-RESEARCH PRE-RESEARCH>
<SYNTAX LOOK UP OBJECT (EVERYWHERE) IN OBJECT = V-RESEARCH PRE-RESEARCH>
<SYNTAX LOOK OBJECT = V-CHASTISE>
<VERB-SYNONYM LOOK L>
<SYNTAX LOWER OBJECT = V-LOWER PRE-TOUCH>
<SYNTAX LOWER OBJECT THROUGH OBJECT = V-PUT-THROUGH IDROP>
<SYNTAX LOWER OBJECT OUT OBJECT = V-PUT-THROUGH IDROP>
;<SYNTAX MAKE OBJECT (EVERYWHERE) = V-MAKE>
;<SYNTAX MAKE OBJECT (EVERYWHERE) WITH OBJECT (FIND ACTORBIT) = V-MAKE-WITH>
;<VERB-SYNONYM MAKE CREATE>
<SYNTAX MAP = V-MAP>
<SYNTAX MAYBE = V-MAYBE>
<SYNTAX MEASURE OBJECT = V-MEASURE>
<SYNTAX MEET OBJECT = V-MEET>
<SYNONYM MEET GREET>
<SYNTAX MOVE OBJECT (ON-GROUND IN-ROOM) = V-MOVE PRE-TOUCH>
<SYNTAX MOVE OBJECT WITH OBJECT (HAVE) = V-MOVE PRE-TOUCH>
<SYNTAX MOVE OBJECT OBJECT = V-MOVE-DIR PRE-TOUCH>
<SYNTAX MOVE OBJECT TO OBJECT = V-MOVE-TO PRE-TOUCH>
<SYNTAX MOVE DOWN OBJECT = V-LOWER PRE-TOUCH>
<SYNTAX MOVE UP OBJECT = V-RAISE PRE-TOUCH>
<SYNTAX MOVE AROUND OBJECT (FIND KLUDGEBIT) = V-WALK-AROUND>
<SYNTAX MOVE IN OBJECT = V-MOVE PRE-TOUCH>
;<SYNTAX MOVE OUT OBJECT = V-REMOVE> ;"pull out object"
<SYNTAX MOVE OBJECT (IN-ROOM CARRIED MANY) OUT OBJECT = V-TAKE PRE-TAKE>
<SYNTAX MOVE OBJECT (IN-ROOM CARRIED MANY) FROM OBJECT = V-TAKE PRE-TAKE>
<VERB-SYNONYM MOVE PULL>
<SYNTAX NO = V-NO>
<VERB-SYNONYM NO NOPE UH-UH NAH>
<SYNTAX OPEN OBJECT (FIND DOORBIT) = V-OPEN PRE-TOUCH>
<SYNTAX OPEN UP OBJECT (FIND DOORBIT) = V-OPEN PRE-TOUCH>
<SYNTAX OPEN OBJECT (FIND DOORBIT) WITH OBJECT (HAVE) = V-OPEN PRE-TOUCH>
<VERB-SYNONYM OPEN UNSHUTTER>
;<SYNTAX PASS OBJECT = V-PASS>
;<SYNTAX PASS OBJECT (MANY HELD HAVE) TO OBJECT (FIND ACTORBIT) (ON-GROUND)
= V-GIVE PRE-GIVE>
<SYNTAX PAY OBJECT (FIND ACTORBIT) = V-PAY>
<SYNTAX PAY FOR OBJECT (EVERYWHERE) = V-BUY>
<SYNTAX PAY OBJECT (MANY HELD HAVE) TO OBJECT (FIND ACTORBIT) (ON-GROUND)
= V-GIVE PRE-GIVE>
<SYNTAX PICK OBJECT = V-PICK>
<SYNTAX PICK OBJECT WITH OBJECT = V-PICK>
<SYNTAX PICK UP OBJECT (FIND TAKEBIT) (ON-GROUND IN-ROOM MANY)
= V-TAKE PRE-TAKE>
<SYNTAX PLAY WITH OBJECT = V-TOUCH PRE-TOUCH>
<SYNTAX PLAY OBJECT = V-PLAY>
<SYNTAX POINT AT OBJECT = V-POINT>
<SYNTAX POINT TO OBJECT = V-POINT>
<SYNTAX POINT OBJECT (HAVE TAKE) AT OBJECT = V-POINT>
<SYNTAX POINT OBJECT (HAVE TAKE) ON OBJECT = V-POINT>
;<SYNTAX POINT OBJECT (HAVE TAKE) IN OBJECT = V-POINT>
<VERB-SYNONYM POINT AIM WAVE FIRE>
<SYNTAX POUR OBJECT (HELD CARRIED HAVE TAKE) ON OBJECT = V-POUR>
<SYNTAX POUR OBJECT (HELD CARRIED HAVE TAKE) IN OBJECT = V-POUR>
<SYNTAX POUR OBJECT (MANY) FROM OBJECT (HAVE TAKE) = V-EMPTY-FROM>
<SYNTAX POUR OUT OBJECT (MANY) FROM OBJECT (HAVE TAKE) = V-EMPTY-FROM>
<SYNTAX POUR OUT OBJECT (HELD CARRIED HAVE TAKE) IN OBJECT = V-POUR>
<SYNTAX POUR OBJECT (MANY) OUT OBJECT (HAVE TAKE) = V-EMPTY-FROM>
<VERB-SYNONYM POUR SPILL>
<SYNTAX PRAY = V-PRAY>
<SYNTAX PRAY TO OBJECT = V-PRAY>
<VERB-SYNONYM PRAY WORSHIP>
<SYNTAX PUSH OBJECT (IN-ROOM ON-GROUND) = V-PUSH PRE-TOUCH>
<SYNTAX PUSH ON OBJECT (IN-ROOM ON-GROUND) = V-PUSH PRE-TOUCH>
;<SYNTAX PUSH OFF OBJECT (FIND KLUDGEBIT) = V-PUSH-OFF>
<SYNTAX PUSH DOWN OBJECT = V-LOWER PRE-TOUCH>
<SYNTAX PUSH OBJECT OBJECT = V-PUSH-DIR PRE-TOUCH>
<SYNTAX PUSH UP OBJECT = V-RAISE PRE-TOUCH>
<SYNTAX PUSH OBJECT UNDER OBJECT = V-PUT-UNDER>
<SYNTAX PUSH OBJECT (HELD MANY) IN OBJECT = V-PUT PRE-PUT>
<VERB-SYNONYM PUSH PRESS ;SQUEEZE RING ;"ring the doorbell">
<SYNTAX RAISE OBJECT = V-RAISE PRE-TOUCH>
<SYNTAX RAISE UP OBJECT = V-RAISE PRE-TOUCH>
<VERB-SYNONYM RAISE LIFT BOOST>
;<SYNTAX RAPE OBJECT (FIND ACTORBIT) = V-RAPE>
<SYNTAX REACH IN OBJECT (ON-GROUND IN-ROOM) = V-REACH-IN>
<SYNTAX READ OBJECT (FIND READBIT) (TAKE) = V-READ PRE-LOOK>
<SYNTAX READ THROUGH OBJECT (FIND READBIT) (TAKE) = V-READ PRE-LOOK>
<SYNTAX READ OBJECT (FIND READBIT) (TAKE) THROUGH OBJECT = V-READ PRE-LOOK>
<SYNTAX READ OBJECT (FIND READBIT) (TAKE) WITH OBJECT = V-READ PRE-LOOK>
<SYNTAX READ ABOUT OBJECT (EVERYWHERE) = V-RESEARCH PRE-RESEARCH>
<SYNTAX READ ABOUT OBJECT (EVERYWHERE) IN OBJECT = V-RESEARCH PRE-RESEARCH>
<SYNTAX READ IN OBJECT ABOUT OBJECT (EVERYWHERE) = V-SRESEARCH PRE-SWITCH>
<VERB-SYNONYM READ SKIM BROWSE>
<SYNTAX REMOVE OBJECT (FIND WORNBIT) (HELD MANY) = V-REMOVE>
<SYNTAX REMOVE OBJECT (IN-ROOM CARRIED MANY) WITH OBJECT ;(HAVE) = V-TAKE-WITH>
<SYNTAX REMOVE OBJECT (FIND TAKEBIT) (IN-ROOM CARRIED MANY)
FROM OBJECT = V-TAKE PRE-TAKE>
<VERB-SYNONYM REMOVE UNWRAP>
;<SYNTAX RETURN OBJECT (HELD CARRIED HAVE) = V-RETURN>
;<SYNTAX RETURN OBJECT (HELD CARRIED HAVE) TO OBJECT (ON-GROUND) = V-RETURN>
<SYNTAX RIDE OBJECT (FIND VEHBIT) = V-CLIMB-ON>
<SYNTAX RIDE OBJECT OBJECT ;(EVERYWHERE) = V-RIDE-DIR>
<SYNTAX RIDE OBJECT TO OBJECT (EVERYWHERE) = V-RIDE-DIR>
<SYNTAX RIDE ON OBJECT TO OBJECT (EVERYWHERE) = V-RIDE-DIR>
<SYNTAX RIDE IN OBJECT TO OBJECT (EVERYWHERE) = V-RIDE-DIR>
;<SYNTAX RIP OBJECT = V-RIP>
;<SYNTAX RIP OBJECT IN OBJECT = V-RIP>
;<SYNTAX RIP UP OBJECT = V-RIP>
;<SYNTAX RIP OBJECT WITH OBJECT = V-RIP>
;<VERB-SYNONYM RIP TEAR SHRED>
<SYNTAX ROLL OBJECT = V-ROLL PRE-TOUCH>
<SYNTAX ROLL OBJECT DOWN OBJECT (FIND KLUDGEBIT) = V-ROLL-DOWN PRE-TOUCH>
<SYNTAX ROLL OBJECT UP OBJECT (FIND KLUDGEBIT) = V-ROLL-UP PRE-TOUCH>
<SYNTAX ROLL OBJECT OBJECT = V-ROLL-DIR PRE-TOUCH>
<SYNTAX ROLL UP OBJECT = V-ROLL PRE-TOUCH>
<SYNTAX SADDLE OBJECT = V-SADDLE>
<SYNTAX SADDLE OBJECT WITH OBJECT (HAVE) = V-SADDLE>
<SYNTAX SAVE OBJECT = V-SAVE-SOMETHING>
<VERB-SYNONYM SAVE RESCUE>
<SYNTAX SAY OBJECT (EVERYWHERE) = V-SAY PRE-TELL>
<VERB-SYNONYM SAY UTTER ANSWER REPLY GUESS>
<SYNTAX SEARCH OBJECT = V-SEARCH PRE-TOUCH>
<SYNTAX SEARCH IN OBJECT = V-SEARCH PRE-TOUCH>
<SYNTAX SEARCH FOR OBJECT (EVERYWHERE) = V-FIND>
<SYNTAX SEARCH THROUGH OBJECT = V-SEARCH PRE-TOUCH>
<SYNTAX SEARCH OBJECT FOR OBJECT (EVERYWHERE) = V-SEARCH-OBJECT-FOR>
<SYNTAX SEARCH FOR OBJECT (EVERYWHERE) IN OBJECT
= V-SSEARCH-OBJECT-FOR PRE-SWITCH>
<VERB-SYNONYM SEARCH RUMMAGE>
<SYNTAX SEND OBJECT TO OBJECT = V-SEND>
<VERB-SYNONYM SEND MAIL SHIP>
<SYNTAX SHAKE OBJECT = V-SHAKE>
<SYNTAX SHAKE WITH OBJECT = V-SHAKE-WITH>
<SYNTAX SHAKE OBJECT WITH OBJECT = V-SHAKE-WITH>
<VERB-SYNONYM SHAKE BOUNCE>
<SYNTAX SHOW OBJECT = V-SHOW>
<SYNTAX SHOW OBJECT (HELD CARRIED MANY) TO OBJECT (FIND ACTORBIT) = V-SHOW>
<SYNTAX SHOW OBJECT (FIND ACTORBIT) OBJECT (HELD CARRIED MANY)
= V-SSHOW PRE-SWITCH>
<SYNTAX SING OBJECT = V-SING PRE-TELL>
<SYNTAX SING TO OBJECT = V-SING-TO PRE-TELL>
<SYNTAX SING OBJECT TO OBJECT = V-SING PRE-TELL>
<SYNTAX SINK OBJECT = V-SINK>
<SYNTAX SIT = V-SIT>
<SYNTAX SIT ON OBJECT ;(FIND VEHBIT) (ON-GROUND IN-ROOM) = V-CLIMB-ON>
<SYNTAX SIT DOWN OBJECT (FIND KLUDGEBIT) (ON-GROUND IN-ROOM) = V-SIT>
<SYNTAX SIT AT OBJECT (ON-GROUND IN-ROOM) = V-SIT>
<SYNTAX SIT IN OBJECT ;(FIND VEHBIT) (ON-GROUND IN-ROOM) = V-CLIMB-ON>
<SYNTAX SKIP = V-SKIP>
<VERB-SYNONYM SKIP HOP>
<SYNTAX SLEEP = V-SLEEP>
<SYNTAX SLEEP IN OBJECT (IN-ROOM ON-GROUND) = V-ENTER PRE-ENTER>
<SYNTAX SLEEP ON OBJECT (IN-ROOM ON-GROUND) = V-ENTER PRE-ENTER>
<VERB-SYNONYM SLEEP REST DOZE NAP SNOOZE>
<SYNTAX SLICE OBJECT WITH OBJECT (CARRIED HELD) = V-CUT>
<SYNTAX SLICE OBJECT OFF OBJECT (FIND KLUDGEBIT) = V-CUT>
<SYNTAX SLICE OFF OBJECT WITH OBJECT (CARRIED HELD) = V-CUT>
<SYNTAX SLICE DOWN OBJECT WITH OBJECT (CARRIED HELD) = V-CUT>
<SYNTAX SLICE THROUGH OBJECT WITH OBJECT (CARRIED HELD) = V-CUT>
<VERB-SYNONYM SLICE CUT CHOP>
<SYNTAX SLIDE DOWN OBJECT (FIND KLUDGEBIT) (ON-GROUND IN-ROOM) = V-CLIMB-DOWN>
;<SYNTAX SMEAR OBJECT (HELD MANY) ON OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX SMELL = V-SMELL PRE-SMELL>
<SYNTAX SMELL OBJECT = V-SMELL PRE-SMELL>
<VERB-SYNONYM SMELL SNIFF ;WHIFF>
<SYNTAX SNAP OBJECT = V-SNAP>
<SYNTAX STAND = V-STAND>
<SYNTAX STAND UP OBJECT (FIND KLUDGEBIT) = V-STAND>
<SYNTAX STAND ON OBJECT = V-STAND-ON>
<SYNTAX STAND IN OBJECT = V-ENTER PRE-ENTER>
<SYNTAX STAND BEHIND OBJECT = V-HIDE>
<SYNTAX STAND AT OBJECT = V-GET-NEAR>
<SYNTAX STAND BEFORE OBJECT = V-GET-NEAR>
<SYNTAX STAND UNDER OBJECT = V-GET-NEAR>
<VERB-SYNONYM STAND RISE>
<SYNTAX STICK OBJECT (HELD MANY) (FIND TAKEBIT) IN OBJECT (FIND CONTBIT)
= V-PUT PRE-PUT>
<SYNTAX STICK OBJECT (HELD MANY) ON OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX STICK OBJECT (HELD MANY) DOWN OBJECT = V-PUT-ON PRE-PUT>
;<SYNTAX STICK OBJECT (HELD MANY) BACK OBJECT = V-PUT PRE-PUT>
;<SYNTAX STICK OBJECT (HELD CARRIED) BEFORE OBJECT = V-PUT-NEAR IDROP>
;<SYNTAX STICK OBJECT (HELD MANY) BEFORE OBJECT = V-PUT-IN-FRONT>
<SYNTAX STICK OBJECT (HELD MANY) AROUND OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX STICK OBJECT (HELD MANY) OVER OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX STICK OBJECT (HELD MANY) ACROSS OBJECT = V-PUT-ON PRE-PUT>
<SYNTAX STICK DOWN OBJECT (HELD MANY HAVE) = V-DROP IDROP>
<SYNTAX STICK OBJECT (HAVE HELD MANY) UNDER OBJECT = V-PUT-UNDER>
<SYNTAX STICK ON OBJECT (FIND WEARBIT) (TAKE HAVE MANY) = V-WEAR>
<SYNTAX STICK OBJECT BEHIND OBJECT = V-PUT-BEHIND>
<SYNTAX STICK OBJECT (MANY) THROUGH OBJECT = V-PUT-THROUGH IDROP>
<SYNTAX STICK OBJECT (MANY) OUT OBJECT = V-PUT-THROUGH IDROP>
<SYNTAX STICK OUT OBJECT (FIND ONBIT) = V-OFF PRE-TOUCH>
;<SYNTAX STICK OBJECT (HELD CARRIED) AT OBJECT = V-PUT-NEAR IDROP>
;<SYNTAX STICK OBJECT (HAVE) AGAINST OBJECT = V-PUT-AGAINST>
<SYNTAX STICK OBJECT TO OBJECT = V-PUT-TO> ;"put bedbug to sleep"
<VERB-SYNONYM STICK PUT STUFF INSERT PLACE INSTALL>
<SYNTAX SUCK OBJECT = V-SUCK-ON PRE-TOUCH>
<SYNTAX SUCK ON OBJECT = V-SUCK-ON PRE-TOUCH>
<SYNTAX SUCK OBJECT WITH OBJECT (HAVE) = V-SUCK-WITH>
<SYNTAX SWAT OBJECT = V-SWAT>
<SYNTAX SWAT OBJECT WITH OBJECT (HAVE) = V-SWAT>
<SYNTAX SWIM = V-SWIM>
<SYNTAX SWIM IN OBJECT = V-SWIM>
<SYNTAX SWIM ACROSS OBJECT = V-SWIM>
<SYNTAX SWING OBJECT (HELD CARRIED HAVE) = V-SWING>
;<SYNTAX SWING OBJECT (HELD CARRIED HAVE) AT OBJECT (FIND ACTORBIT) = V-SWING>
;<SYNTAX SWING TO OBJECT = V-WALK-TO>
;<SYNTAX SWING OVER ;TO OBJECT = V-WALK-TO>
<SYNTAX TAKE OBJECT (FIND TAKEBIT) (ON-GROUND IN-ROOM MANY) = V-TAKE PRE-TAKE>
<SYNTAX TAKE OFF OBJECT (FIND KLUDGEBIT) (MANY) = V-TAKE-OFF>
<SYNTAX TAKE OUT OBJECT (FIND KLUDGEBIT) = V-EXIT>
<SYNTAX TAKE DOWN OBJECT (FIND KLUDGEBIT) = V-EXIT>
<SYNTAX TAKE IN OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-ENTER PRE-ENTER>
<SYNTAX TAKE ON OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-ENTER PRE-ENTER>
<SYNTAX TAKE UP OBJECT (FIND KLUDGEBIT) = V-STAND>
<SYNTAX TAKE OBJECT (CARRIED IN-ROOM MANY) OUT OBJECT = V-TAKE PRE-TAKE>
<SYNTAX TAKE OBJECT (CARRIED IN-ROOM MANY) OFF OBJECT = V-TAKE PRE-TAKE>
<SYNTAX TAKE OBJECT (IN-ROOM CARRIED MANY) FROM OBJECT = V-TAKE PRE-TAKE>
<SYNTAX TAKE OBJECT (IN-ROOM CARRIED MANY) IN OBJECT = V-TAKE PRE-TAKE>
<SYNTAX TAKE OBJECT (IN-ROOM CARRIED MANY) ON OBJECT = V-TAKE PRE-TAKE>
<SYNTAX TAKE OBJECT (IN-ROOM CARRIED MANY) WITH OBJECT ;(HAVE) = V-TAKE-WITH>
;<SYNTAX TAKE OUT OBJECT IN OBJECT = V-LEAP-OFF>
<SYNTAX TAKE UNDER OBJECT = V-CRAWL-UNDER>
<SYNTAX TAKE BEFORE OBJECT = V-GET-NEAR>
;<SYNTAX TAKE DRESSE OBJECT (FIND KLUDGEBIT) = V-GET-DRESSED>
;<SYNTAX TAKE UNDRES OBJECT (FIND KLUDGEBIT) = V-GET-UNDRESSED>
<VERB-SYNONYM TAKE GET GRAB HOLD CARRY>
<SYNTAX TALK TO OBJECT (FIND ACTORBIT) (IN-ROOM) = V-TELL PRE-TELL>
<VERB-SYNONYM TALK SPEAK>
;<SYNTAX TAP OBJECT = V-TOUCH PRE-TOUCH>
;<SYNTAX TAP ON OBJECT = V-KNOCK>
<SYNTAX TASTE OBJECT = V-TASTE>
;<SYNTAX TASTE OBJECT WITH OBJECT = V-DRINK-WITH PRE-INGEST>
<VERB-SYNONYM TASTE LICK NIBBLE>
<SYNTAX TELL OBJECT (FIND ACTORBIT) (IN-ROOM) = V-TELL PRE-TELL>
<SYNTAX TELL OBJECT (FIND ACTORBIT) ABOUT OBJECT (EVERYWHERE) = V-TELL-ABOUT>
<SYNTAX TELL OBJECT OBJECT = V-STELL>
<SYNTAX THANKS OBJECT = V-THANK>
<SYNTAX THANKS = V-THANK>
<VERB-SYNONYM THANKS THANK>
<SYNTAX THROW OBJECT (CARRIED) = V-THROW IDROP>
<SYNTAX THROW AWAY OBJECT (CARRIED) = V-THROW IDROP>
<SYNTAX THROW OVERBOARD OBJECT (HELD CARRIED) = V-THROW-OVERBOARD IDROP>
<SYNTAX THROW OBJECT (CARRIED) IN OBJECT = V-PUT PRE-PUT>
<SYNTAX THROW OBJECT (CARRIED) DOWN OBJECT = V-THROW IDROP>
<SYNTAX THROW OBJECT (CARRIED) AT OBJECT (ON-GROUND IN-ROOM) = V-THROW IDROP>
<SYNTAX THROW OBJECT (CARRIED) ON OBJECT (ON-GROUND IN-ROOM) = V-THROW IDROP>
<SYNTAX THROW OBJECT (CARRIED) TO OBJECT (ON-GROUND IN-ROOM)
= V-THROW-TO IDROP>
<SYNTAX THROW OBJECT (CARRIED) FROM OBJECT = V-THROW-FROM IDROP>
<SYNTAX THROW OBJECT (CARRIED) OFF OBJECT = V-THROW-FROM IDROP>
<SYNTAX THROW OBJECT (ON-GROUND IN-ROOM) OBJECT (CARRIED)
= V-STHROW PRE-SWITCH>
<SYNTAX THROW OBJECT (CARRIED) OVER OBJECT = V-THROW-OVER IDROP>
<SYNTAX THROW OBJECT (CARRIED) THROUGH OBJECT = V-PUT-THROUGH IDROP>
<SYNTAX THROW OBJECT (CARRIED) OUT OBJECT = V-PUT-THROUGH IDROP>
<VERB-SYNONYM THROW HURL TOSS CAST>
<SYNTAX TIE OBJECT (HELD) TO OBJECT = V-TIE>
<SYNTAX TIE UP OBJECT TO OBJECT = V-TIE>
<SYNTAX TIE OBJECT (HELD) AROUND OBJECT = V-TIE>
<VERB-SYNONYM TIE FASTEN ATTACH ;STRAP ;HOOK ;HITCH ;SECURE>
<SYNTAX TIME = V-TIME>
<VERB-SYNONYM TIME T>
<SYNTAX TIP OBJECT = V-TIP>
<SYNTAX TIP OVER OBJECT = V-TIP-OVER>
<SYNTAX TOUCH OBJECT = V-TOUCH PRE-TOUCH>
<SYNTAX TOUCH OBJECT WITH OBJECT (HAVE) = V-TOUCH PRE-TOUCH>
<SYNTAX TOUCH OBJECT (HAVE) TO OBJECT = V-STOUCH PRE-SWITCH>
<SYNTAX TOUCH OBJECT (HAVE) ON OBJECT = V-STOUCH PRE-SWITCH>
<VERB-SYNONYM TOUCH RUB FEEL PAT PET ;POKE ;FONDLE ;SCRATCH ;STROKE>
<SYNTAX TURN OBJECT = V-SET>
<SYNTAX TURN AROUND OBJECT (FIND KLUDGEBIT) = V-SET>
<SYNTAX TURN OBJECT TO OBJECT ;(EVERYWHERE) = V-SET>
<SYNTAX TURN OBJECT OBJECT = V-SET-DIR>
<SYNTAX TURN ON OBJECT (FIND LIGHTBIT) = V-ON PRE-TOUCH>
<SYNTAX TURN OFF OBJECT (FIND LIGHTBIT) = V-OFF PRE-TOUCH>
<SYNTAX TURN OBJECT (HELD MANY) ON OBJECT = V-PUT-ON PRE-PUT>
<VERB-SYNONYM TURN SET SPIN DIAL STEER ROTATE REVOLVE
;WIND ;SWITCH ;FLIP ;FLICK>
;<SYNTAX UNDRESS = V-UNDRESS>
;<SYNTAX UNDRESS OBJECT = V-UNDRESS>
;<VERB-SYNONYM UNDRESS STRIP>
<SYNTAX UNLOCK OBJECT WITH OBJECT (FIND KEYBIT) (HAVE) = V-UNLOCK PRE-LOCK>
<SYNTAX UNTIE OBJECT (ON-GROUND IN-ROOM HELD CARRIED) = V-UNTIE>
<VERB-SYNONYM UNTIE FREE UNSTRAP UNFASTEN UNATTACH UNKNOT>
<SYNTAX USE OBJECT = V-USE>
<SYNTAX WAIT = V-WAIT>
<SYNTAX WAIT FOR OBJECT (EVERYWHERE) = V-WAIT-FOR>
<VERB-SYNONYM WAIT Z>
<SYNTAX WAKE OBJECT (FIND KLUDGEBIT) = V-ALARM>
<SYNTAX WAKE UP OBJECT (FIND KLUDGEBIT) = V-ALARM>
<VERB-SYNONYM WAKE AWAKE ROUSE>
<SYNTAX WALK = V-WALK-AROUND>
<SYNTAX WALK OBJECT = V-WALK>
<SYNTAX WALK IN OBJECT = V-ENTER PRE-ENTER>
<SYNTAX WALK OUT OBJECT = V-ENTER PRE-ENTER>
<SYNTAX WALK ACROSS OBJECT = V-ENTER PRE-ENTER>
<SYNTAX WALK ON OBJECT = V-STAND-ON>
<SYNTAX WALK OVER OBJECT = V-ENTER PRE-ENTER>
<SYNTAX WALK WITH OBJECT (EVERYWHERE) = V-FOLLOW>
<SYNTAX WALK THROUGH OBJECT = V-ENTER PRE-ENTER>
<SYNTAX WALK AROUND OBJECT (FIND KLUDGEBIT) = V-WALK-AROUND>
<SYNTAX WALK UNDER OBJECT = V-CRAWL-UNDER>
<SYNTAX WALK BEHIND OBJECT = V-HIDE>
<SYNTAX WALK UP OBJECT (ON-GROUND IN-ROOM) = V-CLIMB-UP>
<SYNTAX WALK DOWN OBJECT (ON-GROUND IN-ROOM) = V-CLIMB-DOWN>
<SYNTAX WALK TO OBJECT (EVERYWHERE) = V-WALK-TO>
<SYNTAX WALK AWAY OBJECT (FIND KLUDGEBIT) = V-LEAVE>
<SYNTAX WALK TO OBJECT ON OBJECT = V-SRIDE-DIR PRE-SWITCH>
<SYNTAX WALK TO OBJECT IN OBJECT = V-SRIDE-DIR PRE-SWITCH>
<VERB-SYNONYM WALK GO RUN PROCEED STEP>
<SYNTAX WASH OBJECT = V-CLEAN>
<SYNTAX WASH UP OBJECT (FIND KLUDGEBIT) = V-CLEAN>
<SYNTAX WASH OFF OBJECT = V-CLEAN>
<SYNTAX WASH AWAY OBJECT = V-CLEAN>
<SYNTAX WASH OBJECT WITH OBJECT (HAVE) = V-CLEAN>
<SYNTAX WASH OBJECT IN OBJECT = V-CLEAN>
<SYNTAX WASH UP OBJECT WITH OBJECT (HAVE) = V-CLEAN>
<SYNTAX WASH OFF OBJECT WITH OBJECT (HAVE) = V-CLEAN>
<SYNTAX WASH AWAY OBJECT WITH OBJECT (HAVE) = V-CLEAN>
<VERB-SYNONYM WASH CLEAN SWEEP CLEAR SHINE WIPE SOAK>
;<SYNTAX WAVE OBJECT (HAVE) = V-WAVE>
;<SYNTAX WAVE OBJECT (HAVE) AT OBJECT = V-WAVE>
;<SYNTAX WAVE OBJECT (HAVE) IN OBJECT = V-WAVE> ;"in front of"
<SYNTAX WEAR OBJECT (FIND WEARBIT) (HELD CARRIED TAKE MANY HAVE) = V-WEAR>
<VERB-SYNONYM WEAR DON>
<SYNTAX WRAP OBJECT (HELD MANY) AROUND OBJECT = V-WRAP PRE-PUT>
<SYNTAX WRAP OBJECT IN OBJECT (HELD MANY) = V-SWRAP PRE-SWITCH>
<SYNTAX YAWN = V-YAWN>
<SYNTAX YAWN AT OBJECT = V-YAWN>
<SYNTAX YELL = V-YELL PRE-TELL>
<SYNTAX YELL OBJECT = V-YELL PRE-TELL>
<SYNTAX YELL AT OBJECT = V-YELL PRE-TELL>
<SYNTAX YELL TO OBJECT = V-YELL PRE-TELL>
<VERB-SYNONYM YELL SCREAM SHOUT>
<SYNTAX YES = V-YES>
<VERB-SYNONYM YES Y YUP OK OKAY SURE YEAH YEP>
<SYNTAX SIZUL = V-SACRED-WORD>
<VERB-SYNONYM SIZUL FZORTY XZILCH FUBLITSKEE ZASTIC AULDERFOO LIZOWURT
ELDABLITZ MORDEX HILDEBUD>
<SYNTAX ZAP OBJECT = V-ZAP>
<SYNTAX ZAP OBJECT WITH OBJECT (HAVE TAKE) = V-ZAP>
<SYNTAX ZAP OBJECT (HAVE TAKE) AT OBJECT = V-POINT>
<SYNTAX ZIPSO = V-NOT-SO-SACRED-WORD> ;"words on scrap of parchment"
<VERB-SYNONYM ZIPSO FLODOOR FURGALNETI>

624
top.zap Normal file
View File

@ -0,0 +1,624 @@
.SEGMENT "0"
.FUNCT MORE-SPECIFIC
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTR "[Please be more specific.]"
.FUNCT MAIN-LOOP,X
?PRG1: CALL1 MAIN-LOOP-1 >X
JUMP ?PRG1
.FUNCT DIR-VERB-PRSI?,NP
GET PARSE-RESULT,4
EQUAL? STACK,V?MOVE-DIR,V?RIDE-DIR,V?ROLL-DIR /?PRD3
GET PARSE-RESULT,4
EQUAL? STACK,V?SET-DIR \FALSE
?PRD3: GET NP,3
EQUAL? STACK,INTDIR,LEFT-RIGHT /FALSE
RTRUE
.FUNCT DIR-VERB-WORD?,WD
EQUAL? WD,W?WALK,W?GO,W?RUN /TRUE
RFALSE
.FUNCT MAIN-LOOP-1,ICNT,OCNT,NUM,OBJ,V,OBJ1,NP,NP1,CNT,TOFF,XX,TMP
CALL1 PARSER >P-WON
ZERO? P-WON /?CCL3
DLESS? 'P-ERRS,0 \?PRG6
SET 'P-ERRS,0
?PRG6: GET PARSE-RESULT,4 >PRSA
EQUAL? PRSA,V?UNDO \?CCL10
CALL2 PERFORM,PRSA
RSTACK
?CCL10: ISAVE >P-CAN-UNDO
EQUAL? P-CAN-UNDO,2 \?CND8
EQUAL? PRSA,V?SAVE \?CCL15
ICALL1 CANT-UNDO
RFALSE
?CCL15: SET 'P-CONT,-1
ICALL1 V-$REFRESH
RFALSE
?CND8: GET PARSE-RESULT,5 >P-PRSO
GET PARSE-RESULT,6 >P-PRSI
ZERO? P-PRSO /?CCL19
GET P-PRSO,3
EQUAL? INTDIR,STACK \?CCL19
GET P-PRSO,4
GET STACK,2
GETB STACK,6 >P-DIRECTION
JUMP ?CND17
?CCL19: ZERO? P-PRSI /?CND17
GET P-PRSI,3
EQUAL? INTDIR,STACK \?CND17
GET P-PRSI,4
GET STACK,2
GETB STACK,6 >P-DIRECTION
?CND17: GET PARSE-RESULT,1 >P-PRSA-WORD
SET 'CLOCK-WAIT,FALSE-VALUE
SET 'ICNT,0
SET 'OCNT,0
ZERO? P-PRSI /?CND25
GET P-PRSI,1 >ICNT
ZERO? ICNT /?CND25
SET 'P-MULT,ICNT
?CND25: ZERO? P-PRSO /?CND29
GET P-PRSO,1 >OCNT
ZERO? OCNT /?CND29
SET 'P-MULT,OCNT
?CND29: ZERO? OCNT \?CCL35
ZERO? ICNT /?CND33
?CCL35: EQUAL? PRSA,V?WALK /?CND33
ZERO? P-IT-OBJECT /?CND33
CALL2 ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK /?CND33
ZERO? ICNT /?CND42
SET 'CNT,0
?PRG44: MUL CNT,2
ADD NOUN-PHRASE-HEADER-LEN,STACK >TOFF
GET P-PRSI,TOFF
EQUAL? IT,STACK \?CCL48
PUT P-PRSI,TOFF,P-IT-OBJECT
ICALL TELL-PRONOUN,P-IT-OBJECT,IT
JUMP ?CND42
?CCL48: IGRTR? 'CNT,ICNT \?PRG44
?CND42: ZERO? OCNT /?CND33
SET 'CNT,0
?PRG52: MUL CNT,2
ADD NOUN-PHRASE-HEADER-LEN,STACK >TOFF
GET P-PRSO,TOFF
EQUAL? IT,STACK \?CCL56
PUT P-PRSO,TOFF,P-IT-OBJECT
ICALL TELL-PRONOUN,P-IT-OBJECT,IT
JUMP ?CND33
?CCL56: IGRTR? 'CNT,OCNT \?PRG52
?CND33: ZERO? OCNT \?CCL60
SET 'NUM,OCNT
JUMP ?CND58
?CCL60: GRTR? OCNT,1 \?CCL62
ZERO? ICNT \?CCL65
SET 'OBJ,FALSE-VALUE
JUMP ?CND63
?CCL65: GET P-PRSI,3 >OBJ
GET P-PRSI,4 >NP
?CND63: SET 'NUM,OCNT
JUMP ?CND58
?CCL62: GRTR? ICNT,1 \?CCL69
GET P-PRSO,3 >OBJ
GET P-PRSI,4 >NP
SET 'NUM,ICNT
JUMP ?CND58
?CCL69: SET 'NUM,1
?CND58: ZERO? OBJ \?CND72
EQUAL? ICNT,1 \?CND72
GET P-PRSI,3 >OBJ
GET P-PRSI,4 >NP
?CND72: ZERO? LIT \?CCL80
CALL1 SEE-VERB?
ZERO? STACK /?CCL80
ICALL1 TELL-TOO-DARK
SET 'P-CONT,-1
JUMP ?CND78
?CCL80: EQUAL? PRSA,V?WALK \?CCL84
ZERO? P-WALK-DIR /?PRD87
PUSH P-WALK-DIR
JUMP ?PEN85
?PRD87: GET P-PRSO,3
?PEN85: CALL PERFORM,PRSA,STACK >V
JUMP ?CND78
?CCL84: ZERO? NUM \?CCL89
CALL2 PERFORM,PRSA >V
SET 'PRSO,FALSE-VALUE
SET 'PRSO-NP,FALSE-VALUE
JUMP ?CND78
?CCL89: GRTR? OCNT,1 \?CCL91
EQUAL? PRSA,V?COUNT \?CCL91
CALL PERFORM,PRSA,ROOMS >V
JUMP ?CND78
?CCL91: SET 'CNT,-1
SET 'TMP,0
?PRG94: INC 'CNT
LESS? CNT,NUM /?CND96
ZERO? TMP \?CND78
ICALL1 MORE-SPECIFIC
JUMP ?CND78
?CND96: GRTR? ICNT,1 /?CCL102
MUL CNT,2
ADD STACK,NOUN-PHRASE-HEADER-LEN
GET P-PRSO,STACK >OBJ1
MUL CNT,2
ADD STACK,4
GET P-PRSO,STACK >NP1
JUMP ?CND100
?CCL102: MUL CNT,2
ADD STACK,NOUN-PHRASE-HEADER-LEN
GET P-PRSI,STACK >OBJ1
MUL CNT,2
ADD STACK,4
GET P-PRSI,STACK >NP1
?CND100: GRTR? NUM,1 /?CCL108
GET NP1,3
EQUAL? STACK,NP-QUANT-ALL \?CND107
?CCL108: EQUAL? OBJ1,FALSE-VALUE,NOT-HERE-OBJECT \?CCL113
ICALL2 NP-PRINT,NP1
PRINTI ": "
ICALL2 NP-CANT-SEE,NP1
JUMP ?PRG94
?CCL113: GET NP1,3
EQUAL? STACK,NP-QUANT-ALL \?CCL115
CALL VERB-ALL-TEST,OBJ1,OBJ
ZERO? STACK /?PRG94
?CCL115: CALL2 ACCESSIBLE?,OBJ1
ZERO? STACK /?PRG94
EQUAL? OBJ1,PLAYER /?PRG94
EQUAL? OBJ1,IT \?CCL124
ICALL2 DPRINT,P-IT-OBJECT
JUMP ?CND122
?CCL124: ICALL2 DPRINT,OBJ1
?CND122: PRINTI ": "
?CND107: SET 'TMP,TRUE-VALUE
GRTR? ICNT,1 /?CCL127
SET 'PRSO,OBJ1
SET 'PRSO-NP,NP1
SET 'PRSI,OBJ
SET 'PRSI-NP,NP
JUMP ?CND125
?CCL127: SET 'PRSO,OBJ
SET 'PRSO-NP,NP
SET 'PRSI,OBJ1
SET 'PRSI-NP,NP1
?CND125: EQUAL? IT,PRSI,PRSO \?CND128
CALL FIX-HIM-HER-IT,IT,P-IT-OBJECT
ZERO? STACK /?PRG94
?CND128: EQUAL? HER,PRSI,PRSO \?CND132
CALL FIX-HIM-HER-IT,HER,P-HER-OBJECT
ZERO? STACK /?PRG94
?CND132: EQUAL? HIM,PRSI,PRSO \?CND136
CALL FIX-HIM-HER-IT,HIM,P-HIM-OBJECT
ZERO? STACK /?PRG94
?CND136: ICALL2 QCONTEXT-CHECK,PRSO
GET PARSE-RESULT,3
GETB STACK,5 >XX
ZERO? PRSO /?CND140
BTST XX,128 /?CND140
BTST XX,192 /?CND140
CALL2 META-LOC,PRSO >V
ZERO? V /?CND140
IN? V,ROOMS \?CND140
CALL2 META-LOC,WINNER
CALL GLOBAL-IN?,PRSO,STACK
ZERO? STACK \?CND140
CALL2 META-LOC,WINNER
EQUAL? V,STACK /?CND140
ICALL2 NOT-HERE,PRSO
JUMP ?PRG94
?CND140: ZERO? PRSO /?CND149
BAND 96,XX
ZERO? STACK /?CND149
BTST XX,128 /?CND149
CALL ITAKE-CHECK,PRSO,XX >V
EQUAL? M-FATAL,V /?CND78
ZERO? V \?PRG94
?CND149: ZERO? PRSI /?CND159
GET PARSE-RESULT,3
GETB STACK,9 >XX
BAND 96,XX
ZERO? STACK /?CND159
BTST XX,128 /?CND159
CALL ITAKE-CHECK,PRSI,XX >V
EQUAL? M-FATAL,V /?CND78
ZERO? V \?PRG94
?CND159: CALL PERFORM,PRSA,PRSO,PRSI >V
EQUAL? M-FATAL,V /?CND78
EQUAL? P-CONT,-1 \?PRG94
?CND78: SET 'OPRSO,PRSO
ZERO? CLOCK-WAIT \?CND173
CALL1 GAME-VERB?
ZERO? STACK \?CND173
LOC WINNER >V
ZERO? V /?CND177
IN? V,ROOMS /?CND177
GETP V,P?ACTION
CALL D-APPLY,STR?16,STACK,M-END >V
?CND177: GETP HERE,P?ACTION
CALL D-APPLY,STR?16,STACK,M-END >V
?CND173: EQUAL? M-FATAL,V \?CND181
SET 'P-CONT,-1
?CND181: ZERO? CLOCK-WAIT \?CND183
CALL1 GAME-VERB?
ZERO? STACK \?CND183
SET 'CLOCKER-RUNNING,1
CALL1 CLOCKER >V
SET 'CLOCKER-RUNNING,2
EQUAL? M-FATAL,V \?CND183
SET 'P-CONT,-1
?CND183: GET PARSE-RESULT,12 >V
ZERO? V /?CND1
GET V,1
LESS? 1,STACK \?CND1
EQUAL? P-CONT,-1 /?CND1
CALL2 HACK-TELL-1,V >V
EQUAL? M-FATAL,V \?CCL196
SET 'P-CONT,-1
JUMP ?CND1
?CCL196: ZERO? V /?CND1
JUMP ?PRG6
?CCL3: SET 'CLOCK-WAIT,TRUE-VALUE
SET 'P-CONT,FALSE-VALUE
?CND1: SET 'PRSA,FALSE-VALUE
SET 'PRSO,FALSE-VALUE
SET 'PRSO-NP,FALSE-VALUE
SET 'PRSI,FALSE-VALUE
RETURN PRSI
.FUNCT FIX-HIM-HER-IT,PRON,OBJ
ZERO? OBJ \?CCL3
ICALL1 MORE-SPECIFIC
RFALSE
?CCL3: CALL2 VISIBLE?,OBJ
ZERO? STACK \?CCL5
ICALL2 NOT-HERE,OBJ
RFALSE
?CCL5: EQUAL? PRSO,PRON \?CND6
SET 'PRSO,OBJ
ICALL TELL-PRONOUN,OBJ,PRON
?CND6: EQUAL? PRSI,PRON \TRUE
SET 'PRSI,OBJ
ICALL TELL-PRONOUN,OBJ,PRON
RTRUE
.FUNCT TELL-PRONOUN,OBJ,PRON
FSET? PRON,TOUCHBIT /FALSE
EQUAL? OPRSO,OBJ /FALSE
PRINTI "["""
ICALL2 DPRINT,PRON
PRINTI """ meaning "
ICALL2 TELL-THE,OBJ
PRINTR "]"
.FUNCT FIND-A-WINNER,RM,OTHER,WHO,N
ASSIGNED? 'RM /?CND1
SET 'RM,HERE
?CND1: ZERO? QCONTEXT /?CCL5
IN? QCONTEXT,RM \?CCL5
RETURN QCONTEXT
?CCL5: FIRST? RM >OTHER /?BOGUS8
?BOGUS8: SET 'WHO,FALSE-VALUE
?PRG9: ZERO? OTHER \?CCL13
RETURN WHO
?CCL13: FSET? OTHER,PERSONBIT \?CND11
FSET? OTHER,INVISIBLE /?CND11
EQUAL? OTHER,PLAYER /?CND11
IGRTR? 'N,1 /FALSE
SET 'WHO,OTHER
?CND11: NEXT? OTHER >OTHER /?PRG9
JUMP ?PRG9
.FUNCT QCONTEXT-CHECK,PER,WHO
EQUAL? PRSA,V?TELL-ABOUT,V?SHOW \FALSE
EQUAL? PER,PLAYER \FALSE
CALL2 FIND-A-WINNER,HERE >WHO
ZERO? WHO /?CND7
SET 'QCONTEXT,WHO
?CND7: CALL1 QCONTEXT-GOOD?
ZERO? STACK /FALSE
EQUAL? WINNER,PLAYER \FALSE
SET 'WINNER,QCONTEXT
ICALL2 TELL-SAID-TO,QCONTEXT
RTRUE
.FUNCT TELL-SAID-TO,PER
PRINTI "[said to "
ICALL2 DPRINT,PER
PRINTR "]"
.FUNCT QCONTEXT-GOOD?
ZERO? QCONTEXT /FALSE
FSET? QCONTEXT,PERSONBIT \FALSE
CALL2 META-LOC,QCONTEXT
EQUAL? HERE,STACK \FALSE
RETURN QCONTEXT
.FUNCT META-LOC,OBJ,INV,L
LOC OBJ >L
?PRG1: EQUAL? FALSE-VALUE,OBJ,L /FALSE
EQUAL? L,LOCAL-GLOBALS,GLOBAL-OBJECTS,GENERIC-OBJECTS \?CCL7
RETURN L
?CCL7: IN? OBJ,ROOMS \?CCL9
RETURN OBJ
?CCL9: ZERO? INV /?CND10
FSET? OBJ,INVISIBLE /FALSE
?CND10: SET 'OBJ,L
LOC OBJ >L
JUMP ?PRG1
.FUNCT CANT-UNDO
PRINTR "[I can't undo that now.]"
.FUNCT NOT-HERE-VERB?,V
EQUAL? V,V?WALK-TO,V?RESEARCH /TRUE
RFALSE
.FUNCT SEE-VERB?
EQUAL? PRSA,V?SEARCH,V?READ,V?LOOK-UNDER /TRUE
EQUAL? PRSA,V?LOOK-INSIDE,V?LOOK-DOWN,V?LOOK-BEHIND /TRUE
EQUAL? PRSA,V?LOOK,V?TAKE,V?FIND /TRUE
EQUAL? PRSA,V?EXAMINE,V?COUNT,V?CHASTISE /TRUE
RFALSE
.FUNCT PERFORM,PA,PO,PI,V,OA,OO,OI,OQ,OS,X
SET 'OA,PRSA
SET 'OO,PRSO
SET 'OI,PRSI
ZERO? OO /?CCL3
EQUAL? OO,PI \?CCL3
SET 'OBJ-SWAP,TRUE-VALUE
JUMP ?CND1
?CCL3: ZERO? OI /?CCL7
EQUAL? OI,PO \?CCL7
SET 'OBJ-SWAP,TRUE-VALUE
JUMP ?CND1
?CCL7: SET 'OBJ-SWAP,FALSE-VALUE
?CND1: SET 'PRSA,PA
SET 'PRSI,PI
SET 'PRSO,PO
SET 'V,FALSE-VALUE
ZERO? PRSI /?CND10
ICALL2 THIS-IS-IT,PRSI
?CND10: ZERO? PRSO /?CND12
EQUAL? PRSA,V?WALK /?CND12
ICALL2 THIS-IS-IT,PRSO
?CND12: EQUAL? WINNER,PLAYER /?CND16
ICALL2 THIS-IS-IT,WINNER
?CND16: SET 'PO,PRSO
SET 'PI,PRSI
EQUAL? PRSA,V?STOUCH,V?SWRAP /?CND18
EQUAL? PRSA,V?STHROW,V?SSHOW,V?SPUT-ON /?CND18
EQUAL? PRSA,V?SSEARCH-OBJECT-FOR,V?SRIDE-DIR,V?ASK-ABOUT /?CND18
GETP WINNER,P?ACTION
CALL D-APPLY,STR?17,STACK,M-WINNER >V
?CND18: ZERO? V \?CND24
LOC WINNER
IN? STACK,ROOMS /?CND24
LOC WINNER
GETP STACK,P?ACTION
CALL D-APPLY,STR?18,STACK,M-BEG >V
?CND24: ZERO? V \?CND28
GETP HERE,P?ACTION
CALL D-APPLY,STR?18,STACK,M-BEG >V
?CND28: ZERO? V \?CND30
GET PREACTIONS,PA
CALL D-APPLY,STR?19,STACK >V
?CND30: SET 'NOW-PRSI,1
ZERO? V \?CND33
ZERO? PI /?CND33
EQUAL? PRSA,V?WALK /?CND33
LOC PI
ZERO? STACK /?CND33
LOC PI
GETP STACK,P?CONTFCN >V
ZERO? V /?CND33
CALL D-APPLY,STR?20,V,M-CONTAINER >V
?CND33: ZERO? V \?CND41
ZERO? PI /?CND41
EQUAL? PI,GLOBAL-HERE \?CND45
GETP HERE,P?ACTION
CALL D-APPLY,STR?21,STACK >V
?CND45: ZERO? V \?CND41
GETP PI,P?ACTION
CALL D-APPLY,STR?21,STACK >V
?CND41: SET 'NOW-PRSI,0
ZERO? V \?CND49
ZERO? PO /?CND49
EQUAL? PRSA,V?WALK /?CND49
LOC PO
ZERO? STACK /?CND49
LOC PO
GETP STACK,P?CONTFCN >V
ZERO? V /?CND49
CALL D-APPLY,STR?20,V,M-CONTAINER >V
?CND49: ZERO? V \?CND57
ZERO? PO /?CND57
EQUAL? PRSA,V?WALK /?CND57
EQUAL? PO,GLOBAL-HERE \?CND62
GETP HERE,P?ACTION
CALL D-APPLY,STR?22,STACK >V
?CND62: ZERO? V \?CND57
GETP PO,P?ACTION
CALL D-APPLY,STR?22,STACK >V
?CND57: ZERO? V \?CND66
GET ACTIONS,PA
CALL D-APPLY,FALSE-VALUE,STACK >V
?CND66: EQUAL? M-FATAL,V \?CND69
SET 'P-CONT,-1
?CND69: SET 'PRSA,OA
SET 'PRSO,OO
SET 'PRSI,OI
RETURN V
.FUNCT TELL-TOO-DARK
SET 'P-CONT,-1
PRINT TOO-DARK
EQUAL? PRSA,V?LOOK \?CCL3
CALL1 GRUE-PIT-WARNING
RSTACK
?CCL3: CRLF
RTRUE
.FUNCT ITAKE-CHECK,OBJ,BITS,TAKEN
EQUAL? OBJ,IT \?CND1
SET 'OBJ,P-IT-OBJECT
?CND1: CALL HELD?,OBJ,WINNER
ZERO? STACK \FALSE
EQUAL? OBJ,HANDS,ROOMS /FALSE
FSET? OBJ,TRYTAKEBIT /?CND8
EQUAL? WINNER,PLAYER /?CCL12
SET 'TAKEN,TRUE-VALUE
JUMP ?CND8
?CCL12: BTST BITS,32 \?CND8
CALL ITAKE,FALSE-VALUE,OBJ
EQUAL? STACK,TRUE-VALUE \?CND8
SET 'TAKEN,TRUE-VALUE
?CND8: ZERO? TAKEN \FALSE
BTST BITS,64 \FALSE
BTST BITS,128 /FALSE
PRINTC 91
EQUAL? WINNER,PLAYER \?CCL24
PRINTI "You are"
JUMP ?CND22
?CCL24: ICALL2 TELL-CTHE,WINNER
PRINTI " is"
?CND22: PRINTI "n't holding "
ICALL2 TELL-THE,OBJ
ICALL2 THIS-IS-IT,OBJ
PRINTR "!]"
.FUNCT D-APPLY,STR,FCN,FOO,RES
ZERO? FCN /FALSE
ZERO? FOO /?CCL6
CALL FCN,FOO >RES
RETURN RES
?CCL6: CALL FCN >RES
RETURN RES
.FUNCT NOT-HERE,OBJ,CLOCK
ZERO? CLOCK \?CND1
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTI "[But"
?CND1: PRINTC 32
ICALL2 TELL-THE,OBJ
PRINTI " isn't "
CALL2 VISIBLE?,OBJ
ZERO? STACK /?CCL5
PRINTI "close enough"
CALL1 SPEAKING-VERB?
ZERO? STACK /?CND6
PRINTI " to hear you"
?CND6: PRINTC 46
JUMP ?CND3
?CCL5: PRINTI "here!"
?CND3: ICALL2 THIS-IS-IT,OBJ
ZERO? CLOCK \?CND8
PRINTC 93
?CND8: CRLF
RTRUE
.FUNCT SPEAKING-VERB?,A
ASSIGNED? 'A /?CND1
SET 'A,PRSA
?CND1: EQUAL? A,V?ASK-ABOUT,V?ASK-FOR,V?HELLO /TRUE
EQUAL? A,V?NO,V?TELL,V?TELL-ABOUT /TRUE
EQUAL? A,V?YES /TRUE
RFALSE
.FUNCT GET-OWNER,OBJ,TMP,NP
CALL2 GET-NP,OBJ >NP
ZERO? NP /FALSE
GET NP,4 >TMP
ZERO? TMP \?CTR5
GET NP,1 >TMP
ZERO? TMP /?CCL6
GET TMP,2 >TMP
ZERO? TMP /?CCL6
?CTR5: LESS? 0,TMP \FALSE
GRTR? TMP,LAST-OBJECT /FALSE
RETURN TMP
?CCL6: GETP OBJ,P?OWNER >TMP
ZERO? TMP /FALSE
LESS? 0,TMP \?CCL17
GRTR? TMP,LAST-OBJECT \FALSE
?CCL17: RETURN PLAYER
.FUNCT GET-NP,OBJ,PRSI?
SET 'PRSI?,NOW-PRSI
EQUAL? OBJ,PRSO,PRSI \FALSE
ZERO? OBJ /?CND1
EQUAL? OBJ,PRSO \?CCL7
SET 'PRSI?,FALSE-VALUE
JUMP ?CND1
?CCL7: SET 'PRSI?,TRUE-VALUE
?CND1: ZERO? OBJ-SWAP /?CCL10
ZERO? PRSI? /?CCL13
RETURN PRSO-NP
?CCL13: RETURN PRSI-NP
?CCL10: ZERO? PRSI? /?CCL15
RETURN PRSI-NP
?CCL15: RETURN PRSO-NP
.FUNCT NOUN-USED?,OBJ,WD1,WD2,WD3,X
CALL2 GET-NP,OBJ >X
ZERO? X /FALSE
GET X,2 >X
ZERO? X /FALSE
EQUAL? X,WD1,WD2,WD3 /TRUE
RFALSE
.FUNCT ADJ-USED?,OBJ,WD1,WD2,WD3,NP,CT
CALL2 GET-NP,OBJ >NP
ZERO? NP /FALSE
GET NP,1 >NP
ZERO? NP /FALSE
GET NP,2
EQUAL? PLAYER,STACK \?CCL8
EQUAL? W?MY,WD1,WD2,WD3 \?CCL8
RETURN W?MY
?CCL8: GET NP,4 >CT
GRTR? CT,0 \FALSE
ADD NP,10 >NP
INTBL? WD1,NP,CT \?CCL15
RETURN WD1
?CCL15: ZERO? WD2 /FALSE
INTBL? WD2,NP,CT \?CCL20
RETURN WD2
?CCL20: ZERO? WD3 /FALSE
INTBL? WD3,NP,CT \FALSE
RETURN WD3
.ENDSEG
.ENDI

943
top.zil Normal file
View File

@ -0,0 +1,943 @@
"TOP for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
<FILE-FLAGS MDL-ZIL?>
<BEGIN-SEGMENT 0>
<DEFAULTS-DEFINED
ADJ-USED?
ASKING-VERB-WORD?
CANT-UNDO
CAPITAL-NOUN?
COLLECTIVE-VERB?
DIR-VERB?
DIR-VERB-PRSI?
DIR-VERB-WORD?
FIND-A-WINNER
GAME-VERB?
;I-ASSUME-STRING
ITAKE-CHECK
META-LOC
MORE-SPECIFIC
NO-M-WINNER-VERB?
NOT-HERE
NOT-HERE-VERB?
NOUN-USED?
OWNERS
P-PRONOUNS
QCONTEXT-CHECK
SEE-VERB?
SIBREAKS
SPEAKING-VERB?
;TELL-I-ASSUME
TELL-PRONOUN
TELL-SAID-TO
TELL-TOO-DARK
VERB-ALL-TEST>
<DEFAULT-DEFINITION SIBREAKS
<SETG20 SIBREAKS ".,\"'!?">>
<DEFAULT-DEFINITION OWNERS
<CONSTANT OWNERS <TABLE (PURE LENGTH) PLAYER>>>
;<DEFAULT-DEFINITION I-ASSUME-STRING
<CONSTANT I-ASSUME "[I assume you mean:">>
;<DEFAULT-DEFINITION TELL-I-ASSUME
<DEFINE TELL-I-ASSUME (OBJ "OPT" PRON)
<COND (<AND <NOT <FSET? .PRON ,TOUCHBIT>>
<NOT <EQUAL? ,OPRSO .OBJ>>>
<FSET .PRON ,TOUCHBIT>
<TELL ,I-ASSUME>
<TELL !\ >
<TELL-THE .OBJ>
<TELL ".]" CR>)>>>
<DEFAULT-DEFINITION MORE-SPECIFIC
<DEFINE MORE-SPECIFIC ()
<SETG CLOCK-WAIT T>
<TELL "[Please be more specific.]" CR>>>
<DEFMAC VERB? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L
(<CHTYPE <PARSE <STRING "V?"<SPNAME .ATM>>> GVAL>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSA !.L> !.O)>
<SET L ()>>>
<DEFMAC DOBJ? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L (<COND (<TYPE? .ATM ATOM>
<CHTYPE .ATM GVAL>)
(T .ATM)>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSO !.L> !.O)>
<SET L ()>>>
<DEFMAC IOBJ? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L (<COND (<TYPE? .ATM ATOM>
<CHTYPE .ATM GVAL>)
(T .ATM)>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSI !.L> !.O)>
<SET L ()>>>
<DEFMAC PROB ('BASE?)
<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>
<DEFMAC T? ('TERM) <FORM NOT <FORM ZERO? .TERM>>>
<IF-P-DEBUGGING-PARSER
<SYNTAX \#DBG = V-PDEBUG>
<GLOBAL P-DBUG:FLAG <>>
<GLOBAL IDEBUG:FLAG <>>
<DEFINE V-PDEBUG ()
<COND (<T? ,PRSO>
<SETG IDEBUG <NOT ,IDEBUG>>
<TELL !\{ N ,IDEBUG "}" CR>)
(<SETG P-DBUG <NOT ,P-DBUG>>
<TELL "Find them bugs, boss!" CR>)
(T <TELL "No bugs left, eh?" CR>)>>>
<SETG P-PRSI <>>
<SETG P-PRSO <>>
<SETG PRSA 0>
<IF-P-BE-VERB
<GLOBAL PRSQ 0>
<GLOBAL PRSS:OBJECT 0>>
<GLOBAL PRSI:OBJECT 0>
<GLOBAL PRSO:OBJECT 0>
<GLOBAL P-MULT <>>
<GLOBAL OPRSO <>>
<GLOBAL P-CONT:NUMBER 0>
<CONSTANT P-LEXWORDS 1> "Byte offset to # of entries in LEXV"
<CONSTANT P-LEXSTART 1> "Word offset to start of LEXV entries"
<CONSTANT P-LEXELEN 2> "Number of words per LEXV entry"
<CONSTANT P-WORDLEN 4>
<GLOBAL P-WON <>>
"<CONSTANT M-FATAL 2>"
<DEFMAC RFATAL ()
'<PROG () <PUSH 2> <RSTACK>>>
"<CONSTANT M-BEG 1>
<CONSTANT M-END 6>
<CONSTANT M-CONT 7>
<CONSTANT M-WINNER 8>"
<DEFINE MAIN-LOOP ("AUX" X) <REPEAT () <SET X <MAIN-LOOP-1>>>>
<GLOBAL P-PRSA-WORD <>>
<GLOBAL PRSO-NP <>>
<GLOBAL PRSI-NP <>>
<GLOBAL CLOCKER-RUNNING:NUMBER 2>
<DEFAULT-DEFINITION DIR-VERB?
<DEFMAC DIR-VERB? () '<VERB? WALK>>>
<DEFAULT-DEFINITION DIR-VERB-PRSI?
<DEFINE DIR-VERB-PRSI? (NP)
<AND <EQUAL? <PARSE-ACTION ,PARSE-RESULT>
,V?MOVE-DIR ,V?RIDE-DIR ,V?ROLL-DIR ,V?SET-DIR>
<NOT <EQUAL? <NOUN-PHRASE-OBJ1 .NP> ,INTDIR ,LEFT-RIGHT>>>>>
<DEFAULT-DEFINITION DIR-VERB-WORD?
<DEFINE DIR-VERB-WORD? (WD) <EQUAL? .WD ,W?WALK ,W?GO ,W?RUN>>>
<DEFAULT-DEFINITION COLLECTIVE-VERB?
<DEFMAC COLLECTIVE-VERB? () '<VERB? COUNT ;COMPARE>>>
<IF-UNDO <GLOBAL P-CAN-UNDO:NUMBER 0>>
<DEFINE MAIN-LOOP-1 ACT ("AUX" ICNT OCNT NUM (OBJ <>) V OBJ1 (NP <>) NP1)
<COND (<SETG P-WON <PARSER>>
<IFN-P-BE-VERB <COND (<L? <SETG P-ERRS <- ,P-ERRS 1>> 0>
<SETG P-ERRS 0>)>>
<PROG ()
<SETG PRSA <PARSE-ACTION ,PARSE-RESULT>>
;<COND (<ZERO? <PARSE-SUBJ ,PARSE-RESULT>>
<SETG PRSA <PARSE-ACTION ,PARSE-RESULT>>)
(<NOT <EQUAL? <SET V <PARSE-QW ,PARSE-RESULT>> 0 1>>
<SETG PRSA <SYNTAX-ID
<GET-SYNTAX <VERB-ONE <WORD-VERB-STUFF .V>> 1 1>>>)
(T
<SETG PRSA <SYNTAX-ID <PARSE-QUERY-SYNTAX ,PARSE-RESULT>>>)>
<IF-UNDO
<COND (<VERB? UNDO>
;<AND <EQUAL? <ZGET ,TLEXV 0> ,W?UNDO>
<EQUAL? ,P-LEN 1>
<V-UNDO>>
<RETURN <PERFORM ,PRSA> .ACT>)
(T
<SETG P-CAN-UNDO <ISAVE>>
<COND (<EQUAL? ,P-CAN-UNDO 2>
<COND (<OR ;<T? ,P-CONT> <VERB? SAVE>>
<CANT-UNDO>)
(T
<SETG P-CONT -1>
<V-$REFRESH>
;<TELL "[Undone.]|">)>
<RETURN <> .ACT>)>)>>
<SETG P-PRSO <PARSE-OBJ1 ,PARSE-RESULT>>
<SETG P-PRSI <PARSE-OBJ2 ,PARSE-RESULT>>
<COND (<AND ,P-PRSO
<==? ,INTDIR <NOUN-PHRASE-OBJ1 ,P-PRSO>>>
<SETG P-DIRECTION
<WORD-DIR-ID
<NP-NAME <NOUN-PHRASE-NP1 ,P-PRSO>>>>)
(<AND ,P-PRSI
<==? ,INTDIR <NOUN-PHRASE-OBJ1 ,P-PRSI>>>
<SETG P-DIRECTION
<WORD-DIR-ID
<NP-NAME <NOUN-PHRASE-NP1 ,P-PRSI>>>>)>
<SETG P-PRSA-WORD <PARSE-VERB ,PARSE-RESULT>>
<SETG CLOCK-WAIT <>>
<SET ICNT 0>
<SET OCNT 0>
<COND (,P-PRSI
<SET ICNT <NOUN-PHRASE-COUNT ,P-PRSI>>
<COND (<NOT <0? .ICNT>> ;<NP-MULTI? ,P-PRSI>
<SETG P-MULT .ICNT>)>)>
<COND (,P-PRSO
<SET OCNT <NOUN-PHRASE-COUNT ,P-PRSO>>
<COND (<NOT <0? .OCNT>> ;<NP-MULTI? ,P-PRSO>
<SETG P-MULT .OCNT>)>)>
<COND (<AND <ZERO? .OCNT> <ZERO? .ICNT>>
T)
(<AND <NOT <DIR-VERB?>>
<T? ,P-IT-OBJECT>
<ACCESSIBLE? ,P-IT-OBJECT>>
<COND (<T? .ICNT>
<REPEAT ((CNT 0) TOFF)
<SET TOFF <+ ,NOUN-PHRASE-HEADER-LEN <* .CNT 2>>>
<COND (<==? ,IT <ZGET ,P-PRSI .TOFF>>
<ZPUT ,P-PRSI .TOFF ,P-IT-OBJECT>
<TELL-PRONOUN ,P-IT-OBJECT ,IT>
<RETURN>)
(<G? <SET CNT <+ .CNT 1>> .ICNT>
<RETURN>)>>)>
<COND (<T? .OCNT>
<REPEAT ((CNT 0) TOFF)
<SET TOFF <+ ,NOUN-PHRASE-HEADER-LEN <* .CNT 2>>>
<COND (<==? ,IT <ZGET ,P-PRSO .TOFF>>
<ZPUT ,P-PRSO .TOFF ,P-IT-OBJECT>
<TELL-PRONOUN ,P-IT-OBJECT ,IT>
<RETURN>)
(<G? <SET CNT <+ .CNT 1>> .OCNT>
<RETURN>)>>)>)>
<SET NUM
<COND (<0? .OCNT> .OCNT)
(<G? .OCNT 1>
<COND (<0? .ICNT> <SET OBJ <>>)
(T
<SET OBJ <OR <NOUN-PHRASE-OBJ1 ,P-PRSI>
;,NOT-HERE-OBJECT>>
<SET NP <NOUN-PHRASE-NP1 ,P-PRSI>>)>
.OCNT)
(<G? .ICNT 1>
<SET OBJ <OR <NOUN-PHRASE-OBJ1 ,P-PRSO>
;,NOT-HERE-OBJECT>>
<SET NP <NOUN-PHRASE-NP1 ,P-PRSI>>
.ICNT)
(T 1)>>
<COND (<AND <ZERO? .OBJ> <1? .ICNT>>
<SET OBJ <OR <NOUN-PHRASE-OBJ1 ,P-PRSI>
;,NOT-HERE-OBJECT>>
<SET NP <NOUN-PHRASE-NP1 ,P-PRSI>>)>
<IF-P-BE-VERB
<COND (<SET V <PARSE-QUERY-SYNTAX ,PARSE-RESULT>>
<SETG PRSQ ;V <SYNTAX-ID .V>>)>
<COND (<SET XX <PARSE-SUBJ ,PARSE-RESULT>>
<SETG PRSS ;XX <NOUN-PHRASE-OBJ1 .XX>>)>
;<SET V <PERFORM ,PRSA ,PRSO ,PRSI ;.PI ;.V ;.XX>>>
<COND (<AND <ZERO? ,LIT>
<SEE-VERB?>>
<TELL-TOO-DARK>
<SETG P-CONT -1>
;<RTRUE>)
(<DIR-VERB?>
<SET V <PERFORM ,PRSA <OR ,P-WALK-DIR
<NOUN-PHRASE-OBJ1 ,P-PRSO>>>>)
(<0? .NUM>
<SET V <PERFORM ,PRSA>>
<SETG PRSO <>>
<SETG PRSO-NP <>>)
(<AND ;<EQUAL? .OCNT 1>
<G? .OCNT ;.ICNT 1> ;<G? .NUM 1>
<COLLECTIVE-VERB?>>
<SET V <PERFORM ,PRSA ,ROOMS>>)
(T
<REPEAT (XX (CNT -1) ;(X 0) (TMP 0) ;PI)
<SET CNT <+ .CNT 1>>
<COND (<G=? .CNT .NUM>
<COND ;(<G? .X 0>
<TELL "The ">
<COND (<NOT <EQUAL? .X .NUM>>
<TELL "other ">)>
<TELL "object">
<COND (<NOT <EQUAL? .X 1>>
<TELL !\s>)>
<TELL " that you mentioned ">
<COND (<NOT <EQUAL? .X 1>>
<TELL "are">)
(T <TELL "is">)>
<TELL "n't here." CR>)
(<ZERO? .TMP>
<MORE-SPECIFIC>)>
<RETURN>)>
<COND (<NOT <G? .ICNT 1>>
<SET OBJ1
<OR <ZGET ,P-PRSO
<+ <* .CNT 2>
,NOUN-PHRASE-HEADER-LEN>>
;,NOT-HERE-OBJECT>>
<SET NP1 <ZGET ,P-PRSO
<+ <* .CNT 2>
,NOUN-PHRASE-HEADER-LEN
1>>>)
(T
<SET OBJ1
<OR <ZGET ,P-PRSI
<+ <* .CNT 2>
,NOUN-PHRASE-HEADER-LEN>>
;,NOT-HERE-OBJECT>>
<SET NP1 <ZGET ,P-PRSI
<+ <* .CNT 2>
,NOUN-PHRASE-HEADER-LEN
1>>>)>
<COND (<OR <G? .NUM 1>
<==? <NP-QUANT .NP1> ,NP-QUANT-ALL>>
<COND (<EQUAL? .OBJ1 <> ,NOT-HERE-OBJECT>
;<SET X <+ .X 1>>
<NP-PRINT .NP1>
<TELL ": ">
<NP-CANT-SEE .NP1>
<AGAIN>)
(<AND <==? <NP-QUANT .NP1> ,NP-QUANT-ALL>
<NOT <VERB-ALL-TEST .OBJ1 .OBJ>>>
<AGAIN>)
(<NOT <ACCESSIBLE? .OBJ1>>
<AGAIN>)
(<EQUAL? .OBJ1 ,PLAYER>
<AGAIN>)
(T
<COND (<EQUAL? .OBJ1 ,IT>
<TELL D ,P-IT-OBJECT>)
(T <TELL D .OBJ1>)>
<TELL ": ">)>)>
<SET TMP T>
<COND (<NOT <G? .ICNT 1>>
<SETG PRSO .OBJ1>
<SETG PRSO-NP .NP1>
<SETG PRSI ;PI .OBJ>
<SETG PRSI-NP .NP>)
(T
<SETG PRSO .OBJ>
<SETG PRSO-NP .NP>
<SETG PRSI ;PI .OBJ1>
<SETG PRSI-NP .NP1>)>
<COND (<AND <EQUAL? ,IT ,PRSI ,PRSO ;,PRSS>
<NOT <FIX-HIM-HER-IT ,IT ,P-IT-OBJECT>>>
<AGAIN> ;<RETURN ,M-FATAL>)>
<COND (<AND <EQUAL? ,HER ,PRSI ,PRSO ;,PRSS>
<NOT <FIX-HIM-HER-IT ,HER ,P-HER-OBJECT>>>
<AGAIN> ;<RETURN ,M-FATAL>)>
<COND (<AND <EQUAL? ,HIM ,PRSI ,PRSO ;,PRSS>
<NOT <FIX-HIM-HER-IT ,HIM ,P-HIM-OBJECT>>>
<AGAIN> ;<RETURN ,M-FATAL>)>
<QCONTEXT-CHECK ,PRSO>
<SET XX <SYNTAX-SEARCH <PARSE-SYNTAX ,PARSE-RESULT> 1>>
<COND (<AND <T? ,PRSO> ;"Could be ADJACENT room."
<NOT <BTST .XX ,SEARCH-MOBY>>
<NOT <BTST .XX
<BOR ,SEARCH-MOBY ,SEARCH-MUST-HAVE>>>
<SET V <META-LOC ,PRSO>>
<IN? .V ,ROOMS>
<NOT <GLOBAL-IN? ,PRSO <META-LOC ,WINNER>>>
<NOT <EQUAL? .V <META-LOC ,WINNER>>>
;<NOT <EQUAL? <META-LOC ,PRSO>
,HERE ,LOCAL-GLOBALS
,GLOBAL-OBJECTS
,GENERIC-OBJECTS>>>
<NOT-HERE ,PRSO>
;<TELL "[">
;<TELL-CTHE ,WINNER>
;<TELL " can't do that from here.]" CR>
<AGAIN>)>
<COND (<AND <T? ,PRSO>
<BAND <BOR ,SEARCH-MUST-HAVE ,SEARCH-DO-TAKE>
.XX>
<NOT <BAND ,SEARCH-MOBY .XX>>>
<SET V <ITAKE-CHECK ,PRSO .XX>>
<COND (<OR <EQUAL? ,M-FATAL .V>
;<EQUAL? ,P-CONT -1>>
<RETURN>)
(<T? .V>
<AGAIN>)>)>
<COND (<AND <T? ,PRSI ;.PI>
<BAND <BOR ,SEARCH-MUST-HAVE ,SEARCH-DO-TAKE>
<SET XX <SYNTAX-SEARCH
<PARSE-SYNTAX ,PARSE-RESULT>
2>>>
<NOT <BAND ,SEARCH-MOBY .XX>>>
<SET V <ITAKE-CHECK ,PRSI ;.PI .XX>>
<COND (<OR <EQUAL? ,M-FATAL .V>
;<EQUAL? ,P-CONT -1>>
<RETURN>)
(<T? .V>
<AGAIN>)>)>
<SET V <PERFORM ,PRSA ,PRSO ,PRSI ;.PI>>
<COND (<OR <EQUAL? ,M-FATAL .V>
<EQUAL? ,P-CONT -1>> ;"per SEM 16-Feb-88"
<RETURN>)>>)>
<SETG OPRSO ,PRSO>
<COND (<AND <ZERO? ,CLOCK-WAIT>
<NOT <GAME-VERB?>>
;<T? ,P-WON>>
<COND (<AND <SET V <LOC ,WINNER>>
<NOT <IN? .V ,ROOMS>>
;<FSET? .V ,VEHBIT>>
<SET V <D-APPLY "M-END"
<GETP .V ,P?ACTION>
,M-END>>)>
<SET V <D-APPLY "M-END"
<GETP ,HERE ,P?ACTION>
,M-END>>)>
<COND (<EQUAL? ,M-FATAL .V>
<SETG P-CONT -1>)>
<COND (<AND <ZERO? ,CLOCK-WAIT>
<NOT <GAME-VERB?>>
;<T? ,P-WON>>
<SETG CLOCKER-RUNNING 1>
<SET V <CLOCKER>>
<SETG CLOCKER-RUNNING 2>
<COND (<EQUAL? ,M-FATAL .V>
<SETG P-CONT -1>)>)>
<COND (<AND <SET V <PARSE-CHOMPER ,PARSE-RESULT>>
<L? 1 <NOUN-PHRASE-COUNT .V>>
<NOT <EQUAL? ,P-CONT -1>>>
<SET V <HACK-TELL-1 .V>>
<COND (<EQUAL? ,M-FATAL .V>
<SETG P-CONT -1>)
(<T? .V>
<AGAIN>)>)>>)
(T
<SETG CLOCK-WAIT T>
<SETG P-CONT <>>)>
<SETG PRSA <>>
<SETG PRSO <>>
<SETG PRSO-NP <>>
<SETG PRSI ;"PI" <>>>
<DEFAULT-DEFINITION VERB-ALL-TEST
<DEFINE VERB-ALL-TEST (O I "AUX" L) ;"O=PRSO I=PRSI"
<SET L <LOC .O>>
<COND (<VERB? DROP GIVE>
<COND (<EQUAL? .L ,WINNER>
<RTRUE>)
(T <RFALSE>)>)
(<VERB? PUT>
<COND (<EQUAL? .O .I>
<RFALSE>)
(<NOT <IN? .O .I>>
<RTRUE>)
(T <RFALSE>)>)
(<VERB? TAKE>
<COND (<AND <NOT <FSET? .O ,TAKEBIT>>
<NOT <FSET? .O ,TRYTAKEBIT>>>
<RFALSE>)>
<COND (<NOT <ZERO? .I>>
<COND (<NOT <EQUAL? .L .I>>
<RFALSE>)>)
(<EQUAL? .L ;,WINNER ,HERE>
<RTRUE>)>
<COND (<OR <FSET? .L ,PERSONBIT>
<FSET? .L ,SURFACEBIT>>
<RTRUE>)
(<AND <FSET? .L ,CONTBIT>
<FSET? .L ,OPENBIT>>
<RTRUE>)
(T <RFALSE>)>)
(<NOT <ZERO? .I>>
<COND (<NOT <EQUAL? .O .I>>
<RTRUE>)
(T <RFALSE>)>)
(T <RTRUE>)>>>
<DEFINE FIX-HIM-HER-IT (PRON OBJ)
<COND (<ZERO? .OBJ>
<MORE-SPECIFIC>
<>)
(<NOT <VISIBLE? .OBJ>>
<NOT-HERE .OBJ>
<>)
(T
<COND (<EQUAL? ,PRSO .PRON>
<SETG PRSO .OBJ>
<TELL-PRONOUN .OBJ .PRON>)>
<COND (<EQUAL? ,PRSI .PRON>
<SETG PRSI .OBJ>
<TELL-PRONOUN .OBJ .PRON>)>
<IF-P-BE-VERB
<COND (<EQUAL? ,PRSS .PRON>
<SETG PRSS .OBJ>
<TELL-PRONOUN .OBJ .PRON>)>>
T)>>
<DEFAULT-DEFINITION TELL-PRONOUN
<DEFINE TELL-PRONOUN (OBJ PRON)
<COND (<AND <NOT <FSET? .PRON ,TOUCHBIT>>
<NOT <EQUAL? ,OPRSO .OBJ>>>
<TELL "[\"">
<TELL D ;PRINTB .PRON>
<TELL "\" meaning ">
<TELL-THE .OBJ>
<TELL "]" CR>)>>>
<DEFAULT-DEFINITION GAME-VERB?
<CONSTANT GAME-VERB-TABLE
<LTABLE V?BRIEF V?QUIT V?RESTART V?RESTORE
V?SAVE V?SCORE V?SCRIPT V?SUPER-BRIEF
V?TELL V?UNSCRIPT V?VERBOSE V?VERSION V?$VERIFY V?FOOTNOTE>>
<DEFINE GAME-VERB? ()
<COND (<INTBL? ,PRSA <ZREST ,GAME-VERB-TABLE 2> <ZGET ,GAME-VERB-TABLE 0>>
<RTRUE>)>
<COND (<VERB? $RANDOM $COMMAND $RECORD $UNRECORD>
<RTRUE>)>>>
<DEFAULT-DEFINITION NO-M-WINNER-VERB?
<CONSTANT NO-M-WINNER-VERB-TABLE
<PLTABLE V?TELL-ABOUT V?SGIVE V?SSHOW V?SRUB V?SPUT-ON>>
<DEFINE NO-M-WINNER-VERB? ()
<COND (<INTBL? ,PRSA <ZREST ,NO-M-WINNER-VERB-TABLE 2>
<ZGET ,NO-M-WINNER-VERB-TABLE 0>>
<RTRUE>)>>>
<DEFAULT-DEFINITION FIND-A-WINNER
<DEFINE FIND-A-WINNER ACT ("OPT" (RM ,HERE))
<COND (<AND <T? ,QCONTEXT>
<IN? ,QCONTEXT .RM>>
,QCONTEXT)
(T
<REPEAT ((OTHER <FIRST? .RM>) (WHO <>) (N 0))
<COND (<ZERO? .OTHER>
<RETURN .WHO .ACT>)
(<AND <FSET? .OTHER ,PERSONBIT>
<NOT <FSET? .OTHER ,INVISIBLE>>
<NOT <EQUAL? .OTHER ,PLAYER>>>
<COND (<G? <SET N <+ 1 .N>> 1>
<RETURN <> .ACT>)>
<SET WHO .OTHER>)>
<SET OTHER <NEXT? .OTHER>>>)>>>
<DEFAULT-DEFINITION QCONTEXT-CHECK
<DEFINE QCONTEXT-CHECK (PER "AUX" (WHO <>))
<COND (<OR ;<IFFLAG (P-BE-VERB <VERB? BE ;FIND ;HELP>) (T <>)>
<AND <VERB? SHOW TELL-ABOUT>
<EQUAL? .PER ,PLAYER>>> ;"? more?"
<COND (<SET WHO <FIND-A-WINNER ,HERE>>
<SETG QCONTEXT .WHO>)>
<COND (<AND <QCONTEXT-GOOD?>
<EQUAL? ,WINNER ,PLAYER>> ;"? more?"
<SETG WINNER ,QCONTEXT>
<TELL-SAID-TO ,QCONTEXT>
<RTRUE>)>)>>>
<DEFAULT-DEFINITION TELL-SAID-TO
<DEFINE TELL-SAID-TO (PER) <TELL "[said to " D .PER "]" CR>>>
<GLOBAL QCONTEXT:OBJECT <>>
<DEFINE QCONTEXT-GOOD? ()
<COND (<AND <NOT <ZERO? ,QCONTEXT>>
<FSET? ,QCONTEXT ,PERSONBIT>
;<NOT <FSET? ,QCONTEXT ,MUNGBIT>>
<EQUAL? ,HERE <META-LOC ,QCONTEXT>>>
<RETURN ,QCONTEXT>)>>
<DEFAULT-DEFINITION META-LOC
<DEFINE META-LOC ML (OBJ "OPTIONAL" (INV <>) "AUX" L)
<SET L <LOC .OBJ>>
<REPEAT ()
<COND (<EQUAL? <> .OBJ .L>
<RETURN <> .ML>)
(<EQUAL? .L
,LOCAL-GLOBALS ,GLOBAL-OBJECTS ,GENERIC-OBJECTS>
<RETURN .L .ML>)
(<IN? .OBJ ,ROOMS>
<RETURN .OBJ .ML>)
(T
<COND (<AND .INV <FSET? .OBJ ,INVISIBLE>>
<RETURN <> .ML>)>
<SET OBJ .L>
<SET L <LOC .OBJ>>)>>>>
<DEFAULT-DEFINITION P-PRONOUNS
<GLOBAL P-IT-OBJECT:OBJECT <>>
<GLOBAL P-HER-OBJECT:OBJECT <>>
<GLOBAL P-HIM-OBJECT:OBJECT <>>>
;<DEFINE NOT-IT (WHO)
<COND (<EQUAL? .WHO ,P-HER-OBJECT>
<FCLEAR ,HER ,TOUCHBIT>)
(<EQUAL? .WHO ,P-HIM-OBJECT>
<FCLEAR ,HIM ,TOUCHBIT>)
;(<EQUAL? .WHO ,P-THEM-OBJECT>
<FCLEAR ,THEM ,TOUCHBIT>)
(<EQUAL? .WHO ,P-IT-OBJECT>
<FCLEAR ,IT ,TOUCHBIT>)>>
<DEFAULT-DEFINITION CANT-UNDO
<IF-UNDO
<DEFINE CANT-UNDO ()
<TELL "[I can't undo that now.]" CR>>>>
<GLOBAL NOW-PRSI:FLAG <>>
<GLOBAL OBJ-SWAP:FLAG <>>
<DEFAULT-DEFINITION NOT-HERE-VERB?
<DEFINE NOT-HERE-VERB? (V)
<EQUAL? .V ,V?WALK-TO>>>
<OBJECT NOT-HERE-OBJECT
(CONTFCN 0)
(THINGS 0)>
<DEFAULT-DEFINITION SEE-VERB?
<DEFINE SEE-VERB? ()
<VERB? CHASTISE EXAMINE FIND
LOOK LOOK-BEHIND LOOK-DOWN LOOK-INSIDE LOOK-UNDER LOOK-UP
READ SEARCH>>>
<DEFINE PERFORM (PA "OPT" (PO <>) (PI <>) ;(PQ <>) ;(PS <>)
"AUX" V OA OO OI OQ OS X)
<SET OA ,PRSA>
<SET OO ,PRSO>
<SET OI ,PRSI>
<COND (<AND <T? .OO> <==? .OO .PI>>
<SETG OBJ-SWAP T>)
(<AND <T? .OI> <==? .OI .PO>>
<SETG OBJ-SWAP T>)
(T
<SETG OBJ-SWAP <>>)>
<SETG PRSA .PA>
<SETG PRSI .PI>
<SETG PRSO .PO>
;<IF-P-BE-VERB
<SET OS ,PRSS>
<SET OQ ,PRSQ>
<SETG PRSS .PS>
<SETG PRSQ .PQ>>
<IF-P-DEBUGGING-PARSER
<COND (<T? ,P-DBUG>
<PRINTI "{Perform: A=">
<IFFLAG (IN-ZILCH <PRINTN .PA>)
(T <PRINC <NTH ,ACTIONS <+ <* .PA 2> 1>>>)>
<COND (<T? .PO>
<PRINTI "/O=">
<COND (<DIR-VERB?> <PRINTN .PO>)
(T <TELL-D-LOC .PO>)>)>
<COND (<T? .PI>
<PRINTI "/I=">
<TELL-D-LOC .PI>)>
<IF-P-BE-VERB
<COND (<T? ,PRSQ ;.PQ>
<PRINTI "/Q=">
<IFFLAG (IN-ZILCH <PRINTN ,PRSQ ;.PQ>)
(T <PRINC <NTH ,ACTIONS <+ <* ,PRSQ ;.PQ 2> 1>>>)>)>
<COND (<T? ,PRSS ;.PS>
<PRINTI "/S=">
<TELL-D-LOC ,PRSS ;.PS>)>>
<PRINTI "}|">)>>
<SET V <>>
<IF-P-BE-VERB
<COND (<T? ,PRSS>
<THIS-IS-IT ,PRSS>)>>
<COND (<T? ,PRSI>
<THIS-IS-IT ,PRSI>)>
<COND (<AND <T? ,PRSO>
<NOT <DIR-VERB?>>>
<THIS-IS-IT ,PRSO>)>
<COND (<NOT <EQUAL? ,WINNER ,PLAYER>>
<THIS-IS-IT ,WINNER>)>
<SET PO ,PRSO>
<SET PI ,PRSI>
;<IF-P-BE-VERB <SET PS ,PRSS>>
<COND (<AND ;<ZERO? .V>
<NOT <NO-M-WINNER-VERB?>>>
<SET V <D-APPLY "Winner" <GETP ,WINNER ,P?ACTION>
,M-WINNER>>)>
<COND (<AND <ZERO? .V>
<NOT <IN? <LOC ,WINNER> ,ROOMS>>
;<FSET? <LOC ,WINNER> ,VEHBIT>>
<SET V <D-APPLY "M-BEG"
<GETP <LOC ,WINNER> ,P?ACTION>
,M-BEG>>)>
<COND (<ZERO? .V>
<SET V <D-APPLY "M-BEG"
<GETP ,HERE ,P?ACTION>
,M-BEG>>)>
<COND (<ZERO? .V>
<COND <IF-P-BE-VERB
(<T? ,PRSQ ;.PQ>
<COND (<SET X <INTBL? <ZGET ,ACTIONS .PA>
<ZREST ,QACTIONS 2>
<ZGET ,QACTIONS 0>>>
<SET V <D-APPLY "Preaction" <ZGET .X 4>>>)
;(T
<SET V <D-APPLY "Preaction"
<ZGET ,PREACTIONS .PA>>>)>)>
(T
<SET V <D-APPLY "Preaction" <ZGET ,PREACTIONS .PA>>>)>)>
<SETG NOW-PRSI 1>
<COND (<AND <ZERO? .V>
<T? .PI>
<NOT <DIR-VERB?>>
<LOC .PI>>
<COND (<T? <SET V <GETP <LOC .PI> ,P?CONTFCN>>>
<SET V <D-APPLY "Container" .V ,M-CONTAINER>>)>)>
<COND (<AND <ZERO? .V>
<T? .PI>>
<COND (<EQUAL? .PI ,GLOBAL-HERE>
<SET V <D-APPLY "PRSI" <GETP ,HERE ,P?ACTION>>>)>
<COND (<ZERO? .V>
<SET V <D-APPLY "PRSI" <GETP .PI ,P?ACTION>>>)>)>
<SETG NOW-PRSI 0>
<COND (<AND <ZERO? .V>
<T? .PO>
<NOT <DIR-VERB?>>
<LOC .PO>>
<SET V <GETP <LOC .PO> ,P?CONTFCN>>
<COND (<T? .V>
<SET V <D-APPLY "Container" .V ,M-CONTAINER>>)>)>
<COND (<AND <ZERO? .V>
<T? .PO>
<NOT <DIR-VERB?>>>
<COND (<EQUAL? .PO ,GLOBAL-HERE>
<SET V <D-APPLY "PRSO" <GETP ,HERE ,P?ACTION>>>)>
<COND (<ZERO? .V>
<SET V <D-APPLY "PRSO" <GETP .PO ,P?ACTION>>>)>)>
<IFFLAG (P-BE-VERB
<COND (<ZERO? .V>
<COND (<T? ,PRSS ;.PS>
<SET V <D-APPLY "Subject"
<GETP ,PRSS ;.PS ,P?ACTION>
,M-SUBJ>>)>)>)
;(T
"moved down one line")>
<COND (<ZERO? .V>
<COND <IF-P-BE-VERB
(<T? ,PRSQ ;.PQ>
<COND (<SET X <INTBL? <ZGET ,ACTIONS .PA>
<ZREST ,QACTIONS 2>
<ZGET ,QACTIONS 0>>>
<COND (<SET X <ZGET .X 2>>
<SET V <D-APPLY <> .X>>)>)>
<COND (<ZERO? .V>
<SET V <D-APPLY <> <ZGET ,ACTIONS ,PRSQ>>>)>)>
(T
<SET V <D-APPLY <> <ZGET ,ACTIONS .PA>>>)>)>
;<COND (<ZERO? .V>
<SET V <D-APPLY <> <ZGET ,ACTIONS .PA>>>)>
<COND (<EQUAL? ,M-FATAL .V>
<SETG P-CONT -1>)>
<SETG PRSA .OA>
<SETG PRSO .OO>
<SETG PRSI .OI>
;<IF-P-BE-VERB <SETG PRSS .OS>>
.V>
<DEFAULT-DEFINITION TELL-TOO-DARK
<DEFINE TELL-TOO-DARK () <TELL ,TOO-DARK> <RETURN ,M-FATAL>>>
<DEFAULT-DEFINITION ITAKE-CHECK
<DEFINE ITAKE-CHECK (OBJ BITS "AUX" (TAKEN <>))
<COND (<==? .OBJ ,IT>
<SET OBJ ,P-IT-OBJECT>)>
<COND (<AND <NOT <HELD? .OBJ ,WINNER>>
<NOT <EQUAL? .OBJ ,HANDS ,ROOMS>>>
<COND (<FSET? .OBJ ,TRYTAKEBIT>
T)
(<NOT <==? ,WINNER ,PLAYER>>
<SET TAKEN T>)
(<AND <BTST .BITS ,SEARCH-DO-TAKE>
<==? <ITAKE <> .OBJ> T>>
<SET TAKEN T>)>
<COND (<AND <NOT .TAKEN>
<BTST .BITS ,SEARCH-MUST-HAVE>
<NOT <BTST .BITS ,SEARCH-MOBY>>>
<TELL !\[>
<COND (<EQUAL? ,WINNER ,PLAYER>
<TELL "You are">)
(T
<TELL-CTHE ,WINNER>
<TELL " is">)>
<TELL "n't holding ">
<TELL-THE .OBJ>
<THIS-IS-IT .OBJ>
<TELL "!]" CR>
<RTRUE>)
;(<AND .TAKEN <==? ,WINNER ,PLAYER>>
<FIRST-YOU "take" .OBJ ,ITAKE-LOC>)>)>>>
<IF-P-DEBUGGING-PARSER
<DEFINE TELL-D-LOC (OBJ)
<PRINTD .OBJ>
<COND (<IN? .OBJ ,GLOBAL-OBJECTS> <PRINTI "(gl)">)
(<IN? .OBJ ,LOCAL-GLOBALS> <PRINTI "(lg)">)
(<IN? .OBJ ,ROOMS> <PRINTI "(rm)">)>
<COND (<EQUAL? .OBJ ,INTNUM>
<PRINTC !\(>
<PRINTN ,P-NUMBER>
<PRINTC !\)>)>>>
<DEFINE D-APPLY (STR FCN "OPTIONAL" (FOO <>) "AUX" RES)
<COND (<T? .FCN>
<IF-P-DEBUGGING-PARSER
<COND (<T? ,P-DBUG>
<COND (<ZERO? .STR>
<PRINTI "{Action:}|">)
(T
<PRINTC !\{>
<PRINT .STR>
<COND (<=? .STR "Winner">
<PRINTC !\=>
<TELL D ,WINNER>)>
<PRINTI ": ">)>)>>
<COND (<T? .FOO> <SET RES <ZAPPLY .FCN .FOO>>)
(T <SET RES <ZAPPLY .FCN>>)>
<IF-P-DEBUGGING-PARSER
<COND (<AND <T? ,P-DBUG> <T? .STR>>
<COND (<OR <EQUAL? ,M-FATAL .RES>
<EQUAL? ,P-CONT -1>>
<PRINTI "Fatal}|">)
(<ZERO? .RES>
<PRINTI "Not handled}|">)
(T <PRINTI "Handled}|">)>)>>
.RES)>>
<DEFAULT-DEFINITION CAPITAL-NOUN?
<DEFINE CAPITAL-NOUN? (NAM) <>>>
<DEFAULT-DEFINITION NOT-HERE
<DEFINE NOT-HERE (OBJ "OPT" (CLOCK <>))
<COND (<ZERO? .CLOCK>
<SETG CLOCK-WAIT T>
<TELL "[But">)>
<TELL !\ >
<TELL-THE .OBJ>
<TELL " isn't ">
<COND (<VISIBLE? .OBJ>
<TELL "close enough">
<COND (<SPEAKING-VERB?> <TELL " to hear you">)>
<TELL !\.>)
(T <TELL "here!">)>
<THIS-IS-IT .OBJ>
<COND (<ZERO? .CLOCK>
<TELL !\]>)>
<CRLF>>>
<DEFAULT-DEFINITION ASKING-VERB-WORD?
<ADD-WORD ASK ASKWORD>
<ADD-WORD ORDER ASKWORD>
<ADD-WORD TELL ASKWORD>
;<DEFINE ASKING-VERB-WORD? (WD)
<COND (<EQUAL? .WD ,W?ASK ,W?ORDER ,W?TELL>
T)>>>
<DEFAULT-DEFINITION SPEAKING-VERB?
<DEFINE SPEAKING-VERB? ("OPT" (A ,PRSA) ;(PER 0))
<COND (<EQUAL? .A ,V?ANSWER ,V?ASK-ABOUT ,V?ASK-FOR ,V?HELLO
,V?NO ,V?REPLY ,V?TELL ,V?TELL-ABOUT ,V?YES>
<COND (T ;<EQUAL? .PER 0 ,PRSO>
<RTRUE>)>)>>>
<DEFINE GET-OWNER (OBJ "AUX" TMP NP)
<COND (<SET NP <GET-NP .OBJ>>
<COND (<OR <SET TMP <NP-OF .NP>>
<AND <SET TMP <NP-ADJS .NP>>
<SET TMP <ADJS-POSS .TMP>>>>
<COND (<OBJECT? .TMP>
.TMP)
;(T
<NOUN-PHRASE-OBJ1 .TMP>)>)
(<AND <SET TMP <GETP .OBJ ,P?OWNER>>
<NOT <OBJECT? .TMP>>> ;"body part"
,PLAYER)>)>>
<DEFINE GET-NP ("OPT" (OBJ <>) "AUX" (PRSI? ,NOW-PRSI))
<COND (<NOT <EQUAL? .OBJ ,PRSO ,PRSI>>
<RETURN <>>)
(.OBJ
<COND (<==? .OBJ ,PRSO> <SET PRSI? <>>)
(T <SET PRSI? T>)>)>
<COND (,OBJ-SWAP
<COND (<T? .PRSI?> ,PRSO-NP)
(T ,PRSI-NP)>)
(<T? .PRSI?>
,PRSI-NP)
(T ,PRSO-NP)>>
<DEFAULT-DEFINITION NOUN-USED?
<DEFINE NOUN-USED? (OBJ WD1 "OPT" (WD2 <>) (WD3 <>) "AUX" X)
<AND <SET X <GET-NP .OBJ>>
<SET X <NP-NAME .X>>
<EQUAL? .X .WD1 .WD2 .WD3>>>>
<DEFAULT-DEFINITION ADJ-USED?
<DEFINE ADJ-USED? (OBJ WD1 "OPT" (WD2 <>) (WD3 <>) "AUX" NP CT)
<COND (<AND <SET NP <GET-NP .OBJ>>
<SET NP <NP-ADJS .NP>>>
<COND (<AND <EQUAL? ,PLAYER <ADJS-POSS .NP>>
<EQUAL? ,W?MY .WD1 .WD2 .WD3>>
,W?MY)
(<G? <SET CT <ADJS-COUNT .NP>> 0>
<SET NP <REST-TO-SLOT .NP ADJS-COUNT 1>>
<COND (<ZMEMQ .WD1 .NP .CT>
.WD1)
(.WD2
<COND (<ZMEMQ .WD2 .NP .CT>
.WD2)
(.WD3
<COND (<ZMEMQ .WD3 .NP .CT>
.WD3)>)>)>)>)>>>
<END-SEGMENT>

5511
verbs.zap Normal file
View File

File diff suppressed because it is too large Load Diff

5346
verbs.zil Normal file
View File

File diff suppressed because it is too large Load Diff

277
village.zabstr Normal file
View File

@ -0,0 +1,277 @@
<BEGIN-SEGMENT VILLAGE>
<OBJECT VILLAGE (LOC LOCAL-GLOBALS) (DESC "village") (SYNONYM VILLAGE) (ACTION
VILLAGE-F)>
<DEFINE-ROUTINE VILLAGE-F>
<ROOM OUTER-BAILEY (LOC ROOMS) (REGION "Flatheadia") (DESC "Outer Bailey") (SE
TO DRAWBRIDGE IF DRAWBRIDGE IS OPEN ELSE "The drawbridge isn't down.") (SW TO
GARRISON) (NE TO BEND) (NW TO PERIMETER-WALL) (FLAGS RLANDBIT OUTSIDEBIT ONBIT)
(SYNONYM BAILEY) (ADJECTIVE OUTER) (GLOBAL DRAWBRIDGE MOAT ROOTS) (MAP-LOC <
PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-2>) (ICON OUTER-BAILEY-ICON) (
ACTION OUTER-BAILEY-F)>
<DEFINE-ROUTINE OUTER-BAILEY-F>
<OBJECT TREE-STUMP (LOC OUTER-BAILEY) (DESC "tree stump") (LDESC
"A mighty, rotting tree stump spreads its roots across the bailey.") (SYNONYM
STUMP) (ADJECTIVE LARGE TREE WEATHERED) (CAPACITY 100) (FLAGS CONTBIT VEHBIT
SURFACEBIT OPENBIT SEARCHBIT) (ACTION TREE-STUMP-F)>
<GLOBAL JUMP-X 99>
<GLOBAL JUMP-Y 99>
<DEFINE-ROUTINE TREE-STUMP-F>
<OBJECT TREASURE-CHEST (LOC LOCAL-GLOBALS) (DESC "treasure chest") (SYNONYM
CHEST) (ADJECTIVE TREASURE) (FLAGS TAKEBIT CONTBIT SEARCHBIT) (SIZE 25) (
CAPACITY 50)>
<OBJECT CROWN (LOC DIMWIT) (DESC "gaudy crown") (SYNONYM CROWN) (ADJECTIVE
GAUDY) (VALUE 12) (FLAGS NDESCBIT MAGICBIT WEARBIT)>
<ROOM PERIMETER-WALL (LOC ROOMS) (REGION "Flatheadia") (DESC "Perimeter Wall")
(SE TO OUTER-BAILEY) (NW PER WEST-OF-HOUSE-ENTER-F) (OUT PER
WEST-OF-HOUSE-ENTER-F) (FLAGS RLANDBIT OUTSIDEBIT ONBIT) (ICON
PERIMETER-WALL-ICON) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-1>)
(ACTION PERIMETER-WALL-F)>
<DEFINE-ROUTINE PERIMETER-WALL-F>
<DEFINE-ROUTINE WEST-OF-HOUSE-ENTER-F>
<OBJECT OUTER-GATE (LOC PERIMETER-WALL) (DESC "outer gate") (SYNONYM GATE GATES
DOOR) (ADJECTIVE OUTER INCREDIBLY LARGE IRON-REINFORCED OAKEN) (FLAGS NDESCBIT
DOORBIT VOWELBIT) (ACTION OUTER-GATE-F)>
<DEFINE-ROUTINE OUTER-GATE-F>
<GLOBAL END-GAME-COUNTER 0>
<DEFINE-ROUTINE I-END-GAME>
<ROOM WEST-OF-HOUSE (LOC ROOMS) (DESC "West of House") (REGION
"(formerly) Flatheadia") (LDESC
"You are standing in an open field west of a white house, with a
boarded front door.|
There is a small mailbox here.") (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (ACTION
WEST-OF-HOUSE-F)>
<DEFINE-ROUTINE WEST-OF-HOUSE-F>
<ROOM GARRISON (LOC ROOMS) (REGION "Flatheadia") (DESC "Garrison") (LDESC
"This is where the castle's army was quartered. The garrison fell into
disuse as all known lands fell under the rule of the Flatheads; the army
had little to do except quell an occasional tax revolt. In fact, the only
evidence of the garrison is a rusty locker. A road leads northeast.") (NE TO
OUTER-BAILEY) (OUT TO OUTER-BAILEY) (FLAGS RLANDBIT ONBIT) (SYNONYM GARRISON) (
MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-1>) (ICON GARRISON-ICON)>
<OBJECT LOCKER (LOC GARRISON) (DESC "locker") (SYNONYM LOCKER) (ADJECTIVE RUSTY
) (CAPACITY 100) (FLAGS CONTBIT SEARCHBIT NDESCBIT) (ACTION LOCKER-F)>
<DEFINE-ROUTINE LOCKER-F>
<OBJECT POSTER (LOC LOCKER) (OWNER POSTER) (DESC "poster of Ursula Flathead") (
SYNONYM POSTER URSULA FLATHEAD) (ADJECTIVE URSULA) (FLAGS TAKEBIT BURNBIT) (
SIZE 2) (RESEARCH
"\"Ursula Flathead, the former Miss Miznia, has been called the 'Sex Goddess
of the GUE.' The editors would be hard-pressed to disagree with the phrase.\"")
(ACTION POSTER-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE POSTER-F>
<END-SEGMENT>
<BEGIN-SEGMENT VILLAGE>
<OBJECT WEST-KEY (LOC LOCKER) (DESC "steel key") (SYNONYM KEY) (ADJECTIVE STEEL
) (FLAGS TAKEBIT KEYBIT) (SIZE 2)>
<ROOM BEND (LOC ROOMS) (REGION "Flatheadia") (DESC "Bend") (LDESC
"The road curves along the moat, turning southeast and southwest.") (SE TO
VILLAGE-GATE) (SW TO OUTER-BAILEY) (FLAGS RLANDBIT OUTSIDEBIT ONBIT) (GLOBAL
MOAT) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-2 MAP-GEN-X-3>)>
<ROOM VILLAGE-GATE (LOC ROOMS) (REGION "Flatheadia") (DESC "Village Gate") (
LDESC "To the east, a stone arch forms the entrance to the castle's village. (The
village lies outside the castle proper but is still comfortably within the
outer perimeter wall.) The arch is flanked by two medium-sized elms, one more
gnarled than the other. The road passes under the arch; in the other direction,
it follows the moat to the northwest.") (NW TO BEND) (EAST TO SHADY-PARK) (
FLAGS RLANDBIT OUTSIDEBIT ONBIT) (GLOBAL VILLAGE ARCH MOAT) (MAP-LOC <PTABLE
VILLAGE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-4>) (THINGS VILLAGE GATE GATE-PS)>
<DEFINE-ROUTINE GATE-PS>
<OBJECT GNARLED-ELM (LOC VILLAGE-GATE) (DESC "gnarled elm tree") (SYNONYM TREE
ELM) (ADJECTIVE GNARLED ELM) (FLAGS NDESCBIT PLANTBIT) (ACTION TREE-F)>
<OBJECT UNGNARLED-ELM (LOC VILLAGE-GATE) (DESC "ungnarled elm tree") (SYNONYM
TREE ELM) (ADJECTIVE UNGNARLED ELM) (FLAGS NDESCBIT VOWELBIT PLANTBIT) (ACTION
TREE-F)>
<ROOM SHADY-PARK (LOC ROOMS) (REGION "Flatheadia") (DESC "Shady Park") (LDESC
"This grassy mall must have been a nice area at one time, but it is now
overgrown with weeds, and soiled by windblown litter. The shade comes from
a mighty elm which spreads its thick green branches over the park. A wide
east-west boulevard bisects the park, and impressive buildings flank it on
the north and south.") (EAST TO VILLAGE-CENTER) (WEST TO VILLAGE-GATE) (SOUTH
TO CHURCH) (NORTH TO TAX-OFFICE) (FLAGS RLANDBIT OUTSIDEBIT ONBIT) (SYNONYM
PARK) (ADJECTIVE SHADY) (GLOBAL VILLAGE GLOBAL-BLDG) (MAP-LOC <PTABLE
VILLAGE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-5>) (ICON SHADY-PARK-ICON)>
<OBJECT MIGHTY-ELM (LOC SHADY-PARK) (DESC "mighty elm tree") (SYNONYM TREE ELM)
(ADJECTIVE LARGE ELM) (FLAGS NDESCBIT PLANTBIT) (ACTION TREE-F)>
<ROOM CHURCH (LOC ROOMS) (REGION "Flatheadia") (DESC "Church") (LDESC
"This is a house of worship of Brogmoidism. The tenets of this rather silly
religion are engraved on the wall. The only exit is north.") (NORTH TO
SHADY-PARK) (OUT TO SHADY-PARK) (FLAGS RLANDBIT ONBIT) (SYNONYM CHURCH) (GLOBAL
GLOBAL-BLDG) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-5>) (ICON
CHURCH-ICON)>
<OBJECT TENET (LOC CHURCH) (DESC "engraved tenet") (SYNONYM TENET TENETS
ENGRAVING) (ADJECTIVE ENGRAVED) (FLAGS NDESCBIT READBIT) (TEXT
"\"Thou shalt worship the Great Brogmoid to thine utmost, for upon his shoulder
rests the world -- thus he saveth us from plunging into the Great Void...\"
The tenets go on and on about the brogmoid who supports the world. It's hard to
believe that anyone EVER believed such drivel, let alone in today's enlightened
age. As the great modern thinker, Zorbius Blattus, is fond of saying, \"If a
giant brogmoid were holding up the world, where would he stand?\"")>
<ROOM TAX-OFFICE (LOC ROOMS) (REGION "Flatheadia") (DESC "URS Office") (LDESC
"This huge hall was the main office of the Underground Revenue Service. Until
the construction of the FrobozzCo Building, it was the largest structure in
the Empire. Here, thousands upon thousands of accountants and auditors once
sat, tabulating the proceeds from Dimwit's astronomical taxations. The only
exit is south.") (SOUTH TO SHADY-PARK) (OUT TO SHADY-PARK) (FLAGS RLANDBIT
ONBIT) (GLOBAL GLOBAL-BLDG) (RIDDLE
"I once heard of a bookkeeper who, while working on the accounts of the Frobozz
Magic Balloon Company, noted that the word 'balloon' has two double letters in
a row! Stretching his limited imagination to the limit, this bookkeeper
wondered if there were any words with THREE double letters in a row. He
couldn't think of one -- but I'll bet that YOU can!\"") (ICON URS-OFFICE-ICON)
(MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-2 URS-ICON-LOC>) (ACTION
TAX-OFFICE-F)>
<DEFINE-ROUTINE TAX-OFFICE-F>
<OBJECT BOOKKEEPER (LOC GLOBAL-OBJECTS) (DESC "bookkeeper") (SYNONYM BOOKKEEPER
BOOKKEEPING)>
<OBJECT ZORKMID-COIN (LOC LOCAL-GLOBALS) (DESC "zorkmid coin") (SYNONYM ZORKMID
COIN MONEY) (ADJECTIVE ONE ZORKMID) (FLAGS TRYTAKEBIT TAKEBIT READBIT) (SIZE 1)
(TEXT "The coin bears the likeness of Belwit the Flat, along with the inscriptions,
\"One Zorkmid,\" and \"699 GUE.\" On the other side, the coin depicts Egreth
Castle, and says \"In Frobs We Trust\" in several languages.")>
<ROOM VILLAGE-CENTER (LOC ROOMS) (REGION "Flatheadia") (DESC "Village Center")
(LDESC "You are in the midst of the village. At least, at some distant time it may
have been a village. More recently, it was a bustling metropolis. Now it's a
deserted metropolis. A fantastically tall building rises just east of you and
a road heads west. To the south is a post office; to the north, beyond granite
stairs flanked by stone toads, is the Courthouse entrance.") (EAST TO FR-HQ) (
WEST TO SHADY-PARK) (SOUTH TO POST-OFFICE) (NORTH TO COURTROOM) (FLAGS RLANDBIT
ONBIT OUTSIDEBIT) (GLOBAL VILLAGE FR-BLDG) (MAP-LOC <PTABLE VILLAGE-MAP-NUM
MAP-GEN-Y-3 MAP-GEN-X-7>)>
<OBJECT STONE-TOADS (LOC VILLAGE-CENTER) (OWNER STONE-TOADS) (DESC
"pair of stone toads") (SYNONYM PAIR TOAD TOADS) (ADJECTIVE STONE) (FLAGS
NDESCBIT)>
<ROOM COURTROOM (LOC ROOMS) (REGION "Flatheadia") (DESC "Courtroom") (LDESC
"This is where the great jurist, Oliver Wendell Flathead, would hand down
decisions from the bench. The only exit is south.") (SOUTH TO VILLAGE-CENTER) (
OUT TO VILLAGE-CENTER) (FLAGS RLANDBIT ONBIT) (SYNONYM COURTROOM) (GLOBAL
GLOBAL-BLDG) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-2 COURTROOM-ICON-LOC>)
(ICON COURTROOM-ICON)>
<ROOM POST-OFFICE (LOC ROOMS) (REGION "Flatheadia") (DESC "Post Office") (LDESC
"Once the main branch of the Flatheadia Postal Service, this edifice now lies
in deserted silence. A doorway leads north.") (NORTH TO VILLAGE-CENTER) (OUT TO
VILLAGE-CENTER) (FLAGS RLANDBIT ONBIT) (GLOBAL GLOBAL-BLDG) (MAP-LOC <PTABLE
VILLAGE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-7>) (ICON POST-OFFICE-ICON)>
<OBJECT PACKAGE (LOC POST-OFFICE) (DESC "package") (FDESC
"A package rests on one of the counters. Although a collector has stolen
the stamp, the address is still legible.") (SYNONYM PACKAGE ADDRESS) (FLAGS
TAKEBIT READBIT CONTBIT SEARCHBIT) (CAPACITY 12) (TEXT
"\"From: Belznork Gibblewitz To: Eek Numblatz|
F. M. Homing Pigeon Co Int'l Curios, Inc|
FrobozzCo Bldg, 193-E 28 Volcano View Ln|
Flatheadia, FRV-9179 Gurth City, GTH-3791\"")>
<OBJECT PERCH (LOC PACKAGE) (DESC "ceramic perch") (PLURAL "perches") (SYNONYM
PERCH WRITING PRINT LETTERING) (ADJECTIVE CERAMIC SMALL) (FLAGS TAKEBIT READBIT
) (OWNER PERCH) (TEXT
"Tiny lettering says, \"Frobozz Magic Homing Pigeon Company.\"")>
<BEGIN-SEGMENT 0>
<OBJECT PIGEON (LOC PACKAGE) (DESC "ceramic pigeon") (SYNONYM PIGEON BIRD
REPRODUCTION WRITING PRINT LETTERING) (ADJECTIVE CERAMIC CLAY HOMING SMALL) (
FLAGS TAKEBIT READBIT) (OWNER PIGEON) (TEXT
"Tiny lettering says, \"Frobozz Magic Homing Pigeon Company.\"") (ACTION
PIGEON-F)>
<DEFINE-ROUTINE PIGEON-F>
<GLOBAL REMOVED-PERCH-LOC <>>
<DEFINE-ROUTINE MOVE-TO-PERCH>
<DEFINE-ROUTINE FIND-PERCH>
<END-SEGMENT>
\
<BEGIN-SEGMENT VILLAGE>
<OBJECT FR-BLDG (LOC LOCAL-GLOBALS) (DESC "Frobozzco Building") (SYNONYM
BUILDING HEADQUARTERS HQ) (ADJECTIVE TALL FROBOZZCO INTERNATIONAL WORLD
HEADQUARTERS HQ) (ACTION FR-BLDG-F)>
<DEFINE-ROUTINE FR-BLDG-F>
<ROOM FR-HQ (LOC ROOMS) (REGION "Flatheadia") (DESC "FrobozzCo HQ") (LDESC
"You are in the lobby of FrobozzCo International's World Headquarters, an
impressive four hundred story structure. Wide stairs lead up and down; the
main exit is to the west; an emergency exit leads east.") (WEST TO
VILLAGE-CENTER) (EAST TO BACK-ALLEY) (DOWN TO FR-BASEMENT) (UP PER
FR-OFFICES-ENTER-F) (FLAGS RLANDBIT ONBIT) (GLOBAL STAIRS FR-BLDG) (MAP-LOC <
PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-3 MAP-GEN-X-8>) (ICON FR-HQ-ICON)>
<OBJECT MEMO (DESC "memo") (SYNONYM MEMO) (FLAGS READBIT TAKEBIT) (SIZE 2) (
TEXT "FROM: Spaulding Flathead, Seventh Asst. Bldg. Mgr.|
TO: All tenants|
RE: New stairway policy|
To relieve overcrowding in the stairwells, employees who work above the 75th
floor will be given teleportation tokens. Company officers will continue to
receive teleportation tokens regardless of floor. Note: employees with tokens
will no longer be dismissed early for \"stair-climbing\" time.")>
<OBJECT INSTRUCTION-BOOKLET (DESC "damaged instruction booklet") (SYNONYM BOOK
BOOKLET INSTRUCTIONS) (ADJECTIVE INSTRUCTIONS DAMAGED) (FLAGS TAKEBIT READBIT)
(SIZE 3) (TEXT "The booklet is badly torn and faded. You can make out only a few phrases:
\"...ozz Magic Homing Pi...\" and \"...eave the perch in the location you wish
t...\" and \"...eturn warranty card within 90 d...\"")>
<DEFINE-ROUTINE FR-OFFICES-ENTER-F>
<ROOM FR-OFFICES (LOC ROOMS) (REGION "Flatheadia") (DESC "FrobozzCo Offices") (
NORTH TO OFFICES-NORTH) (EAST TO OFFICES-EAST) (WEST TO OFFICES-WEST) (SOUTH TO
OFFICES-SOUTH) (UP PER FR-FLOOR-F) (DOWN PER FR-FLOOR-F) (FLAGS RLANDBIT ONBIT)
(GLOBAL FR-BLDG STAIRS) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-5
MAP-GEN-X-10>) (ACTION OFFICES-F)>
<DEFINE-ROUTINE OFFICES-F>
<GLOBAL BEEN-IN-FR-UPPER-FLOORS <>>
<GLOBAL FLOOR-NUMBER 2>
<DEFINE-ROUTINE FR-FLOOR-F>
<DEFINE-ROUTINE OFFICE-UNSTORE>
<OBJECT T-SQUARE (DESC "T-square") (SYNONYM T-SQUARE) (FLAGS TAKEBIT MAGICBIT)
(VALUE 12)>
<ROOM OFFICES-NORTH (LOC ROOMS) (REGION "Flatheadia") (DESC
"FrobozzCo Offices North") (SOUTH TO FR-OFFICES) (FLAGS RLANDBIT ONBIT) (GLOBAL
FR-BLDG WINDOW) (ICON OFFICES-ICON) (MAP-LOC <PTABLE VILLAGE-MAP-NUM
MAP-GEN-Y-4 MAP-GEN-X-10>) (ACTION FR-OUTER-OFFICES-F)>
<ROOM OFFICES-EAST (LOC ROOMS) (REGION "Flatheadia") (DESC
"FrobozzCo Offices East") (WEST TO FR-OFFICES) (FLAGS RLANDBIT ONBIT) (GLOBAL
FR-BLDG WINDOW) (ICON OFFICES-ICON) (MAP-LOC <PTABLE VILLAGE-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-11>) (ACTION FR-OUTER-OFFICES-F)>
<ROOM OFFICES-WEST (LOC ROOMS) (REGION "Flatheadia") (DESC
"FrobozzCo Offices West") (EAST TO FR-OFFICES) (FLAGS RLANDBIT ONBIT) (GLOBAL
FR-BLDG WINDOW) (ICON OFFICES-ICON) (MAP-LOC <PTABLE VILLAGE-MAP-NUM
MAP-GEN-Y-5 MAP-GEN-X-9>) (ACTION FR-OUTER-OFFICES-F)>
<ROOM OFFICES-SOUTH (LOC ROOMS) (REGION "Flatheadia") (DESC
"FrobozzCo Offices South") (NORTH TO FR-OFFICES) (FLAGS RLANDBIT ONBIT) (GLOBAL
FR-BLDG WINDOW) (ICON OFFICES-ICON) (MAP-LOC <PTABLE VILLAGE-MAP-NUM
MAP-GEN-Y-6 MAP-GEN-X-10>) (ACTION FR-OUTER-OFFICES-F)>
<DEFINE-ROUTINE FR-OUTER-OFFICES-F>
<ROOM FR-PENTHOUSE (LOC ROOMS) (REGION "Flatheadia") (DESC
"FrobozzCo Penthouse") (LDESC
"You have reached the top floor! On a clear day, one can see hundreds of
bloits from here; too bad it's so smoggy today. A stair leads down.") (DOWN PER
FR-OFFICES-ENTER-F) (FLAGS RLANDBIT ONBIT) (GLOBAL FR-BLDG WINDOW STAIRS) (
MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-7 MAP-GEN-X-8>) (ICON PENTHOUSE-ICON)
(ACTION FR-PENTHOUSE-F)>
<DEFINE-ROUTINE FR-PENTHOUSE-F>
<ROOM FR-BASEMENT (LOC ROOMS) (REGION "Flatheadia") (DESC "FrobozzCo Basement")
(LDESC "The basement of the FrobozzCo Building is a place of sturdy walls, designed
to support the 400 stories above. A stair leads up and a passage heads south.")
(UP TO FR-HQ) (SOUTH PER PHIL-ENTER-F) (FLAGS RLANDBIT) (GLOBAL STAIRS FR-BLDG)
(MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-4 MAP-GEN-X-8>)>
<OBJECT BASEMENT-REBUS-BUTTON (LOC FR-BASEMENT) (SDESC
"blinking key-shaped button") (FDESC
"In a dark corner, a blinking button catches your eye. It seems to be in the
shape of a key.") (SYNONYM BUTTON) (ADJECTIVE KEY-SHAPED BLINKING) (ACTION
REBUS-BUTTON-F)>
<DEFINE-ROUTINE PHIL-ENTER-F>
<END-SEGMENT>
<BEGIN-SEGMENT LAKE>
<DEFINE-ROUTINE FR-BASEMENT-ENTER-F>
<END-SEGMENT>
<BEGIN-SEGMENT VILLAGE>
<ROOM BACK-ALLEY (LOC ROOMS) (DESC "Back Alley") (REGION "Flatheadia") (LDESC
"This is a grungy, foul-smelling lane. A large building can be entered
to the west, and a much smaller one to the north.") (NORTH TO MAGIC-SHOP) (WEST
TO FR-HQ) (FLAGS RLANDBIT ONBIT OUTSIDEBIT) (SYNONYM ALLEY) (ADJECTIVE BACK) (
GLOBAL FR-BLDG GLOBAL-BLDG) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-3
MAP-GEN-X-9>) (ICON BACK-ALLEY-ICON)>
<ROOM MAGIC-SHOP (LOC ROOMS) (DESC "Magic Shop") (REGION "Flatheadia") (LDESC
"Perhaps this was once a thriving shop, but now, like the rest of Flatheadia,
it lies deserted, gutted by looters. The exit is south.") (SOUTH TO BACK-ALLEY)
(OUT TO BACK-ALLEY) (FLAGS RLANDBIT ONBIT) (SYNONYM SHOP STORE) (ADJECTIVE
MAGIC) (GLOBAL GLOBAL-BLDG) (MAP-LOC <PTABLE VILLAGE-MAP-NUM MAP-GEN-Y-2
MAP-GEN-X-9>) (ICON MAGIC-SHOP-ICON)>
<OBJECT RING (LOC MAGIC-SHOP) (OWNER RING) (DESC "ring of ineptitude") (FDESC
"The only thing the looters ignored was a ring. Not surprising, as it is a
ring of ineptitude. Fun at parties, but not good for much else.") (SYNONYM RING
INEPTITUDE) (FLAGS TAKEBIT WEARBIT) (SIZE 1) (ACTION RING-F)>
<BEGIN-SEGMENT 0>
<DEFINE-ROUTINE RING-F>
<END-SEGMENT>

613
village.zap Normal file
View File

@ -0,0 +1,613 @@
.SEGMENT "VILLAGE"
.FUNCT VILLAGE-F
EQUAL? HERE,PARAPET \?CCL3
CALL2 TOUCHING?,VILLAGE
ZERO? STACK /?CCL3
CALL2 CANT-REACH,VILLAGE
RSTACK
?CCL3: EQUAL? PRSA,V?ENTER \?CCL7
EQUAL? HERE,VILLAGE-GATE \?CCL10
CALL2 DO-WALK,P?EAST
RSTACK
?CCL10: CALL1 V-WALK-AROUND
RSTACK
?CCL7: EQUAL? PRSA,V?EXIT \FALSE
CALL1 V-WALK-AROUND
RSTACK
.FUNCT OUTER-BAILEY-F,RARG
EQUAL? RARG,M-LOOK \FALSE
PRINTI "This open area is a rolling meadow extending from the moat to the distant perimeter fortifications. A drawbridge "
FSET? DRAWBRIDGE,OPENBIT \?CCL6
PRINTI "leads over the"
JUMP ?CND4
?CCL6: PRINTI "is raised, leaving an impassable"
?CND4: PRINTI " moat to the southeast, and roads lead northeast, southwest, and northwest."
RTRUE
.FUNCT TREE-STUMP-F,VARG
ZERO? VARG \FALSE
EQUAL? PRSA,V?EXAMINE \?CCL5
GETP TREE-STUMP,P?LDESC
PRINT STACK
FIRST? TREE-STUMP \?CCL8
PRINTC 32
RFALSE
?CCL8: CRLF
RTRUE
?CCL5: EQUAL? PRSA,V?GET-NEAR \?CCL10
ICALL PERFORM,V?ENTER,TREE-STUMP
RTRUE
?CCL10: EQUAL? PRSA,V?LISTEN \?CCL12
ZERO? PLANT-TALKER /?CCL12
PRINTR "The stump is dead and silent."
?CCL12: EQUAL? PRSA,V?ENTER \?CCL16
SET 'JUMP-X,0
SET 'JUMP-Y,0
RFALSE
?CCL16: EQUAL? PRSA,V?EXIT \?CCL18
SET 'JUMP-X,99
SET 'JUMP-Y,99
RFALSE
?CCL18: EQUAL? PRSA,V?RAISE,V?TAKE,V?LOOK-UNDER \FALSE
PRINTR "100 men couldn't uproot this stump!"
.FUNCT PERIMETER-WALL-F,RARG
EQUAL? RARG,M-LOOK \FALSE
PRINTI "Before you rises the massive stone wall which forms the first line of defense for the castle grounds. To the northwest, the huge oak gates "
FSET? OUTER-GATE,OPENBIT \?CCL6
PRINTI "lie wide open, revealing dense forest beyond!"
RTRUE
?CCL6: PRINTI "are closed and reinforced, forming an impassable barrier across the road from the southeast."
RTRUE
.FUNCT WEST-OF-HOUSE-ENTER-F,RARG
FSET? OUTER-GATE,OPENBIT \?CCL3
ZERO? RARG \?CND4
ICALL1 RETURN-FROM-MAP
ICALL2 INC-SCORE,30
PRINTI "You dive through the doors as the castle begins its final tremors! Landing on soft grass, you roll to a stop, and turn to see the castle's final moments. But, oddly, though it is collapsing, it doesn't seem to be getting destroyed. Instead, it is merely shrinking, shrivelling... You rub your eyes in disbelief, as the once mighty castle transforms itself into ever tinier structures. At long last there is stillness, and the dust begins to clear"
PRINT ELLIPSIS
?CND4: RETURN WEST-OF-HOUSE
?CCL3: IN? NW-SE-PASSAGE,HERE \?CCL7
EQUAL? NW-SE-PASSAGE-DIR,P?NW \?CCL7
ZERO? RARG \FALSE
ICALL1 CANT-GO
RFALSE
?CCL7: ZERO? RARG \FALSE
ICALL1 RETURN-FROM-MAP
ICALL2 THIS-IS-IT,OUTER-GATE
ICALL2 DO-FIRST,STR?527
RFALSE
.FUNCT OUTER-GATE-F
EQUAL? PRSA,V?OPEN \FALSE
PRINTR "It would take the power of a wizard to open these massive doors."
.FUNCT I-END-GAME
INC 'END-GAME-COUNTER
EQUAL? END-GAME-COUNTER,12 \?CCL3
ICALL1 RETURN-FROM-MAP
CALL2 JIGS-UP,STR?528
RSTACK
?CCL3: EQUAL? END-GAME-COUNTER,11 \?CCL5
ICALL1 RETURN-FROM-MAP
PRINTR " A great rumble fills the air, and the buildings around you teeter like drunken dancers!"
?CCL5: EQUAL? END-GAME-COUNTER,9 \?CCL7
ICALL1 RETURN-FROM-MAP
PRINTR " Boulders of rubble roll past, threatening to crush you!"
?CCL7: EQUAL? END-GAME-COUNTER,6 \?CCL9
ICALL1 RETURN-FROM-MAP
PRINTR " As the grounds continue to shake, a multitude of rats well up from within and flee toward the perimeter wall."
?CCL9: EQUAL? END-GAME-COUNTER,3 \FALSE
ICALL1 RETURN-FROM-MAP
PRINTI " The "
FSET? HERE,OUTSIDEBIT \?CCL14
PRINTI "ground"
JUMP ?CND12
?CCL14: PRINTI "floor"
?CND12: PRINTR " rolls and shudders, making it difficult to stay on your feet."
.FUNCT WEST-OF-HOUSE-F,RARG
EQUAL? RARG,M-ENTER \?CCL3
ICALL1 RETURN-FROM-MAP
CALL1 UPDATE-STATUS-LINE
RSTACK
?CCL3: EQUAL? RARG,M-END \FALSE
ICALL1 RETURN-FROM-MAP
CRLF
ICALL1 HIT-ANY-KEY
CLEAR 0
CRLF
ICALL2 MARGINAL-PIC,EPILOGUE-LETTER
DIROUT D-SCREEN-OFF
PRINTC 65
DIROUT D-SCREEN-ON
PRINTI "s you stare dumbfounded at the white house, the jester appears, laughing as though at some supreme trick. Then, a low moaning wind begins to blow, and slowly, ever so slowly, his appearance shifts, until you see before you a wizard of incredible age and obvious power. His hoary visage stirs an ancient ancestral memory. He speaks in a new voice, tired but commanding of instant respect. ""I am Megaboz,"" he states, and your skin tingles at the presence of a legend.
""Yes, I still live. I have waited a long time for this day; to meet the one who would guard after I am gone.
""The Great Underground Empire is no more; but Quendor remains. The white house will stand as a warning and reminder of the excesses of the Flatheads. Some day, a new Empire may rise; you -- and your successors -- shall watch over the land, and ensure that future Empire be benevolent. Henceforth, you shall be known as Dungeon Master.
""As promised by Decree, half the wealth of the kingdom is yours!"" Your mind is suddenly filled with images of a vast underground Treasury, piled with unfathomable wealth. But the image is tempered by the ironic knowledge that you will never have use for such wealth. As the image fades, you hear tinkling bells and the voice of the jester/Megaboz: ""Well, I'm outta here! Over to you, Dungeon Master!"" You find yourself alone, left to ponder the years ahead, long years of keeping watch over Quendor and searching, ever searching, for your successor"
PRINT ELLIPSIS
CALL1 FINISH
RSTACK
.FUNCT LOCKER-F
EQUAL? PRSA,V?LOCK \FALSE
EQUAL? PRSO,LOCKER \FALSE
PRINTR "You don't have the right key."
.SEGMENT "0"
.FUNCT POSTER-F
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTR "The poster shows pin-up model Ursula Flathead (Miss Miznia, 878 GUE) in a typical suggestive pose and minimal cover."
?CCL3: EQUAL? PRSA,V?ROLL \FALSE
PRINTR "You curl it into a tube, but as you let go it flattens again."
.ENDSEG
.SEGMENT "VILLAGE"
.FUNCT GATE-PS
CALL2 PERFORM-PRSA,ARCH
RSTACK
.FUNCT TAX-OFFICE-F,RARG
EQUAL? RARG,M-END \FALSE
IN? ZORKMID-COIN,LOCAL-GLOBALS \FALSE
ICALL2 SETUP-ORPHAN,STR?44
IN? JESTER,HERE /FALSE
ICALL2 DEQUEUE,I-JESTER
MOVE JESTER,HERE
ICALL2 THIS-IS-IT,JESTER
ICALL1 RETURN-FROM-MAP
PRINTI " A bookkeeper is hunched over one of the desks. He looks up as you enter, and you see that it is the jester, wearing suspenders, a bow tie, thick eyeglasses, and a green visor.
"""
GETP TAX-OFFICE,P?RIDDLE
PRINT STACK
CRLF
RTRUE
.SEGMENT "0"
.FUNCT PIGEON-F
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTR "The pigeon, though strikingly lifelike, is merely a clay reproduction. On the bottom is some tiny writing."
?CCL3: EQUAL? PRSA,V?TAKE \?CCL5
EQUAL? PRSO,PIGEON \?CCL5
CALL2 ULTIMATELY-IN?,PIGEON
ZERO? STACK \FALSE
FSET? OUTER-GATE,OPENBIT /FALSE
ZERO? TIME-STOPPED \FALSE
RANDOM 100
LESS? 10,STACK \?CTR14
GRTR? P-MULT,1 \?CCL15
?CTR14: PRINTI "Your eyes must be starting to play tricks on you. It almost seemed like the clay pigeon "
IN? PIGEON,HERE \?CCL20
PRINTI "hopped"
JUMP ?CND18
?CCL20: PRINTI "squirmed"
?CND18: PRINTR " out of reach at the last second."
?CCL15: CALL2 ITAKE,TRUE-VALUE
EQUAL? STACK,M-FATAL /TRUE
CALL2 ULTIMATELY-IN?,PERCH
ZERO? STACK /?CCL24
PRINTR "Taken."
?CCL24: PRINTI "As you take the pigeon, you feel a dizziness, like that which one gets from drinking Miznian wines too quickly. "
CALL2 META-LOC,PERCH
EQUAL? STACK,HERE /?CTR26
EQUAL? HERE,OUBLIETTE \?CCL27
EQUAL? REMOVED-PERCH-LOC,OUBLIETTE \?CCL27
?CTR26: LOC PROTAGONIST
EQUAL? STACK,YACHT,DB /?CND32
MOVE PROTAGONIST,HERE
?CND32: PRINTR "When the disorientation passes, you seem to have moved a few feet."
?CCL27: ICALL1 CAST-HUNGER-SPELL
PRINTI "The world blurs, then darkens. You blink"
PRINT ELLIPSIS
SET 'HAND-IN-WALDO,FALSE-VALUE
CALL2 MOVE-TO-PERCH,PROTAGONIST
RSTACK
?CCL5: EQUAL? PRSA,V?PUT-ON \FALSE
EQUAL? PRSI,PERCH \FALSE
PRINTR "There's no apparent way to put the pigeon on the perch."
.FUNCT MOVE-TO-PERCH,WHAT,PERCH-LOC,L,OFFSET,RM,OBJ,X,N,TOOK-STUFF
CALL2 META-LOC,PERCH >PERCH-LOC
ZERO? PERCH-LOC /?CND1
IN? PERCH-LOC,ROOMS \?CND1
LOC PERCH
EQUAL? STACK,YACHT,DB \?CND1
LOC PERCH >PERCH-LOC
?CND1: EQUAL? WHAT,PROTAGONIST \?CND6
EQUAL? HERE,PLAIN \?CCL10
ICALL STORE,PLAIN-OFFSET,PLAIN-LOC,PLAIN
JUMP ?CND6
?CCL10: EQUAL? HERE,CONSTRUCTION \?CCL12
ICALL STORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC,CONSTRUCTION
JUMP ?CND6
?CCL12: EQUAL? HERE,FR-OFFICES \?CCL14
ICALL STORE,OFFICES-OFFSET,FLOOR-NUMBER,FR-OFFICES
JUMP ?CND6
?CCL14: EQUAL? HERE,OFFICES-NORTH \?CCL16
ICALL STORE,OFFICES-N-OFFSET,FLOOR-NUMBER,OFFICES-NORTH
JUMP ?CND6
?CCL16: EQUAL? HERE,OFFICES-SOUTH \?CCL18
ICALL STORE,OFFICES-S-OFFSET,FLOOR-NUMBER,OFFICES-SOUTH
JUMP ?CND6
?CCL18: EQUAL? HERE,OFFICES-EAST \?CCL20
ICALL STORE,OFFICES-E-OFFSET,FLOOR-NUMBER,OFFICES-EAST
JUMP ?CND6
?CCL20: EQUAL? HERE,OFFICES-WEST \?CND6
ICALL STORE,OFFICES-W-OFFSET,FLOOR-NUMBER,OFFICES-WEST
?CND6: ZERO? PERCH-LOC /?CCL24
EQUAL? WHAT,PROTAGONIST \?CCL27
EQUAL? HERE,MARSH \?CND28
IN? JESTER,NICE-LUNCH-SPOT \?CND28
ICALL1 REMOVE-J
?CND28: ICALL2 GOTO,PERCH-LOC
EQUAL? HERE,LAKE-BOTTOM \?CCL34
ICALL2 JIGS-UP,DROWN
RTRUE
?CCL34: EQUAL? HERE,PLAIN /TRUE
FCLEAR CLOAK,WORNBIT
RTRUE
?CCL27: EQUAL? PERCH-LOC,LAKE-BOTTOM \?CCL37
SET 'PIECE-DROWNED,1
ICALL ROB,WHAT,LAKE-BOTTOM
REMOVE WHAT
RTRUE
?CCL37: CALL FIND-IN,PERCH-LOC,WHITEBIT >X
ZERO? X \?CCL39
CALL FIND-IN,PERCH-LOC,BLACKBIT >X
ZERO? X /?CND38
?CCL39: ICALL ROB,X,WHAT
REMOVE X
?CND38: FIRST? PERCH-LOC >X /?PRG43
?PRG43: ZERO? X /?REP44
NEXT? X >N /?BOGUS47
?BOGUS47: FSET? X,TAKEBIT \?CND48
FSET? X,TRYTAKEBIT /?CND48
CALL FIND-IN,X,TRYTAKEBIT
ZERO? STACK \?CND48
SET 'TOOK-STUFF,TRUE-VALUE
MOVE X,WHAT
?CND48: SET 'X,N
JUMP ?PRG43
?REP44: MOVE WHAT,PERCH-LOC
EQUAL? PERCH-LOC,HERE \FALSE
PRINTI " With a surprisingly high-pitched squeal of alarm,"
ICALL2 APRINT,WHAT
PRINTI " materializes nearby. "
FSET? WHAT,FEMALEBIT \?CCL58
PRINTI "Sh"
JUMP ?CND56
?CCL58: PRINTC 72
?CND56: PRINTI "e seems somewhat dazed by the experience"
ZERO? TOOK-STUFF /?CCL61
PRINTR ", but not too dazed to pick the ground clean."
?CCL61: PRINT PERIOD-CR
RTRUE
?CCL24: CALL2 FIND-PERCH,PERCH >L
ZERO? L /?CCL63
GRTR? L,5000 \?CCL66
SET 'OFFSET,OFFICES-W-OFFSET
SET 'RM,OFFICES-WEST
JUMP ?CND64
?CCL66: GRTR? L,4000 \?CCL68
SET 'OFFSET,OFFICES-E-OFFSET
SET 'RM,OFFICES-EAST
JUMP ?CND64
?CCL68: GRTR? L,3000 \?CCL70
SET 'OFFSET,OFFICES-S-OFFSET
SET 'RM,OFFICES-SOUTH
JUMP ?CND64
?CCL70: GRTR? L,2000 \?CCL72
SET 'OFFSET,OFFICES-N-OFFSET
SET 'RM,OFFICES-NORTH
JUMP ?CND64
?CCL72: GRTR? L,1000 \?CCL74
SET 'OFFSET,OFFICES-OFFSET
SET 'RM,FR-OFFICES
JUMP ?CND64
?CCL74: GRTR? L,399 \?CCL76
SET 'OFFSET,CONSTRUCTION-OFFSET
SET 'RM,CONSTRUCTION
JUMP ?CND64
?CCL76: SET 'OFFSET,PLAIN-OFFSET
SET 'RM,PLAIN
?CND64: EQUAL? WHAT,PROTAGONIST \?CCL79
SUB L,OFFSET >L
EQUAL? RM,PLAIN \?CCL82
DIV L,8
ADD STACK,1 >RANK
MOD L,8
ADD STACK,1 >FILE
SET 'PLAIN-LOC,L
EQUAL? HERE,PLAIN /?CND83
MOVE CLOAK,PROTAGONIST
FSET CLOAK,WORNBIT
LOC PROTAGONIST
FSET? STACK,TAKEBIT \?CCL87
SET 'CLOAK-LOC,HERE
JUMP ?CND83
?CCL87: LOC PROTAGONIST >CLOAK-LOC
?CND83: ICALL UNSTORE,OFFSET,L,RM
JUMP ?CND80
?CCL82: EQUAL? RM,CONSTRUCTION \?CCL89
DIV L,8
ADD STACK,1 >RANK
MOD L,8
ADD STACK,1 >FILE
SET 'CONSTRUCTION-LOC,L
ICALL UNSTORE,OFFSET,L,RM
JUMP ?CND80
?CCL89: SET 'FLOOR-NUMBER,L
ICALL2 OFFICE-UNSTORE,L
?CND80: EQUAL? RM,PLAIN /?CND90
FCLEAR CLOAK,WORNBIT
?CND90: EQUAL? HERE,MARSH \?CND92
IN? JESTER,NICE-LUNCH-SPOT \?CND92
ICALL1 REMOVE-J
?CND92: CALL2 GOTO,RM
RSTACK
?CCL79: EQUAL? WHAT,WHITE-PAWN \?CCL98
EQUAL? RM,PLAIN \?CCL98
SUB L,OFFSET
LESS? STACK,8 \?CCL98
ICALL ROB,WHITE-PAWN,WHITE-QUEEN
SET 'WHAT,WHITE-QUEEN
JUMP ?CND96
?CCL98: EQUAL? WHAT,BLACK-PAWN \?CND96
EQUAL? RM,PLAIN \?CND96
SUB L,OFFSET
GRTR? STACK,55 \?CND96
ICALL ROB,BLACK-PAWN,BLACK-QUEEN
SET 'WHAT,BLACK-QUEEN
?CND96: REMOVE WHAT
ICALL REMOVE-ANY-PIECE,L,WHAT
ICALL PIECE-SNARF,L,WHAT
SUB L,OFFSET
CALL PUT-IN-STORAGE,OFFSET,WHAT,STACK
RSTACK
?CCL63: EQUAL? WHAT,PROTAGONIST \?CCL107
EQUAL? REMOVED-PERCH-LOC,WATER \?CCL110
HLIGHT H-BOLD
PRINTI "Surrounded by Water"
CRLF
HLIGHT H-NORMAL
CALL2 JIGS-UP,DROWN
RSTACK
?CCL110: EQUAL? REMOVED-PERCH-LOC,GROUND,OUBLIETTE \?CCL112
PRINTI "You appear "
EQUAL? REMOVED-PERCH-LOC,OUBLIETTE \?CCL115
PRINTI "knee deep in mud"
PRINT ELLIPSIS
FCLEAR CLOAK,WORNBIT
EQUAL? HERE,MARSH \?CND116
IN? JESTER,NICE-LUNCH-SPOT \?CND116
ICALL1 REMOVE-J
?CND116: CALL2 GOTO,OUBLIETTE
RSTACK
?CCL115: CALL2 JIGS-UP,STR?548
RSTACK
?CCL112: EQUAL? REMOVED-PERCH-LOC,PSEUDO-OBJECT \?CCL121
CALL2 JIGS-UP,STR?549
RSTACK
?CCL121: EQUAL? REMOVED-PERCH-LOC,BROGMOID \?CCL123
CALL2 JIGS-UP,STR?550
RSTACK
?CCL123: CALL2 JIGS-UP,STR?551
RSTACK
?CCL107: EQUAL? REMOVED-PERCH-LOC,OUBLIETTE \?CCL125
MOVE WHAT,OUBLIETTE
ICALL REMOVE-ANY-PIECE,L,WHAT
CALL PIECE-SNARF,L,WHAT
RSTACK
?CCL125: REMOVE WHAT
RTRUE
.FUNCT FIND-PERCH,OBJ,L,CNT
?PRG1: LESS? CNT,STORAGE-TABLE-LENGTH /?CCL5
LOC OBJ
ZERO? STACK /?REP2
LOC OBJ
CALL2 FIND-PERCH,STACK >L
RETURN L
?CCL5: ADD CNT,1
GET STORAGE-TABLE,STACK
EQUAL? STACK,OBJ \?CND3
GET STORAGE-TABLE,CNT >L
RETURN L
?CND3: ADD CNT,2 >CNT
JUMP ?PRG1
?REP2: RETURN L
.ENDSEG
.SEGMENT "VILLAGE"
.FUNCT FR-BLDG-F
EQUAL? PRSA,V?RESEARCH \?CCL3
CALL PICTURED-ENTRY,FR-ILL,STR?552
RSTACK
?CCL3: EQUAL? PRSA,V?EXAMINE \?CCL5
EQUAL? HERE,VILLAGE-CENTER \?CCL8
PRINTR "Most of the building is lost in the clouds."
?CCL8: PRINTR "You're in it!"
?CCL5: EQUAL? PRSA,V?ENTER \?CCL10
EQUAL? HERE,VILLAGE-CENTER \?CCL13
CALL2 DO-WALK,P?EAST
RSTACK
?CCL13: EQUAL? HERE,PHIL-HALL \?CCL15
CALL2 DO-WALK,P?NORTH
RSTACK
?CCL15: PRINT LOOK-AROUND
RTRUE
?CCL10: EQUAL? PRSA,V?EXIT \FALSE
CALL1 V-WALK-AROUND
RSTACK
.FUNCT FR-OFFICES-ENTER-F,RARG
ZERO? RARG /?CCL3
RETURN FR-OFFICES
?CCL3: EQUAL? HERE,FR-HQ \?CCL5
SET 'FLOOR-NUMBER,2
JUMP ?CND1
?CCL5: SET 'FLOOR-NUMBER,399
?CND1: ICALL2 OFFICE-UNSTORE,FLOOR-NUMBER
RETURN FR-OFFICES
.FUNCT OFFICES-F,RARG
EQUAL? RARG,M-ENTER \?CCL3
SET 'BEEN-IN-FR-UPPER-FLOORS,TRUE-VALUE
RETURN BEEN-IN-FR-UPPER-FLOORS
?CCL3: EQUAL? RARG,M-LOOK \FALSE
PRINTI "You are on Floor "
PRINTN FLOOR-NUMBER
PRINTI " of the FrobozzCo Building. The offices of one subsidiary or another can be entered in all four directions. Stairs lead up and down."
RTRUE
.FUNCT FR-FLOOR-F,RARG
EQUAL? PRSO,P?UP \?CCL3
EQUAL? FLOOR-NUMBER,399 \?CCL3
RETURN FR-PENTHOUSE
?CCL3: EQUAL? PRSO,P?DOWN \?CCL7
EQUAL? FLOOR-NUMBER,2 \?CCL7
RETURN FR-HQ
?CCL7: ZERO? RARG \FALSE
ICALL STORE,OFFICES-OFFSET,FLOOR-NUMBER
ICALL STORE,OFFICES-N-OFFSET,FLOOR-NUMBER,OFFICES-NORTH
ICALL STORE,OFFICES-S-OFFSET,FLOOR-NUMBER,OFFICES-SOUTH
ICALL STORE,OFFICES-E-OFFSET,FLOOR-NUMBER,OFFICES-EAST
ICALL STORE,OFFICES-W-OFFSET,FLOOR-NUMBER,OFFICES-WEST
EQUAL? PRSO,P?UP \?CCL14
INC 'FLOOR-NUMBER
JUMP ?CND12
?CCL14: DEC 'FLOOR-NUMBER
?CND12: ICALL2 OFFICE-UNSTORE,FLOOR-NUMBER
RETURN FR-OFFICES
.FUNCT OFFICE-UNSTORE,L
ICALL UNSTORE,OFFICES-OFFSET,L,FR-OFFICES
ICALL UNSTORE,OFFICES-N-OFFSET,L,OFFICES-NORTH
ICALL UNSTORE,OFFICES-S-OFFSET,L,OFFICES-SOUTH
ICALL UNSTORE,OFFICES-E-OFFSET,L,OFFICES-EAST
CALL UNSTORE,OFFICES-W-OFFSET,L,OFFICES-WEST
RSTACK
.FUNCT FR-OUTER-OFFICES-F,RARG
EQUAL? RARG,M-LOOK \FALSE
PRINTI "You are in an office on floor "
PRINTN FLOOR-NUMBER
PRINTI " of the FrobozzCo Building. The office has a lovely "
EQUAL? HERE,OFFICES-NORTH \?CCL6
PRINTI "north"
JUMP ?CND4
?CCL6: EQUAL? HERE,OFFICES-SOUTH \?CCL8
PRINTI "south"
JUMP ?CND4
?CCL8: EQUAL? HERE,OFFICES-EAST \?CCL10
PRINTI "east"
JUMP ?CND4
?CCL10: PRINTI "west"
?CND4: PRINTI "ern exposure. The only exit is to the "
EQUAL? HERE,OFFICES-NORTH \?CCL13
PRINTI "south"
JUMP ?CND11
?CCL13: EQUAL? HERE,OFFICES-SOUTH \?CCL15
PRINTI "north"
JUMP ?CND11
?CCL15: EQUAL? HERE,OFFICES-EAST \?CCL17
PRINTI "west"
JUMP ?CND11
?CCL17: PRINTI "east"
?CND11: PRINTC 46
RTRUE
.FUNCT FR-PENTHOUSE-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? FR-PENTHOUSE,TOUCHBIT /FALSE
SET 'DO-J,TRUE-VALUE
CALL QUEUE,I-JESTER,1
RSTACK
.FUNCT PHIL-ENTER-F,RARG
ZERO? RARG \?CND1
EQUAL? CURRENT-SPLIT,TEXT-WINDOW-PIC-LOC /?CCL2
RETURN PHIL-HALL
?CCL2: PRINTI "The passage takes you from the FrobozzCo Building back into the castle. It widens"
PRINT ELLIPSIS
?CND1: RETURN PHIL-HALL
.ENDSEG
.SEGMENT "LAKE"
.FUNCT FR-BASEMENT-ENTER-F,RARG
ZERO? RARG \?CND1
EQUAL? CURRENT-SPLIT,TEXT-WINDOW-PIC-LOC /?CCL2
RETURN FR-BASEMENT
?CCL2: PRINTI "The passage narrows as it leaves the castle, then widens again as it enters"
PRINT ELLIPSIS
?CND1: RETURN FR-BASEMENT
.ENDSEG
.SEGMENT "0"
.SEGMENT "VILLAGE"
.FUNCT RING-F,AV,HOLDING-STUFF
EQUAL? PRSA,V?WEAR \FALSE
LOC PROTAGONIST >AV
MOVE RING,PROTAGONIST
FSET RING,WORNBIT
PRINTI "As you slip the ring onto your finger, you clumsily "
EQUAL? HERE,UNDER-THE-WORLD,HANGING-FROM-ROOTS,LEDGE-IN-PIT /?CTR5
EQUAL? HERE,MOUTH-OF-CAVE \?CCL6
?CTR5: PRINTI "lose your grip, and plunge downward. "
ICALL PERFORM,V?LEAP,ROOMS
RTRUE
?CCL6: CALL2 CCOUNT,PROTAGONIST
GRTR? STACK,1 \?CCL10
PRINTI "drop everything you were holding."
FSET? AV,DROPBIT \?CCL13
PUSH AV
JUMP ?CND11
?CCL13: PUSH HERE
?CND11: ICALL ROB,PROTAGONIST,STACK,TRUE-VALUE
CRLF
RTRUE
?CCL10: PRINTR "trip over your own feet and just barely manage to keep your balance."
.ENDSEG
.ENDI

1171
village.zil Normal file
View File

File diff suppressed because it is too large Load Diff

39
zork0.errors Normal file
View File

@ -0,0 +1,39 @@
Assembling ZORK0.ZAP.1 on Wednesday, October 19, 1988 19:35:38
Release: 296
64 Inserting ZORK0FREQ.XZAP.4 (628 bytes)
692 Inserting ZORK0DAT.ZAP.1 (53436 bytes)
54128 Inserting ZORK0PUR.ZAP.1 (6732 bytes)
60860 Inserting PSTACK.ZAP.1 (38 bytes)
60898 Inserting PMEM.ZAP.1 (104 bytes)
61002 Inserting DEFS2.ZAP.1 (19 bytes)
61021 Inserting PARSER.ZAP.1 (4286 bytes)
65307 Inserting FIND.ZAP.1 (1913 bytes)
67220 Inserting REDS.ZAP.1 (5796 bytes)
73016 Inserting TOP.ZAP.1 (2319 bytes)
75335 Inserting PRARE.ZAP.1 (4325 bytes)
79660 Inserting MISC.ZAP.1 (1498 bytes)
81158 Inserting INPUT.ZAP.1 (2001 bytes)
83159 Inserting VERBS.ZAP.1 (26809 bytes)
109968 Inserting GLOBALS.ZAP.1 (11891 bytes)
121859 Inserting PIC.ZAP.1 (340 bytes)
122199 Inserting PROLOGUE.ZAP.1 (9969 bytes)
132168 Inserting CASTLE.ZAP.1 (19888 bytes)
152056 Inserting LIBRARY.ZAP.1 (1736 bytes)
153792 Inserting VILLAGE.ZAP.1 (4709 bytes)
158501 Inserting LAKE.ZAP.1 (10317 bytes)
168818 Inserting HIGHWAY.ZAP.1 (9986 bytes)
178804 Inserting ORACLE.ZAP.1 (15063 bytes)
193867 Inserting CHESS.ZAP.1 (3763 bytes)
197630 Inserting JESTER.ZAP.1 (11786 bytes)
209416 Inserting FENSHIRE.ZAP.1 (6166 bytes)
215582 Inserting CLUES.ZAP.1 (1912 bytes)
217494 Inserting ZORK0STR.ZAP.1 (78038 bytes)
603 objects.
226 globals.
1619 word vocabulary.
295532 bytes (289K).
54128 bytes of preload.
32134 bytes of impure.
Outputting symbol tables

BIN
zork0.pic Normal file
View File

Binary file not shown.

84
zork0.zap Normal file
View File

@ -0,0 +1,84 @@
.NEW 6
; Low core locations
%ZVERSION:: .BYTE 6
.BYTE FLAGS
%ZORKID:: ZORKID
%ENDLOD:: ENDLOD
%START:: GO
%VOCAB:: VOCAB
%OBJECT:: OBJECT
%GLOBAL:: GLOBAL
%PURBOT:: IMPURE
%FLAGS:: .WORD 48
%SERIAL:: .WORD 0
%SERI1:: .WORD 0
%SERI2:: .WORD 0
%FWORDS:: WORDS
%PLENTH:: .WORD 0
%PCHKSM:: .WORD 0
%INTWRD:: .WORD 0
%SCRWRD:: .WORD 0
%HWRD:: .WORD 0
%VWRD:: .WORD 0
%FWRD:: .WORD 0
%FOFF:: FOFF
%SOFF:: SOFF
%CLRWRD:: .WORD 0
%TCHAR:: TCHARS
%TWID:: .WORD 0
%CRFUNC:: .WORD 0
%CHRSET:: .WORD 0
%EXTAB:: LOWCORE-TABLE
.WORD 0
.WORD 0
.WORD 0
.WORD 0
.DEFSEG "CASTLE",0,"FENSHIRE","LOWER","SECRET","VILLAGE","STARTUP"
.DEFSEG "FENSHIRE",0,"CASTLE"
.DEFSEG "FOOZLE",0,"LOWER"
.DEFSEG "LAKE",0,"ORACLE","LOWER","VILLAGE"
.DEFSEG "LOWER",0,"FOOZLE","LAKE","CASTLE"
.DEFSEG "ORACLE",0,"LAKE","SECRET"
.DEFSEG "SECRET",0,"ORACLE","CASTLE"
.DEFSEG "STARTUP",1,"CASTLE"
.DEFSEG "VILLAGE",0,"LAKE","CASTLE"
.INSERT "PS:<ZORK0>ZORK0FREQ" ;Frequent word table
.INSERT "PS:<ZORK0>ZORK0DAT" ; Data file
.INSERT "PS:<ZORK0>ZORK0PUR"
.INSERT "PS:<ZORK0>PSTACK"
.INSERT "PS:<ZORK0>PMEM"
.INSERT "PS:<ZORK0>DEFS2"
.INSERT "PS:<ZORK0>PARSER"
.INSERT "PS:<ZORK0>FIND"
.INSERT "PS:<ZORK0>REDS"
.INSERT "PS:<ZORK0>TOP"
.INSERT "PS:<ZORK0>PRARE"
.INSERT "PS:<ZORK0>MISC"
.INSERT "PS:<ZORK0>INPUT"
.INSERT "PS:<ZORK0>VERBS"
.INSERT "PS:<ZORK0>GLOBALS"
.INSERT "PS:<ZORK0>PIC"
.INSERT "PS:<ZORK0>PROLOGUE"
.INSERT "PS:<ZORK0>CASTLE"
.INSERT "PS:<ZORK0>LIBRARY"
.INSERT "PS:<ZORK0>VILLAGE"
.INSERT "PS:<ZORK0>LAKE"
.INSERT "PS:<ZORK0>HIGHWAY"
.INSERT "PS:<ZORK0>ORACLE"
.INSERT "PS:<ZORK0>CHESS"
.INSERT "PS:<ZORK0>JESTER"
.INSERT "PS:<ZORK0>FENSHIRE"
.INSERT "PS:<ZORK0>CLUES"
.INSERT "PS:<ZORK0>ZORK0STR"
.END

62
zork0.zil Normal file
View File

@ -0,0 +1,62 @@
"ZORK0 for
ZORK ZERO
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
<PRINC "
*** Zork Zero ***
">
ON!-INITIAL
OFF!-INITIAL ;"makes ZIL debugging possible -- pdl"
<VERSION YZIP>
<ZIP-OPTIONS UNDO BIG MOUSE ;"COLOR DISPLAY">
<FREQUENT-WORDS?>
<LONG-WORDS?>
<ORDER-OBJECTS? ROOMS-FIRST>
<DEFINE-SEGMENT STARTUP T CASTLE>
<DEFINE-SEGMENT CASTLE <> VILLAGE SECRET LOWER FENSHIRE>
<DEFINE-SEGMENT VILLAGE <> CASTLE LAKE>
<DEFINE-SEGMENT SECRET <> CASTLE ORACLE>
<DEFINE-SEGMENT LOWER <> CASTLE LAKE FOOZLE>
<DEFINE-SEGMENT LAKE <> VILLAGE LOWER ORACLE>
<DEFINE-SEGMENT FOOZLE <> LOWER>
<DEFINE-SEGMENT FENSHIRE <> CASTLE>
<DEFINE-SEGMENT ORACLE <> LAKE SECRET>
<DEFINE-SEGMENT HINTS <>>
<DEFINE-SEGMENT SOFT <>>
<SET REDEFINE T>
<SETG NEW-PARSER? T>
<SETG NEW-VOC? T>
<COMPILATION-FLAG ONE-BYTE-PARTS-OF-SPEECH T>
<SETG L-SEARCH-PATH (["P" ""] !,L-SEARCH-PATH)>
<INSERT-FILE "DEFS">
<XFLOAD "P:PARSER.ZORK0">
<INSERT-FILE "MISC">
<INSERT-FILE "INPUT">
<INSERT-FILE "SYNTAX">
<INSERT-FILE "VERBS">
;<PUT-PURE-HERE>
<INSERT-FILE "GLOBALS">
<INSERT-FILE "PIC">
<INSERT-FILE "PICDEF">
<INSERT-FILE "PROLOGUE">
<INSERT-FILE "CASTLE">
<INSERT-FILE "LIBRARY">
<INSERT-FILE "VILLAGE">
<INSERT-FILE "LAKE">
<INSERT-FILE "HIGHWAY">
<INSERT-FILE "ORACLE">
<INSERT-FILE "CHESS">
<INSERT-FILE "JESTER">
<INSERT-FILE "FENSHIRE">
<XFLOAD "<ZILLIB>CLUES.XFLOAD">
<INSERT-FILE "HINTS">
<PROPDEF SIZE 5>
<PROPDEF CAPACITY 5>

BIN
zork0.zip Normal file
View File

Binary file not shown.

2108
zork0.zpic Normal file
View File

File diff suppressed because it is too large Load Diff

26969
zork0dat.zap Normal file
View File

File diff suppressed because it is too large Load Diff

200
zork0freq.xzap Normal file
View File

@ -0,0 +1,200 @@
.FSTR FSTR?1,"the " ;6216 3109
.FSTR FSTR?2,"The " ;2115 706
.FSTR FSTR?3,", " ;2067 2068
.FSTR FSTR?4,"and " ;1476 739
.FSTR FSTR?5,"You " ;1290 431
.FSTR FSTR?6,"of " ;1241 1242
.FSTR FSTR?7,"you " ;1180 591
.FSTR FSTR?8,". " ;1149 1150
.FSTR FSTR?9,"to " ;965 966
.FSTR FSTR?10,"is " ;669 670
.FSTR FSTR?11,"your " ;666 223
.FSTR FSTR?12,"that " ;666 223
.FSTR FSTR?13,"from " ;651 218
.FSTR FSTR?14,"in " ;593 594
.FSTR FSTR?15,"with " ;588 197
.FSTR FSTR?16,"into " ;504 169
.FSTR FSTR?17,"which " ;492 124
.FSTR FSTR?18,"are " ;490 246
.FSTR FSTR?19,"There's " ;448 57
.FSTR FSTR?20,"jester " ;440 89
.FSTR FSTR?21,"Flathead " ;440 56
.FSTR FSTR?22,"have " ;438 147
.FSTR FSTR?23,"This " ;428 108
.FSTR FSTR?24,"this " ;366 123
.FSTR FSTR?25,"for " ;346 174
.FSTR FSTR?26,"Underground " ;330 31
.FSTR FSTR?27,"It's " ;320 65
.FSTR FSTR?28,"something " ;312 40
.FSTR FSTR?29,"Flathead" ;301 44
.FSTR FSTR?30,"You're " ;294 43
.FSTR FSTR?31,"about " ;260 66
.FSTR FSTR?32,"can't " ;255 52
.FSTR FSTR?33,"There " ;250 51
.FSTR FSTR?34,"on " ;246 247
.FSTR FSTR?35,"but " ;246 124
.FSTR FSTR?36,"small " ;244 62
.FSTR FSTR?37,"A " ;243 244
.FSTR FSTR?38,"can " ;242 122
.FSTR FSTR?39,"through " ;240 41
.FSTR FSTR?40,"only " ;237 80
.FSTR FSTR?41,"passage " ;234 40
.FSTR FSTR?42,"Dimwit " ;234 40
.FSTR FSTR?43,"FrobozzCo " ;234 27
.FSTR FSTR?44,"one " ;226 114
.FSTR FSTR?45,"Frobozz " ;224 33
.FSTR FSTR?46,"leads " ;216 55
.FSTR FSTR?47,"large " ;216 55
.FSTR FSTR?48,"Great " ;215 44
.FSTR FSTR?49,"been " ;213 72
.FSTR FSTR?50,"seems " ;212 54
.FSTR FSTR?51,"you've " ;210 36
.FSTR FSTR?52,"you're " ;210 36
.FSTR FSTR?53,"his " ;200 101
.FSTR FSTR?54,"around " ;200 41
.FSTR FSTR?55,"just " ;198 67
.FSTR FSTR?56,"out " ;196 99
.FSTR FSTR?57,"south" ;195 66
.FSTR FSTR?58,"at " ;189 190
.FSTR FSTR?59,"it " ;188 189
.FSTR FSTR?60,"will " ;183 62
.FSTR FSTR?61,"be " ;180 181
.FSTR FSTR?62,"has " ;180 91
.FSTR FSTR?63,"Magic " ;180 37
.FSTR FSTR?64,"would " ;176 45
.FSTR FSTR?65,"southwest" ;175 26
.FSTR FSTR?66,"northeast" ;175 26
.FSTR FSTR?67,"! " ;174 175
.FSTR FSTR?68,"getting " ;174 30
.FSTR FSTR?69,"Flatheadia" ;171 20
.FSTR FSTR?70,"as " ;168 169
.FSTR FSTR?71,"like " ;165 56
.FSTR FSTR?72,"all " ;162 82
.FSTR FSTR?73,"It " ;162 82
.FSTR FSTR?74,"there's " ;161 24
.FSTR FSTR?75,"You'll " ;161 24
.FSTR FSTR?76,"other " ;160 41
.FSTR FSTR?77,"north" ;159 54
.FSTR FSTR?78,"not " ;158 80
.FSTR FSTR?79,"get " ;156 79
.FSTR FSTR?80,"where " ;156 40
.FSTR FSTR?81,"by " ;155 156
.FSTR FSTR?82,"don't " ;155 32
.FSTR FSTR?83,"center " ;155 32
.FSTR FSTR?84,"right " ;152 39
.FSTR FSTR?85,"looks " ;152 39
.FSTR FSTR?86,"number " ;150 31
.FSTR FSTR?87,"castle " ;150 31
.FSTR FSTR?88,"already " ;150 26
.FSTR FSTR?89,"Company" ;150 26
.FSTR FSTR?90,"was " ;148 75
.FSTR FSTR?91,"Your " ;148 38
.FSTR FSTR?92,"than " ;147 50
.FSTR FSTR?93,"must " ;144 49
.FSTR FSTR?94,"opening " ;144 25
.FSTR FSTR?95,"its " ;142 72
.FSTR FSTR?96,"here" ;140 71
;word frequency table of 96 most common words
WORDS:: .TABLE
FSTR?1
FSTR?2
FSTR?3
FSTR?4
FSTR?5
FSTR?6
FSTR?7
FSTR?8
FSTR?9
FSTR?10
FSTR?11
FSTR?12
FSTR?13
FSTR?14
FSTR?15
FSTR?16
FSTR?17
FSTR?18
FSTR?19
FSTR?20
FSTR?21
FSTR?22
FSTR?23
FSTR?24
FSTR?25
FSTR?26
FSTR?27
FSTR?28
FSTR?29
FSTR?30
FSTR?31
FSTR?32
FSTR?33
FSTR?34
FSTR?35
FSTR?36
FSTR?37
FSTR?38
FSTR?39
FSTR?40
FSTR?41
FSTR?42
FSTR?43
FSTR?44
FSTR?45
FSTR?46
FSTR?47
FSTR?48
FSTR?49
FSTR?50
FSTR?51
FSTR?52
FSTR?53
FSTR?54
FSTR?55
FSTR?56
FSTR?57
FSTR?58
FSTR?59
FSTR?60
FSTR?61
FSTR?62
FSTR?63
FSTR?64
FSTR?65
FSTR?66
FSTR?67
FSTR?68
FSTR?69
FSTR?70
FSTR?71
FSTR?72
FSTR?73
FSTR?74
FSTR?75
FSTR?76
FSTR?77
FSTR?78
FSTR?79
FSTR?80
FSTR?81
FSTR?82
FSTR?83
FSTR?84
FSTR?85
FSTR?86
FSTR?87
FSTR?88
FSTR?89
FSTR?90
FSTR?91
FSTR?92
FSTR?93
FSTR?94
FSTR?95
FSTR?96
.ENDT
.ENDI

5247
zork0pur.zap Normal file
View File

File diff suppressed because it is too large Load Diff

2108
zork0str.zap Normal file
View File

File diff suppressed because it is too large Load Diff