cutthroats/goal.zap

529 lines
11 KiB
Plaintext

.FUNCT DIR-PRINT,DIR,CNT=0,TBL,DRY=0
ZERO? DIR \?ELS3
PRINTI "out of view"
RTRUE
?ELS3: GETP HERE,P?LINE
GRTR? STACK,BACK-ALLEY-LINE-C \?ELS7
SET 'TBL,NAUTICAL-DIR-STRINGS
JUMP ?CND1
?ELS7: SET 'TBL,DIR-STRINGS
SET 'DRY,TRUE-VALUE
?CND1:
?PRG10: GET TBL,CNT
EQUAL? STACK,DIR \?CND12
ZERO? DRY /?CND15
EQUAL? DIR,P?UP,P?DOWN /?CND15
PRINTI "the "
?CND15: ADD CNT,1
GET TBL,STACK
PRINT STACK
RTRUE
?CND12: INC 'CNT
JUMP ?PRG10
.FUNCT FOLLOW-GOAL,PERSON,HERE,LINE,LN,RM,GT,GOAL,FLG,GOAL-FLAG=0,IGOAL=0,LOC,CNT=1,DIR
LOC PERSON >HERE
GETP PERSON,P?CHARACTER
GET GOAL-TABLES,STACK >GT
GET GT,GOAL-F
EQUAL? HERE,STACK \?ELS3
PUT GT,GOAL-S,FALSE-VALUE
RETURN FALSE-VALUE
?ELS3: GET GT,GOAL-ENABLE
ZERO? STACK /FALSE
?CND1: GETP HERE,P?STATION >LOC
EQUAL? LOC,HERE /?CND6
CALL MOVE-PERSON,PERSON,LOC
RSTACK
?CND6: GET GT,GOAL-I >IGOAL
GET TRANSFER-TABLE,IGOAL >GOAL
ZERO? GOAL \?CND9
SET 'IGOAL,FALSE-VALUE
GET GT,GOAL-S >GOAL
?CND9: ZERO? GOAL /FALSE
EQUAL? HERE,GOAL \?CND12
ZERO? IGOAL /?ELS19
ADD IGOAL,1
GET TRANSFER-TABLE,STACK
CALL MOVE-PERSON,PERSON,STACK >FLG
GET GT,GOAL-F
CALL ESTABLISH-GOAL,PERSON,STACK
RETURN FLG
?ELS19: GET GT,GOAL-F
EQUAL? HERE,STACK /?ELS22
PUT GT,GOAL-S,FALSE-VALUE
GET GT,GOAL-F
CALL MOVE-PERSON,PERSON,STACK >FLG
RETURN FLG
?ELS22: PUT GT,GOAL-S,FALSE-VALUE
RETURN FALSE-VALUE
?CND12: GETP GOAL,P?LINE
CALL GET-LINE,STACK >LINE
?PRG25: GET LINE,CNT >RM
EQUAL? RM,HERE \?ELS29
ZERO? GOAL-FLAG /?ELS32
SUB CNT,3
GET LINE,STACK >LOC
JUMP ?CND30
?ELS32: ADD CNT,3
GET LINE,STACK >LOC
?CND30: CALL MOVE-PERSON,PERSON,LOC
RETURN STACK
?ELS29: EQUAL? RM,GOAL \?CND27
SET 'GOAL-FLAG,TRUE-VALUE
?CND27: ADD CNT,3 >CNT
JUMP ?PRG25
.FUNCT COR-DIR,HERE,THERE,COR,RM,PAST=0,CNT=2,?TMP1
GETP THERE,P?CORRIDOR >?TMP1
GETP HERE,P?CORRIDOR
BAND ?TMP1,STACK
CALL GET-COR,STACK >COR
?PRG1: GET COR,CNT >RM
EQUAL? RM,HERE \?ELS5
SET 'PAST,1
JUMP ?REP2
?ELS5: EQUAL? RM,THERE \?CND3
JUMP ?REP2
?CND3: INC 'CNT
JUMP ?PRG1
?REP2: GET COR,PAST
RSTACK
.FUNCT GET-LINE,LN
ZERO? LN \?ELS5
RETURN ROAD-WHARF-LINE
?ELS5: EQUAL? LN,1 \?ELS7
RETURN EAST-ROAD-LINE
?ELS7: EQUAL? LN,2 \?ELS9
RETURN BEDROOM-LINE
?ELS9: EQUAL? LN,3 \?ELS11
RETURN BACK-ALLEY-LINE
?ELS11: EQUAL? LN,4 \?ELS13
RETURN TRAWLER-LINE
?ELS13: EQUAL? LN,5 \FALSE
RETURN SALVAGER-LINE
.FUNCT GET-COR,NUM
EQUAL? NUM,1 \?ELS5
RETURN COR-1
?ELS5: EQUAL? NUM,2 \?ELS7
RETURN COR-2
?ELS7: EQUAL? NUM,4 \?ELS9
RETURN COR-4
?ELS9: EQUAL? NUM,8 \?ELS11
RETURN COR-8
?ELS11: EQUAL? NUM,16 \?ELS13
RETURN COR-16
?ELS13: EQUAL? NUM,32 \?ELS15
RETURN COR-32
?ELS15: EQUAL? NUM,64 \?ELS17
RETURN COR-64
?ELS17: EQUAL? NUM,128 \?ELS19
RETURN COR-128
?ELS19: EQUAL? NUM,256 \?ELS21
RETURN COR-256
?ELS21: RETURN COR-512
.FUNCT CORRIDOR-LOOK,ITM=0,C,Z,COR,VAL,FOUND=0
GETP HERE,P?CORRIDOR >C
ZERO? C /FALSE
?PRG6: SUB C,512 >Z
LESS? Z,0 /?ELS10
SET 'COR,COR-512
JUMP ?CND8
?ELS10: SUB C,256 >Z
LESS? Z,0 /?ELS12
SET 'COR,COR-256
JUMP ?CND8
?ELS12: SUB C,128 >Z
LESS? Z,0 /?ELS14
SET 'COR,COR-128
JUMP ?CND8
?ELS14: SUB C,64 >Z
LESS? Z,0 /?ELS16
SET 'COR,COR-64
JUMP ?CND8
?ELS16: SUB C,32 >Z
LESS? Z,0 /?ELS18
SET 'COR,COR-32
JUMP ?CND8
?ELS18: SUB C,16 >Z
LESS? Z,0 /?ELS20
SET 'COR,COR-16
JUMP ?CND8
?ELS20: SUB C,8 >Z
LESS? Z,0 /?ELS22
SET 'COR,COR-8
JUMP ?CND8
?ELS22: SUB C,4 >Z
LESS? Z,0 /?ELS24
SET 'COR,COR-4
JUMP ?CND8
?ELS24: SUB C,2 >Z
LESS? Z,0 /?ELS26
SET 'COR,COR-2
JUMP ?CND8
?ELS26: SUB C,1 >Z
LESS? Z,0 /?REP7
SET 'COR,COR-1
?CND8: CALL CORRIDOR-CHECK,COR,ITM >VAL
ZERO? FOUND \?CND31
SET 'FOUND,VAL
?CND31: SET 'C,Z
JUMP ?PRG6
?REP7: RETURN FOUND
.FUNCT CORRIDOR-CHECK,COR,ITM,CNT=2,PAST=0,FOUND=0,RM,OBJ
?PRG1: GET COR,CNT >RM
ZERO? RM /FALSE
EQUAL? RM,HERE \?ELS7
SET 'PAST,1
JUMP ?CND3
?ELS7: FIRST? RM >OBJ \?CND3
?PRG10: ZERO? ITM /?ELS14
EQUAL? OBJ,ITM \?CND12
GET COR,PAST >FOUND
JUMP ?REP11
?ELS14: GETP OBJ,P?CHARACTER
ZERO? STACK /?CND12
CALL IN-MOTION?,OBJ
ZERO? STACK \?CND12
EQUAL? OBJ,MCGINTY \?THN23
CALL QUEUED?,I-MCGINTY-FOLLOWS
ZERO? STACK /?THN23
EQUAL? PRSA,V?FOLLOW,V?WALK /?CND12
?THN23: CALL START-SENTENCE,OBJ
PRINTI " is "
PRINTI "off to "
GET COR,PAST
CALL DIR-PRINT,STACK
PRINTI "."
CRLF
?CND12: NEXT? OBJ >OBJ /?KLU38
?KLU38: ZERO? OBJ \?PRG10
?REP11: ZERO? FOUND /?CND3
RETURN FOUND
?CND3: INC 'CNT
JUMP ?PRG1
.FUNCT IN-MOTION?,PERSON,GT,?TMP1
GETP PERSON,P?CHARACTER
GET GOAL-TABLES,STACK >GT
GET GT,GOAL-ENABLE
ZERO? STACK \?THN8
GET GT,ATTENTION
EQUAL? STACK,1 \FALSE
?THN8: GET GT,GOAL-S
ZERO? STACK /FALSE
LOC PERSON >?TMP1
GET GT,GOAL-F
EQUAL? ?TMP1,STACK /FALSE
RTRUE
.FUNCT START-MOVEMENT
CALL QUEUE,I-MCGINTY,1
PUT STACK,0,1
CALL QUEUE,I-JOHNNY,1
PUT STACK,0,1
CALL QUEUE,I-PETE,1
PUT STACK,0,1
CALL QUEUE,I-WEASEL,1
PUT STACK,0,1
CALL QUEUE,I-DELIVERY-BOY,1
PUT STACK,0,1
CALL QUEUE,I-FOLLOW,-1
PUT STACK,0,1
CALL QUEUE,I-ATTENTION,-1
PUT STACK,0,1
CALL QUEUE,I-DISGUSTING-WEASEL-KLUDGE,35
PUT STACK,0,1
RTRUE
.FUNCT IMOVEMENT,PERSON,INT,TB,VAR,DIS,TIM,ID,RM,GT,?TMP1
GETP PERSON,P?CHARACTER >ID
GET MOVEMENT-GOALS,ID >TB
GET GOAL-TABLES,ID >GT
GET TB,MG-ROOM >RM
EQUAL? 0,RM /?CND1
GET GT,GOAL-QUEUED
ZERO? STACK /?ELS6
PUT GT,GOAL-QUEUED,RM
JUMP ?CND1
?ELS6: CALL ESTABLISH-GOAL,PERSON,RM
?CND1: GET TB,MG-TIME >TIM
EQUAL? 0,TIM /FALSE
GET TB,MG-VARIATION >VAR
MUL VAR,2
RANDOM STACK >DIS
SUB DIS,VAR
ADD TIM,STACK
CALL QUEUE,INT,STACK
ADD TB,MG-LENGTH
PUT MOVEMENT-GOALS,ID,STACK
GET TB,MG-NEXT
EQUAL? 0,STACK /FALSE
GET TB,MG-NEXT >?TMP1
SUB VAR,DIS
ADD ?TMP1,STACK
PUT TB,MG-NEXT,STACK
RFALSE
.FUNCT I-FOLLOW,FLG=0,CNT=0,GT,VAL
?PRG1: IGRTR? 'CNT,CHARACTER-MAX \?ELS5
RETURN FLG
?ELS5: GET GOAL-TABLES,CNT >GT
GET GT,GOAL-S
ZERO? STACK /?PRG1
GET GT,GOAL-ENABLE
ZERO? STACK \?THN10
GET GT,ATTENTION
ZERO? STACK \?PRG1
?THN10: PUT GT,GOAL-ENABLE,TRUE-VALUE
GET CHARACTER-TABLE,CNT
CALL FOLLOW-GOAL,STACK >VAL
ZERO? VAL /?PRG1
EQUAL? FLG,M-FATAL /?PRG1
SET 'FLG,VAL
JUMP ?PRG1
.FUNCT I-ATTENTION,FLG=0,CNT=0,ATT,GT
?PRG1: IGRTR? 'CNT,CHARACTER-MAX \?ELS5
RETURN FLG
?ELS5: GET GOAL-TABLES,CNT >GT
GET GT,ATTENTION
SUB STACK,1 >ATT
ZERO? ATT \?CND3
PUT GT,GOAL-ENABLE,TRUE-VALUE
?CND3: PUT GT,ATTENTION,ATT
JUMP ?PRG1
.FUNCT GRAB-ATTENTION,PERSON,CHR,GT,ATT
GETP PERSON,P?CHARACTER >CHR
GET GOAL-TABLES,CHR >GT
GET GT,GOAL-S
ZERO? STACK /?CND1
GET GT,ATTENTION-SPAN >ATT
PUT GT,ATTENTION,ATT
ZERO? ATT \?ELS6
PUT GT,GOAL-ENABLE,TRUE-VALUE
RFALSE
?ELS6: GET GT,GOAL-ENABLE
ZERO? STACK /?CND1
PUT GT,GOAL-ENABLE,FALSE-VALUE
?CND1: SET 'QCONTEXT,PERSON
SET 'QCONTEXT-ROOM,HERE
RTRUE
.FUNCT ESTABLISH-GOAL,PERSON,GOAL,PRIORITY=0,HERE,HL,GL,GT,?TMP1
LOC PERSON >HERE
GETP PERSON,P?CHARACTER
GET GOAL-TABLES,STACK >GT
ZERO? PRIORITY /?CND1
PUT GT,GOAL-ENABLE,TRUE-VALUE
PUT GT,GOAL-QUEUED,HERE
?CND1: GETP HERE,P?LINE
MUL STACK,12 >?TMP1
GETP GOAL,P?LINE
MUL STACK,2
ADD ?TMP1,STACK
PUT GT,GOAL-I,STACK
GETP GOAL,P?STATION
PUT GT,GOAL-S,STACK
PUT GT,GOAL-F,GOAL
LOC PERSON
RSTACK
.FUNCT GOAL-REACHED,PERSON,GT
GETP PERSON,P?CHARACTER
GET GOAL-TABLES,STACK >GT
PUT GT,GOAL-S,FALSE-VALUE
GET GT,GOAL-FUNCTION
CALL STACK,G-REACHED
RSTACK
.FUNCT MOVE-PERSON,PERSON,WHERE,DIR,GT,OL,COR,PCOR,CHR,PUSHCART,FLG=0,VAL=0,DF,CD
GETP PERSON,P?CHARACTER >CHR
GET GOAL-TABLES,CHR >GT
LOC PERSON >OL
CALL DIR-FROM,OL,WHERE >DIR
SET 'PUSHCART,STR?187
EQUAL? OL,HERE \?ELS3
FSET? PERSON,INVISIBLE /?ELS3
SET 'FLG,TRUE-VALUE
CALL START-SENTENCE,PERSON
EQUAL? DIR,P?OUT \?ELS8
PRINTI " leaves the room"
EQUAL? PERSON,DELIVERY-BOY \?CND11
PRINT PUSHCART
?CND11: PRINTI "."
CRLF
JUMP ?CND1
?ELS8: EQUAL? DIR,P?IN \?ELS19
PRINTI " goes into another room"
PRINTI "."
CRLF
JUMP ?CND1
?ELS19: PRINTI " heads "
GETP HERE,P?LINE
LESS? STACK,TRAWLER-LINE-C \?CND28
EQUAL? DIR,P?UP,P?DOWN /?CND28
PRINTI "off to "
?CND28: CALL DIR-PRINT,DIR
EQUAL? PERSON,DELIVERY-BOY \?CND35
PRINT PUSHCART
?CND35: PRINTI "."
CRLF
JUMP ?CND1
?ELS3: EQUAL? WHERE,HERE \?ELS43
FSET? PERSON,INVISIBLE /?ELS43
SET 'FLG,M-FATAL
GET GT,GOAL-F
EQUAL? HERE,STACK /?CND1
CALL START-SENTENCE,PERSON
PRINTI " walks "
EQUAL? PRSA,V?WALK \?ELS53
EQUAL? WHERE,HERE \?ELS53
EQUAL? OL,LAST-PLAYER-LOC \?ELS53
PRINTI "along with"
JUMP ?CND51
?ELS53: PRINTI "past"
?CND51: PRINTI " you"
EQUAL? PERSON,DELIVERY-BOY \?CND64
PRINT PUSHCART
?CND64: PRINTI "."
CRLF
JUMP ?CND1
?ELS43: GETP HERE,P?CORRIDOR >COR
ZERO? COR /?CND1
FSET? PERSON,INVISIBLE /?CND1
GETP OL,P?CORRIDOR >PCOR
ZERO? PCOR /?ELS77
BAND COR,PCOR
ZERO? STACK /?ELS77
SET 'FLG,TRUE-VALUE
GETP WHERE,P?CORRIDOR
ZERO? STACK \?ELS82
CALL START-SENTENCE,PERSON
PRINTI ", off to "
CALL COR-DIR,HERE,OL
CALL DIR-PRINT,STACK
PRINTI ","
PRINTI " leaves your view"
PRINTI " to "
CALL DIR-FROM,OL,WHERE
CALL DIR-PRINT,STACK
EQUAL? PERSON,DELIVERY-BOY \?CND91
PRINT PUSHCART
?CND91: PRINTI "."
CRLF
JUMP ?CND75
?ELS82: GETP WHERE,P?CORRIDOR
BAND COR,STACK
ZERO? STACK \?ELS99
CALL START-SENTENCE,PERSON
PRINTI ", off to "
CALL COR-DIR,HERE,OL
CALL DIR-PRINT,STACK
PRINTI ", disappears from sight to "
CALL DIR-FROM,OL,WHERE >PCOR
CALL DIR-PRINT,PCOR
EQUAL? PERSON,DELIVERY-BOY \?CND104
PRINT PUSHCART
?CND104: PRINTI "."
CRLF
JUMP ?CND75
?ELS99: CALL START-SENTENCE,PERSON
PRINTI " is to "
CALL COR-DIR,HERE,WHERE >CD
CALL DIR-PRINT,CD
PRINTI ", heading "
CALL DIR-FROM,OL,WHERE >DF
EQUAL? CD,DF \?ELS119
PRINTI "away from you"
JUMP ?CND117
?ELS119: PRINTI "toward "
CALL DIR-PRINT,DF
?CND117: EQUAL? PERSON,DELIVERY-BOY \?CND126
PRINT PUSHCART
?CND126: PRINTI "."
CRLF
JUMP ?CND75
?ELS77: GETP WHERE,P?CORRIDOR >PCOR
ZERO? PCOR /?CND1
BAND COR,PCOR
ZERO? STACK /?CND1
SET 'FLG,TRUE-VALUE
PRINTI "To "
CALL COR-DIR,HERE,WHERE
CALL DIR-PRINT,STACK
PRINTI " "
CALL THE?,PERSON
CALL DPRINT,PERSON
PRINTI " comes into view from "
CALL DIR-FROM,WHERE,OL
CALL DIR-PRINT,STACK
EQUAL? PERSON,DELIVERY-BOY \?CND143
PRINT PUSHCART
?CND143: PRINTI "."
CRLF
?CND75:
?CND1: MOVE PERSON,WHERE
GET GT,GOAL-F
EQUAL? STACK,WHERE \?ELS152
CALL GOAL-REACHED,PERSON >VAL
ZERO? VAL \?CND150
EQUAL? HERE,WHERE \?CND150
FSET? PERSON,INVISIBLE /?CND150
SET 'FLG,M-FATAL
CALL START-SENTENCE,PERSON
PRINTI " stops here."
CRLF
JUMP ?CND150
?ELS152: GET GT,GOAL-FUNCTION
CALL STACK,G-ENROUTE
?CND150: EQUAL? VAL,M-FATAL \?ELS166
RETURN VAL
?ELS166: RETURN FLG
.FUNCT DIR-FROM,HERE,THERE,V=0,P=0,L,Z,O
?PRG1: NEXTP HERE,P >P
ZERO? P \?ELS5
RETURN V
?ELS5: EQUAL? P,P?IN,P?OUT \?ELS7
JUMP ?PRG1
?ELS7: LESS? P,LOW-DIRECTION /?PRG1
GETPT HERE,P >Z
PTSIZE Z >L
EQUAL? L,DEXIT,UEXIT,CEXIT \?ELS12
GETB Z,REXIT
EQUAL? STACK,THERE \?ELS12
EQUAL? P,P?UP,P?DOWN \?ELS17
SET 'V,P
JUMP ?PRG1
?ELS17: RETURN P
?ELS12: ZERO? V \?PRG1
EQUAL? L,FEXIT \?PRG1
SET 'V,P
JUMP ?PRG1
.ENDI