mirror of
https://github.com/historicalsource/journey
synced 2024-04-26 05:59:31 +03:00
2140 lines
46 KiB
Plaintext
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
|