zorkzero/chess.zap

754 lines
18 KiB
Plaintext

.SEGMENT "FENSHIRE"
.FUNCT PLAIN-F,RARG,PIECE
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "You are on an amazingly flat plain of "
ADD RANK,FILE
MOD STACK,2
ZERO? STACK \?CCL6
PRINTI "sun-bleached sand"
JUMP ?CND4
?CCL6: PRINTI "deep, rich loam"
?CND4: PRINTI ". The plain seems to stretch endlessly in all directions"
EQUAL? RANK,1,8 /?CCL8
EQUAL? FILE,1,8 \?CND7
?CCL8: PRINTI ", except to the "
EQUAL? RANK,1 \?CCL13
PRINTI "north"
EQUAL? FILE,1 \?CCL16
PRINTI " and west"
JUMP ?CND11
?CCL16: EQUAL? FILE,8 \?CND11
PRINTI " and east"
JUMP ?CND11
?CCL13: EQUAL? RANK,8 \?CCL19
PRINTI "south"
EQUAL? FILE,1 \?CCL22
PRINTI " and west"
JUMP ?CND11
?CCL22: EQUAL? FILE,8 \?CND11
PRINTI " and east"
JUMP ?CND11
?CCL19: EQUAL? FILE,1 \?CCL25
PRINTI "west"
JUMP ?CND11
?CCL25: PRINTI "east"
?CND11: PRINTI ", where the world seems to end in a gray void"
?CND7: PRINTC 46
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
CALL FIND-IN,HERE,BLACKBIT >PIECE
ZERO? PIECE \?PEN31
CALL FIND-IN,HERE,WHITEBIT >PIECE
?PEN31: ZERO? PIECE /FALSE
FSET? PIECE,TOUCHBIT /FALSE
FSET PIECE,TOUCHBIT
RANDOM 100
LESS? 30,STACK /FALSE
PRINTI " The "
ICALL2 DPRINT,PIECE
PRINTR " notices your cloak and bows gracefully. ""Greetings, Lordship. It's been a long time between moves -- I'll bet you've got a great one planned!"""
.FUNCT PLAIN-MOVEMENT-F,RARG
ZERO? RARG \FALSE
EQUAL? RANK,1 \?PRD6
EQUAL? PRSO,P?NW,P?NE,P?NORTH /?CCL4
?PRD6: EQUAL? RANK,8 \?PRD9
EQUAL? PRSO,P?SW,P?SE,P?SOUTH /?CCL4
?PRD9: EQUAL? FILE,8 \?PRD12
EQUAL? PRSO,P?SE,P?NE,P?EAST /?CCL4
?PRD12: EQUAL? FILE,1 \?CND1
EQUAL? PRSO,P?SW,P?NW,P?WEST \?CND1
?CCL4: PRINTI "The world ends at a gray void in that direction."
CRLF
RFALSE
?CND1: EQUAL? PRSO,P?NW,P?NE,P?NORTH \?CND17
DEC 'RANK
?CND17: EQUAL? PRSO,P?SW,P?SE,P?SOUTH \?CND19
INC 'RANK
?CND19: EQUAL? PRSO,P?NE,P?SE,P?EAST \?CND21
INC 'FILE
?CND21: EQUAL? PRSO,P?NW,P?SW,P?WEST \?CND23
DEC 'FILE
?CND23: ICALL STORE,PLAIN-OFFSET,PLAIN-LOC
SUB RANK,1
MUL STACK,8
ADD STACK,FILE
SUB STACK,1 >PLAIN-LOC
ICALL UNSTORE,PLAIN-OFFSET,PLAIN-LOC
RETURN PLAIN
.SEGMENT "0"
.FUNCT PIECE-F,ARG,CNT
FSET? WINNER,BLACKBIT /?CTR2
FSET? WINNER,WHITEBIT \?CCL3
?CTR2: ZERO? TIME-STOPPED /?CCL8
SET 'P-CONT,-1
PRINTI "Seemingly frozen,"
ICALL2 TPRINT,WINNER
PRINTR " is unresponsive."
?CCL8: EQUAL? PRSA,V?WALK \?CCL10
EQUAL? PRSO,P?UP,P?OUT,P?IN /?CTR9
EQUAL? PRSO,P?DOWN \?CCL10
?CTR9: SET 'DIR-CNT,0
PRINT CANNOT-TRAVEL
ICALL1 STOP
RTRUE
?CCL10: EQUAL? PRSA,V?WALK \?PRD18
ZERO? P-WALK-DIR \?CCL16
?PRD18: EQUAL? PRSA,V?MOVE \?CTR15
EQUAL? PRSO,INTDIR /?CCL16
?CTR15: SET 'DIR-CNT,0
EQUAL? PRSA,V?WALK \?CCL25
CALL NOUN-USED?,PRSO,W?ONE
ZERO? STACK /?CCL25
PRINTI "[The proper way to ask"
ICALL2 TPRINT,WINNER
PRINTR " to move is simply to tell the direction(s), as in >CHARACTER, NW.NW]"
?CCL25: SET 'P-CONT,-1
PRINTR """You can tell me directions. That's it."""
?CCL16: EQUAL? HERE,PLAIN,CONSTRUCTION /?CCL29
SET 'P-CONT,-1
PRINTR """The terrain is strange and unfamiliar; I am too terrified to move!"""
?CCL29: EQUAL? DIR-CNT,7 \?CCL31
SET 'DIR-CNT,0
SET 'P-CONT,-1
PRINTR """Too many directions!"""
?CCL31: EQUAL? PRSA,V?MOVE \?CND32
CALL1 DIRECTION-CONVERSION >PRSO
?CND32: PUT PIECE-MOVE-TABLE,DIR-CNT,PRSO
IGRTR? 'DIR-CNT,1 \?CCL36
EQUAL? WINNER,WHITE-KNIGHT,BLACK-KNIGHT /?CCL36
SUB DIR-CNT,2
GET PIECE-MOVE-TABLE,STACK
EQUAL? PRSO,STACK /?CCL36
SET 'DIR-CNT,0
COPYT PIECE-MOVE-TABLE,0,16
PRINT CANNOT-TRAVEL
ICALL1 STOP
RTRUE
?CCL36: ZERO? P-CONT \?CTR40
ZERO? M-PTR /?CCL41
?CTR40: SET 'CLOCK-WAIT,TRUE-VALUE
RTRUE
?CCL41: SET 'DIR-CNT,0
ICALL1 MOVE-PIECE
RTRUE
?CCL3: EQUAL? PRSA,V?ENTER \?CCL45
EQUAL? PRSO,WHITE-CASTLE \?CCL45
CALL NOUN-USED?,WHITE-CASTLE,W?MAN
ZERO? STACK \?CCL45
PRINTR "Oddly, there doesn't seem to be any entrance."
?CCL45: EQUAL? PRSA,V?ENTER \?CCL50
EQUAL? PRSO,BLACK-KNIGHT,WHITE-KNIGHT \?CCL50
CALL NOUN-USED?,PRSO,W?HORSE
ZERO? STACK /?CCL50
PRINTR "The horse isn't large enough for two riders."
?CCL50: EQUAL? PRSA,V?MOVE \?CCL55
PRINTI "Perhaps you should tell"
ICALL1 TPRINT-PRSO
PRINTR " the direction(s)."
?CCL55: EQUAL? PRSA,V?GIVE \?CCL57
FSET? PRSO,TRYTAKEBIT /?CCL57
CALL FIND-IN,PRSO,TRYTAKEBIT
ZERO? STACK \?CCL57
FSET? PRSI,WHITEBIT /?CTR56
FSET? PRSI,BLACKBIT \?CCL57
?CTR56: ZERO? TIME-STOPPED /?CND64
ICALL PERFORM,V?TELL,PRSI
RTRUE
?CND64: MOVE PRSO,PRSI
PRINTI "The "
ICALL2 DPRINT,PRSI
PRINTI " takes"
ICALL1 TPRINT-PRSO
PRINTC 46
EQUAL? PRSO,PIGEON \?CCL68
CALL2 META-LOC,PERCH
EQUAL? HERE,STACK /?CCL68
EQUAL? HERE,OUBLIETTE \?CTR67
EQUAL? REMOVED-PERCH-LOC,OUBLIETTE /?CCL68
?CTR67: CALL2 PIECE-TAKES-PIGEON,PRSI
RSTACK
?CCL68: PRINTR " ""Your graciousness is not unappreciated, your Lordship."""
?CCL57: EQUAL? PRSA,V?ASK-FOR \FALSE
LOC PRSI
FSET? STACK,WHITEBIT /?CCL75
LOC PRSI
FSET? STACK,BLACKBIT \FALSE
?CCL75: ICALL PERFORM,V?TAKE,PRSI
RTRUE
.FUNCT PIECE-TAKES-PIGEON,PIECE,DO-CR
ASSIGNED? 'DO-CR /?CND1
SET 'DO-CR,TRUE-VALUE
?CND1: ICALL2 MOVE-TO-PERCH,PIECE
PRINTI " Instantly,"
EQUAL? PIECE,WHITE-CASTLE \?CCL5
PRINTI " the tower"
JUMP ?CND3
?CCL5: ICALL2 TPRINT,PIECE
?CND3: PRINTI " seems to grow more distant without moving. Within seconds,"
EQUAL? PIECE,WHITE-CASTLE \?CCL8
PRINTI " the tower"
JUMP ?CND6
?CCL8: ICALL2 TPRINT,PIECE
?CND6: PRINTI " is gone."
ZERO? DO-CR /TRUE
CRLF
RTRUE
.FUNCT MOVE-PIECE,CNT,DIR,NEW-RANK,NEW-FILE,NEW-LOC,X,OFFSET,BLOCK,?TMP1
SET 'NEW-RANK,RANK
SET 'NEW-FILE,FILE
SUB NEW-RANK,1
MUL STACK,8 >?TMP1
SUB NEW-FILE,1
ADD ?TMP1,STACK >NEW-LOC
SET 'CNT,0
?PRG1: GET PIECE-MOVE-TABLE,CNT >DIR
EQUAL? DIR,FALSE-VALUE /?REP2
EQUAL? DIR,P?NORTH,P?NE,P?NW \?CND5
DEC 'NEW-RANK
?CND5: EQUAL? DIR,P?EAST,P?NE,P?SE \?CND7
INC 'NEW-FILE
?CND7: EQUAL? DIR,P?SOUTH,P?SE,P?SW \?CND9
INC 'NEW-RANK
?CND9: EQUAL? DIR,P?WEST,P?SW,P?NW \?CND11
DEC 'NEW-FILE
?CND11: INC 'CNT
EQUAL? HERE,CONSTRUCTION \?CND13
EQUAL? WINNER,BLACK-KNIGHT,WHITE-KNIGHT /?CND13
CALL OBSTRUCTION,NEW-LOC,DIR
ZERO? STACK /?CND13
SET 'BLOCK,TRUE-VALUE
EQUAL? DIR,P?EAST \?CCL20
EQUAL? NEW-LOC,47 \?CCL20
PRINTI """Appearances deceive you -- such a move would send me off the edge of the world!"""
CRLF
JUMP ?REP2
?CCL20: PRINTI """My word! There appears to be a wall in the way!"""
CRLF
JUMP ?REP2
?CND13: SUB NEW-RANK,1
MUL STACK,8 >?TMP1
SUB NEW-FILE,1
ADD ?TMP1,STACK >NEW-LOC
GET PIECE-MOVE-TABLE,CNT
ZERO? STACK /?PRG1
EQUAL? WINNER,BLACK-KNIGHT,WHITE-KNIGHT /?PRG1
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC
ZERO? STACK /?PRG1
SET 'BLOCK,TRUE-VALUE
PRINTI """Alas, the path between here and there is not unobstructed."""
CRLF
?REP2: GET PIECE-MOVE-TABLE,0
CALL2 DIR-TO-STRING,STACK >DIR
COPYT PIECE-MOVE-TABLE,0,16
ZERO? BLOCK \TRUE
CALL ILLEGAL-MOVE?,NEW-LOC,NEW-RANK,NEW-FILE >X
EQUAL? X,M-FATAL \?CCL32
PRINTR """That land is occupied!"""
?CCL32: ZERO? X /?CCL34
PRINT CANNOT-TRAVEL
CALL1 STOP
RSTACK
?CCL34: GRTR? NEW-RANK,8 /?CTR35
GRTR? NEW-FILE,8 /?CTR35
LESS? NEW-RANK,1 /?CTR35
LESS? NEW-FILE,1 \?CCL36
?CTR35: PRINTI """You would have me plunge off the end of the world"
EQUAL? HERE,CONSTRUCTION \?CND41
PRINTI " -- or whatever passes for the end of the world in this forsaken badland"
?CND41: PRINTR "!"""
?CCL36: CALL2 TAKE-PIECE?,NEW-LOC
ZERO? STACK \FALSE
REMOVE WINNER
PRINTI """I'm off!"" The "
PRINTD WINNER
EQUAL? WINNER,WHITE-KNIGHT,BLACK-KNIGHT \?CCL47
PRINTI " and his steed jump high into the air and vanish! A moment later, you hear a proud whinny in the distance."
JUMP ?CND45
?CCL47: PRINTI " moves out of sight to the "
PRINT DIR
PRINTC 46
?CND45: CRLF
EQUAL? WINNER,WHITE-PAWN \?CCL50
EQUAL? HERE,PLAIN \?CCL50
LESS? NEW-LOC,8 \?CCL50
ICALL ROB,WHITE-PAWN,WHITE-QUEEN
SET 'WINNER,WHITE-QUEEN
JUMP ?CND48
?CCL50: EQUAL? WINNER,BLACK-PAWN \?CND48
EQUAL? HERE,PLAIN \?CND48
GRTR? NEW-LOC,55 \?CND48
ICALL ROB,BLACK-PAWN,BLACK-QUEEN
SET 'WINNER,BLACK-QUEEN
?CND48: EQUAL? HERE,PLAIN \?CCL60
SET 'OFFSET,PLAIN-OFFSET
JUMP ?CND58
?CCL60: SET 'OFFSET,CONSTRUCTION-OFFSET
?CND58: ADD NEW-LOC,OFFSET
ICALL PIECE-SNARF,STACK,WINNER
CALL PUT-IN-STORAGE,OFFSET,WINNER,NEW-LOC
RSTACK
.FUNCT DIR-TO-STRING,DIR
EQUAL? DIR,P?UP \?CCL3
RETURN STR?912
?CCL3: EQUAL? DIR,P?DOWN \?CCL5
RETURN STR?913
?CCL5: EQUAL? DIR,P?NORTH \?CCL7
RETURN STR?198
?CCL7: EQUAL? DIR,P?NE \?CCL9
RETURN STR?828
?CCL9: EQUAL? DIR,P?EAST \?CCL11
RETURN STR?827
?CCL11: EQUAL? DIR,P?SE \?CCL13
RETURN STR?263
?CCL13: EQUAL? DIR,P?SOUTH \?CCL15
RETURN STR?199
?CCL15: EQUAL? DIR,P?SW \?CCL17
RETURN STR?826
?CCL17: EQUAL? DIR,P?WEST \?CCL19
RETURN STR?824
?CCL19: EQUAL? DIR,P?NW \FALSE
RETURN STR?825
.FUNCT PIECE-SNARF,NEW-LOC,SNARFER,OBJ,CNT,TOOK-PIGEON
?PRG1: LESS? CNT,STORAGE-TABLE-LENGTH \?REP2
GET STORAGE-TABLE,CNT
EQUAL? STACK,NEW-LOC \?CND3
ADD CNT,1
GET STORAGE-TABLE,STACK >OBJ
FSET? OBJ,TAKEBIT \?CND3
FSET? OBJ,TRYTAKEBIT /?CND3
CALL FIND-IN,OBJ,TRYTAKEBIT
ZERO? STACK \?CND3
EQUAL? OBJ,PIGEON \?CND12
SET 'TOOK-PIGEON,TRUE-VALUE
?CND12: MOVE OBJ,SNARFER
PUT STORAGE-TABLE,CNT,0
ADD CNT,1
PUT STORAGE-TABLE,STACK,0
?CND3: ADD CNT,2 >CNT
JUMP ?PRG1
?REP2: ZERO? TOOK-PIGEON /FALSE
CALL2 MOVE-TO-PERCH,SNARFER
RSTACK
.FUNCT TAKE-PIECE?,NEW-LOC,TAKEE,VAL
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC >TAKEE
ZERO? TAKEE \?CCL3
RETURN VAL
?CCL3: FSET? TAKEE,WHITEBIT \?PRD7
FSET? WINNER,WHITEBIT /?CTR4
?PRD7: FSET? TAKEE,BLACKBIT \?CCL5
FSET? WINNER,BLACKBIT \?CCL5
?CTR4: PRINTI """I cannot attack one of my own side!"""
CRLF
SET 'VAL,TRUE-VALUE
RETURN VAL
?CCL5: ICALL PIECE-AT-NEW-LOC?,NEW-LOC,TRUE-VALUE
RETURN VAL
.FUNCT ILLEGAL-MOVE?,NEW-LOC,NEW-RANK,NEW-FILE,TAKEE,OLD-LOC
EQUAL? HERE,PLAIN \?CCL3
SET 'OLD-LOC,PLAIN-LOC
JUMP ?CND1
?CCL3: SET 'OLD-LOC,CONSTRUCTION-LOC
?CND1: EQUAL? WINNER,WHITE-KNIGHT,BLACK-KNIGHT \?CCL6
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,6,10,15 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,17,-6,-10 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,-15,-17 /FALSE
RTRUE
?CCL6: EQUAL? WINNER,WHITE-KING,BLACK-KING \?CCL14
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,1,7,8 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,9,-1,-7 /FALSE
SUB OLD-LOC,NEW-LOC
EQUAL? STACK,-8,-9 /FALSE
RTRUE
?CCL14: EQUAL? WINNER,BLACK-BISHOP \?CCL22
GRTR? OLD-LOC,NEW-LOC \?CCL25
SUB OLD-LOC,NEW-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB OLD-LOC,NEW-LOC
MOD STACK,9
ZERO? STACK /FALSE
RTRUE
?CCL25: SUB NEW-LOC,OLD-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB NEW-LOC,OLD-LOC
MOD STACK,9
ZERO? STACK /FALSE
RTRUE
?CCL22: EQUAL? WINNER,WHITE-CASTLE \?CCL37
EQUAL? RANK,NEW-RANK /FALSE
EQUAL? FILE,NEW-FILE /FALSE
RTRUE
?CCL37: EQUAL? WINNER,WHITE-QUEEN,BLACK-QUEEN \?CCL44
EQUAL? RANK,NEW-RANK /FALSE
EQUAL? FILE,NEW-FILE /FALSE
GRTR? NEW-LOC,OLD-LOC \?CCL51
SUB NEW-LOC,OLD-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB NEW-LOC,OLD-LOC
MOD STACK,9
ZERO? STACK /FALSE
?CCL51: GRTR? OLD-LOC,NEW-LOC \TRUE
SUB OLD-LOC,NEW-LOC
MOD STACK,7
ZERO? STACK /FALSE
SUB OLD-LOC,NEW-LOC
MOD STACK,9
ZERO? STACK /FALSE
RTRUE
?CCL44: EQUAL? WINNER,BLACK-PAWN \?CCL63
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC >TAKEE
EQUAL? OLD-LOC,14 \?CCL66
EQUAL? NEW-LOC,30 \?CCL66
ZERO? TAKEE /FALSE
RETURN 2
?CCL66: SUB NEW-LOC,OLD-LOC
EQUAL? STACK,7,9 \?CCL75
ZERO? TAKEE \FALSE
RTRUE
?CCL75: SUB NEW-LOC,OLD-LOC
EQUAL? STACK,8 \TRUE
ZERO? TAKEE /FALSE
RETURN 2
?CCL63: EQUAL? WINNER,WHITE-PAWN \?CCL87
CALL2 PIECE-AT-NEW-LOC?,NEW-LOC >TAKEE
EQUAL? OLD-LOC,49 \?CCL90
EQUAL? NEW-LOC,33 \?CCL90
ZERO? TAKEE /FALSE
RETURN 2
?CCL90: SUB OLD-LOC,NEW-LOC
EQUAL? STACK,7,9 \?CCL99
ZERO? TAKEE \FALSE
RTRUE
?CCL99: SUB OLD-LOC,NEW-LOC
EQUAL? STACK,8 \TRUE
ZERO? TAKEE /FALSE
RETURN 2
?CCL87: PRINTR "Bug7"
.FUNCT PIECE-AT-NEW-LOC?,NEW-LOC,TAKE-PIECE,CNT,TAKEE
EQUAL? HERE,CONSTRUCTION \?CCL3
PUSH CONSTRUCTION-OFFSET
JUMP ?CND1
?CCL3: PUSH PLAIN-OFFSET
?CND1: ADD NEW-LOC,STACK >NEW-LOC
?PRG4: GET STORAGE-TABLE,CNT
EQUAL? NEW-LOC,STACK \?CND6
ADD CNT,1
GET STORAGE-TABLE,STACK >TAKEE
FSET? TAKEE,WHITEBIT /?CCL9
FSET? TAKEE,BLACKBIT \?CND6
?CCL9: ZERO? TAKE-PIECE /?REP5
ICALL ROB,TAKEE,WINNER
PUT STORAGE-TABLE,CNT,0
JUMP ?REP5
?CND6: ADD CNT,2 >CNT
LESS? CNT,STORAGE-TABLE-LENGTH /?PRG4
?REP5: ZERO? TAKEE /FALSE
FSET? TAKEE,WHITEBIT /?CTR19
FSET? TAKEE,BLACKBIT \FALSE
?CTR19: RETURN TAKEE
.FUNCT OBSTRUCTION,L,DIR,CALLED-BY-EXIT-F,CHANGE
EQUAL? DIR,P?NORTH \?CCL3
INTBL? L,NORTH-EXITS,11 /?CTR2
ADD L,100
INTBL? STACK,NORTH-EXITS,11 \?CCL3
?CTR2: SET 'CHANGE,-8
JUMP ?CND1
?CCL3: EQUAL? DIR,P?NE \?CCL9
INTBL? L,NE-EXITS,17 \?CCL9
SET 'CHANGE,-7
JUMP ?CND1
?CCL9: EQUAL? DIR,P?EAST \?CCL13
EQUAL? L,47 \?CCL16
ZERO? CALLED-BY-EXIT-F /?CCL16
SET 'CHANGE,100
JUMP ?CND1
?CCL16: INTBL? L,EAST-EXITS,15 \?CND1
SET 'CHANGE,1
JUMP ?CND1
?CCL13: EQUAL? DIR,P?SE \?CCL21
INTBL? L,SE-EXITS,7 /?CTR20
ADD L,100
INTBL? STACK,SE-EXITS,7 \?CCL21
?CTR20: SET 'CHANGE,9
JUMP ?CND1
?CCL21: EQUAL? DIR,P?SOUTH \?CCL27
ADD L,8
INTBL? STACK,NORTH-EXITS,11 /?CTR26
ADD L,108
INTBL? STACK,NORTH-EXITS,11 \?CCL27
?CTR26: SET 'CHANGE,8
JUMP ?CND1
?CCL27: EQUAL? DIR,P?SW \?CCL33
ADD L,7
INTBL? STACK,NE-EXITS,17 \?CCL33
SET 'CHANGE,7
JUMP ?CND1
?CCL33: EQUAL? DIR,P?WEST \?CCL37
SUB L,1
INTBL? STACK,EAST-EXITS,15 \?CCL37
SET 'CHANGE,-1
JUMP ?CND1
?CCL37: EQUAL? DIR,P?NW \?CND1
SUB L,9
INTBL? STACK,SE-EXITS,7 /?CCL40
ADD L,91
INTBL? STACK,SE-EXITS,7 \?CND1
?CCL40: SET 'CHANGE,-9
?CND1: ZERO? CALLED-BY-EXIT-F /?CCL47
RETURN CHANGE
?CCL47: ZERO? CHANGE /TRUE
RFALSE
.ENDSEG
.SEGMENT "LOWER"
.FUNCT CONSTRUCTION-ENTER-F,RARG
ZERO? RARG \FALSE
SET 'CONSTRUCTION-LOC,47
RETURN CONSTRUCTION
.SEGMENT "0"
.FUNCT HAMMER-F
EQUAL? PRSA,V?KILL \?CCL3
EQUAL? PRSI,HAMMER \?CCL3
ICALL PERFORM,V?MUNG,PRSO,HAMMER
RTRUE
?CCL3: EQUAL? PRSA,V?MUNG \FALSE
EQUAL? PRSI,HAMMER \FALSE
FSET? PRSO,ANIMATEDBIT \FALSE
PRINTI "Fortunately,"
ICALL1 TPRINT-PRSO
PRINTR " evades your blow."
.ENDSEG
.SEGMENT "LOWER"
.FUNCT CONSTRUCTION-F,RARG,CNT
EQUAL? RARG,M-LOOK \?CCL3
INTBL? CONSTRUCTION-LOC,NORTH-EXITS,11 \?CND4
INC 'CNT
?CND4: INTBL? CONSTRUCTION-LOC,NE-EXITS,17 \?CND6
INC 'CNT
?CND6: INTBL? CONSTRUCTION-LOC,EAST-EXITS,15 \?CND8
INC 'CNT
?CND8: INTBL? CONSTRUCTION-LOC,SE-EXITS,7 \?CND10
INC 'CNT
?CND10: ADD CONSTRUCTION-LOC,8
INTBL? STACK,NORTH-EXITS,11 \?CND12
INC 'CNT
?CND12: ADD CONSTRUCTION-LOC,7
INTBL? STACK,NE-EXITS,17 \?CND14
INC 'CNT
?CND14: SUB CONSTRUCTION-LOC,1
INTBL? STACK,EAST-EXITS,15 \?CND16
INC 'CNT
?CND16: SUB CONSTRUCTION-LOC,9
INTBL? STACK,SE-EXITS,7 \?CND18
INC 'CNT
?CND18: PRINTI "You are in an abandoned underground construction site, roughly octagonal in shape. "
GRTR? CNT,0 \?CND20
PRINTI "There "
EQUAL? CNT,1 \?CCL24
PRINTI "is an exit"
JUMP ?CND22
?CCL24: PRINTI "are exits"
?CND22: PRINTI " to the "
INTBL? CONSTRUCTION-LOC,NORTH-EXITS,11 \?CND25
PRINTI "north"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND25: INTBL? CONSTRUCTION-LOC,NE-EXITS,17 \?CND27
PRINTI "northeast"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND27: INTBL? CONSTRUCTION-LOC,EAST-EXITS,15 \?CND29
PRINTI "east"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND29: INTBL? CONSTRUCTION-LOC,SE-EXITS,7 \?CND31
PRINTI "southeast"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND31: ADD CONSTRUCTION-LOC,8
INTBL? STACK,NORTH-EXITS,11 \?CND33
PRINTI "south"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND33: ADD CONSTRUCTION-LOC,7
INTBL? STACK,NE-EXITS,17 \?CND35
PRINTI "southwest"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND35: SUB CONSTRUCTION-LOC,1
INTBL? STACK,EAST-EXITS,15 \?CND37
PRINTI "west"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND37: SUB CONSTRUCTION-LOC,9
INTBL? STACK,SE-EXITS,7 \?CND39
PRINTI "northwest"
DEC 'CNT
ICALL2 AND-OR-COMMA,CNT
?CND39: PRINTI ". "
?CND20: EQUAL? CONSTRUCTION-LOC,47 \?CND41
PRINTI "Also, a heavily used passage leads east. "
?CND41: PRINTI "Engraved on the wall is the number "
PRINTN CONSTRUCTION-LOC
PRINTC 46
RTRUE
?CCL3: EQUAL? RARG,M-ENTER \FALSE
DIV CONSTRUCTION-LOC,8
ADD STACK,1 >RANK
MOD CONSTRUCTION-LOC,8
ADD STACK,1 >FILE
CALL UNSTORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
RSTACK
.FUNCT AND-OR-COMMA,CNT
EQUAL? CNT,1 \?CCL3
PRINTI " and "
RTRUE
?CCL3: GRTR? CNT,1 \FALSE
PRINTI ", "
RTRUE
.FUNCT CONSTRUCTION-MOVEMENT-F,RARG,CHANGE
ZERO? RARG \FALSE
ICALL STORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
CALL OBSTRUCTION,CONSTRUCTION-LOC,PRSO,TRUE-VALUE >CHANGE
EQUAL? CHANGE,100 \?CND3
RETURN FIELD-OFFICE
?CND3: DIV CONSTRUCTION-LOC,8
ADD STACK,1 >RANK
MOD CONSTRUCTION-LOC,8
ADD STACK,1 >FILE
ZERO? CHANGE \?CCL7
ICALL UNSTORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
ICALL1 CANT-GO
RFALSE
?CCL7: ADD CONSTRUCTION-LOC,CHANGE >CONSTRUCTION-LOC
ICALL UNSTORE,CONSTRUCTION-OFFSET,CONSTRUCTION-LOC
RETURN CONSTRUCTION
.SEGMENT "0"
.FUNCT REMOVE-ANY-PIECE,L,TAKER,TAKEE,CNT
?PRG1: LESS? CNT,STORAGE-TABLE-LENGTH \TRUE
GET STORAGE-TABLE,CNT
EQUAL? STACK,L \?CND3
ADD CNT,1
GET STORAGE-TABLE,STACK >TAKEE
FSET? TAKEE,WHITEBIT /?CCL8
FSET? TAKEE,BLACKBIT \?CND3
?CCL8: ICALL ROB,TAKEE,TAKER
PUT STORAGE-TABLE,CNT,0
ADD CNT,1
PUT STORAGE-TABLE,STACK,0
?CND3: ADD CNT,2 >CNT
JUMP ?PRG1
.FUNCT PUT-IN-STORAGE,OFFSET,OBJ,L,CNT
?PRG1: GET STORAGE-TABLE,CNT
ZERO? STACK \?CCL5
ADD L,OFFSET
PUT STORAGE-TABLE,CNT,STACK
ADD CNT,1
PUT STORAGE-TABLE,STACK,OBJ
RTRUE
?CCL5: ADD CNT,2 >CNT
JUMP ?PRG1
.ENDSEG
.SEGMENT "VILLAGE"
.SEGMENT "FENSHIRE"
.SEGMENT "LOWER"
.FUNCT STORE,OFFSET,L,RM,CNT,F,N
ASSIGNED? 'RM /?CND1
SET 'RM,HERE
?CND1: FIRST? RM >F /?PRG4
?PRG4: ZERO? F /TRUE
NEXT? F >N /?CND6
?CND6: EQUAL? F,PROTAGONIST /?CND10
?PRG12: EQUAL? F,JESTER \?CCL16
ICALL1 REMOVE-J
JUMP ?CND10
?CCL16: GET STORAGE-TABLE,CNT
ZERO? STACK \?CCL18
ADD L,OFFSET
PUT STORAGE-TABLE,CNT,STACK
ADD CNT,1
PUT STORAGE-TABLE,STACK,F
ADD CNT,2 >CNT
REMOVE F
?CND10: SET 'F,N
JUMP ?PRG4
?CCL18: ADD CNT,2 >CNT
JUMP ?PRG12
.FUNCT UNSTORE,OFFSET,L,RM,CNT,?TMP1
ASSIGNED? 'RM /?PRG3
SET 'RM,HERE
?PRG3: LESS? CNT,STORAGE-TABLE-LENGTH \TRUE
GET STORAGE-TABLE,CNT >?TMP1
ADD L,OFFSET
EQUAL? ?TMP1,STACK \?CND5
ADD CNT,1
GET STORAGE-TABLE,STACK
MOVE STACK,RM
PUT STORAGE-TABLE,CNT,0
ADD CNT,1
PUT STORAGE-TABLE,STACK,0
?CND5: ADD CNT,2 >CNT
JUMP ?PRG3
.ENDSEG
.ENDI