.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