699 lines
13 KiB
Plaintext
699 lines
13 KiB
Plaintext
|
||
.SEGMENT "0"
|
||
|
||
|
||
.FUNCT PRINT-HIM/HER:ANY:1:1,X
|
||
FSET? X,PLURAL \?CCL3
|
||
PRINTI "them"
|
||
RTRUE
|
||
?CCL3: FSET? X,PERSON \?CCL5
|
||
EQUAL? X,ME,WINNER \?CCL8
|
||
PRINTI "yourself"
|
||
RTRUE
|
||
?CCL8: FSET? X,FEMALE \?CCL10
|
||
PRINTI "her"
|
||
RTRUE
|
||
?CCL10: PRINTI "him"
|
||
RTRUE
|
||
?CCL5: PRINTI "it"
|
||
RTRUE
|
||
|
||
|
||
.FUNCT CPRINT-HE/SHE:ANY:1:1,X
|
||
FSET? X,PLURAL \?CCL3
|
||
PRINTI "They"
|
||
RTRUE
|
||
?CCL3: FSET? X,PERSON \?CCL5
|
||
EQUAL? X,ME,WINNER \?CCL8
|
||
PRINTI "You"
|
||
RTRUE
|
||
?CCL8: FSET? X,FEMALE \?CCL10
|
||
PRINTI "She"
|
||
RTRUE
|
||
?CCL10: PRINTI "He"
|
||
RTRUE
|
||
?CCL5: PRINTI "It"
|
||
RTRUE
|
||
|
||
|
||
.FUNCT PRINT-HE/SHE:ANY:1:1,X
|
||
FSET? X,PLURAL \?CCL3
|
||
PRINTI "they"
|
||
RTRUE
|
||
?CCL3: FSET? X,PERSON \?CCL5
|
||
EQUAL? X,ME,WINNER \?CCL8
|
||
PRINTI "yourself"
|
||
RTRUE
|
||
?CCL8: FSET? X,FEMALE \?CCL10
|
||
PRINTI "she"
|
||
RTRUE
|
||
?CCL10: PRINTI "he"
|
||
RTRUE
|
||
?CCL5: PRINTI "it"
|
||
RTRUE
|
||
|
||
|
||
.FUNCT PRINT-HIS/HER:ANY:1:1,X
|
||
FSET? X,PLURAL \?CCL3
|
||
PRINTI "their"
|
||
RTRUE
|
||
?CCL3: FSET? X,PERSON \?CCL5
|
||
EQUAL? X,ME,WINNER \?CCL8
|
||
PRINTI "your"
|
||
RTRUE
|
||
?CCL8: FSET? X,FEMALE \?CCL10
|
||
PRINTI "her"
|
||
RTRUE
|
||
?CCL10: PRINTI "his"
|
||
RTRUE
|
||
?CCL5: PRINTI "its"
|
||
RTRUE
|
||
|
||
|
||
.FUNCT PRINT-PLURAL:ANY:1:1,OBJ
|
||
FSET? OBJ,PLURAL /FALSE
|
||
PRINTC 115
|
||
RTRUE
|
||
|
||
|
||
.FUNCT PRINTUNDER:ANY:1:1,X
|
||
HLIGHT H-UNDER
|
||
PRINT X
|
||
HLIGHT H-NORMAL
|
||
RTRUE
|
||
|
||
|
||
.FUNCT CTHE-PRINT-PRSO:ANY:0:0
|
||
CALL THE-PRINT,PRSO,TRUE-VALUE
|
||
RSTACK
|
||
|
||
|
||
.FUNCT CTHE-PRINT-PRSI:ANY:0:0
|
||
CALL THE-PRINT,PRSI,TRUE-VALUE
|
||
RSTACK
|
||
|
||
|
||
.FUNCT CTHE-PRINT:ANY:1:1,O
|
||
CALL THE-PRINT,O,TRUE-VALUE
|
||
RSTACK
|
||
|
||
|
||
.FUNCT THE-PRINT-PRSO:ANY:0:0
|
||
CALL2 THE-PRINT,PRSO
|
||
RSTACK
|
||
|
||
|
||
.FUNCT THE-PRINT-PRSI:ANY:0:0
|
||
CALL2 THE-PRINT,PRSI
|
||
RSTACK
|
||
|
||
|
||
.FUNCT THE-PRINT:ANY:1:2,O,CAP?
|
||
FSET? O,NOTHEBIT /?PRD2
|
||
PUSH 1
|
||
JUMP ?PEN1
|
||
?PRD2: PUSH 0
|
||
?PEN1: CALL DPRINT,O,CAP?,STACK
|
||
RSTACK
|
||
|
||
|
||
.FUNCT CPRINTA-PRSO:ANY:0:0
|
||
CALL PRINTA,PRSO,TRUE-VALUE
|
||
RSTACK
|
||
|
||
|
||
.FUNCT PRINTA-PRSO:ANY:0:0
|
||
CALL2 PRINTA,PRSO
|
||
RSTACK
|
||
|
||
|
||
.FUNCT PRINTA-PRSI:ANY:0:0
|
||
CALL2 PRINTA,PRSI
|
||
RSTACK
|
||
|
||
|
||
.FUNCT PRINTA:ANY:1:2,O,CAP?
|
||
FSET? O,THE \?CCL3
|
||
ZERO? CAP? /?CCL6
|
||
PRINTI "The "
|
||
JUMP ?CND1
|
||
?CCL6: PRINTI "the "
|
||
JUMP ?CND1
|
||
?CCL3: FSET? O,NOABIT /?CND1
|
||
FSET? O,AN \?CCL10
|
||
ZERO? CAP? /?CCL13
|
||
PRINTI "An "
|
||
JUMP ?CND1
|
||
?CCL13: PRINTI "an "
|
||
JUMP ?CND1
|
||
?CCL10: ZERO? CAP? /?CCL15
|
||
PRINTI "A "
|
||
JUMP ?CND1
|
||
?CCL15: PRINTI "a "
|
||
?CND1: CALL2 IPRINT,O
|
||
RSTACK
|
||
|
||
|
||
.FUNCT DPRINT-PRSO:ANY:0:0
|
||
CALL2 DPRINT,PRSO
|
||
RSTACK
|
||
|
||
|
||
.FUNCT DPRINT-PRSI:ANY:0:0
|
||
CALL2 DPRINT,PRSI
|
||
RSTACK
|
||
|
||
|
||
.FUNCT DPRINT:ANY:1:3,O,CAP?,THE?,S
|
||
EQUAL? O,PLAYER,ME \?CCL3
|
||
ZERO? CAP? /?CCL6
|
||
PRINTI "You"
|
||
RTRUE
|
||
?CCL6: PRINTI "you"
|
||
RTRUE
|
||
?CCL3: EQUAL? O,RUTTER \?CCL8
|
||
ZERO? CAP? /?CCL8
|
||
PRINTI "Your rutter"
|
||
RTRUE
|
||
?CCL8: CALL2 GET-OWNER,O >S
|
||
ZERO? S /?CCL13
|
||
GETP O,P?OWNER
|
||
EQUAL? S,STACK /?CCL13
|
||
EQUAL? S,PLAYER \?CCL18
|
||
ZERO? CAP? /?CCL21
|
||
PRINTI "Your "
|
||
JUMP ?CND11
|
||
?CCL21: PRINTI "your "
|
||
JUMP ?CND11
|
||
?CCL18: ICALL DPRINT,S,CAP?
|
||
PRINTI "'s "
|
||
JUMP ?CND11
|
||
?CCL13: ZERO? THE? \?CCL22
|
||
FSET? O,THE \?CND11
|
||
?CCL22: ZERO? CAP? /?CCL27
|
||
PRINTI "The "
|
||
JUMP ?CND11
|
||
?CCL27: PRINTI "the "
|
||
?CND11: CALL2 IPRINT,O
|
||
RSTACK
|
||
|
||
|
||
.FUNCT IPRINT:ANY:1:1,O,TMP
|
||
GETP O,P?SDESC >TMP
|
||
ZERO? TMP /?CCL3
|
||
PRINT TMP
|
||
RTRUE
|
||
?CCL3: PRINTD O
|
||
RTRUE
|
||
|
||
|
||
.FUNCT PICK-ONE:ANY:1:1,FROB,L,CNT,RND,MSG,RFROB
|
||
GET FROB,0 >L
|
||
GET FROB,1 >CNT
|
||
DEC 'L
|
||
ADD FROB,2 >FROB
|
||
MUL CNT,2
|
||
ADD FROB,STACK >RFROB
|
||
SUB L,CNT
|
||
RANDOM STACK >RND
|
||
GET RFROB,RND >MSG
|
||
GET RFROB,1
|
||
PUT RFROB,RND,STACK
|
||
PUT RFROB,1,MSG
|
||
INC 'CNT
|
||
EQUAL? CNT,L \?CND1
|
||
SET 'CNT,0
|
||
?CND1: PUT FROB,0,CNT
|
||
RETURN MSG
|
||
|
||
|
||
.FUNCT SCENE-SELECT:ANY:0:1,FULL?,TMP,M,WID,WHICH,L,Y,END,?TMP1
|
||
GET PART-MENU,0
|
||
ADD STACK,1 >L
|
||
WINGET S-FULL,WHIGH
|
||
ADD 1,STACK >END
|
||
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS \?CND1
|
||
ADD L,2 >L
|
||
?CND1: MUL L,FONT-Y >TMP
|
||
SUB END,TMP >Y
|
||
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS \?CND3
|
||
MUL 2,FONT-Y
|
||
SUB Y,STACK >Y
|
||
?CND3: WINGET S-TEXT,WLEFT >?TMP1
|
||
WINGET S-TEXT,WWIDE
|
||
ICALL WINDEF,S-TEXT,Y,?TMP1,TMP,STACK
|
||
ICALL1 RESET-MARGIN
|
||
?PRG5: CLEAR S-TEXT
|
||
SCREEN S-TEXT
|
||
CALL GET-FROM-MENU,STR?6,PART-MENU,SCENE-SELECT-F,1 >WHICH
|
||
ZERO? WHICH /?PRG5
|
||
RTRUE
|
||
|
||
|
||
.FUNCT SCENE-SELECT-F:ANY:2:2,TMP,M
|
||
EQUAL? TMP,1 \?CCL3
|
||
ICALL1 SETUP-TEXT-AND-STATUS
|
||
GET SCENES,1 >SCENE
|
||
RETURN SCENE
|
||
?CCL3: EQUAL? TMP,2 \?CCL5
|
||
CLEAR S-TEXT
|
||
ICALL1 V-RESTORE
|
||
ICALL1 RESET-MARGIN
|
||
CLEAR S-TEXT
|
||
RFALSE
|
||
?CCL5: EQUAL? TMP,3 \FALSE
|
||
CLEAR S-TEXT
|
||
ICALL V-QUIT,TRUE-VALUE,FALSE-VALUE
|
||
ICALL1 RESET-MARGIN
|
||
CLEAR S-TEXT
|
||
RFALSE
|
||
|
||
.ENDSEG
|
||
|
||
.SEGMENT "STARTUP"
|
||
|
||
|
||
.FUNCT GO:ANY:0:0
|
||
?FCN: MOUSE-LIMIT -1
|
||
GETB 0,30 >MACHINE
|
||
GETB 0,45 >FG-COLOR
|
||
GETB 0,44 >BG-COLOR
|
||
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS \?CCL4
|
||
SET 'TEXT-MARGIN,0
|
||
PICINF P-BORDER,YX-TBL \?CND2
|
||
GET YX-TBL,0 >BORDER-HEIGHT
|
||
JUMP ?CND2
|
||
?CCL4: SET 'TEXT-MARGIN,2
|
||
?CND2: SET 'LIT,TRUE-VALUE
|
||
ADD C-TABLE,C-TABLELEN >CLOCK-HAND
|
||
SET 'PLAYER,BLACKTHORNE
|
||
ICALL1 SETUP-FULL
|
||
ICALL1 TITLE-SCREEN
|
||
ZERO? DEMO-VERSION? /?CND7
|
||
ICALL1 SLIDE-SHOW
|
||
JUMP ?FCN
|
||
?CND7: ICALL1 SETUP-DISPLAY
|
||
ICALL1 SCENE-SELECT
|
||
ICALL GOTO-SCENE,SCENE,FALSE-VALUE
|
||
CALL1 MAIN-LOOP
|
||
RSTACK
|
||
|
||
|
||
.FUNCT SLIDE-SHOW:ANY:0:0
|
||
CLEAR -1
|
||
PRINTI "This is a demonstration version of SHOGUN.
|
||
|
||
First you will see a few samples of the graphic screens that await you in SHOGUN. We've used graphics in surprising new ways to enhance the story without detracting from Infocom's traditional richness and depth.
|
||
Then you will be able to interact with a small section of SHOGUN. Feel free to try the new friendlier parser, the optional mouse interface, and the on-screen hints.
|
||
SHOGUN is an adaptation of James Clavell's novel, which has sold over 7 million copies and inspired the popular T.V. mini-series. Dave Lebling, while collaborating with Clavell, has incorporated the creative style and rich prose that have made his earlier ZORK titles so popular.
|
||
In SHOGUN you are transcended into the world of Clavell's saga, which combines all of the mystery and action of a great adventure story with the intensity and romance of a classic love story. Whether you find yourself matching wits with tyrannical Japanese aristocrats or fighting off attacks by Ninja assassins, you are sure to be both challenged and entertained. Both the action and the intriguing, historical locale set the stage for unparalleled fun and excitement.
|
||
"
|
||
ICALL1 TYPE-ANY-KEY
|
||
CALL1 END-DEMO
|
||
RSTACK
|
||
|
||
|
||
.FUNCT END-DEMO:ANY:0:0
|
||
?FCN: CLEAR -1
|
||
PRINTI "
|
||
You have reached the end of this demonstration version of
|
||
"
|
||
ICALL1 V-VERSION
|
||
PRINTI "
|
||
|
||
"
|
||
ICALL1 TYPE-ANY-KEY
|
||
SCREEN S-TEXT
|
||
RESTART
|
||
PRINT FAILED
|
||
JUMP ?FCN
|
||
|
||
.ENDSEG
|
||
|
||
.SEGMENT "0"
|
||
|
||
|
||
.FUNCT SETUP-FULL:ANY:0:0,HIGH,WIDE,X
|
||
GET 0,18 >HIGH
|
||
GET 0,17 >WIDE
|
||
ICALL WINDEF,S-FULL,1,1,HIGH,WIDE
|
||
WINGET S-TEXT,WFSIZE >X
|
||
SHIFT X,-8 >FONT-Y
|
||
BAND X,255 >FONT-X
|
||
RETURN FONT-X
|
||
|
||
|
||
.FUNCT SETUP-DISPLAY:ANY:0:0,HIGH,WIDE
|
||
GET 0,18 >HIGH
|
||
GET 0,17 >WIDE
|
||
MOUSE-LIMIT -1
|
||
ICALL1 SETUP-FULL
|
||
ICALL1 SETUP-TEXT-AND-STATUS
|
||
WINGET S-TEXT,WWIDE >WIDE
|
||
MARGIN TEXT-MARGIN,TEXT-MARGIN,S-TEXT
|
||
MUL 2,TEXT-MARGIN
|
||
SUB WIDE,STACK >WIDE
|
||
GETB P-INBUF,0 >WIDTH
|
||
DIV WIDE,FONT-X >WIDE
|
||
LESS? WIDE,WIDTH \FALSE
|
||
SET 'WIDTH,WIDE
|
||
GRTR? WIDE,INBUF-LENGTH \?CCL6
|
||
PUSH INBUF-LENGTH
|
||
JUMP ?CND4
|
||
?CCL6: PUSH WIDE
|
||
?CND4: PUTB P-INBUF,0,STACK
|
||
RTRUE
|
||
|
||
|
||
.FUNCT REPAINT-DISPLAY:ANY:0:1,NO-BORDER?
|
||
ICALL1 RESET-MARGIN
|
||
ICALL1 NORMAL-COLOR
|
||
ICALL1 SETUP-DISPLAY
|
||
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS /?CCL2
|
||
ZERO? NO-BORDER? \?CND1
|
||
?CCL2: ICALL1 DISPLAY-BORDER
|
||
?CND1: ICALL2 INIT-STATUS-LINE,TRUE-VALUE
|
||
EQUAL? HERE,MAZE \FALSE
|
||
CALL1 DISPLAY-MAZE
|
||
RSTACK
|
||
|
||
|
||
.FUNCT GOTO-SCENE:ANY:1:2,SC,OSC
|
||
ASSIGNED? 'OSC /?CND1
|
||
SET 'OSC,SCENE
|
||
?CND1: CLEAR S-TEXT
|
||
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS \?CCL5
|
||
ZERO? OSC \?CCL5
|
||
SCREEN S-STATUS
|
||
CLEAR S-STATUS
|
||
ICALL2 DISPLAY-BORDER,P-EBORDER
|
||
JUMP ?CND3
|
||
?CCL5: EQUAL? CURRENT-BORDER,P-BORDER /?CND3
|
||
ICALL2 DISPLAY-BORDER,P-BORDER
|
||
?CND3: ICALL1 END-QUOTE
|
||
ICALL1 RESET-MARGIN
|
||
ICALL1 DEQUEUE-ALL
|
||
SET 'ORPHAN-ANSWER,FALSE-VALUE
|
||
SET 'SCENE,SC
|
||
GET SCENE-LOCS,SCENE >HERE
|
||
GETB SCENE-PICS,SCENE
|
||
ICALL2 TOUCH-SEG,STACK
|
||
FCLEAR HERE,TOUCHBIT
|
||
SET 'QCONTEXT,FALSE-VALUE
|
||
ICALL2 MOVE-ALL,BLACKTHORNE
|
||
MOVE BLACKTHORNE,HERE
|
||
FCLEAR BLACKTHORNE,RMUNGBIT
|
||
SET 'P-IT-OBJECT,FALSE-VALUE
|
||
SET 'P-HIM-OBJECT,FALSE-VALUE
|
||
SET 'P-HER-OBJECT,FALSE-VALUE
|
||
SET 'P-THEM-OBJECT,FALSE-VALUE
|
||
ICALL1 B-STAND
|
||
SET 'OPPONENT,FALSE-VALUE
|
||
GETP HERE,P?ACTION
|
||
ICALL STACK,M-SCENE-SETUP
|
||
SET 'WINNER,PLAYER
|
||
CLEAR S-TEXT
|
||
ZERO? OSC \?CCL11
|
||
CLEAR S-STATUS
|
||
ICALL1 INIT-STATUS-LINE
|
||
JUMP ?CND9
|
||
?CCL11: ICALL2 UPDATE-STATUS-LINE,TRUE-VALUE
|
||
?CND9: ICALL2 GOTO,HERE
|
||
ZERO? OSC \TRUE
|
||
ICALL1 CLOCKER
|
||
SET 'MOVES,0
|
||
RTRUE
|
||
|
||
|
||
.FUNCT TOUCH-SEG:ANY:1:1,S
|
||
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS /?CCL3
|
||
EQUAL? MACHINE,IBM \FALSE
|
||
?CCL3: PICINF S,YX-TBL /TRUE
|
||
RFALSE
|
||
|
||
|
||
.FUNCT GAME-VERB?:ANY:0:0
|
||
EQUAL? PRSA,V?TELL \?CCL3
|
||
ZERO? P-CONT \TRUE
|
||
?CCL3: EQUAL? PRSA,V?HELP \?CCL7
|
||
ZERO? PRSO /TRUE
|
||
?CCL7: EQUAL? PRSA,V?QUIT,V?VERSION,V?BRIEF /TRUE
|
||
EQUAL? PRSA,V?SUPER-BRIEF,V?VERBOSE,V?COLOR /TRUE
|
||
EQUAL? PRSA,V?$VERIFY,V?RESTART,V?SAVE /TRUE
|
||
EQUAL? PRSA,V?RESTORE,V?SCRIPT,V?UNSCRIPT /TRUE
|
||
EQUAL? PRSA,V?UNDO,V?SCORE,V?TIME /TRUE
|
||
EQUAL? PRSA,V?DEFINE,V?$REFRESH,V?NOTIFY /TRUE
|
||
EQUAL? PRSA,V?HINT,V?HINTS-OFF,V?CREDITS /TRUE
|
||
EQUAL? PRSA,V?$RANDOM,V?$COMMAND,V?$RECORD /TRUE
|
||
EQUAL? PRSA,V?$UNRECORD /TRUE
|
||
RFALSE
|
||
|
||
|
||
.FUNCT END-QUOTE:ANY:0:0
|
||
SET 'P-CONT,FALSE-VALUE
|
||
RETURN M-FATAL
|
||
|
||
|
||
.FUNCT DEQUEUE:ANY:1:1,RTN,TIM
|
||
CALL2 QUEUED?,RTN >RTN
|
||
ZERO? RTN /FALSE
|
||
GET RTN,C-TICK >TIM
|
||
PUT RTN,C-RTN,0
|
||
RETURN TIM
|
||
|
||
|
||
.FUNCT QUEUED?:ANY:1:1,RTN,C,E
|
||
ADD C-TABLE,C-TABLELEN >E
|
||
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 QUEUE:ANY:2:3,RTN,TICK,I?,C,E,INT
|
||
ADD C-TABLE,C-TABLELEN >E
|
||
ADD C-TABLE,C-INTS >C
|
||
?PRG1: EQUAL? C,E \?CCL5
|
||
ZERO? INT /?CCL8
|
||
SET 'C,INT
|
||
JUMP ?CND6
|
||
?CCL8: SUB C-INTS,C-INTLEN >C-INTS
|
||
ADD C-TABLE,C-INTS >INT
|
||
?CND6: PUT INT,C-RTN,RTN
|
||
JUMP ?REP2
|
||
?CCL5: GET C,C-RTN
|
||
EQUAL? STACK,RTN \?CCL10
|
||
ZERO? I? \FALSE
|
||
SET 'INT,C
|
||
?REP2: GRTR? INT,CLOCK-HAND \?CND15
|
||
ADD TICK,3
|
||
SUB 0,STACK >TICK
|
||
?CND15: PUT INT,C-TICK,TICK
|
||
RETURN INT
|
||
?CCL10: GET C,C-RTN
|
||
ZERO? STACK \?CND3
|
||
SET 'INT,C
|
||
?CND3: ADD C,C-INTLEN >C
|
||
JUMP ?PRG1
|
||
|
||
|
||
.FUNCT CLOCKER:ANY:0:0,E,TICK,RTN,FLG,Q?,OWINNER,TMP
|
||
ZERO? CLOCK-WAIT /?CND1
|
||
SET 'CLOCK-WAIT,FALSE-VALUE
|
||
RFALSE
|
||
?CND1: EQUAL? HERE,STATIONARY? \?CCL5
|
||
INC 'STATIONARY-CNT
|
||
JUMP ?CND3
|
||
?CCL5: SET 'STATIONARY?,HERE
|
||
SET 'STATIONARY-CNT,0
|
||
?CND3: ADD C-TABLE,C-INTS >CLOCK-HAND
|
||
ADD C-TABLE,C-TABLELEN >E
|
||
SET 'OWINNER,WINNER
|
||
SET 'WINNER,PLAYER
|
||
?PRG6: ZERO? NEW-SCENE-NUMBER /?CND8
|
||
ICALL1 I-NEW-SCENE
|
||
ADD C-TABLE,C-INTS >CLOCK-HAND
|
||
SET 'FLG,TRUE-VALUE
|
||
?CND8: EQUAL? CLOCK-HAND,E \?CCL12
|
||
INC 'MOVES
|
||
SET 'WINNER,OWINNER
|
||
RETURN FLG
|
||
?CCL12: GET CLOCK-HAND,C-RTN
|
||
ZERO? STACK /?CND10
|
||
GET CLOCK-HAND,C-TICK >TICK
|
||
LESS? TICK,-1 \?CCL16
|
||
SUB 0,TICK
|
||
SUB STACK,3
|
||
PUT CLOCK-HAND,C-TICK,STACK
|
||
SET 'Q?,CLOCK-HAND
|
||
JUMP ?CND10
|
||
?CCL16: ZERO? TICK /?CND10
|
||
GRTR? TICK,0 \?CND18
|
||
DEC 'TICK
|
||
PUT CLOCK-HAND,C-TICK,TICK
|
||
?CND18: ZERO? TICK /?CND20
|
||
SET 'Q?,CLOCK-HAND
|
||
?CND20: GRTR? TICK,0 /?CND10
|
||
GET CLOCK-HAND,C-RTN >RTN
|
||
ZERO? TICK \?CND24
|
||
PUT CLOCK-HAND,C-RTN,0
|
||
?CND24: CALL RTN >TMP
|
||
ZERO? TMP /?CND26
|
||
SET 'FLG,TMP
|
||
?CND26: ZERO? Q? \?CND10
|
||
GET CLOCK-HAND,C-RTN
|
||
ZERO? STACK /?CND10
|
||
SET 'Q?,TRUE-VALUE
|
||
?CND10: ZERO? NEW-SCENE-NUMBER /?CCL34
|
||
ADD C-TABLE,C-INTS >CLOCK-HAND
|
||
JUMP ?PRG6
|
||
?CCL34: EQUAL? FLG,M-FATAL \?CCL36
|
||
SET 'CLOCK-HAND,E
|
||
JUMP ?PRG6
|
||
?CCL36: EQUAL? CLOCK-HAND,E /?PRG6
|
||
ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND
|
||
ZERO? Q? \?PRG6
|
||
ADD C-INTS,C-INTLEN >C-INTS
|
||
JUMP ?PRG6
|
||
|
||
|
||
.FUNCT DEQUEUE-ALL:ANY:0:0,E,TICK,RTN,FLG,Q?
|
||
ZERO? CLOCK-WAIT /?CND1
|
||
SET 'CLOCK-WAIT,FALSE-VALUE
|
||
RFALSE
|
||
?CND1: ADD C-TABLE,C-INTS >CLOCK-HAND
|
||
ADD C-TABLE,C-TABLELEN >E
|
||
?PRG3: EQUAL? CLOCK-HAND,E \?CCL7
|
||
SET 'CLOCK-HAND,E
|
||
RTRUE
|
||
?CCL7: PUT CLOCK-HAND,C-TICK,0
|
||
PUT CLOCK-HAND,C-RTN,0
|
||
ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND
|
||
ADD C-INTS,C-INTLEN >C-INTS
|
||
JUMP ?PRG3
|
||
|
||
|
||
.FUNCT PERFORM-PRSA:ANY:0:2,O,I
|
||
CALL PERFORM,PRSA,O,I
|
||
RSTACK
|
||
|
||
|
||
.FUNCT NEW-VERB:ANY:1:1,V
|
||
CALL PERFORM,V,PRSO,PRSI
|
||
RSTACK
|
||
|
||
|
||
.FUNCT SWAP-VERB:ANY:1:1,V
|
||
CALL PERFORM,V,PRSI,PRSO
|
||
RSTACK
|
||
|
||
|
||
.FUNCT NEW-PRSO:ANY:1:1,O
|
||
CALL PERFORM-PRSA,O,PRSI
|
||
RSTACK
|
||
|
||
|
||
.FUNCT NEW-WINNER-PRSO:ANY:1:3,A,O,I,OW
|
||
SET 'OW,WINNER
|
||
SET 'WINNER,PRSO
|
||
ICALL PERFORM,A,O,I
|
||
SET 'WINNER,OW
|
||
RTRUE
|
||
|
||
|
||
.FUNCT REDIRECT:ANY:2:2,FROM,TO,O,I
|
||
EQUAL? PRSO,FROM \?CCL3
|
||
SET 'O,TO
|
||
JUMP ?CND1
|
||
?CCL3: SET 'O,PRSO
|
||
?CND1: EQUAL? PRSI,FROM \?CCL6
|
||
SET 'I,TO
|
||
JUMP ?CND4
|
||
?CCL6: SET 'I,PRSI
|
||
?CND4: ICALL PERFORM-PRSA,O,I
|
||
RTRUE
|
||
|
||
|
||
.FUNCT CREWMAN?:ANY:1:1,OBJ
|
||
EQUAL? OBJ,CREWMEN,LG-CREWMEN /FALSE
|
||
FSET? OBJ,DUTCHBIT /TRUE
|
||
RFALSE
|
||
|
||
|
||
.FUNCT WINDEF:ANY:5:5,W,TOP,LEFT,HIGH,WIDE
|
||
WINPOS W,TOP,LEFT
|
||
WINSIZE W,HIGH,WIDE
|
||
RTRUE
|
||
|
||
|
||
.FUNCT C-PIXELS:ANY:1:1,X
|
||
SUB X,1
|
||
MUL STACK,FONT-X
|
||
ADD STACK,1
|
||
RSTACK
|
||
|
||
|
||
.FUNCT L-PIXELS:ANY:1:1,Y
|
||
SUB Y,1
|
||
MUL STACK,FONT-Y
|
||
ADD STACK,1
|
||
RSTACK
|
||
|
||
|
||
.FUNCT CCURSET:ANY:2:2,Y,X,?TMP1
|
||
CALL2 L-PIXELS,Y >?TMP1
|
||
CALL2 C-PIXELS,X
|
||
CURSET ?TMP1,STACK
|
||
RTRUE
|
||
|
||
|
||
.FUNCT IN-SCENE?:ANY:1:1,OBJ,SC,PT
|
||
GETPT OBJ,P?SCENE >SC
|
||
ZERO? SC /TRUE
|
||
PTSIZE SC >PT
|
||
INTBL? SCENE,SC,PT,1 /TRUE
|
||
RFALSE
|
||
|
||
|
||
.FUNCT REPLACE-SYNONYM:ANY:3:4,OBJ,OLD,NEW,DUP?,TMP,S,L
|
||
GETPT OBJ,P?SYNONYM >S
|
||
ZERO? S /FALSE
|
||
PTSIZE S
|
||
DIV STACK,2 >L
|
||
ZERO? DUP? \?CCL6
|
||
INTBL? NEW,S,L /TRUE
|
||
?CCL6: INTBL? OLD,S,L >TMP \FALSE
|
||
PUT TMP,0,NEW
|
||
RTRUE
|
||
|
||
|
||
.FUNCT REPLACE-ADJECTIVE:ANY:3:4,OBJ,OLD,NEW,DUP?,TMP,S,L
|
||
GETPT OBJ,P?ADJECTIVE >S
|
||
ZERO? S /FALSE
|
||
PTSIZE S
|
||
DIV STACK,2 >L
|
||
ZERO? DUP? \?CCL6
|
||
INTBL? NEW,S,L /TRUE
|
||
?CCL6: INTBL? OLD,S,L >TMP \FALSE
|
||
PUT TMP,0,NEW
|
||
RTRUE
|
||
|
||
|
||
.FUNCT CURSOR-OFF:ANY:0:0
|
||
CURSET -1
|
||
RTRUE
|
||
|
||
|
||
.FUNCT CURSOR-ON:ANY:0:0
|
||
CURSET -2
|
||
RTRUE
|
||
|
||
.ENDSEG
|
||
|
||
.ENDI
|