beyondzork/macros.zil

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>)>>