3721 lines
70 KiB
Plaintext
3721 lines
70 KiB
Plaintext
|
|
|
|
.FUNCT GO
|
|
START::
|
|
|
|
?FCN: SET 'HERE,HILLTOP
|
|
MOVE PLAYER,HERE
|
|
SET 'WINNER,PLAYER
|
|
SET 'LIT?,TRUE-VALUE
|
|
ICALL1 INITVARS
|
|
ICALL1 STARTUP
|
|
ICALL1 SETUP-CHARACTER
|
|
RANDOM 8
|
|
SUB STACK,1 >WINDIR
|
|
ICALL2 QUEUE,I-BREEZE
|
|
ICALL1 V-REFRESH
|
|
CRLF
|
|
ICALL1 V-LOOK
|
|
ICALL1 DO-MAIN-LOOP
|
|
JUMP ?FCN
|
|
|
|
|
|
.FUNCT DO-MAIN-LOOP,X
|
|
?PRG1: CALL1 MAIN-LOOP >X
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT MAIN-LOOP,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,X
|
|
SET 'CNT,0
|
|
SET 'OBJ,FALSE-VALUE
|
|
SET 'PTBL,TRUE-VALUE
|
|
EQUAL? HERE,QCONTEXT-ROOM /?CND1
|
|
SET 'QCONTEXT,FALSE-VALUE
|
|
SET 'QCONTEXT-ROOM,FALSE-VALUE
|
|
?CND1: CALL1 PARSER >P-WON
|
|
ZERO? P-WON /?CCL5
|
|
GET P-PRSI,P-MATCHLEN >ICNT
|
|
GET P-PRSO,P-MATCHLEN >OCNT
|
|
ZERO? P-IT-OBJECT /?CND6
|
|
CALL2 ACCESSIBLE?,P-IT-OBJECT
|
|
ZERO? STACK /?CND6
|
|
SET 'TMP,FALSE-VALUE
|
|
?PRG10: IGRTR? 'CNT,ICNT /?REP11
|
|
GET P-PRSI,CNT
|
|
EQUAL? STACK,IT \?PRG10
|
|
PUT P-PRSI,CNT,P-IT-OBJECT
|
|
SET 'TMP,TRUE-VALUE
|
|
?REP11: ZERO? TMP \?CND16
|
|
SET 'CNT,0
|
|
?PRG18: IGRTR? 'CNT,OCNT /?CND16
|
|
GET P-PRSO,CNT
|
|
EQUAL? STACK,IT \?PRG18
|
|
PUT P-PRSO,CNT,P-IT-OBJECT
|
|
?CND16: SET 'CNT,0
|
|
?CND6: SET 'NUM,1
|
|
ZERO? OCNT \?CCL26
|
|
SET 'NUM,0
|
|
JUMP ?CND24
|
|
?CCL26: GRTR? OCNT,1 \?CCL28
|
|
SET 'TBL,P-PRSO
|
|
SET 'OBJ,FALSE-VALUE
|
|
ZERO? ICNT /?CND29
|
|
GET P-PRSI,1 >OBJ
|
|
?CND29: SET 'NUM,OCNT
|
|
JUMP ?CND24
|
|
?CCL28: GRTR? ICNT,1 \?CND24
|
|
SET 'PTBL,FALSE-VALUE
|
|
SET 'TBL,P-PRSI
|
|
GET P-PRSO,1 >OBJ
|
|
SET 'NUM,ICNT
|
|
?CND24: ZERO? OBJ \?CND32
|
|
EQUAL? ICNT,1 \?CND32
|
|
GET P-PRSI,1 >OBJ
|
|
?CND32: EQUAL? PRSA,V?WALK \?CCL38
|
|
CALL PERFORM,PRSA,PRSO >V
|
|
JUMP ?CND36
|
|
?CCL38: ZERO? NUM \?CCL40
|
|
GETB P-SYNTAX,P-SBITS
|
|
BAND STACK,P-SONUMS
|
|
ZERO? STACK \?CCL43
|
|
CALL2 PERFORM,PRSA >V
|
|
SET 'PRSO,FALSE-VALUE
|
|
JUMP ?CND36
|
|
?CCL43: ZERO? LIT? \?CCL45
|
|
ICALL1 PCLEAR
|
|
ICALL1 TOO-DARK
|
|
JUMP ?CND36
|
|
?CCL45: ICALL1 PCLEAR
|
|
PRINTI "[There isn't anything to "
|
|
GET P-ITBL,P-VERBN >TMP
|
|
INTBL? PRSA,TALKVERBS,NTVERBS >X \?CCL48
|
|
PRINTI "talk to"
|
|
JUMP ?CND46
|
|
?CCL48: ZERO? P-MERGED \?CTR49
|
|
ZERO? P-OFLAG /?CCL50
|
|
?CTR49: GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?CND46
|
|
?CCL50: GETB TMP,3 >X
|
|
GETB TMP,2
|
|
ICALL WORD-PRINT,STACK,X
|
|
?CND46: PRINTI ".]"
|
|
CRLF
|
|
SET 'V,FALSE-VALUE
|
|
JUMP ?CND36
|
|
?CCL40: SET 'X,0
|
|
SET 'P-MULT?,FALSE-VALUE
|
|
GRTR? NUM,1 \?CND53
|
|
SET 'P-MULT?,TRUE-VALUE
|
|
?CND53: SET 'TMP,FALSE-VALUE
|
|
?PRG55: IGRTR? 'CNT,NUM \?CND57
|
|
GRTR? X,0 \?CCL61
|
|
PRINTI "[The "
|
|
EQUAL? X,NUM /?CND62
|
|
PRINTI "other "
|
|
?CND62: PRINTI "object"
|
|
EQUAL? X,1 /?CND64
|
|
PRINTC 115
|
|
?CND64: PRINTI " that you mentioned "
|
|
EQUAL? X,1 /?CCL68
|
|
PRINTI "are"
|
|
JUMP ?CND66
|
|
?CCL68: PRINTI "is"
|
|
?CND66: PRINTI "n't here.]"
|
|
CRLF
|
|
JUMP ?CND36
|
|
?CCL61: ZERO? TMP \?CND36
|
|
ICALL1 REFERRING
|
|
JUMP ?CND36
|
|
?CND57: ZERO? PTBL /?CCL72
|
|
GET P-PRSO,CNT >OBJ1
|
|
JUMP ?CND70
|
|
?CCL72: GET P-PRSI,CNT >OBJ1
|
|
?CND70: GRTR? NUM,1 /?CCL74
|
|
GET P-ITBL,P-NC1
|
|
GET STACK,0
|
|
EQUAL? STACK,W?ALL,W?EVERYTHING \?CND73
|
|
?CCL74: EQUAL? OBJ1,NOT-HERE-OBJECT \?CCL79
|
|
INC 'X
|
|
JUMP ?PRG55
|
|
?CCL79: EQUAL? P-GETFLAGS,P-ALL \?CCL81
|
|
CALL DONT-ALL?,OBJ1,OBJ
|
|
ZERO? STACK \?PRG55
|
|
?CCL81: CALL2 ACCESSIBLE?,OBJ1
|
|
ZERO? STACK /?PRG55
|
|
EQUAL? OBJ1,PLAYER /?PRG55
|
|
EQUAL? OBJ1,IT \?CCL89
|
|
FSET? P-IT-OBJECT,NOARTICLE /?CND90
|
|
PRINT XTHE
|
|
?CND90: ICALL2 DPRINT,P-IT-OBJECT
|
|
JUMP ?CND87
|
|
?CCL89: FSET? OBJ1,NOARTICLE /?CND92
|
|
PRINT XTHE
|
|
?CND92: ICALL2 DPRINT,OBJ1
|
|
?CND87: PRINTI ": "
|
|
?CND73: SET 'TMP,TRUE-VALUE
|
|
SET 'PRSO,OBJ1
|
|
SET 'PRSI,OBJ
|
|
ZERO? PTBL \?CND94
|
|
SET 'PRSO,OBJ
|
|
SET 'PRSI,OBJ1
|
|
?CND94: SET 'PSEUDO-PRSO?,FALSE-VALUE
|
|
EQUAL? PRSO,PSEUDO-OBJECT \?CND96
|
|
SET 'PSEUDO-PRSO?,TRUE-VALUE
|
|
?CND96: CALL PERFORM,PRSA,PRSO,PRSI >V
|
|
EQUAL? V,M-FATAL \?PRG55
|
|
?CND36: EQUAL? V,M-FATAL \?CND3
|
|
SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND3
|
|
?CCL5: SET 'P-CONT,FALSE-VALUE
|
|
?CND3: ZERO? P-WON /?CND102
|
|
EQUAL? V,M-FATAL /?CND102
|
|
INTBL? PRSA,GAME-VERBS,NGVERBS >X /?CND102
|
|
CALL1 CLOCKER >V
|
|
?CND102: SET 'PRSA,FALSE-VALUE
|
|
SET 'PRSO,FALSE-VALUE
|
|
SET 'PRSI,FALSE-VALUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DONT-ALL?,O,I,L,X
|
|
LOC O >L
|
|
ZERO? L /TRUE
|
|
EQUAL? O,I /TRUE
|
|
EQUAL? PRSA,V?TAKE \?CCL7
|
|
EQUAL? L,WINNER /TRUE
|
|
ZERO? LIT? \?CCL12
|
|
IN? L,WINNER \TRUE
|
|
?CCL12: FSET? O,NOALL /TRUE
|
|
FSET? O,TAKEABLE /?CCL18
|
|
FSET? O,TRYTAKE \TRUE
|
|
?CCL18: FSET? L,CONTAINER \?CCL22
|
|
FSET? L,OPENED \TRUE
|
|
?CCL22: ZERO? I /?CCL26
|
|
EQUAL? L,I \TRUE
|
|
CALL2 SEE-INSIDE?,I
|
|
ZERO? STACK /TRUE
|
|
RFALSE
|
|
?CCL26: LOC PLAYER
|
|
EQUAL? L,STACK /FALSE
|
|
FSET? L,TAKEABLE /TRUE
|
|
CALL2 SEE-INSIDE?,L
|
|
ZERO? STACK /TRUE
|
|
RFALSE
|
|
?CCL7: INTBL? PRSA,PUTVERBS,NUMPUTS >X \FALSE
|
|
FSET? O,WORN /TRUE
|
|
FSET? O,WIELDED /TRUE
|
|
EQUAL? L,WINNER /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DEQUEUE,RTN
|
|
CALL2 QUEUED?,RTN >RTN
|
|
ZERO? RTN /FALSE
|
|
COPYT RTN,0,C-INTLEN
|
|
RFALSE
|
|
|
|
|
|
.FUNCT QUEUED?,RTN,TBL,LEN
|
|
ADD C-TABLE,C-INTS >TBL
|
|
SUB C-TABLE+100,TBL
|
|
DIV STACK,C-INTLEN >LEN
|
|
LESS? LEN,1 /FALSE
|
|
INTBL? RTN,TBL,LEN,132 >RTN \FALSE
|
|
GET RTN,C-TICK
|
|
ZERO? STACK /FALSE
|
|
RETURN RTN
|
|
|
|
|
|
.FUNCT QUEUE,RTN,TICK,C,E,INT
|
|
ASSIGNED? 'TICK /?CND1
|
|
SET 'TICK,-1
|
|
?CND1: SET 'E,C-TABLE+100
|
|
ADD C-TABLE,C-INTS >C
|
|
?PRG3: EQUAL? C,E \?CCL7
|
|
ZERO? INT /?CCL10
|
|
SET 'C,INT
|
|
JUMP ?CND8
|
|
?CCL10: LESS? C-INTS,C-INTLEN /TRUE
|
|
SUB C-INTS,C-INTLEN >C-INTS
|
|
ADD C-TABLE,C-INTS >INT
|
|
?CND8: PUT INT,C-RTN,RTN
|
|
JUMP ?REP4
|
|
?CCL7: GET C,C-RTN
|
|
EQUAL? STACK,RTN \?CCL14
|
|
SET 'INT,C
|
|
?REP4: 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 \?CND5
|
|
SET 'INT,C
|
|
?CND5: ADD C,C-INTLEN >C
|
|
JUMP ?PRG3
|
|
|
|
|
|
.FUNCT CLOCKER,FLG,Q?,E,TICK,RTN,X,OSTAT,NSTAT,MAX,DELTA
|
|
ZERO? CLOCK-WAIT? /?CND1
|
|
SET 'CLOCK-WAIT?,FALSE-VALUE
|
|
RFALSE
|
|
?CND1: ADD C-TABLE,C-INTS >CLOCK-HAND
|
|
SET 'E,C-TABLE+100
|
|
?PRG3: EQUAL? CLOCK-HAND,E \?CCL7
|
|
INC 'MOVES
|
|
CALL1 REFRESH-STATS?
|
|
ZERO? STACK /?REP4
|
|
SET 'FLG,TRUE-VALUE
|
|
RETURN FLG
|
|
?CCL7: GET CLOCK-HAND,C-RTN
|
|
ZERO? STACK /?CND5
|
|
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 ?CND5
|
|
?CCL13: ZERO? TICK /?CND5
|
|
GRTR? TICK,0 \?CND15
|
|
DEC 'TICK
|
|
PUT CLOCK-HAND,C-TICK,TICK
|
|
?CND15: ZERO? TICK /?CND17
|
|
SET 'Q?,CLOCK-HAND
|
|
?CND17: GRTR? TICK,0 /?CND5
|
|
GET CLOCK-HAND,C-RTN >RTN
|
|
ZERO? TICK \?CND21
|
|
COPYT CLOCK-HAND,0,C-INTLEN
|
|
?CND21: CALL RTN >X
|
|
ZERO? X /?CND23
|
|
SET 'FLG,TRUE-VALUE
|
|
?CND23: ZERO? Q? \?CND5
|
|
GET CLOCK-HAND,C-RTN
|
|
ZERO? STACK /?CND5
|
|
SET 'Q?,TRUE-VALUE
|
|
?CND5: ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND
|
|
ZERO? Q? \?PRG3
|
|
ADD C-INTS,C-INTLEN >C-INTS
|
|
JUMP ?PRG3
|
|
?REP4: RETURN FLG
|
|
|
|
|
|
.FUNCT REFRESH-STATS?,CNT,ANY,STAT,OSTAT,NSTAT,DELTA,MAX,RATE
|
|
SET 'RATE,NORMAL-RATE
|
|
IN? SCABBARD,PLAYER \?CND1
|
|
FSET? SCABBARD,WORN \?CND1
|
|
FSET? SCABBARD,NEUTRALIZED /?CND1
|
|
SET 'RATE,BLESSED-RATE
|
|
?CND1: SET 'STAT,ENDURANCE
|
|
?PRG6: GET STATS,STAT >OSTAT
|
|
GET MAXSTATS,STAT >MAX
|
|
EQUAL? STAT,INTELLIGENCE \?CCL9
|
|
CALL2 WEARING-MAGIC?,HELM
|
|
ZERO? STACK \?CND8
|
|
?CCL9: EQUAL? NO-REFRESH,STAT \?CCL13
|
|
SET 'NO-REFRESH,-1
|
|
JUMP ?CND8
|
|
?CCL13: EQUAL? OSTAT,MAX /?CND8
|
|
MUL RATE,MAX
|
|
DIV STACK,100 >DELTA
|
|
LESS? DELTA,1 \?CND15
|
|
SET 'DELTA,1
|
|
?CND15: GRTR? OSTAT,MAX \?CCL19
|
|
SUB OSTAT,DELTA >NSTAT
|
|
LESS? NSTAT,MAX \?CND17
|
|
SET 'NSTAT,MAX
|
|
JUMP ?CND17
|
|
?CCL19: ADD OSTAT,DELTA >NSTAT
|
|
GRTR? NSTAT,MAX \?CND17
|
|
SET 'NSTAT,MAX
|
|
?CND17: PUT STATS,STAT,NSTAT
|
|
ZERO? DMODE /?CND24
|
|
EQUAL? IN-DBOX,SHOWING-STATS /?CCL26
|
|
ZERO? BMODE /?CND24
|
|
ZERO? STAT \?CND24
|
|
?CCL26: ICALL2 SHOW-STAT,STAT
|
|
?CND24: INC 'ANY
|
|
EQUAL? NSTAT,MAX \?CND8
|
|
INC 'CNT
|
|
PUTB NEW-STATS,CNT,STAT
|
|
?CND8: IGRTR? 'STAT,LUCK \?PRG6
|
|
ZERO? ANY /FALSE
|
|
ZERO? DMODE \?CCL39
|
|
ICALL1 UPPER-SLINE
|
|
JUMP ?CND35
|
|
?CCL39: ZERO? VT220 \?CND35
|
|
ICALL1 APPLE-STATS
|
|
?CND35: ZERO? CNT /FALSE
|
|
ZERO? SAY-STAT /FALSE
|
|
EQUAL? HOST,MACINTOSH /?CND45
|
|
HLIGHT H-BOLD
|
|
?CND45: PRINT TAB
|
|
PRINTI "[Your "
|
|
SET 'ANY,CNT
|
|
?PRG47: GETB NEW-STATS,ANY
|
|
GET STAT-NAMES,STACK
|
|
PRINT STACK
|
|
DLESS? 'ANY,1 /?REP48
|
|
EQUAL? ANY,1 \?CCL53
|
|
PRINT AND
|
|
JUMP ?PRG47
|
|
?CCL53: PRINTI ", "
|
|
JUMP ?PRG47
|
|
?REP48: PRINTC SP
|
|
GRTR? CNT,1 \?CCL56
|
|
PRINTB W?ARE
|
|
JUMP ?CND54
|
|
?CCL56: PRINTB W?IS
|
|
?CND54: PRINTI " back to normal.]"
|
|
CRLF
|
|
HLIGHT H-NORMAL
|
|
SOUND S-BEEP
|
|
ZERO? AUTO /TRUE
|
|
GETB NEW-STATS,1
|
|
ZERO? STACK \TRUE
|
|
ICALL1 BMODE-OFF
|
|
RTRUE
|
|
|
|
|
|
.FUNCT INITVARS,X
|
|
GETB 0,30 >HOST
|
|
GETB 0,1
|
|
BAND STACK,1 >COLORS?
|
|
GET 0,8
|
|
BAND STACK,8 >GRAPHICS?
|
|
SET 'BAR-RES,8
|
|
EQUAL? HOST,MACINTOSH \?CND1
|
|
PUTB TCHARS,FIRST-MAC-ARROW,MAC-UP-ARROW
|
|
PUTB TCHARS,27,MAC-DOWN-ARROW
|
|
SET 'BAR-RES,6
|
|
?CND1: HLIGHT H-MONO
|
|
GETB 0,38 >CWIDTH
|
|
GETB 0,39 >CHEIGHT
|
|
FONT F-NEWFONT >X
|
|
FONT F-DEFAULT >X
|
|
HLIGHT H-NORMAL
|
|
GET 0,17 >X
|
|
DIV X,CWIDTH >WIDTH
|
|
GRTR? WIDTH,80 \?CND3
|
|
SET 'WIDTH,80
|
|
?CND3: GET 0,18 >X
|
|
DIV X,CHEIGHT >HEIGHT
|
|
SUB WIDTH,20 >DWIDTH
|
|
SET 'BOXWIDTH,DWIDTH
|
|
EQUAL? HOST,APPLE-2C \?CND5
|
|
DEC 'BOXWIDTH
|
|
?CND5: SUB WIDTH,MWIDTH
|
|
SUB STACK,1 >MOUSEDGE
|
|
DIV STATMAX,BAR-RES
|
|
ADD STACK,1 >SWIDTH
|
|
ADD LABEL-WIDTH,SWIDTH
|
|
ADD STACK,5 >BARWIDTH
|
|
SET 'CAN-UNDO,0
|
|
SET 'STAT-ROUTINE,RAWBAR
|
|
SET 'VT220,TRUE-VALUE
|
|
SET 'MAX-DHEIGHT,NORMAL-DHEIGHT
|
|
SET 'DHEIGHT,MAX-DHEIGHT
|
|
SET 'MAP-ROUTINE,CLOSE-MAP
|
|
ZERO? VT100 \?CCL8
|
|
EQUAL? HOST,APPLE-2E,APPLE-2C /?CCL8
|
|
ZERO? GRAPHICS? \FALSE
|
|
EQUAL? HOST,IBM \FALSE
|
|
?CCL8: ICALL1 SETUP-APPLE-MODE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SETUP-APPLE-MODE
|
|
SET 'VT220,FALSE-VALUE
|
|
SET 'GRAPHICS?,FALSE-VALUE
|
|
SET 'STAT-ROUTINE,BAR-NUMBER
|
|
SET 'MAX-DHEIGHT,8
|
|
SET 'MAP-ROUTINE,FAR-MAP
|
|
SET 'DHEIGHT,MAX-DHEIGHT
|
|
RFALSE
|
|
|
|
|
|
.FUNCT CENTER,Y,X
|
|
SUB WIDTH,X
|
|
DIV STACK,2
|
|
ICALL DO-CURSET,Y,STACK
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DO-CURSET,Y,X
|
|
EQUAL? 1,CWIDTH,CHEIGHT /?CND1
|
|
DEC 'X
|
|
MUL X,CWIDTH >X
|
|
INC 'X
|
|
DEC 'Y
|
|
MUL Y,CHEIGHT >Y
|
|
INC 'Y
|
|
?CND1: CURSET Y,X
|
|
RFALSE
|
|
|
|
|
|
.FUNCT TO-TOP-WINDOW,X
|
|
FONT F-DEFAULT >X
|
|
SCREEN S-WINDOW
|
|
BUFOUT FALSE-VALUE
|
|
HLIGHT H-NORMAL
|
|
HLIGHT H-MONO
|
|
COLOR GCOLOR,BGND
|
|
RFALSE
|
|
|
|
|
|
.FUNCT TO-BOTTOM-WINDOW,X
|
|
FONT F-DEFAULT >X
|
|
SCREEN S-TEXT
|
|
BUFOUT TRUE-VALUE
|
|
HLIGHT H-NORMAL
|
|
COLOR FORE,BGND
|
|
RFALSE
|
|
|
|
|
|
.FUNCT V-REFRESH,REDGE,X
|
|
GET 0,8 >X
|
|
BAND X,65531
|
|
PUT 0,8,STACK
|
|
SET 'OLD-HERE,FALSE-VALUE
|
|
SET 'P-WALK-DIR,FALSE-VALUE
|
|
COLOR FORE,BGND
|
|
CLEAR -1
|
|
ZERO? DMODE \?CND1
|
|
SPLIT 2
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RTRUE
|
|
?CND1: SET 'NEW-DBOX,IN-DBOX
|
|
SPLIT 12
|
|
ZERO? VT220 \?CND3
|
|
ICALL1 APPLE-STATS
|
|
EQUAL? HOST,APPLE-2C \?CCL7
|
|
ICALL1 2C-BOX
|
|
RTRUE
|
|
?CCL7: EQUAL? HOST,IBM \TRUE
|
|
ICALL1 IBM-BOX
|
|
RTRUE
|
|
?CND3: ICALL1 TO-TOP-WINDOW
|
|
FONT F-NEWFONT >X
|
|
SUB WIDTH,MWIDTH
|
|
SUB STACK,1 >REDGE
|
|
ICALL DO-CURSET,2,1
|
|
PRINTC TLC
|
|
SET 'X,REDGE
|
|
?PRG9: PRINTC TOP
|
|
DLESS? 'X,3 \?PRG9
|
|
PRINTC TRC
|
|
ICALL DO-CURSET,12,1
|
|
PRINTC BLC
|
|
SET 'X,REDGE
|
|
?PRG13: PRINTC BOT
|
|
DLESS? 'X,3 \?PRG13
|
|
PRINTC BRC
|
|
SET 'X,3
|
|
?PRG17: ICALL DO-CURSET,X,1
|
|
PRINTC RSID
|
|
ICALL DO-CURSET,X,REDGE
|
|
PRINTC LSID
|
|
IGRTR? 'X,11 \?PRG17
|
|
SET 'DHEIGHT,MAX-DHEIGHT
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
EQUAL? PRIOR,SHOWING-STATS \?CCL23
|
|
ICALL1 SHOW-RANK
|
|
ICALL1 DISPLAY-STATS
|
|
RTRUE
|
|
?CCL23: ZERO? BMODE /TRUE
|
|
ICALL1 BATTLE-MODE-ON
|
|
RTRUE
|
|
|
|
|
|
.FUNCT IBM-BOX,REDGE,X
|
|
ICALL1 TO-TOP-WINDOW
|
|
FONT F-NEWFONT >X
|
|
SUB WIDTH,MWIDTH
|
|
SUB STACK,1 >REDGE
|
|
CURSET 3,1
|
|
PRINTC IBM-TLC
|
|
SET 'X,REDGE
|
|
?PRG1: PRINTC IBM-HORZ
|
|
DLESS? 'X,3 \?PRG1
|
|
PRINTC IBM-TRC
|
|
ICALL DO-CURSET,12,1
|
|
PRINTC IBM-BLC
|
|
SET 'X,REDGE
|
|
?PRG5: PRINTC IBM-HORZ
|
|
DLESS? 'X,3 \?PRG5
|
|
PRINTC IBM-BRC
|
|
SET 'X,4
|
|
?PRG9: ICALL DO-CURSET,X,1
|
|
PRINTC IBM-VERT
|
|
ICALL DO-CURSET,X,REDGE
|
|
PRINTC IBM-VERT
|
|
IGRTR? 'X,11 \?PRG9
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RTRUE
|
|
|
|
|
|
.FUNCT 2C-BOX,CNT,X
|
|
ICALL1 TO-TOP-WINDOW
|
|
FONT F-NEWFONT >X
|
|
SUB WIDTH,MWIDTH
|
|
SUB STACK,2 >X
|
|
SET 'CNT,2
|
|
CURSET 12,2
|
|
?PRG1: PRINTC APPLE-HORZ
|
|
IGRTR? 'CNT,X \?PRG1
|
|
SET 'X,1
|
|
?PRG5: CURSET X,1
|
|
PRINTC APPLE-RIGHT
|
|
CURSET X,CNT
|
|
PRINTC APPLE-LEFT
|
|
IGRTR? 'X,11 \?PRG5
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DISPLAY-PLACE,DIR,LEN,X,DEST,END
|
|
GETB ROOMS-MAPPED,0 >LEN
|
|
ZERO? LEN /?CND1
|
|
ZERO? OLD-HERE /?CND1
|
|
INTBL? OLD-HERE,ROOMS-MAPPED+1,LEN,1 >DEST \?CND1
|
|
ADD ROOMS-MAPPED,LEN >END
|
|
LESS? DEST,END \?CND5
|
|
SUB END,DEST
|
|
SUB 0,STACK >X
|
|
ADD DEST,1
|
|
COPYT STACK,DEST,X
|
|
?CND5: SUB LEN,1
|
|
PUTB ROOMS-MAPPED,0,STACK
|
|
?CND1: ICALL1 SETUP-SLINE
|
|
ICALL1 SAY-HERE
|
|
ICALL1 CENTER-SLINE
|
|
ICALL1 SHOW-SLINE
|
|
EQUAL? P-WALK-DIR,FALSE-VALUE,P?UP,P?DOWN /?CTR8
|
|
EQUAL? P-WALK-DIR,P?IN,P?OUT \?PRG12
|
|
?CTR8: ICALL1 NEW-MAP
|
|
JUMP ?CND7
|
|
?PRG12: GETB PDIR-LIST,DIR
|
|
EQUAL? P-WALK-DIR,STACK \?CND14
|
|
ADD DIR,4 >X
|
|
GRTR? X,I-NW \?CND16
|
|
SUB X,8 >X
|
|
?CND16: GETB PDIR-LIST,X
|
|
GETP HERE,STACK >LEN
|
|
ZERO? LEN \?CND18
|
|
ICALL1 NEW-MAP
|
|
JUMP ?CND7
|
|
?CND18: GET LEN,XTYPE
|
|
BAND STACK,127 >LEN
|
|
INC 'LEN
|
|
GET YOFFS,DIR >X
|
|
EQUAL? MAP-ROUTINE,CLOSE-MAP \?CND20
|
|
ADD X,X >X
|
|
?CND20: MUL X,LEN >X
|
|
ADD MAPY,X >MAPY
|
|
GET XOFFS,DIR >X
|
|
EQUAL? MAP-ROUTINE,CLOSE-MAP \?CND22
|
|
ADD X,X >X
|
|
?CND22: MUL X,LEN >X
|
|
ADD MAPX,X >MAPX
|
|
LESS? MAPY,1 /?CCL25
|
|
GRTR? MAPY,9 /?CCL25
|
|
LESS? MAPX,1 /?CCL25
|
|
GRTR? MAPX,15 \?CND24
|
|
?CCL25: ICALL1 NEW-MAP
|
|
JUMP ?CND7
|
|
?CND24: ICALL1 DRAW-MAP
|
|
JUMP ?CND7
|
|
?CND14: IGRTR? 'DIR,I-NW \?PRG12
|
|
?CND7: ICALL1 SHOW-MAP
|
|
ZERO? DMODE /?CND32
|
|
EQUAL? PRIOR,0,SHOWING-ROOM \?CND32
|
|
SET 'DBOX-TOP,0
|
|
ICALL1 UPDATE-ROOMDESC
|
|
?CND32: SET 'OLD-HERE,HERE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT REFRESH-MAP,NEW
|
|
ASSIGNED? 'NEW /?CND1
|
|
SET 'NEW,TRUE-VALUE
|
|
?CND1: ZERO? DMODE \?CND3
|
|
ICALL1 LOWER-SLINE
|
|
RFALSE
|
|
?CND3: SET 'SAME-COORDS,NEW
|
|
BOR NEW-DBOX,SHOWING-ROOM >NEW-DBOX
|
|
ICALL1 NEW-MAP
|
|
ICALL1 SHOW-MAP
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SHOW-MAP,X
|
|
ICALL1 TO-TOP-WINDOW
|
|
ZERO? VT220 /?CND1
|
|
FONT F-NEWFONT >X
|
|
?CND1: SUB WIDTH,MWIDTH
|
|
ICALL DO-CURSET,1,STACK
|
|
PRINTT MAP,MWIDTH,MHEIGHT
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SHOW-RANK,RIGHT-EDGE,LEN,X
|
|
ASSIGNED? 'RIGHT-EDGE /?CND1
|
|
SET 'RIGHT-EDGE,DWIDTH
|
|
?CND1: ICALL1 SETUP-SLINE
|
|
PRINTC SP
|
|
ICALL2 PRINT-TABLE,CHARNAME
|
|
DIROUT D-TABLE-OFF
|
|
GET AUX-TABLE,0 >LEN
|
|
ADD AUX-TABLE,2
|
|
COPYT STACK,SLINE,LEN
|
|
PUT AUX-TABLE,0,0
|
|
DIROUT D-TABLE-ON,AUX-TABLE
|
|
ICALL1 ANNOUNCE-RANK
|
|
PRINTC SP
|
|
DIROUT D-TABLE-OFF
|
|
GET AUX-TABLE,0 >LEN
|
|
SUB RIGHT-EDGE,LEN
|
|
ADD SLINE,STACK >X
|
|
ADD AUX-TABLE,2
|
|
COPYT STACK,X,LEN
|
|
ICALL SHOW-SLINE,1,RIGHT-EDGE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT ANNOUNCE-RANK,LEVEL,STAT
|
|
GET STATS,EXPERIENCE >STAT
|
|
PRINTI "Level "
|
|
?PRG1: GET THRESHOLDS,LEVEL
|
|
LESS? STAT,STACK /?REP2
|
|
IGRTR? 'LEVEL,MAX-LEVEL \?PRG1
|
|
SET 'LEVEL,0
|
|
PUT STATS,EXPERIENCE,0
|
|
IGRTR? 'RANK,2 \?REP2
|
|
SET 'RANK,2
|
|
?REP2: PRINTN LEVEL
|
|
PRINTC SP
|
|
FSET? PLAYER,FEMALE \?CCL11
|
|
PRINTI "Fem"
|
|
JUMP ?CND9
|
|
?CCL11: PRINTC 77
|
|
?CND9: PRINTI "ale "
|
|
GET RANK-NAMES,RANK
|
|
PRINT STACK
|
|
RETURN LEVEL
|
|
|
|
|
|
.FUNCT SETUP-SLINE
|
|
PUTB SLINE,0,SP
|
|
COPYT SLINE,SLINE+1,-81
|
|
PUT AUX-TABLE,0,0
|
|
DIROUT D-TABLE-ON,AUX-TABLE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT CENTER-SLINE,X,LEN
|
|
DIROUT D-TABLE-OFF
|
|
GET AUX-TABLE,0 >LEN
|
|
SUB DWIDTH,LEN
|
|
DIV STACK,2
|
|
ADD SLINE,STACK >X
|
|
ADD AUX-TABLE,2
|
|
COPYT STACK,X,LEN
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SHOW-SLINE,Y,RIGHT-EDGE,X
|
|
ASSIGNED? 'Y /?CND1
|
|
SET 'Y,1
|
|
?CND1: ASSIGNED? 'RIGHT-EDGE /?CND3
|
|
SET 'RIGHT-EDGE,DWIDTH
|
|
?CND3: ICALL1 TO-TOP-WINDOW
|
|
ICALL DO-CURSET,Y,1
|
|
EQUAL? RIGHT-EDGE,WIDTH /?CND5
|
|
ZERO? VT220 /?CCL8
|
|
FONT F-NEWFONT >X
|
|
PRINTC 58
|
|
FONT F-DEFAULT >X
|
|
JUMP ?CND5
|
|
?CCL8: EQUAL? HOST,APPLE-2C \?CCL10
|
|
FONT F-NEWFONT >X
|
|
PRINTC APPLE-RIGHT
|
|
FONT F-DEFAULT >X
|
|
JUMP ?CND5
|
|
?CCL10: PRINTC SP
|
|
?CND5: HLIGHT H-INVERSE
|
|
PRINTT SLINE,RIGHT-EDGE
|
|
HLIGHT H-NORMAL
|
|
HLIGHT H-MONO
|
|
EQUAL? RIGHT-EDGE,WIDTH /?CND11
|
|
ZERO? VT220 /?CCL14
|
|
FONT F-NEWFONT >X
|
|
PRINTC 57
|
|
FONT F-DEFAULT >X
|
|
JUMP ?CND11
|
|
?CCL14: EQUAL? HOST,APPLE-2C \?CCL16
|
|
FONT F-NEWFONT >X
|
|
PRINTC APPLE-LEFT
|
|
FONT F-DEFAULT >X
|
|
JUMP ?CND11
|
|
?CCL16: PRINTC SP
|
|
?CND11: ICALL1 TO-BOTTOM-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SAY-HERE,X
|
|
EQUAL? HERE,DEATH /?CND1
|
|
ZERO? LIT? \?CND1
|
|
PRINTI "Darkness"
|
|
RTRUE
|
|
?CND1: ICALL2 DPRINT,HERE
|
|
LOC PLAYER >X
|
|
FSET? X,VEHICLE \TRUE
|
|
PRINTC COMMA
|
|
EQUAL? X,SADDLE \?CND6
|
|
IN? SADDLE,DACT \?CND6
|
|
PRINT SON
|
|
ICALL2 PRINTA,DACT
|
|
RTRUE
|
|
?CND6: ICALL2 ON-IN,X
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PRINT-SPACES,N
|
|
?PRG1: DLESS? 'N,0 /TRUE
|
|
PRINTC SP
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT NEW-MAP,TBL,X
|
|
ZERO? SAME-COORDS /?CCL3
|
|
SET 'SAME-COORDS,FALSE-VALUE
|
|
JUMP ?CND1
|
|
?CCL3: SET 'MAPX,CENTERX
|
|
SET 'MAPY,CENTERY
|
|
GETPT HERE,P?COORDS >TBL
|
|
ZERO? TBL /?CND1
|
|
GETB TBL,0 >X
|
|
ZERO? X /?CND6
|
|
SET 'MAPX,X
|
|
?CND6: GETB TBL,1 >X
|
|
ZERO? X /?CND1
|
|
SET 'MAPY,X
|
|
?CND1: ICALL1 DRAW-MAP
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DRAW-MAP
|
|
COPYT ROOMS-MAPPED,0,ROOMS-MAPPED-LENGTH
|
|
PUTB MAP,0,SP
|
|
COPYT MAP,MAP+1,-186
|
|
ICALL MAP-ROUTINE,HERE,MAPY,MAPX
|
|
RFALSE
|
|
|
|
|
|
.FUNCT CLOSE-MAP,RM,Y,X,DIR,TBL,CHAR,TYPE,LEN,DEST,NY,NX,YOFF,XOFF,CTBL
|
|
GETB ROOMS-MAPPED,0 >LEN
|
|
ZERO? LEN /?CCL2
|
|
INTBL? RM,ROOMS-MAPPED+1,LEN,1 >CHAR /?CND1
|
|
?CCL2: IGRTR? 'LEN,45 /TRUE
|
|
PUTB ROOMS-MAPPED,LEN,RM
|
|
PUTB ROOMS-MAPPED,0,LEN
|
|
?CND1: GRTR? Y,-1 \?CND7
|
|
LESS? Y,MHEIGHT \?CND7
|
|
GRTR? X,-1 \?CND7
|
|
LESS? X,MWIDTH \?CND7
|
|
ZERO? VT220 /?CCL15
|
|
CALL2 SMART-CHAR?,RM >CHAR
|
|
JUMP ?CND13
|
|
?CCL15: CALL2 DUMB-CHAR?,RM >CHAR
|
|
?CND13: MUL Y,MWIDTH
|
|
ADD MAP,STACK
|
|
PUTB STACK,X,CHAR
|
|
?CND7: FSET RM,MAPPED
|
|
SET 'DIR,-1
|
|
?PRG16: IGRTR? 'DIR,I-NW \?CND18
|
|
FCLEAR RM,MAPPED
|
|
RTRUE
|
|
?CND18: SET 'LEN,0
|
|
SET 'DEST,FALSE-VALUE
|
|
SET 'TYPE,FALSE-VALUE
|
|
SET 'CTBL,XCHARS
|
|
GETB PDIR-LIST,DIR
|
|
GETP RM,STACK >TBL
|
|
ZERO? TBL /?CND20
|
|
GET TBL,XTYPE >TYPE
|
|
BAND TYPE,255 >LEN
|
|
BAND TYPE,65280 >TYPE
|
|
?CND20: ZERO? TBL /?CTR23
|
|
EQUAL? TYPE,NO-EXIT,SORRY-EXIT /?CTR23
|
|
BTST LEN,MARKBIT /?CCL24
|
|
?CTR23: SET 'CTBL,NXCHARS
|
|
JUMP ?CND22
|
|
?CCL24: EQUAL? TYPE,FCONNECT \?CCL29
|
|
SET 'DEST,-1
|
|
BAND LEN,127 >LEN
|
|
ZERO? LEN \?CND22
|
|
SET 'CTBL,NXCHARS
|
|
JUMP ?CND22
|
|
?CCL29: GET TBL,XROOM >DEST
|
|
ZERO? DEST /FALSE
|
|
IN? DEST,ROOMS \FALSE
|
|
EQUAL? TYPE,SHADOW-EXIT /?CCL37
|
|
EQUAL? TYPE,DCONNECT \?CND22
|
|
GET TBL,XDATA
|
|
FSET? STACK,OPENED /?CND22
|
|
?CCL37: SET 'CTBL,NXCHARS
|
|
?CND22: BAND LEN,127 >LEN
|
|
GET YOFFS,DIR >YOFF
|
|
GET XOFFS,DIR >XOFF
|
|
ADD Y,YOFF >NY
|
|
ADD X,XOFF >NX
|
|
LESS? NY,0 /?PRG16
|
|
GRTR? NY,10 /?PRG16
|
|
LESS? NX,0 /?PRG16
|
|
GRTR? NX,16 /?PRG16
|
|
GETB CTBL,DIR >CHAR
|
|
ZERO? VT220 \?CCL50
|
|
GETB SHITCHARS,DIR >CHAR
|
|
EQUAL? CTBL,NXCHARS \?CND48
|
|
SET 'CHAR,SP
|
|
JUMP ?CND48
|
|
?CCL50: EQUAL? HERE,RM \?CND48
|
|
ADD CHAR,17 >CHAR
|
|
?CND48: MUL NY,MWIDTH
|
|
ADD MAP,STACK
|
|
PUTB STACK,NX,CHAR
|
|
ZERO? TBL /?PRG16
|
|
ZERO? TYPE /?PRG16
|
|
ZERO? DEST /?PRG16
|
|
LESS? Y,0 /?PRG16
|
|
GRTR? Y,10 /?PRG16
|
|
LESS? X,0 /?PRG16
|
|
GRTR? X,16 /?PRG16
|
|
BAND LEN,254
|
|
ADD LEN,STACK >LEN
|
|
GETB MCHARS,DIR >CHAR
|
|
EQUAL? TYPE,X-EXIT \?CCL65
|
|
BTST DIR,1 \?CCL68
|
|
SET 'CHAR,XCROSS
|
|
ZERO? VT220 \?PRG78
|
|
SET 'CHAR,88
|
|
JUMP ?PRG78
|
|
?CCL68: SET 'CHAR,HVCROSS
|
|
ZERO? VT220 \?PRG78
|
|
SET 'CHAR,43
|
|
JUMP ?PRG78
|
|
?CCL65: EQUAL? CTBL,NXCHARS \?CCL74
|
|
SET 'CHAR,SOLID
|
|
ZERO? VT220 \?PRG78
|
|
SET 'CHAR,SP
|
|
JUMP ?PRG78
|
|
?CCL74: ZERO? VT220 \?PRG78
|
|
GETB SHITCHARS,DIR >CHAR
|
|
?PRG78: ADD NY,YOFF >NY
|
|
ADD NX,XOFF >NX
|
|
LESS? NY,0 /?REP79
|
|
GRTR? NY,10 /?REP79
|
|
LESS? NX,0 /?REP79
|
|
GRTR? NX,16 /?REP79
|
|
MUL NY,MWIDTH
|
|
ADD MAP,STACK
|
|
PUTB STACK,NX,CHAR
|
|
DLESS? 'LEN,1 \?PRG78
|
|
?REP79: EQUAL? DEST,-1 /?PRG16
|
|
FSET? DEST,MAPPED /?PRG16
|
|
GETB ROOMS-MAPPED,0
|
|
INTBL? DEST,ROOMS-MAPPED+1,STACK,1 >CHAR /?PRG16
|
|
FSET? DEST,VIEWED \?PRG16
|
|
ADD YOFF,YOFF
|
|
ADD NY,STACK >NY
|
|
ADD XOFF,XOFF
|
|
ADD NX,STACK >NX
|
|
LESS? NY,-1 /?PRG16
|
|
GRTR? NY,MHEIGHT /?PRG16
|
|
LESS? NX,-1 /?PRG16
|
|
GRTR? NX,MWIDTH /?PRG16
|
|
ICALL CLOSE-MAP,DEST,NY,NX
|
|
JUMP ?PRG16
|
|
|
|
|
|
.FUNCT DUMB-CHAR?,RM,CHAR
|
|
SET 'CHAR,42
|
|
EQUAL? HERE,RM \?CCL3
|
|
SET 'CHAR,64
|
|
RETURN CHAR
|
|
?CCL3: CALL2 IS-LIT?,RM
|
|
ZERO? STACK \?CND1
|
|
SET 'CHAR,63
|
|
?CND1: RETURN CHAR
|
|
|
|
|
|
.FUNCT SMART-CHAR?,RM,CHAR,TBL
|
|
SET 'CHAR,SOLID
|
|
EQUAL? HERE,RM \?CND1
|
|
SET 'CHAR,ISOLID
|
|
?CND1: CALL2 IS-LIT?,RM
|
|
ZERO? STACK \?CND3
|
|
SET 'CHAR,QMARK
|
|
EQUAL? HERE,RM \?CND3
|
|
SET 'CHAR,IQMARK
|
|
?CND3: GETP RM,P?UP >TBL
|
|
ZERO? TBL /?CND7
|
|
CALL CHECK-EXIT?,RM,TBL
|
|
ZERO? STACK /?CND7
|
|
SET 'CHAR,UARROW
|
|
EQUAL? HERE,RM \?CND7
|
|
SET 'CHAR,IUARROW
|
|
?CND7: GETP RM,P?DOWN >TBL
|
|
ZERO? TBL /?CND13
|
|
CALL CHECK-EXIT?,RM,TBL
|
|
ZERO? STACK /?CND13
|
|
EQUAL? CHAR,UARROW \?CCL19
|
|
RETURN UDARROW
|
|
?CCL19: EQUAL? CHAR,IUARROW \?CCL21
|
|
RETURN IUDARROW
|
|
?CCL21: EQUAL? HERE,RM /?CCL22
|
|
RETURN DARROW
|
|
?CCL22: RETURN IDARROW
|
|
?CND13: RETURN CHAR
|
|
|
|
|
|
.FUNCT CHECK-EXIT?,RM,TBL,EXIT-WORD,ROOM,XDIR,XTBL,TYPE,LEN
|
|
GET TBL,XTYPE >EXIT-WORD
|
|
GET TBL,XROOM >ROOM
|
|
SET 'XDIR,P?NW
|
|
?PRG1: GETP RM,XDIR >XTBL
|
|
ZERO? TBL /?CND3
|
|
GET XTBL,XTYPE
|
|
EQUAL? STACK,EXIT-WORD \?CND3
|
|
GET XTBL,XROOM
|
|
EQUAL? STACK,ROOM /FALSE
|
|
?CND3: IGRTR? 'XDIR,P?NORTH \?PRG1
|
|
BAND EXIT-WORD,65280 >TYPE
|
|
BAND EXIT-WORD,127 >LEN
|
|
EQUAL? TYPE,NO-EXIT,SORRY-EXIT /FALSE
|
|
BTST EXIT-WORD,MARKBIT \FALSE
|
|
EQUAL? TYPE,CONNECT,SCONNECT,X-EXIT /TRUE
|
|
EQUAL? TYPE,DCONNECT \?CCL18
|
|
GET TBL,XDATA
|
|
FSET? STACK,OPENED /TRUE
|
|
?CCL18: EQUAL? TYPE,FCONNECT \FALSE
|
|
ZERO? LEN /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT FAR-MAP,RM,Y,X,DIR,TBL,CHAR,TYPE,LEN,DEST,NY,NX,YOFF,XOFF
|
|
GETB ROOMS-MAPPED,0 >LEN
|
|
ZERO? LEN /?CCL2
|
|
INTBL? RM,ROOMS-MAPPED+1,LEN,1 >CHAR /?CND1
|
|
?CCL2: IGRTR? 'LEN,45 /TRUE
|
|
PUTB ROOMS-MAPPED,LEN,RM
|
|
PUTB ROOMS-MAPPED,0,LEN
|
|
?CND1: GRTR? Y,-1 \?CND7
|
|
LESS? Y,MHEIGHT \?CND7
|
|
GRTR? X,-1 \?CND7
|
|
LESS? X,MWIDTH \?CND7
|
|
ZERO? VT220 \?CCL15
|
|
CALL2 DUMB-CHAR?,RM >CHAR
|
|
JUMP ?CND13
|
|
?CCL15: SET 'CHAR,SMBOX
|
|
EQUAL? HERE,RM \?CND13
|
|
SET 'CHAR,ISOLID
|
|
?CND13: MUL Y,MWIDTH
|
|
ADD MAP,STACK
|
|
PUTB STACK,X,CHAR
|
|
?CND7: FSET RM,MAPPED
|
|
SET 'DIR,-1
|
|
?PRG18: IGRTR? 'DIR,I-NW \?CND20
|
|
FCLEAR RM,MAPPED
|
|
RTRUE
|
|
?CND20: SET 'LEN,0
|
|
SET 'DEST,FALSE-VALUE
|
|
SET 'TYPE,FALSE-VALUE
|
|
GETB PDIR-LIST,DIR
|
|
GETP RM,STACK >TBL
|
|
ZERO? TBL /?PRG18
|
|
GET TBL,XTYPE >TYPE
|
|
BAND TYPE,255 >LEN
|
|
BAND TYPE,65280 >TYPE
|
|
ZERO? TYPE /FALSE
|
|
EQUAL? TYPE,NO-EXIT,SORRY-EXIT /?PRG18
|
|
BTST LEN,MARKBIT \?PRG18
|
|
EQUAL? TYPE,FCONNECT \?CCL32
|
|
SET 'DEST,-1
|
|
JUMP ?CND24
|
|
?CCL32: GET TBL,XROOM >DEST
|
|
ZERO? DEST /FALSE
|
|
IN? DEST,ROOMS \FALSE
|
|
?CND24: ZERO? DEST /?PRG18
|
|
LESS? Y,0 /?PRG18
|
|
GRTR? Y,10 /?PRG18
|
|
LESS? X,0 /?PRG18
|
|
GRTR? X,16 /?PRG18
|
|
BAND LEN,127 >LEN
|
|
GET YOFFS,DIR >YOFF
|
|
GET XOFFS,DIR >XOFF
|
|
GETB MCHARS,DIR >CHAR
|
|
EQUAL? TYPE,X-EXIT \?CCL46
|
|
BTST DIR,1 \?CCL49
|
|
SET 'CHAR,XCROSS
|
|
ZERO? VT220 \?CND44
|
|
SET 'CHAR,88
|
|
JUMP ?CND44
|
|
?CCL49: SET 'CHAR,HVCROSS
|
|
ZERO? VT220 \?CND44
|
|
SET 'CHAR,43
|
|
JUMP ?CND44
|
|
?CCL46: EQUAL? TYPE,SHADOW-EXIT /?CTR54
|
|
EQUAL? TYPE,DCONNECT \?CCL55
|
|
GET TBL,XDATA
|
|
FSET? STACK,OPENED /?CCL55
|
|
?CTR54: SET 'CHAR,SOLID
|
|
ZERO? VT220 \?CND44
|
|
SET 'CHAR,SP
|
|
JUMP ?CND44
|
|
?CCL55: ZERO? VT220 \?CND44
|
|
GETB SHITCHARS,DIR >CHAR
|
|
?CND44: SET 'NY,Y
|
|
SET 'NX,X
|
|
?PRG63: ADD NY,YOFF >NY
|
|
ADD NX,XOFF >NX
|
|
LESS? NY,0 /?REP64
|
|
GRTR? NY,10 /?REP64
|
|
LESS? NX,0 /?REP64
|
|
GRTR? NX,16 /?REP64
|
|
MUL NY,MWIDTH
|
|
ADD MAP,STACK
|
|
PUTB STACK,NX,CHAR
|
|
DLESS? 'LEN,1 \?PRG63
|
|
?REP64: EQUAL? DEST,-1 /?PRG18
|
|
FSET? DEST,MAPPED /?PRG18
|
|
GETB ROOMS-MAPPED,0
|
|
INTBL? DEST,ROOMS-MAPPED+1,STACK,1 >CHAR /?PRG18
|
|
FSET? DEST,VIEWED \?PRG18
|
|
ADD NY,YOFF >NY
|
|
ADD NX,XOFF >NX
|
|
LESS? NY,-1 /?PRG18
|
|
GRTR? NY,MHEIGHT /?PRG18
|
|
LESS? NX,-1 /?PRG18
|
|
GRTR? NX,MWIDTH /?PRG18
|
|
ICALL FAR-MAP,DEST,NY,NX
|
|
JUMP ?PRG18
|
|
|
|
|
|
.FUNCT RELOOK,NOP
|
|
ZERO? NOP \?CND1
|
|
PRINT PERIOD
|
|
?CND1: ZERO? VERBOSITY /?CND3
|
|
CRLF
|
|
?CND3: ICALL1 V-LOOK
|
|
RFALSE
|
|
|
|
|
|
.FUNCT V-LOOK,V
|
|
ASSIGNED? 'V /?CND1
|
|
SET 'V,TRUE-VALUE
|
|
?CND1: EQUAL? HOST,MACINTOSH /?CND3
|
|
HLIGHT H-BOLD
|
|
?CND3: ICALL1 SAY-HERE
|
|
CRLF
|
|
HLIGHT H-NORMAL
|
|
ZERO? LIT? /?CND5
|
|
ICALL1 MARK-EXITS
|
|
?CND5: ZERO? DMODE /?CCL8
|
|
EQUAL? PRIOR,SHOWING-STATS,SHOWING-INV \?CND7
|
|
?CCL8: ICALL2 DESCRIBE-HERE,V
|
|
ZERO? DMODE \?CND11
|
|
ICALL1 UPPER-SLINE
|
|
ICALL1 LOWER-SLINE
|
|
SET 'OLD-HERE,HERE
|
|
RTRUE
|
|
?CND11: ICALL1 DISPLAY-PLACE
|
|
RTRUE
|
|
?CND7: ICALL1 DISPLAY-PLACE
|
|
GET 0,8
|
|
BTST STACK,1 \TRUE
|
|
DIROUT D-SCREEN-OFF
|
|
ICALL2 DESCRIBE-HERE,V
|
|
DIROUT D-SCREEN-ON
|
|
RTRUE
|
|
|
|
|
|
.FUNCT MARK-EXITS,DIR,TBL,WRD,TYPE,LEN
|
|
SET 'DIR,P?NORTH
|
|
?PRG1: GETP HERE,DIR >TBL
|
|
ZERO? TBL /?CND3
|
|
GET TBL,XTYPE >WRD
|
|
BAND WRD,65280 >TYPE
|
|
BAND WRD,127 >LEN
|
|
BTST WRD,MARKBIT /?CND3
|
|
EQUAL? TYPE,CONNECT,SCONNECT,X-EXIT /?CCL7
|
|
EQUAL? TYPE,FCONNECT \?PRD10
|
|
ZERO? LEN \?CCL7
|
|
?PRD10: EQUAL? TYPE,DCONNECT \?CND3
|
|
GET TBL,XDATA
|
|
FSET? STACK,OPENED \?CND3
|
|
?CCL7: ADD WRD,MARKBIT
|
|
PUT TBL,XTYPE,STACK
|
|
?CND3: DLESS? 'DIR,P?DOWN \?PRG1
|
|
RFALSE
|
|
|
|
|
|
.FUNCT UPDATE-ROOMDESC
|
|
SET 'IN-DBOX,SHOWING-ROOM
|
|
ICALL1 SETUP-DBOX
|
|
ICALL1 DESCRIBE-HERE
|
|
ICALL1 JUSTIFY-DBOX
|
|
ICALL1 DISPLAY-DBOX
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DESCRIBE-HERE,V,INDENT,X
|
|
ZERO? DMODE /?CCL2
|
|
EQUAL? PRIOR,SHOWING-INV,SHOWING-STATS \?CND1
|
|
?CCL2: INC 'INDENT
|
|
?CND1: EQUAL? HERE,DEATH \?CCL7
|
|
ZERO? INDENT /?CND8
|
|
PRINT TAB
|
|
?CND8: PRINTI "You are de"
|
|
FSET? DEATH,MUNGED \?CND10
|
|
PRINTR "feated."
|
|
?CND10: PRINTR "ad."
|
|
?CCL7: ZERO? LIT? \?CND5
|
|
FSET HERE,TOUCHED
|
|
FSET HERE,VIEWED
|
|
ZERO? INDENT /?CND13
|
|
PRINT TAB
|
|
?CND13: CALL2 WEARING-MAGIC?,HELM
|
|
ZERO? STACK /?CND15
|
|
IN? URGRUE,HERE \?CCL19
|
|
SET 'P-IT-OBJECT,URGRUE
|
|
SET 'LAST-MONSTER,URGRUE
|
|
PRINTR "You sense the presence of an obscure shadow in the darkness."
|
|
?CCL19: IN? GRUE,HERE \?CND15
|
|
FSET GRUE,SEEN
|
|
SET 'P-IT-OBJECT,GRUE
|
|
SET 'LAST-MONSTER,GRUE
|
|
CALL2 PICK-NEXT,GRUE-SIGHTS
|
|
PRINT STACK
|
|
PRINT PERIOD
|
|
RTRUE
|
|
?CND15: PRINTI "It's completely dark"
|
|
FSET? GRUE,SEEN \?CCL22
|
|
RANDOM 100
|
|
LESS? 50,STACK /?CND21
|
|
?CCL22: FSET GRUE,SEEN
|
|
PRINTI ". You are likely to be eaten by a grue"
|
|
?CND21: PRINT PERIOD
|
|
RTRUE
|
|
?CND5: FCLEAR GRUE,SEEN
|
|
GETP HERE,P?ACTION >X
|
|
ZERO? X /?CND25
|
|
ZERO? V \?CCL28
|
|
ZERO? INDENT /?CCL28
|
|
EQUAL? VERBOSITY,2 /?CCL28
|
|
EQUAL? VERBOSITY,1 \?CND25
|
|
FSET? HERE,TOUCHED /?CND25
|
|
?CCL28: ZERO? INDENT /?CND35
|
|
PRINT TAB
|
|
?CND35: ICALL X,M-LOOK
|
|
?CND25: FSET HERE,TOUCHED
|
|
FSET HERE,VIEWED
|
|
ZERO? V \?CCL38
|
|
ZERO? VERBOSITY \?CCL38
|
|
ZERO? INDENT \TRUE
|
|
?CCL38: ICALL1 DESCRIBE-OBJECTS
|
|
RTRUE
|
|
|
|
|
|
.FUNCT UPPER-SLINE
|
|
ICALL1 SETUP-SLINE
|
|
PRINTC SP
|
|
ICALL2 PRINT-TABLE,CHARNAME
|
|
ICALL1 NEXTLINE
|
|
ICALL1 TEXT-STATS
|
|
ICALL2 PRINTLINE,1
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TEXT-STATS,STAT,X
|
|
?PRG1: GET STSTR,STAT
|
|
PRINT STACK
|
|
PRINTC 58
|
|
GET STATS,STAT >X
|
|
LESS? X,10 \?CND3
|
|
PRINTC 48
|
|
?CND3: PRINTN X
|
|
PRINTC SP
|
|
IGRTR? 'STAT,6 \?PRG1
|
|
RFALSE
|
|
|
|
|
|
.FUNCT NEXTLINE,LEN
|
|
DIROUT D-TABLE-OFF
|
|
GET AUX-TABLE,0 >LEN
|
|
ADD AUX-TABLE,2
|
|
COPYT STACK,SLINE,LEN
|
|
DIROUT D-TABLE-ON,AUX-TABLE
|
|
PUT AUX-TABLE,0,0
|
|
RFALSE
|
|
|
|
|
|
.FUNCT PRINTLINE,LINE,LEN,X
|
|
DIROUT D-TABLE-OFF
|
|
GET AUX-TABLE,0 >LEN
|
|
SUB WIDTH,LEN
|
|
ADD SLINE,STACK >X
|
|
ADD AUX-TABLE,2
|
|
COPYT STACK,X,LEN
|
|
ICALL1 TO-TOP-WINDOW
|
|
ICALL DO-CURSET,LINE,1
|
|
HLIGHT H-INVERSE
|
|
PRINTT SLINE,WIDTH
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT LOWER-SLINE,ANY,PTR,DIR,TBL,TYPE,X
|
|
ICALL1 SETUP-SLINE
|
|
PRINTC SP
|
|
ICALL1 SAY-HERE
|
|
ICALL1 NEXTLINE
|
|
PRINTI "Exits:"
|
|
ZERO? LIT? \?CCL3
|
|
PRINTI " None visible"
|
|
JUMP ?CND1
|
|
?CCL3: COPYT GOOD-DIRS,0,32
|
|
SET 'DIR,I-NORTH
|
|
?PRG4: GETB PDIR-LIST,DIR
|
|
GETP HERE,STACK >TBL
|
|
ZERO? TBL /?CND6
|
|
GET TBL,XTYPE >TYPE
|
|
BAND TYPE,65280 >X
|
|
EQUAL? X,CONNECT,SCONNECT,X-EXIT /?CCL9
|
|
EQUAL? X,FCONNECT \?PRD12
|
|
BAND TYPE,127
|
|
ZERO? STACK \?CCL9
|
|
?PRD12: EQUAL? X,DCONNECT \?CND6
|
|
GET TBL,XDATA
|
|
FSET? STACK,OPENED \?CND6
|
|
?CCL9: MUL DIR,4
|
|
ADD GOOD-DIRS,STACK
|
|
COPYT TBL,STACK,-4
|
|
INC 'ANY
|
|
PRINTC SP
|
|
GET XLIST-NAMES,DIR
|
|
PRINT STACK
|
|
?CND6: IGRTR? 'DIR,I-NW \?PRG4
|
|
ADD GOOD-DIRS,2 >PTR
|
|
?PRG19: GETB PDIR-LIST,DIR
|
|
GETP HERE,STACK >TBL
|
|
ZERO? TBL /?CND21
|
|
GET TBL,XTYPE >TYPE
|
|
BAND TYPE,65280 >X
|
|
EQUAL? X,CONNECT,SCONNECT,X-EXIT /?CCL24
|
|
EQUAL? X,FCONNECT \?PRD27
|
|
BAND TYPE,127
|
|
ZERO? STACK \?CCL24
|
|
?PRD27: EQUAL? X,DCONNECT \?CND21
|
|
GET TBL,XDATA
|
|
FSET? STACK,OPENED \?CND21
|
|
?CCL24: INTBL? TYPE,GOOD-DIRS,8,132 >X \?CCL33
|
|
GET TBL,XROOM
|
|
INTBL? STACK,PTR,8,132 >X /?CND21
|
|
?CCL33: INC 'ANY
|
|
PRINTC SP
|
|
GET XLIST-NAMES,DIR
|
|
PRINT STACK
|
|
?CND21: IGRTR? 'DIR,11 \?PRG19
|
|
ZERO? ANY \?CND1
|
|
PRINTI " None"
|
|
?CND1: PRINTC SP
|
|
ICALL2 PRINTLINE,2
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SETUP-DBOX
|
|
SET 'DBOX-LINES,0
|
|
PUTB DBOX,0,SP
|
|
COPYT DBOX,DBOX+1,-1551
|
|
PUT DBOX,0,0
|
|
DIROUT D-TABLE-ON,DBOX
|
|
RFALSE
|
|
|
|
|
|
.FUNCT JUSTIFY-DBOX,MORE,LINE,BASE,LEN,PTR,CHAR,X,SOURCE,DEST,END,XLEN
|
|
DIROUT D-TABLE-OFF
|
|
GET DBOX,0 >LEN
|
|
SET 'LINE,DBOX-LINES
|
|
SET 'BASE,DBOX+2
|
|
MUL LINE,BOXWIDTH
|
|
ADD BASE,STACK >BASE
|
|
SUB BOXWIDTH,1 >END
|
|
?PRG1: ADD DBOX+2,LEN
|
|
GRTR? BASE,STACK /?REP2
|
|
INTBL? EOL,BASE,END,1 >PTR \?CCL7
|
|
SUB PTR,BASE >PTR
|
|
SET 'X,PTR
|
|
?PRG8: INC 'X
|
|
GETB BASE,X >CHAR
|
|
EQUAL? CHAR,EOL /?REP9
|
|
GRTR? CHAR,31 \?PRG8
|
|
?REP9: ADD BASE,X >SOURCE
|
|
ADD BASE,BOXWIDTH >DEST
|
|
EQUAL? SOURCE,DEST /?CND5
|
|
MUL LINE,BOXWIDTH
|
|
ADD STACK,X
|
|
SUB LEN,STACK >XLEN
|
|
COPYT SOURCE,DEST,XLEN
|
|
?PRG16: PUTB BASE,PTR,SP
|
|
IGRTR? 'PTR,END /?CND5
|
|
INC 'LEN
|
|
JUMP ?PRG16
|
|
?CCL7: SET 'PTR,BOXWIDTH
|
|
?PRG20: DLESS? 'PTR,0 /?CND5
|
|
GETB BASE,PTR >CHAR
|
|
EQUAL? CHAR,SP \?PRG20
|
|
EQUAL? PTR,END /?PRG20
|
|
ADD BASE,PTR >SOURCE
|
|
INC 'SOURCE
|
|
ADD BASE,BOXWIDTH >DEST
|
|
EQUAL? SOURCE,DEST /?CND5
|
|
MUL LINE,BOXWIDTH >XLEN
|
|
ADD XLEN,PTR
|
|
SUB LEN,STACK >XLEN
|
|
COPYT SOURCE,DEST,XLEN
|
|
?PRG30: IGRTR? 'PTR,END /?CND5
|
|
INC 'LEN
|
|
PUTB BASE,PTR,SP
|
|
JUMP ?PRG30
|
|
?CND5: ADD BASE,BOXWIDTH >BASE
|
|
IGRTR? 'LINE,24 \?PRG1
|
|
?REP2: SET 'DBOX-LINES,LINE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DISPLAY-DBOX,MORE,TLC,BASE,LINES
|
|
SET 'NEW-DBOX,0
|
|
SUB 12,MAX-DHEIGHT >TLC
|
|
SET 'BASE,DBOX+2
|
|
ZERO? DBOX-TOP /?CND1
|
|
MUL DBOX-TOP,BOXWIDTH
|
|
ADD BASE,STACK >BASE
|
|
?CND1: SET 'LINES,DHEIGHT
|
|
BTST IN-DBOX,SHOWING-STATS \?CCL5
|
|
SET 'LINES,MAX-DHEIGHT
|
|
JUMP ?CND3
|
|
?CCL5: SUB DBOX-LINES,DBOX-TOP
|
|
GRTR? STACK,DHEIGHT \?CND3
|
|
INC 'MORE
|
|
DEC 'LINES
|
|
?CND3: ICALL1 TO-TOP-WINDOW
|
|
COLOR FORE,BGND
|
|
ICALL DO-CURSET,TLC,2
|
|
EQUAL? HOST,APPLE-2C \?CCL9
|
|
PRINTC SP
|
|
JUMP ?CND7
|
|
?CCL9: ZERO? VT220 \?CND7
|
|
EQUAL? HOST,IBM /?CND7
|
|
HLIGHT H-INVERSE
|
|
?CND7: PRINTT BASE,BOXWIDTH,LINES
|
|
ZERO? DBOX-TOP /?CND13
|
|
ICALL SAY-MORE,TLC,TRUE-VALUE
|
|
?CND13: ZERO? MORE /?CND15
|
|
SUB 11,MAX-DHEIGHT
|
|
ADD DHEIGHT,STACK
|
|
ICALL2 SAY-MORE,STACK
|
|
?CND15: ICALL1 TO-BOTTOM-WINDOW
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SAY-MORE,Y,UP,X
|
|
COLOR GCOLOR,BGND
|
|
ICALL DO-CURSET,Y,2
|
|
EQUAL? HOST,APPLE-2C \?CND1
|
|
PRINTC SP
|
|
?CND1: PRINTI "[MORE]"
|
|
EQUAL? HOST,MACINTOSH \?CCL5
|
|
SUB BOXWIDTH,30
|
|
ICALL2 PRINT-SPACES,STACK
|
|
PRINTI "[Press "
|
|
ZERO? UP /?CCL8
|
|
PRINTC 92
|
|
JUMP ?CND6
|
|
?CCL8: PRINTC 47
|
|
?CND6: PRINTI " or "
|
|
FONT F-NEWFONT >X
|
|
ZERO? UP /?CCL11
|
|
PRINTC 92
|
|
JUMP ?CND9
|
|
?CCL11: PRINTC 93
|
|
?CND9: FONT F-DEFAULT >X
|
|
JUMP ?CND3
|
|
?CCL5: ZERO? VT220 \?CTR12
|
|
EQUAL? HOST,APPLE-2C,IBM \?CCL13
|
|
?CTR12: SUB BOXWIDTH,25
|
|
ICALL2 PRINT-SPACES,STACK
|
|
PRINTI "[Press "
|
|
FONT F-NEWFONT >X
|
|
ZERO? VT220 /?CCL18
|
|
SET 'X,93
|
|
ZERO? UP /?CND16
|
|
DEC 'X
|
|
JUMP ?CND16
|
|
?CCL18: EQUAL? HOST,APPLE-2C \?CCL22
|
|
SET 'X,74
|
|
ZERO? UP /?CND16
|
|
INC 'X
|
|
JUMP ?CND16
|
|
?CCL22: SET 'X,25
|
|
ZERO? UP /?CND16
|
|
DEC 'X
|
|
?CND16: PRINTC X
|
|
FONT F-DEFAULT >X
|
|
JUMP ?CND3
|
|
?CCL13: SUB BOXWIDTH,34
|
|
ICALL2 PRINT-SPACES,STACK
|
|
ZERO? UP /?CND27
|
|
PRINTI " "
|
|
?CND27: PRINTI "[Press "
|
|
ZERO? UP /?CCL31
|
|
PRINTI "UP"
|
|
JUMP ?CND29
|
|
?CCL31: PRINTI "DOWN"
|
|
?CND29: PRINTI " arrow"
|
|
?CND3: PRINTI " to scroll]"
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DESCRIBE-OBJECTS,TWO?,IT?,ANY?,CR,B,1ST?,OBJ,NXT,STR,X
|
|
ZERO? LIT? \?CCL3
|
|
ICALL1 TOO-DARK
|
|
RTRUE
|
|
?CCL3: FIRST? HERE >OBJ \TRUE
|
|
LOC WINNER >OBJ
|
|
EQUAL? OBJ,HERE /?CND5
|
|
FSET? OBJ,VEHICLE \?CND5
|
|
IN? OBJ,HERE \?CND5
|
|
MOVE OBJ,DUMMY-OBJECT
|
|
CALL2 SEE-ANYTHING-IN?,OBJ
|
|
ZERO? STACK /?CND5
|
|
PRINT TAB
|
|
PRINT YOU-SEE
|
|
ICALL2 CONTENTS,OBJ
|
|
ICALL2 ON-IN,OBJ
|
|
PRINT PERIOD
|
|
?CND5: FIRST? HERE >OBJ \?CND12
|
|
?PRG14: NEXT? OBJ >NXT /?BOGUS16
|
|
?BOGUS16: FSET? OBJ,NODESC /?CCL18
|
|
EQUAL? OBJ,WINNER \?CND17
|
|
?CCL18: MOVE OBJ,DUMMY-OBJECT
|
|
?CND17: SET 'OBJ,NXT
|
|
ZERO? OBJ \?PRG14
|
|
?CND12: FIRST? HERE >OBJ \?CND23
|
|
?PRG25: NEXT? OBJ >NXT /?BOGUS27
|
|
?BOGUS27: GETP OBJ,P?DESCFCN >STR
|
|
ZERO? STR /?CND28
|
|
SET 'DESCING,OBJ
|
|
PRINT TAB
|
|
ICALL STR,M-OBJDESC
|
|
CRLF
|
|
ICALL2 THIS-IS-IT,OBJ
|
|
MOVE OBJ,DUMMY-OBJECT
|
|
?CND28: SET 'OBJ,NXT
|
|
ZERO? OBJ \?PRG25
|
|
?CND23: SET '1ST?,1
|
|
FIRST? HERE >OBJ /?PRG33
|
|
?PRG33: ZERO? OBJ \?CND35
|
|
ZERO? 1ST? \?REP34
|
|
ZERO? IT? /?CND37
|
|
ZERO? TWO? \?CND37
|
|
ICALL2 THIS-IS-IT,OBJ
|
|
?CND37: PRINTI " here."
|
|
INC 'ANY?
|
|
?REP34: FIRST? X-OBJECT >OBJ \?CND69
|
|
?PRG71: INC 'ANY?
|
|
PRINTC SP
|
|
EQUAL? OBJ,GURDY \?CCL75
|
|
PRINTI "Within"
|
|
JUMP ?CND73
|
|
?CND35: NEXT? OBJ >NXT /?BOGUS43
|
|
?BOGUS43: ZERO? 1ST? /?CCL46
|
|
DEC '1ST?
|
|
PRINT TAB
|
|
ZERO? NXT /?CCL49
|
|
PRINT YOU-SEE
|
|
JUMP ?CND44
|
|
?CCL49: FSET? OBJ,PLURAL \?CCL51
|
|
PRINTI "There are "
|
|
JUMP ?CND44
|
|
?CCL51: PRINTI "There's "
|
|
JUMP ?CND44
|
|
?CCL46: ZERO? NXT /?CCL54
|
|
PRINTI ", "
|
|
JUMP ?CND44
|
|
?CCL54: PRINT AND
|
|
?CND44: SET 'DESCING,OBJ
|
|
ICALL2 PRINTA,OBJ
|
|
EQUAL? OBJ,GOBLET \?CND55
|
|
IN? BFLY,OBJ \?CND55
|
|
FSET? BFLY,LIVING \?CND55
|
|
INC 'B
|
|
PRINT WITH
|
|
ICALL2 PRINTA,BFLY
|
|
PRINT STR?493
|
|
REMOVE BFLY
|
|
?CND55: CALL2 SEE-INSIDE?,OBJ
|
|
ZERO? STACK /?CND60
|
|
CALL2 SEE-ANYTHING-IN?,OBJ
|
|
ZERO? STACK /?CND60
|
|
MOVE OBJ,X-OBJECT
|
|
?CND60: ZERO? IT? \?CCL66
|
|
ZERO? TWO? \?CCL66
|
|
SET 'IT?,OBJ
|
|
JUMP ?CND64
|
|
?CCL66: SET 'TWO?,TRUE-VALUE
|
|
SET 'IT?,FALSE-VALUE
|
|
?CND64: SET 'OBJ,NXT
|
|
JUMP ?PRG33
|
|
?CCL75: EQUAL? OBJ,ARCH \?CCL77
|
|
PRINTI "Under"
|
|
JUMP ?CND73
|
|
?CCL77: FSET? OBJ,SURFACE \?CCL79
|
|
PRINTI "On"
|
|
JUMP ?CND73
|
|
?CCL79: PRINTI "Inside"
|
|
?CND73: PRINTC SP
|
|
ICALL2 THE-PRINT,OBJ
|
|
PRINTI " you see "
|
|
ICALL2 CONTENTS,OBJ
|
|
PRINTC PER
|
|
NEXT? OBJ >OBJ /?PRG71
|
|
?CND69: ZERO? B /?CND82
|
|
MOVE BFLY,GOBLET
|
|
?CND82: ZERO? ANY? /?CND84
|
|
CRLF
|
|
?CND84: SET 'DESCING,FALSE-VALUE
|
|
ICALL MOVE-ALL,X-OBJECT,HERE
|
|
ICALL MOVE-ALL,DUMMY-OBJECT,HERE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SEE-ANYTHING-IN?,OBJ
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSO
|
|
?CND1: FIRST? OBJ >OBJ \FALSE
|
|
?PRG5: FSET? OBJ,NODESC /?CND7
|
|
EQUAL? OBJ,WINNER \TRUE
|
|
?CND7: NEXT? OBJ >OBJ /?PRG5
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SEE-INSIDE?,OBJ
|
|
ZERO? OBJ /FALSE
|
|
EQUAL? OBJ,WINNER,PLAYER /TRUE
|
|
FSET? OBJ,VEHICLE /TRUE
|
|
FSET? OBJ,SURFACE /TRUE
|
|
FSET? OBJ,PERSON /TRUE
|
|
FSET? OBJ,LIVING /TRUE
|
|
FSET? OBJ,CONTAINER \FALSE
|
|
FSET? OBJ,OPENED /TRUE
|
|
FSET? OBJ,TRANSPARENT /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT ACCESSIBLE?,OBJ,L
|
|
EQUAL? OBJ,FALSE-VALUE,NOT-HERE-OBJECT /FALSE
|
|
EQUAL? OBJ,PSEUDO-OBJECT \?CND1
|
|
EQUAL? LAST-PSEUDO-LOC,HERE /TRUE
|
|
RFALSE
|
|
?CND1: CALL2 META-LOC,OBJ >L
|
|
EQUAL? L,GLOBAL-OBJECTS /TRUE
|
|
LOC WINNER
|
|
EQUAL? L,WINNER,HERE,STACK \FALSE
|
|
CALL2 VISIBLE?,OBJ
|
|
ZERO? STACK /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT META-LOC,OBJ
|
|
?PRG1: ZERO? OBJ /FALSE
|
|
IN? OBJ,GLOBAL-OBJECTS \?CCL7
|
|
RETURN GLOBAL-OBJECTS
|
|
?CCL7: IN? OBJ,ROOMS \?CND3
|
|
RETURN OBJ
|
|
?CND3: LOC OBJ >OBJ
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT VISIBLE?,OBJ,L
|
|
EQUAL? OBJ,FALSE-VALUE,NOT-HERE-OBJECT /FALSE
|
|
EQUAL? OBJ,PSEUDO-OBJECT \?CCL5
|
|
EQUAL? LAST-PSEUDO-LOC,HERE /TRUE
|
|
RFALSE
|
|
?CCL5: LOC WINNER
|
|
EQUAL? OBJ,STACK /TRUE
|
|
LOC OBJ >L
|
|
EQUAL? L,FALSE-VALUE,GLOBAL-OBJECTS /FALSE
|
|
LOC WINNER
|
|
EQUAL? L,WINNER,STACK,HERE /TRUE
|
|
EQUAL? L,LOCAL-GLOBALS \?CCL15
|
|
CALL GLOBAL-IN?,HERE,OBJ
|
|
ZERO? STACK \TRUE
|
|
?CCL15: CALL2 SEE-INSIDE?,L
|
|
ZERO? STACK /FALSE
|
|
CALL2 VISIBLE?,L
|
|
ZERO? STACK /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DPRINT,O,X
|
|
GETP O,P?SDESC >X
|
|
ZERO? X /?CCL3
|
|
ICALL X,O
|
|
RTRUE
|
|
?CCL3: FSET? O,NOARTICLE \?CND1
|
|
GETP O,P?NAME-TABLE >X
|
|
ZERO? X /?CND1
|
|
ICALL2 PRINT-TABLE,X
|
|
RTRUE
|
|
?CND1: PRINTD O
|
|
RTRUE
|
|
|
|
|
|
.FUNCT THE-PRINT,O,X
|
|
ASSIGNED? 'O /?CND1
|
|
SET 'O,PRSO
|
|
?CND1: FSET? O,NOARTICLE /?CND3
|
|
PRINT LTHE
|
|
?CND3: ICALL2 DPRINT,O
|
|
RTRUE
|
|
|
|
|
|
.FUNCT CTHE-PRINT,O,X
|
|
ASSIGNED? 'O /?CND1
|
|
SET 'O,PRSO
|
|
?CND1: FSET? O,PROPER /?CND3
|
|
PRINT XTHE
|
|
?CND3: ICALL2 DPRINT,O
|
|
RTRUE
|
|
|
|
|
|
.FUNCT THEI-PRINT,X
|
|
FSET? PRSI,NOARTICLE /?CND1
|
|
PRINT LTHE
|
|
?CND1: ICALL2 DPRINT,PRSI
|
|
RTRUE
|
|
|
|
|
|
.FUNCT CTHEI-PRINT,X
|
|
FSET? PRSI,PROPER /?CND1
|
|
PRINT XTHE
|
|
?CND1: ICALL2 DPRINT,PRSI
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PRINTA,O,X
|
|
ASSIGNED? 'O /?CND1
|
|
SET 'O,PRSO
|
|
?CND1: FSET? O,NOARTICLE /?CND3
|
|
FSET? O,PROPER /?CTR5
|
|
FSET? O,PLURAL \?CCL6
|
|
FSET? O,PERSON \?CCL6
|
|
?CTR5: PRINT LTHE
|
|
JUMP ?CND3
|
|
?CCL6: FSET? O,VOWEL \?CCL12
|
|
PRINTI "an "
|
|
JUMP ?CND3
|
|
?CCL12: PRINTI "a "
|
|
?CND3: ICALL2 DPRINT,O
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PRINTCA,O,X
|
|
ASSIGNED? 'O /?CND1
|
|
SET 'O,PRSO
|
|
?CND1: FSET? O,NOARTICLE /?CND3
|
|
FSET? O,PROPER /?CTR5
|
|
FSET? O,PLURAL \?CCL6
|
|
FSET? O,PERSON \?CCL6
|
|
?CTR5: PRINT XTHE
|
|
JUMP ?CND3
|
|
?CCL6: FSET? O,VOWEL \?CCL12
|
|
PRINTI "An "
|
|
JUMP ?CND3
|
|
?CCL12: PRINT XA
|
|
?CND3: ICALL2 DPRINT,O
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-LANTERN,OBJ
|
|
FSET? OBJ,MUNGED \?CCL3
|
|
PRINTB W?BROKEN
|
|
PRINTC SP
|
|
JUMP ?CND1
|
|
?CCL3: FSET? OBJ,LIGHTED \?CCL5
|
|
PRINTB W?LIGHTED
|
|
PRINTC SP
|
|
JUMP ?CND1
|
|
?CCL5: FSET? OBJ,MAPPED /?CND1
|
|
PRINTB W?RUSTY
|
|
PRINTC SP
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-SHILL,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: FSET? OBJ,TOUCHED \?CND5
|
|
PRINTD OBJ
|
|
RTRUE
|
|
?CND5: PRINTI "piece of "
|
|
PRINTB W?DRIFTWOOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-SWORD,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-AXE,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DAGGER,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: FSET? OBJ,MUNGED \?CND5
|
|
PRINTB W?RUSTY
|
|
PRINTC SP
|
|
?CND5: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-AMULET,OBJ
|
|
FSET? AMULET,IDENTIFIED \?CND1
|
|
PRINTI "Amulet of "
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-PHASE,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: EQUAL? HERE,APLANE \?CND5
|
|
PRINTD OBJ
|
|
RTRUE
|
|
?CND5: PRINTD SHAPE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-JUNGLE-WAND,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINTI " lies in a clump of grass."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-MOOR-WAND,CONTEXT
|
|
PRINTI "The end of "
|
|
ICALL2 PRINTA,DESCING
|
|
PRINTI " sticks out of the mud."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-FOREST-WAND,CONTEXT
|
|
PRINTI "Somebody has left "
|
|
ICALL2 PRINTA,DESCING
|
|
PRINTI " lying across the path."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-CELLAR-WAND,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINTI " lies in a shadowy corner."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-TOWER-WAND,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINT STR?494
|
|
PRINTI "a corner."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-HALL-WAND,CONTEXT
|
|
PRINTI "The tip of "
|
|
ICALL2 PRINTA,DESCING
|
|
PRINT STR?495
|
|
PRINTI "rubble."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-TELE-WAND,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Sayonara"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-SLEEP-WAND,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Anesthesia"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-IO-WAND,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Eversion"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-LEV-WAND,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Levitation"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-BLAST-WAND,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Annihilation"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DISPEL-WAND,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "Dispel "
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-HELM,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "Pheehelm"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-HORSE,OBJ
|
|
FSET? HORSE,LIVING \?CCL3
|
|
PRINTB W?GRAY
|
|
JUMP ?CND1
|
|
?CCL3: PRINTB W?DEAD
|
|
?CND1: PRINTC SP
|
|
PRINTD HORSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-TRENCH,OBJ
|
|
EQUAL? HERE,ARCH12 \?CND1
|
|
PRINTI "minxhole"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-KEYS,OBJ,WORD
|
|
GETPT OBJ,P?ADJECTIVE
|
|
GET STACK,0 >WORD
|
|
CALL1 SEE-COLOR?
|
|
ZERO? STACK \?CND1
|
|
SET 'WORD,W?GRAY
|
|
?CND1: PRINTB WORD
|
|
PRINTC SP
|
|
PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-ARROW,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-CLOAK,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Stealth"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-PARASOL,OBJ
|
|
FSET? OBJ,MUNGED \?CCL3
|
|
PRINTB W?BROKEN
|
|
JUMP ?CND1
|
|
?CCL3: FSET? OBJ,OPENED \?CCL5
|
|
PRINTB W?OPEN
|
|
JUMP ?CND1
|
|
?CCL5: PRINTB W?CLOSED
|
|
?CND1: PRINTC SP
|
|
PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-WHISTLE,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Summoning"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-BFLY,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: FSET? OBJ,LIVING /?CND5
|
|
PRINTI "dead "
|
|
?CND5: FSET? OBJ,MUNGED \?CND7
|
|
PRINT STR?496
|
|
RTRUE
|
|
?CND7: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-GOBLET,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "Chalice of "
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-RING,OBJ
|
|
PRINTD OBJ
|
|
FSET? OBJ,IDENTIFIED \TRUE
|
|
PRINTI " of Shielding"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-SPADE,OBJ
|
|
FSET? OBJ,NAMED \?CND1
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
ZERO? INV-PRINTING? /TRUE
|
|
PRINT STHE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-SCABBARD,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "Sheath of Grueslayer"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DIAMOND,OBJ
|
|
PRINTB W?SNOWFLAKE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DO-PARTAY,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Mischief"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-BLESS-WEAPON,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Honing"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-BLESS-ARMOR,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Protection"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DO-FILFRE,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Fireworks"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DO-GOTO,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Recall"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-TOWER-SCROLL,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINT STR?494
|
|
PRINTI "shadow."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-FOREST-SCROLL,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINT STR?497
|
|
PRINTI "the underbrush."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-PLAIN-SCROLL,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINTI " is blowing against a clump of grass."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-MOOR-SCROLL,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINTI " lies trodden in the mud."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-JUNGLE-SCROLL,CONTEXT
|
|
PRINTI "The undergrowth nearly conceals "
|
|
ICALL2 PRINTA,DESCING
|
|
PRINTC PER
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-RENEWAL,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Renewal"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT RENEWAL-DESC,CONTEXT
|
|
ICALL2 PRINTCA,RENEWAL
|
|
PRINTI " lies trampled in the dust."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-PALIMP,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "scroll of Gating"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-STONE,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "Scrystone of "
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-WALL,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
EQUAL? OBJ,NWALL \?CCL5
|
|
PRINTI "Nor"
|
|
JUMP ?CND3
|
|
?CCL5: PRINTI "Sou"
|
|
?CND3: PRINTI "th Wall of "
|
|
GETP OBJ,P?NAME-TABLE
|
|
ICALL2 PRINT-TABLE,STACK
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-IQ-POTION,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "potion of Enlightenment"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-HEALING-POTION,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "potion of Healing"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-DEATH-POTION,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "potion of Death"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-MIGHT-POTION,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "potion of Might"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-FORGET-POTION,OBJ
|
|
FSET? OBJ,IDENTIFIED \?CND1
|
|
PRINTI "potion of Forgetfulness"
|
|
RTRUE
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-MOOR-POTION,CONTEXT
|
|
PRINTI "Some luckless fool has left "
|
|
ICALL2 PRINTA,DESCING
|
|
PRINTI " in the mud."
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-RUINS-POTION,CONTEXT
|
|
PRINTI "Someone else must have been here recently. There's "
|
|
ICALL2 PRINTA,DESCING
|
|
PRINT STR?498
|
|
RTRUE
|
|
|
|
|
|
.FUNCT KERBLAM
|
|
ICALL2 ITALICIZE,STR?499
|
|
PRINTI "! "
|
|
RFALSE
|
|
|
|
|
|
.FUNCT WHOOSH
|
|
ICALL2 ITALICIZE,STR?500
|
|
PRINTI "! "
|
|
RFALSE
|
|
|
|
|
|
.FUNCT ITALICIZE,STR,PTR,LEN,CHAR
|
|
SET 'PTR,2
|
|
PUT AUX-TABLE,0,0
|
|
DIROUT D-TABLE-ON,AUX-TABLE
|
|
PRINT STR
|
|
DIROUT D-TABLE-OFF
|
|
GET AUX-TABLE,0 >LEN
|
|
INC 'LEN
|
|
LESS? LEN,2 /TRUE
|
|
GETB 0,1
|
|
BTST STACK,8 \?PRG17
|
|
HLIGHT H-ITALIC
|
|
?PRG5: GETB AUX-TABLE,PTR >CHAR
|
|
EQUAL? HOST,ATARI-ST /?CCL9
|
|
EQUAL? CHAR,SP,PER,44 /?CTR8
|
|
EQUAL? CHAR,EXCLAM,63,59 /?CTR8
|
|
EQUAL? CHAR,58 \?CCL9
|
|
?CTR8: HLIGHT H-NORMAL
|
|
PRINTC CHAR
|
|
HLIGHT H-ITALIC
|
|
JUMP ?CND7
|
|
?CCL9: PRINTC CHAR
|
|
?CND7: EQUAL? PTR,LEN /?REP6
|
|
INC 'PTR
|
|
JUMP ?PRG5
|
|
?REP6: HLIGHT H-NORMAL
|
|
RTRUE
|
|
?PRG17: GETB AUX-TABLE,PTR >CHAR
|
|
GRTR? CHAR,96 \?CND19
|
|
LESS? CHAR,123 \?CND19
|
|
SUB CHAR,SP >CHAR
|
|
?CND19: PRINTC CHAR
|
|
EQUAL? PTR,LEN /TRUE
|
|
INC 'PTR
|
|
JUMP ?PRG17
|
|
|
|
|
|
.FUNCT NOUN-USED?,WORD1,WORD2,WORD3,O,I,OOF,IOF
|
|
ZERO? WORD1 /FALSE
|
|
INTBL? PRSA,R-VERBS,NR-VERBS >O \?CCL5
|
|
GET P-NAMW,1 >O
|
|
GET P-OFW,1 >OOF
|
|
GET P-NAMW,0 >I
|
|
GET P-OFW,0 >IOF
|
|
JUMP ?CND1
|
|
?CCL5: GET P-NAMW,0 >O
|
|
GET P-OFW,0 >OOF
|
|
GET P-NAMW,1 >I
|
|
GET P-OFW,1 >IOF
|
|
?CND1: ZERO? NOW-PRSI? \?PRD10
|
|
EQUAL? WORD1,O,OOF /?CTR7
|
|
?PRD10: ZERO? PRSI /?CCL8
|
|
ZERO? NOW-PRSI? /?CCL8
|
|
EQUAL? WORD1,I,IOF \?CCL8
|
|
?CTR7: RETURN WORD1
|
|
?CCL8: ZERO? WORD2 /FALSE
|
|
ZERO? NOW-PRSI? \?PRD21
|
|
EQUAL? WORD2,O,OOF /?CTR18
|
|
?PRD21: ZERO? PRSI /?CCL19
|
|
ZERO? NOW-PRSI? /?CCL19
|
|
EQUAL? WORD2,I,IOF \?CCL19
|
|
?CTR18: RETURN WORD2
|
|
?CCL19: ZERO? WORD3 /FALSE
|
|
ZERO? NOW-PRSI? \?PRD32
|
|
EQUAL? WORD3,O,OOF /?CTR29
|
|
?PRD32: ZERO? PRSI /FALSE
|
|
ZERO? NOW-PRSI? /FALSE
|
|
EQUAL? WORD3,I,IOF \FALSE
|
|
?CTR29: RETURN WORD3
|
|
|
|
|
|
.FUNCT ADJ-USED?,WORD1,WORD2,WORD3,O,I
|
|
ZERO? WORD1 /FALSE
|
|
INTBL? PRSA,R-VERBS,NR-VERBS >O \?CCL5
|
|
GET P-ADJW,1 >O
|
|
GET P-ADJW,0 >I
|
|
JUMP ?CND1
|
|
?CCL5: GET P-ADJW,0 >O
|
|
GET P-ADJW,1 >I
|
|
?CND1: ZERO? NOW-PRSI? \?PRD10
|
|
EQUAL? WORD1,O /?CTR7
|
|
?PRD10: ZERO? PRSI /?CCL8
|
|
ZERO? NOW-PRSI? /?CCL8
|
|
EQUAL? WORD1,I \?CCL8
|
|
?CTR7: RETURN WORD1
|
|
?CCL8: ZERO? WORD2 /FALSE
|
|
ZERO? NOW-PRSI? \?PRD21
|
|
EQUAL? WORD2,O /?CTR18
|
|
?PRD21: ZERO? PRSI /?CCL19
|
|
ZERO? NOW-PRSI? /?CCL19
|
|
EQUAL? WORD2,I \?CCL19
|
|
?CTR18: RETURN WORD2
|
|
?CCL19: ZERO? WORD3 /FALSE
|
|
ZERO? NOW-PRSI? \?PRD32
|
|
EQUAL? WORD3,O /?CTR29
|
|
?PRD32: ZERO? PRSI /FALSE
|
|
ZERO? NOW-PRSI? /FALSE
|
|
EQUAL? WORD3,I \FALSE
|
|
?CTR29: RETURN WORD3
|
|
|
|
|
|
.FUNCT REPLACE-ADJ?,OBJ,OLD,NEW,TBL,LEN
|
|
GETPT OBJ,P?ADJECTIVE >TBL
|
|
ZERO? TBL /FALSE
|
|
PTSIZE TBL
|
|
DIV STACK,2 >LEN
|
|
?PRG3: DLESS? 'LEN,0 /FALSE
|
|
GET TBL,LEN
|
|
EQUAL? STACK,OLD \?PRG3
|
|
PUT TBL,LEN,NEW
|
|
RTRUE
|
|
|
|
|
|
.FUNCT REPLACE-SYN?,OBJ,OLD,NEW,TBL,LEN
|
|
GETPT OBJ,P?SYNONYM >TBL
|
|
ZERO? TBL /FALSE
|
|
PTSIZE TBL
|
|
DIV STACK,2 >LEN
|
|
?PRG3: DLESS? 'LEN,0 /FALSE
|
|
GET TBL,LEN
|
|
EQUAL? STACK,OLD \?PRG3
|
|
PUT TBL,LEN,NEW
|
|
RTRUE
|
|
|
|
|
|
.FUNCT REPLACE-GLOBAL?,OBJ,OLD,NEW,TBL,LEN
|
|
GETPT OBJ,P?GLOBAL >TBL
|
|
ZERO? TBL /FALSE
|
|
PTSIZE TBL
|
|
DIV STACK,2 >LEN
|
|
?PRG3: DLESS? 'LEN,0 /FALSE
|
|
GET TBL,LEN
|
|
EQUAL? STACK,OLD \?PRG3
|
|
PUT TBL,LEN,NEW
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DISPLAY-STATS
|
|
SET 'BMODE,FALSE-VALUE
|
|
SET 'DHEIGHT,MAX-DHEIGHT
|
|
SET 'DBOX-TOP,0
|
|
SET 'DBOX-LINES,0
|
|
SET 'IN-DBOX,SHOWING-STATS
|
|
PUTB DBOX,0,SP
|
|
COPYT DBOX,DBOX+1,-1551
|
|
ICALL1 DISPLAY-DBOX
|
|
SUB 13,MAX-DHEIGHT
|
|
ICALL2 STATBARS,STACK
|
|
RFALSE
|
|
|
|
|
|
.FUNCT STATBARS,Y,X,N,STAT
|
|
ZERO? X \?CND1
|
|
SUB DWIDTH,BARWIDTH
|
|
DIV STACK,2
|
|
ADD STACK,1 >X
|
|
?CND1: ASSIGNED? 'N /?CND3
|
|
SET 'N,ARMOR-CLASS
|
|
?CND3: SET 'BARY,Y
|
|
SET 'BARX,X
|
|
ICALL1 TO-TOP-WINDOW
|
|
COLOR FORE,BGND
|
|
ICALL DO-CURSET,BARY,BARX
|
|
ADD N,1
|
|
PRINTT BAR-LABELS,LABEL-WIDTH,STACK
|
|
?PRG5: GET STATS,STAT
|
|
ICALL STAT-ROUTINE,STAT,STACK
|
|
IGRTR? 'STAT,N \?PRG5
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SHOW-STAT,STAT
|
|
ICALL1 TO-TOP-WINDOW
|
|
GET STATS,STAT
|
|
ICALL STAT-ROUTINE,STAT,STACK
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT BAR-NUMBER,STAT,VAL,Y
|
|
HLIGHT H-NORMAL
|
|
ADD STAT,BARY >Y
|
|
ADD BARX,13
|
|
CURSET Y,STACK
|
|
LESS? VAL,10 \?CCL3
|
|
PRINTI " "
|
|
JUMP ?CND1
|
|
?CCL3: LESS? VAL,100 \?CND1
|
|
PRINTC SP
|
|
?CND1: PRINTN VAL
|
|
RFALSE
|
|
|
|
|
|
.FUNCT RAWBAR,STAT,VAL,PTR,X,Y,Z
|
|
PUTB SLINE,0,BASE-CHAR
|
|
SUB 0,SWIDTH >X
|
|
COPYT SLINE,SLINE+1,X
|
|
ADD BASE-CHAR,BAR-RES >X
|
|
DIV VAL,BAR-RES >Y
|
|
SUB SWIDTH,1 >Z
|
|
SET 'PTR,1
|
|
?PRG1: GRTR? PTR,Y /?REP2
|
|
PUTB SLINE,PTR,X
|
|
IGRTR? 'PTR,Z \?PRG1
|
|
?REP2: MOD VAL,BAR-RES
|
|
ADD BASE-CHAR,STACK
|
|
PUTB SLINE,PTR,STACK
|
|
PUTB SLINE,0,LCAP
|
|
ADD SWIDTH,1
|
|
PUTB SLINE,STACK,RCAP
|
|
ADD STAT,BARY >Y
|
|
ADD BARX,LABEL-WIDTH >X
|
|
ICALL DO-CURSET,Y,X
|
|
FONT F-NEWFONT >Z
|
|
COLOR GCOLOR,BGND
|
|
ADD SWIDTH,2 >Z
|
|
PRINTT SLINE,Z
|
|
ADD Z,X
|
|
ICALL DO-CURSET,Y,STACK
|
|
FONT F-DEFAULT >Z
|
|
COLOR FORE,BGND
|
|
LESS? VAL,10 \?CND7
|
|
PRINTC SP
|
|
?CND7: PRINTN VAL
|
|
PRINTC 37
|
|
RFALSE
|
|
|
|
|
|
.FUNCT APPLE-STATS,CNT,X
|
|
ICALL1 SETUP-SLINE
|
|
?PRG1: GET STSTR,CNT
|
|
PRINT STACK
|
|
PRINTC 58
|
|
GET STATS,CNT >X
|
|
LESS? X,10 \?CND3
|
|
PRINTC 48
|
|
?CND3: PRINTN X
|
|
IGRTR? 'CNT,6 /?REP2
|
|
PRINTC SP
|
|
GRTR? DWIDTH,46 \?PRG1
|
|
PRINTC SP
|
|
JUMP ?PRG1
|
|
?REP2: ICALL1 CENTER-SLINE
|
|
ICALL2 SHOW-SLINE,2
|
|
RTRUE
|
|
|
|
|
|
.FUNCT UPDATE-STAT,DELTA,STAT,UPDATE-MAX,NEWRANK,NSTAT,OSTAT,MAX,OMAX,NLVL,OLVL,X
|
|
ASSIGNED? 'STAT /?CND1
|
|
SET 'STAT,ENDURANCE
|
|
?CND1: ZERO? DELTA /FALSE
|
|
GET STATS,STAT >OSTAT
|
|
ADD OSTAT,DELTA >NSTAT
|
|
LESS? NSTAT,0 \?CCL7
|
|
SET 'NSTAT,0
|
|
JUMP ?CND5
|
|
?CCL7: EQUAL? STAT,EXPERIENCE /?CND5
|
|
GRTR? NSTAT,STATMAX \?CND5
|
|
SET 'NSTAT,STATMAX
|
|
?CND5: EQUAL? OSTAT,NSTAT /FALSE
|
|
PUT STATS,STAT,NSTAT
|
|
GET MAXSTATS,STAT >OMAX
|
|
ZERO? UPDATE-MAX /?CND12
|
|
EQUAL? STAT,EXPERIENCE /?CND12
|
|
EQUAL? NSTAT,OMAX /?CND12
|
|
ADD DELTA,OMAX >MAX
|
|
LESS? MAX,0 \?CCL18
|
|
SET 'MAX,0
|
|
JUMP ?CND16
|
|
?CCL18: GRTR? MAX,STATMAX \?CND16
|
|
SET 'MAX,STATMAX
|
|
?CND16: PUT MAXSTATS,STAT,MAX
|
|
?CND12: EQUAL? NSTAT,OMAX /?CND20
|
|
SET 'NO-REFRESH,STAT
|
|
?CND20: EQUAL? STAT,EXPERIENCE \?CND22
|
|
CALL2 GET-LEVEL?,NSTAT >NLVL
|
|
CALL2 GET-LEVEL?,OSTAT >OLVL
|
|
GRTR? NLVL,OLVL /?CCL25
|
|
ZERO? NLVL \?CND22
|
|
EQUAL? OLVL,MAX-LEVEL \?CND22
|
|
?CCL25: ICALL1 UPGRADE-RANK
|
|
INC 'NEWRANK
|
|
?CND22: ZERO? SAY-STAT /?CND30
|
|
EQUAL? HOST,MACINTOSH /?CND32
|
|
HLIGHT H-BOLD
|
|
?CND32: PRINT TAB
|
|
PRINTI "[Your "
|
|
GET STAT-NAMES,STAT
|
|
PRINT STACK
|
|
SET 'X,S-BEEP
|
|
EQUAL? NSTAT,OMAX \?CCL36
|
|
PRINTI " is back to normal"
|
|
JUMP ?CND34
|
|
?CCL36: PRINTI " just went "
|
|
LESS? DELTA,0 \?CCL39
|
|
SET 'X,S-BOOP
|
|
PRINTB W?DOWN
|
|
JUMP ?CND34
|
|
?CCL39: PRINTB W?UP
|
|
?CND34: ZERO? NEWRANK /?CND40
|
|
PRINTI ". You have achieved the rank of "
|
|
ICALL1 ANNOUNCE-RANK
|
|
?CND40: PRINTI ".]"
|
|
CRLF
|
|
HLIGHT H-NORMAL
|
|
SOUND X
|
|
?CND30: ZERO? DMODE \?CCL44
|
|
ICALL1 UPPER-SLINE
|
|
JUMP ?CND42
|
|
?CCL44: ZERO? VT220 \?CCL46
|
|
ICALL1 APPLE-STATS
|
|
JUMP ?CND42
|
|
?CCL46: EQUAL? IN-DBOX,SHOWING-STATS \?CCL48
|
|
ZERO? NEWRANK /?CCL51
|
|
ICALL1 SHOW-RANK
|
|
ICALL1 TO-TOP-WINDOW
|
|
SET 'STAT,ENDURANCE
|
|
?PRG52: GET STATS,STAT
|
|
ICALL STAT-ROUTINE,STAT,STACK
|
|
IGRTR? 'STAT,ARMOR-CLASS \?PRG52
|
|
ICALL1 TO-BOTTOM-WINDOW
|
|
RTRUE
|
|
?CCL51: EQUAL? STAT,EXPERIENCE /TRUE
|
|
ICALL2 SHOW-STAT,STAT
|
|
JUMP ?CND42
|
|
?CCL48: ZERO? BMODE /?CND42
|
|
ZERO? NEWRANK \?CCL58
|
|
ZERO? STAT \?CND42
|
|
?CCL58: ICALL2 SHOW-STAT,ENDURANCE
|
|
?CND42: ZERO? NSTAT \TRUE
|
|
EQUAL? STAT,ENDURANCE,STRENGTH \TRUE
|
|
PRINT TAB
|
|
PRINTI "Your last ounce of "
|
|
GET STAT-NAMES,STAT
|
|
PRINT STACK
|
|
PRINTI " gives out"
|
|
ICALL1 JIGS-UP
|
|
RTRUE
|
|
|
|
|
|
.FUNCT GET-LEVEL?,VAL,LVL
|
|
?PRG1: GET THRESHOLDS,LVL
|
|
LESS? VAL,STACK \?CCL5
|
|
RETURN LVL
|
|
?CCL5: IGRTR? 'LVL,MAX-LEVEL \?PRG1
|
|
RFALSE
|
|
|
|
|
|
.FUNCT UPGRADE-RANK,TBL,O,N
|
|
SET 'TBL,STATS
|
|
?PRG1: GET TBL,ENDURANCE >O
|
|
SUB STATMAX,O
|
|
DIV STACK,10 >N
|
|
LESS? N,1 \?CND3
|
|
SET 'N,1
|
|
?CND3: ADD O,N >N
|
|
GRTR? N,STATMAX \?CCL7
|
|
SET 'N,STATMAX
|
|
JUMP ?CND5
|
|
?CCL7: LESS? N,1 \?CND5
|
|
SET 'N,1
|
|
?CND5: PUT TBL,ENDURANCE,N
|
|
EQUAL? TBL,MAXSTATS /FALSE
|
|
SET 'TBL,MAXSTATS
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT PRINT-TABLE,TBL,PTR,LEN
|
|
SET 'PTR,1
|
|
GETB TBL,0 >LEN
|
|
ZERO? LEN /FALSE
|
|
?PRG3: GETB TBL,PTR
|
|
PRINTC STACK
|
|
IGRTR? 'PTR,LEN \?PRG3
|
|
RFALSE
|
|
|
|
|
|
.FUNCT WATER-VANISH
|
|
ICALL1 VANISH
|
|
ICALL1 CTHE-PRINT
|
|
PRINT STR?501
|
|
PRINTR "water."
|
|
|
|
|
|
.FUNCT VANISH,OBJ
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSO
|
|
?CND1: BOR NEW-DBOX,SHOWING-ALL >NEW-DBOX
|
|
REMOVE OBJ
|
|
SET 'P-IT-OBJECT,NOT-HERE-OBJECT
|
|
RFALSE
|
|
|
|
|
|
.FUNCT LIGHT-SOURCE?,OBJ,LEN
|
|
FSET? HERE,INDOORS /?CND1
|
|
CALL1 PLAIN-ROOM?
|
|
ZERO? STACK \?CND1
|
|
RETURN SUN
|
|
?CND1: GET LIGHT-SOURCES,0 >LEN
|
|
?PRG4: GET LIGHT-SOURCES,LEN >OBJ
|
|
FSET? OBJ,LIGHTED \?CND6
|
|
CALL2 VISIBLE?,OBJ
|
|
ZERO? STACK /?CND6
|
|
RETURN OBJ
|
|
?CND6: DLESS? 'LEN,1 \?PRG4
|
|
CALL FIND-IN?,WINNER,LIGHTED >OBJ
|
|
ZERO? OBJ /?CCL13
|
|
RETURN OBJ
|
|
?CCL13: LOC WINNER
|
|
CALL FIND-IN?,STACK,LIGHTED >OBJ
|
|
RETURN OBJ
|
|
|
|
|
|
.FUNCT NEW-EXIT?,OBJ,DIR,TYPE,ROOM,DATA,PTR,X,TBL,BYTES
|
|
GETP OBJ,DIR >TBL
|
|
ZERO? TBL \?CND1
|
|
SET 'BYTES,4
|
|
ASSIGNED? 'DATA \?CND3
|
|
SET 'BYTES,6
|
|
?CND3: SET 'PTR,STORAGE
|
|
ADD STORAGE,BYTES >X
|
|
GRTR? X,STORAGE-SPACE \?CND5
|
|
ICALL2 SAY-ERROR,STR?502
|
|
RFALSE
|
|
?CND5: SET 'STORAGE,X
|
|
ADD FREE-STORAGE,PTR >TBL
|
|
PUTP OBJ,DIR,TBL
|
|
?CND1: PUT TBL,XTYPE,TYPE
|
|
ASSIGNED? 'ROOM \?CND7
|
|
PUT TBL,XROOM,ROOM
|
|
?CND7: ASSIGNED? 'DATA \TRUE
|
|
PUT TBL,XDATA,DATA
|
|
RTRUE
|
|
|
|
|
|
.FUNCT JUMPING-OFF?
|
|
EQUAL? PRSA,V?LEAP /TRUE
|
|
EQUAL? PRSA,V?DIVE \?CCL5
|
|
EQUAL? P-PRSA-WORD,V?DIVE /TRUE
|
|
?CCL5: EQUAL? PRSA,V?CLIMB-DOWN \FALSE
|
|
EQUAL? P-PRSA-WORD,W?JUMP,W?LEAP,W?HURDLE /TRUE
|
|
EQUAL? P-PRSA-WORD,W?VAULT,W?BOUND /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DONT-HAVE-WAND?,OBJ,W
|
|
IN? W,PLAYER /?CCL3
|
|
ICALL2 MUST-HOLD,W
|
|
PRINTR " to direct its power."
|
|
?CCL3: EQUAL? OBJ,W \?CCL5
|
|
PRINT CANT
|
|
PRINTB P-PRSA-WORD
|
|
PRINTC SP
|
|
ICALL2 THE-PRINT,W
|
|
PRINTR " at itself."
|
|
?CCL5: CALL2 NO-MAGIC-HERE?,W
|
|
ZERO? STACK /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT MUST-HOLD,OBJ
|
|
PRINTI "You must be holding "
|
|
ICALL2 THE-PRINT,OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT CANT-REACH-WHILE-IN?,OBJ1,OBJ2,X
|
|
EQUAL? OBJ1,FALSE-VALUE,OBJ2 /FALSE
|
|
CALL GLOBAL-IN?,HERE,OBJ1
|
|
ZERO? STACK \FALSE
|
|
IN? OBJ1,HERE \FALSE
|
|
INTBL? PRSA,TOUCHVERBS,NTOUCHES >X /?CTR6
|
|
EQUAL? PRSA,V?THRUST \FALSE
|
|
EQUAL? OBJ1,PRSO,LAST-MONSTER \FALSE
|
|
?CTR6: ICALL2 CANT-REACH,OBJ1
|
|
PRINTI " while you're "
|
|
EQUAL? OBJ2,ARCH \?CCL16
|
|
PRINTB W?UNDER
|
|
JUMP ?CND14
|
|
?CCL16: EQUAL? OBJ2,DACT \?CCL18
|
|
PRINTB W?ON
|
|
JUMP ?CND14
|
|
?CCL18: EQUAL? OBJ2,BUSH \?CCL20
|
|
PRINTB W?BEHIND
|
|
JUMP ?CND14
|
|
?CCL20: PRINTB W?IN
|
|
?CND14: PRINTC SP
|
|
ICALL2 THE-PRINT,OBJ2
|
|
PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT CANT-REACH,OBJ
|
|
PRINT CANT
|
|
PRINTI "quite reach "
|
|
ICALL2 THE-PRINT,OBJ
|
|
RFALSE
|
|
|
|
|
|
.FUNCT NO-MAGIC-HERE?,OBJ
|
|
IN? PLAYER,ARCH /?CND1
|
|
EQUAL? ATIME,PRESENT \?CND1
|
|
EQUAL? HERE,IN-CABIN,IN-FROON,IN-GARDEN /?CND1
|
|
CALL1 GRUE-ROOM?
|
|
ZERO? STACK \?CND1
|
|
EQUAL? OBJ,GURDY /?CCL6
|
|
CALL1 PLAIN-ROOM?
|
|
ZERO? STACK \?CND1
|
|
?CCL6: EQUAL? HERE,IN-SKY \?CCL9
|
|
EQUAL? ABOVE,OCAVES /?CND1
|
|
?CCL9: EQUAL? OBJ,PALIMP /FALSE
|
|
EQUAL? HERE,APLANE,IN-SPLENDOR \FALSE
|
|
?CND1: ICALL2 SPUTTERS,OBJ
|
|
ICALL1 INFLUENCE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SPUTTERS,OBJ
|
|
ICALL2 CTHE-PRINT,OBJ
|
|
PRINTI " sputters ineffectually. "
|
|
RTRUE
|
|
|
|
|
|
.FUNCT INFLUENCE
|
|
PRINTR "A nearby influence must be blocking its Magick."
|
|
|
|
|
|
.FUNCT SEE-COLOR?
|
|
CALL1 PLAIN-ROOM?
|
|
ZERO? STACK /TRUE
|
|
FSET? HERE,SEEN /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT GRUE-ROOM?,X
|
|
GETB GRUE-ROOMS,0 >X
|
|
INTBL? HERE,GRUE-ROOMS+1,X,1 >X /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT PLAIN-ROOM?,RM,X
|
|
ASSIGNED? 'RM /?CND1
|
|
SET 'RM,HERE
|
|
?CND1: EQUAL? RM,IN-FARM,ROSE-ROOM /TRUE
|
|
GETB PLAIN-ROOMS,0 >X
|
|
INTBL? RM,PLAIN-ROOMS+1,X,1 >X /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT GROUND-WORD
|
|
FSET? HERE,INDOORS \?CND1
|
|
PRINTB W?FLOOR
|
|
RFALSE
|
|
?CND1: PRINTB W?GROUND
|
|
RFALSE
|
|
|
|
|
|
.FUNCT VIEW-MONSTER,CONTEXT,X
|
|
FSET? DESCING,SLEEPING \?CCL3
|
|
ICALL2 CTHE-PRINT,DESCING
|
|
PRINTI " lies stunned upon the "
|
|
ICALL1 GROUND-WORD
|
|
PRINTC PER
|
|
RTRUE
|
|
?CCL3: FSET? DESCING,SURPRISED \?CND1
|
|
GETP DESCING,P?EXIT-STR >X
|
|
FSET? DESCING,SEEN /?CCL6
|
|
ZERO? X \?CND5
|
|
?CCL6: ICALL2 CTHE-PRINT,DESCING
|
|
PRINTI " is waiting for you."
|
|
RTRUE
|
|
?CND5: FSET DESCING,SEEN
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINT SIS
|
|
PRINT X
|
|
PRINTC PER
|
|
RTRUE
|
|
?CND1: RANDOM 100 >X
|
|
LESS? X,33 \?CCL11
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINTI " is attacking you"
|
|
JUMP ?CND9
|
|
?CCL11: LESS? X,67 \?CCL13
|
|
PRINTI "You're being attacked by "
|
|
ICALL2 PRINTA,DESCING
|
|
JUMP ?CND9
|
|
?CCL13: PRINTI "You're under attack by "
|
|
ICALL2 PRINTA,DESCING
|
|
?CND9: PRINTC 33
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DARK-MOVES
|
|
CALL2 PICK-NEXT,DARK-MOVINGS
|
|
PRINT STACK
|
|
PRINTI " in the darkness"
|
|
RANDOM 100
|
|
LESS? 50,STACK /?CND1
|
|
PRINTI " nearby"
|
|
?CND1: PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT OUCH,OBJ,DAMAGE
|
|
ZERO? STATIC \?CND1
|
|
RANDOM 100
|
|
LESS? 25,STACK /?CND1
|
|
PRINTI ". "
|
|
CALL2 PICK-NEXT,OUCHES
|
|
PRINT STACK
|
|
?CND1: PRINTC 33
|
|
CRLF
|
|
CALL MSPARK?,OBJ,DAMAGE
|
|
ICALL2 UPDATE-STAT,STACK
|
|
RTRUE
|
|
|
|
|
|
.FUNCT STILL-SLEEPING?,OBJ
|
|
FSET? OBJ,SLEEPING \?CND1
|
|
SET 'LAST-MONSTER-DIR,-1
|
|
SET 'ATTACK-MODE,NORMAL-ATTACK
|
|
PRINT TAB
|
|
FSET? OBJ,NEUTRALIZED \?CCL5
|
|
FCLEAR OBJ,NEUTRALIZED
|
|
ICALL2 CTHE-PRINT,OBJ
|
|
PRINTI " blinks its eyes, yawns and staggers with groggy impotence"
|
|
JUMP ?CND3
|
|
?CCL5: BOR NEW-DBOX,SHOWING-ROOM >NEW-DBOX
|
|
FCLEAR OBJ,SLEEPING
|
|
ICALL REPLACE-ADJ?,OBJ,W?STUNNED,W?AWAKE
|
|
ICALL2 CTHE-PRINT,OBJ
|
|
PRINTI " shakes itself out of its stupor"
|
|
?CND3: PRINT PERIOD
|
|
ICALL2 TOPPLED?,OBJ
|
|
RTRUE
|
|
?CND1: ICALL2 NEXT-ENDURANCE?,OBJ
|
|
RFALSE
|
|
|
|
|
|
.FUNCT NEXT-ENDURANCE?,OBJ,X,MAX,CHANGE
|
|
GETP OBJ,P?ENDURANCE >X
|
|
FSET? OBJ,STRICKEN \?CND1
|
|
FCLEAR OBJ,STRICKEN
|
|
RETURN X
|
|
?CND1: GETP OBJ,P?EMAX >MAX
|
|
GRTR? MAX,X /?CCL4
|
|
RETURN X
|
|
?CCL4: MUL 2,MAX
|
|
DIV STACK,100 >CHANGE
|
|
LESS? CHANGE,1 \?CND5
|
|
SET 'CHANGE,1
|
|
?CND5: ADD X,CHANGE >X
|
|
GRTR? X,MAX \?CND7
|
|
SET 'X,MAX
|
|
?CND7: PUTP OBJ,P?ENDURANCE,X
|
|
RETURN X
|
|
|
|
|
|
.FUNCT WHIRLS,OBJ
|
|
ICALL2 CTHE-PRINT,OBJ
|
|
PRINTI " whirls to face you!"
|
|
CRLF
|
|
ICALL2 TOPPLED?,SNIPE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TOPPLED?,OBJ
|
|
FSET? DACT,MUNGED /FALSE
|
|
IN? PLAYER,SADDLE \?CCL5
|
|
IN? SADDLE,DACT \?CCL5
|
|
SET 'P-WALK-DIR,FALSE-VALUE
|
|
SET 'OLD-HERE,FALSE-VALUE
|
|
LOC DACT
|
|
MOVE PLAYER,STACK
|
|
ICALL EXIT-DACT,OBJ,STR?503,STR?504
|
|
RTRUE
|
|
?CCL5: CALL2 VISIBLE?,DACT
|
|
ZERO? STACK /FALSE
|
|
ICALL EXIT-DACT,OBJ,STR?505,STR?506
|
|
RTRUE
|
|
|
|
|
|
.FUNCT EXIT-DACT,OBJ,STR1,STR2
|
|
FCLEAR DACT,NODESC
|
|
BOR NEW-DBOX,SHOWING-ROOM >NEW-DBOX
|
|
REMOVE DACT
|
|
PRINT TAB
|
|
ICALL2 CTHE-PRINT,DACT
|
|
FSET? DACT,SLEEPING \?CND1
|
|
FCLEAR DACT,SLEEPING
|
|
PRINTI " shakes himself awake,"
|
|
?CND1: PRINTI " takes one good look at "
|
|
ICALL2 THE-PRINT,OBJ
|
|
PRINTI " and decides that he doesn't want to "
|
|
PRINT STR1
|
|
PRINTI " anymore. Before you can think or move, you find yourself "
|
|
PRINT STR2
|
|
PRINTR ", with a cowardly shadow soaring out of sight overhead."
|
|
|
|
|
|
.FUNCT SEE-MONSTER,OBJ
|
|
SET 'LAST-MONSTER,OBJ
|
|
FCLEAR OBJ,SURPRISED
|
|
RFALSE
|
|
|
|
|
|
.FUNCT MONSTER-STRIKES?,OBJ,DAMAGE,STR,CHANCE,X
|
|
ICALL2 SEE-MONSTER,OBJ
|
|
GETP OBJ,P?STRENGTH >STR
|
|
LESS? STR,1 /FALSE
|
|
FSET OBJ,STRICKEN
|
|
SET 'CHANCE,12
|
|
EQUAL? ATTACK-MODE,PARRYING /?CND3
|
|
GETP OBJ,P?DEXTERITY >CHANCE
|
|
ZERO? ATTACK-MODE \?CND5
|
|
DIV CHANCE,2 >CHANCE
|
|
?CND5: MUL CHANCE,45
|
|
DIV STACK,100 >CHANCE
|
|
ADD CHANCE,MIN-HIT-PROB >CHANCE
|
|
GRTR? CHANCE,MAX-HIT-PROB \?CND3
|
|
SET 'CHANCE,MAX-HIT-PROB
|
|
?CND3: SET 'ATTACK-MODE,NORMAL-ATTACK
|
|
RANDOM 100
|
|
LESS? CHANCE,STACK /FALSE
|
|
GET STATS,ARMOR-CLASS
|
|
SUB STATMAX,STACK >DAMAGE
|
|
MUL DAMAGE,STR
|
|
ADD STACK,99
|
|
DIV STACK,100 >DAMAGE
|
|
LESS? DAMAGE,2 \?CCL14
|
|
SET 'DAMAGE,1
|
|
JUMP ?CND12
|
|
?CCL14: RANDOM DAMAGE >DAMAGE
|
|
?CND12: ZERO? AUTO /?CND15
|
|
ICALL1 BMODE-ON
|
|
?CND15: SUB 0,DAMAGE
|
|
RSTACK
|
|
|
|
|
|
.FUNCT MOVE-MONSTER?,OBJ,UD,L,RLIST,RLEN,CNT,DIR,TBL,DEST,X,BRIGHT,FEAR
|
|
FSET? OBJ,SLEEPING \?CND1
|
|
FCLEAR OBJ,SLEEPING
|
|
FCLEAR OBJ,STRICKEN
|
|
FCLEAR OBJ,NEUTRALIZED
|
|
RFALSE
|
|
?CND1: FSET OBJ,SURPRISED
|
|
ICALL2 NEXT-ENDURANCE?,OBJ
|
|
LOC OBJ >L
|
|
LOC SCARE3 >FEAR
|
|
GETP OBJ,P?HABITAT >RLIST
|
|
GETB RLIST,0 >RLEN
|
|
INC 'RLIST
|
|
SET 'CNT,1
|
|
SET 'DIR,P?NORTH
|
|
?PRG3: GETP L,DIR >TBL
|
|
ZERO? TBL /?CND5
|
|
GET TBL,XTYPE
|
|
BAND STACK,65280
|
|
EQUAL? STACK,CONNECT,SCONNECT,X-EXIT \?CND5
|
|
GET TBL,XROOM >DEST
|
|
INTBL? DEST,RLIST,RLEN,1 >X \?CND5
|
|
EQUAL? OBJ,GRUE \?CCL9
|
|
CALL2 IS-LIT?,DEST
|
|
ZERO? STACK \?CND5
|
|
?CCL9: ZERO? LAST-MONSTER \?CND14
|
|
CALL2 WEARING-MAGIC?,CLOAK
|
|
ZERO? STACK \?CND14
|
|
EQUAL? DEST,HERE \?CND14
|
|
EQUAL? DEST,FEAR /?CND14
|
|
SET 'CNT,2
|
|
PUT GOOD-DIRS,2,DIR
|
|
JUMP ?REP4
|
|
?CND14: EQUAL? DEST,FEAR /?CND5
|
|
INC 'CNT
|
|
PUT GOOD-DIRS,CNT,DIR
|
|
?CND5: DLESS? 'DIR,P?NW \?PRG3
|
|
?REP4: ZERO? UD /?CND24
|
|
SET 'DIR,P?UP
|
|
?PRG26: GETP L,DIR >TBL
|
|
ZERO? TBL /?CND28
|
|
GET TBL,XTYPE
|
|
BAND STACK,65280
|
|
EQUAL? STACK,CONNECT,SCONNECT \?CND28
|
|
GET TBL,XROOM >DEST
|
|
INTBL? DEST,RLIST,RLEN,1 >X \?CND28
|
|
ZERO? LAST-MONSTER \?CND33
|
|
CALL2 WEARING-MAGIC?,CLOAK
|
|
ZERO? STACK \?CND33
|
|
EQUAL? DEST,HERE \?CND33
|
|
SET 'CNT,2
|
|
PUT GOOD-DIRS,2,DIR
|
|
?CND24: EQUAL? CNT,1 /FALSE
|
|
EQUAL? CNT,2 \?CCL43
|
|
GET GOOD-DIRS,2 >DIR
|
|
GETP L,DIR
|
|
GET STACK,XROOM >DEST
|
|
JUMP ?CND39
|
|
?CND33: INC 'CNT
|
|
PUT GOOD-DIRS,CNT,DIR
|
|
?CND28: EQUAL? DIR,P?DOWN /?CND24
|
|
SET 'DIR,P?DOWN
|
|
JUMP ?PRG26
|
|
?CCL43: GETP OBJ,P?LAST-LOC >X
|
|
PUT GOOD-DIRS,0,CNT
|
|
PUT GOOD-DIRS,1,0
|
|
?PRG44: CALL2 PICK-ONE,GOOD-DIRS >DIR
|
|
GETP L,DIR
|
|
GET STACK,XROOM >DEST
|
|
EQUAL? DEST,X /?PRG44
|
|
?CND39: ZERO? LAST-MONSTER /?CND48
|
|
EQUAL? DEST,HERE /FALSE
|
|
?CND48: MOVE OBJ,DEST
|
|
PUTP OBJ,P?LAST-LOC,DEST
|
|
EQUAL? DEST,HERE \FALSE
|
|
ZERO? LIT? /?CND51
|
|
BOR NEW-DBOX,SHOWING-ROOM >NEW-DBOX
|
|
?CND51: EQUAL? DIR,P?UP,P?DOWN /?CND55
|
|
ADD DIR,4 >DIR
|
|
GRTR? DIR,P?NORTH \?CND57
|
|
SUB DIR,8 >DIR
|
|
?CND57: SET 'LAST-MONSTER-DIR,DIR
|
|
?CND55: ICALL2 THIS-IS-IT,OBJ
|
|
SET 'LAST-MONSTER,OBJ
|
|
FCLEAR OBJ,SURPRISED
|
|
EQUAL? DIR,P?UP \?CCL61
|
|
SET 'LAST-MONSTER-DIR,P?DOWN
|
|
RETURN W?UP
|
|
?CCL61: EQUAL? DIR,P?DOWN \?CND59
|
|
SET 'LAST-MONSTER-DIR,P?UP
|
|
RETURN W?DOWN
|
|
?CND59: SUB DIR,P?NORTH
|
|
SUB 0,STACK
|
|
GET DIR-NAMES,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT NEXT-MONSTER,OBJ,RLIST,LEN,CNT,X,RM
|
|
ZERO? OBJ /FALSE
|
|
GETP OBJ,P?HABITAT >RLIST
|
|
GETB RLIST,0 >LEN
|
|
SET 'X,LEN
|
|
SET 'CNT,1
|
|
?PRG3: GETB RLIST,X >RM
|
|
EQUAL? RM,HERE /?CND5
|
|
EQUAL? OBJ,GRUE \?CCL7
|
|
FSET? RM,LIGHTED /?CND5
|
|
?CCL7: FSET? RM,TOUCHED /?CND5
|
|
INC 'CNT
|
|
PUT AUX-TABLE,CNT,RM
|
|
?CND5: DLESS? 'X,1 \?PRG3
|
|
EQUAL? CNT,1 \?CCL15
|
|
?PRG16: RANDOM LEN
|
|
GETB RLIST,STACK >RM
|
|
EQUAL? RM,HERE /?PRG16
|
|
EQUAL? OBJ,GRUE \?CND13
|
|
FSET? RM,LIGHTED /?PRG16
|
|
JUMP ?CND13
|
|
?CCL15: EQUAL? CNT,2 \?CCL25
|
|
GET AUX-TABLE,2 >RM
|
|
JUMP ?CND13
|
|
?CCL25: PUT AUX-TABLE,0,CNT
|
|
PUT AUX-TABLE,1,0
|
|
CALL2 PICK-ONE,AUX-TABLE >RM
|
|
?CND13: MOVE OBJ,RM
|
|
FSET OBJ,SURPRISED
|
|
PUTP OBJ,P?LAST-LOC,RM
|
|
GETP OBJ,P?LIFE
|
|
ICALL2 QUEUE,STACK
|
|
RFALSE
|
|
|
|
|
|
.FUNCT V-SHIT
|
|
ICALL PERFORM,V?HIT,PRSI,PRSO
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PRE-HIT,OBJ,X
|
|
CALL1 DARKFIGHT?
|
|
ZERO? STACK \TRUE
|
|
ZERO? PRSI \FALSE
|
|
SET 'PRSI,HANDS
|
|
FIRST? WINNER >OBJ \?CND5
|
|
?PRG7: FSET? OBJ,WIELDED \?CCL11
|
|
SET 'PRSI,OBJ
|
|
JUMP ?CND5
|
|
?CCL11: FSET? OBJ,WEAPON \?CND9
|
|
SET 'PRSI,OBJ
|
|
?CND9: NEXT? OBJ >OBJ /?PRG7
|
|
?CND5: EQUAL? PRSI,HANDS /FALSE
|
|
PRINTI "[with "
|
|
ICALL1 THEI-PRINT
|
|
PRINT BRACKET
|
|
RFALSE
|
|
|
|
|
|
.FUNCT V-PUNCH
|
|
ICALL PERFORM,V?HIT,PRSO,HANDS
|
|
RTRUE
|
|
|
|
|
|
.FUNCT V-HIT,MODE
|
|
SET 'MODE,NORMAL-ATTACK
|
|
EQUAL? P-PRSA-WORD,W?THRUST \?CND1
|
|
SET 'MODE,THRUSTING
|
|
?CND1: ICALL2 HIT-MONSTER,MODE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT V-THRUST
|
|
CALL2 PRACTICE?,W?THRUST
|
|
ZERO? STACK \TRUE
|
|
ICALL2 HIT-MONSTER,THRUSTING
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DARKFIGHT?
|
|
ZERO? LIT? \FALSE
|
|
EQUAL? PRSO,GRUE,URGRUE \?CND4
|
|
CALL2 WEARING-MAGIC?,HELM
|
|
ZERO? STACK \FALSE
|
|
?CND4: ICALL1 TOO-DARK
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PRACTICE?,WRD
|
|
ZERO? PRSO \?CND1
|
|
ZERO? LAST-MONSTER \?CND3
|
|
PRINTI "You practice "
|
|
PRINTB WRD
|
|
PRINTI "ing "
|
|
ZERO? LIT? \?CND5
|
|
PRINTI "in the dark "
|
|
?CND5: PRINTR "for a few moments."
|
|
?CND3: SET 'PRSO,LAST-MONSTER
|
|
?CND1: CALL1 DARKFIGHT?
|
|
RSTACK
|
|
|
|
|
|
.FUNCT V-PARRY
|
|
CALL2 PRACTICE?,W?PARRY
|
|
ZERO? STACK \TRUE
|
|
FSET? PRSO,LIVING \?CCL4
|
|
FSET? PRSO,MONSTER \?CCL4
|
|
FSET? PRSO,SLEEPING \?CND3
|
|
?CCL4: ICALL1 CTHE-PRINT
|
|
PRINTI " isn't attacking you"
|
|
PRINT AT-MOMENT
|
|
RTRUE
|
|
?CND3: SET 'ATTACK-MODE,PARRYING
|
|
SET 'LAST-MONSTER-DIR,FALSE-VALUE
|
|
IN? PLAYER,MAW \?CND8
|
|
IN? PRSO,MAW /?CND8
|
|
ICALL1 CTHE-PRINT
|
|
PRINTR " can't seem to reach you."
|
|
?CND8: PRINTI "You leap away from "
|
|
ICALL1 THE-PRINT
|
|
PRINTR "'s attack."
|
|
|
|
|
|
.FUNCT HARMLESS,OBJ
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSO
|
|
?CND1: ICALL2 CTHE-PRINT,OBJ
|
|
PRINTI " obviously means you no harm; "
|
|
GET STATS,COMPASSION
|
|
LESS? STACK,15 \?CCL5
|
|
PRINTI "even your meager compassion is enough to stay "
|
|
JUMP ?CND3
|
|
?CCL5: PRINTI "compassion stays "
|
|
?CND3: PRINTD HANDS
|
|
PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT HIT-MONSTER,MODE,STR,DAM,L,MEND,PCENT,MIN,X
|
|
ASSIGNED? 'MODE /?CND1
|
|
SET 'MODE,NORMAL-ATTACK
|
|
?CND1: CALL1 DARKFIGHT?
|
|
ZERO? STACK \TRUE
|
|
FSET? PRSO,LIVING /?CCL7
|
|
PRINTI "Attacking "
|
|
ICALL1 THE-PRINT
|
|
EQUAL? PRSI,FALSE-VALUE,HANDS /?CND8
|
|
PRINT WITH
|
|
ICALL2 PRINTA,PRSI
|
|
?CND8: ICALL1 WONT-HELP
|
|
RTRUE
|
|
?CCL7: FSET? PRSO,MONSTER /?CND3
|
|
ICALL1 HARMLESS
|
|
RTRUE
|
|
?CND3: SET 'ATTACK-MODE,MODE
|
|
ZERO? PRSI \?CND11
|
|
CALL1 PRE-HIT
|
|
ZERO? STACK \TRUE
|
|
?CND11: LOC PLAYER >L
|
|
IN? PRSO,L /?CCL17
|
|
PRINT CANT
|
|
PRINTI "quite reach "
|
|
ICALL1 THE-PRINT
|
|
PRINT AT-MOMENT
|
|
RTRUE
|
|
?CCL17: EQUAL? PRSO,CORBIES \?CCL19
|
|
ICALL1 CORBIES-STAY-AWAY
|
|
RTRUE
|
|
?CCL19: EQUAL? PRSO,URGRUE \?CCL21
|
|
ICALL1 HOPELESS
|
|
RTRUE
|
|
?CCL21: EQUAL? PRSO,DUST \?CCL23
|
|
ICALL1 HIT-BUNNIES
|
|
RTRUE
|
|
?CCL23: EQUAL? PRSO,SHAPE \?CCL25
|
|
ICALL2 TOUCH-SHAPE-WITH,PRSI
|
|
RTRUE
|
|
?CCL25: EQUAL? PRSI,PHASE \?CCL27
|
|
EQUAL? HERE,APLANE /?CCL27
|
|
ICALL1 PHASE-WHOOSH
|
|
RTRUE
|
|
?CCL27: EQUAL? PRSO,ASUCKER,BSUCKER,CSUCKER \?CCL31
|
|
ICALL TOUCH-SUCKER-WITH,PRSO,PRSI
|
|
RTRUE
|
|
?CCL31: EQUAL? PRSO,DEAD \?CND15
|
|
ICALL2 TOUCH-DEAD-WITH,PRSI
|
|
RTRUE
|
|
?CND15: GET STATS,LUCK >L
|
|
GET STATS,STRENGTH >STR
|
|
SET 'NO-REFRESH,ENDURANCE
|
|
SET 'PCENT,MAX-HIT-PROB
|
|
FSET? PRSO,SLEEPING /?CND33
|
|
GET STATS,DEXTERITY >PCENT
|
|
LESS? PCENT,MAX-HIT-PROB \?CND33
|
|
LESS? PCENT,MIN-HIT-PROB \?CND37
|
|
SET 'PCENT,MIN-HIT-PROB
|
|
?CND37: SUB MAX-HIT-PROB,PCENT
|
|
MUL L,STACK
|
|
DIV STACK,100 >X
|
|
LESS? X,1 /?CND33
|
|
ADD PCENT,X >PCENT
|
|
?CND33: EQUAL? MODE,THRUSTING \?CCL43
|
|
SET 'PCENT,MAX-HIT-PROB
|
|
JUMP ?CND41
|
|
?CCL43: GRTR? PCENT,MAX-HIT-PROB \?CCL45
|
|
SET 'PCENT,MAX-HIT-PROB
|
|
JUMP ?CND41
|
|
?CCL45: LESS? PCENT,MIN-HIT-PROB \?CND41
|
|
SET 'PCENT,MIN-HIT-PROB
|
|
?CND41: RANDOM 100
|
|
LESS? PCENT,STACK /?CND47
|
|
CALL SPARK-TO?,PRSI,PRSO
|
|
ZERO? STACK /?CND49
|
|
PRINT TAB
|
|
?CND49: GETP PRSO,P?ENDURANCE >MEND
|
|
LESS? MEND,1 /FALSE
|
|
GRTR? STR,1 \?CND53
|
|
RANDOM STR >DAM
|
|
?CND53: GET STATS,LUCK
|
|
MUL STACK,DAM
|
|
DIV STACK,100 >X
|
|
LESS? X,1 \?CND55
|
|
SET 'X,1
|
|
?CND55: ADD DAM,X >DAM
|
|
GRTR? DAM,STR \?CND57
|
|
SET 'DAM,STR
|
|
?CND57: DIV DAM,5 >MIN
|
|
GETP PRSI,P?EFFECT
|
|
MUL STACK,DAM
|
|
ADD STACK,99
|
|
DIV STACK,100 >DAM
|
|
LESS? DAM,MIN \?CCL61
|
|
SET 'DAM,MIN
|
|
JUMP ?CND59
|
|
?CCL61: FSET? PRSI,WIELDED /?CND59
|
|
DIV DAM,2 >DAM
|
|
LESS? DAM,MIN \?CND59
|
|
SET 'DAM,MIN
|
|
?CND59: FSET PRSO,STRICKEN
|
|
LESS? DAM,MEND \?CND65
|
|
MUL DAM,100
|
|
DIV STACK,MEND >PCENT
|
|
SUB MEND,DAM >MEND
|
|
PUTP PRSO,P?ENDURANCE,MEND
|
|
ICALL2 YOUR-OBJ,PRSI
|
|
PRINTC SP
|
|
ZERO? LIT? \?CND67
|
|
PRINTR "strikes a blow."
|
|
?CND67: ICALL2 HOW-BAD,PCENT
|
|
PRINTI "ly wounds "
|
|
ICALL1 THE-PRINT
|
|
LESS? PCENT,20 \?CND69
|
|
ICALL1 TOO-BAD
|
|
?CND69: PRINT PERIOD
|
|
RTRUE
|
|
?CND65: PUTP PRSO,P?ENDURANCE,0
|
|
PUTP PRSO,P?STRENGTH,0
|
|
PRINTI "You deal "
|
|
ZERO? LIT? /?CND71
|
|
ICALL1 THE-PRINT
|
|
PRINTC SP
|
|
?CND71: PRINTI "a decisive blow"
|
|
EQUAL? PRSI,FALSE-VALUE,HANDS /?CND73
|
|
PRINT WITH
|
|
ICALL1 THEI-PRINT
|
|
?CND73: PRINTR "!"
|
|
?CND47: PRINT CYOU
|
|
EQUAL? PRSI,FEET \?CCL77
|
|
PRINTB W?KICK
|
|
JUMP ?CND75
|
|
?CCL77: EQUAL? PRSI,HANDS /?CTR78
|
|
RANDOM 100
|
|
LESS? 50,STACK /?CCL79
|
|
?CTR78: PRINTB W?SWING
|
|
JUMP ?CND75
|
|
?CCL79: PRINTB W?STRIKE
|
|
?CND75: ZERO? LIT? \?CND82
|
|
PRINTR " at the darkness, with no effect."
|
|
?CND82: PRINTI " at "
|
|
ICALL1 THE-PRINT
|
|
EQUAL? PRSI,FALSE-VALUE,HANDS,FEET /?CND84
|
|
PRINT WITH
|
|
ICALL1 THEI-PRINT
|
|
?CND84: PRINTI ", "
|
|
CALL2 PICK-NEXT,MISSES
|
|
PRINT STACK
|
|
ICALL1 TOO-BAD
|
|
PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TOO-BAD
|
|
EQUAL? PRSI,HANDS,FEET /FALSE
|
|
FSET? PRSI,WEAPON \FALSE
|
|
FSET? PRSI,WIELDED /FALSE
|
|
PRINTI ". Too bad you're not wielding "
|
|
ICALL1 THEI-PRINT
|
|
RFALSE
|
|
|
|
|
|
.FUNCT MONSTER-THROW
|
|
LOC PRSI
|
|
MOVE PRSO,STACK
|
|
BOR NEW-DBOX,SHOWING-ALL >NEW-DBOX
|
|
ICALL2 YOUR-OBJ,PRSO
|
|
PRINTI " just misses "
|
|
ICALL1 THEI-PRINT
|
|
PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT KILL-MONSTER,OBJ,X
|
|
ICALL2 EXUENT-MONSTER,OBJ
|
|
FCLEAR OBJ,LIVING
|
|
PUTP OBJ,P?STRENGTH,0
|
|
PUTP OBJ,P?DEXTERITY,0
|
|
PUTP OBJ,P?ENDURANCE,0
|
|
GETP OBJ,P?LIFE >X
|
|
ZERO? X /?CND1
|
|
ICALL2 DEQUEUE,X
|
|
PUTP OBJ,P?LIFE,0
|
|
?CND1: GETP OBJ,P?VALUE >X
|
|
ZERO? X /FALSE
|
|
PUTP OBJ,P?VALUE,0
|
|
ICALL UPDATE-STAT,X,EXPERIENCE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT EXUENT-MONSTER,OBJ
|
|
ICALL2 VANISH,OBJ
|
|
FSET OBJ,SURPRISED
|
|
FCLEAR OBJ,STRICKEN
|
|
SET 'ATTACK-MODE,NORMAL-ATTACK
|
|
SET 'QCONTEXT,NOT-HERE-OBJECT
|
|
SET 'QCONTEXT-ROOM,FALSE-VALUE
|
|
CALL FIND-IN?,HERE,MONSTER >LAST-MONSTER
|
|
SET 'LAST-MONSTER-DIR,FALSE-VALUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DIAGNOSE-MONSTER,OBJ,MAX,MEND
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSO
|
|
?CND1: GETP OBJ,P?EMAX >MAX
|
|
GETP OBJ,P?ENDURANCE >MEND
|
|
FSET? OBJ,FEMALE \?CCL5
|
|
PRINTI "She"
|
|
JUMP ?CND3
|
|
?CCL5: PRINTI "He"
|
|
?CND3: PRINTI " appears to be "
|
|
FSET? OBJ,SLEEPING \?CND6
|
|
PRINTB W?STUNNED
|
|
PRINTI ", "
|
|
EQUAL? MEND,MAX \?CCL10
|
|
PRINTB W?BUT
|
|
JUMP ?CND8
|
|
?CCL10: PRINTB W?AND
|
|
?CND8: PRINTI ", "
|
|
?CND6: EQUAL? MAX,MEND \?CND11
|
|
PRINTI "in excellent condition"
|
|
EQUAL? OBJ,DORN \?CND13
|
|
FSET? OBJ,MUNGED \?CND13
|
|
PRINTI " otherwise"
|
|
?CND13: PRINT PERIOD
|
|
RTRUE
|
|
?CND11: MUL MEND,100
|
|
DIV STACK,MAX
|
|
ICALL2 HOW-BAD,STACK
|
|
PRINTR "ly wounded."
|
|
|
|
|
|
.FUNCT HOW-BAD,PCENT
|
|
LESS? PCENT,20 \?CCL3
|
|
PRINTI "dangerous"
|
|
RTRUE
|
|
?CCL3: LESS? PCENT,40 \?CCL5
|
|
PRINTI "grave"
|
|
RTRUE
|
|
?CCL5: LESS? PCENT,60 \?CCL7
|
|
PRINTI "serious"
|
|
RTRUE
|
|
?CCL7: LESS? PCENT,80 \?CCL9
|
|
PRINTI "noticeab"
|
|
RTRUE
|
|
?CCL9: PRINTI "slight"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT WATER?,OBJ
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSI
|
|
?CND1: EQUAL? OBJ,GREAT-SEA,COVE,BROOK /TRUE
|
|
EQUAL? OBJ,WATERFALL,RIVER /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT MAGICWORD?,WRD,LEN,OBJ,X
|
|
ZERO? TELEWORD /?CCL3
|
|
EQUAL? TELEWORD,P-PRSA-WORD,WRD \?CCL3
|
|
ICALL1 SAY-TELEWORD
|
|
RTRUE
|
|
?CCL3: EQUAL? W?LIGHTNING,P-PRSA-WORD,WRD \?CCL7
|
|
LOC RIDDLE
|
|
EQUAL? HERE,STACK \?CCL7
|
|
ICALL1 OPEN-CLIFF
|
|
RTRUE
|
|
?CCL7: EQUAL? W?YOUTH,P-PRSA-WORD,WRD \?CCL11
|
|
LOC BOULDER
|
|
EQUAL? HERE,STACK \?CCL11
|
|
LOC POOL
|
|
ZERO? STACK \?CCL11
|
|
ICALL1 OPEN-POOL
|
|
RTRUE
|
|
?CCL11: ZERO? AMULET-WORD /?CCL16
|
|
EQUAL? AMULET-WORD,P-PRSA-WORD,WRD \?CCL16
|
|
ICALL1 SAY-AMULET-WORD
|
|
RTRUE
|
|
?CCL16: ZERO? WALL-WORD /?CCL20
|
|
EQUAL? WALL-WORD,P-PRSA-WORD,WRD \?CCL20
|
|
ICALL1 SAY-WALL-WORD
|
|
RTRUE
|
|
?CCL20: ZERO? GOBLET-WORD /?CND1
|
|
EQUAL? GOBLET-WORD,P-PRSA-WORD,WRD \?CND1
|
|
CALL1 SAY-GOBLET-WORD?
|
|
ZERO? STACK \TRUE
|
|
?CND1: GET ALL-SCROLLS,0 >LEN
|
|
?PRG27: GET ALL-SCROLLS,LEN >OBJ
|
|
EQUAL? OBJ,PRSO /?CCL30
|
|
CALL2 VISIBLE?,OBJ
|
|
ZERO? STACK /?CND29
|
|
?CCL30: GETPT OBJ,P?SYNONYM
|
|
GET STACK,1 >X
|
|
EQUAL? X,W?ZZZP /?CND29
|
|
EQUAL? X,WRD,P-PRSA-WORD \?CND29
|
|
GETP OBJ,P?EFFECT
|
|
CALL STACK,OBJ >X
|
|
RTRUE
|
|
?CND29: DLESS? 'LEN,1 \?PRG27
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DESCRIBE-MONSTERS,OBJ
|
|
FSET? OBJ,LIVING /?CCL3
|
|
PRINTI "dead "
|
|
JUMP ?CND1
|
|
?CCL3: FSET? OBJ,SLEEPING \?CND1
|
|
PRINTI "stunned "
|
|
?CND1: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT LAST-ROOM-IN?,TBL,LAST,LEN,RM
|
|
ASSIGNED? 'LAST /?CND1
|
|
SET 'LAST,1
|
|
?CND1: FSET? HERE,TOUCHED /FALSE
|
|
GETB TBL,0 >LEN
|
|
?PRG5: GETB TBL,LEN >RM
|
|
EQUAL? HERE,RM /?CND7
|
|
FSET? RM,TOUCHED \FALSE
|
|
?CND7: DLESS? 'LEN,LAST \?PRG5
|
|
RTRUE
|
|
|
|
|
|
.FUNCT I-BREEZE
|
|
FSET? BREEZE,SEEN \?CCL3
|
|
FCLEAR BREEZE,SEEN
|
|
RFALSE
|
|
?CCL3: RANDOM 100
|
|
LESS? 7,STACK /FALSE
|
|
CALL1 NEXT-WINDIR?
|
|
CALL2 NEW-WINDIR?,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT NEXT-WINDIR?,X
|
|
?PRG1: RANDOM 8 >X
|
|
DEC 'X
|
|
EQUAL? X,WINDIR /?PRG1
|
|
EQUAL? HERE,IN-SKY /?CCL6
|
|
RETURN X
|
|
?CCL6: EQUAL? ABOVE,OXROADS \?CCL8
|
|
EQUAL? X,I-NE,I-NORTH,I-EAST /?PRG1
|
|
?CCL8: EQUAL? ABOVE,OTHRIFF /?PRD13
|
|
RETURN X
|
|
?PRD13: EQUAL? X,I-SE,I-SOUTH,I-EAST /?PRG1
|
|
RETURN X
|
|
|
|
|
|
.FUNCT NEW-WINDIR?,X
|
|
ASSIGNED? 'X \?CND1
|
|
SET 'WINDIR,X
|
|
?CND1: FSET BREEZE,SEEN
|
|
FSET? HERE,INDOORS /FALSE
|
|
EQUAL? HERE,APLANE,IN-SPLENDOR,IN-FROON /FALSE
|
|
EQUAL? HERE,IN-GARDEN /FALSE
|
|
CALL1 PLAIN-ROOM?
|
|
ZERO? STACK \FALSE
|
|
INTBL? HERE,ARCH-ROOMS,MAX-ATIME,1 >X /FALSE
|
|
PRINT TAB
|
|
CALL2 PICK-NEXT,WIND-ALERTS
|
|
PRINT STACK
|
|
PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT FIND-IN?,OBJ,BIT
|
|
FIRST? OBJ >OBJ /?PRG3
|
|
RETURN OBJ
|
|
?PRG3: FSET? OBJ,BIT /?REP4
|
|
NEXT? OBJ >OBJ /?PRG3
|
|
?REP4: RETURN OBJ
|
|
|
|
|
|
.FUNCT ON-IN,OBJ
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSO
|
|
?CND1: PRINTC SP
|
|
EQUAL? OBJ,BUSH \?CCL5
|
|
PRINTB W?BEHIND
|
|
JUMP ?CND3
|
|
?CCL5: EQUAL? OBJ,ARCH \?CCL7
|
|
PRINTB W?UNDER
|
|
JUMP ?CND3
|
|
?CCL7: FSET? OBJ,CONTAINER /?CTR8
|
|
FSET? OBJ,PLACE \?CCL9
|
|
?CTR8: PRINTB W?IN
|
|
JUMP ?CND3
|
|
?CCL9: PRINTB W?ON
|
|
?CND3: PRINTC SP
|
|
ICALL2 THE-PRINT,OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SHOP-DOOR,OBJ
|
|
PRINTI "glass "
|
|
PRINTD BCASE
|
|
PRINTI " near the "
|
|
FSET? OBJ,OPENED \?CND1
|
|
PRINTI "open "
|
|
?CND1: PRINTD OBJ
|
|
RFALSE
|
|
|
|
|
|
.FUNCT LOOK-ON-CASE,OBJ
|
|
CALL2 SEE-ANYTHING-IN?,OBJ
|
|
ZERO? STACK /?CND1
|
|
PRINTI ". On the case you see "
|
|
ICALL2 CONTENTS,OBJ
|
|
?CND1: PRINTI ". Another exit is partly concealed by "
|
|
ICALL2 PRINTA,CURTAIN
|
|
PRINT PERIOD
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DESCRIBE-CAVES,OBJ
|
|
PRINTI "Underground"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT IGNORANT,WHO,OBJ
|
|
ICALL2 CTHE-PRINT,WHO
|
|
PRINTI " shrugs. ""Don't know nothin' special about "
|
|
ICALL2 PRONOUN,OBJ
|
|
PRINT PERQ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PRONOUN,OBJ,IT
|
|
FSET? OBJ,PLURAL \?CCL3
|
|
PRINTB W?THEM
|
|
RTRUE
|
|
?CCL3: FSET? OBJ,FEMALE \?CCL5
|
|
PRINTB W?HER
|
|
RTRUE
|
|
?CCL5: FSET? OBJ,PERSON \?CCL7
|
|
PRINTB W?HIM
|
|
RTRUE
|
|
?CCL7: ASSIGNED? 'IT \?CCL9
|
|
PRINTB W?IT
|
|
RTRUE
|
|
?CCL9: PRINTB W?THAT
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DESCRIBE-WEAPONS,CONTEXT
|
|
ICALL2 PRINTCA,DESCING
|
|
PRINT STR?507
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SAY-YOUR,OBJ
|
|
FSET? OBJ,NOARTICLE /?CND1
|
|
PRINTI "your "
|
|
?CND1: ICALL2 DPRINT,OBJ
|
|
RFALSE
|
|
|
|
|
|
.FUNCT YOUR-OBJ,OBJ
|
|
ASSIGNED? 'OBJ /?CND1
|
|
SET 'OBJ,PRSI
|
|
?CND1: EQUAL? OBJ,FEET /?CTR4
|
|
EQUAL? PRSA,V?KICK \?CCL5
|
|
?CTR4: PRINTI "Your foot"
|
|
RFALSE
|
|
?CCL5: EQUAL? OBJ,FALSE-VALUE,HANDS,ME \?CND3
|
|
PRINTI "Your fist"
|
|
RFALSE
|
|
?CND3: FSET? OBJ,NOARTICLE /?CND9
|
|
PRINT CYOUR
|
|
?CND9: ICALL2 DPRINT,OBJ
|
|
RFALSE
|
|
|
|
|
|
.FUNCT CARRIAGE-RETURNS,NUM
|
|
SET 'NUM,HEIGHT
|
|
ZERO? DMODE /?PRG3
|
|
SUB NUM,12 >NUM
|
|
?PRG3: CRLF
|
|
DLESS? 'NUM,1 \?PRG3
|
|
RFALSE
|
|
|
|
|
|
.FUNCT PEERING-BEHIND
|
|
PRINTI "Peering behind "
|
|
ICALL1 THE-PRINT
|
|
PRINT LYOU-SEE
|
|
ICALL1 CONTENTS
|
|
PRINT PERIOD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT FROBOZZ,STR
|
|
PRINTI "Frobozz Magic "
|
|
PRINT STR
|
|
PRINTI " Company"
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DO-INPUT,CHR
|
|
INPUT 1 >CHR
|
|
EQUAL? CHR,MAC-UP-ARROW,MAC-DOWN-ARROW \?CCL3
|
|
EQUAL? CHR,MAC-UP-ARROW \?CCL6
|
|
RETURN UP-ARROW
|
|
?CCL6: RETURN DOWN-ARROW
|
|
?CCL3: RETURN CHR
|
|
|
|
.ENDI
|