1037 lines
21 KiB
Plaintext
1037 lines
21 KiB
Plaintext
|
|
|
|
.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
|