historicalsource
/
abyss
mirror of https://github.com/historicalsource/abyss
1
0
Fork 0
Code Issues Releases Wiki Activity
abyss/util.zap

1037 lines
21 KiB
Plaintext
Raw Permalink Blame History

.FUNCT V-$STEAL:ANY:0:0
CALL RT-DO-TAKE,PRSO,TRUE-VALUE
ZERO? STACK /TRUE
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTC 91
ICALL RT-PRINT-OBJ,PRSO,K-ART-THE,TRUE-VALUE,STR?138
PRINTR " in your hand.]"
.FUNCT V-$GOTO:ANY:0:0,OBJ
SET 'OBJ,PRSO
SET 'CLOCK-WAIT,TRUE-VALUE
?PRG1: IN? OBJ,ROOMS \?CCL5
ICALL2 RT-GOTO,OBJ
RTRUE
?CCL5: LOC OBJ
EQUAL? STACK,LOCAL-GLOBALS,GLOBAL-OBJECTS,FALSE-VALUE \?CCL7
PRINTC 91
ICALL RT-PRINT-OBJ,PRSO,K-ART-THE,TRUE-VALUE,STR?56
PRINTR "n't in a room.]"
?CCL7: LOC OBJ >OBJ
JUMP ?PRG1
.FUNCT V-VERSION:ANY:0:0,IDX
SET 'IDX,18
HLIGHT K-H-BLD
PRINTI "The Abyss
Copyright (c) 1989 Infocom, Inc. All rights reserved.
"
GETB 0,30
GET K-MACHINE-NAME-TBL,STACK
PRINT STACK
PRINTI " Interpreter version "
GETB 0,0
PRINTN STACK
PRINTC 46
GETB 0,31
PRINTN STACK
CRLF
PRINTI "Release "
GET 0,1
BAND STACK,2047
PRINTN STACK
PRINTI " / Serial Number "
?PRG1: GETB 0,IDX
PRINTC STACK
IGRTR? 'IDX,23 \?PRG1
CRLF
HLIGHT K-H-NRM
RTRUE
.FUNCT V-COLOR:ANY:0:0,S
ZERO? GL-COLOR-NOTE \?CND1
SET 'GL-COLOR-NOTE,TRUE-VALUE
PRINTC TAB
PRINTI "Aesthetically, we recommend not changing the standard setting"
GETB 0,30
EQUAL? STACK,MACINTOSH \?CND3
CALL1 MAC-II?
ZERO? STACK /?CCL7
PRINTI ", and if your Mac II displays only 16 colors, you probably won't get the color you ask for"
JUMP ?CND3
?CCL7: PRINTI ", and you can have only black on white or white on black"
?CND3: PRINTI ". Do you still want to go ahead?
"
CALL1 Y?
ZERO? STACK /TRUE
?CND1: CRLF
?PRG10: ICALL1 RT-DO-COLOR
PRINTC TAB
PRINTI "You should now get "
GET K-COLOR-TABLE,GL-F-COLOR
PRINT STACK
PRINTI " text on a "
GET K-COLOR-TABLE,GL-B-COLOR
PRINT STACK
PRINTI " background. Is that what you want?
"
CALL1 Y?
ZERO? STACK \?REP11
GETB 0,30
EQUAL? STACK,MACINTOSH \?CND14
CALL1 MAC-II?
ZERO? STACK \?CND14
EQUAL? GL-B-COLOR,2 \?CCL20
SET 'GL-B-COLOR,9
SET 'GL-F-COLOR,2
JUMP ?REP11
?CCL20: SET 'GL-B-COLOR,2
SET 'GL-F-COLOR,9
JUMP ?REP11
?CND14: PRINTC TAB
PRINTI "Do you want to pick again, or would you like to just go back to the standard colors? (Type Y to pick again) >"
CALL2 Y?,FALSE-VALUE
ZERO? STACK /?CCL23
CRLF
JUMP ?PRG10
?CCL23: SET 'GL-F-COLOR,1
SET 'GL-B-COLOR,1
?REP11: SET 'S,0
?PRG24: SCREEN S
COLOR GL-F-COLOR,GL-B-COLOR
IGRTR? 'S,7 \?PRG24
CALL1 V-$REFRESH
RSTACK
.FUNCT RT-DO-COLOR:ANY:0:0
GETB 0,30
EQUAL? STACK,MACINTOSH \?CCL3
CALL1 MAC-II?
ZERO? STACK \?CCL3
EQUAL? GL-B-COLOR,2 \?CCL8
SET 'GL-B-COLOR,9
SET 'GL-F-COLOR,2
RETURN GL-F-COLOR
?CCL8: SET 'GL-B-COLOR,2
SET 'GL-F-COLOR,9
RETURN GL-F-COLOR
?CCL3: CALL RT-PICK-COLOR,GL-F-COLOR,STR?149,TRUE-VALUE >GL-F-COLOR
CALL RT-PICK-COLOR,GL-B-COLOR,STR?150 >GL-B-COLOR
RETURN GL-B-COLOR
.FUNCT RT-PICK-COLOR:ANY:2:3,WHICH,STRING,SETTING-FG,CHAR
PRINTI "The current "
PRINT STRING
PRINTI " color is "
GET K-COLOR-TABLE,WHICH
PRINT STACK
PRINTC 46
CRLF
FONT 4
PRINTI " 1 --> WHITE 5 --> YELLOW"
CRLF
PRINTI " 2 --> BLACK 6 --> BLUE"
CRLF
PRINTI " 3 --> RED 7 --> MAGENTA"
CRLF
PRINTI " 4 --> GREEN 8 --> CYAN"
CRLF
FONT 1
PRINTI "Type a number to select the "
PRINT STRING
PRINTI " color you want. >"
?PRG1: INPUT 1 >CHAR
SUB CHAR,48 >CHAR
EQUAL? CHAR,1 \?CND4
SET 'CHAR,9
?CND4: EQUAL? CHAR,2,3,4 /?CTR7
EQUAL? CHAR,5,6,7 /?CTR7
EQUAL? CHAR,8,9 \?CCL8
?CTR7: ZERO? SETTING-FG \?REP2
EQUAL? CHAR,GL-F-COLOR \?REP2
CRLF
PRINTI "You can't make the background the same color as the text. Please pick another color. >"
JUMP ?PRG1
?CCL8: CRLF
PRINT K-TYPE-NUMBER-MSG
PRINTI "8. >"
JUMP ?PRG1
?REP2: CRLF
CRLF
RETURN CHAR
.FUNCT MAC-II?:ANY:0:0
GET 0,8
BTST STACK,64 /TRUE
RFALSE
.FUNCT Y?:ANY:0:1,P?,C,1ST?
ASSIGNED? 'P? /?CND1
SET 'P?,TRUE-VALUE
?CND1: SET '1ST?,TRUE-VALUE
?PRG3: ZERO? P? /?CND5
PRINTI "Please press Y or N >"
?CND5: INPUT 1 >C
EQUAL? C,89,78,121 /?CTR9
EQUAL? C,110 \?CCL10
?CTR9: PRINTC C
CRLF
EQUAL? C,89,121 /TRUE
RFALSE
?CCL10: SOUND S-BEEP
ZERO? P? /?PRG3
CRLF
JUMP ?PRG3
.FUNCT RT-CHECK-ADJ:ANY:1:1,DOOR
RFALSE
.FUNCT RT-UPDATE-ADJ:ANY:3:3,DOOR,RM1,RM2,TMP1,TMP2,?TMP1
GETP RM1,P?ADJACENT >TMP2
ZERO? TMP2 /?CND1
ADD TMP2,1 >?TMP1
GETB TMP2,0
INTBL? RM2,?TMP1,STACK,1 >TMP1 \?CND1
FSET? DOOR,FL-OPEN /?PRD5
PUSH 0
JUMP ?PRD6
?PRD5: PUSH 1
?PRD6: PUTB TMP1,1,STACK
?CND1: GETP RM2,P?ADJACENT >TMP2
ZERO? TMP2 /FALSE
ADD TMP2,1 >?TMP1
GETB TMP2,0
INTBL? RM1,?TMP1,STACK,1 >TMP1 \FALSE
FSET? DOOR,FL-OPEN /?PRD13
PUSH 0
JUMP ?PRD14
?PRD13: PUSH 1
?PRD14: PUTB TMP1,1,STACK
RTRUE
.FUNCT RT-SCORE-MSG:ANY:1:2,N,NL?
ASSIGNED? 'NL? /?CND1
SET 'NL?,TRUE-VALUE
?CND1: ZERO? N /FALSE
ADD GL-SCORE,N >GL-SCORE
HLIGHT H-BOLD
ZERO? NL? /?CND6
CRLF
?CND6: PRINTI "[You have "
GRTR? N,0 \?CCL10
PRINTI "earned"
JUMP ?CND8
?CCL10: PRINTI "lost"
?CND8: ICALL2 RT-WORD-NUMBERS,N
PRINTI " point"
LESS? N,0 \?CCL15
SUB 0,N
JUMP ?CND13
?CCL15: PUSH N
?CND13: EQUAL? STACK,1 /?CND11
PRINTC 115
?CND11: PRINTI ".]"
ZERO? NL? /?CND16
CRLF
?CND16: HLIGHT H-NORMAL
RTRUE
.FUNCT RT-SCORE-OBJ:ANY:1:2,OBJ,NL?,SC
ASSIGNED? 'NL? /?CND1
SET 'NL?,TRUE-VALUE
?CND1: GETP OBJ,P?SCORE >SC
ZERO? SC /FALSE
ICALL RT-SCORE-MSG,SC,NL?
PUTP OBJ,P?SCORE,0
RTRUE
.FUNCT V-SCORE:ANY:0:0
PRINTI "You have"
ICALL2 RT-WORD-NUMBERS,GL-SCORE
PRINTI " point"
LESS? GL-SCORE,0 \?CCL5
SUB 0,GL-SCORE
JUMP ?CND3
?CCL5: PUSH GL-SCORE
?CND3: EQUAL? STACK,1 /?CND1
PRINTC 115
?CND1: PRINTR "."
.FUNCT V-DIAGNOSE:ANY:0:0,N,1ST?,TMP,OXY,CO2,NIT,M
SET '1ST?,TRUE-VALUE
GRTR? GL-PLAYER-TEMP,K-TEMP-LOW-1 \?PST4
LESS? GL-PLAYER-TEMP,K-TEMP-HIGH-1 /?PRD7
SET 'TMP,1
JUMP ?PEN3
?PRD7: SET 'TMP,0
JUMP ?PEN3
?PST4: SET 'TMP,1
?PEN3: ZERO? TMP /?CND1
INC 'N
?CND1: GRTR? GL-OXYGEN-QTY,K-OXY-LOW-1 \?PST12
LESS? GL-OXYGEN-QTY,K-OXY-HIGH-1 /?PRD15
SET 'OXY,1
JUMP ?PEN11
?PRD15: SET 'OXY,0
JUMP ?PEN11
?PST12: SET 'OXY,1
?PEN11: ZERO? OXY /?CND9
INC 'N
?CND9: LESS? GL-CO2-QTY,K-CO2-HIGH-1 /?PRD20
SET 'CO2,1
JUMP ?PEN19
?PRD20: SET 'CO2,0
?PEN19: ZERO? CO2 /?CND17
INC 'N
?CND17: GRTR? GL-NITROGEN-QTY,K-NIT-LOW-1 \?PST25
LESS? GL-NITROGEN-QTY,K-NIT-HIGH-1 /?PRD28
SET 'NIT,1
JUMP ?PEN24
?PRD28: SET 'NIT,0
JUMP ?PEN24
?PST25: SET 'NIT,1
?PEN24: ZERO? NIT /?CND22
INC 'N
?CND22: PRINTC TAB
ZERO? N \?CCL32
PRINTI "You feel fine"
JUMP ?CND30
?CCL32: ZERO? TMP /?CND33
DEC 'N
SET '1ST?,FALSE-VALUE
GRTR? GL-PLAYER-TEMP,K-TEMP-LOW-3 /?CCL38
PRINTI "You're so cold you can hardly move"
JUMP ?CND33
?CCL38: GRTR? GL-PLAYER-TEMP,K-TEMP-LOW-2 /?CCL40
PRINTI "The cold is creeping into your bones"
JUMP ?CND33
?CCL40: GRTR? GL-PLAYER-TEMP,K-TEMP-LOW-1 /?CCL42
PRINTI "You are shivering"
JUMP ?CND33
?CCL42: LESS? GL-PLAYER-TEMP,K-TEMP-HIGH-3 /?CCL44
PRINTI "You're so hot you can hardly move and your breathing is dangerously fast"
JUMP ?CND33
?CCL44: LESS? GL-PLAYER-TEMP,K-TEMP-HIGH-2 /?CCL46
PRINTI "Your face is red from the heat"
JUMP ?CND33
?CCL46: LESS? GL-PLAYER-TEMP,K-TEMP-HIGH-1 /?CND33
PRINTI "You are sweating"
?CND33: ZERO? OXY /?CND48
DEC 'N
ZERO? 1ST? \?CCL52
PRINTI ", "
ZERO? N \?CND53
PRINTI "and "
?CND53: SET 'M,32
JUMP ?CND50
?CCL52: SET '1ST?,FALSE-VALUE
SET 'M,0
?CND50: GRTR? GL-OXYGEN-QTY,K-OXY-LOW-3 /?CCL57
BOR 89,M
PRINTC STACK
PRINTI "our peripheral vision has disappeared"
JUMP ?CND48
?CCL57: GRTR? GL-OXYGEN-QTY,K-OXY-LOW-2 /?CCL59
BOR 84,M
PRINTC STACK
PRINTI "he colors around you seem faded"
JUMP ?CND48
?CCL59: GRTR? GL-OXYGEN-QTY,K-OXY-LOW-1 /?CCL61
BOR 89,M
PRINTC STACK
PRINTI "ou have a headache"
JUMP ?CND48
?CCL61: LESS? GL-OXYGEN-QTY,K-OXY-HIGH-3 /?CCL63
BOR 89,M
PRINTC STACK
PRINTI "our stomach muscles are tight and you feel an urge to vomit"
JUMP ?CND48
?CCL63: LESS? GL-OXYGEN-QTY,K-OXY-HIGH-2 /?CCL65
BOR 89,M
PRINTC STACK
PRINTI "ou feel nauseous"
JUMP ?CND48
?CCL65: LESS? GL-OXYGEN-QTY,K-OXY-HIGH-1 /?CND48
BOR 89,M
PRINTC STACK
PRINTI "ou have a twitch in your lower lip"
?CND48: ZERO? CO2 /?CND67
DEC 'N
ZERO? 1ST? \?CCL71
PRINTI ", "
ZERO? N \?CND72
PRINTI "and "
?CND72: SET 'M,32
JUMP ?CND69
?CCL71: SET '1ST?,FALSE-VALUE
SET 'M,0
?CND69: LESS? GL-CO2-QTY,K-CO2-HIGH-3 /?CCL76
BOR 84,M
PRINTC STACK
PRINTI "he muscles in your arm are spasming"
JUMP ?CND67
?CCL76: LESS? GL-CO2-QTY,K-CO2-HIGH-2 /?CCL78
BOR 89,M
PRINTC STACK
PRINTI "our chest muscles ache"
JUMP ?CND67
?CCL78: LESS? GL-CO2-QTY,K-CO2-HIGH-1 /?CND67
BOR 89,M
PRINTC STACK
PRINTI "ou feel a little short of breath"
?CND67: ZERO? NIT /?CND30
DEC 'N
ZERO? 1ST? \?CCL84
PRINTI ", "
ZERO? N \?CND85
PRINTI "and "
?CND85: PRINTC 121
JUMP ?CND82
?CCL84: SET '1ST?,FALSE-VALUE
PRINTC 89
?CND82: GRTR? GL-NITROGEN-QTY,K-NIT-LOW-3 /?CCL89
PRINTI "ou have flashes of sudden irritibility"
JUMP ?CND30
?CCL89: GRTR? GL-NITROGEN-QTY,K-NIT-LOW-2 /?CCL91
PRINTI "our fingertips are shaking badly"
JUMP ?CND30
?CCL91: GRTR? GL-NITROGEN-QTY,K-NIT-LOW-1 /?CCL93
PRINTI "our hands are trembling"
JUMP ?CND30
?CCL93: LESS? GL-NITROGEN-QTY,K-NIT-HIGH-3 /?CCL95
PRINTI "ou are hallucinating"
JUMP ?CND30
?CCL95: LESS? GL-NITROGEN-QTY,K-NIT-HIGH-2 /?CCL97
PRINTI "our head is spinning"
JUMP ?CND30
?CCL97: LESS? GL-NITROGEN-QTY,K-NIT-HIGH-1 /?CND30
PRINTI "ou feel light-headed"
?CND30: PRINTR "."
.FUNCT RT-WORD-NUMBERS:ANY:1:2,COUNT,1ST?,N
ASSIGNED? '1ST? /?CND1
SET '1ST?,TRUE-VALUE
?CND1: ZERO? 1ST? /?CND3
PRINTC 32
LESS? COUNT,0 \?CND3
PRINTI "negative "
SUB 0,COUNT >COUNT
?CND3: ZERO? COUNT \?CCL9
PRINTI "zero"
RTRUE
?CCL9: EQUAL? COUNT,1 \?CCL11
PRINTI "one"
RTRUE
?CCL11: EQUAL? COUNT,2 \?CCL13
PRINTI "two"
RTRUE
?CCL13: EQUAL? COUNT,3 \?CCL15
PRINTI "three"
RTRUE
?CCL15: EQUAL? COUNT,4 \?CCL17
PRINTI "four"
RTRUE
?CCL17: EQUAL? COUNT,5 \?CCL19
PRINTI "five"
RTRUE
?CCL19: EQUAL? COUNT,6 \?CCL21
PRINTI "six"
RTRUE
?CCL21: EQUAL? COUNT,7 \?CCL23
PRINTI "seven"
RTRUE
?CCL23: EQUAL? COUNT,8 \?CCL25
PRINTI "eight"
RTRUE
?CCL25: EQUAL? COUNT,9 \?CCL27
PRINTI "nine"
RTRUE
?CCL27: EQUAL? COUNT,10 \?CCL29
PRINTI "ten"
RTRUE
?CCL29: EQUAL? COUNT,11 \?CCL31
PRINTI "eleven"
RTRUE
?CCL31: EQUAL? COUNT,12 \?CCL33
PRINTI "twelve"
RTRUE
?CCL33: EQUAL? COUNT,13 \?CCL35
PRINTI "thirteen"
RTRUE
?CCL35: EQUAL? COUNT,14 \?CCL37
PRINTI "fourteen"
RTRUE
?CCL37: EQUAL? COUNT,15 \?CCL39
PRINTI "fifteen"
RTRUE
?CCL39: EQUAL? COUNT,16 \?CCL41
PRINTI "sixteen"
RTRUE
?CCL41: EQUAL? COUNT,17 \?CCL43
PRINTI "seventeen"
RTRUE
?CCL43: EQUAL? COUNT,18 \?CCL45
PRINTI "eighteen"
RTRUE
?CCL45: EQUAL? COUNT,19 \?CCL47
PRINTI "nineteen"
RTRUE
?CCL47: EQUAL? COUNT,20 \?CCL49
PRINTI "twenty"
RTRUE
?CCL49: EQUAL? COUNT,30 \?CCL51
PRINTI "thirty"
RTRUE
?CCL51: EQUAL? COUNT,40 \?CCL53
PRINTI "forty"
RTRUE
?CCL53: EQUAL? COUNT,50 \?CCL55
PRINTI "fifty"
RTRUE
?CCL55: EQUAL? COUNT,60 \?CCL57
PRINTI "sixty"
RTRUE
?CCL57: EQUAL? COUNT,70 \?CCL59
PRINTI "seventy"
RTRUE
?CCL59: EQUAL? COUNT,80 \?CCL61
PRINTI "eighty"
RTRUE
?CCL61: EQUAL? COUNT,90 \?CCL63
PRINTI "ninety"
RTRUE
?CCL63: LESS? COUNT,100 \?CCL65
MOD COUNT,10 >N
SUB COUNT,N
ICALL RT-WORD-NUMBERS,STACK,FALSE-VALUE
PRINTC 45
CALL RT-WORD-NUMBERS,N,FALSE-VALUE
RSTACK
?CCL65: LESS? COUNT,1000 \?CCL67
DIV COUNT,100
ICALL RT-WORD-NUMBERS,STACK,FALSE-VALUE
PRINTI " hundred"
MOD COUNT,100
GRTR? STACK,0 \FALSE
PRINTI " and "
MOD COUNT,100
CALL RT-WORD-NUMBERS,STACK,FALSE-VALUE
RSTACK
?CCL67: DIV COUNT,1000
ICALL RT-WORD-NUMBERS,STACK,FALSE-VALUE
PRINTI " thousand"
MOD COUNT,1000
GRTR? STACK,0 \FALSE
PRINTI ", "
MOD COUNT,1000
CALL RT-WORD-NUMBERS,STACK,FALSE-VALUE
RSTACK
.FUNCT RT-END-OF-GAME:ANY:0:2,WIN?,REPEAT,VAL
ICALL1 UPDATE-STATUS-LINE
ZERO? REPEAT \?PRG3
PRINTC TAB
PRINTI "Sorry, but the game is over. "
?PRG3: ZERO? REPEAT /?CCL7
PRINTC TAB
JUMP ?CND5
?CCL7: SET 'REPEAT,TRUE-VALUE
?CND5: PRINTI "Do you want to "
ZERO? P-CAN-UNDO /?CND8
PRINTI "Undo, "
?CND8: PRINTI "Restore, Restart, or Quit ?
"
?PRG10: PRINTC 62
PUTB P-INBUF,1,0
?PRG12: READ P-INBUF,P-LEXV >VAL
EQUAL? VAL,10,13 \?PRG12
GET P-LEXV,P-LEXSTART >VAL
ZERO? P-CAN-UNDO /?CCL18
EQUAL? VAL,W?UNDO \?CCL18
ICALL1 V-UNDO
JUMP ?PRG3
?CCL18: EQUAL? VAL,W?RESTART \?CCL22
RESTART
JUMP ?PRG3
?CCL22: EQUAL? VAL,W?RESTORE \?CCL24
ICALL1 V-RESTORE
JUMP ?PRG3
?CCL24: EQUAL? VAL,W?QUIT,W?Q \?CCL26
PRINTI "Are you sure you want to quit?"
CALL2 YES?,TRUE-VALUE
ZERO? STACK /?PRG3
QUIT
JUMP ?PRG10
?CCL26: PRINTC TAB
PRINTI "Please type "
ZERO? P-CAN-UNDO /?CND30
PRINTI "UNDO, "
?CND30: PRINTI "RESTORE, RESTART, QUIT, or HINT."
CRLF
JUMP ?PRG10
.FUNCT RT-COMMA-MSG:ANY:1:1,MORE?
ZERO? MORE? /?CCL3
PRINTC 44
RTRUE
?CCL3: PRINTI " and"
RTRUE
.FUNCT FIND-FLAG-LG:ANY:2:3,RM,FLAG,FLAG2,TBL,OBJ,CNT,SIZE
GETPT RM,P?GLOBAL >TBL
ZERO? TBL /FALSE
PTSIZE TBL
DIV STACK,2
SUB STACK,1 >SIZE
?PRG4: GET TBL,CNT >OBJ
FSET? OBJ,FLAG \?CCL8
FSET? OBJ,FL-INVISIBLE /?CCL8
ZERO? FLAG2 /?CTR7
FSET? OBJ,FLAG2 \?CCL8
?CTR7: RETURN OBJ
?CCL8: IGRTR? 'CNT,SIZE \?PRG4
RFALSE
.FUNCT FIND-FLAG:ANY:2:4,RM,FLAG,NOT1,NOT2,OBJ
FIRST? RM >OBJ /?PRG2
?PRG2: ZERO? OBJ /FALSE
FSET? OBJ,FLAG \?CCL8
FSET? OBJ,FL-INVISIBLE /?CCL8
EQUAL? OBJ,NOT1,NOT2 /?CCL8
RETURN OBJ
?CCL8: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
.FUNCT RT-ALREADY-MSG:ANY:1:2,OBJ,STR
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTC 91
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE,TRUE-VALUE,STR?56
PRINTI " already"
ZERO? STR /TRUE
PRINTC 32
PRINT STR
PRINTR ".]"
.FUNCT RT-META-IN?:ANY:2:2,OBJ,CONT,L
LOC OBJ >L
?PRG1: ZERO? L /FALSE
EQUAL? L,CONT /TRUE
LOC L >L
JUMP ?PRG1
.FUNCT NO-NEED:ANY:0:2,STR,OBJ
ZERO? OBJ \?CND1
SET 'OBJ,PRSO
?CND1: SET 'CLOCK-WAIT,TRUE-VALUE
PRINTC 91
ICALL RT-PRINT-OBJ,WINNER,K-ART-THE,TRUE-VALUE,STR?66
PRINTI "n't need to "
ZERO? STR /?CCL5
PRINT STR
JUMP ?CND3
?CCL5: GET PARSE-RESULT,1
PRINTB STACK
?CND3: EQUAL? STR,STR?106 \?CCL8
PRINTI " in that "
ICALL2 RT-PRINT-DESC,INTDIR
JUMP ?CND6
?CCL8: ZERO? OBJ /?CND6
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE
?CND6: PRINTR ".]"
.FUNCT RT-YOU-CANT-MSG:ANY:0:3,STR,WHILE,STR1
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTC 91
ICALL RT-PRINT-OBJ,WINNER,K-ART-THE,TRUE-VALUE
PRINTI " can't "
ZERO? STR \?CCL3
GET PARSE-RESULT,1
PRINTB STACK
JUMP ?CND1
?CCL3: PRINT STR
?CND1: EQUAL? STR,STR?106 \?CCL6
PRINTI " in that "
ICALL2 RT-PRINT-DESC,INTDIR
JUMP ?CND4
?CCL6: ICALL RT-PRINT-OBJ,PRSO,K-ART-THE
ZERO? STR1 /?CND4
PRINTI " while"
ZERO? WHILE /?CCL11
ICALL RT-PRINT-OBJ,WHILE,K-ART-HE,FALSE-VALUE,STR?56
JUMP ?CND9
?CCL11: ICALL RT-PRINT-OBJ,PRSO,K-ART-HE,FALSE-VALUE,STR?56
?CND9: PRINTC 32
PRINT STR1
?CND4: PRINTR ".]"
.FUNCT HAR-HAR:ANY:0:0
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTR "[You can't be serious.]"
.FUNCT RT-IMPOSSIBLE-MSG:ANY:0:0
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTR "[That's impossible.]"
.FUNCT WONT-HELP:ANY:0:0
SET 'CLOCK-WAIT,TRUE-VALUE
PRINTR "[That would be a waste of time.]"
.FUNCT PICK-ONE:ANY:1:1,TBL
GET TBL,0
RANDOM STACK
GET TBL,STACK
RSTACK
.FUNCT GLOBAL-IN?:ANY:2:2,OBJ1,OBJ2,TBL
EQUAL? OBJ1,OBJ2 /TRUE
GETPT OBJ2,P?GLOBAL >TBL
ZERO? TBL /FALSE
PTSIZE TBL
DIV STACK,2
INTBL? OBJ1,TBL,STACK /?CND1
?CND1: RSTACK
.FUNCT RT-FIRST-YOU-MSG:ANY:1:3,STR,OBJ,OBJ2
PRINTC 91
ICALL RT-PRINT-OBJ,WINNER,K-ART-THE,TRUE-VALUE,STR
ZERO? OBJ /?CND1
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE
ZERO? OBJ2 /?CND1
IN? OBJ2,ROOMS /?CND1
PRINTI " from"
ICALL RT-PRINT-OBJ,OBJ2,K-ART-THE
?CND1: PRINTR " first.]"
.FUNCT RT-SEE-INSIDE?:ANY:1:2,OBJ,ONLY-IN
IN? OBJ,ROOMS /TRUE
FSET? OBJ,FL-TRANSPARENT /TRUE
FSET? OBJ,FL-OPEN /TRUE
ZERO? ONLY-IN \FALSE
FSET? OBJ,FL-SURFACE /TRUE
RFALSE
.FUNCT RT-SEE-ANYTHING-IN?:ANY:1:1,CONT,OBJ
FIRST? CONT >OBJ /?PRG2
?PRG2: ZERO? OBJ /FALSE
FSET? OBJ,FL-INVISIBLE /?CND7
FSET? OBJ,FL-NO-DESC /?CND7
EQUAL? OBJ,WINNER \TRUE
?CND7: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
.FUNCT RT-MOVE-ALL:ANY:1:2,FROM,TO,NXT,OBJ,CNT
FIRST? FROM >OBJ /?PRG2
?PRG2: ZERO? OBJ \?CCL6
RETURN CNT
?CCL6: NEXT? OBJ >NXT /?BOGUS7
?BOGUS7: FCLEAR OBJ,FL-WORN
ZERO? TO /?CCL10
MOVE OBJ,TO
JUMP ?CND8
?CCL10: REMOVE OBJ
?CND8: INC 'CNT
SET 'OBJ,NXT
JUMP ?PRG2
.FUNCT RT-MOVE-ALL-BUT-WORN:ANY:1:2,FROM,TO,NXT,OBJ,CNT
FIRST? FROM >OBJ /?PRG2
?PRG2: ZERO? OBJ \?CCL6
RETURN CNT
?CCL6: NEXT? OBJ >NXT /?BOGUS7
?BOGUS7: FSET? OBJ,FL-WORN /?CND8
ZERO? TO /?CCL12
MOVE OBJ,TO
JUMP ?CND10
?CCL12: REMOVE OBJ
?CND10: INC 'CNT
?CND8: SET 'OBJ,NXT
JUMP ?PRG2
.FUNCT RT-MOVE-ALL-WORN:ANY:1:2,FROM,TO,NXT,OBJ,CNT
FIRST? FROM >OBJ /?PRG2
?PRG2: ZERO? OBJ \?CCL6
RETURN CNT
?CCL6: NEXT? OBJ >NXT /?BOGUS7
?BOGUS7: FSET? OBJ,FL-WORN \?CND8
ZERO? TO /?CCL12
MOVE OBJ,TO
JUMP ?CND10
?CCL12: REMOVE OBJ
?CND10: INC 'CNT
?CND8: SET 'OBJ,NXT
JUMP ?PRG2
.FUNCT RT-NOT-LIKELY-MSG:ANY:2:2,OBJ,STR
PRINTI "It "
CALL2 RT-PICK-NEXT,K-NOT-LIKELY-TBL
PRINT STACK
PRINTI " that"
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE
PRINTC 32
PRINT STR
PRINTR "."
.FUNCT RT-NO-POINT-MSG:ANY:2:2,STR,OBJ
PRINT STR
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE
PRINTI " would "
CALL2 RT-PICK-NEXT,K-NO-POINT-TBL
PRINT STACK
PRINTR "."
.FUNCT RT-PICK-NEXT:ANY:1:1,TBL,CNT,STR,NT
GETB TBL,0 >CNT
ADD TBL,1
GET STACK,0 >NT
GET NT,CNT >STR
GET NT,0
IGRTR? 'CNT,STACK \?CND1
SET 'CNT,1
?CND1: PUTB TBL,0,CNT
RETURN STR
.FUNCT RT-NO-RESPONSE-MSG:ANY:0:1,OBJ
ZERO? OBJ \?CND1
SET 'OBJ,PRSO
?CND1: EQUAL? OBJ,ROOMS \?CND3
SET 'OBJ,WINNER
?CND3: EQUAL? OBJ,CH-PLAYER \?CCL7
CALL FIND-FLAG,HERE,FL-PERSON,CH-PLAYER >OBJ
ZERO? OBJ \?CCL7
PRINT K-TALK-TO-SELF-MSG
CRLF
RTRUE
?CCL7: FSET? OBJ,FL-ASLEEP \?CCL11
ICALL RT-PRINT-OBJ,OBJ,K-ART-THE,TRUE-VALUE,STR?56
PRINTR " in no condition to respond."
?CCL11: ICALL RT-PRINT-OBJ,OBJ,K-ART-THE,TRUE-VALUE,STR?66
PRINTR "n't respond."
.FUNCT RT-FOOLISH-TO-TALK?:ANY:0:0
EQUAL? PRSO,FALSE-VALUE,ROOMS /FALSE
FSET? PRSO,FL-ALIVE /?CCL5
CALL1 RT-NO-RESPONSE-MSG
RSTACK
?CCL5: EQUAL? PRSO,CH-PLAYER,PRSI,WINNER \?CCL7
CALL1 RT-WASTE-OF-TIME-MSG
RSTACK
?CCL7: ICALL2 THIS-IS-IT,PRSO
RFALSE
.FUNCT RT-WASTE-OF-TIME-MSG:ANY:0:0
PRINTR "[That would be a waste of time.]"
.FUNCT V-$P:ANY:0:0
PICINF P-NUMBER,K-WIN-TBL \?CCL3
ZERO? P-NUMBER \?CCL6
PRINTI "Last picture number is "
GET K-WIN-TBL,0
PRINTN STACK
PRINTR "."
?CCL6: GET K-WIN-TBL,0
PRINTN STACK
PRINTC 120
GET K-WIN-TBL,1
PRINTN STACK
CRLF
RTRUE
?CCL3: PRINTR "No such picture."
.FUNCT RT-CENTER-PIC:ANY:1:1,N,X,Y,?TMP1
PICINF N,K-WIN-TBL /?BOGUS1
?BOGUS1: WINGET -3,K-W-YSIZE >?TMP1
GET K-WIN-TBL,0
SUB ?TMP1,STACK
DIV STACK,2
ADD STACK,1 >Y
WINGET -3,K-W-XSIZE >?TMP1
GET K-WIN-TBL,1
SUB ?TMP1,STACK
DIV STACK,2
ADD STACK,1 >X
DISPLAY N,Y,X
RTRUE
.FUNCT V-$D:ANY:0:0
GRTR? P-NUMBER,0 \?CCL3
PICINF P-NUMBER,K-WIN-TBL \?CCL3
SCREEN 7
CLEAR 7
ICALL2 RT-CENTER-PIC,P-NUMBER
INPUT 1
SCREEN 0
CALL2 V-$REFRESH,FALSE-VALUE
RSTACK
?CCL3: PRINTR "No such picture."
.FUNCT V-$SHOW:ANY:0:0,P,N,C
PICINF 0,K-WIN-TBL /?BOGUS1
?BOGUS1: GET K-WIN-TBL,0 >N
SET 'P,0
?PRG2: PICINF P,K-WIN-TBL \?PRG2
SCREEN 7
CLEAR 7
CURSET 1,1
PRINTI "Picture #"
PRINTN P
PRINTI ". [Q]uit, [+F] to advance, [-B] to back up.
"
ICALL2 RT-CENTER-PIC,P
INPUT 1 >C
EQUAL? C,113,81 \?CCL8
SCREEN 0
ICALL2 V-$REFRESH,FALSE-VALUE
RTRUE
?CCL8: EQUAL? C,45,98,66 \?CCL10
DLESS? 'P,1 \?PRG2
SET 'P,N
JUMP ?PRG2
?CCL10: IGRTR? 'P,N \?PRG2
SET 'P,1
JUMP ?PRG2
.FUNCT V-$W:ANY:0:0,WIN,A,TMP
SET 'WIN,P-NUMBER
LESS? WIN,0 /?CCL2
GRTR? WIN,7 \?CND1
?CCL2: PRINTR "No such window."
?CND1: PRINTC 35
PRINTN WIN
PRINTI " at "
WINGET WIN,K-W-YPOS
PRINTN STACK
PRINTC 44
WINGET WIN,K-W-XPOS
PRINTN STACK
PRINTI "; size "
WINGET WIN,K-W-YSIZE
PRINTN STACK
PRINTC 120
WINGET WIN,K-W-XSIZE
PRINTN STACK
WINGET WIN,K-W-LMARG
ZERO? STACK \?CCL6
WINGET WIN,K-W-RMARG
ZERO? STACK /?CND5
?CCL6: PRINTI " ( ->"
WINGET WIN,K-W-LMARG
PRINTN STACK
PRINTC 44
WINGET WIN,K-W-RMARG
PRINTN STACK
PRINTI "<- )"
?CND5: WINGET WIN,K-W-HLIGHT >TMP
ZERO? TMP /?CND9
PRINTI "; HL="
PRINTN TMP
?CND9: WINGET WIN,K-W-COLOR >TMP
EQUAL? TMP,257 /?CND11
PRINTI "; C="
SHIFT TMP,-8
PRINTN STACK
PRINTC 44
BAND TMP,255
PRINTN STACK
?CND11: WINGET WIN,K-W-FONT >TMP
ZERO? TMP /?CND13
PRINTI "; F="
PRINTN TMP
?CND13: WINGET WIN,K-W-FONTSIZE >TMP
PRINTI "; "
SHIFT TMP,-8
EQUAL? STACK,GL-FONT-Y \?CCL16
BAND TMP,255
EQUAL? STACK,GL-FONT-X /?CND15
?CCL16: PRINTC 42
?CND15: PRINTI "FS="
SHIFT TMP,-8
PRINTN STACK
PRINTC 120
BAND TMP,255
PRINTN STACK
PRINTI "; cursor "
WINGET WIN,K-W-YCURPOS
PRINTN STACK
PRINTC 44
WINGET WIN,K-W-XCURPOS
PRINTN STACK
PRINTI "; line "
WINGET WIN,K-W-MORE
PRINTN STACK
WINGET WIN,K-W-CRCNT >TMP
ZERO? TMP /?CND19
WINGET WIN,K-W-CRFCN
ZERO? STACK /?CND19
PRINTI "; CR="
PRINTN TMP
?CND19: PRINTI "; "
WINGET WIN,K-W-ATTR >A
BTST A,1 /?CCL25
PRINTC 45
JUMP ?CND23
?CCL25: PRINTC 43
?CND23: PRINTI "W,"
BTST A,2 /?CCL28
PRINTC 45
JUMP ?CND26
?CCL28: PRINTC 43
?CND26: PRINTI "S,"
BTST A,4 /?CCL31
PRINTC 45
JUMP ?CND29
?CCL31: PRINTC 43
?CND29: PRINTI "P,"
BTST A,8 /?CCL34
PRINTC 45
JUMP ?CND32
?CCL34: PRINTC 43
?CND32: PRINTR "B"
.ENDI
Reference in New Issue View Git Blame Copy Permalink