2336 lines
48 KiB
Plaintext
2336 lines
48 KiB
Plaintext
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT INIT-STATUS-LINE:ANY:0:1,PW?,CW,Y,Y1,N,?TMP2,?TMP1
|
|
ASSIGNED? 'PW? /?CND1
|
|
SET 'PW?,TRUE-VALUE
|
|
?CND1: GET 0,18
|
|
SUB STACK,GL-FONT-Y >N
|
|
ZERO? PW? /?CCL5
|
|
DIV N,2
|
|
ADD 1,STACK
|
|
ADD STACK,GL-FONT-Y >?TMP1
|
|
MUL 27,GL-FONT-X
|
|
ADD 1,STACK
|
|
WINPOS 0,?TMP1,STACK
|
|
ADD N,1
|
|
DIV STACK,2 >?TMP1
|
|
GET 0,17 >?TMP2
|
|
MUL 27,GL-FONT-X
|
|
SUB ?TMP2,STACK
|
|
WINSIZE 0,?TMP1,STACK
|
|
ADD 1,GL-FONT-Y >?TMP1
|
|
MUL 27,GL-FONT-X
|
|
ADD 1,STACK
|
|
WINPOS 6,?TMP1,STACK
|
|
DIV N,2 >?TMP1
|
|
GET 0,17 >?TMP2
|
|
MUL 27,GL-FONT-X
|
|
SUB ?TMP2,STACK
|
|
WINSIZE 6,?TMP1,STACK
|
|
JUMP ?CND3
|
|
?CCL5: ADD 1,GL-FONT-Y >?TMP1
|
|
MUL 27,GL-FONT-X
|
|
ADD 1,STACK
|
|
WINPOS 0,?TMP1,STACK
|
|
GET 0,18
|
|
SUB STACK,GL-FONT-Y >?TMP1
|
|
GET 0,17 >?TMP2
|
|
MUL 27,GL-FONT-X
|
|
SUB ?TMP2,STACK
|
|
WINSIZE 0,?TMP1,STACK
|
|
WINPOS 6,1,1
|
|
WINSIZE 6,0,0
|
|
?CND3: WINPOS 1,1,1
|
|
GET 0,17
|
|
WINSIZE 1,GL-FONT-Y,STACK
|
|
GET 0,18
|
|
SUB STACK,GL-FONT-Y
|
|
ADD STACK,1
|
|
WINPOS 2,STACK,1
|
|
GET 0,17
|
|
WINSIZE 2,GL-FONT-Y,STACK
|
|
MUL 3,GL-FONT-Y
|
|
ADD 1,STACK
|
|
WINPOS 3,STACK,1
|
|
GET 0,18 >?TMP2
|
|
MUL 3,GL-FONT-Y
|
|
SUB ?TMP2,STACK >?TMP1
|
|
MUL 10,GL-FONT-X
|
|
WINSIZE 3,?TMP1,STACK
|
|
MUL 3,GL-FONT-Y
|
|
ADD 1,STACK >?TMP1
|
|
MUL 11,GL-FONT-X
|
|
ADD 1,STACK
|
|
WINPOS 4,?TMP1,STACK
|
|
GET 0,18 >?TMP2
|
|
MUL 3,GL-FONT-Y
|
|
SUB ?TMP2,STACK >?TMP1
|
|
MUL 15,GL-FONT-X
|
|
WINSIZE 4,?TMP1,STACK
|
|
ADD GL-FONT-Y,1
|
|
WINPOS 5,STACK,1
|
|
MUL 2,GL-FONT-Y >?TMP1
|
|
MUL 27,GL-FONT-X
|
|
WINSIZE 5,?TMP1,STACK
|
|
WINPOS 7,1,1
|
|
GET 0,18 >?TMP1
|
|
GET 0,17
|
|
WINSIZE 7,?TMP1,STACK
|
|
SCREEN 7
|
|
HLIGHT K-H-INV
|
|
WINGET 3,K-W-YPOS >Y
|
|
WINGET 3,K-W-YSIZE
|
|
ADD Y,STACK
|
|
SUB STACK,1 >Y1
|
|
?PRG6: CALL2 C-PIXELS,11
|
|
CURSET Y,STACK
|
|
PRINTC 32
|
|
CALL2 C-PIXELS,27
|
|
CURSET Y,STACK
|
|
PRINTC 32
|
|
ADD Y,GL-FONT-Y >Y
|
|
GRTR? Y,Y1 \?PRG6
|
|
HLIGHT K-H-NRM
|
|
SCREEN 5
|
|
WINGET 5,K-W-XSIZE
|
|
DIV STACK,GL-SPACE-WIDTH >N
|
|
PUTB K-DIROUT-TBL,0,32
|
|
ADD K-DIROUT-TBL,1 >?TMP1
|
|
SUB 0,N
|
|
COPYT K-DIROUT-TBL,?TMP1,STACK
|
|
CURSET 1,1
|
|
HLIGHT K-H-INV
|
|
PRINTT K-DIROUT-TBL,N
|
|
CURSET 1,1
|
|
PRINTI "EXECUTE"
|
|
ICALL CCURSET,1,13
|
|
PRINTI "DELETE"
|
|
ICALL CCURSET,2,1
|
|
PRINTT K-DIROUT-TBL,N
|
|
ICALL CCURSET,2,1
|
|
PRINTI "UP"
|
|
ICALL CCURSET,2,7
|
|
PRINTI "DN"
|
|
ICALL CCURSET,2,13
|
|
PRINTI "UP"
|
|
ICALL CCURSET,2,24
|
|
PRINTI "DN"
|
|
HLIGHT K-H-NRM
|
|
SCREEN 1
|
|
CURSET 1,1
|
|
WINGET 1,K-W-XSIZE
|
|
DIV STACK,GL-SPACE-WIDTH >N
|
|
PUTB K-DIROUT-TBL,0,32
|
|
ADD K-DIROUT-TBL,1 >?TMP1
|
|
SUB 0,N
|
|
COPYT K-DIROUT-TBL,?TMP1,STACK
|
|
HLIGHT H-INVERSE
|
|
PRINTT K-DIROUT-TBL,N
|
|
HLIGHT H-NORMAL
|
|
SCREEN 0
|
|
SET 'GL-SL-HERE,FALSE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT UPDATE-STATUS-LINE:ANY:0:0,C,CW,N,H,M,S,?TMP1
|
|
SCREEN 1
|
|
HLIGHT K-H-INV
|
|
EQUAL? HERE,GL-SL-HERE /?CND1
|
|
SET 'GL-SL-HERE,HERE
|
|
CURSET 1,1
|
|
WINGET 1,K-W-XSIZE >?TMP1
|
|
WINGET 1,K-W-XCURPOS
|
|
SUB ?TMP1,STACK
|
|
DIV STACK,GL-SPACE-WIDTH >N
|
|
PUTB K-DIROUT-TBL,0,32
|
|
ADD K-DIROUT-TBL,1 >?TMP1
|
|
SUB 0,N
|
|
COPYT K-DIROUT-TBL,?TMP1,STACK
|
|
PRINTT K-DIROUT-TBL,N
|
|
CURSET 1,1
|
|
DIROUT K-D-TBL-ON,K-DIROUT-TBL
|
|
ICALL2 RT-PRINT-DESC,HERE
|
|
DIROUT K-D-TBL-OFF
|
|
GETB K-DIROUT-TBL,2 >C
|
|
LESS? C,97 /?CND3
|
|
GRTR? C,122 /?CND3
|
|
SUB C,32
|
|
PUTB K-DIROUT-TBL,2,STACK
|
|
?CND3: ADD K-DIROUT-TBL,2 >?TMP1
|
|
GET K-DIROUT-TBL,0
|
|
PRINTT ?TMP1,STACK
|
|
?CND1: WINGET 1,K-W-XSIZE >?TMP1
|
|
MUL 9,GL-FONT-X
|
|
SUB ?TMP1,STACK
|
|
ADD STACK,1
|
|
CURSET 1,STACK
|
|
WINGET 1,K-W-XSIZE >?TMP1
|
|
WINGET 1,K-W-XCURPOS
|
|
SUB ?TMP1,STACK
|
|
DIV STACK,GL-SPACE-WIDTH >N
|
|
PUTB K-DIROUT-TBL,0,32
|
|
ADD K-DIROUT-TBL,1 >?TMP1
|
|
SUB 0,N
|
|
COPYT K-DIROUT-TBL,?TMP1,STACK
|
|
PRINTT K-DIROUT-TBL,N
|
|
MOD GL-MOVES,2880 >N
|
|
DIV N,120
|
|
MOD STACK,24 >H
|
|
DIV N,2
|
|
MOD STACK,60 >M
|
|
MOD N,2
|
|
MUL STACK,30 >S
|
|
DIROUT K-D-TBL-ON,K-DIROUT-TBL
|
|
LESS? H,10 \?CND7
|
|
PRINTC 48
|
|
?CND7: PRINTN H
|
|
PRINTC 58
|
|
LESS? M,10 \?CND9
|
|
PRINTC 48
|
|
?CND9: PRINTN M
|
|
PRINTC 58
|
|
LESS? S,10 \?CND11
|
|
PRINTC 48
|
|
?CND11: PRINTN S
|
|
DIROUT K-D-TBL-OFF
|
|
WINGET 1,K-W-XSIZE >?TMP1
|
|
GET 0,24
|
|
SUB ?TMP1,STACK
|
|
ADD STACK,1
|
|
CURSET 1,STACK
|
|
ADD K-DIROUT-TBL,2 >?TMP1
|
|
GET K-DIROUT-TBL,0
|
|
PRINTT ?TMP1,STACK
|
|
HLIGHT K-H-NRM
|
|
SCREEN 0
|
|
RTRUE
|
|
|
|
|
|
.FUNCT RT-PRINT-MENU:ANY:1:1,MN,N,L,TBL,W
|
|
ADD 3,MN >W
|
|
SCREEN W
|
|
CLEAR W
|
|
CURSET 1,1
|
|
GET K-MENU-TBL,MN >TBL
|
|
GETB K-FIRST-ENTRY-TBL,MN >N
|
|
WINGET -3,K-W-YSIZE
|
|
DIV STACK,GL-FONT-Y
|
|
ADD N,STACK
|
|
SUB STACK,1 >L
|
|
GET TBL,0
|
|
LESS? STACK,L \?PRG3
|
|
GET TBL,0 >L
|
|
?PRG3: GRTR? N,L /TRUE
|
|
ICALL RT-PRINT-MENU-ENTRY,MN,N
|
|
CRLF
|
|
INC 'N
|
|
JUMP ?PRG3
|
|
|
|
|
|
.FUNCT RT-PRINT-MENU-ENTRY:ANY:2:2,MN,N,L,ITEM,TBL,W,T
|
|
GET K-MENU-TBL,MN >TBL
|
|
ZERO? TBL /FALSE
|
|
GET TBL,N >ITEM
|
|
ZERO? ITEM /FALSE
|
|
GETB K-MENU-TBL-TYPE,MN >T
|
|
EQUAL? T,K-MENU-ONE-WORD \?CCL8
|
|
PRINTB ITEM
|
|
RTRUE
|
|
?CCL8: EQUAL? T,K-MENU-MANY-WORD \?CCL10
|
|
GET ITEM,0 >L
|
|
ADD ITEM,2 >ITEM
|
|
?PRG11: DLESS? 'L,0 /TRUE
|
|
GET ITEM,0 >W
|
|
ZERO? W /?CCL18
|
|
PRINTB W
|
|
JUMP ?CND16
|
|
?CCL18: PRINTC 126
|
|
?CND16: GRTR? L,0 \?CND19
|
|
PRINTC 32
|
|
?CND19: ADD ITEM,2 >ITEM
|
|
JUMP ?PRG11
|
|
?CCL10: EQUAL? T,K-MENU-OBJECT \FALSE
|
|
ADD LAST-OBJECT,1
|
|
EQUAL? ITEM,STACK \?CCL25
|
|
PRINTI "all"
|
|
RTRUE
|
|
?CCL25: GETP ITEM,P?MENU >W
|
|
ZERO? W /?CCL27
|
|
PRINT W
|
|
RTRUE
|
|
?CCL27: CALL2 RT-PRINT-DESC,ITEM
|
|
RSTACK
|
|
|
|
|
|
.FUNCT RT-HLIGHT-MENU:ANY:2:3,MN,L,ON?,Y,TBL,N,?TMP1
|
|
ASSIGNED? 'ON? /?CND1
|
|
SET 'ON?,TRUE-VALUE
|
|
?CND1: ADD 3,MN
|
|
SCREEN STACK
|
|
GETB K-FIRST-ENTRY-TBL,MN
|
|
SUB L,STACK
|
|
ADD STACK,1 >Y
|
|
CALL2 L-PIXELS,Y
|
|
CURSET STACK,1
|
|
ZERO? ON? /?CND3
|
|
HLIGHT K-H-INV
|
|
?CND3: ICALL RT-PRINT-MENU-ENTRY,MN,L
|
|
ZERO? ON? /?CCL7
|
|
WINGET -3,K-W-XSIZE >?TMP1
|
|
WINGET -3,K-W-XCURPOS
|
|
SUB ?TMP1,STACK
|
|
DIV STACK,GL-SPACE-WIDTH >N
|
|
PUTB K-DIROUT-TBL,0,32
|
|
ADD K-DIROUT-TBL,1 >?TMP1
|
|
SUB 0,N
|
|
COPYT K-DIROUT-TBL,?TMP1,STACK
|
|
PRINTT K-DIROUT-TBL,N
|
|
HLIGHT K-H-NRM
|
|
RTRUE
|
|
?CCL7: ERASE 1
|
|
RTRUE
|
|
|
|
|
|
.FUNCT RT-GET-PREPS:ANY:2:3,ACT,TBL,PREP,PTR,L,M,N,P
|
|
ASSIGNED? 'PREP /?CND1
|
|
SET 'PREP,-1
|
|
?CND1: EQUAL? PREP,-1 \?CCL5
|
|
SET 'L,1
|
|
JUMP ?PRG6
|
|
?CCL5: SET 'L,3
|
|
?PRG6: EQUAL? L,1 \?CCL10
|
|
GET ACT,2 >PTR
|
|
JUMP ?CND8
|
|
?CCL10: GET ACT,3 >PTR
|
|
?CND8: ZERO? PTR /?CND11
|
|
GET PTR,0 >M
|
|
ADD PTR,2 >PTR
|
|
GET TBL,0 >N
|
|
?PRG13: DLESS? 'M,0 /?CND11
|
|
EQUAL? PREP,-1 \?CCL20
|
|
GET PTR,1 >P
|
|
JUMP ?CND18
|
|
?CCL20: GET PTR,3 >P
|
|
?CND18: ZERO? P /?CND21
|
|
EQUAL? PREP,-1 /?CCL24
|
|
GET PTR,1
|
|
EQUAL? PREP,STACK \?CND21
|
|
?CCL24: ADD TBL,2
|
|
INTBL? P,STACK,N /?CND21
|
|
INC 'N
|
|
PUT TBL,N,P
|
|
PUT TBL,0,N
|
|
?CND21: EQUAL? L,1 \?CCL31
|
|
ADD PTR,6 >PTR
|
|
JUMP ?PRG13
|
|
?CCL31: ADD PTR,10 >PTR
|
|
JUMP ?PRG13
|
|
?CND11: EQUAL? L,1 \TRUE
|
|
SET 'L,3
|
|
JUMP ?PRG6
|
|
|
|
|
|
.FUNCT RT-GET-OBJS:ANY:1:3,TBL,CONT,SEARCH,OBJ,N,PTR,ADD?
|
|
ASSIGNED? 'CONT /?CND1
|
|
SET 'CONT,HERE
|
|
?CND1: ASSIGNED? 'SEARCH /?CND3
|
|
SET 'SEARCH,15
|
|
?CND3: FIRST? CONT >OBJ /?PRG6
|
|
?PRG6: ZERO? OBJ /TRUE
|
|
FSET? OBJ,FL-INVISIBLE /?CND8
|
|
IN? CONT,ROOMS \?CCL14
|
|
BAND SEARCH,1 >ADD?
|
|
JUMP ?CND12
|
|
?CCL14: EQUAL? CONT,CH-PLAYER \?CCL16
|
|
BAND SEARCH,4 >ADD?
|
|
JUMP ?CND12
|
|
?CCL16: SET 'ADD?,TRUE-VALUE
|
|
?CND12: ZERO? ADD? /?CND17
|
|
GET TBL,0
|
|
ADD STACK,1 >N
|
|
PUT TBL,N,OBJ
|
|
PUT TBL,0,N
|
|
?CND17: IN? CONT,ROOMS \?PRD22
|
|
BTST SEARCH,2 /?CCL20
|
|
?PRD22: EQUAL? CONT,CH-PLAYER \?CND8
|
|
BTST SEARCH,8 \?CND8
|
|
?CCL20: CALL2 CLOSED?,OBJ
|
|
ZERO? STACK \?CND8
|
|
ICALL RT-GET-OBJS,TBL,OBJ,SEARCH
|
|
?CND8: NEXT? OBJ >OBJ /?PRG6
|
|
JUMP ?PRG6
|
|
|
|
|
|
.FUNCT RT-DO-OBJECTS:ANY:0:1,SEARCH,PTR,I,N,OBJ,STR
|
|
ASSIGNED? 'SEARCH /?CND1
|
|
SET 'SEARCH,31
|
|
?CND1: BTST SEARCH,16 \?CND3
|
|
ADD LAST-OBJECT,1
|
|
PUT K-OBJECT-TBL,1,STACK
|
|
PUT K-OBJECT-TBL,0,1
|
|
?CND3: ICALL RT-GET-OBJS,K-OBJECT-TBL,HERE,SEARCH
|
|
GETPT HERE,P?GLOBAL >PTR
|
|
PTSIZE PTR
|
|
DIV STACK,2 >N
|
|
?PRG5: DLESS? 'N,0 /?REP6
|
|
GET K-OBJECT-TBL,0
|
|
ADD STACK,1 >I
|
|
GET PTR,0
|
|
PUT K-OBJECT-TBL,I,STACK
|
|
PUT K-OBJECT-TBL,0,I
|
|
ADD PTR,2 >PTR
|
|
JUMP ?PRG5
|
|
?REP6: RETURN K-OBJECT-TBL
|
|
|
|
|
|
.FUNCT RT-GET-MEM:ANY:1:1,N,PTR
|
|
SET 'PTR,GL-FREE-PTR
|
|
ADD N,1
|
|
MUL 2,STACK
|
|
ADD GL-FREE-PTR,STACK >GL-FREE-PTR
|
|
PUT PTR,0,N
|
|
RETURN PTR
|
|
|
|
|
|
.FUNCT RT-FREE-MEM:ANY:1:4,PTR,N,P,L
|
|
ASSIGNED? 'N /?CND1
|
|
SET 'N,-1
|
|
?CND1: LESS? N,0 \?CND3
|
|
GET PTR,0 >N
|
|
?CND3: ADD N,1
|
|
MUL 2,STACK >L
|
|
ADD PTR,L >P
|
|
SUB GL-FREE-PTR,P
|
|
COPYT P,PTR,STACK
|
|
SUB GL-FREE-PTR,L >GL-FREE-PTR
|
|
RETURN GL-FREE-PTR
|
|
|
|
|
|
.FUNCT RT-STOP-READ:ANY:0:0
|
|
SET 'GL-INPUT-TIMEOUT,TRUE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT MOUSE-INPUT?:ANY:0:5,W,X1,Y1,X2,Y2,N
|
|
GET 0,27
|
|
GET STACK,1 >GL-MOUSE-X
|
|
GET 0,27
|
|
GET STACK,2 >GL-MOUSE-Y
|
|
ASSIGNED? 'W \TRUE
|
|
ASSIGNED? 'X1 /?CCL5
|
|
EQUAL? W,-1 /TRUE
|
|
WINGET W,K-W-XPOS >X1
|
|
WINGET W,K-W-YPOS >Y1
|
|
WINGET W,K-W-XSIZE
|
|
ADD X1,STACK
|
|
SUB STACK,1 >X2
|
|
WINGET W,K-W-YSIZE
|
|
ADD Y1,STACK
|
|
SUB STACK,1 >Y2
|
|
LESS? GL-MOUSE-X,X1 /FALSE
|
|
GRTR? GL-MOUSE-X,X2 /FALSE
|
|
LESS? GL-MOUSE-Y,Y1 /FALSE
|
|
GRTR? GL-MOUSE-Y,Y2 /FALSE
|
|
SUB GL-MOUSE-X,X1
|
|
ADD STACK,1 >GL-MOUSE-X
|
|
SUB GL-MOUSE-Y,Y1
|
|
ADD STACK,1 >GL-MOUSE-Y
|
|
RTRUE
|
|
?CCL5: EQUAL? W,-1 /?CND16
|
|
WINGET W,K-W-XPOS
|
|
SUB STACK,1 >N
|
|
ADD X1,N >X1
|
|
ADD X2,N >X2
|
|
WINGET W,K-W-YPOS
|
|
SUB STACK,1 >N
|
|
ADD Y1,N >Y1
|
|
ADD Y2,N >Y2
|
|
?CND16: LESS? GL-MOUSE-X,X1 /FALSE
|
|
GRTR? GL-MOUSE-X,X2 /FALSE
|
|
LESS? GL-MOUSE-Y,Y1 /FALSE
|
|
GRTR? GL-MOUSE-Y,Y2 /FALSE
|
|
SUB GL-MOUSE-X,X1
|
|
ADD STACK,1 >GL-MOUSE-X
|
|
SUB GL-MOUSE-Y,Y1
|
|
ADD STACK,1 >GL-MOUSE-Y
|
|
RTRUE
|
|
|
|
|
|
.FUNCT READ-INPUT:ANY:0:0,C,L,M,N,TBL,ACT,S?,Y,X,W,?TMP1
|
|
MOUSE-LIMIT -1
|
|
SET 'GL-FREE-PTR,K-JUNK-TBL
|
|
SET 'GL-VERB-TBL,K-DEFAULT-VERB-TBL
|
|
SET 'GL-PREP-TBL,FALSE-VALUE
|
|
CALL1 RT-DO-OBJECTS >GL-NOUN-TBL
|
|
PUTB K-FIRST-ENTRY-TBL,0,1
|
|
PUTB K-FIRST-ENTRY-TBL,1,1
|
|
PUTB K-MENU-TBL-TYPE,0,K-MENU-MANY-WORD
|
|
PUTB K-MENU-TBL-TYPE,1,K-MENU-OBJECT
|
|
PUT K-MENU-TBL,0,GL-VERB-TBL
|
|
PUT K-MENU-TBL,1,GL-NOUN-TBL
|
|
SET 'GL-INPUT-WINNER,CH-PLAYER
|
|
SET 'GL-INPUT-VERB,FALSE-VALUE
|
|
SET 'GL-INPUT-PREP1,FALSE-VALUE
|
|
SET 'GL-INPUT-PREP2,FALSE-VALUE
|
|
SET 'GL-MENU-NUM,0
|
|
SET 'GL-ITEM-NUM,0
|
|
SET 'GL-INPUT-STATE,0
|
|
ICALL2 RT-PRINT-MENU,0
|
|
ICALL2 RT-PRINT-MENU,1
|
|
GET K-MENU-TBL,GL-MENU-NUM >TBL
|
|
SET 'L,1
|
|
SCREEN 0
|
|
WINATTR 0,A-BUFFER,O-CLEAR
|
|
WINGET 0,K-W-YCURPOS >Y
|
|
PRINTC 62
|
|
PUTB P-INBUF,1,0
|
|
?PRG1: SET 'S?,FALSE-VALUE
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L
|
|
SCREEN 0
|
|
READ P-INBUF,P-LEXV >C
|
|
GETB P-INBUF,1 >N
|
|
EQUAL? C,K-CLICK1,K-CLICK2 \?CND3
|
|
SET 'W,3
|
|
?PRG5: CALL2 MOUSE-INPUT?,W
|
|
ZERO? STACK \?REP6
|
|
IGRTR? 'W,5 \?PRG5
|
|
SET 'W,-1
|
|
?REP6: EQUAL? W,3,4 \?CCL13
|
|
SUB W,3 >W
|
|
SUB GL-MOUSE-Y,1
|
|
DIV STACK,GL-FONT-Y >?TMP1
|
|
GETB K-FIRST-ENTRY-TBL,W
|
|
ADD ?TMP1,STACK >M
|
|
EQUAL? L,M \?CCL15
|
|
EQUAL? GL-MENU-NUM,W /?CND14
|
|
?CCL15: GET K-MENU-TBL,W
|
|
GET STACK,0
|
|
GRTR? M,STACK /?CCL20
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
ICALL RT-HLIGHT-MENU,W,M
|
|
?CND14: SET 'GL-MENU-NUM,W
|
|
GET K-MENU-TBL,GL-MENU-NUM >TBL
|
|
SET 'L,M
|
|
SET 'C,K-F1
|
|
JUMP ?CND3
|
|
?CCL20: SOUND S-BEEP
|
|
JUMP ?PRG1
|
|
?CCL13: EQUAL? W,5 \?CCL22
|
|
CALL2 PIXELS-L,GL-MOUSE-Y >Y
|
|
CALL2 PIXELS-C,GL-MOUSE-X >X
|
|
EQUAL? Y,1 \?CCL25
|
|
LESS? X,13 \?CCL28
|
|
SET 'C,CR
|
|
CRLF
|
|
JUMP ?CND3
|
|
?CCL28: SET 'C,K-F2
|
|
JUMP ?CND3
|
|
?CCL25: LESS? X,4 \?CCL31
|
|
SET 'C,K-F3
|
|
SET 'W,0
|
|
JUMP ?CND29
|
|
?CCL31: LESS? X,7 /?CCL33
|
|
LESS? X,10 \?CCL33
|
|
SET 'C,K-F4
|
|
SET 'W,0
|
|
JUMP ?CND29
|
|
?CCL33: LESS? X,13 /?CCL37
|
|
LESS? X,16 \?CCL37
|
|
SET 'C,K-F3
|
|
SET 'W,1
|
|
JUMP ?CND29
|
|
?CCL37: LESS? X,24 /?CCL41
|
|
LESS? X,27 \?CCL41
|
|
SET 'C,K-F4
|
|
SET 'W,1
|
|
?CND29: EQUAL? GL-MENU-NUM,W /?CND3
|
|
GET K-MENU-TBL,W >M
|
|
GET M,0
|
|
GRTR? STACK,0 \?CCL48
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
SET 'TBL,M
|
|
GETB K-FIRST-ENTRY-TBL,W >L
|
|
SET 'GL-MENU-NUM,W
|
|
GET TBL,0
|
|
GRTR? L,STACK \?CCL51
|
|
GET TBL,0 >L
|
|
JUMP ?CND3
|
|
?CCL41: SOUND S-BEEP
|
|
JUMP ?PRG1
|
|
?CCL51: GET TBL,L
|
|
ZERO? STACK \?CND3
|
|
INC 'L
|
|
?CND3: SCREEN 0
|
|
EQUAL? C,CR,LF /?REP2
|
|
EQUAL? C,32 \?CCL57
|
|
ADD P-INBUF,2
|
|
PUTB STACK,N,32
|
|
PRINTC 32
|
|
INC 'N
|
|
PUTB P-INBUF,1,N
|
|
JUMP ?CND53
|
|
?CCL48: SOUND S-BEEP
|
|
JUMP ?PRG1
|
|
?CCL22: SOUND S-BEEP
|
|
JUMP ?PRG1
|
|
?CCL57: EQUAL? C,K-F1 \?CCL59
|
|
ZERO? TBL /?CCL62
|
|
GET TBL,0
|
|
GRTR? STACK,0 \?CCL62
|
|
DIROUT K-D-TBL-ON,K-DIROUT-TBL
|
|
ICALL RT-PRINT-MENU-ENTRY,GL-MENU-NUM,L
|
|
DIROUT K-D-TBL-OFF
|
|
GET K-DIROUT-TBL,0 >M
|
|
SHIFT GL-INPUT-STATE,8
|
|
BOR N,STACK
|
|
PUT K-ITEM-TBL,GL-ITEM-NUM,STACK
|
|
GRTR? N,0 \?CND65
|
|
ADD P-INBUF,2 >?TMP1
|
|
SUB N,1
|
|
GETB ?TMP1,STACK
|
|
EQUAL? STACK,32 /?CND65
|
|
ADD P-INBUF,2
|
|
PUTB STACK,N,32
|
|
PRINTC 32
|
|
INC 'N
|
|
?CND65: ADD K-DIROUT-TBL,2 >?TMP1
|
|
ADD 2,N
|
|
ADD P-INBUF,STACK
|
|
COPYT ?TMP1,STACK,M
|
|
ADD K-DIROUT-TBL,2
|
|
PRINTT STACK,M
|
|
ADD N,M >N
|
|
ZERO? GL-INPUT-STATE \?CCL71
|
|
EQUAL? GL-MENU-NUM,1 \?CCL71
|
|
ADD P-INBUF,2
|
|
PUTB STACK,N,44
|
|
PRINTC 44
|
|
INC 'N
|
|
JUMP ?CND69
|
|
?CCL71: EQUAL? GL-INPUT-STATE,0,1 \?CND69
|
|
ZERO? GL-MENU-NUM \?CND69
|
|
GET TBL,L
|
|
GET STACK,1
|
|
GET STACK,4
|
|
BTST STACK,64 \?CND69
|
|
ADD P-INBUF,2
|
|
PUTB STACK,N,46
|
|
PRINTC 46
|
|
INC 'N
|
|
?CND69: ADD P-INBUF,2
|
|
PUTB STACK,N,32
|
|
PRINTC 32
|
|
INC 'N
|
|
PUTB P-INBUF,1,N
|
|
LEX P-INBUF,P-LEXV
|
|
INC 'GL-ITEM-NUM
|
|
INPUT 1,1,RT-STOP-READ
|
|
EQUAL? GL-INPUT-STATE,0,1 \?CCL80
|
|
ZERO? GL-MENU-NUM \?CCL80
|
|
GET TBL,L
|
|
GET STACK,1 >GL-INPUT-VERB
|
|
GET GL-INPUT-VERB,4
|
|
BTST STACK,64 \?CCL85
|
|
SET 'GL-INPUT-STATE,0
|
|
GETB K-FIRST-ENTRY-TBL,0
|
|
EQUAL? STACK,1 \?CCL88
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
JUMP ?CND86
|
|
?CCL88: PUTB K-FIRST-ENTRY-TBL,1,1
|
|
ICALL2 RT-PRINT-MENU,GL-MENU-NUM
|
|
?CND86: SET 'L,1
|
|
JUMP ?CND53
|
|
?CCL85: SET 'GL-INPUT-STATE,2
|
|
GET TBL,L >M
|
|
GET M,0
|
|
GRTR? STACK,1 \?CND89
|
|
GET M,2 >GL-INPUT-PREP1
|
|
?CND89: GET GL-INPUT-VERB,3 >ACT
|
|
ZERO? GL-PREP-TBL /?CND91
|
|
ICALL2 RT-FREE-MEM,GL-PREP-TBL
|
|
?CND91: SET 'GL-PREP-TBL,GL-FREE-PTR
|
|
PUT GL-PREP-TBL,0,0
|
|
ICALL RT-GET-PREPS,ACT,GL-PREP-TBL
|
|
GET GL-PREP-TBL,0
|
|
ADD STACK,1
|
|
MUL STACK,2
|
|
ADD GL-FREE-PTR,STACK >GL-FREE-PTR
|
|
PUT K-MENU-TBL,0,GL-PREP-TBL
|
|
PUTB K-FIRST-ENTRY-TBL,0,1
|
|
PUTB K-MENU-TBL-TYPE,0,K-MENU-ONE-WORD
|
|
ICALL2 RT-PRINT-MENU,0
|
|
SET 'TBL,FALSE-VALUE
|
|
GET GL-NOUN-TBL,0
|
|
GRTR? STACK,0 \?CND53
|
|
SET 'S?,TRUE-VALUE
|
|
JUMP ?CND53
|
|
?CCL80: ZERO? GL-INPUT-STATE \?CCL96
|
|
EQUAL? GL-MENU-NUM,1 \?CND53
|
|
SET 'GL-INPUT-STATE,1
|
|
SET 'S?,TRUE-VALUE
|
|
JUMP ?CND53
|
|
?CCL96: EQUAL? GL-INPUT-STATE,2 \?CCL100
|
|
EQUAL? GL-MENU-NUM,1 /?CCL102
|
|
ZERO? GL-MENU-NUM \?CND53
|
|
ZERO? GL-INPUT-PREP1 \?CND53
|
|
?CCL102: EQUAL? GL-MENU-NUM,1 \?CCL109
|
|
INC 'GL-INPUT-STATE
|
|
JUMP ?CND107
|
|
?CCL109: GET TBL,L >GL-INPUT-PREP1
|
|
GETB K-MENU-TBL-TYPE,GL-MENU-NUM
|
|
EQUAL? STACK,K-MENU-MANY-WORD \?CND107
|
|
GET GL-INPUT-PREP1,1 >GL-INPUT-PREP1
|
|
?CND107: ZERO? GL-PREP-TBL /?CND112
|
|
ICALL2 RT-FREE-MEM,GL-PREP-TBL
|
|
?CND112: SET 'GL-PREP-TBL,GL-FREE-PTR
|
|
PUT GL-PREP-TBL,0,0
|
|
GET GL-INPUT-VERB,3
|
|
ICALL RT-GET-PREPS,STACK,GL-PREP-TBL,GL-INPUT-PREP1
|
|
GET GL-PREP-TBL,0
|
|
ADD STACK,1
|
|
MUL STACK,2
|
|
ADD GL-FREE-PTR,STACK >GL-FREE-PTR
|
|
PUT K-MENU-TBL,0,GL-PREP-TBL
|
|
PUTB K-FIRST-ENTRY-TBL,0,1
|
|
PUTB K-MENU-TBL-TYPE,0,K-MENU-ONE-WORD
|
|
ICALL2 RT-PRINT-MENU,0
|
|
SET 'S?,TRUE-VALUE
|
|
JUMP ?CND53
|
|
?CCL100: EQUAL? GL-INPUT-STATE,3 \?CND53
|
|
ZERO? GL-MENU-NUM \?CND53
|
|
INC 'GL-INPUT-STATE
|
|
SET 'S?,TRUE-VALUE
|
|
JUMP ?CND53
|
|
?CCL62: SOUND S-BEEP
|
|
JUMP ?CND53
|
|
?CCL59: EQUAL? C,K-F2 \?CCL118
|
|
GRTR? GL-ITEM-NUM,0 \?CCL121
|
|
DEC 'GL-ITEM-NUM
|
|
GET K-ITEM-TBL,GL-ITEM-NUM >N
|
|
SHIFT N,-8 >M
|
|
BAND N,255 >N
|
|
PUTB P-INBUF,1,N
|
|
CURGET K-WIN-TBL
|
|
GET K-WIN-TBL,0
|
|
CURSET STACK,1
|
|
ERASE 1
|
|
PRINTC 62
|
|
ADD P-INBUF,2
|
|
PRINTT STACK,N
|
|
EQUAL? GL-INPUT-STATE,M /?CND122
|
|
EQUAL? M,0,1 \?CCL126
|
|
PUTB K-FIRST-ENTRY-TBL,0,1
|
|
PUTB K-FIRST-ENTRY-TBL,1,1
|
|
PUTB K-MENU-TBL-TYPE,0,K-MENU-MANY-WORD
|
|
PUTB K-MENU-TBL-TYPE,1,K-MENU-OBJECT
|
|
PUT K-MENU-TBL,0,GL-VERB-TBL
|
|
PUT K-MENU-TBL,1,GL-NOUN-TBL
|
|
SET 'GL-MENU-NUM,0
|
|
JUMP ?CND124
|
|
?CCL126: EQUAL? M,2,3,4 \?CND124
|
|
ZERO? GL-PREP-TBL /?CND128
|
|
ICALL2 RT-FREE-MEM,GL-PREP-TBL
|
|
?CND128: SET 'GL-PREP-TBL,GL-FREE-PTR
|
|
PUT GL-PREP-TBL,0,0
|
|
GET GL-INPUT-VERB,3 >ACT
|
|
EQUAL? M,2 \?CCL132
|
|
ICALL RT-GET-PREPS,ACT,GL-PREP-TBL
|
|
JUMP ?CND130
|
|
?CCL132: ICALL RT-GET-PREPS,ACT,GL-PREP-TBL,GL-INPUT-PREP1
|
|
?CND130: GET GL-PREP-TBL,0
|
|
ADD STACK,1
|
|
MUL STACK,2
|
|
ADD GL-FREE-PTR,STACK >GL-FREE-PTR
|
|
PUTB K-FIRST-ENTRY-TBL,0,1
|
|
PUTB K-FIRST-ENTRY-TBL,1,1
|
|
PUTB K-MENU-TBL-TYPE,0,K-MENU-ONE-WORD
|
|
PUTB K-MENU-TBL-TYPE,1,K-MENU-OBJECT
|
|
PUT K-MENU-TBL,0,GL-PREP-TBL
|
|
PUT K-MENU-TBL,1,GL-NOUN-TBL
|
|
EQUAL? M,3 \?CCL135
|
|
SET 'GL-MENU-NUM,0
|
|
JUMP ?CND124
|
|
?CCL135: SET 'GL-MENU-NUM,1
|
|
?CND124: ICALL2 RT-PRINT-MENU,0
|
|
ICALL2 RT-PRINT-MENU,1
|
|
SET 'GL-INPUT-STATE,M
|
|
?CND122: GET K-MENU-TBL,GL-MENU-NUM >TBL
|
|
SET 'L,1
|
|
JUMP ?CND53
|
|
?CCL121: SOUND S-BEEP
|
|
JUMP ?CND53
|
|
?CCL118: EQUAL? C,K-F3 \?CCL137
|
|
ADD 3,GL-MENU-NUM
|
|
SCREEN STACK
|
|
GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M
|
|
WINGET -3,K-W-YSIZE
|
|
DIV STACK,GL-FONT-Y >N
|
|
GRTR? M,1 \?CCL140
|
|
SUB M,N
|
|
LESS? STACK,1 \?CCL143
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,1
|
|
GRTR? L,N \?CND141
|
|
SUB L,N >L
|
|
JUMP ?CND141
|
|
?CCL143: SUB M,N
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,STACK
|
|
SUB L,N >L
|
|
?CND141: LESS? L,1 \?CCL148
|
|
SET 'L,1
|
|
JUMP ?CND146
|
|
?CCL148: GET TBL,L
|
|
ZERO? STACK \?CND146
|
|
DEC 'L
|
|
?CND146: ICALL2 RT-PRINT-MENU,GL-MENU-NUM
|
|
JUMP ?CND53
|
|
?CCL140: GRTR? L,1 \?CCL151
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
SET 'L,1
|
|
JUMP ?CND53
|
|
?CCL151: SOUND S-BEEP
|
|
JUMP ?CND53
|
|
?CCL137: EQUAL? C,K-F4 \?CCL153
|
|
ADD 3,GL-MENU-NUM
|
|
SCREEN STACK
|
|
GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M
|
|
WINGET -3,K-W-YSIZE
|
|
DIV STACK,GL-FONT-Y >N
|
|
GET TBL,0
|
|
LESS? M,STACK \?CCL156
|
|
ADD M,N >?TMP1
|
|
GET TBL,0
|
|
GRTR? ?TMP1,STACK \?CCL159
|
|
GET TBL,0
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,STACK
|
|
GET TBL,0 >L
|
|
JUMP ?CND157
|
|
?CCL159: ADD M,N
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,STACK
|
|
ADD L,N >L
|
|
?CND157: GET TBL,0
|
|
GRTR? L,STACK \?CCL162
|
|
GET TBL,0 >L
|
|
JUMP ?CND160
|
|
?CCL162: GET TBL,L
|
|
ZERO? STACK \?CND160
|
|
INC 'L
|
|
?CND160: ICALL2 RT-PRINT-MENU,GL-MENU-NUM
|
|
JUMP ?CND53
|
|
?CCL156: SOUND S-BEEP
|
|
JUMP ?CND53
|
|
?CCL153: EQUAL? C,K-UP \?CCL165
|
|
GRTR? L,1 \?CCL168
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M
|
|
WINGET -3,K-W-YSIZE
|
|
DIV STACK,GL-FONT-Y >N
|
|
?PRG169: EQUAL? L,M \?CND171
|
|
SUB 0,GL-FONT-Y
|
|
SCROLL -3,STACK
|
|
DEC 'M
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,M
|
|
?CND171: DLESS? 'L,2 /?CND53
|
|
GET TBL,L
|
|
ZERO? STACK /?PRG169
|
|
JUMP ?CND53
|
|
?CCL168: SOUND S-BEEP
|
|
JUMP ?CND53
|
|
?CCL165: EQUAL? C,K-DOWN \?CCL178
|
|
GET TBL,0
|
|
LESS? L,STACK \?CCL181
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M
|
|
WINGET -3,K-W-YSIZE
|
|
DIV STACK,GL-FONT-Y >N
|
|
?PRG182: GET TBL,0
|
|
SUB STACK,1
|
|
IGRTR? 'L,STACK /?CND53
|
|
ADD M,N
|
|
EQUAL? L,STACK \?CND186
|
|
SCROLL -3,GL-FONT-Y
|
|
INC 'M
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,M
|
|
?CND186: GET TBL,L
|
|
ZERO? STACK /?PRG182
|
|
JUMP ?CND53
|
|
?CCL181: SOUND S-BEEP
|
|
JUMP ?CND53
|
|
?CCL178: EQUAL? C,K-LEFT,K-RIGHT \?CND53
|
|
ADD GL-MENU-NUM,1
|
|
MOD STACK,2 >M
|
|
GET K-MENU-TBL,M >N
|
|
GET N,0
|
|
GRTR? STACK,0 \?CCL193
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
SET 'TBL,N
|
|
GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM
|
|
SUB L,STACK >?TMP1
|
|
GETB K-FIRST-ENTRY-TBL,M
|
|
ADD ?TMP1,STACK >L
|
|
SET 'GL-MENU-NUM,M
|
|
GET TBL,0
|
|
GRTR? L,STACK \?CCL196
|
|
GET TBL,0 >L
|
|
JUMP ?CND53
|
|
?CCL196: GET TBL,L
|
|
ZERO? STACK \?CND53
|
|
INC 'L
|
|
JUMP ?CND53
|
|
?CCL193: SOUND S-BEEP
|
|
?CND53: ZERO? S? /?PRG1
|
|
ADD GL-MENU-NUM,1
|
|
MOD STACK,2 >M
|
|
GET K-MENU-TBL,M
|
|
GET STACK,0
|
|
GRTR? STACK,0 \?PRG1
|
|
ZERO? TBL /?CND202
|
|
ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE
|
|
?CND202: SET 'GL-MENU-NUM,M
|
|
GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM
|
|
EQUAL? STACK,1 /?CND204
|
|
PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,1
|
|
ICALL2 RT-PRINT-MENU,GL-MENU-NUM
|
|
?CND204: GET K-MENU-TBL,GL-MENU-NUM >TBL
|
|
SET 'L,1
|
|
JUMP ?PRG1
|
|
?REP2: ICALL1 RT-SCRIPT-INBUF
|
|
SCREEN 0
|
|
WINATTR 0,A-BUFFER,O-SET
|
|
RETURN C
|
|
|
|
|
|
.FUNCT SPECIAL-CONTRACTION?:ANY:1:1,PTR
|
|
RFALSE
|
|
|
|
|
|
.FUNCT EXPAND-BE-CONTRACTIONS:ANY:0:0,LEN,PTR,OPTR,N,WD,SPWD,L,?TMP1
|
|
GETB P-LEXV,P-LEXWORDS >LEN
|
|
SET 'PTR,P-LEXV+2
|
|
SET 'OPTR,PTR
|
|
SET 'L,LEN
|
|
?PRG1: SET 'SPWD,FALSE-VALUE
|
|
DLESS? 'L,0 \?CCL5
|
|
PUTB P-LEXV,P-LEXWORDS,LEN
|
|
RTRUE
|
|
?CCL5: GET PTR,0 >WD
|
|
ZERO? WD /?CCL7
|
|
GET PTR,P-LEXELEN
|
|
EQUAL? STACK,W?APOSTROPHE \?CCL7
|
|
GET P-QA-WORDS1,0
|
|
INTBL? WD,P-QA-WORDS1+2,STACK >N \?PRD12
|
|
SUB N,P-QA-WORDS1
|
|
DIV STACK,2 >N
|
|
GET P-QA-WORDS2,N >?TMP1
|
|
GET PTR,4
|
|
EQUAL? ?TMP1,STACK /?CTR6
|
|
?PRD12: CALL2 SPECIAL-CONTRACTION?,PTR >SPWD
|
|
ZERO? SPWD /?CCL7
|
|
?CTR6: ZERO? SPWD /?CCL17
|
|
PUSH 8
|
|
JUMP ?CND15
|
|
?CCL17: PUSH 4
|
|
?CND15: ADD PTR,STACK >?TMP1
|
|
MUL L,4
|
|
COPYT ?TMP1,PTR,STACK
|
|
ZERO? SPWD /?CCL20
|
|
PUT PTR,0,SPWD
|
|
DEC 'L
|
|
DEC 'LEN
|
|
JUMP ?CND18
|
|
?CCL20: GET P-QB-WORDS-1,N >WD
|
|
PUT PTR,0,WD
|
|
GET P-QB-WORDS-2,N >WD
|
|
PUT PTR,P-LEXELEN,WD
|
|
?CND18: DEC 'L
|
|
DEC 'LEN
|
|
JUMP ?PRG1
|
|
?CCL7: EQUAL? WD,W?APOSTROPHE \?CCL22
|
|
GET PTR,P-LEXELEN
|
|
EQUAL? STACK,W?S /?CCL22
|
|
EQUAL? OPTR,PTR /?CCL22
|
|
SUB PTR,4 >WD
|
|
ZERO? WD /?CCL22
|
|
GETB WD,2
|
|
ADD -1,STACK >?TMP1
|
|
GETB WD,3
|
|
ADD ?TMP1,STACK
|
|
GETB P-INBUF,STACK
|
|
EQUAL? STACK,115,122 \?CCL22
|
|
SUB PTR,P-LEXV
|
|
DIV STACK,2
|
|
ADD P-LEXELEN,STACK
|
|
ICALL MAKE-ROOM-FOR-TOKENS,1,P-LEXV,STACK
|
|
PUT PTR,P-LEXELEN,W?S
|
|
INC 'L
|
|
INC 'LEN
|
|
JUMP ?PRG1
|
|
?CCL22: ADD PTR,4 >PTR
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT TELL-THE:ANY:1:1,OBJ,TMP
|
|
EQUAL? OBJ,PLAYER \?CCL3
|
|
PRINTI "you"
|
|
RTRUE
|
|
?CCL3: CALL2 GET-OWNER,OBJ >TMP
|
|
ZERO? TMP /?CCL6
|
|
EQUAL? TMP,PLAYER \?CCL9
|
|
PRINTI "your "
|
|
JUMP ?CND4
|
|
?CCL9: EQUAL? TMP,OBJ /?CND4
|
|
ICALL2 TELL-THE,TMP
|
|
PRINTI "'s "
|
|
JUMP ?CND4
|
|
?CCL6: FSET? OBJ,NARTICLEBIT /?CND4
|
|
PRINTI "the "
|
|
?CND4: CALL2 RT-PRINT-DESC,OBJ
|
|
RSTACK
|
|
|
|
|
|
.FUNCT TELL-CTHE:ANY:1:1,OBJ,TMP
|
|
EQUAL? OBJ,PLAYER \?CCL3
|
|
PRINTI "You"
|
|
RTRUE
|
|
?CCL3: CALL2 GET-OWNER,OBJ >TMP
|
|
ZERO? TMP /?CCL6
|
|
EQUAL? TMP,PLAYER \?CCL9
|
|
PRINTI "Your "
|
|
JUMP ?CND4
|
|
?CCL9: EQUAL? TMP,OBJ /?CND4
|
|
ICALL2 TELL-CTHE,TMP
|
|
PRINTI "'s "
|
|
JUMP ?CND4
|
|
?CCL6: FSET? OBJ,NARTICLEBIT /?CND4
|
|
PRINTI "The "
|
|
?CND4: CALL2 RT-PRINT-DESC,OBJ
|
|
RSTACK
|
|
|
|
|
|
.FUNCT NAKED-DIR?:ANY:0:0,WCNUM,LEN
|
|
GET TLEXV,0 >LEN
|
|
ZERO? LEN /FALSE
|
|
GET LEN,4 >WCNUM
|
|
ZERO? WCNUM \?CND3
|
|
GET LEN,3 >LEN
|
|
GET LEN,4 >WCNUM
|
|
?CND3: BTST WCNUM,32768 /FALSE
|
|
BAND WCNUM,64
|
|
BAND STACK,32767
|
|
ZERO? STACK /FALSE
|
|
EQUAL? P-LEN,1 \?CCL11
|
|
RETURN LEN
|
|
?CCL11: SUB TLEXV,P-LEXV
|
|
LESS? STACK,234 /?CND9
|
|
RETURN LEN
|
|
?CND9: GET TLEXV,P-LEXELEN >WCNUM
|
|
EQUAL? WCNUM,W?COMMA,W?AND \?CND13
|
|
RETURN LEN
|
|
?CND13: GET WCNUM,4 >WCNUM
|
|
BAND WCNUM,32768
|
|
EQUAL? STACK,-32768 \FALSE
|
|
BAND WCNUM,32769
|
|
BAND STACK,32767
|
|
ZERO? STACK /FALSE
|
|
RETURN LEN
|
|
|
|
|
|
.FUNCT PARSER:ANY:0:0,OWINNER,LEN,N,PV,?TMP1
|
|
ZERO? P-DBUG /?CND2
|
|
PRINTI "[Reset of PMEM: "
|
|
PRINTN PMEM-WORDS-USED
|
|
PRINTI " words used.]
|
|
"
|
|
?CND2: ICALL1 PMEM-RESET
|
|
SET 'ERROR-PRIORITY,255
|
|
SET 'ERROR-STRING,FALSE-VALUE
|
|
SET 'OWINNER,WINNER
|
|
GRTR? P-CONT,0 \?CCL6
|
|
SET 'TLEXV,P-CONT
|
|
ZERO? VERBOSITY /?CND7
|
|
EQUAL? PLAYER,WINNER \?CND7
|
|
CRLF
|
|
?CND7: SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND4
|
|
?CCL6: SET 'WINNER,PLAYER
|
|
ZERO? P-OFLAG \?CND11
|
|
GET OOPS-TABLE,O-PTR
|
|
ZERO? STACK \?CND11
|
|
PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
?CND11: LOC WINNER
|
|
IN? STACK,ROOMS \?CND15
|
|
LOC WINNER >HERE
|
|
?CND15: ZERO? LIT /?CCL18
|
|
EQUAL? HERE,LIT /?CND17
|
|
IN? LIT,HERE /?CND17
|
|
CALL2 VISIBLE?,LIT
|
|
ZERO? STACK \?CND17
|
|
?CCL18: CALL1 LIT? >LIT
|
|
?CND17: GET 0,8
|
|
BTST STACK,F-REFRESH \?CND24
|
|
ICALL1 V-$REFRESH
|
|
?CND24: ZERO? VERBOSITY /?CND26
|
|
CRLF
|
|
?CND26: ICALL1 UPDATE-STATUS-LINE
|
|
ICALL1 READ-INPUT
|
|
GETB P-LEXV,P-LEXWORDS >LEN
|
|
ZERO? LEN /?CND29
|
|
INTBL? W?QUOTE,P-LEXV+2,LEN,132 >N \?CND29
|
|
ICALL FIX-QUOTATIONS,LEN,N
|
|
?CND29: ICALL1 EXPAND-BE-CONTRACTIONS
|
|
GETB P-LEXV,P-LEXWORDS >P-LEN
|
|
SET 'TLEXV,P-LEXV+2
|
|
?CND4: GET TLEXV,0
|
|
EQUAL? STACK,W?PERIOD,W?THEN \?CND33
|
|
ADD TLEXV,4 >TLEXV
|
|
DEC 'P-LEN
|
|
?CND33: GET TLEXV,0
|
|
EQUAL? STACK,W?YOU \?CND35
|
|
ICALL1 IGNORE-FIRST-WORD
|
|
?CND35: GET TLEXV,0
|
|
EQUAL? STACK,W?GO,W?TO \?CND37
|
|
ICALL1 IGNORE-FIRST-WORD
|
|
?CND37: ZERO? P-LEN \?CND39
|
|
ICALL1 BEG-PARDON
|
|
RFALSE
|
|
?CND39: CALL1 NAKED-DIR? >LEN
|
|
ZERO? LEN /?CCL43
|
|
PUT STATE-STACK,0,20
|
|
PUT DATA-STACK,0,20
|
|
XPUSH LEN,DATA-STACK /?BOGUS44
|
|
?BOGUS44: ICALL2 RED-SD,1
|
|
SET 'P-CONT,FALSE-VALUE
|
|
SET 'P-OFLAG,0
|
|
SET 'P-WORDS-AGAIN,1
|
|
PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
PUT OOPS-TABLE,O-START,TLEXV
|
|
PUTB P-LEXV,P-LEXWORDS,P-LEN
|
|
COPYT P-LEXV,G-LEXV,LEXV-LENGTH-BYTES
|
|
COPYT P-INBUF,G-INBUF,61
|
|
PUT PARSE-RESULT,13,0
|
|
DEC 'P-LEN
|
|
LESS? 0,P-LEN \TRUE
|
|
ADD TLEXV,4 >TLEXV
|
|
GET TLEXV,0 >LEN
|
|
ZERO? LEN /TRUE
|
|
GET LEN,4 >LEN
|
|
ZERO? LEN /TRUE
|
|
BAND LEN,32768
|
|
EQUAL? STACK,-32768 \TRUE
|
|
BAND LEN,32769
|
|
BAND STACK,32767
|
|
ZERO? STACK /TRUE
|
|
SET 'P-WORDS-AGAIN,P-WORD-NUMBER
|
|
DLESS? 'P-LEN,1 /TRUE
|
|
ADD TLEXV,4 >P-CONT
|
|
RTRUE
|
|
?CCL43: GET TLEXV,0
|
|
EQUAL? STACK,W?OOPS,W?O \?CCL55
|
|
CALL2 DO-OOPS,OWINNER
|
|
ZERO? STACK \?CND41
|
|
RFALSE
|
|
?CCL55: ZERO? P-OFLAG \?CND41
|
|
LESS? P-CONT,1 \?CND41
|
|
PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
?CND41: SET 'P-CONT,FALSE-VALUE
|
|
GET TLEXV,0
|
|
EQUAL? STACK,W?AGAIN,W?G \?CCL63
|
|
CALL2 DO-AGAIN,OWINNER
|
|
ZERO? STACK \?CND61
|
|
RFALSE
|
|
?CCL63: PUTB P-LEXV,P-LEXWORDS,P-LEN
|
|
COPYT P-LEXV,G-LEXV,LEXV-LENGTH-BYTES
|
|
COPYT P-INBUF,G-INBUF,61
|
|
PUT OOPS-TABLE,O-START,TLEXV
|
|
PUT OOPS-TABLE,O-LENGTH,P-LEN
|
|
GET OOPS-TABLE,O-END
|
|
ZERO? STACK \?CND61
|
|
GETB P-LEXV,P-LEXWORDS
|
|
MUL 4,STACK >LEN
|
|
DEC 'LEN
|
|
GETB TLEXV,LEN >?TMP1
|
|
DEC 'LEN
|
|
GETB TLEXV,LEN
|
|
ADD ?TMP1,STACK
|
|
PUT OOPS-TABLE,O-END,STACK
|
|
?CND61: SET 'P-WON,FALSE-VALUE
|
|
SET 'P-WALK-DIR,FALSE-VALUE
|
|
CALL2 PARSE-IT,FALSE-VALUE >PV
|
|
?PRG68: ZERO? PV \?CCL72
|
|
CALL1 PRINT-PARSER-FAILURE >PV
|
|
JUMP ?PRG68
|
|
?CCL72: EQUAL? PV,1 /FALSE
|
|
PUT OOPS-TABLE,O-PTR,FALSE-VALUE
|
|
CALL1 GAME-VERB?
|
|
ZERO? STACK \?CND75
|
|
SET 'P-OFLAG,0
|
|
?CND75: GET PV,0 >LEN
|
|
EQUAL? LEN,W?TWICE,W?THRICE \?CND77
|
|
GET OOPS-TABLE,O-START
|
|
INTBL? LEN,STACK,P-WORDS-AGAIN,132 >N \?CND77
|
|
ICALL CHANGE-LEXV,N,W?ONCE
|
|
EQUAL? LEN,W?THRICE \?CCL83
|
|
PUSH 2
|
|
JUMP ?CND81
|
|
?CCL83: PUSH 1
|
|
?CND81: ICALL2 DO-IT-AGAIN,STACK
|
|
CALL2 PARSE-IT,FALSE-VALUE >PV
|
|
JUMP ?PRG68
|
|
?CND77: GET GWIM-MSG,1
|
|
ZERO? STACK /?CND84
|
|
ICALL1 TELL-GWIM-MSG
|
|
PUT GWIM-MSG,1,0
|
|
?CND84: GET GWIM-MSG,2
|
|
ZERO? STACK /TRUE
|
|
PRINTI "["""
|
|
GET GWIM-MSG,2
|
|
ICALL2 NP-PRINT,STACK
|
|
PRINTI """ meaning "
|
|
GET GWIM-MSG,3
|
|
ICALL2 TELL-THE,STACK
|
|
PRINTI "]
|
|
"
|
|
PUT GWIM-MSG,2,0
|
|
RTRUE
|
|
|
|
|
|
.FUNCT GAME-VERB?:ANY:0:0
|
|
EQUAL? PRSA,V?COMMAND,V?RECORD,V?UNRECORD /TRUE
|
|
EQUAL? PRSA,V?QUIT,V?RESTART,V?RESTORE /TRUE
|
|
EQUAL? PRSA,V?SAVE,V?SCRIPT,V?VERIFY /TRUE
|
|
EQUAL? PRSA,V?DESC-LEVEL,V?$REFRESH,V?VERSION /TRUE
|
|
EQUAL? PRSA,V?DIAGNOSE /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT RED-SD:ANY:0:2,N,TYP,V,SYN,NEW-OBJECT
|
|
SET 'V,W?WALK
|
|
PUT PARSE-RESULT,1,V
|
|
GET V,3
|
|
GET STACK,2
|
|
ADD STACK,2 >SYN
|
|
PUT PARSE-RESULT,3,SYN
|
|
GET SYN,0
|
|
PUT PARSE-RESULT,4,STACK
|
|
PUT PARSE-RESULT,7,FALSE-VALUE
|
|
POP DATA-STACK
|
|
GETB STACK,6 >P-WALK-DIR
|
|
CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >NEW-OBJECT
|
|
PUT NEW-OBJECT,1,1
|
|
PUT NEW-OBJECT,3,P-WALK-DIR
|
|
PUT PARSE-RESULT,5,NEW-OBJECT
|
|
RTRUE
|
|
|
|
|
|
.FUNCT P-P:ANY:1:1,X
|
|
CALL2 PMEM?,X
|
|
ZERO? STACK /?CCL3
|
|
GETB X,1
|
|
EQUAL? STACK,1 \?CCL6
|
|
PRINTI "#ADJS["
|
|
ICALL2 ADJS-PRINT,X
|
|
PRINTC 93
|
|
RTRUE
|
|
?CCL6: GETB X,1
|
|
EQUAL? STACK,2 \?CCL8
|
|
PRINTI "#NP["
|
|
ICALL2 NP-PRINT,X
|
|
PRINTC 93
|
|
RTRUE
|
|
?CCL8: GETB X,1
|
|
EQUAL? STACK,3 \?CCL10
|
|
PRINTI "#NPP["
|
|
?PRG11: GET X,2
|
|
ZERO? STACK /?CND13
|
|
GET X,2
|
|
ICALL2 P-P,STACK
|
|
PRINTC 32
|
|
?CND13: GET X,3
|
|
ZERO? STACK /?CND15
|
|
GET X,3
|
|
ICALL2 P-P,STACK
|
|
PRINTC 32
|
|
?CND15: GET X,1 >X
|
|
ZERO? X \?PRG11
|
|
PRINTC 93
|
|
RTRUE
|
|
?CCL10: GETB X,1
|
|
EQUAL? STACK,4 \?CCL20
|
|
PRINTI "#NOUN-PHRASE["
|
|
ICALL2 NP-PRINT,X
|
|
PRINTC 93
|
|
RTRUE
|
|
?CCL20: GETB X,1
|
|
EQUAL? STACK,5 /?CTR21
|
|
GETB X,1
|
|
EQUAL? STACK,6 \?CCL22
|
|
?CTR21: PRINTI "#PP["
|
|
PRINTI "W?"
|
|
GET X,1
|
|
PRINTB STACK
|
|
PRINTC 32
|
|
GET X,2
|
|
ICALL2 P-P,STACK
|
|
PRINTC 93
|
|
RTRUE
|
|
?CCL22: PRINTI "#PMEM[]"
|
|
RTRUE
|
|
?CCL3: EQUAL? X,PARSE-RESULT \?CCL26
|
|
PRINTI "RESULT"
|
|
RTRUE
|
|
?CCL26: LESS? VOCAB,PRSTBL \?PRD30
|
|
LESS? VOCAB,X \?PRD30
|
|
LESS? X,PRSTBL /?CTR27
|
|
?PRD30: LESS? 0,VOCAB \?CCL28
|
|
LESS? PRSTBL,0 \?CCL28
|
|
LESS? VOCAB,X /?CTR27
|
|
LESS? X,PRSTBL \?CCL28
|
|
?CTR27: PRINTI "W?"
|
|
PRINTB X
|
|
RTRUE
|
|
?CCL28: PRINTN X
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PARSE-IT:ANY:0:1,V,RES,NUM,W,SAV-LEXV,TMP,TV,T2,?TMP1
|
|
SET 'SPLITS,0
|
|
PUT SPLIT-STACK,0,0
|
|
SET 'ERROR-PRIORITY,255
|
|
PUT ERROR-ARGS,1,0
|
|
SET 'P-OLEN,P-LEN
|
|
SET 'OTLEXV,TLEXV
|
|
SET 'W,WINNER
|
|
SET 'SAV-LEXV,TLEXV
|
|
?PRG1: INC 'NUM
|
|
ICALL2 BE-PATIENT,NUM
|
|
PUT STATE-STACK,0,20
|
|
XPUSH 1,STATE-STACK /?BOGUS3
|
|
?BOGUS3: PUT DATA-STACK,0,20
|
|
ZERO? P-DBUG /?CND4
|
|
PRINTI "[Reset of PMEM: "
|
|
PRINTN PMEM-WORDS-USED
|
|
PRINTI " words used.]
|
|
"
|
|
?CND4: ICALL1 PMEM-RESET
|
|
SET 'P-WORD-NUMBER,0
|
|
SET 'TLEXV,SAV-LEXV
|
|
SET 'P-LEN,P-OLEN
|
|
SET 'WINNER,W
|
|
PUT GWIM-MSG,0,0
|
|
PUT GWIM-MSG,1,0
|
|
PUT GWIM-MSG,2,0
|
|
PUT GWIM-MSG,3,0
|
|
COPYT PARSE-RESULT,0,PARSE-RESULT-LEN
|
|
CALL2 PARSE-SENTENCE,PARSE-RESULT >RES
|
|
EQUAL? RES,PARSER-RESULT-AGAIN \?CCL8
|
|
PUT SPLIT-STACK,0,0
|
|
SET 'ERROR-PRIORITY,255
|
|
SET 'P-OLEN,P-LEN
|
|
SET 'SAV-LEXV,TLEXV
|
|
JUMP ?PRG1
|
|
?CCL8: LESS? RES,PARSER-RESULT-WON \?REP2
|
|
GET SPLIT-STACK,0
|
|
ZERO? STACK /?REP2
|
|
ZERO? RES /?REP2
|
|
?PRG14: GET SPLIT-STACK,0 >T2
|
|
SUB T2,1
|
|
GET SPLIT-STACK,STACK
|
|
ZERO? STACK \?CCL18
|
|
GET SPLIT-STACK,T2 >TMP
|
|
ZERO? TMP /?CTR20
|
|
GET TMP,0
|
|
ZERO? STACK \?PRD24
|
|
GET TMP,1
|
|
ZERO? STACK /?CTR20
|
|
?PRD24: ADD TMP,6 >TV
|
|
GET TV,0
|
|
ZERO? STACK \?CCL21
|
|
GET TV,1
|
|
ZERO? STACK \?CCL21
|
|
?CTR20: SUB T2,2
|
|
PUT SPLIT-STACK,0,STACK
|
|
JUMP ?CND16
|
|
?CCL21: PUT SPLIT-STACK,T2,TV
|
|
JUMP ?REP15
|
|
?CCL18: GET SPLIT-STACK,T2 >?TMP1
|
|
SUB T2,1
|
|
GET SPLIT-STACK,STACK
|
|
EQUAL? ?TMP1,STACK \?CCL30
|
|
SUB T2,2
|
|
PUT SPLIT-STACK,0,STACK
|
|
?CND16: GET SPLIT-STACK,0
|
|
ZERO? STACK \?PRG14
|
|
?REP15: GET SPLIT-STACK,0
|
|
ZERO? STACK /?REP2
|
|
ZERO? P-DBUG /?PRG1
|
|
PRINTI "[Splits left, trying again...]
|
|
"
|
|
JUMP ?PRG1
|
|
?CCL30: GET SPLIT-STACK,T2
|
|
ADD 1,STACK
|
|
PUT SPLIT-STACK,T2,STACK
|
|
JUMP ?REP15
|
|
?REP2: SUB 0,NUM
|
|
ICALL2 BE-PATIENT,STACK
|
|
EQUAL? RES,PARSER-RESULT-WON \?CCL39
|
|
RETURN PARSER-RESULT
|
|
?CCL39: ZERO? RES /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT PARSE-SENTENCE:ANY:1:1,PR,SPLIT-NUM,RES-WCN,CURRENT-TOKEN,CAV,OFFS,T2,CURRENT-ACTION,REDUCTION,N,?TMP1
|
|
SET 'SPLIT-NUM,-1
|
|
GET TLEXV,0 >CURRENT-TOKEN
|
|
CATCH >PARSE-SENTENCE-ACTIVATION
|
|
ZERO? CURRENT-TOKEN \?CND1
|
|
CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
|
|
ZERO? CURRENT-TOKEN \?CND1
|
|
RETURN PARSER-RESULT-DEAD
|
|
?CND1: ZERO? P-DBUG /?PRG7
|
|
PRINTI "[Next token: "
|
|
PRINTB CURRENT-TOKEN
|
|
PRINTI "]
|
|
"
|
|
?PRG7: EQUAL? CURRENT-TOKEN,W?S \?CCL11
|
|
SUB TLEXV,4
|
|
GET STACK,0
|
|
EQUAL? STACK,W?APOSTROPHE \?CCL11
|
|
SET 'RES-WCN,32
|
|
JUMP ?CND9
|
|
?CCL11: GET CURRENT-TOKEN,4 >RES-WCN
|
|
?CND9: ZERO? RES-WCN \?CCL16
|
|
GET CURRENT-TOKEN,3
|
|
ZERO? STACK \?CCL19
|
|
CALL BUZZER-WORD?,CURRENT-TOKEN,TLEXV
|
|
ZERO? STACK /?CND20
|
|
MUL P-LEXELEN,P-WORD-NUMBER
|
|
ADD STACK,P-LEXSTART
|
|
PUT OOPS-TABLE,O-PTR,STACK
|
|
RETURN PARSER-RESULT-DEAD
|
|
?CND20: SET 'CAV,FALSE-VALUE
|
|
?CND14: ZERO? CAV /?PST46
|
|
GET CAV,2 >CURRENT-ACTION
|
|
JUMP ?PRG48
|
|
?CCL19: GET CURRENT-TOKEN,3 >CURRENT-TOKEN
|
|
JUMP ?PRG7
|
|
?CCL16: BTST RES-WCN,32768 /?CCL24
|
|
SET 'OFFS,1
|
|
JUMP ?CND22
|
|
?CCL24: SET 'OFFS,0
|
|
?CND22: CALL2 PEEK-PSTACK,STATE-STACK
|
|
GET ACTION-TABLE,STACK
|
|
GET STACK,0
|
|
CALL GET-TERMINAL-ACTION,RES-WCN,STACK,OFFS >CAV
|
|
ZERO? CAV /?CND25
|
|
BAND RES-WCN,32767 >?TMP1
|
|
GET CAV,OFFS
|
|
BCOM STACK
|
|
BAND ?TMP1,STACK
|
|
ZERO? STACK /?CND25
|
|
ADD CAV,6
|
|
CALL GET-TERMINAL-ACTION,RES-WCN,STACK,OFFS
|
|
ZERO? STACK /?CND25
|
|
ADD SPLIT-NUM,2 >SPLIT-NUM
|
|
ADD SPLIT-NUM,1
|
|
GET SPLIT-STACK,0 >T2
|
|
GRTR? STACK,T2 \?CCL32
|
|
INC 'SPLITS
|
|
INC 'T2
|
|
LESS? T2,21 /?CND33
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND33: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,0
|
|
INC 'T2
|
|
LESS? T2,21 /?CND35
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND35: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,CAV
|
|
ZERO? P-DBUG /?CND25
|
|
PRINTI "[New split on a"
|
|
PRINTI " word"
|
|
PRINTI " (split #"
|
|
PRINTN SPLITS
|
|
PRINTI ") at depth "
|
|
DIV T2,2
|
|
PRINTN STACK
|
|
PRINTI "; word class: "
|
|
PRINTN RES-WCN
|
|
PRINTI "; left: "
|
|
ADD CAV,6
|
|
GET STACK,0
|
|
PRINTN STACK
|
|
PRINTI ".]
|
|
"
|
|
JUMP ?CND25
|
|
?CCL32: GET SPLIT-STACK+2,SPLIT-NUM >CAV
|
|
ZERO? CAV /?CND39
|
|
CALL GET-TERMINAL-ACTION,RES-WCN,CAV,OFFS >CAV
|
|
?CND39: PUT SPLIT-STACK+2,SPLIT-NUM,CAV
|
|
?CND25: ZERO? CAV \?CND14
|
|
ZERO? P-DBUG /?CND43
|
|
PRINTI "[A parse loses.]
|
|
"
|
|
?CND43: RETURN PARSER-RESULT-FAILED
|
|
?PST46: SET 'CURRENT-ACTION,0
|
|
?PRG48: ZERO? CAV /?CCL52
|
|
BAND CURRENT-ACTION,65280
|
|
ZERO? STACK /?CCL52
|
|
ADD SPLIT-NUM,2 >SPLIT-NUM
|
|
ADD SPLIT-NUM,1
|
|
GET SPLIT-STACK,0 >T2
|
|
GRTR? STACK,T2 \?CCL57
|
|
INC 'SPLITS
|
|
INC 'T2
|
|
LESS? T2,21 /?CND58
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND58: PUT SPLIT-STACK,0,T2
|
|
GETB CURRENT-ACTION,0
|
|
PUT SPLIT-STACK,T2,STACK
|
|
INC 'T2
|
|
LESS? T2,21 /?CND60
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND60: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,1
|
|
ZERO? P-DBUG /?CND62
|
|
PRINTI "[New split on a"
|
|
PRINTI "n action"
|
|
PRINTI " (split #"
|
|
PRINTN SPLITS
|
|
PRINTI ") at depth "
|
|
DIV T2,2
|
|
PRINTN STACK
|
|
PRINTI ", "
|
|
GETB CURRENT-ACTION,0
|
|
PRINTN STACK
|
|
PRINTI " cases.]
|
|
"
|
|
?CND62: GETB CURRENT-ACTION,1 >CURRENT-ACTION
|
|
JUMP ?CND55
|
|
?CCL57: GET SPLIT-STACK+2,SPLIT-NUM
|
|
GETB CURRENT-ACTION,STACK >CURRENT-ACTION
|
|
?CND55: ZERO? P-DBUG /?CND50
|
|
PRINTI "[Using action "
|
|
PRINTN CURRENT-ACTION
|
|
PRINTI ".]
|
|
"
|
|
JUMP ?CND50
|
|
?CCL52: ZERO? CAV /?CND50
|
|
ZERO? CURRENT-ACTION \?CND50
|
|
ZERO? P-DBUG /?CND69
|
|
PRINTI "[A parse loses.]
|
|
"
|
|
?CND69: RETURN PARSER-RESULT-FAILED
|
|
?CND50: ZERO? CAV /?CTR72
|
|
LESS? CURRENT-ACTION,128 \?CCL73
|
|
?CTR72: ZERO? CAV /?CND76
|
|
ZERO? P-DBUG /?CND78
|
|
PRINTI "[Pushing: "
|
|
PRINTB CURRENT-TOKEN
|
|
PRINTI "]
|
|
"
|
|
?CND78: XPUSH CURRENT-TOKEN,DATA-STACK \?CCL82
|
|
XPUSH CURRENT-ACTION,STATE-STACK /?CND76
|
|
?CCL82: ICALL1 P-NO-MEM-ROUTINE
|
|
?CND76: DLESS? 'P-LEN,1 \?CCL87
|
|
SET 'CURRENT-TOKEN,W?END.OF.INPUT
|
|
ADD 1,P-WORD-NUMBER >P-WORDS-AGAIN
|
|
SET 'P-CONT,FALSE-VALUE
|
|
SET 'P-LEN,0
|
|
JUMP ?CND85
|
|
?CCL87: INC 'P-WORD-NUMBER
|
|
ADD TLEXV,4 >TLEXV
|
|
GET TLEXV,0 >CURRENT-TOKEN
|
|
GRTR? TLEXV,OTLEXV \?CND85
|
|
SET 'OTLEXV,TLEXV
|
|
?CND85: ZERO? CURRENT-TOKEN \?CCL92
|
|
CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
|
|
ZERO? CURRENT-TOKEN \?CND90
|
|
RETURN PARSER-RESULT-DEAD
|
|
?CCL92: EQUAL? CURRENT-TOKEN,W?THEN,W?!,W?PERIOD /?CCL95
|
|
EQUAL? CURRENT-TOKEN,W?? \?CND90
|
|
?CCL95: SET 'P-WORDS-AGAIN,P-WORD-NUMBER
|
|
DLESS? 'P-LEN,1 /?CCL100
|
|
ADD TLEXV,4 >P-CONT
|
|
JUMP ?CND90
|
|
?CCL100: SET 'P-CONT,FALSE-VALUE
|
|
?CND90: ZERO? P-DBUG /?PRG7
|
|
PRINTI "[Next token: "
|
|
PRINTB CURRENT-TOKEN
|
|
PRINTI "]
|
|
"
|
|
JUMP ?PRG7
|
|
?CCL73: GRTR? CURRENT-ACTION,128 \?CCL104
|
|
SUB CURRENT-ACTION,129
|
|
GET REDUCTION-TABLE,STACK >REDUCTION
|
|
ZERO? P-DBUG /?CND107
|
|
PRINTI "[Reducing "
|
|
GET REDUCTION,5
|
|
PRINT STACK
|
|
CRLF
|
|
PRINTI "Args:"
|
|
GET REDUCTION,0 >N
|
|
?PRG109: DLESS? 'N,0 \?CND111
|
|
PRINTI " ..."
|
|
?CND107: GET REDUCTION,0 >RES-WCN
|
|
ZERO? RES-WCN /?CND113
|
|
FSTACK RES-WCN,STATE-STACK
|
|
?CND113: SET 'CURRENT-REDUCTION,REDUCTION
|
|
SET 'P-RUNNING,TLEXV
|
|
GET REDUCTION,1 >?TMP1
|
|
GET REDUCTION,0
|
|
CALL ?TMP1,STACK >RES-WCN
|
|
SET 'TLEXV,P-RUNNING
|
|
GRTR? TLEXV,OTLEXV \?CND115
|
|
SET 'OTLEXV,TLEXV
|
|
?CND115: LESS? P-LEN,1 \?CCL119
|
|
SET 'CURRENT-TOKEN,W?END.OF.INPUT
|
|
JUMP ?CND117
|
|
?CND111: PRINTC 32
|
|
CALL PEEK-PSTACK,DATA-STACK,N
|
|
ICALL2 P-P,STACK
|
|
JUMP ?PRG109
|
|
?CCL119: GET TLEXV,0 >CURRENT-TOKEN
|
|
?CND117: SET 'CURRENT-REDUCTION,FALSE-VALUE
|
|
ZERO? RES-WCN \?CTR121
|
|
RETURN PARSER-RESULT-FAILED
|
|
?CTR121: XPUSH RES-WCN,DATA-STACK /?CND120
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND120: CALL2 PEEK-PSTACK,STATE-STACK
|
|
GET ACTION-TABLE,STACK >?TMP1
|
|
GET REDUCTION,4
|
|
CALL GET-NONTERMINAL-ACTION,?TMP1,STACK
|
|
XPUSH STACK,STATE-STACK /?CND125
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND125: ZERO? P-DBUG /?PRG7
|
|
PRINTI " result: "
|
|
ICALL2 P-P,RES-WCN
|
|
PRINTI ", new state "
|
|
CALL2 PEEK-PSTACK,STATE-STACK
|
|
PRINTN STACK
|
|
PRINTI "]
|
|
"
|
|
JUMP ?PRG7
|
|
?CCL104: POP DATA-STACK >PARSER-RESULT
|
|
RETURN PARSER-RESULT-WON
|
|
|
|
|
|
.FUNCT GET-TERMINAL-ACTION:ANY:3:3,TYPE,STATE,OFFS,V
|
|
ZERO? STATE /FALSE
|
|
BAND TYPE,32767 >TYPE
|
|
SET 'V,STATE
|
|
?PRG4: GET V,0
|
|
ZERO? STACK \?CND6
|
|
GET V,1
|
|
ZERO? STACK /FALSE
|
|
?CND6: GET V,OFFS
|
|
BAND TYPE,STACK
|
|
ZERO? STACK /?CND10
|
|
RETURN V
|
|
?CND10: ADD V,6 >V
|
|
JUMP ?PRG4
|
|
|
|
|
|
.FUNCT GET-NONTERMINAL-ACTION:ANY:2:2,STATE,TYPE,V
|
|
GET STATE,1
|
|
ZERO? STACK /FALSE
|
|
GET STATE,1 >V
|
|
?PRG4: GETB V,0
|
|
ZERO? STACK /FALSE
|
|
GETB V,0
|
|
EQUAL? STACK,TYPE \?CND6
|
|
GETB V,1
|
|
RSTACK
|
|
?CND6: ADD V,2 >V
|
|
JUMP ?PRG4
|
|
|
|
|
|
.FUNCT BE-PATIENT:ANY:1:1,NUM,LIM
|
|
SET 'LIM,16
|
|
GETB 0,30
|
|
EQUAL? STACK,APPLE-2E,APPLE-2C,APPLE-2GS \?CND1
|
|
SET 'LIM,4
|
|
?CND1: LESS? NUM,0 \?CCL5
|
|
ZERO? P-DBUG /?CND6
|
|
PRINTI "[Total: "
|
|
SUB 0,NUM
|
|
PRINTN STACK
|
|
PRINTI " passes.]
|
|
"
|
|
?CND6: SUB 1,LIM
|
|
LESS? NUM,STACK \FALSE
|
|
SET 'P-RESPONDED,FALSE-VALUE
|
|
BUFOUT TRUE-VALUE
|
|
PRINTR "]"
|
|
?CCL5: MOD NUM,LIM
|
|
ZERO? STACK \FALSE
|
|
EQUAL? NUM,LIM \?CCL15
|
|
SET 'P-RESPONDED,TRUE-VALUE
|
|
PRINTI "[Please be patient..."
|
|
JUMP ?CND13
|
|
?CCL15: PRINTC 46
|
|
?CND13: BUFOUT FALSE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT MAIN-LOOP:ANY:0:0,X
|
|
?PRG1: CALL1 MAIN-LOOP-1 >X
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT MAIN-LOOP-1:ANY:0:0,ICNT,OCNT,NUM,OBJ,V,OBJ1,NP,NP1,XX,CNT,TMP
|
|
CALL1 PARSER >P-WON
|
|
ZERO? P-WON /?CCL3
|
|
?PRG4: GET PARSE-RESULT,4 >PRSA
|
|
EQUAL? PRSA,V?UNDO \?CCL8
|
|
SET 'PRSS,FALSE-VALUE
|
|
SET 'PRSQ,FALSE-VALUE
|
|
CALL2 PERFORM,PRSA
|
|
RSTACK
|
|
?CCL8: ISAVE >P-CAN-UNDO
|
|
EQUAL? P-CAN-UNDO,2 \?CND6
|
|
EQUAL? PRSA,V?SAVE \?CCL13
|
|
ICALL1 CANT-UNDO
|
|
RFALSE
|
|
?CCL13: SET 'P-CONT,-1
|
|
ICALL1 V-$REFRESH
|
|
RFALSE
|
|
?CND6: GET PARSE-RESULT,5 >P-PRSO
|
|
GET PARSE-RESULT,6 >P-PRSI
|
|
ZERO? P-PRSO /?CCL17
|
|
GET P-PRSO,3
|
|
EQUAL? INTDIR,STACK \?CCL17
|
|
GET P-PRSO,4
|
|
GET STACK,2
|
|
GETB STACK,6 >P-DIRECTION
|
|
JUMP ?CND15
|
|
?CCL17: ZERO? P-PRSI /?CND15
|
|
GET P-PRSI,3
|
|
EQUAL? INTDIR,STACK \?CND15
|
|
GET P-PRSI,4
|
|
GET STACK,2
|
|
GETB STACK,6 >P-DIRECTION
|
|
?CND15: GET PARSE-RESULT,1 >P-PRSA-WORD
|
|
SET 'CLOCK-WAIT,FALSE-VALUE
|
|
SET 'ICNT,0
|
|
SET 'OCNT,0
|
|
ZERO? P-PRSI /?CND23
|
|
GET P-PRSI,1 >ICNT
|
|
ZERO? ICNT /?CND23
|
|
SET 'P-MULT,ICNT
|
|
?CND23: ZERO? P-PRSO /?CND27
|
|
GET P-PRSO,1 >OCNT
|
|
ZERO? OCNT /?CND27
|
|
SET 'P-MULT,OCNT
|
|
?CND27: ZERO? OCNT \?CCL33
|
|
ZERO? ICNT /?CND31
|
|
?CCL33: EQUAL? PRSA,V?WALK /?CND31
|
|
ZERO? P-IT-OBJECT /?CND31
|
|
ZERO? ICNT /?CND39
|
|
ICALL MAIN-LOOP-IT,ICNT,P-PRSI
|
|
?CND39: ZERO? OCNT /?CND31
|
|
ICALL MAIN-LOOP-IT,OCNT,P-PRSO
|
|
?CND31: ZERO? OCNT \?CCL45
|
|
SET 'NUM,OCNT
|
|
JUMP ?CND43
|
|
?CCL45: GRTR? OCNT,1 \?CCL47
|
|
ZERO? ICNT \?CCL50
|
|
SET 'OBJ,FALSE-VALUE
|
|
JUMP ?CND48
|
|
?CCL50: GET P-PRSI,3 >OBJ
|
|
GET P-PRSI,4 >NP
|
|
?CND48: SET 'NUM,OCNT
|
|
JUMP ?CND43
|
|
?CCL47: GRTR? ICNT,1 \?CCL54
|
|
GET P-PRSO,3 >OBJ
|
|
GET P-PRSI,4 >NP
|
|
SET 'NUM,ICNT
|
|
JUMP ?CND43
|
|
?CCL54: SET 'NUM,1
|
|
?CND43: ZERO? OBJ \?CND57
|
|
EQUAL? ICNT,1 \?CND57
|
|
GET P-PRSI,3 >OBJ
|
|
GET P-PRSI,4 >NP
|
|
?CND57: GET PARSE-RESULT,12 >V
|
|
ZERO? V /?CND63
|
|
GET V,1
|
|
LESS? 1,STACK \?CND63
|
|
GET V,2
|
|
ZERO? STACK \?CND63
|
|
PUT V,2,1
|
|
GET V,3
|
|
ICALL2 RT-PRINT-DESC,STACK
|
|
PRINTI ":
|
|
"
|
|
?CND63: GET PARSE-RESULT,15 >V
|
|
ZERO? V /?CCL70
|
|
GET V,0 >PRSQ
|
|
JUMP ?CND68
|
|
?CCL70: SET 'PRSQ,FALSE-VALUE
|
|
?CND68: GET PARSE-RESULT,13 >XX
|
|
ZERO? XX /?CCL73
|
|
GET XX,3 >PRSS
|
|
JUMP ?CND71
|
|
?CCL73: SET 'PRSS,FALSE-VALUE
|
|
?CND71: ZERO? LIT \?CCL76
|
|
CALL1 SEE-VERB?
|
|
ZERO? STACK /?CCL76
|
|
ICALL1 TELL-TOO-DARK
|
|
SET 'P-CONT,-1
|
|
JUMP ?CND74
|
|
?CCL76: EQUAL? PRSA,V?WALK \?CCL80
|
|
ZERO? P-WALK-DIR /?PRD83
|
|
PUSH P-WALK-DIR
|
|
JUMP ?PEN81
|
|
?PRD83: GET P-PRSO,3
|
|
?PEN81: CALL PERFORM,PRSA,STACK >V
|
|
JUMP ?CND74
|
|
?CCL80: ZERO? NUM \?CCL85
|
|
CALL2 PERFORM,PRSA >V
|
|
SET 'PRSO,FALSE-VALUE
|
|
SET 'PRSO-NP,FALSE-VALUE
|
|
JUMP ?CND74
|
|
?CCL85: GRTR? OCNT,1 \?CCL87
|
|
CALL1 COLLECTIVE-VERB?
|
|
ZERO? STACK /?CCL87
|
|
CALL PERFORM,PRSA,ROOMS >V
|
|
JUMP ?CND74
|
|
?CCL87: SET 'CNT,-1
|
|
SET 'TMP,0
|
|
?PRG90: INC 'CNT
|
|
LESS? CNT,NUM /?CND92
|
|
ZERO? TMP \?CND74
|
|
ICALL1 MORE-SPECIFIC
|
|
JUMP ?CND74
|
|
?CND92: MUL CNT,2
|
|
ADD NOUN-PHRASE-HEADER-LEN,STACK >XX
|
|
GRTR? ICNT,1 /?CCL98
|
|
GET P-PRSO,XX >OBJ1
|
|
ADD 1,XX
|
|
GET P-PRSO,STACK >NP1
|
|
JUMP ?CND96
|
|
?CCL98: GET P-PRSI,XX >OBJ1
|
|
ADD 1,XX
|
|
GET P-PRSI,STACK >NP1
|
|
?CND96: GRTR? NUM,1 /?CCL100
|
|
GET NP1,3
|
|
EQUAL? STACK,NP-QUANT-ALL \?CND99
|
|
?CCL100: EQUAL? OBJ1,FALSE-VALUE,NOT-HERE-OBJECT \?CCL105
|
|
ICALL2 NP-PRINT,NP1
|
|
PRINTI ": "
|
|
ICALL2 NP-CANT-SEE,NP1
|
|
JUMP ?PRG90
|
|
?CCL105: GET NP1,3
|
|
EQUAL? STACK,NP-QUANT-ALL \?CCL107
|
|
CALL VERB-ALL-TEST,OBJ1,OBJ
|
|
ZERO? STACK /?PRG90
|
|
?CCL107: CALL2 ACCESSIBLE?,OBJ1
|
|
ZERO? STACK /?PRG90
|
|
EQUAL? OBJ1,PLAYER /?PRG90
|
|
EQUAL? OBJ1,IT \?CCL116
|
|
ICALL2 RT-PRINT-DESC,P-IT-OBJECT
|
|
JUMP ?CND114
|
|
?CCL116: EQUAL? OBJ1,PSEUDO-OBJECT \?CCL118
|
|
ICALL2 NP-PRINT,NP1
|
|
JUMP ?CND114
|
|
?CCL118: ICALL2 RT-PRINT-DESC,OBJ1
|
|
?CND114: PRINTI ": "
|
|
?CND99: SET 'TMP,TRUE-VALUE
|
|
GRTR? ICNT,1 /?CCL121
|
|
SET 'PRSO,OBJ1
|
|
SET 'PRSO-NP,NP1
|
|
SET 'PRSI,OBJ
|
|
SET 'PRSI-NP,NP
|
|
JUMP ?CND119
|
|
?CCL121: SET 'PRSO,OBJ
|
|
SET 'PRSO-NP,NP
|
|
SET 'PRSI,OBJ1
|
|
SET 'PRSI-NP,NP1
|
|
?CND119: EQUAL? IT,PRSI,PRSO,PRSS \?CND122
|
|
CALL FIX-HIM-HER-IT,IT,P-IT-OBJECT
|
|
ZERO? STACK /?PRG90
|
|
?CND122: EQUAL? HER,PRSI,PRSO,PRSS \?CND126
|
|
CALL FIX-HIM-HER-IT,HER,P-HER-OBJECT
|
|
ZERO? STACK /?PRG90
|
|
?CND126: EQUAL? HIM,PRSI,PRSO,PRSS \?CND130
|
|
CALL FIX-HIM-HER-IT,HIM,P-HIM-OBJECT
|
|
ZERO? STACK /?PRG90
|
|
?CND130: EQUAL? THEM,PRSI,PRSO,PRSS \?CND134
|
|
CALL FIX-HIM-HER-IT,THEM,P-THEM-OBJECT
|
|
ZERO? STACK /?PRG90
|
|
?CND134: ICALL2 QCONTEXT-CHECK,PRSO
|
|
GET PARSE-RESULT,3
|
|
GETB STACK,5 >XX
|
|
ZERO? PRSO /?CND138
|
|
BTST XX,128 /?CND138
|
|
BTST XX,192 /?CND138
|
|
CALL2 META-LOC,PRSO >V
|
|
ZERO? V /?CND138
|
|
IN? V,ROOMS \?CND138
|
|
CALL2 META-LOC,WINNER
|
|
CALL GLOBAL-IN?,PRSO,STACK
|
|
ZERO? STACK \?CND138
|
|
CALL2 META-LOC,WINNER
|
|
EQUAL? V,STACK /?CND138
|
|
ICALL2 NOT-HERE,PRSO
|
|
JUMP ?PRG90
|
|
?CND138: ZERO? PRSO /?CND147
|
|
BAND XX,96
|
|
ZERO? STACK /?CND147
|
|
BTST XX,128 /?CND147
|
|
CALL ITAKE-CHECK,PRSO,XX >V
|
|
EQUAL? M-FATAL,V /?CND74
|
|
ZERO? V \?PRG90
|
|
?CND147: ZERO? PRSI /?CND157
|
|
GET PARSE-RESULT,3
|
|
GETB STACK,9 >XX
|
|
BAND 96,XX
|
|
ZERO? STACK /?CND157
|
|
BTST XX,128 /?CND157
|
|
CALL ITAKE-CHECK,PRSI,XX >V
|
|
EQUAL? M-FATAL,V /?CND74
|
|
ZERO? V \?PRG90
|
|
?CND157: CALL PERFORM,PRSA,PRSO,PRSI >V
|
|
EQUAL? M-FATAL,V /?CND74
|
|
EQUAL? P-CONT,-1 \?PRG90
|
|
?CND74: SET 'OPRSO,PRSO
|
|
ZERO? CLOCK-WAIT \?CND171
|
|
CALL1 GAME-VERB?
|
|
ZERO? STACK \?CND171
|
|
LOC WINNER >V
|
|
ZERO? V /?CND175
|
|
IN? V,ROOMS /?CND175
|
|
GETP V,P?ACTION
|
|
CALL D-APPLY,STR?1,STACK,M-END >V
|
|
?CND175: GETP HERE,P?ACTION
|
|
CALL D-APPLY,STR?1,STACK,M-END >V
|
|
EQUAL? M-FATAL,V \?CND179
|
|
SET 'P-CONT,-1
|
|
?CND179: SET 'CLOCKER-RUNNING,1
|
|
CALL1 CLOCKER >V
|
|
SET 'CLOCKER-RUNNING,2
|
|
EQUAL? M-FATAL,V \?CND171
|
|
SET 'P-CONT,-1
|
|
?CND171: GET PARSE-RESULT,12 >V
|
|
ZERO? V /?CND1
|
|
GET V,1
|
|
LESS? 1,STACK \?CND1
|
|
EQUAL? P-CONT,-1 /?CND1
|
|
CALL2 HACK-TELL-1,V >V
|
|
EQUAL? M-FATAL,V \?CCL191
|
|
SET 'P-CONT,-1
|
|
JUMP ?CND1
|
|
?CCL191: ZERO? V /?CND1
|
|
JUMP ?PRG4
|
|
?CCL3: SET 'CLOCK-WAIT,TRUE-VALUE
|
|
SET 'P-CONT,FALSE-VALUE
|
|
?CND1: SET 'PRSA,FALSE-VALUE
|
|
SET 'PRSO,FALSE-VALUE
|
|
SET 'PRSO-NP,FALSE-VALUE
|
|
SET 'PRSI,FALSE-VALUE
|
|
RETURN PRSI
|
|
|
|
|
|
.FUNCT QCONTEXT-CHECK:ANY:1:1,PER,WHO
|
|
EQUAL? PRSA,V?TELL-ABOUT \FALSE
|
|
EQUAL? PER,PLAYER \FALSE
|
|
CALL2 FIND-A-WINNER,HERE >WHO
|
|
ZERO? WHO /?CND7
|
|
SET 'QCONTEXT,WHO
|
|
?CND7: CALL1 QCONTEXT-GOOD?
|
|
ZERO? STACK /FALSE
|
|
EQUAL? WINNER,PLAYER \FALSE
|
|
SET 'WINNER,QCONTEXT
|
|
ICALL2 TELL-SAID-TO,QCONTEXT
|
|
RTRUE
|
|
|
|
|
|
.FUNCT LIT?:ANY:0:2,RM,RMBIT,OHERE,LT
|
|
ASSIGNED? 'RM /?CND1
|
|
SET 'RM,HERE
|
|
?CND1: ASSIGNED? 'RMBIT /?CND3
|
|
SET 'RMBIT,TRUE-VALUE
|
|
?CND3: SET 'OHERE,HERE
|
|
SET 'HERE,RM
|
|
ZERO? RMBIT /?CCL7
|
|
FSET? RM,ONBIT \?CCL7
|
|
SET 'LT,HERE
|
|
JUMP ?CND5
|
|
?CCL7: FSET? WINNER,ONBIT \?CCL11
|
|
CALL HELD?,WINNER,RM
|
|
ZERO? STACK /?CCL11
|
|
SET 'LT,WINNER
|
|
JUMP ?CND5
|
|
?CCL11: PUT SEARCH-RES,1,0
|
|
PUT SEARCH-RES,2,FALSE-VALUE
|
|
PUT FINDER,0,ONBIT
|
|
PUT FINDER,1,FIND-FLAGS-GWIM
|
|
EQUAL? OHERE,RM \?CND14
|
|
ICALL FIND-DESCENDANTS,WINNER,7
|
|
EQUAL? WINNER,PLAYER /?CND14
|
|
IN? PLAYER,RM \?CND14
|
|
ICALL FIND-DESCENDANTS,PLAYER,7
|
|
?CND14: GET SEARCH-RES,1
|
|
ZERO? STACK \?CND20
|
|
LOC WINNER
|
|
IN? STACK,ROOMS /?CND22
|
|
LOC WINNER
|
|
FSET? STACK,OPENBIT /?CND22
|
|
LOC WINNER
|
|
ICALL FIND-DESCENDANTS,STACK,7
|
|
?CND22: ICALL FIND-DESCENDANTS,RM,7
|
|
?CND20: GET SEARCH-RES,1
|
|
LESS? 0,STACK \?CND5
|
|
GET SEARCH-RES,4 >LT
|
|
?CND5: SET 'HERE,OHERE
|
|
RETURN LT
|
|
|
|
|
|
.FUNCT IGNORE-FIRST-WORD:ANY:0:0,NW
|
|
LESS? 1,P-LEN \FALSE
|
|
GET TLEXV,P-LEXELEN >NW
|
|
ZERO? NW /FALSE
|
|
GET NW,4 >NW
|
|
ZERO? NW /FALSE
|
|
BTST NW,32768 /FALSE
|
|
BAND NW,1
|
|
BAND STACK,32767
|
|
ZERO? STACK /FALSE
|
|
ADD TLEXV,4 >TLEXV
|
|
DEC 'P-LEN
|
|
RTRUE
|
|
|
|
|
|
.FUNCT FIX-QUOTATIONS:ANY:2:2,LEN,PTR,X,QFLAG
|
|
SET 'QFLAG,FALSE-VALUE
|
|
?PRG1: ZERO? QFLAG \?CCL5
|
|
SET 'QFLAG,TRUE-VALUE
|
|
SUB PTR,P-LEXV
|
|
DIV STACK,2
|
|
ADD 2,STACK >X
|
|
ICALL MAKE-ROOM-FOR-TOKENS,1,P-LEXV,X
|
|
PUT P-LEXV,X,W?NO.WORD
|
|
JUMP ?CND3
|
|
?CCL5: SET 'QFLAG,FALSE-VALUE
|
|
?CND3: ADD PTR,4 >PTR
|
|
SUB PTR,P-LEXV
|
|
DIV STACK,4 >X
|
|
GETB P-LEXV,P-LEXWORDS
|
|
SUB STACK,X >LEN
|
|
ZERO? LEN /TRUE
|
|
INTBL? W?QUOTE,PTR,LEN,132 >PTR /?PRG1
|
|
RTRUE
|
|
|
|
|
|
.FUNCT MAIN-LOOP-IT:ANY:2:2,ICNT,PRS,CNT,TOFF
|
|
?PRG1: MUL CNT,2
|
|
ADD NOUN-PHRASE-HEADER-LEN,STACK >TOFF
|
|
GET PRS,TOFF
|
|
EQUAL? IT,STACK \?CCL5
|
|
CALL2 ACCESSIBLE?,P-IT-OBJECT
|
|
ZERO? STACK /?CCL5
|
|
PUT PRS,TOFF,P-IT-OBJECT
|
|
ICALL TELL-PRONOUN,P-IT-OBJECT,IT
|
|
RTRUE
|
|
?CCL5: IGRTR? 'CNT,ICNT \?PRG1
|
|
RTRUE
|
|
|
|
|
|
.FUNCT P-NO-MEM-ROUTINE:ANY:0:1,TYP
|
|
PRINTI "[Sorry, but that"
|
|
EQUAL? TYP,7 \?CCL3
|
|
PRINTI "'s too many objects"
|
|
JUMP ?CND1
|
|
?CCL3: PRINTI " sentence is too complicated"
|
|
?CND1: PRINTI ".]
|
|
"
|
|
THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
|
|
RTRUE
|
|
|
|
|
|
.FUNCT BEG-PARDON:ANY:0:0
|
|
PRINTR "[I beg your pardon?]"
|
|
|
|
|
|
.FUNCT UNKNOWN-WORD:ANY:1:1,RLEXV,X
|
|
CALL2 NUMBER?,RLEXV >X
|
|
ZERO? X /?CCL3
|
|
RETURN X
|
|
?CCL3: PRINTI "[I don't know the word """
|
|
SUB RLEXV,P-LEXV
|
|
DIV STACK,2
|
|
PUT OOPS-TABLE,O-PTR,STACK
|
|
ICALL2 WORD-PRINT,RLEXV
|
|
PRINTI ".""]"
|
|
CRLF
|
|
THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
|
|
RTRUE
|
|
|
|
|
|
.FUNCT WORD-PRINT:ANY:1:3,PTR,LEN,OFFS
|
|
ASSIGNED? 'LEN /?CND1
|
|
GETB PTR,2 >LEN
|
|
?CND1: ASSIGNED? 'OFFS /?PRG5
|
|
GETB PTR,3 >OFFS
|
|
?PRG5: DLESS? 'LEN,0 /TRUE
|
|
GETB P-INBUF,OFFS
|
|
PRINTC STACK
|
|
INC 'OFFS
|
|
JUMP ?PRG5
|
|
|
|
|
|
.FUNCT PRINT-VOCAB-WORD:ANY:1:1,WD,TMP,?TMP1
|
|
ADD LONG-WORD-TABLE,2 >?TMP1
|
|
GET LONG-WORD-TABLE,0
|
|
DIV STACK,2
|
|
INTBL? WD,?TMP1,STACK,132 >TMP \?CCL3
|
|
GET TMP,1
|
|
PRINT STACK
|
|
RTRUE
|
|
?CCL3: EQUAL? WD,W?INT.NUM,W?INT.TIM /FALSE
|
|
PRINTB WD
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DO-OOPS:ANY:1:1,OWINNER,PTR,VAL
|
|
SET 'PTR,P-LEXSTART
|
|
GET TLEXV,P-LEXELEN
|
|
EQUAL? STACK,W?PERIOD,W?COMMA \?CND1
|
|
ADD PTR,P-LEXELEN >PTR
|
|
DEC 'P-LEN
|
|
?CND1: GRTR? P-LEN,1 /?CCL5
|
|
ICALL1 NAKED-OOPS
|
|
RFALSE
|
|
?CCL5: CALL2 META-LOC,OWINNER
|
|
EQUAL? HERE,STACK /?CCL7
|
|
ICALL2 NOT-HERE,OWINNER
|
|
RFALSE
|
|
?CCL7: GET OOPS-TABLE,O-PTR >VAL
|
|
ZERO? VAL /?CCL9
|
|
SUB P-LEN,1
|
|
ICALL REPLACE-ONE-TOKEN,STACK,P-LEXV,PTR,G-LEXV,VAL
|
|
SET 'WINNER,OWINNER
|
|
ICALL2 COPY-INPUT,TRUE-VALUE
|
|
RTRUE
|
|
?CCL9: PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
ICALL1 CANT-OOPS
|
|
RFALSE
|
|
|
|
|
|
.FUNCT DO-AGAIN:ANY:1:1,OWINNER,N,?TMP1
|
|
CALL2 META-LOC,OWINNER
|
|
EQUAL? HERE,STACK /?CCL3
|
|
ICALL2 NOT-HERE,OWINNER
|
|
RFALSE
|
|
?CCL3: LESS? 0,P-OFLAG /?CTR4
|
|
ZERO? P-WON /?CTR4
|
|
GETB G-INBUF,2
|
|
ZERO? STACK \?CCL5
|
|
?CTR4: ICALL1 CANT-AGAIN
|
|
RFALSE
|
|
?CCL5: GRTR? P-LEN,1 \?CND1
|
|
SUB TLEXV,P-LEXV
|
|
LESS? STACK,234 \?CND1
|
|
GET TLEXV,P-LEXELEN >N
|
|
EQUAL? N,W?PERIOD,W?COMMA,W?THEN /?CND1
|
|
EQUAL? N,W?AND /?CND1
|
|
ICALL1 DONT-UNDERSTAND
|
|
RFALSE
|
|
?CND1: SET 'N,P-WORDS-AGAIN
|
|
SET 'WINNER,OWINNER
|
|
EQUAL? N,1 /?CND16
|
|
SUB N,1
|
|
ADD P-LEN,STACK >P-LEN
|
|
SUB N,1 >?TMP1
|
|
SUB TLEXV,P-LEXV
|
|
DIV STACK,2
|
|
ICALL MAKE-ROOM-FOR-TOKENS,?TMP1,P-LEXV,STACK
|
|
ZERO? P-CONT /?CND16
|
|
SUB N,1
|
|
MUL STACK,4
|
|
ADD P-CONT,STACK >P-CONT
|
|
?CND16: GET OOPS-TABLE,O-START
|
|
SUB STACK,P-LEXV
|
|
ADD G-LEXV,STACK >?TMP1
|
|
MUL N,4
|
|
COPYT ?TMP1,TLEXV,STACK
|
|
RTRUE
|
|
|
|
|
|
.FUNCT NP-SAVE:ANY:1:1,ROBJ,TMP
|
|
COPYT SEARCH-RES,ORPHAN-SR,20
|
|
COPYT ROBJ,ORPHAN-NP,20
|
|
GET ROBJ,5 >TMP
|
|
ZERO? TMP /?CCL3
|
|
GET TMP,2
|
|
COPYT STACK,ORPHAN-NP2,10
|
|
PUT ORPHAN-NP,5,ORPHAN-NP2
|
|
JUMP ?CND1
|
|
?CCL3: GET ROBJ,4 >TMP
|
|
ZERO? TMP /?CCL5
|
|
COPYT TMP,ORPHAN-NP2,20
|
|
PUT ORPHAN-NP,4,ORPHAN-NP2
|
|
JUMP ?CND1
|
|
?CCL5: GET ROBJ,6 >TMP
|
|
ZERO? TMP /?CND1
|
|
COPYT TMP,ORPHAN-NP2,20
|
|
PUT ORPHAN-NP,6,ORPHAN-NP2
|
|
?CND1: GET ROBJ,1 >TMP
|
|
ZERO? TMP /?CCL9
|
|
COPYT TMP,ORPHAN-ADJS,18
|
|
PUT ORPHAN-NP,1,ORPHAN-ADJS
|
|
GET TMP,2 >TMP
|
|
GRTR? 0,TMP /?CCL12
|
|
GRTR? TMP,LAST-OBJECT /?CCL12
|
|
PUT ORPHAN-ADJS,2,TMP
|
|
RETURN ORPHAN-NP
|
|
?CCL12: COPYT TMP,ORPHAN-NP2,20
|
|
PUT ORPHAN-ADJS,2,ORPHAN-NP2
|
|
RETURN ORPHAN-NP
|
|
?CCL9: PUT ORPHAN-NP,1,0
|
|
RETURN ORPHAN-NP
|
|
|
|
|
|
.FUNCT PARSER-ERROR:ANY:0:5,STR,CLASS,OTHER,OTHER2,OTHER3,RP
|
|
ZERO? CURRENT-REDUCTION /FALSE
|
|
GET CURRENT-REDUCTION,2 >RP
|
|
GRTR? ERROR-PRIORITY,RP /?CCL3
|
|
EQUAL? ERROR-PRIORITY,RP \FALSE
|
|
EQUAL? CLASS,PARSER-ERROR-ORPH-NP /?CCL3
|
|
EQUAL? CLASS,PARSER-ERROR-NOUND /FALSE
|
|
GET ERROR-ARGS,1
|
|
EQUAL? STACK,PARSER-ERROR-NOUND \FALSE
|
|
?CCL3: SET 'ERROR-PRIORITY,RP
|
|
SET 'ERROR-STRING,STR
|
|
ZERO? CLASS /?CCL14
|
|
PUT ERROR-ARGS,0,3
|
|
PUT ERROR-ARGS,1,CLASS
|
|
PUT ERROR-ARGS,2,OTHER
|
|
PUT ERROR-ARGS,3,OTHER2
|
|
CALL2 PMEM?,OTHER
|
|
ZERO? STACK /FALSE
|
|
GETB OTHER,1
|
|
EQUAL? STACK,4 \?CND17
|
|
GET OTHER,4 >OTHER
|
|
?CND17: GETB OTHER,1
|
|
EQUAL? STACK,2 \FALSE
|
|
CALL2 NP-SAVE,OTHER
|
|
PUT ERROR-ARGS,2,STACK
|
|
EQUAL? CLASS,PARSER-ERROR-NOOBJ \FALSE
|
|
GET OTHER,3
|
|
ZERO? STACK \FALSE
|
|
PUT ERROR-ARGS,3,OTHER3
|
|
RFALSE
|
|
?CCL14: PUT ERROR-ARGS,0,0
|
|
RFALSE
|
|
|
|
|
|
.FUNCT BUZZER-WORD?:ANY:2:2,WD,PTR,N
|
|
GET P-N-WORDS,0
|
|
INTBL? WD,P-N-WORDS+2,STACK \?CCL3
|
|
PRINTR "[Use numerals for numbers, for example ""10.""]"
|
|
?CCL3: GET P-C-WORDS,0
|
|
INTBL? WD,P-C-WORDS+2,STACK \FALSE
|
|
PRINTC 91
|
|
CALL2 PICK-ONE,OFFENDED
|
|
PRINT STACK
|
|
PRINTR "]"
|
|
|
|
|
|
.FUNCT NUMBER?:ANY:1:1,RLEXV,BPTR,SUM,TIM,NEG,CHR,CNT,?TMP1
|
|
GETB RLEXV,3 >BPTR
|
|
GETB RLEXV,2 >CNT
|
|
?PRG1: DLESS? 'CNT,0 /?REP2
|
|
GETB P-INBUF,BPTR >CHR
|
|
EQUAL? CHR,58 \?CCL8
|
|
SET 'TIM,SUM
|
|
SET 'SUM,0
|
|
JUMP ?CND6
|
|
?CCL8: EQUAL? CHR,45 \?CCL10
|
|
ZERO? NEG \FALSE
|
|
SET 'NEG,TRUE-VALUE
|
|
JUMP ?CND6
|
|
?CCL10: GRTR? CHR,57 /FALSE
|
|
LESS? CHR,48 /FALSE
|
|
GRTR? SUM,3276 /FALSE
|
|
MUL SUM,10 >?TMP1
|
|
SUB CHR,48
|
|
ADD ?TMP1,STACK >SUM
|
|
?CND6: INC 'BPTR
|
|
JUMP ?PRG1
|
|
?REP2: ZERO? TIM /?CCL22
|
|
GRTR? TIM,23 /FALSE
|
|
ZERO? NEG \FALSE
|
|
MUL TIM,60
|
|
ADD SUM,STACK >SUM
|
|
ICALL CHANGE-LEXV,RLEXV,W?INT.TIM,BPTR,SUM
|
|
RETURN W?INT.TIM
|
|
?CCL22: ZERO? NEG /?CND27
|
|
SUB 0,SUM >SUM
|
|
?CND27: ICALL CHANGE-LEXV,RLEXV,W?INT.NUM,BPTR,SUM
|
|
RETURN W?INT.NUM
|
|
|
|
|
|
.FUNCT CHANGE-LEXV:ANY:2:4,PTR,WRD,BPTR,SUM,X
|
|
PUT PTR,0,WRD
|
|
SUB PTR,P-LEXV
|
|
ADD G-LEXV,STACK >X
|
|
PUT X,0,WRD
|
|
ASSIGNED? 'BPTR \FALSE
|
|
PUT PTR,1,SUM
|
|
PUT X,1,SUM
|
|
SET 'P-NUMBER,SUM
|
|
RETURN P-NUMBER
|
|
|
|
|
|
.FUNCT TELL-GWIM-MSG:ANY:0:0,WD,VB,OBJ
|
|
GET GWIM-MSG,1 >OBJ
|
|
EQUAL? OBJ,TH-HANDS /FALSE
|
|
PRINTC 91
|
|
GET GWIM-MSG,0 >WD
|
|
ZERO? WD /?CND4
|
|
ICALL2 PRINT-VOCAB-WORD,WD
|
|
GET PARSER-RESULT,1 >VB
|
|
EQUAL? VB,W?SIT,W?LIE \?CCL8
|
|
EQUAL? WD,W?DOWN \?CND4
|
|
PRINTI " on"
|
|
JUMP ?CND4
|
|
?CCL8: EQUAL? VB,W?GET \?CND4
|
|
EQUAL? WD,W?OUT \?CND4
|
|
PRINTI " of"
|
|
?CND4: GET GWIM-MSG,1
|
|
ICALL RT-PRINT-OBJ,STACK,K-ART-THE
|
|
PRINTC 93
|
|
CRLF
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DO-IT-AGAIN:ANY:0:1,NUM,X,TMP
|
|
ASSIGNED? 'NUM /?CND1
|
|
SET 'NUM,1
|
|
?CND1: SUB TLEXV,P-LEXV
|
|
DIV STACK,2 >X
|
|
ZERO? P-CONT \?CND3
|
|
ADD X,P-LEXELEN >X
|
|
?CND3: GET OOPS-TABLE,O-START >TMP
|
|
ZERO? TMP /?PRG7
|
|
SUB TMP,P-LEXV+2
|
|
DIV STACK,4 >TMP
|
|
GETB G-LEXV,P-LEXWORDS
|
|
ADD STACK,TMP
|
|
PUTB G-LEXV,P-LEXWORDS,STACK
|
|
?PRG7: ICALL MAKE-ROOM-FOR-TOKENS,2,G-LEXV,X
|
|
PUT G-LEXV,X,W?PERIOD
|
|
ADD X,P-LEXELEN
|
|
PUT G-LEXV,STACK,W?AGAIN
|
|
DLESS? 'NUM,1 \?PRG7
|
|
GETB G-LEXV,P-LEXWORDS
|
|
SUB STACK,TMP
|
|
PUTB G-LEXV,P-LEXWORDS,STACK
|
|
CALL2 COPY-INPUT,TRUE-VALUE
|
|
RSTACK
|
|
|
|
.ENDSEG
|
|
|
|
.ENDI
|