misc.zap

	.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