moonmist/macros.zil
2019-04-14 13:36:31 -04:00

237 lines
6.2 KiB
Plaintext

"MACROS for MOONMIST
Copyright (c) 1986 Infocom, Inc. All rights reserved."
;<TELL-TOKENS CR <CRLF>
N * <PRINTN .X>
C * <PRINTC .X>
D * <PRINTD .X>
A * <PRINTA .X>
FN <PRINT-NAME ,FIRST-NAME>
LN <PRINT-NAME ,LAST-NAME>
TN <TITLE-NAME>
THE * <PRINTT .X>
CTHE * <START-SENTENCE .X>
CHE * *:ATOM <HE-SHE-IT .X 1 .Y>
CHE * <HE-SHE-IT .X 1>
HE * *:ATOM <HE-SHE-IT .X 0 .Y>
HE * <HE-SHE-IT .X>
V * * <HE-SHE-IT .X -1 .Y>
HIM * <HIM-HER-IT .X>
HIS * <HIM-HER-IT .X 0 T>
CHIS * <HIM-HER-IT .X 1 T>>
<DEFMAC VERB? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L
(<CHTYPE <PARSE <STRING "V?"<SPNAME .ATM>>> GVAL>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSA !.L> !.O)>
<SET L ()>>>
<DEFMAC DOBJ? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L (<COND (<TYPE? .ATM ATOM>
<CHTYPE .ATM GVAL>)
(T .ATM)>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSO !.L> !.O)>
<SET L ()>>>
<DEFMAC IOBJ? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L (<COND (<TYPE? .ATM ATOM>
<CHTYPE .ATM GVAL>)
(T .ATM)>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSI !.L> !.O)>
<SET L ()>>>
<DEFMAC RFATAL ()
'<PROG () <PUSH 2> <RSTACK>>>
<DEFMAC PROB ('BASE?)
<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>
<DEFMAC TELL ("ARGS" A)
<FORM PROG ()
!<MAPF ,LIST
<FUNCTION ("AUX" E P O)
<COND (<EMPTY? .A> <MAPSTOP>)
(<SET E <NTH .A 1>>
<SET A <REST .A>>)>
<COND (<TYPE? .E ATOM>
<COND (<OR <=? <SET P <SPNAME .E>>
"CRLF">
<=? .P "CR">>
<MAPRET '<CRLF>>)
(<=? .P "FN">
<MAPRET '<PRINT-NAME ,FIRST-NAME>>)
(<=? .P "LN">
<MAPRET '<PRINT-NAME ,LAST-NAME>>)
(<=? .P "TN">
<MAPRET '<TITLE-NAME>>)
(<EMPTY? .A>
<ERROR INDICATOR-AT-END? .E>)
(ELSE
<SET O <NTH .A 1>>
<SET A <REST .A>>
<COND (<OR <=? <SET P <SPNAME .E>>
"DESC">
<=? .P "D">
<=? .P "OBJ">
<=? .P "O">>
<MAPRET <FORM PRINTD .O>>)
(<OR <=? .P "A">
<=? .P "AN">>
<MAPRET <FORM PRINTA .O>>)
(<OR ;<=? .P "T">
<=? .P "THE">>
<MAPRET <FORM PRINTT .O>>)
(<OR ;<=? .P "CT">
<=? .P "CTHE">>
<MAPRET <FORM START-SENTENCE .O>>)
(<=? .P "CHE">
<COND (<OR <EMPTY? .A>
<NOT <TYPE? <NTH .A 1> ATOM>>>
<MAPRET <FORM HE-SHE-IT .O T>>)
(T
<SET P <SPNAME <NTH .A 1>>>
<SET A <REST .A>>
<MAPRET <FORM HE-SHE-IT .O T .P>>)>)
(<=? .P "HE">
<COND (<OR <EMPTY? .A>
<NOT <TYPE? <NTH .A 1> ATOM>>>
<MAPRET <FORM HE-SHE-IT .O>>)
(T
<SET P <SPNAME <NTH .A 1>>>
<SET A <REST .A>>
<MAPRET <FORM HE-SHE-IT .O 0 .P>>)>)
(<=? .P "V">
<SET P <SPNAME <NTH .A 1>>>
<SET A <REST .A>>
<MAPRET <FORM HE-SHE-IT .O -1 .P>>)
(<=? .P "HIM">
<MAPRET <FORM HIM-HER-IT .O>>)
;(<=? .P "CHIM">
<MAPRET <FORM HIM-HER-IT .O T>>)
(<=? .P "HIS">
<MAPRET <FORM HIM-HER-IT .O '<> T>>)
(<=? .P "CHIS">
<MAPRET <FORM HIM-HER-IT .O T T>>)
(<OR <=? .P "NUM">
<=? .P "N">>
<MAPRET <FORM PRINTN .O>>)
(<OR ;<=? .P "CHAR">
;<=? .P "CHR">
<=? .P "C">>
<MAPRET <FORM PRINTC <ASCII .O>>>)
(ELSE
<MAPRET <FORM PRINT <FORM GETP .O .E>>>)>)>)
(<TYPE? .E CHARACTER>
<MAPRET <FORM PRINTC <ASCII .E>>>)
(<TYPE? .E STRING ZSTRING>
<MAPRET <FORM PRINTI .E>>)
(<AND <TYPE? .E FORM>
<==? <NTH .E 1> QUOTE>>
<MAPRET <FORM PRINTD <FORM GVAL <NTH .E 2>>>>)
(<TYPE? .E FORM LVAL GVAL>
<MAPRET <FORM PRINT .E>>)
(ELSE <ERROR UNKNOWN-TYPE .E>)>>>>>
<DEFMAC ONE? ('TERM)
<FORM EQUAL? .TERM 1 T>>
;<ROUTINE ONE? (NUM) <EQUAL? .NUM 1 T>>
<SETG C-ENABLED? 0>
<SETG C-ENABLED 1>
<SETG C-DISABLED 0>
<DEFMAC ENABLE ('INT) <FORM PUT .INT ,C-ENABLED? 1>>
<DEFMAC DISABLE ('INT) <FORM PUT .INT ,C-ENABLED? 0>>
;<DEFMAC FLAMING? ('OBJ)
<FORM AND <FORM FSET? .OBJ ',FLAMEBIT>
<FORM FSET? .OBJ ',ONBIT>>>
<DEFMAC OPENABLE? ('OBJ)
<FORM OR <FORM FSET? .OBJ ',DOORBIT>
<FORM FSET? .OBJ ',CONTBIT>>>
<DEFMAC ABS ('NUM)
<FORM COND (<FORM L? .NUM 0> <FORM - 0 .NUM>)
(T .NUM)>>
<DEFMAC GET-REXIT-ROOM ('PT)
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
<FORM GET .PT ',REXIT>)
(T <FORM GETB .PT ',REXIT>)>>
<DEFMAC GET-DOOR-OBJ ('PT)
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
<FORM GET .PT ',DEXITOBJ>)
(T <FORM GETB .PT ',DEXITOBJ>)>>
<DEFMAC GET/B ('TBL 'PTR)
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
<FORM GET .TBL .PTR>)
(T <FORM GETB .TBL .PTR>)>>
<DEFMAC PUT/B ('TBL 'PTR 'OBJ)
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
<FORM PUT .TBL .PTR .OBJ>)
(T <FORM PUTB .TBL .PTR .OBJ>)>>
<DEFMAC ZMEMQ/B ('OBJ 'TBL)
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
<FORM ZMEMQ .OBJ .TBL>)
(T <FORM ZMEMQB .OBJ .TBL>)>>
<DEFMAC RMGL-SIZE ('TBL)
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
<FORM - <FORM / <FORM PTSIZE .TBL> 2> 1>)
(T <FORM - <FORM PTSIZE .TBL> 1>)>>
<DEFMAC GT-O ('OBJ)
<FORM GET ',GOAL-TABLES <FORM GETP .OBJ ',P?CHARACTER>>>
<DEFMAC T? ('TERM)
<FORM NOT <FORM ZERO? .TERM>>>
<DEFINE PSEUDO ("TUPLE" V)
<MAPF ,PLTABLE
<FUNCTION (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>>>
.V>>