278 lines
6.7 KiB
Plaintext
278 lines
6.7 KiB
Plaintext
"MACROS for BEYOND ZORK:
|
|
Copyright (C)1987 Infocom, Inc. All rights reserved."
|
|
|
|
<SETG C-ENABLED? 0>
|
|
<SETG C-ENABLED 1>
|
|
<SETG C-DISABLED 0>
|
|
|
|
<TELL-TOKENS (CR CRLF) <CRLF>
|
|
(N NUM) * <PRINTN .X>
|
|
(D DESC) * <DPRINT .X>
|
|
(A AN) * <PRINTA .X>
|
|
(AO ANO) <PRINTA>
|
|
(CA CAN) * <PRINTCA .X>
|
|
(CAO CANO) * <PRINTCA>
|
|
(CHAR CHR C) * <PRINTC .X>
|
|
B * <PRINTB .X>
|
|
THE * <THE-PRINT .X>
|
|
CTHE * <CTHE-PRINT .X>
|
|
THEO <THE-PRINT>
|
|
CTHEO <CTHE-PRINT>
|
|
THEI <THEI-PRINT>
|
|
CTHEI <CTHEI-PRINT> >
|
|
|
|
<DEFMAC VERB? ("ARGS" ATMS)
|
|
<MULTIFROB PRSA .ATMS>>
|
|
|
|
<DEFMAC PRSO? ("ARGS" ATMS)
|
|
<MULTIFROB PRSO .ATMS>>
|
|
|
|
<DEFMAC PRSI? ("ARGS" ATMS)
|
|
<MULTIFROB PRSI .ATMS>>
|
|
|
|
<DEFMAC HERE? ("ARGS" ATMS)
|
|
<MULTIFROB HERE .ATMS>>
|
|
|
|
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (LL (T)) (L .LL) ATM)
|
|
<REPEAT ()
|
|
<COND (<EMPTY? .ATMS>
|
|
<RETURN!- <COND (<LENGTH? .OO 1>
|
|
<ERROR .X>)
|
|
(<LENGTH? .OO 2>
|
|
<NTH .OO 2>)
|
|
(ELSE
|
|
<CHTYPE .OO FORM>)>>)>
|
|
<REPEAT ()
|
|
<COND (<EMPTY? .ATMS>
|
|
<RETURN!->)>
|
|
<SET ATM <NTH .ATMS 1>>
|
|
<SET L <REST <PUTREST
|
|
.L
|
|
(<COND (<TYPE? .ATM ATOM>
|
|
<CHTYPE <COND (<==? .X PRSA>
|
|
<PARSE
|
|
<STRING "V?"
|
|
<SPNAME .ATM>>>)
|
|
(T .ATM)> GVAL>)
|
|
(ELSE .ATM)>)>>>
|
|
<SET ATMS <REST .ATMS>>
|
|
<COND (<==? <LENGTH .LL> 4>
|
|
<RETURN!->)>>
|
|
<SET O <REST <PUTREST .O
|
|
(<FORM EQUAL? <CHTYPE .X GVAL> !<REST .LL>>)>>>
|
|
<SET LL (T)>
|
|
<SET L .LL>>>
|
|
|
|
; <DEFMAC BSET ('OBJ "ARGS" BITS)
|
|
<MULTIBITS FSET .OBJ .BITS>>
|
|
|
|
; <DEFMAC BCLEAR ('OBJ "ARGS" BITS)
|
|
<MULTIBITS FCLEAR .OBJ .BITS>>
|
|
|
|
; <DEFMAC BSET? ('OBJ "ARGS" BITS)
|
|
<MULTIBITS FSET? .OBJ .BITS>>
|
|
|
|
; <DEFINE MULTIBITS (X OBJ ATMS "AUX" (O ()) ATM)
|
|
<REPEAT ()
|
|
<COND (<EMPTY? .ATMS>
|
|
<RETURN!- <COND (<LENGTH? .O 1>
|
|
<NTH .O 1>)
|
|
(<==? .X FSET?>
|
|
<FORM OR !.O>)
|
|
(ELSE
|
|
<FORM PROG () !.O>)>>)>
|
|
<SET ATM <NTH .ATMS 1>>
|
|
<SET ATMS <REST .ATMS>>
|
|
<SET O
|
|
(<FORM .X
|
|
.OBJ
|
|
<COND (<TYPE? .ATM FORM>
|
|
.ATM)
|
|
(ELSE
|
|
<FORM GVAL .ATM>)>>
|
|
!.O)>>>
|
|
|
|
<DEFMAC RFATAL ()
|
|
'<PROG () <PUSH 2> <RSTACK>>>
|
|
|
|
<DEFMAC PROB ('BASE)
|
|
<FORM NOT <FORM L? .BASE '<RANDOM 100>>>>
|
|
|
|
<DEFMAC ENABLE ('INT)
|
|
<FORM PUT .INT ,C-ENABLED? 1>>
|
|
|
|
<DEFMAC DISABLE ('INT)
|
|
<FORM PUT .INT ,C-ENABLED? 0>>
|
|
|
|
<DEFMAC GET-REXIT-ROOM ('PT)
|
|
<FORM GET .PT ',REXIT>>
|
|
|
|
<DEFMAC GET-DOOR-OBJ ('PT)
|
|
<FORM GET .PT ',DEXITOBJ>>
|
|
|
|
<DEFMAC GET/B ('TBL 'PTR)
|
|
<FORM GET .TBL .PTR>>
|
|
|
|
<DEFMAC RMGL-SIZE ('TBL)
|
|
<FORM - <FORM / <FORM PTSIZE .TBL> 2> 1>>
|
|
|
|
<DEFMAC MAKE ('OBJ 'FLAG)
|
|
<FORM FSET .OBJ .FLAG>>
|
|
|
|
<DEFMAC UNMAKE ('OBJ 'FLAG)
|
|
<FORM FCLEAR .OBJ .FLAG>>
|
|
|
|
<DEFMAC IS? ('OBJ 'FLAG)
|
|
<FORM FSET? .OBJ .FLAG>>
|
|
|
|
<DEFMAC T? ('TERM)
|
|
<FORM NOT <FORM ZERO? .TERM>>>
|
|
|
|
<DEFMAC ABS ('NUM)
|
|
<FORM COND (<FORM L? .NUM 0>
|
|
<FORM - 0 .NUM>)
|
|
(T
|
|
.NUM)>>
|
|
|
|
; <DEFMAC QUOTE? ()
|
|
<FORM COND (<FORM NOT <FORM EQUAL?
|
|
<CHTYPE WINNER GVAL>
|
|
<CHTYPE PLAYER GVAL>>>
|
|
<FORM PRINTC 34>)>>
|
|
|
|
<DEFMAC THIS-PRSO? ()
|
|
<FORM ZERO? <CHTYPE NOW-PRSI? GVAL>>>
|
|
|
|
<DEFMAC THIS-PRSI? ()
|
|
<FORM NOT <FORM ZERO? <CHTYPE NOW-PRSI? GVAL>>>>
|
|
|
|
<DEFMAC TOUCHING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE TOUCHVERBS GVAL>
|
|
<CHTYPE NTOUCHES GVAL>>>
|
|
|
|
<DEFMAC MUST-HAVE? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE HAVEVERBS GVAL>
|
|
<CHTYPE NHAVES GVAL>>>
|
|
|
|
<DEFMAC PUTTING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE PUTVERBS GVAL>
|
|
<CHTYPE NUMPUTS GVAL>>>
|
|
|
|
<DEFMAC MOVING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE MOVEVERBS GVAL>
|
|
<CHTYPE NMVERBS GVAL>>>
|
|
|
|
<DEFMAC HURTING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE HURTVERBS GVAL>
|
|
<CHTYPE NHVERBS GVAL>>>
|
|
|
|
<DEFMAC SEEING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE SEEVERBS GVAL>
|
|
<CHTYPE NSVERBS GVAL>>>
|
|
|
|
<DEFMAC GAMEVERB? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE GAME-VERBS GVAL>
|
|
<CHTYPE NGVERBS GVAL>>>
|
|
|
|
<DEFMAC TALKING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE TALKVERBS GVAL>
|
|
<CHTYPE NTVERBS GVAL>>>
|
|
|
|
<DEFMAC ENTERING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE E-VERBS GVAL>
|
|
<CHTYPE ENTER-VERBS GVAL>>>
|
|
|
|
<DEFMAC CLIMBING-ON? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE E-VERBS GVAL>
|
|
<CHTYPE CLIMB-ON-VERBS GVAL>>>
|
|
|
|
<DEFMAC EXITING? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE X-VERBS GVAL>
|
|
<CHTYPE EXIT-VERBS GVAL>>>
|
|
|
|
<DEFMAC CLIMBING-OFF? ()
|
|
<FORM INTBL? <CHTYPE PRSA GVAL> <CHTYPE X-VERBS GVAL>
|
|
<CHTYPE CLIMB-DOWN-VERBS GVAL>>>
|
|
|
|
<DEFINE PSEUDO (L)
|
|
(<>
|
|
<MAPF ,PLTABLE
|
|
<FUNCTION (OBJ)
|
|
<SET OBJ <EVAL .OBJ>>
|
|
<COND (<N==? <LENGTH .OBJ> 3>
|
|
<ERROR BAD-THING .OBJ>)>
|
|
<MAPRET <COND (<NTH .OBJ 2>
|
|
<VOC <SPNAME <NTH .OBJ 2>> NOUN>)>
|
|
<COND (<NTH .OBJ 1>
|
|
<VOC <SPNAME <NTH .OBJ 1>> ADJECTIVE>)>
|
|
<3 .OBJ>>>
|
|
<REST .L>>)>
|
|
|
|
<PUTPROP THINGS PROPSPEC PSEUDO>
|
|
|
|
<DEFMAC LSB ('WRD)
|
|
<FORM BAND .WRD 127>>
|
|
|
|
<DEFMAC MSB ('WRD)
|
|
<FORM BAND .WRD #2 1111111100000000>>
|
|
|
|
<DEFMAC PERCENT ('X 'Y)
|
|
<FORM / <FORM * .X .Y> 100>>
|
|
|
|
<DEFMAC RATIO ('X 'Y)
|
|
<FORM / <FORM * .X 100> .Y>>
|
|
|
|
<DEFMAC WINDOW ('BITS)
|
|
<FORM SETG NEW-DBOX <FORM BOR <CHTYPE NEW-DBOX GVAL> .BITS>>>
|
|
|
|
"*** NEW EXIT MACROS ***"
|
|
|
|
<CONSTANT XTYPE 0> "Exit type: MSB identifies type, LSB specifies length."
|
|
<CONSTANT XROOM 1> "Exit room/function/string (depending on XTYPE)."
|
|
<CONSTANT XDATA 2> "Auxiliary exit data (not used in all types of exits)."
|
|
|
|
<CONSTANT NO-EXIT #2 000100000000>
|
|
<CONSTANT CONNECT #2 001000000000>
|
|
<CONSTANT SCONNECT #2 001100000000>
|
|
<CONSTANT FCONNECT #2 010000000000>
|
|
<CONSTANT DCONNECT #2 010100000000>
|
|
<CONSTANT SORRY-EXIT #2 011000000000>
|
|
<CONSTANT X-EXIT #2 011100000000>
|
|
<CONSTANT SHADOW-EXIT #2 100000000000>
|
|
<CONSTANT FSORRY-EXIT #2 100100000000>
|
|
|
|
<DEFMAC WALL ()
|
|
<FORM TABLE ,NO-EXIT 0>>
|
|
|
|
<DEFMAC SHADOW ('ROOM "OPT" ('LEN 1))
|
|
<FORM TABLE <+ .LEN ,SHADOW-EXIT> .ROOM>>
|
|
|
|
<DEFMAC TO ('ROOM "OPT" ('LEN 1))
|
|
<FORM TABLE <+ .LEN ,CONNECT> .ROOM>>
|
|
|
|
<DEFMAC CROSS-TO ('ROOM "OPT" ('LEN 1))
|
|
<FORM TABLE <+ .LEN ,X-EXIT> .ROOM>>
|
|
|
|
<DEFMAC SAY-TO ('ROOM 'STR "OPT" ('LEN 1))
|
|
<FORM TABLE <+ .LEN ,SCONNECT> .ROOM .STR>>
|
|
|
|
<DEFMAC THRU ('DOOR 'ROOM "OPT" ('LEN 1))
|
|
<FORM TABLE <+ .LEN ,DCONNECT> .ROOM .DOOR>>
|
|
|
|
<DEFMAC PER ('FCN "OPT" ('LEN 0))
|
|
<FORM TABLE <+ .LEN ,FCONNECT> .FCN>>
|
|
|
|
<DEFMAC SORRY ('STR)
|
|
<FORM TABLE ,SORRY-EXIT .STR>>
|
|
|
|
<DEFMAC FSORRY ('FCN "OPT" ('ARG <>))
|
|
<FORM TABLE ,FSORRY-EXIT .FCN .ARG>>
|
|
|
|
; <DEFMAC WT? ('PTR BIT "OPT" (B1 5))
|
|
<COND (<G? .B1 4>
|
|
<FORM BTST <FORM GETB .PTR ,P-PSOFF> .BIT>)
|
|
(T
|
|
<FORM DO-WT? .PTR .BIT .B1>)>>
|
|
|
|
|