sherlock/other-misc.zap

1074 lines
22 KiB
Plaintext

.FUNCT SET-SIZE-TO-ONE,OBJ,NUM
GETP OBJ,P?SIZE >NUM
DIV NUM,SIZE-VALS
MUL STACK,SIZE-VALS
ADD 1,STACK
PUTP OBJ,P?SIZE,STACK
RTRUE
.FUNCT GET-SIZE,OBJ,NUM
GETP OBJ,P?SIZE >NUM
MOD NUM,SIZE-VALS >NUM
LESS? NUM,6 \?CCL3
RETURN NUM
?CCL3: SUB NUM,6
GETB SIZE-TABLE,STACK
RSTACK
.FUNCT SET-MASS-TO-ONE,OBJ,NUM,?TMP1
GETP OBJ,P?SIZE >NUM
MOD NUM,SIZE-VALS
ADD SIZE-VALS,STACK >?TMP1
DIV NUM,143
MUL STACK,143
ADD ?TMP1,STACK
PUTP OBJ,P?SIZE,STACK
RTRUE
.FUNCT GET-MASS,OBJ,NUM
GETP OBJ,P?SIZE >NUM
DIV NUM,SIZE-VALS
MOD STACK,MASS-VALS >NUM
LESS? NUM,6 \?CCL3
RETURN NUM
?CCL3: SUB NUM,6
GETB MASS-TABLE,STACK
RSTACK
.FUNCT GET-CAPACITY,OBJ,NUM
GETP OBJ,P?SIZE >NUM
DIV NUM,143 >NUM
GRTR? NUM,100 \?CCL3
RETURN 999
?CCL3: RETURN NUM
.FUNCT SET-CAPACITY-TO-ONE,OBJ,NUM
GETP OBJ,P?SIZE >NUM
MOD NUM,143
ADD 143,STACK
PUTP OBJ,P?SIZE,STACK
RTRUE
.FUNCT RT-SEE-ANYTHING-IN?,THING,OBJ
FIRST? THING >OBJ /?PRG2
?PRG2: ZERO? OBJ /FALSE
FSET? OBJ,FL-NODESC /?CCL8
EQUAL? OBJ,GL-WINNER \TRUE
?CCL8: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
.FUNCT RT-CANT-TOUCH-MSG,OBJ,CLSD,IN-OUT
ICALL1 RT-CYOU-MSG
PRINTI "cannot "
PRINTB GL-P-PRSA-WORD
PRINTC 32
ICALL2 RT-THEO-PRINT,OBJ
ZERO? CLSD /?CND1
PRINTI " because "
FSET? OBJ,FL-PLURAL \?CCL5
FSET? OBJ,FL-COLLECTIVE /?CCL5
PRINTI "they are"
JUMP ?CND3
?CCL5: PRINTI "it is"
?CND3: PRINTC 32
ZERO? IN-OUT /?CCL10
PRINTI "inside"
JUMP ?CND8
?CCL10: PRINTI "outside"
?CND8: PRINTC 32
ICALL2 RT-THEO-PRINT,CLSD
PRINTI ", which is closed"
?CND1: PRINTR "."
.FUNCT RT-TOTAL-SIZE-IN-OBJ,OBJ1,OBJ,TOTSIZ
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
CALL2 GET-SIZE,OBJ
ADD TOTSIZ,STACK >TOTSIZ
NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: RETURN TOTSIZ
.FUNCT RT-TOTAL-MASS-OF-OBJ,OBJ1,OBJ,TOTMAS
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
CALL2 RT-TOTAL-MASS-OF-OBJ,OBJ
ADD TOTMAS,STACK >TOTMAS
NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: CALL2 GET-MASS,OBJ1
ADD TOTMAS,STACK >TOTMAS
RETURN TOTMAS
.FUNCT RT-TOTAL-COUNT-IN-OBJ,OBJ1,OBJ,TOTCNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
FSET? OBJ,FL-WORN \?CCL8
IN? OBJ,CH-PLAYER /?CND4
?CCL8: FSET? OBJ,FL-BODYPART /?CND4
INC 'TOTCNT
?CND4: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: RETURN TOTCNT
.FUNCT RT-OBJ-TOO-LARGE?,OBJ1,OBJ2,?TMP1,?TMP2
CALL2 GET-SIZE,OBJ1 >?TMP2
CALL2 RT-TOTAL-SIZE-IN-OBJ,OBJ2
ADD ?TMP2,STACK >?TMP1
CALL2 GET-CAPACITY,OBJ2
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT RT-OBJ-TOO-HEAVY?,OBJ1,OBJ2,?TMP1,?TMP2
CALL2 RT-TOTAL-MASS-OF-OBJ,OBJ1 >?TMP2
CALL2 RT-TOTAL-MASS-OF-OBJ,OBJ2
ADD ?TMP2,STACK >?TMP1
GETP OBJ2,P?STRENGTH
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT RT-OBJ-TOO-MANY?,OBJ1,OBJ2,?TMP1
CALL2 RT-TOTAL-COUNT-IN-OBJ,OBJ2
ADD 1,STACK >?TMP1
GETP OBJ2,P?DEXTERITY
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT RT-REMOVE-ALL,OBJ1,OBJ,NXT,CNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: REMOVE OBJ
INC 'CNT
SET 'OBJ,NXT
JUMP ?PRG2
?REP3: RETURN CNT
.FUNCT RT-MOVE-ALL-BUT-WORN,OBJ1,OBJ2,OBJ,NXT,CNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: FSET? OBJ,FL-WORN /?CND7
EQUAL? OBJ,TH-POCKET /?CND7
MOVE OBJ,OBJ2
INC 'CNT
?CND7: SET 'OBJ,NXT
JUMP ?PRG2
?REP3: RETURN CNT
.FUNCT RT-MOVE-NODESC-OBJS,OBJ1,OBJ2,OBJ,NXT,CNT
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: FSET? OBJ,FL-NODESC \?CND7
MOVE OBJ,OBJ2
INC 'CNT
?CND7: SET 'OBJ,NXT
JUMP ?PRG2
?REP3: RETURN CNT
.FUNCT RT-FIND-IN?,OBJ1,FLG,OBJ
FIRST? OBJ1 >OBJ /?PRG2
?PRG2: ZERO? OBJ /FALSE
FSET? OBJ,FLG \?CND4
RETURN OBJ
?CND4: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
.FUNCT RT-GET-ANY-KEY,X
PRINTI "[Press any key.]"
CRLF
INPUT 1 >X
RTRUE
.FUNCT RT-GET-YES-NO?,WORD
?PRG1: CRLF
PRINTI "Please type YES or NO > "
PUTB GL-YES-LEXV,0,4
PUTB GL-YES-IBUF,1,0
READ GL-YES-IBUF,GL-YES-LEXV
GET GL-YES-LEXV,K-P-LEXSTART >WORD
GETB GL-YES-LEXV,K-P-LEXWORDS
ZERO? STACK /?PRG1
ZERO? WORD /?PRG1
EQUAL? WORD,W?Y,W?YES /TRUE
EQUAL? WORD,W?N,W?NO \?PRG1
RFALSE
.FUNCT RT-INIT-SCREEN,FAST?
ZERO? FAST? /?CCL3
SPLIT GL-SPLIT-ROW
CLEAR 1
JUMP ?CND1
?CCL3: CLEAR -1
SPLIT GL-SPLIT-ROW
?CND1: SCREEN K-S-WIN
HLIGHT K-H-INV
CURSET GL-SPLIT-ROW,1
ICALL2 RT-PRINT-SPACES,GL-ALLSCREEN
SET 'GL-PLACE-STS,-1
SET 'GL-MOVES-STS,-1
SET 'GL-SCORE-STS,-1
CURSET GL-SPLIT-ROW,GL-STAT-S-POS
ZERO? GL-SHORT-STAT? \?CND4
PRINTI "Score:"
?CND4: HLIGHT K-H-NRM
SCREEN K-S-NOR
RTRUE
.FUNCT RT-GAMETITLE-MSG
PRINTR "Sherlock: The Riddle of the Crown Jewels"
.FUNCT RT-COPYRIGHT-MSG
PRINTR "Copyright 1987 Infocom, Inc."
.FUNCT RT-TRADEMARK-MSG
PRINTR "Sherlock: The Riddle of the Crown Jewels is a trademark of Infocom, Inc."
.FUNCT RT-ID-MSG,IDX
SET 'IDX,18
PRINTI "Release "
GET 0,1
BAND STACK,2047
PRINTN STACK
PRINTI " Interpreter "
GETB 0,30
PRINTN STACK
PRINTI " Version "
GETB 0,31
PRINTC STACK
PRINTI " Serial Number "
?PRG1: GETB 0,IDX
PRINTC STACK
IGRTR? 'IDX,23 \?PRG1
CRLF
RTRUE
.FUNCT RT-VERSION-MSG
HLIGHT K-H-BLD
ICALL1 RT-GAMETITLE-MSG
ICALL1 RT-COPYRIGHT-MSG
ICALL1 RT-TRADEMARK-MSG
ICALL1 RT-ID-MSG
HLIGHT K-H-NRM
RTRUE
.FUNCT RT-DESC-PL-CONT-1,SURFACE,CNT,OBJ,NXT,FIRST,PERSON-COUNT,PERSON-PLURAL
FIRST? SURFACE >OBJ /?BOGUS1
?BOGUS1: SET 'FIRST,TRUE-VALUE
?PRG2: ZERO? OBJ /?REP3
FSET? OBJ,FL-NODESC /?CTR7
EQUAL? OBJ,GL-PUPPY \?CCL8
?CTR7: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?CCL8: FSET? OBJ,FL-PERSON \?CCL13
INC 'PERSON-COUNT
NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?CCL13: ZERO? FIRST /?CND4
GRTR? CNT,0 \?CCL18
PRINTC 32
JUMP ?CND16
?CCL18: CRLF
?CND16: PRINTI "You see "
SET 'FIRST,FALSE-VALUE
?CND4: ICALL2 RT-A-PRINT,OBJ
INC 'CNT
NEXT? OBJ >OBJ /?PRG20
?PRG20: ZERO? OBJ /?REP21
EQUAL? OBJ,GL-PUPPY /?CND22
FSET? OBJ,FL-NODESC /?CND22
FSET? OBJ,FL-PERSON \?REP21
FSET? OBJ,FL-NODESC /?REP21
INC 'PERSON-COUNT
?CND22: NEXT? OBJ >OBJ /?PRG20
JUMP ?PRG20
?REP21: ZERO? OBJ /?CCL36
NEXT? OBJ >NXT /?PRG38
?PRG38: ZERO? NXT /?REP39
FSET? NXT,FL-NODESC /?CND40
EQUAL? NXT,GL-PUPPY /?CND40
FSET? NXT,FL-PERSON \?REP39
?CND40: NEXT? NXT >NXT /?PRG38
JUMP ?PRG38
?REP39: ZERO? NXT \?CCL50
PRINTI " and "
JUMP ?PRG2
?CCL50: PRINTI ", "
JUMP ?PRG2
?CCL36: IN? SURFACE,ROOMS /?CND51
PRINTI " on "
ICALL2 RT-THEO-PRINT,SURFACE
?CND51: PRINTC 46
JUMP ?PRG2
?REP3: GRTR? PERSON-COUNT,0 \?CND53
GRTR? CNT,0 \?CCL57
PRINTC 32
JUMP ?CND55
?CCL57: CRLF
?CND55: ADD CNT,PERSON-COUNT >CNT
GRTR? PERSON-COUNT,1 \?CND58
SET 'PERSON-PLURAL,TRUE-VALUE
?CND58: FIRST? SURFACE >OBJ /?BOGUS60
?BOGUS60: SET 'FIRST,TRUE-VALUE
?PRG61: FSET? OBJ,FL-NODESC /?CND63
EQUAL? OBJ,GL-PUPPY /?CND63
FSET? OBJ,FL-PERSON \?CND63
ZERO? FIRST /?CCL71
ICALL RT-THEO-PRINT,OBJ,TRUE-VALUE,K-DESC-A
JUMP ?CND69
?CCL71: ICALL2 RT-A-PRINT,OBJ
?CND69: SET 'FIRST,FALSE-VALUE
FSET? OBJ,FL-PLURAL \?CND72
SET 'PERSON-PLURAL,TRUE-VALUE
?CND72: DEC 'PERSON-COUNT
ZERO? PERSON-COUNT \?CCL76
ZERO? PERSON-PLURAL /?CCL79
PRINTI " are"
JUMP ?CND77
?CCL79: PRINTI " is"
?CND77: PRINTI " here."
?CND53: FIRST? SURFACE >OBJ /?PRG84
?PRG84: ZERO? OBJ /?REP85
FSET? OBJ,FL-SURFACE \?CND86
CALL RT-DESC-PL-CONT-1,OBJ,CNT >CNT
?CND86: NEXT? OBJ >OBJ /?PRG84
JUMP ?PRG84
?CCL76: EQUAL? PERSON-COUNT,1 \?CCL81
PRINTI " and "
JUMP ?CND63
?CCL81: PRINTI ", "
?CND63: NEXT? OBJ >OBJ /?PRG61
JUMP ?PRG61
?REP85: RETURN CNT
.FUNCT RT-DESCRIBE-PLACE-CONTENTS,PLACE,LOOK,OBJ,PREV,CNT,LIGHT
ZERO? PLACE \?CND1
SET 'PLACE,GL-PLACE-CUR
?CND1: CALL RT-DESC-PL-CONT-1,PLACE,0
ZERO? STACK /TRUE
CRLF
RTRUE
.FUNCT RT-RANK-STR,PTS
LESS? PTS,1 \?CCL3
RETURN STR?231
?CCL3: LESS? PTS,21 \?CCL5
RETURN STR?232
?CCL5: LESS? PTS,41 \?CCL7
RETURN STR?233
?CCL7: LESS? PTS,61 \?CCL9
RETURN STR?234
?CCL9: LESS? PTS,81 \?CCL11
RETURN STR?235
?CCL11: LESS? PTS,91 \?CCL13
RETURN STR?236
?CCL13: LESS? PTS,100 /?CTR14
RETURN STR?238
?CTR14: RETURN STR?237
.FUNCT RT-NEW-SCORE-MSG,PTS
ZERO? PTS /FALSE
HLIGHT K-H-BLD
ZERO? GL-SCORE-MSG /?CND3
CRLF
PRINTI "[Your score just went up by "
PRINTN PTS
PRINTI " point"
GRTR? PTS,1 \?CND5
PRINTC 115
?CND5: PRINTI ". The total is now "
PRINTN GL-SCORE-CUR
PRINTI " out of "
PRINTN GL-SCORE-MAX
PRINTI ".]"
CRLF
?CND3: HLIGHT K-H-NRM
RTRUE
.FUNCT RT-PARSE-EVENT?,NOUN,ADJ,OBJ,N,TB,NTB,ATB,FLGS,?TMP1
SET 'OBJ,TH-EVENT
SET 'N,10
SET 'TB,TH-EVENT-NAMES+2
?PRG1: GET TB,0 >NTB
ADD NTB,2 >?TMP1
GET NTB,0
INTBL? NOUN,?TMP1,STACK \?CND3
ZERO? ADJ /?CTR6
GET TB,1 >ATB
ZERO? ATB /FALSE
ADD ATB,2 >?TMP1
GET ATB,0
INTBL? ADJ,?TMP1,STACK \FALSE
?CTR6: GET NTB,1
PUTP OBJ,P?OBJ-NOUN,STACK
GET TB,3 >FLGS
BTST FLGS,2 \?CCL14
FSET OBJ,FL-ALIVE
JUMP ?CND12
?CCL14: FCLEAR OBJ,FL-ALIVE
?CND12: BTST FLGS,4 \?CCL17
FSET OBJ,FL-PERSON
JUMP ?CND15
?CCL17: FCLEAR OBJ,FL-PERSON
?CND15: BTST FLGS,8 \?CCL20
FSET OBJ,FL-VOWEL
RETURN OBJ
?CCL20: FCLEAR OBJ,FL-VOWEL
RETURN OBJ
?CND3: DLESS? 'N,1 /FALSE
ADD TB,8 >TB
JUMP ?PRG1
.FUNCT RT-IDENTIFY-EVENT?,WD,OBJ,NAM,N,TB,NTB,?TMP1
GETP TH-EVENT,P?OBJ-NOUN >NAM
ZERO? OBJ /?CND1
EQUAL? OBJ,TH-EVENT \FALSE
?CND1: SET 'N,10
SET 'TB,TH-EVENT-NAMES+2
?PRG5: GET TB,0 >NTB
GET NTB,1
EQUAL? WD,STACK \?CND7
ADD NTB,2 >?TMP1
GET NTB,0
INTBL? NAM,?TMP1,STACK /TRUE
RFALSE
?CND7: DLESS? 'N,1 /FALSE
ADD TB,8 >TB
JUMP ?PRG5
.FUNCT RT-DESC-EVENT,CLASS,WD,FLAGS,N,TB,?TMP1,?TMP2,?TMP3
GETP TH-EVENT,P?OBJ-NOUN >WD
SET 'N,10
SET 'TB,TH-EVENT-NAMES+2
?PRG1: GET TB,0
GET STACK,1
EQUAL? WD,STACK \?CND3
GET TB,3 >FLAGS
GET TB,2
ZERO? STACK /?CCL7
GET TB,2 >?TMP3
BTST FLAGS,1 \?PRF10
SET '?TMP2,1
JUMP ?PEN8
?PRF10: SET '?TMP2,0
?PEN8: FSET? TH-EVENT,FL-PLURAL /?PRD11
PUSH 0
JUMP ?PRD12
?PRD11: PUSH 1
?PRD12: SET '?TMP1,STACK
FSET? TH-EVENT,FL-VOWEL /?PRD13
PUSH 0
JUMP ?PRD14
?PRD13: PUSH 1
?PRD14: ICALL PRINT-SDESC,?TMP3,CLASS,?TMP2,?TMP1,STACK
RTRUE
?CCL7: BTST FLAGS,1 \?PRF17
SET '?TMP2,1
JUMP ?PEN15
?PRF17: SET '?TMP2,0
?PEN15: FSET? TH-EVENT,FL-PLURAL /?PRD18
PUSH 0
JUMP ?PRD19
?PRD18: PUSH 1
?PRD19: SET '?TMP1,STACK
FSET? TH-EVENT,FL-VOWEL /?PRD20
PUSH 0
JUMP ?PRD21
?PRD20: PUSH 1
?PRD21: ICALL PRINT-SDESC,WD,CLASS,?TMP2,?TMP1,STACK,TRUE-VALUE
RTRUE
?CND3: DLESS? 'N,1 /FALSE
ADD TB,8 >TB
JUMP ?PRG1
.FUNCT RT-AC-TH-EVENT,CONTEXT,CLASS
EQUAL? CONTEXT,K-M-SDESC \?CCL3
CALL2 RT-DESC-EVENT,CLASS
RSTACK
?CCL3: CALL1 RT-TALK-VERB?
ZERO? STACK \FALSE
ICALL1 RT-IMPOSSIBLE-MSG
RTRUE
.FUNCT RT-TO-DO-THING-USE-MSG,STR1,STR2
PRINTI "[To "
PRINT STR1
PRINTI " something, use the command: "
PRINT STR2
PRINTR " THING.]"
.FUNCT RT-NOT-IN-SENTENCE-MSG,STR
PRINTI "[There are not "
PRINT STR
PRINTR " in that sentence.]"
.FUNCT RT-IMPOSSIBLE-MSG,WHO
CALL1 RT-WHO-SAYS? >WHO
EQUAL? WHO,CH-HOLMES,CH-WIGGINS \?CCL3
EQUAL? WHO,CH-HOLMES \?CCL6
CALL2 RT-PICK-NEXT,GL-HOLMES-DESC-TXT
PRINT STACK
PRINTI " looks at you "
CALL2 RT-PICK-NEXT,GL-HOLMES-DESPAIR-TXT
PRINT STACK
PRINTI " and says, """
CALL2 RT-PICK-NEXT,GL-HOLMES-IMPOSSIBLE-TXT
PRINT STACK
JUMP ?CND4
?CCL6: EQUAL? WHO,CH-WIGGINS \?CND4
CALL2 RT-PICK-NEXT,GL-WIGGINS-DESC-TXT
PRINT STACK
PRINTI " says, """
CALL2 RT-PICK-NEXT,GL-WIGGINS-IMPOSSIBLE-TXT
PRINT STACK
?CND4: PRINTR "."""
?CCL3: CALL2 RT-PICK-NEXT,GL-IMPOSSIBLE-TXT
PRINT STACK
PRINTR "."
.FUNCT RT-NOT-LIKELY-MSG,THING,STR
PRINTI "It"
CALL2 RT-PICK-NEXT,GL-NOT-LIKELY-TXT
PRINT STACK
PRINTI " that "
ICALL2 RT-THEO-PRINT,THING
PRINTC 32
PRINT STR
PRINTR "."
.FUNCT RT-LOOKS-PUZZLED-MSG,WHO
ICALL2 RT-CTHEO-PRINT,WHO
PRINTC 32
CALL2 RT-PICK-NEXT,GL-LOOKS-TXT
PRINT STACK
PRINTC 32
CALL2 RT-PICK-NEXT,GL-PUZZLED-TXT
PRINT STACK
PRINTR "."
.FUNCT RT-WINNER-NOT-HOLDING-MSG
ICALL2 RT-CTHEO-PRINT,GL-WINNER
ICALL2 RT-ISNT-ARENT-MSG,GL-WINNER
PRINTI "holding "
RTRUE
.FUNCT RT-YOUD-HAVE-TO-MSG,STR,THING
PRINTI "You would have to "
PRINT STR
PRINTC 32
ICALL2 RT-THEO-PRINT,THING
PRINTI " to do that."
CRLF
ICALL2 RT-THIS-IS-IT,THING
RTRUE
.FUNCT RT-WOULD-HAVE-TO-MSG,STR,THING
PRINTI "would have to "
PRINT STR
PRINTC 32
ZERO? THING /?CND1
ICALL2 RT-THEO-PRINT,THING
?CND1: ICALL2 RT-THIS-IS-IT,THING
RTRUE
.FUNCT RT-NOBODY-TO-ASK-MSG
PRINTI "[There is nobody here to ask.]"
CRLF
ICALL1 RT-P-CLEAR
RTRUE
.FUNCT RT-TALK-TO-SELF-MSG
PRINTI "[You must address characters directly.]"
CRLF
ICALL1 RT-P-CLEAR
RTRUE
.FUNCT RT-WAY-TO-TALK-MSG
PRINTI "[Refer to your instruction manual for the correct way to address characters.]"
CRLF
ICALL1 RT-P-CLEAR
RETURN 2
.FUNCT RT-I-SUN-UP-DOWN-MSG,TOD
FSET? GL-PLACE-CUR,FL-INDOORS /FALSE
CALL RT-CLOCK-CMP,6,30,0
ZERO? STACK \?CCL5
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,0,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,1
CRLF
PRINTI "Visibility increases in the gathering light of the new day."
EQUAL? GL-PLACE-CUR,RM-THAMES-ONE,RM-THAMES-TWO,RM-THAMES-THREE /?CND6
EQUAL? GL-PLACE-CUR,RM-THAMES-FOUR,RM-THAMES-FIVE /?CND6
PRINTR " Tourists are beginning to crowd into the streets."
?CND6: CRLF
RTRUE
?CCL5: CALL RT-CLOCK-CMP,7,0,0
ZERO? STACK \?CCL11
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,12,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,2
CRLF
PRINTI "The sun comes up, as much as it ever comes up in England."
CRLF
RFALSE
?CCL11: CALL RT-CLOCK-CMP,19,30,0
ZERO? STACK \?CCL13
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,0,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,3
CRLF
PRINTR "Daylight begins to fade. Soon it will be dark."
?CCL13: CALL RT-CLOCK-CMP,20,0,0
ZERO? STACK \FALSE
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,10,30,0
ICALL RT-ALARM-SET-REL,RT-I-SUN-UP-DOWN-MSG,STACK
SET 'GL-LAST-OUT-TOD,0
CRLF
PRINTI "Darkness falls and the mists come in."
CRLF
RFALSE
.FUNCT RT-NO-OTHER?,FEMALE?,OBJ
FIRST? GL-PLACE-CUR >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
EQUAL? OBJ,GL-WINNER /?CND7
FSET? OBJ,FL-PERSON \?CND7
ZERO? FEMALE? /?CCL13
FSET? OBJ,FL-FEMALE /?REP3
?CCL13: ZERO? FEMALE? \?CND7
FSET? OBJ,FL-FEMALE \?REP3
?CND7: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: ZERO? OBJ /FALSE
ICALL2 RT-LOOKS-PUZZLED-MSG,GL-WINNER
PRINTR "To whom are you referring?"
.FUNCT RT-GLOBAL-IN?,OBJ1,OBJ2,TBL
GETPT OBJ2,P?GLOBAL >TBL
ZERO? TBL /FALSE
GRTR? OBJ1,255 /FALSE
PTSIZE TBL
INTBL? OBJ1,TBL,STACK,1 /TRUE
RFALSE
.FUNCT RT-META-LOC,OBJ
?PRG1: ZERO? OBJ /FALSE
IN? OBJ,GLOBAL-OBJECTS \?CCL7
RETURN GLOBAL-OBJECTS
?CCL7: IN? OBJ,ROOMS \?CCL9
RETURN OBJ
?CCL9: LOC OBJ >OBJ
JUMP ?PRG1
.FUNCT GO
START::
?FCN: SET 'GL-CLOCK-FMT,0
SET 'GL-SCORE-MSG,TRUE-VALUE
SET 'GL-SCORE-MAX,100
SET 'GL-PLACE-CUR,RM-221B-BAKER-ST
ICALL RT-DO-CLOCK-SET,GL-TIME-UPDT-INC,0,1,0
ICALL RT-DO-CLOCK-SET,GL-TIME-UPDT-DEF,0,1,0
ICALL RT-DO-CLOCK-SET,GL-TIME,5,0,0,18
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,0,0,18
ICALL RT-ALARM-SET-ABS,RT-I-BIGBEN,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,30,0,18
ICALL RT-ALARM-SET-ABS,RT-I-SUN-UP-DOWN-MSG,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,30,0,18
ICALL RT-ALARM-SET-ABS,RT-I-PM-QUITS,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,7,0,0,18
ICALL RT-ALARM-SET-ABS,RT-I-OPEN-WESTMINSTER-DOOR,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,55,0,18
ICALL RT-ALARM-SET-ABS,RT-I-WESTMINSTER-LIGHTS-ON,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,17,50,0,18
ICALL RT-ALARM-SET-ABS,RT-I-FLASH-WESTMINSTER-LIGHTS,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,18,5,0,18
ICALL RT-ALARM-SET-ABS,RT-I-WESTMINSTER-LIGHTS-OFF,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,6,55,0,19
ICALL RT-ALARM-SET-ABS,RT-I-WESTMINSTER-LIGHTS-ON,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,17,50,0,19
ICALL RT-ALARM-SET-ABS,RT-I-FLASH-WESTMINSTER-LIGHTS,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,18,1,0,19
ICALL RT-ALARM-SET-ABS,RT-I-LOCKED-IN-END-GAME,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,8,0,0,18
ICALL RT-ALARM-SET-ABS,RT-I-OPEN-MUSEUM-DOOR,STACK
CALL RT-DO-CLOCK-SET,GL-TIME-PARM,9,0,0,20
ICALL RT-ALARM-SET-ABS,RT-I-OUT-OF-TIME,STACK
SET 'GL-SCORE-CUR,0
SET 'GL-MOVES-CUR,0
SET 'GL-SCORE-STS,-1
SET 'GL-MOVES-STS,-1
SET 'GL-PLACE-STS,-1
SET 'GL-PLACE-PRV,-1
CALL1 RT-IS-LIT? >GL-NOW-LIT?
SET 'GL-WINNER,CH-PLAYER
GETB 0,33 >GL-ALLSCREEN
DIV GL-ALLSCREEN,2 >GL-MIDSCREEN
LESS? GL-ALLSCREEN,60 \?CND1
SET 'GL-SHORT-STAT?,TRUE-VALUE
SET 'GL-STAT-S-POS,4
SET 'GL-STAT-T-POS,17
SET 'GL-SCORE-HEADER-LEN,0
SUB GL-ALLSCREEN,19 >GL-STAT-MAX-ROOM
?CND1: SUB GL-ALLSCREEN,GL-STAT-S-POS >GL-STAT-S-POS
SUB GL-ALLSCREEN,GL-STAT-T-POS >GL-STAT-T-POS
SET 'GL-SPLIT-ROW,1
MOVE CH-PLAYER,GL-PLACE-CUR
CLEAR -1
CRLF
ICALL1 RT-GAMETITLE-MSG
ICALL1 RT-COPYRIGHT-MSG
ICALL1 RT-TRADEMARK-MSG
ICALL1 RT-ID-MSG
CRLF
ICALL1 RT-GET-ANY-KEY
ICALL1 RT-INIT-SCREEN
ICALL1 RT-UPDATE-STATUS-LINE
ICALL1 RT-DESC-ALL
ICALL1 RT-P-CLEAR
ICALL1 RT-MAIN-LOOP
JUMP ?FCN
.FUNCT RT-NUMBER?,PTR,TMP,CNT,BPTR,TPTR,CHR,SUM,TIM,AM-PM?,?TMP1
SET 'TPTR,K-HRS
MUL PTR,2
ADD GL-P-P-LEX,STACK >TMP
GET TMP,K-P-LEXELEN >CNT
EQUAL? CNT,W?AM \?CCL3
SET 'AM-PM?,1
JUMP ?CND1
?CCL3: EQUAL? CNT,W?PM \?CND1
SET 'AM-PM?,2
?CND1: ZERO? AM-PM? /?CCL7
SET 'BELIEVE-WAIT-TIME?,TRUE-VALUE
JUMP ?CND5
?CCL7: SET 'BELIEVE-WAIT-TIME?,FALSE-VALUE
?CND5: GETB TMP,2 >CNT
GETB TMP,3 >BPTR
?PRG8: DLESS? 'CNT,0 /?REP9
GETB GL-P-PIBUF,BPTR >CHR
EQUAL? CHR,58 \?CCL15
PUTB GL-P-TIME,TPTR,SUM
EQUAL? TPTR,K-HRS \?CCL18
GRTR? SUM,23 /FALSE
EQUAL? AM-PM?,2 \?CND21
LESS? SUM,12 \?CND21
ADD SUM,12 >SUM
PUTB GL-P-TIME,K-HRS,SUM
?CND21: SET 'TPTR,K-MIN
JUMP ?CND16
?CCL18: EQUAL? TPTR,K-MIN /FALSE
ZERO? TPTR /FALSE
?CND16: SET 'TIM,TRUE-VALUE
SET 'SUM,0
JUMP ?CND13
?CCL15: GRTR? SUM,9999 /FALSE
GRTR? CHR,57 /FALSE
LESS? CHR,48 /FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
?CND13: INC 'BPTR
JUMP ?PRG8
?REP9: ZERO? TIM /?CCL36
PUTB GL-P-TIME,TPTR,SUM
EQUAL? TPTR,K-HRS /FALSE
EQUAL? TPTR,K-MIN \?CCL41
LESS? SUM,0 /FALSE
GRTR? SUM,59 \?CND34
RFALSE
?CCL41: ZERO? TPTR \?CND34
RFALSE
?CCL36: EQUAL? AM-PM?,2 \?CND47
LESS? SUM,12 \?CND47
ADD SUM,12 >SUM
?CND47: PUTB GL-P-TIME,K-HRS,SUM
PUTB GL-P-TIME,K-MIN,0
PUTB GL-P-TIME,K-SEC,0
?CND34: ICALL RT-CHANGE-LEXV,PTR,W?INTNUM
GRTR? SUM,9999 /FALSE
ZERO? TIM /?CND51
SET 'SUM,0
?CND51: SET 'GL-P-TIME-FLAG,TIM
SET 'GL-P-NUMBER,SUM
RETURN W?INTNUM
.FUNCT V-WAIT-FOR,H,M,S,N
EQUAL? GL-PRSO,TH-TIME \?CCL3
SET 'N,GL-P-NUMBER
EQUAL? N,-1 \?CND4
SET 'N,1
?CND4: GETP GL-PRSO,P?OBJ-NOUN
EQUAL? STACK,W?MINUTE,W?MINUTES \?CCL8
SET 'H,0
SET 'M,N
JUMP ?CND6
?CCL8: SET 'H,N
SET 'M,0
?CND6: SET 'S,0
PRINTI "Time passes..."
CRLF
CALL RT-CLOCK-JMP,H,M,S
RSTACK
?CCL3: ZERO? GL-P-TIME-FLAG \?CCL10
EQUAL? GL-PRSO,TH-INTNUM /?CCL10
ICALL1 RT-CYOU-MSG
PRINT K-CANT-WAIT-MSG
CRLF
RETURN 2
?CCL10: GETB GL-P-TIME,K-HRS >H
GETB GL-P-TIME,K-MIN >M
GETB GL-P-TIME,K-SEC >S
EQUAL? GL-PRSO,TH-INTNUM \?CND13
ZERO? GL-P-TIME-FLAG \?CND13
PRINTC 91
PRINTN H
PRINTI ":00]"
CRLF
CRLF
?CND13: GRTR? H,23 \?CCL19
ICALL1 RT-CYOU-MSG
PRINT K-CANT-WAIT-MSG
CRLF
RETURN 2
?CCL19: ZERO? BELIEVE-WAIT-TIME? \?CTR20
GRTR? H,12 \?CCL21
?CTR20: GETB GL-TIME,K-HRS
SUB H,STACK >H
GETB GL-TIME,K-MIN
SUB M,STACK >M
GETB GL-TIME,K-SEC
SUB S,STACK >S
JUMP ?CND17
?CCL21: GETB GL-TIME,K-HRS
SUB STACK,1
MOD STACK,12
ADD STACK,1
SUB H,STACK >H
GETB GL-TIME,K-MIN
SUB M,STACK >M
GETB GL-TIME,K-SEC
SUB S,STACK >S
?CND17: SUB S,59
DIV STACK,60 >N
ADD M,N >M
MUL N,60
SUB S,STACK >S
SUB M,59
DIV STACK,60 >N
ADD H,N >H
MUL N,60
SUB M,STACK >M
?PRG24: LESS? H,0 \?REP25
ZERO? BELIEVE-WAIT-TIME? /?CCL30
ADD H,24 >H
JUMP ?PRG24
?CCL30: ADD H,12 >H
JUMP ?PRG24
?REP25: ZERO? H \?CCL33
ZERO? M \?CCL33
ZERO? S \?CCL33
PRINTI "It is"
GETB GL-TIME,K-HRS
SUB STACK,1
MOD STACK,12
ADD STACK,1
GRTR? STACK,9 \?CND37
PRINTC 32
?CND37: ICALL2 RT-CLK-NTI-MSG,6
PRINTI " now."
CRLF
ICALL2 RT-TIME-OF-DAY-MSG,TRUE-VALUE
RETURN 2
?CCL33: PRINTI "Time passes..."
CRLF
ICALL RT-CLOCK-JMP,H,M,S
ICALL2 RT-TIME-OF-DAY-MSG,TRUE-VALUE
RTRUE
.FUNCT RT-WAIT-TOD-MSG,TOD
CRLF
PRINTI "While you were waiting, "
ZERO? TOD \?CCL3
PRINTR "the sun set and the mists rolled in."
?CCL3: EQUAL? TOD,1 \?CCL5
PRINTR "the sky started to lighten. Soon it will be sunrise."
?CCL5: EQUAL? TOD,2 \?CCL7
PRINTR "the sun rose... as much as it ever does here."
?CCL7: PRINTR "the sun set. Soon it will be dark."
.FUNCT RT-WINDOW,TABLE,MARGIN,Y,I,WIDTH,LINES,STR,PLINES
SET 'Y,8
SET 'I,2
GET TABLE,0 >LINES
GET TABLE,1 >WIDTH
SET 'PLINES,LINES
GRTR? WIDTH,GL-ALLSCREEN \?CND1
PRINTR "[*** Window too wide ***]"
?CND1: ZERO? MARGIN \?CND3
DIV WIDTH,2
SUB GL-MIDSCREEN,STACK >MARGIN
?CND3: ADD LINES,6
SPLIT STACK
SCREEN K-S-WIN
HLIGHT K-H-INV
CURSET Y,MARGIN
ICALL2 RT-PRINT-SPACES,WIDTH
?PRG5: INC 'Y
CURSET Y,MARGIN
DEC 'LINES
ZERO? LINES \?CND7
ICALL2 RT-PRINT-SPACES,WIDTH
HLIGHT K-H-NRM
SCREEN K-S-NOR
SPLIT 1
DIROUT K-D-SCR-OFF
SET 'I,2
CRLF
PRINTC 91
?PRG12: DEC 'PLINES
ZERO? PLINES /?REP13
GET TABLE,I >STR
ZERO? STR /?CND16
EQUAL? I,2 /?CND18
PRINTC 32
?CND18: PRINT STR
EQUAL? PLINES,1 \?CND16
PRINTC 93
?CND16: CRLF
INC 'I
JUMP ?PRG12
?CND7: GET TABLE,I >STR
ZERO? STR \?CCL11
ICALL2 RT-PRINT-SPACES,WIDTH
JUMP ?CND9
?CCL11: PRINTC 32
PRINT STR
PRINTC 32
?CND9: INC 'I
JUMP ?PRG5
?REP13: CRLF
DIROUT K-D-SCR-ON
RTRUE
.FUNCT HOLMES-COMPLAINS,AMP?,SS?
ZERO? AMP? /?CND1
CALL1 RT-ANYONE-HERE?
EQUAL? STACK,FALSE-VALUE,CH-HOLMES \?CND1
SET 'AMP?,FALSE-VALUE
?CND1: ZERO? SS? \?PRD9
ZERO? AMP? /FALSE
?PRD9: CALL1 RT-WHO-SAYS?
EQUAL? STACK,CH-HOLMES \FALSE
CRLF
PRINTI "Holmes "
ZERO? AMP? /?CND12
PRINTI "takes you aside and whispers, ""Watson, you must keep the ampoule hidden"
?CND12: ZERO? SS? /?CND14
ZERO? AMP? /?CCL18
PRINTI ", and"
JUMP ?CND16
?CCL18: PRINTI "says, ""Watson,"
?CND16: PRINTI " take that ridiculous thing out of your ears"
?CND14: PRINTR "."""
.FUNCT TOO-DARK-TO-GO,NEWPLACE
PRINTI "You start off into the "
FSET? NEWPLACE,FL-INDOORS \?CCL3
PRINTI "darkness"
JUMP ?CND1
?CCL3: PRINTI "fog"
?CND1: PRINTR ", but think better of it when you realize you have no light to guide your way."
.FUNCT RT-AC-CH-PLAYER-AUX
ZERO? GL-NOW-PRSI? /?CCL3
EQUAL? GL-WINNER,CH-PLAYER \FALSE
EQUAL? GL-PRSA,V?GIVE \FALSE
ICALL RT-PERFORM,V?TAKE,GL-PRSO
RTRUE
?CCL3: ZERO? GL-NOW-PRSI? \FALSE
EQUAL? GL-PRSA,V?EXAMINE,V?LOOK-ON,V?SEARCH \FALSE
PRINTR "You don't look any uglier than usual."
.FUNCT RT-CHECK-HANDS
EQUAL? GL-PRSA,V?TAKE-OFF \?CCL3
EQUAL? GL-PRSO,TH-HANDS /TRUE
?CCL3: EQUAL? GL-PRSA,V?PUT-ON,V?TAKE \?CCL7
EQUAL? GL-PRSO,TH-HANDS \?CCL7
EQUAL? GL-PRSI,TH-EARS /TRUE
?CCL7: EQUAL? GL-PRSA,V?COVER \FALSE
EQUAL? GL-PRSI,TH-HANDS \FALSE
EQUAL? GL-PRSO,TH-EARS /TRUE
RFALSE
.FUNCT RT-HANDS-COVERING-EARS
PRINTI "You cannot do that because "
ICALL2 RT-THEO-PRINT,TH-HANDS
PRINTI " are covering "
ICALL2 RT-THEO-PRINT,TH-EARS
PRINTR "."
.ENDI