journey/input.zap
historicalsource 689e06b55f Final Revision
2019-04-14 16:35:30 -04:00

2140 lines
46 KiB
Plaintext

.SEGMENT "0"
.FUNCT NEXT-DAY:ANY:0:1,AMT
ASSIGNED? 'AMT /?CND1
SET 'AMT,1
?CND1: GRTR? TOP-SCREEN-LINE,0 /TRUE
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
ADD DAY,AMT >DAY
SUB SCREEN-WIDTH,10
ICALL GCURSET,1,STACK
HLIGHT H-INVERSE
PRINTN DAY
EQUAL? DAY,3,23,33 \?CCL7
PRINTI "rd"
JUMP ?CND5
?CCL7: EQUAL? DAY,2,22,32 \?CCL9
PRINTI "nd"
JUMP ?CND5
?CCL9: EQUAL? DAY,1,21,31 \?CCL11
PRINTI "st"
JUMP ?CND5
?CCL11: PRINTI "th"
?CND5: PRINTI " Day"
HLIGHT H-NORMAL
CALL2 SELECT-SCREEN,TEXT-WINDOW
RSTACK
.FUNCT FILL-CHARACTER-TBL:ANY:0:0,OFF,CHR,TBLI,TBLC,ICNT,CCNT,CMD
SET 'UPDATE-FLAG,FALSE-VALUE
EQUAL? PARTY-MODE,FIGHT-MODE \?CND1
ZERO? MODE-ENTRANCE-FLAG /TRUE
?CND1: SET 'MODE-ENTRANCE-FLAG,FALSE-VALUE
?PRG5: IGRTR? 'OFF,5 /TRUE
GET PARTY,OFF >CHR
ZERO? CHR /?CCL11
FSET? CHR,BUSY /?PRG5
?CCL11: GRTR? OFF,PARTY-MAX /?CTR14
ZERO? SUBGROUP-MODE /?CCL15
FSET? CHR,SUBGROUP /?CCL15
FSET? CHR,SHADOW /?CCL15
?CTR14: GET CHARACTER-INPUT-TBL,OFF
COPYT NUL-CHARACTER-INPUT,STACK,6
JUMP ?PRG5
?CCL15: SET 'CCNT,-1
SET 'ICNT,-1
GETPT CHR,PARTY-MODE-PROPERTY >TBLC
GET CHARACTER-INPUT-TBL,OFF >TBLI
?PRG21: IGRTR? 'CCNT,2 /?PRG30
GET TBLC,CCNT
CALL VALID-OPTION,STACK,CHR >CMD
EQUAL? PARTY-MODE,FIGHT-MODE /?CCL27
EQUAL? CMD,NUL-COMMAND /?PRG21
?CCL27: INC 'ICNT
PUT TBLI,ICNT,CMD
JUMP ?PRG21
?PRG30: IGRTR? 'ICNT,2 /?PRG5
PUT TBLI,ICNT,NUL-COMMAND
JUMP ?PRG30
.FUNCT VALID-OPTION:ANY:2:2,CMD,CHR,OFCN
EQUAL? CMD,GET-ADVICE-COMMAND \?CCL3
EQUAL? PARTY-MODE,OPTION-MODE /?CCL3
FSET? HERE,ADVISE /?CCL3
FSET? SCENE-OBJECT,ADVISE /?CCL3
RETURN NUL-COMMAND
?CCL3: EQUAL? CMD,MIX-COMMAND \?CCL9
FSET? REAGENT,SOLVED /?CCL9
RETURN NUL-COMMAND
?CCL9: EQUAL? CMD,DROP-COMMAND,SELL-COMMAND \?CCL13
FSET? HERE,DONT-DROP \?CCL13
RETURN NUL-COMMAND
?CCL13: EQUAL? CMD,SCOUT-COMMAND,LOOK-AROUND-COMMAND \?CCL17
EQUAL? PARTY-MODE,OPTION-MODE /?CCL17
EQUAL? HERE,MINE-HOLE \?CCL22
GETP HERE,P?TEMP
EQUAL? CHR,STACK \?CCL22
RETURN CMD
?CCL22: FSET? HERE,DONT-SCOUT /?CTR25
FSET? SCENE-OBJECT,DONT-SCOUT \?CCL26
?CTR25: RETURN NUL-COMMAND
?CCL26: RETURN CMD
?CCL17: EQUAL? CMD,INVENTORY-COMMAND \?CCL30
FSET? HERE,INVENTORIED \?CCL30
RETURN NUL-COMMAND
?CCL30: EQUAL? CMD,CAST-COMMAND,USE-MIX-COMMAND,MIX-COMMAND \?CCL34
EQUAL? PARTY-MODE,OPTION-MODE,FIGHT-MODE /?CCL34
FSET? HERE,DONT-CAST \?CCL34
RETURN NUL-COMMAND
?CCL34: EQUAL? CMD,CAST-COMMAND \?CCL39
FSET? SCENE-OBJECT,DONT-CAST \?CCL39
RETURN NUL-COMMAND
?CCL39: EQUAL? CMD,EXAMINE-COMMAND,INVENTORY-COMMAND,PICK-UP-COMMAND \?CCL43
FSET? HERE,UNDERGROUND \?CCL43
EQUAL? HERE,SUNSET-TOWER /?CCL43
FSET? PRAXIX,LIT /?CCL43
FSET? HERE,LIT /?CCL43
FSET? HURTH,IN-PARTY /?CCL43
RETURN NUL-COMMAND
?CCL43: GET CMD,COMMAND-OBJECT >OFCN
ZERO? OFCN \?CCL51
RETURN CMD
?CCL51: PUT O-TABLE,0,0
SET 'ACTOR,CHR
ICALL OFCN
GET O-TABLE,0
ZERO? STACK \?CCL54
RETURN NUL-COMMAND
?CCL54: RETURN CMD
.FUNCT MODE:ANY:1:3,M,INIT?,DUF?,TBL,OFF,?TMP1
SET 'MODE-ENTRANCE-FLAG,TRUE-VALUE
SET 'PARTY-MODE,M
GETP M,P?ACTION >PARTY-MODE-PROPERTY
ZERO? DUF? \?CCL3
SET 'UPDATE-FLAG,TRUE-VALUE
JUMP ?CND1
?CCL3: SET 'UPDATE-FLAG,FALSE-VALUE
?CND1: GETPT M,P?MODE-COMMANDS >TBL
ZERO? TBL /?CCL6
ADD PARTY-COMMANDS,2 >?TMP1
PTSIZE TBL
COPYT TBL,?TMP1,STACK
JUMP ?CND4
?CCL6: GETPT HERE,P?TRAVEL-COMMANDS >TBL
ADD PARTY-COMMANDS,2
PTSIZE TBL >OFF
COPYT TBL,STACK,OFF
LESS? OFF,8 \?CND4
PUT PARTY-COMMANDS,4,NUL-COMMAND
?CND4: ZERO? INIT? /?CCL11
CALL2 PRINT-COLUMNS,TRUE-VALUE
RSTACK
?CCL11: SET 'PUPDATE-FLAG,TRUE-VALUE
RETURN PUPDATE-FLAG
.FUNCT INIT-SCREEN:ANY:0:0,LN,POS,F,IC-WID,OLN,WIDTH,?TMP3,?TMP2,?TMP1
EQUAL? INTERPRETER,INT-PC \?CCL3
SET 'BORDER-FLAG,FALSE-VALUE
SET 'FONT3-FLAG,FALSE-VALUE
SET 'FWC-FLAG,FALSE-VALUE
SET 'BLACK-PICTURE-BORDER,FALSE-VALUE
JUMP ?CND1
?CCL3: EQUAL? INTERPRETER,INT-MAC \?CCL5
SET 'BORDER-FLAG,FALSE-VALUE
SET 'FONT3-FLAG,TRUE-VALUE
SET 'FWC-FLAG,TRUE-VALUE
SET 'BLACK-PICTURE-BORDER,TRUE-VALUE
JUMP ?CND1
?CCL5: EQUAL? INTERPRETER,INT-AMIGA \?CCL7
SET 'BORDER-FLAG,TRUE-VALUE
SET 'FONT3-FLAG,TRUE-VALUE
SET 'FWC-FLAG,TRUE-VALUE
SET 'BLACK-PICTURE-BORDER,TRUE-VALUE
JUMP ?CND1
?CCL7: CALL1 APPLE2?
ZERO? STACK /?CND1
SET 'BORDER-FLAG,FALSE-VALUE
SET 'FONT3-FLAG,FALSE-VALUE
SET 'FWC-FLAG,FALSE-VALUE
SET 'BLACK-PICTURE-BORDER,TRUE-VALUE
?CND1: ZERO? FWC-FLAG /?CND9
FONT 4 >F
?CND9: GETB 0,38 >CHRV
GETB 0,39 >CHRH
ZERO? FWC-FLAG /?CND11
FONT F
?CND11: GET 0,17
DIV STACK,CHRH >SCREEN-WIDTH
GET 0,18
DIV STACK,CHRV >SCREEN-HEIGHT
ZERO? BORDER-FLAG \?CCL15
SET 'TOP-SCREEN-LINE,1
SUB SCREEN-HEIGHT,4 >COMMAND-START-LINE
JUMP ?CND13
?CCL15: SET 'TOP-SCREEN-LINE,2
SUB SCREEN-HEIGHT,5 >COMMAND-START-LINE
?CND13: DIV SCREEN-WIDTH,5 >COMMAND-WIDTH
MUL COMMAND-WIDTH,4
SUB SCREEN-WIDTH,STACK >NAME-WIDTH
CALL1 APPLE2?
ZERO? STACK /?CND16
SET 'PARTY-COMMAND-COLUMN,1
?CND16: ADD PARTY-COMMAND-COLUMN,COMMAND-WIDTH >NAME-COLUMN
ADD NAME-COLUMN,NAME-WIDTH >CHR-COMMAND-COLUMN
ADD CHR-COMMAND-COLUMN,COMMAND-WIDTH >COMMAND-OBJECT-COLUMN
MOUSE-LIMIT -1
CALL QSET?,START-LOC,SEEN
ZERO? STACK \?CND18
PICINF G-BOOT-SCREEN,PICINF-TBL \?CND18
CLEAR -1
DISPLAY G-BOOT-SCREEN,1,1
INPUT 1
?CND18: CLEAR -1
MUL SCREEN-HEIGHT,CHRV
SPLIT STACK
ICALL1 SETUP-WINDOWS
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
ZERO? FONT3-FLAG /?CND22
ICALL2 CHANGE-FONT,4
?CND22: ZERO? BORDER-FLAG /?CND24
ZERO? FONT3-FLAG /?CCL28
ICALL FONT3-LINE,1,H-LINE,47,48
JUMP ?CND26
?CCL28: HLIGHT H-INVERSE
ICALL GCURSET,1,1
SUB SCREEN-WIDTH,1
PRINTT WPRINT-EBUF,STACK
ICALL GCURSET,1,SCREEN-WIDTH
PRINTC 32
?CND26: DIV SCREEN-WIDTH,2
SUB STACK,4 >F
EQUAL? INTERPRETER,INT-AMIGA \?CND29
ADD F,2 >F
?CND29: ICALL GCURSET,1,F
PRINTI "JOURNEY"
ZERO? FONT3-FLAG \?CND24
HLIGHT H-NORMAL
?CND24: SET 'LN,TOP-SCREEN-LINE
?PRG33: SUB COMMAND-START-LINE,1
EQUAL? LN,STACK /?REP34
ZERO? BORDER-FLAG \?CCL40
SUB TEXT-WINDOW-LEFT,1
ICALL GCURSET,LN,STACK
ZERO? FONT3-FLAG /?CCL43
CALL2 CHANGE-FONT,3 >F
PRINTC THIN-V-LINE
CALL2 CHANGE-FONT,4 >F
JUMP ?CND38
?CCL43: HLIGHT H-INVERSE
PRINTC 32
HLIGHT H-NORMAL
JUMP ?CND38
?CCL40: ZERO? FONT3-FLAG /?CCL46
CALL2 CHANGE-FONT,3 >F
ICALL GCURSET,LN,1
PRINTC THIN-V-LINE
SUB TEXT-WINDOW-LEFT,1
ICALL GCURSET,LN,STACK
PRINTC THIN-V-LINE
ICALL GCURSET,LN,SCREEN-WIDTH
PRINTC 40
CALL2 CHANGE-FONT,4 >F
JUMP ?CND38
?CCL46: HLIGHT H-INVERSE
ZERO? FWC-FLAG \?CND47
FONT 4 >F
?CND47: ICALL GCURSET,LN,1
PRINTC 32
SUB TEXT-WINDOW-LEFT,1
ICALL GCURSET,LN,STACK
PRINTC 32
ICALL GCURSET,LN,SCREEN-WIDTH
PRINTC 32
ZERO? FWC-FLAG \?CND49
FONT 1 >F
?CND49: HLIGHT H-NORMAL
?CND38: INC 'LN
JUMP ?PRG33
?REP34: ZERO? FONT3-FLAG /?CCL53
ZERO? BORDER-FLAG /?CCL56
ICALL FONT3-LINE,LN,H-LINE,THIN-V-LINE,40
JUMP ?CND51
?CCL56: ICALL FONT3-LINE,LN,H-LINE,H-LINE,H-LINE
JUMP ?CND51
?CCL53: ICALL GCURSET,LN,1
ICALL1 BLANK-LINE
?CND51: SET 'OLN,LN
CALL2 REFRESH-CHARACTER-COMMAND-AREA,LN >LN
ZERO? BORDER-FLAG /?CND57
ZERO? FONT3-FLAG /?CCL61
ICALL FONT3-LINE,LN,38,46,49
JUMP ?CND57
?CCL61: ICALL GCURSET,LN,1
ICALL1 BLANK-LINE
?CND57: ZERO? FONT3-FLAG \?CND62
HLIGHT H-INVERSE
?CND62: CALL2 TEXT-WIDTH,STR?11 >WIDTH
CALL GPOS,NAME-COLUMN,CHRH >?TMP1
SUB NAME-WIDTH-PIX,WIDTH
DIV STACK,2
ADD ?TMP1,STACK >F
CALL GPOS,OLN,CHRV
CURSET STACK,F
PRINTI "The Party"
CALL2 TEXT-WIDTH,STR?12 >WIDTH
CALL GPOS,OLN,CHRV >?TMP1
CALL GPOS,CHR-COMMAND-COLUMN,CHRH >?TMP2
GET 0,17 >?TMP3
CALL GPOS,CHR-COMMAND-COLUMN,CHRH
SUB ?TMP3,STACK
SUB STACK,WIDTH
DIV STACK,2
ADD ?TMP2,STACK
CURSET ?TMP1,STACK
PRINTI "Individual Commands"
ZERO? FONT3-FLAG \?CND64
HLIGHT H-NORMAL
?CND64: EQUAL? INTERPRETER,INT-MAC \?CND66
MENU 3,MAC-SPECIAL-MENU /?CND66
?CND66: CALL2 SELECT-SCREEN,TEXT-WINDOW
RSTACK
.FUNCT TEXT-WIDTH:ANY:1:1,STR
DIROUT 3,CENTER-TABLE
PRINT STR
DIROUT -3
GET 0,24
RSTACK
.FUNCT BLANK-LINE:ANY:0:0,FG,BG
WINGET -3,11 >FG
SHIFT FG,-8 >BG
BAND FG,255 >FG
COLOR BG,FG
ERASE 1
COLOR FG,BG
RTRUE
.FUNCT FONT3-LINE:ANY:4:4,LN,CHR,L,R,F
CALL2 CHANGE-FONT,3 >F
ICALL GCURSET,LN,1
SET 'F,0
?PRG1: IGRTR? 'F,SCREEN-WIDTH \?CCL5
CALL2 CHANGE-FONT,4 >F
RTRUE
?CCL5: EQUAL? F,1 \?CCL7
PRINTC L
JUMP ?PRG1
?CCL7: EQUAL? F,SCREEN-WIDTH \?CCL9
ICALL GCURSET,LN,F
PRINTC R
JUMP ?PRG1
?CCL9: PRINTC CHR
JUMP ?PRG1
.FUNCT REFRESH-CHARACTER-COMMAND-AREA:ANY:1:1,LN,POS,F,START,END,TW,?TMP1
?PRG1: ADD COMMAND-START-LINE,4
IGRTR? 'LN,STACK \?CCL5
GRTR? NAME-RIGHT,0 /?CCL7
RETURN LN
?CCL7: ZERO? FWC-FLAG /?CCL10
FONT 4
JUMP ?CND8
?CCL10: FONT 1
?CND8: CALL2 TEXT-WIDTH,STR?13
ADD 2,STACK >LONG-ARROW-WIDTH
CALL2 TEXT-WIDTH,STR?14
ADD 2,STACK >SHORT-ARROW-WIDTH
CALL2 TEXT-WIDTH,STR?15
ADD 2,STACK >NO-ARROW-WIDTH
RETURN LN
?CCL5: SET 'POS,1
ICALL GCURSET,LN,POS
?PRG11: GRTR? POS,SCREEN-WIDTH \?CCL15
ZERO? BORDER-FLAG /?PRG1
ZERO? FONT3-FLAG /?CCL20
CALL2 CHANGE-FONT,3 >F
ICALL GCURSET,LN,SCREEN-WIDTH
CURGET CURGET-TABLE
GET CURGET-TABLE,1
SUB STACK,RIGHT-COLUMN-LEFT-EDGE >RIGHT-COLUMN-WIDTH
PRINTC 40
CALL2 CHANGE-FONT,4 >F
JUMP ?PRG1
?CCL20: CURGET CURGET-TABLE
GET CURGET-TABLE,1
SUB STACK,RIGHT-COLUMN-LEFT-EDGE >RIGHT-COLUMN-WIDTH
ICALL2 FIXED-SPACE,H-INVERSE
JUMP ?PRG1
?CCL15: ZERO? FONT3-FLAG /?CCL23
EQUAL? POS,1 /?CCL26
SUB SCREEN-WIDTH,5
LESS? POS,STACK \?CCL26
CALL2 CHANGE-FONT,3 >F
SUB POS,1
ICALL GCURSET,LN,STACK
GRTR? START,0 \?CND29
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >END
?CND29: ADD COMMAND-WIDTH,1 >?TMP1
ADD COMMAND-WIDTH,NAME-WIDTH
ADD STACK,1
EQUAL? POS,COMMAND-WIDTH,?TMP1,STACK /?CTR32
ADD COMMAND-WIDTH,NAME-WIDTH
EQUAL? POS,STACK \?CCL33
?CTR32: PRINTC THICK-V-LINE
JUMP ?CND31
?CCL33: PRINTC THIN-V-LINE
?CND31: CURGET CURGET-TABLE
GET CURGET-TABLE,1 >RIGHT-COLUMN-LEFT-EDGE
CALL2 CHANGE-FONT,4 >F
JUMP ?CND13
?CCL26: EQUAL? POS,1 \?CND13
ZERO? BORDER-FLAG /?CND13
CALL2 CHANGE-FONT,3 >F
ICALL GCURSET,LN,POS
PRINTC THIN-V-LINE
GRTR? START,0 \?CND39
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >END
?CND39: CALL2 CHANGE-FONT,4 >F
JUMP ?CND13
?CCL23: EQUAL? POS,1 /?CND13
SUB SCREEN-WIDTH,5
LESS? POS,STACK \?CND13
SUB POS,1
ICALL GCURSET,LN,STACK
GRTR? START,0 \?CND44
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >END
?CND44: ICALL2 FIXED-SPACE,H-INVERSE
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >RIGHT-COLUMN-LEFT-EDGE
?CND13: GRTR? START,0 \?CND46
ZERO? COMMAND-WIDTH-PIX \?CCL50
SUB END,START >COMMAND-WIDTH-PIX
JUMP ?CND48
?CCL50: SET 'NAME-RIGHT,END
CALL GPOS,NAME-COLUMN,CHRH
SUB END,STACK >NAME-WIDTH-PIX
?CND48: SET 'START,0
?CND46: ADD 1,COMMAND-WIDTH
EQUAL? POS,COMMAND-WIDTH,STACK \?CCL53
ZERO? NAME-WIDTH-PIX \?CND54
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >START
?CND54: ADD POS,NAME-WIDTH >POS
JUMP ?PRG11
?CCL53: ZERO? COMMAND-WIDTH-PIX \?CND56
ICALL GCURSET,LN,PARTY-COMMAND-COLUMN
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >START
?CND56: EQUAL? POS,1 \?CCL60
ADD POS,COMMAND-WIDTH >POS
JUMP ?PRG11
?CCL60: ADD POS,COMMAND-WIDTH >POS
JUMP ?PRG11
.FUNCT FIXED-SPACE:ANY:0:1,HL,F
ZERO? FWC-FLAG \?CND1
FONT 4 >F
?CND1: ZERO? HL /?CND3
HLIGHT HL
?CND3: PRINTC 32
ZERO? HL /?CND5
HLIGHT H-NORMAL
?CND5: ZERO? FWC-FLAG \TRUE
FONT 1 >F
RTRUE
.FUNCT GET-CURSOR:ANY:2:2,PCM,PCF,?TMP1
GET CHARACTER-INPUT-TBL,PCM >?TMP1
SUB PCF,1
GET ?TMP1,STACK
RSTACK
.FUNCT ERASE-COMMAND:ANY:0:1,W,F
ASSIGNED? 'W /?CND1
SET 'W,COMMAND-WIDTH-PIX
?CND1: ERASE W
RTRUE
.FUNCT BOLD-CURSOR:ANY:2:3,PCM,PCF,STR,X,Y,CMD,?TMP1
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
SUB COMMAND-START-LINE,1
ADD STACK,PCM >Y
SUB PCF,1
MUL COMMAND-WIDTH,STACK
ADD CHR-COMMAND-COLUMN,STACK >X
ICALL GCURSET,Y,X
ICALL1 ERASE-COMMAND
ICALL GCURSET,Y,X
ASSIGNED? 'STR \?CCL3
PRINT STR
JUMP ?CND1
?CCL3: GET CHARACTER-INPUT-TBL,PCM >?TMP1
SUB PCF,1
GET ?TMP1,STACK >CMD
EQUAL? CMD,NUL-COMMAND /?CND1
HLIGHT H-BOLD
ICALL2 PRINT-COMMAND,CMD
HLIGHT H-NORMAL
?CND1: ICALL GCURSET,Y,X
ICALL2 SELECT-SCREEN,TEXT-WINDOW
RETURN CMD
.FUNCT NORMAL-ALL:ANY:1:1,PCM
ICALL NORMAL-CURSOR,PCM,1
ICALL NORMAL-CURSOR,PCM,2
CALL NORMAL-CURSOR,PCM,3
RSTACK
.FUNCT NORMAL-CURSOR:ANY:2:3,PCM,PCF,STR,Y,X,CHR,?TMP1
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
SUB COMMAND-START-LINE,1
ADD STACK,PCM >Y
SUB PCF,1
MUL COMMAND-WIDTH,STACK
ADD CHR-COMMAND-COLUMN,STACK >X
ICALL GCURSET,Y,X
ICALL1 ERASE-COMMAND
ICALL GCURSET,Y,X
GET PARTY,PCM >CHR
ASSIGNED? 'STR \?CCL3
PRINT STR
JUMP ?CND1
?CCL3: ZERO? CHR \?CCL4
ZERO? SUBGROUP-MODE /?CCL4
FSET? CHR,SUBGROUP \?CND1
?CCL4: GET CHARACTER-INPUT-TBL,PCM >?TMP1
SUB PCF,1
GET ?TMP1,STACK
ICALL2 PRINT-COMMAND,STACK
?CND1: CALL2 SELECT-SCREEN,TEXT-WINDOW
RSTACK
.FUNCT GMSLOCX:ANY:0:0
EQUAL? CHRH,1 \?CCL3
GET 0,27
GET STACK,1
RSTACK
?CCL3: GET 0,27
GET STACK,1
SUB STACK,1
DIV STACK,CHRH
ADD STACK,1
RSTACK
.FUNCT GMSLOCY:ANY:0:0
EQUAL? CHRV,1 \?CCL3
GET 0,27
GET STACK,2
RSTACK
?CCL3: GET 0,27
GET STACK,2
SUB STACK,1
DIV STACK,CHRV
ADD STACK,1
RSTACK
.FUNCT LOCATE-MOUSE:ANY:0:0,MX,MY
CALL1 GMSLOCX >MX
CALL1 GMSLOCY >MY
LESS? MY,COMMAND-START-LINE /FALSE
ADD COMMAND-START-LINE,5
LESS? MY,STACK \FALSE
SUB COMMAND-START-LINE,1
SUB MY,STACK
PUT MOUSETBL,0,STACK
LESS? MX,PARTY-COMMAND-COLUMN /?CCL8
GRTR? MX,COMMAND-WIDTH /?CCL8
PUT MOUSETBL,1,-1
RTRUE
?CCL8: LESS? MX,CHR-COMMAND-COLUMN /FALSE
GRTR? MX,SCREEN-WIDTH /FALSE
SUB MX,CHR-COMMAND-COLUMN
ADD STACK,1
MOD STACK,COMMAND-WIDTH
ZERO? STACK /FALSE
SUB MX,CHR-COMMAND-COLUMN
DIV STACK,COMMAND-WIDTH
ADD STACK,1 >MY
PUT MOUSETBL,1,MY
RTRUE
.FUNCT PARTY-INPUT:ANY:0:0,PCM,PCF,CHR,CLICK,MFLG
SET 'PCM,1
SET 'PCF,-1
?PRG1: ZERO? NO-DEFAULTS \?PRG5
ICALL BOLD-PARTY-CURSOR,PCM,PCF
?PRG5: ZERO? CLICK \?CTR8
CALL1 GETCHR >CHR
EQUAL? CHR,13 \?CCL9
ZERO? NO-DEFAULTS \?CCL9
?CTR8: SET 'CLICK,FALSE-VALUE
ICALL BOLD-PARTY-CURSOR,PCM,PCF
CALL PROCESS-COMMAND,PCM,PCF
ZERO? STACK /?CND14
ICALL1 PRINT-CHARACTER-COMMANDS
?CND14: ICALL NORMAL-PARTY-CURSOR,PCM,PCF
JUMP ?PRG1
?CCL9: EQUAL? CHR,SINGLE-CLICK,DOUBLE-CLICK,DEFAULT-CHR \?CCL17
EQUAL? CHR,DEFAULT-CHR \?CCL20
GET MOUSETBL,0
LESS? STACK,0 /?PRG5
SET 'MFLG,FALSE-VALUE
JUMP ?CND18
?CCL20: SET 'MFLG,TRUE-VALUE
?CND18: ZERO? MFLG /?CTR24
CALL1 LOCATE-MOUSE
ZERO? STACK /?CCL25
?CTR24: ZERO? GAME-MODE /?CND28
GET MOUSETBL,1
GRTR? STACK,0 \?CND28
SOUND 1
JUMP ?PRG5
?CND28: ICALL NORMAL-PARTY-CURSOR,PCM,PCF
GET MOUSETBL,0 >PCM
GET MOUSETBL,1 >PCF
GRTR? PCF,0 \?CCL34
ICALL CHARACTER-INPUT,PCM,PCF,MFLG
SET 'CLICK,SAVED-CLICK
ZERO? CLICK /?CCL37
SET 'PCM,SAVED-PCM
JUMP ?CND35
?CCL37: CALL2 F-P-C,SAVED-PCM >PCM
?CND35: SET 'PCF,SAVED-PCF
JUMP ?CND32
?CCL34: SET 'CLICK,MFLG
?CND32: ICALL BOLD-PARTY-CURSOR,PCM,PCF
JUMP ?PRG5
?CCL25: SOUND 1
JUMP ?PRG5
?CCL17: ZERO? NO-DEFAULTS /?CCL39
SOUND 1
JUMP ?PRG5
?CCL39: EQUAL? CHR,SPACE-BAR \?CCL41
ZERO? GAME-MODE \?CCL41
ICALL1 C-N-D
JUMP ?PRG5
?CCL41: EQUAL? CHR,DOWN-ARROW \?CCL45
?PRG46: ICALL NORMAL-PARTY-CURSOR,PCM,PCF
EQUAL? PCM,5 \?CCL50
SET 'PCM,1
JUMP ?CND48
?CCL50: INC 'PCM
?CND48: CALL BOLD-PARTY-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND /?PRG46
JUMP ?PRG5
?CCL45: EQUAL? CHR,UP-ARROW \?CCL54
?PRG55: ICALL NORMAL-PARTY-CURSOR,PCM,PCF
EQUAL? PCM,1 \?CCL59
SET 'PCM,5
JUMP ?CND57
?CCL59: DEC 'PCM
?CND57: CALL BOLD-PARTY-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND /?PRG55
JUMP ?PRG5
?CCL54: EQUAL? CHR,LEFT-ARROW \?CCL63
SOUND 1
JUMP ?PRG5
?CCL63: EQUAL? CHR,RIGHT-ARROW \?CCL65
ZERO? GAME-MODE /?CCL68
SOUND 1
JUMP ?PRG5
?CCL68: ICALL NORMAL-PARTY-CURSOR,PCM,PCF
EQUAL? PCF,-1 \?CCL71
CALL BOLD-CURSOR,PCM,1
EQUAL? STACK,NUL-COMMAND /?CCL74
ICALL CHARACTER-INPUT,PCM,1
CALL2 F-P-C,SAVED-PCM >PCM
SET 'PCF,SAVED-PCF
SET 'CLICK,SAVED-CLICK
JUMP ?CND69
?CCL74: SOUND 1
JUMP ?CND69
?CCL71: INC 'PCF
?CND69: ICALL BOLD-PARTY-CURSOR,PCM,PCF
JUMP ?PRG5
?CCL65: CALL2 PARTY-KBD-COMMAND?,CHR
ZERO? STACK /?CCL76
ICALL NORMAL-PARTY-CURSOR,PCM,PCF
GET MOUSETBL,0 >PCM
GET MOUSETBL,1 >PCF
ICALL BOLD-PARTY-CURSOR,PCM,PCF
SET 'CLICK,TRUE-VALUE
JUMP ?PRG5
?CCL76: SOUND 1
JUMP ?PRG5
.FUNCT F-P-C:ANY:1:1,PCM
?PRG1: GET PARTY-COMMANDS,PCM
EQUAL? STACK,NUL-COMMAND /?CCL5
RETURN PCM
?CCL5: EQUAL? PCM,5 \?CCL7
PRINTI "[Error 2]"
RETURN 5
?CCL7: INC 'PCM
JUMP ?PRG1
.FUNCT FIRST-PARTY:ANY:0:0,CNT
?PRG1: IGRTR? 'CNT,PARTY-MAX \?CCL5
RETURN -1
?CCL5: GET CHARACTER-INPUT-TBL,CNT
GET STACK,0
EQUAL? STACK,NUL-COMMAND /?PRG1
RETURN CNT
.FUNCT FIRST-SUBGROUP:ANY:0:0,CNT
?PRG1: IGRTR? 'CNT,PARTY-MAX \?CCL5
SET 'CNT,-1
RETURN CNT
?CCL5: GET PARTY,CNT
FSET? STACK,SUBGROUP \?PRG1
GET CHARACTER-INPUT-TBL,CNT
GET STACK,0
EQUAL? STACK,NUL-COMMAND /?PRG1
RETURN CNT
.FUNCT PARTY-KBD-COMMAND?:ANY:1:1,CHR,OFF,MAX,CMD
SET 'OFF,1
SET 'MAX,5
LESS? CHR,97 /?PRG5
GRTR? CHR,122 /?PRG5
SUB CHR,32 >CHR
?PRG5: GRTR? OFF,MAX /FALSE
GET PARTY-COMMANDS,OFF >CMD
EQUAL? CMD,NUL-COMMAND /?CND7
GET CMD,COMMAND-CHR
EQUAL? CHR,STACK \?CND7
DEC 'OFF
ADD OFF,1
PUT MOUSETBL,0,STACK
PUT MOUSETBL,1,-1
RTRUE
?CND7: INC 'OFF
JUMP ?PRG5
.FUNCT CHARACTER-KBD-COMMAND?:ANY:1:2,CHR,F,PCM,CNT,OFF,TBL,CMD
SET 'PCM,1
LESS? CHR,97 /?PRG5
GRTR? CHR,122 /?PRG5
SUB CHR,32 >CHR
?PRG5: GRTR? PCM,PARTY-MAX \?CCL9
ZERO? F /FALSE
ZERO? CNT /FALSE
EQUAL? CNT,1 \?CCL16
SET 'UPDATE-FLAG,TRUE-VALUE
RTRUE
?CCL16: ICALL1 PRINT-CHARACTER-COMMANDS
SET 'UPDATE-FLAG,TRUE-VALUE
RETURN 3
?CCL9: GET CHARACTER-INPUT-TBL,PCM >TBL
SET 'OFF,0
?PRG17: GRTR? OFF,2 /?REP18
GET TBL,OFF >CMD
EQUAL? CMD,NUL-COMMAND /?CND19
GET CMD,COMMAND-CHR
EQUAL? CHR,STACK \?CCL24
ZERO? F /?CND25
INC 'CNT
?CND25: ZERO? F /?CCL28
EQUAL? CNT,1 \?CND27
?CCL28: PUT MOUSETBL,0,PCM
ADD OFF,1
PUT MOUSETBL,1,STACK
?CND27: ZERO? F \?CND19
RTRUE
?CCL24: ZERO? F /?CND19
PUT TBL,OFF,NUL-COMMAND
?CND19: INC 'OFF
JUMP ?PRG17
?REP18: INC 'PCM
JUMP ?PRG5
.FUNCT OBJECT-KBD-COMMAND?:ANY:1:2,CHR,MP,OFF,MAX,CMD,?TMP1
ASSIGNED? 'MP /?CND1
SET 'MP,2
?CND1: SET 'OFF,1
GET O-TABLE,0 >MAX
LESS? CHR,97 /?CND3
GRTR? CHR,122 /?CND3
SUB CHR,32 >CHR
?CND3: EQUAL? MP,3 \?PRG9
SET 'OFF,6
?PRG9: GRTR? OFF,MAX /FALSE
GET O-TABLE,OFF
GETP STACK,P?KBD >?TMP1
GET O-TABLE,OFF
GETP STACK,P?KBD2
EQUAL? CHR,?TMP1,STACK \?CND11
DEC 'OFF
MOD OFF,5
ADD STACK,1
PUT MOUSETBL,0,STACK
DIV OFF,5
ADD STACK,2
PUT MOUSETBL,1,STACK
RTRUE
?CND11: INC 'OFF
JUMP ?PRG9
.FUNCT MENU-NO-DEFAULTS:ANY:0:0
SET 'NO-DEFAULTS,TRUE-VALUE
PUT MAC-SPECIAL-MENU,3,MSM-DEFAULTS
PUT MOUSE-JOURNEY-MENU-TBL,2,MENU-DEFAULTS
EQUAL? INTERPRETER,INT-MAC \FALSE
MENU 3,MAC-SPECIAL-MENU /TRUE
RFALSE
.FUNCT MENU-DEFAULTS:ANY:0:0
SET 'NO-DEFAULTS,FALSE-VALUE
PUT MAC-SPECIAL-MENU,3,MSM-NO-DEFAULTS
PUT MOUSE-JOURNEY-MENU-TBL,2,MENU-NO-DEFAULTS
EQUAL? INTERPRETER,INT-MAC \FALSE
MENU 3,MAC-SPECIAL-MENU /TRUE
RFALSE
.FUNCT MENU-ESSENCES:ANY:0:0
FSET? ESSENCES,TRIED \?CCL3
ICALL PERFORM,EXAMINE-COMMAND,POUCH,FALSE-VALUE,PRAXIX
RTRUE
?CCL3: PRINTR "[You must START the game first.]"
.FUNCT MOUSE-SAVE:ANY:0:0,GM
SET 'GM,GAME-MODE
ICALL2 V-SAVE,GM
RTRUE
.FUNCT MOUSE-RESTORE:ANY:0:0
CALL2 V-RESTORE,FALSE-VALUE
RSTACK
.FUNCT V-SCRIPT:ANY:0:0
ZERO? SCRIPTING-FLAG /?CCL3
CALL1 V-SCRIPT-OFF
RSTACK
?CCL3: CALL2 V-GAME,SCRIPT-ON-ROOM
RSTACK
.FUNCT V-SAFE-START-OVER:ANY:0:0
CRLF
PRINTI "[Restart"
PRINT CONFIRM-STR
CRLF
INPUT 1
EQUAL? STACK,F3 \FALSE
CALL1 V-RESTART
RSTACK
.FUNCT V-SAFE-QUIT:ANY:0:0
CRLF
PRINTI "[Quit"
PRINT CONFIRM-STR
CRLF
INPUT 1
EQUAL? STACK,F4 \FALSE
CALL1 V-QUIT
RSTACK
.FUNCT GETCHR:ANY:0:0,CHR,F,TBL
?FCN: ZERO? NEW-DEFAULT-FLAG /?CCL3
SET 'NEW-DEFAULT-FLAG,FALSE-VALUE
RETURN DEFAULT-CHR
?CCL3: INPUT 1 >CHR
GRTR? CHR,F-KEY-START \?PRD8
LESS? CHR,F-KEY-END /?CTR5
?PRD8: EQUAL? CHR,252 \?CCL6
?CTR5: ZERO? INHIBIT-MOUSE-COMMANDS /?CND11
SOUND 1
JUMP ?FCN
?CND11: EQUAL? CHR,252 \?CND13
MOUSE-INFO MOUSE-INFO-TBL
GETB MOUSE-INFO-TBL,6
EQUAL? STACK,3 \?CND13
GETB MOUSE-INFO-TBL,7
GET MOUSE-JOURNEY-MENU-TBL,STACK
ICALL STACK
CRLF
JUMP ?FCN
?CND13: EQUAL? CHR,252 \?CCL19
GETB MOUSE-INFO-TBL,6 >F
EQUAL? F,2 \?CCL22
GETB MOUSE-INFO-TBL,7
EQUAL? STACK,1 \?CCL22
IRESTORE
ZERO? STACK \?FCN
PRINTI "[Undo Failed]"
CRLF
JUMP ?FCN
?CCL22: EQUAL? F,1 \?FCN
ICALL1 GO-TO-GAME-MODE
GETB MOUSE-INFO-TBL,7
GET MOUSE-MENU-TBL,STACK
ICALL STACK
EQUAL? HERE,GAME-ROOM,CONTROLS-ROOM,END-SESSION-ROOM \?FCN
ICALL1 V-CANCEL
JUMP ?FCN
?CCL19: ICALL1 GO-TO-GAME-MODE
SUB CHR,F-KEY-START
GET F-KEY-TBL,STACK
ICALL STACK
JUMP ?FCN
?CCL6: EQUAL? CHR,18 /?CCL30
GET 0,8 >F
BTST F,4 \?CND4
?CCL30: ICALL1 REFRESH-SCREEN
BAND F,-5
PUT 0,8,STACK
JUMP ?FCN
?CND4: RETURN CHR
.FUNCT GO-TO-GAME-MODE:ANY:0:0
ZERO? GAME-MODE \FALSE
SET 'GAME-MODE,TRUE-VALUE
EQUAL? SAVED-GAME-ROOM,GAME-ROOM,CONTROLS-ROOM,END-SESSION-ROOM /FALSE
ICALL1 SAVE-PARTY-COMMANDS
SET 'SAVED-GAME-ROOM,HERE
SET 'SAVED-GAME-MODE,PARTY-MODE
RETURN SAVED-GAME-MODE
.FUNCT SCREEN-NEEDS-INIT:ANY:0:0
WINGET TEXT-WINDOW,14
EQUAL? STACK,15 \TRUE
GET 0,19
EQUAL? STACK,XFWRD \TRUE
GET 0,17
EQUAL? STACK,XHWRD \TRUE
GET 0,18
EQUAL? STACK,XVWRD /FALSE
RTRUE
.FUNCT REFRESH-CHECK:ANY:0:1,RST,F
CALL1 SCREEN-NEEDS-INIT
ZERO? STACK /?CCL3
CALL2 REFRESH-SCREEN,TRUE-VALUE
RSTACK
?CCL3: GET 0,8 >F
BTST F,4 \?CCL5
CALL1 REFRESH-SCREEN
RSTACK
?CCL5: ZERO? RST /FALSE
ICALL1 GRAPHIC
GETP SAVED-GAME-ROOM,P?REFRESH
CALL STACK
RSTACK
.FUNCT REFRESH-SCREEN:ANY:0:1,INIT?,F
ASSIGNED? 'INIT? /?CND1
SET 'INIT?,TRUE-VALUE
?CND1: ZERO? INIT? /?CND3
ICALL1 INIT-SCREEN
ICALL1 TURN-OFF-CURSOR
?CND3: ICALL2 PRINT-COLUMNS,TRUE-VALUE
ICALL1 PRINT-CHARACTER-COMMANDS
ICALL2 NEXT-DAY,0
ICALL1 NEW-DEFAULT
ICALL1 GRAPHIC
GETP SAVED-GAME-ROOM,P?REFRESH
ICALL STACK
GET 0,8 >F
BAND F,-5
PUT 0,8,STACK
RTRUE
.FUNCT CHARACTER-INPUT:ANY:2:3,PCM,PCF,CLICK,CHR,MFLG,FLG
?PRG1: ZERO? NO-DEFAULTS \?PRG5
ICALL BOLD-CURSOR,PCM,PCF
?PRG5: ZERO? CLICK \?CTR8
CALL1 GETCHR >CHR
EQUAL? CHR,13 \?CCL9
ZERO? NO-DEFAULTS \?CCL9
?CTR8: SET 'CLICK,FALSE-VALUE
ICALL BOLD-CURSOR,PCM,PCF
CALL PROCESS-COMMAND,PCM,PCF
ZERO? STACK /?CND14
ICALL1 PRINT-CHARACTER-COMMANDS
CALL GET-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND \?CND14
ICALL C-N-D,PCM,PCF
?CND14: ICALL NORMAL-CURSOR,PCM,PCF
JUMP ?PRG1
?CCL9: EQUAL? CHR,SINGLE-CLICK,DOUBLE-CLICK,DEFAULT-CHR \?CCL19
EQUAL? CHR,DEFAULT-CHR \?CCL22
SET 'MFLG,FALSE-VALUE
JUMP ?CND20
?CCL22: SET 'MFLG,TRUE-VALUE
?CND20: ZERO? MFLG /?CTR24
CALL1 LOCATE-MOUSE
ZERO? STACK /?CCL25
?CTR24: ICALL NORMAL-CURSOR,PCM,PCF
GET MOUSETBL,0 >PCM
GET MOUSETBL,1 >PCF
LESS? PCF,0 \?CCL30
SET 'SAVED-PCM,PCM
SET 'SAVED-PCF,PCF
SET 'SAVED-CLICK,MFLG
RTRUE
?CCL30: ICALL BOLD-CURSOR,PCM,PCF
SET 'CLICK,MFLG
JUMP ?PRG5
?CCL25: SOUND 1
JUMP ?PRG5
?CCL19: ZERO? NO-DEFAULTS /?CCL32
SOUND 1
JUMP ?PRG5
?CCL32: EQUAL? CHR,SPACE-BAR \?CCL34
ICALL1 NEW-DEFAULT
JUMP ?PRG5
?CCL34: EQUAL? CHR,DOWN-ARROW \?CCL36
?PRG37: EQUAL? PARTY-MODE,OPTION-MODE \?CCL41
SOUND 1
JUMP ?PRG5
?CCL41: ICALL NORMAL-CURSOR,PCM,PCF
EQUAL? PCM,PARTY-MAX \?CCL44
SET 'PCM,1
JUMP ?CND42
?CCL44: INC 'PCM
?CND42: CALL BOLD-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND /?PRG37
JUMP ?PRG5
?CCL36: EQUAL? CHR,UP-ARROW \?CCL48
?PRG49: EQUAL? PARTY-MODE,OPTION-MODE \?CCL53
SOUND 1
JUMP ?PRG5
?CCL53: ICALL NORMAL-CURSOR,PCM,PCF
EQUAL? PCM,1 \?CCL56
SET 'PCM,PARTY-MAX
JUMP ?CND54
?CCL56: DEC 'PCM
?CND54: CALL BOLD-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND /?PRG49
JUMP ?PRG5
?CCL48: EQUAL? CHR,LEFT-ARROW \?CCL60
?PRG61: EQUAL? PCF,1 \?CCL65
ICALL NORMAL-CURSOR,PCM,PCF
SET 'SAVED-PCM,PCM
SET 'SAVED-PCF,-1
SET 'SAVED-CLICK,FALSE-VALUE
RTRUE
?CCL65: ICALL NORMAL-CURSOR,PCM,PCF
DEC 'PCF
CALL BOLD-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND /?PRG61
JUMP ?PRG5
?CCL60: EQUAL? CHR,RIGHT-ARROW \?CCL69
?PRG70: ICALL NORMAL-CURSOR,PCM,PCF
EQUAL? PCF,3 \?CCL74
SET 'PCF,1
JUMP ?CND72
?CCL74: INC 'PCF
?CND72: CALL BOLD-CURSOR,PCM,PCF
EQUAL? STACK,NUL-COMMAND /?PRG70
JUMP ?PRG5
?CCL69: CALL2 CHARACTER-KBD-COMMAND?,CHR >FLG
ZERO? FLG /?CCL78
ICALL NORMAL-CURSOR,PCM,PCF
GET MOUSETBL,0 >PCM
GET MOUSETBL,1 >PCF
ICALL BOLD-CURSOR,PCM,PCF
EQUAL? FLG,1 \?PRG5
SET 'CLICK,TRUE-VALUE
JUMP ?PRG5
?CCL78: SOUND 1
JUMP ?PRG5
.FUNCT C-N-D:ANY:0:2,PCM,PCF,F
ASSIGNED? 'PCF /?CND1
SET 'PCF,1
?CND1: EQUAL? PCF,1 /?CTR4
SUB PCF,1
CALL GET-CURSOR,PCM,STACK
EQUAL? STACK,NUL-COMMAND \?CCL5
?CTR4: ZERO? SUBGROUP-MODE /?CCL10
CALL1 FIRST-SUBGROUP >F
JUMP ?CND8
?CCL10: CALL1 FIRST-PARTY >F
?CND8: EQUAL? F,-1 \?CCL13
CALL NEW-DEFAULT,1,-1
RSTACK
?CCL13: CALL NEW-DEFAULT,F,1
RSTACK
?CCL5: SUB PCF,1
CALL NEW-DEFAULT,PCM,STACK
RSTACK
.FUNCT CLEAR-FIELDS:ANY:0:0
CALL2 PRINT-CHARACTER-COMMANDS,TRUE-VALUE
RSTACK
.FUNCT PRINT-CHARACTER-COMMANDS:ANY:0:1,CLEAR,PTBL,CNT,C,BTBL,LN,POS,BCNT,CHR,?TMP1
SET 'CNT,5
SET 'LN,COMMAND-START-LINE
ZERO? UPDATE-FLAG /?CND1
ZERO? CLEAR \?CND1
ICALL1 FILL-CHARACTER-TBL
?CND1: SET 'PTBL,PARTY
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
?PRG5: DLESS? 'CNT,0 \?CCL9
ICALL2 SELECT-SCREEN,TEXT-WINDOW
ZERO? SMART-DEFAULT-FLAG /TRUE
SET 'SMART-DEFAULT-FLAG,FALSE-VALUE
ICALL1 SMART-DEFAULT
RTRUE
?CCL9: GET PTBL,1 >CHR
SET 'POS,NAME-COLUMN
ICALL GCURSET,LN,POS
ZERO? CHR /?CTR13
ZERO? SUBGROUP-MODE /?CCL14
FSET? CHR,SUBGROUP /?CCL14
?CTR13: ICALL2 ERASE-COMMAND,NAME-WIDTH-PIX
JUMP ?CND12
?CCL14: ICALL2 ERASE-COMMAND,NAME-WIDTH-PIX
EQUAL? CHR,TAG \?CCL21
ZERO? TAG-NAME-LENGTH /?CCL21
ADD NAME-TBL,2
PRINTT STACK,TAG-NAME-LENGTH
JUMP ?CND19
?CCL21: ICALL2 WPRINTD,CHR
?CND19: LESS? SCREEN-WIDTH,8-WIDTH \?CCL26
CURGET CURGET-TABLE
GET CURGET-TABLE,1 >?TMP1
SUB NAME-RIGHT,SHORT-ARROW-WIDTH
GRTR? ?TMP1,STACK \?CCL29
CALL GPOS,LN,CHRV >?TMP1
SUB NAME-RIGHT,NO-ARROW-WIDTH
CURSET ?TMP1,STACK
PRINTC 62
JUMP ?CND12
?CCL29: CALL GPOS,LN,CHRV >?TMP1
SUB NAME-RIGHT,SHORT-ARROW-WIDTH
CURSET ?TMP1,STACK
PRINTI "->"
JUMP ?CND12
?CCL26: CALL GPOS,LN,CHRV >?TMP1
SUB NAME-RIGHT,LONG-ARROW-WIDTH
CURSET ?TMP1,STACK
PRINTI "-->"
?CND12: SUB 5,CNT
GET CHARACTER-INPUT-TBL,STACK >BTBL
SET 'BCNT,0
SET 'POS,CHR-COMMAND-COLUMN
?PRG30: GRTR? BCNT,2 /?REP31
ICALL GCURSET,LN,POS
ICALL1 ERASE-COMMAND
ICALL GCURSET,LN,POS
ZERO? CLEAR \?CND32
ZERO? CHR /?CND32
ZERO? SUBGROUP-MODE /?CCL37
FSET? CHR,SUBGROUP /?CCL37
FSET? CHR,SHADOW \?CND32
?CCL37: GET BTBL,BCNT
ICALL2 PRINT-COMMAND,STACK
?CND32: ADD POS,COMMAND-WIDTH >POS
INC 'BCNT
JUMP ?PRG30
?REP31: INC 'LN
ADD PTBL,2 >PTBL
JUMP ?PRG5
.FUNCT SCENE:ANY:1:3,OBJ,M,GFX?,TMP
ASSIGNED? 'GFX? /?CND1
SET 'GFX?,TRUE-VALUE
?CND1: SET 'UPDATE-FLAG,TRUE-VALUE
ICALL2 SCENE-ACTION,SCENE-END-COMMAND
ZERO? OBJ \?CCL5
SET 'SCENE-OBJECT,DEFAULT-SCENE
JUMP ?CND3
?CCL5: SET 'SCENE-OBJECT,OBJ
?CND3: ZERO? GFX? /?CND6
GETP SCENE-OBJECT,P?GRAPHIC >TMP
ZERO? TMP /?CND6
ICALL2 GRAPHIC,TMP
?CND6: ZERO? M /?CND10
ICALL2 MODE,M
?CND10: ICALL2 SCENE-ACTION,SCENE-START-COMMAND
RTRUE
.FUNCT PERFORM:ANY:1:4,CMD,OBJO,OBJI,ACT,TMP
ASSIGNED? 'OBJO \?CND1
SET 'ACTION-OBJECT,OBJO
?CND1: ASSIGNED? 'OBJI \?CND3
SET 'ACTION-PRSI,OBJI
?CND3: ASSIGNED? 'ACT \?CND5
SET 'ACTOR,ACT
?CND5: ZERO? SCRIPTING-FLAG /?CND7
ZERO? DONT-SCRIPT-INPUT \?CND7
CALL2 FAKE-COMMAND?,CMD
ZERO? STACK \?CND7
CALL2 GAME-COMMAND?,CMD
ZERO? STACK \?CND7
DIROUT -1
CRLF
PRINTI ") "
ZERO? ACTOR /?CND13
ICALL2 PRINT-DESC,ACTOR
PRINTI ", "
?CND13: GET CMD,COMMAND-STR
PRINT STACK
PRINTC 32
ZERO? ACTION-OBJECT /?CND15
ICALL2 PRINT-DESC,ACTION-OBJECT
?CND15: ZERO? ACTION-PRSI /?CND17
ZERO? PRSI-PREP /?CND17
PRINTC 32
PRINT PRSI-PREP
?CND17: ZERO? ACTION-PRSI /?CND21
PRINTC 32
ICALL2 PRINT-DESC,ACTION-PRSI
?CND21: CRLF
DIROUT 1
?CND7: SET 'ACTION,CMD
PUT O-TABLE,0,0
ZERO? ACTION-OBJECT /?CCL25
GETP ACTION-OBJECT,P?PRSI >TMP
ZERO? TMP /?CCL25
CALL TMP
ZERO? STACK /FALSE
?CCL25: ZERO? TMP \?CND23
SET 'ACTION-PRSI,FALSE-VALUE
?CND23: EQUAL? CMD,CAST-COMMAND \?CND30
ICALL2 USE-ESSENCES,ACTION-OBJECT
?CND30: CALL2 FAKE-COMMAND?,ACTION
ZERO? STACK \?CND32
CALL2 GAME-COMMAND?,ACTION
ZERO? STACK \?CND32
CRLF
?CND32: GETP SCENE-OBJECT,P?ACTION
CALL STACK
ZERO? STACK \?CND36
GETP HERE,P?ACTION
CALL STACK
ZERO? STACK \?CND36
EQUAL? PARTY-MODE,FIGHT-MODE \?CCL41
GETP OPPONENT,P?ACTION
CALL STACK
ZERO? STACK \?CND36
?CCL41: ZERO? ACTION-OBJECT /?CCL45
GETP ACTION-OBJECT,P?ACTION
CALL STACK
ZERO? STACK \?CND36
?CCL45: GET CMD,COMMAND-ACTION
ICALL STACK
?CND36: CALL1 CHECK-USED-UP-ESSENCES
RSTACK
.FUNCT FAKE-COMMAND?:ANY:1:1,CMD
EQUAL? CMD,ILL-COMMAND,BUSY-COMMAND,GONE-COMMAND /TRUE
EQUAL? CMD,NUL-COMMAND /TRUE
RFALSE
.FUNCT GAME-COMMAND?:ANY:0:1,CMD
ASSIGNED? 'CMD /?CND1
SET 'CMD,ACTION
?CND1: EQUAL? CMD,GAME-COMMAND,CONTROLS-COMMAND,SCRIPT-ON-COMMAND /TRUE
EQUAL? CMD,SCRIPT-OFF-COMMAND,CHECK-DISK-COMMAND,VERSION-COMMAND /TRUE
EQUAL? CMD,SAVE-COMMAND,RESTORE-COMMAND,END-SESSION-COMMAND /TRUE
EQUAL? CMD,CANCEL-COMMAND,ILL-COMMAND,GONE-COMMAND /TRUE
EQUAL? CMD,BUSY-COMMAND,REFRESH-COMMAND,COMMANDS-COMMAND /TRUE
EQUAL? CMD,NO-COMMANDS-COMMAND /TRUE
RFALSE
.FUNCT PROCESS-COMMAND:ANY:2:2,PCM,PCF,CMD,OFCN,RES,?TMP1
SET 'RES,TRUE-VALUE
ISAVE >CMD
EQUAL? CMD,2 \?CND1
ICALL2 REFRESH-SCREEN,FALSE-VALUE
CRLF
PRINTI "[Undone.]"
CRLF
RFALSE
?CND1: SET 'ACTION-OBJECT,FALSE-VALUE
LESS? PCF,0 \?CCL5
SET 'ACTOR,FALSE-VALUE
GET PARTY-COMMANDS,PCM >CMD
JUMP ?CND3
?CCL5: GET PARTY,PCM >ACTOR
GET CHARACTER-INPUT-TBL,PCM >?TMP1
SUB PCF,1
GET ?TMP1,STACK >CMD
?CND3: GET CMD,COMMAND-OBJECT >OFCN
ZERO? OFCN \?CCL8
CALL2 FAKE-COMMAND?,CMD
ZERO? STACK /?CCL11
SET 'ACTION,NUL-COMMAND
SET 'RES,FALSE-VALUE
JUMP ?CND6
?CCL11: CALL2 PERFORM,CMD >RES
JUMP ?CND6
?CCL8: PUT O-TABLE,0,0
ICALL OFCN
GET O-TABLE,0
GRTR? STACK,0 \?CCL14
ICALL2 FIND-OBJECT,CANCEL-OBJECT
ICALL1 CLEAR-FIELDS
CALL2 GET-COMMAND,CMD
ICALL BOLD-CURSOR,PCM,1,STACK
ICALL PREP-CHECK,CMD,PCM
ICALL1 PRINT-COLUMNS
ICALL1 COMMAND-OBJECT-INPUT
EQUAL? ACTION-OBJECT,CANCEL-OBJECT \?CCL17
SET 'RES,FALSE-VALUE
SET 'ACTION,NUL-COMMAND
JUMP ?CND6
?CCL17: CALL2 PERFORM,CMD >RES
JUMP ?CND6
?CCL14: PRINTI "[Error: No object?]"
?CND6: ZERO? RES /?CCL20
EQUAL? ACTION,NUL-COMMAND /?CND18
CALL2 GAME-COMMAND?,ACTION
ZERO? STACK \?CND23
ICALL1 RUN-CLOCK
?CND23: CRLF
INC 'MOVE-NUMBER
JUMP ?CND18
?CCL20: EQUAL? ACTION-OBJECT,CANCEL-OBJECT /?CND18
SET 'SMART-DEFAULT-FLAG,TRUE-VALUE
SOUND 1
?CND18: ZERO? UPDATE-FLAG /?CND26
SET 'OFCN,TRUE-VALUE
?CND26: EQUAL? ACTION,MUSINGS-COMMAND /FALSE
ZERO? PUPDATE-FLAG /?CND30
SET 'PUPDATE-FLAG,FALSE-VALUE
ICALL2 PRINT-COLUMNS,TRUE-VALUE
?CND30: ZERO? SMART-DEFAULT-FLAG \?PRD35
RETURN OFCN
?PRD35: ZERO? OFCN \?CND32
SET 'SMART-DEFAULT-FLAG,FALSE-VALUE
ICALL1 SMART-DEFAULT
?CND32: RETURN OFCN
.FUNCT PREP-CHECK:ANY:2:2,CMD,PCM,STR
EQUAL? PCM,5 /FALSE
EQUAL? CMD,USE-MIX-COMMAND \?CCL5
SET 'STR,STR?17
JUMP ?CND1
?CCL5: EQUAL? CMD,RIGHT-DIAL-COMMAND,LEFT-DIAL-COMMAND \?CCL7
CALL1 APPLE2?
ZERO? STACK /?CCL10
SET 'STR,STR?18
JUMP ?CND1
?CCL10: SET 'STR,STR?19
JUMP ?CND1
?CCL7: EQUAL? CMD,ASK-UMBER-COMMAND,ASK-TREE-COMMAND,ASK-MINER-COMMAND \?CND1
SET 'STR,STR?20
?CND1: ZERO? STR /FALSE
ADD PCM,1
CALL BOLD-CURSOR,STACK,1,STR
RSTACK
.FUNCT FIND-OBJECTS:ANY:1:2,OBJ,BIT,F,CNT
FIRST? OBJ >F /?PRG2
?PRG2: ZERO? F /TRUE
EQUAL? CNT,9 /TRUE
ZERO? BIT /?CCL9
FSET? F,BIT /?CND4
?CCL9: CALL2 FIND-OBJECT,F >CNT
?CND4: NEXT? F >F /?PRG2
JUMP ?PRG2
.FUNCT FIND-OBJECT:ANY:1:1,F
CALL ADD-TO-LTABLE,O-TABLE,F
RSTACK
.FUNCT PRINT-COLUMNS:ANY:0:2,PARTY?,PRSI?,CNT,LN,OBJ,OTBL,ROW,OCNT
SET 'LN,COMMAND-START-LINE
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
ZERO? PARTY? /?CCL3
SET 'ROW,PARTY-COMMAND-COLUMN
SET 'OTBL,PARTY-COMMANDS
JUMP ?CND1
?CCL3: ZERO? PRSI? /?CCL5
ADD COMMAND-OBJECT-COLUMN,COMMAND-WIDTH >ROW
ADD O-TABLE,10 >OTBL
JUMP ?CND1
?CCL5: SET 'ROW,COMMAND-OBJECT-COLUMN
SET 'OTBL,O-TABLE
?CND1: GET OTBL,0 >CNT
?PRG6: DLESS? 'CNT,0 \?CCL10
ICALL2 SELECT-SCREEN,TEXT-WINDOW
RTRUE
?CCL10: IGRTR? 'OCNT,5 \?CND11
SET 'OCNT,0
ADD ROW,COMMAND-WIDTH >ROW
SET 'LN,COMMAND-START-LINE
?CND11: GET OTBL,1 >OBJ
ICALL GCURSET,LN,ROW
ZERO? PARTY? /?CCL15
EQUAL? OBJ,TAG-ROUTE-COMMAND \?CCL18
ZERO? TAG-NAME-LENGTH /?CCL18
ICALL1 TAG-ROUTE-PRINT
JUMP ?CND13
?CCL18: ICALL1 ERASE-COMMAND
ICALL GCURSET,LN,ROW
ICALL2 PRINT-COMMAND,OBJ
JUMP ?CND13
?CCL15: ICALL PRINT-DESC,OBJ,TRUE-VALUE
?CND13: INC 'LN
ADD OTBL,2 >OTBL
JUMP ?PRG6
.FUNCT TAG-ROUTE-PRINT:ANY:0:0,RTL
SET 'RTL,6
ADD NAME-TBL,2
PRINTT STACK,TAG-NAME-LENGTH
LESS? SCREEN-WIDTH,12-WIDTH /?CTR2
GRTR? TAG-NAME-LENGTH,6 \?CCL3
?CTR2: PRINTI " Rt"
SET 'RTL,3
JUMP ?CND1
?CCL3: PRINTI " Route"
?CND1: ADD TAG-NAME-LENGTH,RTL
SUB COMMAND-WIDTH,STACK
SUB STACK,1
PRINTT WPRINT-EBUF,STACK
RTRUE
.FUNCT ILLEGAL-COMMAND-OBJECT?:ANY:2:2,PCM,PCF,?TMP1
SUB PCF,2
MUL STACK,5
ADD PCM,STACK >?TMP1
GET O-TABLE,0
GRTR? ?TMP1,STACK /TRUE
RFALSE
.FUNCT COMMAND-OBJECT-INPUT:ANY:0:2,PCM,PCF,CHR,NPCM,NPCF,MNPCF,CLICK
ASSIGNED? 'PCM /?CND1
SET 'PCM,1
?CND1: ASSIGNED? 'PCF /?CND3
SET 'PCF,2
?CND3: SET 'INHIBIT-MOUSE-COMMANDS,TRUE-VALUE
SET 'MNPCF,PCF
ICALL BOLD-OBJECT-CURSOR,PCM,PCF
?PRG5: ZERO? CLICK \?CTR8
CALL1 GETCHR >CHR
EQUAL? CHR,13 \?CCL9
?CTR8: ICALL BOLD-OBJECT-CURSOR,PCM,PCF
ICALL PROCESS-COMMAND-OBJECT,PCM,PCF
SET 'INHIBIT-MOUSE-COMMANDS,FALSE-VALUE
RTRUE
?CCL9: EQUAL? CHR,SINGLE-CLICK,DOUBLE-CLICK \?CCL13
CALL1 LOCATE-MOUSE
ZERO? STACK /?CCL16
GET MOUSETBL,0 >NPCM
GET MOUSETBL,1 >NPCF
LESS? NPCM,1 /?CTR18
GRTR? NPCM,5 /?CTR18
LESS? NPCF,MNPCF /?CTR18
CALL ILLEGAL-COMMAND-OBJECT?,NPCM,NPCF
ZERO? STACK /?CCL19
?CTR18: SOUND 1
JUMP ?PRG5
?CCL19: ICALL NORMAL-OBJECT-CURSOR,PCM,PCF
SET 'PCM,NPCM
SET 'PCF,NPCF
SET 'CLICK,TRUE-VALUE
JUMP ?PRG5
?CCL16: SOUND 1
JUMP ?PRG5
?CCL13: EQUAL? CHR,DOWN-ARROW \?CCL25
EQUAL? PCM,5 /?CTR27
ADD PCM,1
CALL ILLEGAL-COMMAND-OBJECT?,STACK,PCF
ZERO? STACK /?CCL28
?CTR27: SOUND 1
JUMP ?PRG5
?CCL28: ICALL NORMAL-OBJECT-CURSOR,PCM,PCF
INC 'PCM
ICALL BOLD-OBJECT-CURSOR,PCM,PCF
JUMP ?PRG5
?CCL25: EQUAL? CHR,UP-ARROW \?CCL32
EQUAL? PCM,1 \?CCL35
SOUND 1
JUMP ?PRG5
?CCL35: ICALL NORMAL-OBJECT-CURSOR,PCM,PCF
DEC 'PCM
ICALL BOLD-OBJECT-CURSOR,PCM,PCF
JUMP ?PRG5
?CCL32: EQUAL? CHR,LEFT-ARROW \?CCL37
EQUAL? PCF,MNPCF \?CCL40
SOUND 1
JUMP ?PRG5
?CCL40: ICALL NORMAL-OBJECT-CURSOR,PCM,PCF
DEC 'PCF
ICALL BOLD-OBJECT-CURSOR,PCM,PCF
JUMP ?PRG5
?CCL37: EQUAL? CHR,RIGHT-ARROW \?CCL42
EQUAL? PCF,3 /?CTR44
ADD PCF,1
CALL ILLEGAL-COMMAND-OBJECT?,PCM,STACK
ZERO? STACK /?CCL45
?CTR44: SOUND 1
JUMP ?PRG5
?CCL45: ICALL NORMAL-OBJECT-CURSOR,PCM,PCF
INC 'PCF
ICALL BOLD-OBJECT-CURSOR,PCM,PCF
JUMP ?PRG5
?CCL42: CALL OBJECT-KBD-COMMAND?,CHR,MNPCF
ZERO? STACK /?CCL49
ICALL NORMAL-OBJECT-CURSOR,PCM,PCF
GET MOUSETBL,0 >PCM
GET MOUSETBL,1 >PCF
ICALL BOLD-OBJECT-CURSOR,PCM,PCF
SET 'CLICK,TRUE-VALUE
JUMP ?PRG5
?CCL49: SOUND 1
JUMP ?PRG5
.FUNCT PROCESS-COMMAND-OBJECT:ANY:2:2,PCM,PCF
SUB PCF,2
MUL STACK,5
ADD PCM,STACK
GET O-TABLE,STACK >ACTION-OBJECT
RETURN ACTION-OBJECT
.FUNCT BOLD-OBJECT-CURSOR:ANY:2:2,PCM,PCF,X,Y
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
SUB COMMAND-START-LINE,1
ADD STACK,PCM >Y
SUB PCF,1
MUL COMMAND-WIDTH,STACK
ADD CHR-COMMAND-COLUMN,STACK >X
ICALL GCURSET,Y,X
HLIGHT H-BOLD
SUB PCF,2
MUL STACK,5
ADD PCM,STACK
GET O-TABLE,STACK
ICALL PRINT-DESC,STACK,TRUE-VALUE
HLIGHT H-NORMAL
ICALL GCURSET,Y,X
CALL2 SELECT-SCREEN,TEXT-WINDOW
RSTACK
.FUNCT NORMAL-OBJECT-CURSOR:ANY:2:2,PCM,PCF,X,Y
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
SUB COMMAND-START-LINE,1
ADD STACK,PCM >Y
SUB PCF,1
MUL COMMAND-WIDTH,STACK
ADD CHR-COMMAND-COLUMN,STACK >X
ICALL GCURSET,Y,X
SUB PCF,2
MUL STACK,5
ADD PCM,STACK
GET O-TABLE,STACK
ICALL PRINT-DESC,STACK,TRUE-VALUE
CALL2 SELECT-SCREEN,TEXT-WINDOW
RSTACK
.FUNCT BOLD-PARTY-CURSOR:ANY:2:2,PCM,PCF,X,Y,CMD
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
SET 'X,PARTY-COMMAND-COLUMN
SUB COMMAND-START-LINE,1
ADD STACK,PCM >Y
ICALL GCURSET,Y,X
ICALL1 ERASE-COMMAND
ICALL GCURSET,Y,X
GET PARTY-COMMANDS,PCM >CMD
EQUAL? CMD,NUL-COMMAND /?CND1
HLIGHT H-BOLD
EQUAL? CMD,TAG-ROUTE-COMMAND \?CCL5
GRTR? TAG-NAME-LENGTH,0 \?CCL5
ICALL1 TAG-ROUTE-PRINT
JUMP ?CND3
?CCL5: ICALL2 PRINT-COMMAND,CMD
?CND3: HLIGHT H-NORMAL
?CND1: ICALL GCURSET,Y,X
ICALL2 SELECT-SCREEN,TEXT-WINDOW
RETURN CMD
.FUNCT NORMAL-PARTY-CURSOR:ANY:2:2,PCM,PCF,CMD,Y,X
ICALL2 SELECT-SCREEN,COMMAND-WINDOW
SET 'X,PARTY-COMMAND-COLUMN
SUB COMMAND-START-LINE,1
ADD STACK,PCM >Y
ICALL GCURSET,Y,X
ICALL1 ERASE-COMMAND
ICALL GCURSET,Y,X
GET PARTY-COMMANDS,PCM >CMD
EQUAL? CMD,TAG-ROUTE-COMMAND \?CCL3
GRTR? TAG-NAME-LENGTH,0 \?CCL3
ICALL1 TAG-ROUTE-PRINT
JUMP ?CND1
?CCL3: ICALL2 PRINT-COMMAND,CMD
?CND1: CALL2 SELECT-SCREEN,TEXT-WINDOW
RSTACK
.FUNCT CIT:ANY:1:4,CHR,CMD1,CMD2,CMD3
ASSIGNED? 'CMD1 /?CND1
SET 'CMD1,NUL-COMMAND
?CND1: ASSIGNED? 'CMD2 /?CND3
SET 'CMD2,NUL-COMMAND
?CND3: ASSIGNED? 'CMD3 /?CND5
SET 'CMD3,NUL-COMMAND
?CND5: ICALL CHANGE-CIT,CHR,1,CMD1,FALSE-VALUE
ICALL CHANGE-CIT,CHR,2,CMD2,FALSE-VALUE
ICALL CHANGE-CIT,CHR,3,CMD3
RTRUE
.FUNCT CHANGE-CIT:ANY:3:4,CHR,POS,CMD,PRT,?TMP1
ASSIGNED? 'PRT /?CND1
SET 'PRT,TRUE-VALUE
?CND1: FSET? CHR,IN-PARTY \FALSE
CALL2 PARTY-PCM,CHR
GET CHARACTER-INPUT-TBL,STACK >?TMP1
SUB POS,1
PUT ?TMP1,STACK,CMD
ZERO? PRT /TRUE
ICALL1 PRINT-CHARACTER-COMMANDS
RTRUE
.FUNCT PARTY-PCM:ANY:1:1,CHR,CNT,MAX
SET 'CNT,1
GET PARTY,0 >MAX
?PRG1: GET PARTY,CNT
EQUAL? STACK,CHR \?CCL5
RETURN CNT
?CCL5: IGRTR? 'CNT,MAX \?PRG1
RFALSE
.FUNCT OPTION:ANY:1:4,CHR,CMD1,CMD2,CMD3,SC
ASSIGNED? 'CMD1 /?CND1
SET 'CMD1,NUL-COMMAND
?CND1: ASSIGNED? 'CMD2 /?CND3
SET 'CMD2,NUL-COMMAND
?CND3: ASSIGNED? 'CMD3 /?CND5
SET 'CMD3,NUL-COMMAND
?CND5: SET 'OPTION-ACTOR,CHR
EQUAL? PARTY-MODE,OPTION-MODE /?CND7
SET 'OPTION-OLD-MODE,PARTY-MODE
?CND7: GETPT CHR,P?OPTION-COMMANDS >SC
PUT SC,0,CMD1
PUT SC,1,CMD2
PUT SC,2,CMD3
ICALL2 MODE,OPTION-MODE
CALL2 PARTY-PCM,CHR
CALL NEW-DEFAULT,STACK,1
RSTACK
.FUNCT END-OPTION:ANY:0:1,M,SC
ASSIGNED? 'M /?CND1
SET 'M,TRUE-VALUE
?CND1: ZERO? OPTION-ACTOR /FALSE
GETPT OPTION-ACTOR,P?OPTION-COMMANDS >SC
PUT SC,0,NUL-COMMAND
PUT SC,1,NUL-COMMAND
PUT SC,2,NUL-COMMAND
SET 'OPTION-ACTOR,FALSE-VALUE
ZERO? M /?CND5
ICALL2 MODE,OPTION-OLD-MODE
?CND5: SET 'SMART-DEFAULT-FLAG,TRUE-VALUE
RETURN SMART-DEFAULT-FLAG
.FUNCT CHARACTER-HERE?:ANY:1:1,CHR
FSET? CHR,IN-PARTY \FALSE
ZERO? SUBGROUP-MODE /TRUE
FSET? CHR,SUBGROUP /TRUE
RFALSE
.FUNCT MAKE-SUBGROUP:ANY:1:3,CHR,CHR2,CHR3
ICALL1 CLEAR-SUBGROUP
SET 'SUBGROUP-MODE,TRUE-VALUE
FSET CHR,SUBGROUP
ZERO? CHR2 /?CND1
FSET CHR2,SUBGROUP
?CND1: ZERO? CHR3 /?CND3
FSET CHR3,SUBGROUP
?CND3: EQUAL? TAG,CHR,CHR2,CHR3 /TRUE
ICALL1 SAVE-TAG-OBJECTS
RTRUE
.FUNCT CLEAR-SUBGROUP:ANY:0:0,CNT
ZERO? SUBGROUP-MODE /?CND1
FSET? TAG,SUBGROUP /?CND1
ICALL1 RESTORE-TAG-OBJECTS
?CND1: SET 'SUBGROUP-MODE,FALSE-VALUE
SET 'UPDATE-FLAG,TRUE-VALUE
?PRG5: IGRTR? 'CNT,PARTY-MAX /TRUE
GET PARTY,CNT
FCLEAR STACK,SUBGROUP
JUMP ?PRG5
.FUNCT MOVE-TO:ANY:1:5,RM,STR,GC,EF?,GFX?,MD,TMP
ASSIGNED? 'EF? /?CND1
SET 'EF?,TRUE-VALUE
?CND1: ASSIGNED? 'GFX? /?CND3
SET 'GFX?,TRUE-VALUE
?CND3: ZERO? EF? /?CND5
ICALL1 CLEAR-BUSY
?CND5: ZERO? GC \?CND7
SET 'UPDATE-FLAG,TRUE-VALUE
?CND7: ZERO? DONT-CAST-FLAG /?CND9
SET 'DONT-CAST-FLAG,FALSE-VALUE
FCLEAR HERE,DONT-CAST
?CND9: ZERO? EF? /?CND11
GETP HERE,P?EXIT
CALL STACK >TMP
?CND11: FSET? RM,PROVISIONER \?CCL15
SET 'MD,PROVISION-MODE
JUMP ?CND13
?CCL15: FSET? HERE,PROVISIONER \?CCL17
SET 'MD,TRAVEL-MODE
JUMP ?CND13
?CCL17: EQUAL? PARTY-MODE,TRAVEL-MODE /?CND13
SET 'MD,TRAVEL-MODE
?CND13: SET 'HERE,RM
ZERO? MD /?CND19
ZERO? EF? /?PRT21
PUSH 0
JUMP ?PRE23
?PRT21: PUSH 1
?PRE23: ICALL MODE,MD,FALSE-VALUE,STACK
?CND19: ZERO? STR /?CND24
PRINT STR
?CND24: ZERO? GC /?CCL28
PUSH CANCEL-COMMAND
JUMP ?CND26
?CCL28: PUSH GAME-COMMAND
?CND26: ICALL FILL-PARTY-COMMANDS,RM,STACK
ZERO? EF? /?CND29
GETP RM,P?ENTER
CALL STACK >TMP
ICALL1 RESTORE-SPELLS
?CND29: ZERO? GC /?CCL33
ICALL2 PRINT-COLUMNS,TRUE-VALUE
JUMP ?CND31
?CCL33: SET 'PUPDATE-FLAG,TRUE-VALUE
?CND31: SET 'SMART-DEFAULT-FLAG,TRUE-VALUE
ZERO? EF? \?PRD37
RETURN RM
?PRD37: ZERO? GFX? \?PRD38
RETURN RM
?PRD38: GETP HERE,P?GRAPHIC >TMP
ZERO? TMP /?CND34
GETP SCENE-OBJECT,P?GRAPHIC
ZERO? STACK \?CND34
ICALL2 GRAPHIC,TMP
?CND34: RETURN RM
.FUNCT SMART-DEFAULT:ANY:0:0
EQUAL? PARTY-MODE,OPTION-MODE \?CCL3
CALL2 PARTY-PCM,OPTION-ACTOR
CALL NEW-DEFAULT,STACK,1
RSTACK
?CCL3: GET PARTY-COMMANDS,1
EQUAL? STACK,NUL-COMMAND \?CCL5
ZERO? SUBGROUP-MODE /?CCL8
CALL1 FIRST-SUBGROUP
CALL NEW-DEFAULT,STACK,1
RSTACK
?CCL8: CALL1 FIRST-PARTY
CALL NEW-DEFAULT,STACK,1
RSTACK
?CCL5: CALL1 NEW-DEFAULT
RSTACK
.FUNCT FILL-PARTY-COMMANDS:ANY:1:2,RM,GC,T,O
ASSIGNED? 'GC /?CND1
SET 'GC,GAME-COMMAND
?CND1: GETPT RM,P?TRAVEL-COMMANDS >T
ADD PARTY-COMMANDS,2
PTSIZE T >O
COPYT T,STACK,O
LESS? O,8 \?CND3
PUT PARTY-COMMANDS,4,NUL-COMMAND
?CND3: PUT PARTY-COMMANDS,5,GC
RTRUE
.FUNCT ADD-PARTY-COMMAND:ANY:1:2,CMD,DEF?,CNT
ASSIGNED? 'DEF? /?CND1
SET 'DEF?,TRUE-VALUE
?CND1: CALL CHANGE-PARTY-COMMAND,NUL-COMMAND,CMD,DEF?
RSTACK
.FUNCT NUL-PARTY-COMMAND:ANY:1:1,CMD
CALL CHANGE-PARTY-COMMAND,CMD,NUL-COMMAND,FALSE-VALUE
RSTACK
.FUNCT CHANGE-PARTY-COMMAND:ANY:2:3,OCMD,NCMD,DEF?,CNT
ASSIGNED? 'DEF? /?PRG3
SET 'DEF?,TRUE-VALUE
?PRG3: IGRTR? 'CNT,5 /TRUE
GET PARTY-COMMANDS,CNT
EQUAL? STACK,OCMD \?PRG3
PUT PARTY-COMMANDS,CNT,NCMD
SET 'PUPDATE-FLAG,TRUE-VALUE
RTRUE
.FUNCT REMOVE-PARTY-COMMAND:ANY:1:1,CMD,CNT,?TMP1,?TMP2
?PRG1: IGRTR? 'CNT,4 /FALSE
GET PARTY-COMMANDS,CNT
EQUAL? STACK,CMD \?PRG1
ADD CNT,1
MUL STACK,2
ADD PARTY-COMMANDS,STACK >?TMP2
MUL CNT,2
ADD PARTY-COMMANDS,STACK >?TMP1
SUB 4,CNT
MUL STACK,2
COPYT ?TMP2,?TMP1,STACK
PUT PARTY-COMMANDS,4,NUL-COMMAND
SET 'PUPDATE-FLAG,TRUE-VALUE
SET 'SMART-DEFAULT-FLAG,TRUE-VALUE
RTRUE
.FUNCT NEW-DEFAULT:ANY:0:2,PCM,PCF
ASSIGNED? 'PCM /?CND1
SET 'PCM,1
?CND1: ASSIGNED? 'PCF /?CND3
SET 'PCF,-1
?CND3: SET 'NEW-DEFAULT-FLAG,TRUE-VALUE
PUT MOUSETBL,0,PCM
PUT MOUSETBL,1,PCF
RTRUE
.FUNCT TRAVEL-COMMANDS:ANY:1:5,OBJ,CMD1,CMD2,CMD3,CMD4,TBL
ASSIGNED? 'CMD1 /?CND1
SET 'CMD1,NUL-COMMAND
?CND1: ASSIGNED? 'CMD2 /?CND3
SET 'CMD2,NUL-COMMAND
?CND3: ASSIGNED? 'CMD3 /?CND5
SET 'CMD3,NUL-COMMAND
?CND5: ASSIGNED? 'CMD4 /?CND7
SET 'CMD4,NUL-COMMAND
?CND7: GETPT OBJ,P?TRAVEL-COMMANDS >TBL
PUT TBL,0,CMD1
PUT TBL,1,CMD2
PUT TBL,2,CMD3
PTSIZE TBL
GRTR? STACK,6 \?CND9
PUT TBL,3,CMD4
?CND9: ICALL UPDATE-CHECK,OBJ,TBL
RTRUE
.FUNCT PROVISION-COMMANDS:ANY:1:4,OBJ,CMD1,CMD2,CMD3,TBL
ASSIGNED? 'CMD1 /?CND1
SET 'CMD1,NUL-COMMAND
?CND1: ASSIGNED? 'CMD2 /?CND3
SET 'CMD2,NUL-COMMAND
?CND3: ASSIGNED? 'CMD3 /?CND5
SET 'CMD3,NUL-COMMAND
?CND5: GETPT OBJ,P?PROVISION-COMMANDS >TBL
PUT TBL,0,CMD1
PUT TBL,1,CMD2
PUT TBL,2,CMD3
ICALL UPDATE-CHECK,OBJ,TBL
RTRUE
.FUNCT UPDATE-CHECK:ANY:2:2,OBJ,TBL,?TMP1
EQUAL? OBJ,HERE,SCENE-OBJECT \?CCL3
ADD PARTY-COMMANDS,2 >?TMP1
PTSIZE TBL
COPYT TBL,?TMP1,STACK
SET 'PUPDATE-FLAG,TRUE-VALUE
RETURN PUPDATE-FLAG
?CCL3: FSET? OBJ,IN-PARTY \FALSE
SET 'UPDATE-FLAG,TRUE-VALUE
RETURN UPDATE-FLAG
.FUNCT SAVE-PROVISION-COMMANDS:ANY:1:1,CHR
CALL SAVE-TRAVEL-COMMANDS,CHR,P?PROVISION-COMMANDS
RSTACK
.FUNCT SAVE-TRAVEL-COMMANDS:ANY:1:2,CHR,PRP,?TMP1
ASSIGNED? 'PRP /?CND1
SET 'PRP,P?TRAVEL-COMMANDS
?CND1: GETPT CHR,PRP >?TMP1
GETPT CHR,P?SAVED-COMMANDS
COPYT ?TMP1,STACK,6
RTRUE
.FUNCT RESTORE-PROVISION-COMMANDS:ANY:1:1,CHR
CALL RESTORE-TRAVEL-COMMANDS,CHR,P?PROVISION-COMMANDS
RSTACK
.FUNCT RESTORE-TRAVEL-COMMANDS:ANY:1:2,CHR,PRP,?TMP1
ASSIGNED? 'PRP /?CND1
SET 'PRP,P?TRAVEL-COMMANDS
?CND1: GETPT CHR,P?SAVED-COMMANDS >?TMP1
GETPT CHR,PRP
COPYT ?TMP1,STACK,6
SET 'UPDATE-FLAG,TRUE-VALUE
RETURN UPDATE-FLAG
.FUNCT CHANGE-TRAVEL-COMMAND:ANY:3:5,CHR,OCMD,NCMD,NUP,PRP,TBL,CNT,CMD
ASSIGNED? 'PRP /?CND1
SET 'PRP,P?TRAVEL-COMMANDS
?CND1: SET 'CNT,-1
GETPT CHR,PRP >TBL
?PRG3: IGRTR? 'CNT,3 /FALSE
GET TBL,CNT >CMD
EQUAL? CMD,OCMD \?CCL9
PUT TBL,CNT,NCMD
EQUAL? CHR,HERE \?CCL12
ZERO? NUP \?CCL12
ICALL2 FILL-PARTY-COMMANDS,CHR
SET 'PUPDATE-FLAG,TRUE-VALUE
RTRUE
?CCL12: SET 'UPDATE-FLAG,TRUE-VALUE
RTRUE
?CCL9: EQUAL? CMD,NCMD \?PRG3
RFALSE
.FUNCT CHANGE-PROVISION-COMMAND:ANY:3:3,CHR,OCMD,NCMD
CALL CHANGE-TRAVEL-COMMAND,CHR,OCMD,NCMD,FALSE-VALUE,P?PROVISION-COMMANDS
RSTACK
.FUNCT ADD-PROVISION-COMMAND:ANY:2:2,CHR,CMD
CALL CHANGE-TRAVEL-COMMAND,CHR,NUL-COMMAND,CMD,FALSE-VALUE,P?PROVISION-COMMANDS
RSTACK
.FUNCT ADD-TRAVEL-COMMAND:ANY:2:2,CHR,CMD
CALL CHANGE-TRAVEL-COMMAND,CHR,NUL-COMMAND,CMD
RSTACK
.FUNCT FORCE-TRAVEL-COMMAND:ANY:2:2,CHR,CMD
CALL TRAVEL-COMMAND?,CHR,CMD
ZERO? STACK \FALSE
CALL ADD-TRAVEL-COMMAND,CHR,CMD
RSTACK
.FUNCT TRAVEL-COMMAND?:ANY:2:3,CHR,CMD,PRP,TBL,CNT,SIZ
ASSIGNED? 'PRP /?CND1
SET 'PRP,P?TRAVEL-COMMANDS
?CND1: SET 'CNT,-1
GETPT CHR,PRP >TBL
PTSIZE TBL
DIV STACK,2
SUB STACK,1 >SIZ
?PRG3: IGRTR? 'CNT,SIZ /FALSE
GET TBL,CNT
EQUAL? STACK,CMD \?PRG3
RTRUE
.FUNCT REMOVE-PROVISION-COMMAND:ANY:2:2,CHR,CMD
CALL REMOVE-TRAVEL-COMMAND,CHR,CMD,P?PROVISION-COMMANDS
RSTACK
.FUNCT REMOVE-TRAVEL-COMMAND:ANY:0:3,CHR,CMD,PRP,TBL,CNT,SIZ,?TMP1,?TMP2
SET 'CNT,-1
ASSIGNED? 'CHR /?CND1
SET 'CHR,HERE
?CND1: ASSIGNED? 'CMD /?CND3
SET 'CMD,ACTION
?CND3: ASSIGNED? 'PRP /?CND5
SET 'PRP,P?TRAVEL-COMMANDS
?CND5: GETPT CHR,PRP >TBL
PTSIZE TBL
DIV STACK,2
SUB STACK,1 >SIZ
?PRG7: IGRTR? 'CNT,SIZ /FALSE
GET TBL,CNT
EQUAL? STACK,CMD \?PRG7
EQUAL? SIZ,CNT /?CND13
ADD CNT,1
MUL STACK,2
ADD TBL,STACK >?TMP2
MUL CNT,2
ADD TBL,STACK >?TMP1
SUB SIZ,CNT
MUL STACK,2
COPYT ?TMP2,?TMP1,STACK
?CND13: PUT TBL,SIZ,NUL-COMMAND
ICALL UPDATE-CHECK,CHR,TBL
EQUAL? CHR,HERE,SCENE-OBJECT \TRUE
EQUAL? ACTION,CMD \TRUE
SET 'SMART-DEFAULT-FLAG,TRUE-VALUE
RTRUE
.FUNCT PRSI-INPUT:ANY:1:2,STR,COL3,TMP,OBJ,?TMP1
SET 'PRSI-PREP,STR
SET 'OBJ,ACTION-OBJECT
ZERO? COL3 /?CCL3
GET O-TABLE,5 >TMP
JUMP ?CND1
?CCL3: GET O-TABLE,0 >TMP
?CND1: GRTR? TMP,0 \FALSE
INC 'TMP
ZERO? COL3 /?CCL9
PUT O-TABLE,5,TMP
ADD TMP,5
PUT O-TABLE,STACK,CANCEL-OBJECT
JUMP ?CND7
?CCL9: PUT O-TABLE,0,TMP
PUT O-TABLE,TMP,CANCEL-OBJECT
?CND7: ICALL1 CLEAR-FIELDS
CALL2 PARTY-PCM,ACTOR >TMP
ZERO? COL3 /?CCL12
CALL2 GET-COMMAND,ACTION
ICALL BOLD-CURSOR,TMP,1,STACK
EQUAL? TMP,5 \?CND13
SET 'TMP,4
?CND13: CALL2 GET-DESC,ACTION-OBJECT
ICALL BOLD-CURSOR,TMP,2,STACK
ADD TMP,1
ICALL BOLD-CURSOR,STACK,2,STR
ICALL PRINT-COLUMNS,FALSE-VALUE,TRUE-VALUE
ICALL COMMAND-OBJECT-INPUT,1,3
JUMP ?CND10
?CCL12: GRTR? TMP,3 \?CND15
SET 'TMP,3
?CND15: CALL2 GET-COMMAND,ACTION
ICALL BOLD-CURSOR,TMP,1,STACK
ADD TMP,1 >?TMP1
CALL2 GET-DESC,ACTION-OBJECT
ICALL BOLD-CURSOR,?TMP1,1,STACK
ADD TMP,2
ICALL BOLD-CURSOR,STACK,1,STR
ICALL2 PRINT-COLUMNS,FALSE-VALUE
ICALL1 COMMAND-OBJECT-INPUT
?CND10: EQUAL? ACTION-OBJECT,CANCEL-OBJECT \?CCL19
SET 'ACTION,NUL-COMMAND
RFALSE
?CCL19: SET 'ACTION-PRSI,ACTION-OBJECT
SET 'ACTION-OBJECT,OBJ
RTRUE
.FUNCT RUN-CLOCK:ANY:0:0,OBJ,NXT,CNT
GETP HERE,P?CLOCK
ICALL STACK
GETP SCENE-OBJECT,P?CLOCK
ICALL STACK
FIRST? CLOCK-QUEUE >OBJ /?PRG2
?PRG2: ZERO? OBJ /TRUE
NEXT? OBJ >NXT /?BOGUS7
?BOGUS7: GETP OBJ,P?TIME
SUB STACK,1 >CNT
LESS? CNT,1 \?CCL10
GETP OBJ,P?ACTION
ICALL STACK
ZERO? CNT \?CND8
REMOVE OBJ
JUMP ?CND8
?CCL10: PUTP OBJ,P?TIME,CNT
?CND8: SET 'OBJ,NXT
JUMP ?PRG2
.FUNCT QUEUE:ANY:2:2,OBJ,TIM
MOVE OBJ,CLOCK-QUEUE
ADD TIM,1
PUTP OBJ,P?TIME,STACK
RTRUE
.FUNCT ADD-TO-LTABLE:ANY:2:2,TBL,OBJ,TMP
GET TBL,0
ADD STACK,1 >TMP
PUT TBL,TMP,OBJ
PUT TBL,0,TMP
RETURN TMP
.FUNCT TURN-ON-CURSOR:ANY:0:0
CURSET -2
RTRUE
.FUNCT TURN-OFF-CURSOR:ANY:0:0
CURSET -1
RTRUE
.ENDSEG
.ENDI