425 lines
8.4 KiB
Plaintext
425 lines
8.4 KiB
Plaintext
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT PICK-ONE,TBL,LENGTH,CNT,RND,MSG,RFROB
|
|
GET TBL,0 >LENGTH
|
|
GET TBL,1 >CNT
|
|
DEC 'LENGTH
|
|
ADD TBL,2 >TBL
|
|
MUL CNT,2
|
|
ADD TBL,STACK >RFROB
|
|
SUB LENGTH,CNT
|
|
RANDOM STACK >RND
|
|
GET RFROB,RND >MSG
|
|
GET RFROB,1
|
|
PUT RFROB,RND,STACK
|
|
PUT RFROB,1,MSG
|
|
INC 'CNT
|
|
EQUAL? CNT,LENGTH \?CND1
|
|
SET 'CNT,0
|
|
?CND1: PUT TBL,0,CNT
|
|
RETURN MSG
|
|
|
|
|
|
.FUNCT DPRINT,OBJ
|
|
GETP OBJ,P?INANIMATE-DESC
|
|
ZERO? STACK /?CCL3
|
|
FSET? OBJ,ANIMATEDBIT /?CCL3
|
|
GETP OBJ,P?INANIMATE-DESC
|
|
PRINT STACK
|
|
RTRUE
|
|
?CCL3: GETP OBJ,P?SDESC
|
|
ZERO? STACK /?CCL7
|
|
GETP OBJ,P?SDESC
|
|
PRINT STACK
|
|
RTRUE
|
|
?CCL7: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.FUNCT APRINT,OBJ,NOSP,LEN
|
|
ZERO? NOSP \?CND1
|
|
PRINTC 32
|
|
?CND1: CALL2 GET-OWNER,OBJ >LEN
|
|
ZERO? LEN /?CCL5
|
|
GETP OBJ,P?OWNER
|
|
EQUAL? LEN,STACK /?CCL5
|
|
EQUAL? LEN,PROTAGONIST \?CCL10
|
|
PRINTI "your "
|
|
JUMP ?CND3
|
|
?CCL10: EQUAL? LEN,OBJ /?CND3
|
|
ICALL APRINT,LEN,TRUE-VALUE
|
|
PRINTI "'s "
|
|
JUMP ?CND3
|
|
?CCL5: FSET? OBJ,NARTICLEBIT /?CND3
|
|
FSET? OBJ,VOWELBIT \?CCL15
|
|
PRINTI "an "
|
|
JUMP ?CND3
|
|
?CCL15: PRINTI "a "
|
|
?CND3: CALL2 DPRINT,OBJ
|
|
RSTACK
|
|
|
|
|
|
.FUNCT TPRINT,OBJ,NOSP,LEN
|
|
ZERO? NOSP \?CND1
|
|
PRINTC 32
|
|
?CND1: CALL2 GET-OWNER,OBJ >LEN
|
|
ZERO? LEN /?CCL5
|
|
GETP OBJ,P?OWNER
|
|
EQUAL? LEN,STACK /?CCL5
|
|
EQUAL? LEN,PROTAGONIST \?CCL10
|
|
PRINTI "your "
|
|
JUMP ?CND3
|
|
?CCL10: EQUAL? LEN,OBJ /?CND3
|
|
ICALL TPRINT,LEN,TRUE-VALUE
|
|
PRINTI "'s "
|
|
JUMP ?CND3
|
|
?CCL5: FSET? OBJ,NARTICLEBIT /?CND3
|
|
PRINTI "the "
|
|
?CND3: CALL2 DPRINT,OBJ
|
|
RSTACK
|
|
|
|
|
|
.FUNCT TPRINT-PRSO
|
|
CALL2 TPRINT,PRSO
|
|
RSTACK
|
|
|
|
|
|
.FUNCT TPRINT-PRSI
|
|
CALL2 TPRINT,PRSI
|
|
RSTACK
|
|
|
|
|
|
.FUNCT ARPRINT,OBJ
|
|
ICALL2 APRINT,OBJ
|
|
PRINT PERIOD-CR
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TRPRINT,OBJ
|
|
ICALL2 TPRINT,OBJ
|
|
PRINT PERIOD-CR
|
|
RTRUE
|
|
|
|
|
|
.FUNCT IS-ARE-PRINT,OBJ
|
|
FSET? OBJ,NARTICLEBIT \?CCL3
|
|
PRINTC 32
|
|
JUMP ?CND1
|
|
?CCL3: PRINTI " the "
|
|
?CND1: ICALL2 DPRINT,OBJ
|
|
FSET? OBJ,PLURALBIT \?CCL6
|
|
PRINTI " are "
|
|
RTRUE
|
|
?CCL6: PRINTI " is "
|
|
RTRUE
|
|
|
|
|
|
.FUNCT VERB-ALL-TEST,OO,II,L
|
|
LOC OO >L
|
|
EQUAL? OO,ROOMS \?CCL3
|
|
INC 'P-NOT-HERE
|
|
RFALSE
|
|
?CCL3: EQUAL? PRSA,V?TAKE \?CCL5
|
|
ZERO? II /?CCL5
|
|
IN? OO,II \FALSE
|
|
?CCL5: ZERO? II /?CCL11
|
|
EQUAL? PRSO,II /FALSE
|
|
?CCL11: EQUAL? PRSA,V?TAKE \?CCL15
|
|
FSET? OO,TAKEBIT /?CCL18
|
|
FSET? OO,TRYTAKEBIT \FALSE
|
|
?CCL18: FSET? OO,NALLBIT /FALSE
|
|
ZERO? II \TRUE
|
|
CALL2 ULTIMATELY-IN?,OO
|
|
ZERO? STACK /TRUE
|
|
RFALSE
|
|
?CCL15: EQUAL? PRSA,V?PUT-ON,V?PUT,V?DROP /?PRD30
|
|
EQUAL? PRSA,V?SGIVE,V?GIVE \?CCL28
|
|
?PRD30: IN? OO,WINNER \FALSE
|
|
?CCL28: EQUAL? PRSA,V?PUT-ON,V?PUT \?CCL34
|
|
IN? OO,WINNER /?CCL34
|
|
CALL ULTIMATELY-IN?,OO,II
|
|
ZERO? STACK \FALSE
|
|
?CCL34: EQUAL? PRSA,V?WEAR \?CCL39
|
|
FSET? OO,WORNBIT /FALSE
|
|
FSET? OO,WEARBIT \FALSE
|
|
?CCL39: EQUAL? OO,II /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT GAME-VERB?
|
|
EQUAL? PRSA,V?$COMMAND,V?$UNRECORD,V?$RECORD /TRUE
|
|
EQUAL? PRSA,V?$REFRESH,V?$VERIFY,V?$RANDOM /TRUE
|
|
EQUAL? PRSA,V?RESTART,V?RESTORE,V?SAVE /TRUE
|
|
EQUAL? PRSA,V?UNSCRIPT,V?SCRIPT,V?QUIT /TRUE
|
|
EQUAL? PRSA,V?VERBOSE,V?SUPERBRIEF,V?BRIEF /TRUE
|
|
EQUAL? PRSA,V?NOTIFY,V?CREDITS,V?VERSION /TRUE
|
|
EQUAL? PRSA,V?SCORE,V?COLOR,V?HINT /TRUE
|
|
EQUAL? PRSA,V?DEFINE,V?MAP,V?TIME /TRUE
|
|
EQUAL? PRSA,V?MODE /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT THIS-IS-IT,OBJ
|
|
EQUAL? PRSA,V?WALK \?PRD5
|
|
EQUAL? PRSO,OBJ /TRUE
|
|
?PRD5: EQUAL? OBJ,FALSE-VALUE,ROOMS,ME /TRUE
|
|
EQUAL? OBJ,PROTAGONIST /TRUE
|
|
CALL DONT-IT,OBJ,LOBSTER,W?NUTCRACKER
|
|
ZERO? STACK \TRUE
|
|
CALL DONT-IT,OBJ,SNAKE,W?ROPE
|
|
ZERO? STACK \TRUE
|
|
FSET? OBJ,FEMALEBIT \?CCL14
|
|
EQUAL? P-HER-OBJECT,OBJ /?CND15
|
|
FCLEAR HER,TOUCHBIT
|
|
?CND15: SET 'P-HER-OBJECT,OBJ
|
|
RETURN P-HER-OBJECT
|
|
?CCL14: FSET? OBJ,ACTORBIT /?CTR17
|
|
EQUAL? OBJ,LITTLE-FUNGUS \?CCL18
|
|
?CTR17: EQUAL? P-HIM-OBJECT,OBJ /?CND21
|
|
FCLEAR HIM,TOUCHBIT
|
|
?CND21: SET 'P-HIM-OBJECT,OBJ
|
|
EQUAL? OBJ,JESTER,EXECUTIONER /FALSE
|
|
EQUAL? P-IT-OBJECT,OBJ /?CND26
|
|
FCLEAR IT,TOUCHBIT
|
|
?CND26: SET 'P-IT-OBJECT,OBJ
|
|
RETURN P-IT-OBJECT
|
|
?CCL18: EQUAL? P-IT-OBJECT,OBJ /?CND28
|
|
FCLEAR IT,TOUCHBIT
|
|
?CND28: SET 'P-IT-OBJECT,OBJ
|
|
RETURN P-IT-OBJECT
|
|
|
|
|
|
.FUNCT DONT-IT,OBJ1,OBJ2,WRD
|
|
EQUAL? OBJ1,OBJ2 \FALSE
|
|
CALL NOUN-USED?,OBJ2,WRD
|
|
ZERO? STACK /FALSE
|
|
FSET? OBJ2,ANIMATEDBIT \FALSE
|
|
CALL2 VISIBLE?,OBJ2
|
|
ZERO? STACK \FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PERFORM-PRSA,O,I
|
|
ICALL PERFORM,PRSA,O,I
|
|
RTRUE
|
|
|
|
|
|
.FUNCT CAPITAL-NOUN?,WRD,TBL
|
|
EQUAL? WRD,W?FLATHEAD,W?DIMWIT,W?URSULA /TRUE
|
|
EQUAL? WRD,W?MEGABOZ,W?JOHN,W?PIERPONT /TRUE
|
|
EQUAL? WRD,W?STONEWALL,W?LUCREZIA,W?SEBASTIAN /TRUE
|
|
EQUAL? WRD,W?DAVISON,W?THOMAS,W?ALVA /TRUE
|
|
EQUAL? WRD,W?LEONARDO,W?JOHANN,W?RALPH /TRUE
|
|
EQUAL? WRD,W?PAUL,W?FRANK,W?LLOYD /TRUE
|
|
EQUAL? WRD,W?BABE,W?ZILBO,W?MERETZKY /TRUE
|
|
EQUAL? WRD,W?FOOBUS,W?BARBAZZO,W?FERNAP /TRUE
|
|
EQUAL? WRD,W?MUMBERTHRAX,W?BOZBO,W?MUMBO /TRUE
|
|
EQUAL? WRD,W?PHLOID,W?BELWIT /TRUE
|
|
GETPT SAINTS,P?SYNONYM >TBL
|
|
ZERO? TBL /?CCL15
|
|
PTSIZE TBL
|
|
DIV STACK,2
|
|
INTBL? WRD,TBL,STACK /TRUE
|
|
?CCL15: INTBL? WRD,FUNGUS-WORDS,12 /TRUE
|
|
INTBL? WRD,MID-NAME-WORDS,12 /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT LIT?,RM,RMBIT,OHERE,LIT,RES,OLD-OBJECT
|
|
ASSIGNED? 'RMBIT /?CND1
|
|
SET 'RMBIT,TRUE-VALUE
|
|
?CND1: SET 'RES,SEARCH-RES
|
|
EQUAL? HERE,UNDERWATER,LAKE-BOTTOM \?CND3
|
|
FSET? EXTERIOR-LIGHT,ONBIT \FALSE
|
|
?CND3: ZERO? RM \?CND7
|
|
SET 'RM,HERE
|
|
?CND7: SET 'OHERE,HERE
|
|
SET 'HERE,RM
|
|
ZERO? RMBIT /?CCL11
|
|
FSET? RM,ONBIT \?CCL11
|
|
SET 'LIT,HERE
|
|
JUMP ?CND9
|
|
?CCL11: FSET? WINNER,ONBIT \?CCL15
|
|
CALL ULTIMATELY-IN?,WINNER,RM
|
|
ZERO? STACK /?CCL15
|
|
SET 'LIT,WINNER
|
|
JUMP ?CND9
|
|
?CCL15: SET 'OLD-OBJECT,RES
|
|
PUT OLD-OBJECT,1,0
|
|
PUT OLD-OBJECT,2,FALSE-VALUE
|
|
PUT OLD-OBJECT,3,FALSE-VALUE
|
|
PUT OLD-OBJECT,4,FALSE-VALUE
|
|
SET 'OLD-OBJECT,FINDER
|
|
PUT OLD-OBJECT,0,ONBIT
|
|
PUT OLD-OBJECT,1,FIND-FLAGS-GWIM
|
|
PUT OLD-OBJECT,2,FALSE-VALUE
|
|
PUT OLD-OBJECT,3,FALSE-VALUE
|
|
PUT OLD-OBJECT,4,0
|
|
PUT OLD-OBJECT,5,FALSE-VALUE
|
|
PUT OLD-OBJECT,6,FALSE-VALUE
|
|
PUT OLD-OBJECT,7,FALSE-VALUE
|
|
PUT OLD-OBJECT,8,FALSE-VALUE
|
|
PUT OLD-OBJECT,9,RES
|
|
PUT OLD-OBJECT,10,0
|
|
EQUAL? OHERE,RM \?CND18
|
|
ICALL FIND-DESCENDANTS,WINNER,7
|
|
EQUAL? WINNER,PROTAGONIST /?CND18
|
|
IN? PROTAGONIST,RM \?CND18
|
|
ICALL FIND-DESCENDANTS,PROTAGONIST,7
|
|
?CND18: GET RES,1
|
|
ZERO? STACK \?CND24
|
|
LOC WINNER
|
|
FSET? STACK,VEHBIT \?CND26
|
|
LOC WINNER
|
|
FSET? STACK,OPENBIT /?CND26
|
|
LOC WINNER
|
|
ICALL FIND-DESCENDANTS,STACK,7
|
|
?CND26: ICALL FIND-DESCENDANTS,RM,7
|
|
?CND24: GET RES,1
|
|
GRTR? STACK,0 \?CND9
|
|
GET RES,4 >LIT
|
|
?CND9: SET 'HERE,OHERE
|
|
RETURN LIT
|
|
|
|
|
|
.FUNCT DEQUEUE,RTN
|
|
CALL2 QUEUED?,RTN >RTN
|
|
ZERO? RTN /FALSE
|
|
PUT RTN,C-RTN,0
|
|
RTRUE
|
|
|
|
|
|
.FUNCT QUEUED?,RTN,C,E
|
|
SET 'E,C-TABLE+60
|
|
ADD C-TABLE,C-INTS >C
|
|
?PRG1: EQUAL? C,E /FALSE
|
|
GET C,C-RTN
|
|
EQUAL? STACK,RTN \?CND3
|
|
GET C,C-TICK
|
|
ZERO? STACK /FALSE
|
|
RETURN C
|
|
?CND3: ADD C,C-INTLEN >C
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT RUNNING?,RTN,C,E
|
|
SET 'E,C-TABLE+60
|
|
ADD C-TABLE,C-INTS >C
|
|
?PRG1: EQUAL? C,E /FALSE
|
|
GET C,C-RTN
|
|
EQUAL? STACK,RTN \?CND3
|
|
GET C,C-TICK
|
|
ZERO? STACK /FALSE
|
|
GET C,C-TICK
|
|
GRTR? STACK,1 /FALSE
|
|
RTRUE
|
|
?CND3: ADD C,C-INTLEN >C
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT QUEUE,RTN,TICK,C,E,INT
|
|
SET 'E,C-TABLE+60
|
|
ADD C-TABLE,C-INTS >C
|
|
?PRG1: EQUAL? C,E \?CCL5
|
|
ZERO? INT /?CCL8
|
|
SET 'C,INT
|
|
JUMP ?CND6
|
|
?CCL8: LESS? C-INTS,C-INTLEN \?CND9
|
|
PRINTI "**Too many ints!**"
|
|
CRLF
|
|
?CND9: SUB C-INTS,C-INTLEN >C-INTS
|
|
LESS? C-INTS,C-MAXINTS \?CND11
|
|
SET 'C-MAXINTS,C-INTS
|
|
?CND11: ADD C-TABLE,C-INTS >INT
|
|
?CND6: PUT INT,C-RTN,RTN
|
|
JUMP ?REP2
|
|
?CCL5: GET C,C-RTN
|
|
EQUAL? STACK,RTN \?CCL14
|
|
SET 'INT,C
|
|
?REP2: ZERO? CLOCK-HAND /?CND16
|
|
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 \?CND3
|
|
SET 'INT,C
|
|
?CND3: ADD C,C-INTLEN >C
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT CLOCKER,E,TICK,RTN,FLG,Q?,OWINNER
|
|
ZERO? CLOCK-WAIT /?CCL3
|
|
SET 'CLOCK-WAIT,FALSE-VALUE
|
|
RFALSE
|
|
?CCL3: ZERO? TIME-STOPPED /?CND1
|
|
INC 'MOVES
|
|
RFALSE
|
|
?CND1: ADD C-TABLE,C-INTS >CLOCK-HAND
|
|
SET 'E,C-TABLE+60
|
|
SET 'OWINNER,WINNER
|
|
SET 'WINNER,PROTAGONIST
|
|
?PRG5: EQUAL? CLOCK-HAND,E \?CCL9
|
|
SET 'CLOCK-HAND,E
|
|
INC 'MOVES
|
|
SET 'WINNER,OWINNER
|
|
RETURN FLG
|
|
?CCL9: GET CLOCK-HAND,C-RTN
|
|
ZERO? STACK /?CND7
|
|
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 ?CND7
|
|
?CCL13: ZERO? TICK /?CND7
|
|
GRTR? TICK,0 \?CND15
|
|
DEC 'TICK
|
|
PUT CLOCK-HAND,C-TICK,TICK
|
|
?CND15: ZERO? TICK /?CND17
|
|
SET 'Q?,CLOCK-HAND
|
|
?CND17: GRTR? TICK,0 /?CND7
|
|
GET CLOCK-HAND,C-RTN >RTN
|
|
ZERO? TICK \?CND21
|
|
PUT CLOCK-HAND,C-RTN,0
|
|
?CND21: CALL RTN
|
|
ZERO? STACK /?CND23
|
|
SET 'FLG,TRUE-VALUE
|
|
?CND23: ZERO? Q? \?CND7
|
|
GET CLOCK-HAND,C-RTN
|
|
ZERO? STACK /?CND7
|
|
SET 'Q?,TRUE-VALUE
|
|
?CND7: ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND
|
|
ZERO? Q? \?PRG5
|
|
ADD C-INTS,C-INTLEN >C-INTS
|
|
JUMP ?PRG5
|
|
|
|
|
|
.FUNCT C-PIXELS,X
|
|
SUB X,1
|
|
MUL STACK,FONT-X
|
|
ADD STACK,1
|
|
RSTACK
|
|
|
|
|
|
.FUNCT L-PIXELS,Y
|
|
SUB Y,1
|
|
MUL STACK,FONT-Y
|
|
ADD STACK,1
|
|
RSTACK
|
|
|
|
|
|
.FUNCT CCURSET,Y,X,?TMP1
|
|
CALL2 L-PIXELS,Y >?TMP1
|
|
CALL2 C-PIXELS,X
|
|
CURSET ?TMP1,STACK
|
|
RTRUE
|
|
|
|
.ENDSEG
|
|
|
|
.ENDI
|