shogun/desc.zap

	.SEGMENT "0"


	.FUNCT	DESCRIBE-ROOM:ANY:0:1,LOOK?,V?,STR,AV
	ZERO?	LIT \?CND1
	PRINTI	"It is pitch black."
	CRLF	
	RFALSE	
?CND1:	IN?	HERE,ROOMS \?CND3
	HLIGHT	H-BOLD
	PRINTD	HERE
	HLIGHT	H-NORMAL
?CND3:	LOC	WINNER >AV
	FSET?	AV,VEHBIT \?CND5
	FSET?	AV,SURFACEBIT \?CCL9
	PRINTI	", on "
	JUMP	?CND7
?CCL9:	PRINTI	", in "
?CND7:	ICALL2	THE-PRINT,AV
?CND5:	CRLF	
	ZERO?	LOOK? /?PRD12
	SET	'V?,LOOK?
	JUMP	?PEN10
?PRD12:	EQUAL?	VERBOSITY,2 /?PRD13
	PUSH	0
	JUMP	?PRD14
?PRD13:	PUSH	1
?PRD14:	SET	'V?,STACK
?PEN10:	FSET?	HERE,TOUCHBIT /?CND15
	FSET	HERE,TOUCHBIT
	ZERO?	VERBOSITY /?CND15
	SET	'V?,TRUE-VALUE
?CND15:	SET	'DESCRIBED-ROOM?,V?
	ZERO?	V? /TRUE
	EQUAL?	HERE,AV /?CCL23
	FSET?	AV,VEHBIT \?CCL23
	GETP	AV,P?ACTION
	CALL	STACK,M-LOOK
	ZERO?	STACK \TRUE
?CCL23:	GETP	HERE,P?ACTION
	CALL	STACK,M-LOOK
	ZERO?	STACK \TRUE
	GETP	HERE,P?LDESC >STR
	ZERO?	STR /TRUE
	PRINT	STR
	CRLF	
	RTRUE	


	.FUNCT	DESCRIBE-OBJECTS:ANY:0:0,O,STR,AV,TMP
	LOC	WINNER >AV
	FIRST?	HERE >O /?BOGUS1
?BOGUS1:	ZERO?	O /FALSE
?PRG4:	ZERO?	O /?REP5
	CALL2	DESCRIBABLE?,O
	ZERO?	STACK /?CND6
	FSET?	O,TOUCHBIT /?CND6
	GETP	O,P?FDESC >STR
	ZERO?	STR /?CND6
	ICALL2	THIS-IS-IT,O
	CRLF	
	PRINT	STR
	FSET?	O,CONTBIT \?CND13
	ADD	D-ALL?,D-PARA?
	ICALL	DESCRIBE-CONTENTS,O,TRUE-VALUE,STACK
?CND13:	CRLF	
?CND6:	NEXT?	O >O /?PRG4
	JUMP	?PRG4
?REP5:	FIRST?	HERE >O /?PRG17
?PRG17:	ZERO?	O /?REP18
	CALL2	DESCRIBABLE?,O
	ZERO?	STACK /?CND19
	GETP	O,P?FDESC
	ZERO?	STACK /?CCL23
	FSET?	O,TOUCHBIT \?CND19
?CCL23:	GETP	O,P?DESCFCN >STR
	ZERO?	STR /?CCL29
	CALL	STR,M-OBJDESC?,O >TMP
	ZERO?	TMP /?CCL29
	EQUAL?	TMP,M-FATAL /?CND19
	ICALL2	THIS-IS-IT,O
	CRLF	
	CALL	STR,M-OBJDESC,O >STR
	ZERO?	STR /?CND34
	FSET?	O,CONTBIT \?CND34
	EQUAL?	STR,M-FATAL /?CND34
	ADD	D-ALL?,D-PARA?
	ICALL	DESCRIBE-CONTENTS,O,TRUE-VALUE,STACK
?CND34:	CRLF	
	JUMP	?CND19
?CCL29:	GETP	O,P?LDESC >STR
	ZERO?	STR /?CND19
	ICALL2	THIS-IS-IT,O
	CRLF	
	PRINT	STR
	FSET?	O,CONTBIT \?CND41
	ADD	D-ALL?,D-PARA?
	ICALL	DESCRIBE-CONTENTS,O,TRUE-VALUE,STACK
?CND41:	CRLF	
?CND19:	NEXT?	O >O /?PRG17
	JUMP	?PRG17
?REP18:	SUB	0,PERSON >D-BIT
	ICALL	DESCRIBE-CONTENTS,HERE,FALSE-VALUE,FALSE-VALUE
	SET	'D-BIT,PERSON
	ICALL	DESCRIBE-CONTENTS,HERE,FALSE-VALUE,FALSE-VALUE
	SET	'D-BIT,FALSE-VALUE
	ZERO?	AV /FALSE
	EQUAL?	HERE,AV /FALSE
	CALL	DESCRIBE-CONTENTS,AV,FALSE-VALUE,FALSE-VALUE
	RSTACK	


	.FUNCT	DESCRIBE-CONTENTS:ANY:1:3,OBJ,LEVEL,ALL?,F,N,1ST?,IT?,TWO?,START?,PARA?,DB
	ASSIGNED?	'LEVEL /?CND1
	SET	'LEVEL,-1
?CND1:	ASSIGNED?	'ALL? /?CND3
	SET	'ALL?,D-ALL?
?CND3:	SET	'1ST?,TRUE-VALUE
	EQUAL?	LEVEL,2 \?CCL7
	SET	'LEVEL,TRUE-VALUE
	SET	'PARA?,TRUE-VALUE
	SET	'START?,TRUE-VALUE
	JUMP	?CND5
?CCL7:	BTST	ALL?,D-PARA? \?CND5
	SET	'PARA?,TRUE-VALUE
?CND5:	FIRST?	OBJ >N /?BOGUS9
?BOGUS9:	ZERO?	START? \?PRG25
	IN?	OBJ,ROOMS /?PRG25
	FSET?	OBJ,PERSON /?PRG25
	ZERO?	N /FALSE
	FSET?	OBJ,CONTBIT \FALSE
	FSET?	OBJ,OPENBIT /?PRD20
	FSET?	OBJ,TRANSBIT \FALSE
?PRD20:	EQUAL?	LEVEL,-1 /?PRG25
	FSET?	OBJ,SEARCHBIT \FALSE
?PRG25:	ZERO?	N /?CCL28
	CALL2	DESCRIBABLE?,N
	ZERO?	STACK /?CND27
	BTST	ALL?,D-ALL? /?CCL28
	CALL2	SIMPLE-DESC?,N
	ZERO?	STACK /?CND27
?CCL28:	ZERO?	F /?CND35
	ZERO?	1ST? /?CCL39
	SET	'1ST?,FALSE-VALUE
	EQUAL?	LEVEL,FALSE-VALUE,TRUE-VALUE \?CCL42
	ZERO?	START? \?CND37
	ZERO?	PARA? \?CCL47
	SET	'PARA?,TRUE-VALUE
	CRLF	
	JUMP	?CND45
?CCL47:	EQUAL?	LEVEL,TRUE-VALUE \?CND45
	PRINTC	11
?CND45:	FSET?	F,PLURAL \?CCL51
	PUSH	TRUE-VALUE
	JUMP	?CND49
?CCL51:	PUSH	N
?CND49:	ICALL	DESCRIBE-START,OBJ,STACK
	JUMP	?CND37
?CCL42:	EQUAL?	LEVEL,-1 /?CND37
	PRINT	LEVEL
	JUMP	?CND37
?CCL39:	ZERO?	N /?CCL54
	PRINTI	", "
	JUMP	?CND37
?CCL54:	PRINTI	" and "
?CND37:	ICALL2	PRINTA,F
	ICALL2	DESCRIBE-SPECIAL,F
	ZERO?	IT? \?CCL57
	ZERO?	TWO? \?CCL57
	SET	'IT?,F
	JUMP	?CND35
?CCL57:	SET	'TWO?,TRUE-VALUE
	SET	'IT?,FALSE-VALUE
?CND35:	SET	'F,N
?CND27:	ZERO?	N /?CND60
	NEXT?	N >N /?CND60
?CND60:	ZERO?	F \?PRG25
	ZERO?	N \?PRG25
	ZERO?	IT? /?CND67
	ZERO?	TWO? \?CND67
	ICALL2	THIS-IS-IT,IT?
?CND67:	ZERO?	1ST? /?CCL73
	ZERO?	START? /?CCL73
	PRINTI	" nothing"
	RFALSE	
?CCL73:	ZERO?	1ST? \?REP26
	EQUAL?	LEVEL,FALSE-VALUE,TRUE-VALUE \?REP26
	EQUAL?	OBJ,HERE \?CND79
	PRINTI	" here"
?CND79:	PRINTC	46
?REP26:	EQUAL?	LEVEL,FALSE-VALUE,TRUE-VALUE \?CND81
	FIRST?	OBJ >F /?PRG84
?PRG84:	ZERO?	F /?CND81
	FSET?	F,CONTBIT /?PRD91
	EQUAL?	F,HERE \?CND86
?PRD91:	CALL	DESCRIBABLE?,F,TRUE-VALUE
	ZERO?	STACK /?CND86
	BTST	ALL?,D-ALL? /?CCL89
	CALL2	SIMPLE-DESC?,F
	ZERO?	STACK /?CND86
?CCL89:	SET	'DB,D-BIT
	SET	'D-BIT,FALSE-VALUE
	ZERO?	PARA? /?CCL101
	PUSH	3
	JUMP	?CND99
?CCL101:	PUSH	D-ALL?
?CND99:	CALL	DESCRIBE-CONTENTS,F,TRUE-VALUE,STACK
	ZERO?	STACK /?CND97
	SET	'1ST?,FALSE-VALUE
	SET	'PARA?,TRUE-VALUE
?CND97:	SET	'D-BIT,DB
?CND86:	NEXT?	F >F /?PRG84
	JUMP	?PRG84
?CND81:	ZERO?	1ST? \?CND103
	EQUAL?	LEVEL,FALSE-VALUE,TRUE-VALUE \?CND103
	LOC	WINNER
	EQUAL?	OBJ,HERE,STACK \?CND103
	CRLF	
?CND103:	ZERO?	1ST? /TRUE
	RFALSE	


	.FUNCT	DESCRIBE-START:ANY:2:2,OBJ,N
	EQUAL?	OBJ,HERE \?CCL3
	EQUAL?	D-BIT,PERSON \?CCL6
	PRINTI	"You see "
	RTRUE	
?CCL6:	PRINTI	"There "
	ZERO?	N /?CCL9
	PRINTI	"are "
	RTRUE	
?CCL9:	PRINTI	"is "
	RTRUE	
?CCL3:	EQUAL?	OBJ,PLAYER \?CCL11
	EQUAL?	D-BIT,WEARBIT \?CCL14
	PRINTI	"You are wearing "
	RTRUE	
?CCL14:	PRINTI	"You are carrying "
	RTRUE	
?CCL11:	FSET?	OBJ,PERSON \?CCL16
	ICALL2	CTHE-PRINT,OBJ
	PRINTI	" has "
	RTRUE	
?CCL16:	FSET?	OBJ,SURFACEBIT \?CCL18
	EQUAL?	OBJ,LADDER \?CCL21
	PRINTI	"Stand"
	JUMP	?CND19
?CCL21:	PRINTI	"Sitt"
?CND19:	PRINTI	"ing on "
	ICALL2	THE-PRINT,OBJ
	ZERO?	N /?CCL24
	PRINTI	" are "
	RTRUE	
?CCL24:	PRINTI	" is "
	RTRUE	
?CCL18:	ICALL2	CTHE-PRINT,OBJ
	PRINTI	" contains "
	RTRUE	


	.FUNCT	DESCRIBE-SPECIAL:ANY:1:1,OBJ
	FSET?	OBJ,ONBIT \FALSE
	PRINTI	" (providing light)"
	RTRUE	


	.FUNCT	DESCRIBABLE?:ANY:1:2,OBJ,CONT?
	FSET?	OBJ,INVISIBLE /FALSE
	EQUAL?	OBJ,WINNER /FALSE
	LOC	WINNER
	EQUAL?	OBJ,STACK \?CCL7
	LOC	WINNER
	EQUAL?	HERE,STACK \FALSE
?CCL7:	ZERO?	CONT? \?CCL11
	FSET?	OBJ,NDESCBIT /FALSE
?CCL11:	ZERO?	D-BIT /TRUE
	GRTR?	D-BIT,0 \?CCL18
	FSET?	OBJ,D-BIT /TRUE
	RFALSE	
?CCL18:	SUB	0,D-BIT
	FSET?	OBJ,STACK /FALSE
	RTRUE	


	.FUNCT	SIMPLE-DESC?:ANY:1:1,OBJ,STR
	GETP	OBJ,P?FDESC
	ZERO?	STACK /?CCL3
	FSET?	OBJ,TOUCHBIT \FALSE
?CCL3:	GETP	OBJ,P?DESCFCN >STR
	ZERO?	STR /?CCL7
	CALL	STR,M-OBJDESC?,OBJ
	ZERO?	STACK \FALSE
?CCL7:	GETP	OBJ,P?LDESC
	ZERO?	STACK /TRUE
	RFALSE	


	.FUNCT	DESCRIBE-REST:ANY:1:1,OBJ
	CALL2	DESCRIBE-CONTENTS,OBJ
	ZERO?	STACK \TRUE
	PRINTI	"nothing"
	RTRUE	


	.FUNCT	DESCRIBE-SENT:ANY:1:1,OBJ
	CALL	DESCRIBE-CONTENTS,OBJ,FALSE-VALUE,3
	ZERO?	STACK \TRUE
	PRINTI	"The "
	ICALL2	DPRINT,OBJ
	PRINTI	" is empty."
	RTRUE	

	.ENDSEG

	.ENDI