147 lines
3.7 KiB
Plaintext
147 lines
3.7 KiB
Plaintext
"TELLS (formerly GMACROS) for
|
|
The Zork Trilogy
|
|
(c) Copyright 1983 Infocom, Inc. All Rights Reserved
|
|
-- CHEAPO EDITION"
|
|
|
|
<SETG C-ENABLED? 0>
|
|
<SETG C-ENABLED 1>
|
|
<SETG C-DISABLED 0>
|
|
|
|
;<ROUTINE DO-CURSET (Y X)
|
|
<COND (<EQUAL? 1 ,CWIDTH ,CHEIGHT>
|
|
<CURSET .Y .X>
|
|
<RFALSE>)
|
|
(T
|
|
<SET X <* .X ,CWIDTH>>
|
|
<CURSET <* .Y ,CHEIGHT> .X>
|
|
<RFALSE>)>>
|
|
|
|
<DEFMAC VERB? ("ARGS" ATMS)
|
|
<MULTIFROB PRSA .ATMS>>
|
|
|
|
<DEFMAC PRSO? ("ARGS" ATMS)
|
|
<MULTIFROB PRSO .ATMS>>
|
|
|
|
<DEFMAC PRSI? ("ARGS" ATMS)
|
|
<MULTIFROB PRSI .ATMS>>
|
|
|
|
<DEFMAC ROOM? ("ARGS" ATMS)
|
|
<MULTIFROB HERE .ATMS>>
|
|
|
|
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) 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
|
|
(<COND (<TYPE? .ATM ATOM>
|
|
<FORM GVAL
|
|
<COND (<==? .X PRSA>
|
|
<PARSE
|
|
<STRING "V?"
|
|
<SPNAME .ATM>>>)
|
|
(ELSE .ATM)>>)
|
|
(ELSE .ATM)>
|
|
!.L)>
|
|
<SET ATMS <REST .ATMS>>
|
|
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
|
|
<SET O <REST <PUTREST .O (<FORM EQUAL? <FORM GVAL .X> !.L>)>>>
|
|
<SET L ()>>>
|
|
|
|
<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? "OPTIONAL" 'LOSER?)
|
|
<COND (<ASSIGNED? LOSER?> <FORM ZPROB .BASE?>)
|
|
(ELSE <FORM G? .BASE? '<RANDOM 100>>)>>
|
|
|
|
<ROUTINE ZPROB
|
|
(BASE)
|
|
<COND (,LUCKY <G? .BASE <RANDOM 100>>)
|
|
(ELSE <G? .BASE <RANDOM 300>>)>>
|
|
|
|
<ROUTINE RANDOM-ELEMENT (FROB)
|
|
<GET .FROB <RANDOM <GET .FROB 0>>>>
|
|
|
|
<ROUTINE PICK-ONE (FROB
|
|
"AUX" (L <GET .FROB 0>) (CNT <GET .FROB 1>) RND MSG RFROB)
|
|
<SET L <- .L 1>>
|
|
<SET FROB <REST .FROB 2>>
|
|
<SET RFROB <REST .FROB <* .CNT 2>>>
|
|
<SET RND <RANDOM <- .L .CNT>>>
|
|
<SET MSG <GET .RFROB .RND>>
|
|
<PUT .RFROB .RND <GET .RFROB 1>>
|
|
<PUT .RFROB 1 .MSG>
|
|
<SET CNT <+ .CNT 1>>
|
|
<COND (<==? .CNT .L> <SET CNT 0>)>
|
|
<PUT .FROB 0 .CNT>
|
|
.MSG>
|
|
|
|
<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 RMGL-SIZE ('TBL)
|
|
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
|
|
<FORM - <FORM / <FORM PTSIZE .TBL> 2> 1>)
|
|
(T <FORM - <FORM PTSIZE .TBL> 1>)>>
|
|
|
|
;<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 "OPT" ('SIZ <>))
|
|
<COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE>
|
|
<COND (<NOT .SIZ>
|
|
<FORM ZMEMQ .OBJ .TBL>)
|
|
(T <FORM ZMEMQ .OBJ .TBL .SIZ>)>)
|
|
(T
|
|
<COND (<NOT .SIZ>
|
|
<FORM ZMEMQB .OBJ .TBL>)
|
|
(T <FORM ZMEMQB .OBJ .TBL .SIZ>)>)>> |