macros.zil

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