shogun/desc.zap

317 lines
6.4 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

.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