amfv/misc.zil

"MISC for
			A MIND FOREVER VOYAGING
	     (c) 1985 by Infocom, Inc.  All Rights Reserved."

;"former MACROS.ZIL stuff"

<ZSTR-OFF>

"<SETG C-ENABLED? 0>
<SETG C-ENABLED 1>
<SETG C-DISABLED 0>"

;<ROUTINE ENABLED? (RTN "AUX" C E)
	 <SET E <REST ,C-TABLE ,C-TABLELEN>>
	 <SET C <REST ,C-TABLE ,C-INTS>>
	 <REPEAT ()
		 <COND (<==? .C .E>
			<RFALSE>)
		       (<EQUAL? <GET .C ,C-RTN> .RTN>
			<COND (<0? <GET .C ,C-ENABLED?>>
			       <RFALSE>)
			      (T
			       <RTRUE>)>)>
		 <SET C <REST .C ,C-INTLEN>>>>

<ROUTINE INT-NO-INSERT (RTN "OPTIONAL" E C (INT <>))
	 <SET E <REST ,C-TABLE ,C-TABLELEN>>
	 <SET C <REST ,C-TABLE ,C-INTS>>
	 <REPEAT ()
		 <COND (<EQUAL? .C .E> <RFALSE>)
		       (<EQUAL? <GET .C ,C-RTN> .RTN>
			<RETURN .C>)>
		 <SET C <REST .C ,C-INTLEN>>>>

<ROUTINE QUEUED? (RTN "AUX" C)
	 <COND (<SET C <INT-NO-INSERT .RTN>>
		<COND (<OR ;<0? <GET .C ,C-ENABLED?>>
			   <0? <GET .C ,C-TICK>>>
		       <RFALSE>)
		      (T <RETURN .C>)>)>>

<ROUTINE RUNNING? (RTN "AUX" C TICK)
	 <COND (<SET C <INT-NO-INSERT .RTN>>
		<SET TICK <GET .C ,C-TICK>>
		<COND (<OR ;<0? <GET .C ,C-ENABLED?>>
			   <0? .TICK>
			   <G? .TICK 1>>
		       <RFALSE>)
		      (T <RETURN .C>)>)>>

<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>>)
				       (<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 DPRINT .O>>)
					      (<OR <=? .P "NUM">
						   <=? .P "N">>
					       <MAPRET <FORM PRINTN .O>>)
					      (<=? .P "S">
					       <MAPRET <FORM SPRINT .O>>)
					      (<OR <=? .P "CHAR">
						   <=? .P "CHR">
						   <=? .P "C">>
					       <MAPRET <FORM PRINTC .O>>)
					      (ELSE
					       <MAPRET
						 <FORM PRINT
						       <FORM GETP .O .E>>>)>)>)
				(<TYPE? .E STRING ZSTRING>
				 <MAPRET <FORM PRINTI .E>>)
				(<TYPE? .E FORM LVAL GVAL>
				 <MAPRET <FORM PRINT .E>>)
				(ELSE <ERROR UNKNOWN-TYPE .E>)>>>>>

<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>
				     <CHTYPE <COND (<==? .X PRSA>
						    <PARSE
						     <STRING "V?"
							     <SPNAME .ATM>>>)
						   (ELSE .ATM)> GVAL>)
				    (ELSE .ATM)>
			      !.L)>
			<SET ATMS <REST .ATMS>>
			<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
		<SET O <REST <PUTREST .O
				      (<FORM EQUAL? <CHTYPE .X GVAL> !.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>)
				       (<EQUAL? .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 <CHTYPE .ATM GVAL>)>>
		      !.O)>>>

<DEFMAC RFATAL ()
	'<PROG () <PUSH 2> <RSTACK>>>

<DEFMAC PROB ('BASE?)
	<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>

;<ROUTINE PICK-ONE (FROB) ;"totally random PICK-ONE"
	 <GET .FROB <RANDOM <GET .FROB 0>>>>

<ROUTINE PICK-ONE ;"this won't repeat any strings until they've all been used"
	 (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-RTN 0>>

<ROUTINE SPRINT (OBJ)
	 <COND (<L? .OBJ 10>
		<TELL "   ">)
	       (<L? .OBJ 100>
		<TELL "  ">)
	       (<L? .OBJ 1000>
		<TELL " ">)>
	 <TELL N .OBJ>>

<ROUTINE DPRINT (OBJ)
	 <COND (<GETP .OBJ ,P?MDESC> ;"message desc"
		<TELL "MESSAGE."
		      N <GET <GETP .OBJ ,P?MDESC> 0>
		      "/"
		      N <GET <GETP .OBJ ,P?MDESC> 1>
		      "/"
		      N <GET <GETP .OBJ ,P?MDESC> 2>
		      ".">
		<TIME-PRINT <GET <GETP .OBJ ,P?MDESC> 3>>)
	       (<GETP .OBJ ,P?SDESC>
		<TELL <GETP .OBJ ,P?SDESC>>)
	       (T
		<PRINTD .OBJ>)>>

<ZSTR-ON>

;"former MAIN.ZIL stuff"

<GLOBAL P-WON <>>

<GLOBAL ELAPSED-TIME 1>

<CONSTANT M-FATAL 2>
<CONSTANT M-BEG 1>
<CONSTANT M-END 6>
<CONSTANT M-ENTER 2>
<CONSTANT M-LOOK 3>
<CONSTANT M-FLASH 4>
<CONSTANT M-OBJDESC 5>

<ROUTINE GO ()
	 ;"put interrupts on clock chain"
	 <SETG LAST-ABE-TIME <- ,TIME 1>>
	 ;<QUEUE I-UNFOLLOW 0> ;"so it's always the last interrupt called"
	 <QUEUE I-PERELMAN -1>
	 <QUEUE I-MESSAGE-C 28>
	 <QUEUE I-MESSAGE-Y 1373>	 
	 ;"set up and go"
	 <PUTB ,P-LEXV 0 59>
	 <SETG WINNER ,PLAYER>
	 <SETG HERE ,COMM-ROOM>
	 <SETG MODE ,COMM-MODE>
	 <SETG FEED-BUFFER ,NEWS-BUFFER>
	 <NAME-MESSAGE ,MESSAGE-B>
	 <CHAPTER-PRINT 1>
	 <TELL CR CR CR CR>
	 <PRINT-SPACES 22>
	 <TELL "\"Tomorrow never yet" CR>
	 <PRINT-SPACES 23>
	 <TELL "On any human being rose or set.\"" CR>
	 <PRINT-SPACES 39>
	 <TELL "-- William Marsden" CR CR CR CR CR>
	 <CONTINUE>
	 <INIT-STATUS-LINE 2>
	 <STATUS-LINE>
	 <TELL
"You \"hear\" a message coming in on the official message line: "
<GETP ,MESSAGE-B ,P?TEXT> CR CR>
	 <V-VERSION>
	 <CRLF>
	 <V-LOOK>
	 <MAIN-LOOP>
	 <AGAIN>>    

<ROUTINE MAIN-LOOP ("AUX" TRASH)
	<REPEAT ()
	     <SET TRASH <MAIN-LOOP-1>>>>

<ROUTINE MAIN-LOOP-1 ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP NOT-HERE)
     <SETG ELAPSED-TIME 1>
     <SETG INCREMENT-WAIT <>>
     <SETG STOP-WAIT <>>
     <SET CNT 0>
     <SET OBJ <>>
     <SET PTBL T>
     <COND (<SETG P-WON <PARSER>>
	    <SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
	    <SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>
	    <COND (<AND ,P-IT-OBJECT <ACCESSIBLE? ,P-IT-OBJECT>>
		   <SET TMP <>>
		   <REPEAT ()
			   <COND (<G? <SET CNT <+ .CNT 1>> .ICNT>
				  <RETURN>)
				 (T
				  <COND (<EQUAL? <GET ,P-PRSI .CNT> ,IT>
					 <PUT ,P-PRSI .CNT ,P-IT-OBJECT>
					 <SET TMP T>
					 <RETURN>)>)>>
		   <COND (<NOT .TMP>
			  <SET CNT 0>
			  <REPEAT ()
			   <COND (<G? <SET CNT <+ .CNT 1>> .OCNT>
				  <RETURN>)
				 (T
				  <COND (<EQUAL? <GET ,P-PRSO .CNT> ,IT>
					 <PUT ,P-PRSO .CNT ,P-IT-OBJECT>
					 <RETURN>)>)>>)>
		   <SET CNT 0>)>
	    <SET NUM
		 <COND (<0? .OCNT> .OCNT)
		       (<G? .OCNT 1>
			<SET TBL ,P-PRSO>
			<COND (<0? .ICNT> <SET OBJ <>>)
			      (T <SET OBJ <GET ,P-PRSI 1>>)>
			.OCNT)
		       (<G? .ICNT 1>
			<SET PTBL <>>
			<SET TBL ,P-PRSI>
			<SET OBJ <GET ,P-PRSO 1>>
			.ICNT)
		       (T 1)>>
	    <COND (<AND <NOT .OBJ>
			<1? .ICNT>>
		   <SET OBJ <GET ,P-PRSI 1>>)>
	    <COND (<EQUAL? ,PRSA ,V?WALK>
		   <SET V <PERFORM ,PRSA ,PRSO>>)
		  (<0? .NUM>
		   <COND (<0? <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
			  <SET V <PERFORM ,PRSA>>
			  <SETG PRSO <>>)
			 ;(<NOT ,LIT>
			  <TELL ,TOO-DARK CR>
			  <CLEAR-BUF>)
			 (T
			  <TELL "There isn't anything to ">
			  <SET TMP <GET ,P-ITBL ,P-VERBN>>
			  <COND (<VERB? TELL>
				 <TELL "talk to">)
				(<OR ,P-OFLAG ,P-MERGED>
				 <PRINTB <GET .TMP 0>>)
				(T
				 <WORD-PRINT <GETB .TMP 2>
					     <GETB .TMP 3>>)>
			  <TELL "!" CR>
			  <SET V <>>
			  <CLEAR-BUF>)>)
		  (T
		   <SET NOT-HERE 0>
		   ;<SETG P-MULT <>>
		   ;<COND (<G? .NUM 1>
			  <SETG P-MULT T>)>
		   <SET TMP <>>
		   <REPEAT ()
		    <COND (<G? <SET CNT <+ .CNT 1>> .NUM>
			   <COND (<G? .NOT-HERE 0>
				  <TELL "[The ">
				  <COND (<NOT <EQUAL? .NOT-HERE .NUM>>
					 <TELL "other ">)>
				  <TELL "object">
				  <COND (<NOT <EQUAL? .NOT-HERE 1>>
					 <TELL "s">)>
				  <TELL " that you mentioned ">
				  <COND (<NOT <EQUAL? .NOT-HERE 1>>
					 <TELL "are">)
					(T
					 <TELL "is">)>
				  <TELL "n't here.]" CR>)
				 (<NOT .TMP>
				  <TELL ,REFERRING CR>)>
			   <RETURN>)
			  (T
			   <COND (.PTBL
				  <SET OBJ1 <GET ,P-PRSO .CNT>>
				  <SETG PRSO .OBJ1>
				  <SETG PRSI .OBJ>)
				 (T
				  <SET OBJ1 <GET ,P-PRSI .CNT>>
				  <SETG PRSO .OBJ>
				  <SETG PRSI .OBJ1>)>
			   <COND (<OR <G? .NUM 1>
				      <EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0>
					      ,W?ALL>>
				  <COND (<EQUAL? .OBJ1 ,NOT-HERE-OBJECT>
					 <SET NOT-HERE <+ .NOT-HERE 1>>
					 <AGAIN>)
					(<AND <==? ,P-GETFLAGS ,P-ALL>
					      <DONT-ALL? ,PRSO ,PRSI .PTBL>>
					 <AGAIN>)
					(<AND <VERB? TAKE>
					      ,PRSI
					      <NOT <IN? ,PRSO ,PRSI>>>
					 <AGAIN>)
					(<NOT <ACCESSIBLE? .OBJ1>>
					 <AGAIN>)
					(<NOT <==? .OBJ1 ,BUZZERS ,BOOKS>>
					 <COND (<EQUAL? .OBJ1 ,IT>
						<PRINTD ,P-IT-OBJECT>)
					       (T
						<PRINTD .OBJ1>)>
					 <TELL ": ">)>)>
			   <SET TMP T>
			   <SET V <PERFORM ,PRSA ,PRSO ,PRSI>>
			   <COND (<EQUAL? .V ,M-FATAL>
				  <RETURN>)>)>>)>
	    <COND (<OR <NOT <EQUAL? .V ,M-FATAL>>
		       <EQUAL? ,HERE ,NEWS>>
		   <COND ;(<VERB? TELL BRIEF SUPER-BRIEF VERBOSE
				 SAVE VERSION RESTORE SCRIPT UNSCRIPT>
			  T)
			 (<NOT <EQUAL? ,ELAPSED-TIME 0>>
			  ;<APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-END>
			  <SET V <APPLY <GETP ,HERE ,P?ACTION> ,M-END>>)>)>
	    ;<COND (<VERB? AGAIN SAVE RESTORE SCRIPT UNSCRIPT
			  VERBOSE BRIEF SUPER-BRIEF>
		   T)
		  (,P-OFLAG
		   T)
		  (T
		   <SETG L-PRSA ,PRSA>
		   <SETG L-PRSO ,PRSO>
		   <SETG L-PRSI ,PRSI>)>
	    <COND (<NOT ,CLOCK-WAIT>
		   <INCREMENT-TIME ,ELAPSED-TIME>)>
	    ;<SETG TURNS <+ ,TURNS 1>>
	    <COND (<EQUAL? .V ,M-FATAL>
		   <SETG P-CONT <>>)>)
	   (T
	    <SETG P-CONT <>>)>
     <COND (,P-WON
	    ;<COND (<VERB? TELL BRIEF SUPER-BRIEF VERBOSE VERSION QUIT SCORE
			  SAVE RESTORE SCRIPT UNSCRIPT HELP RESTART>
		   T)
		  (<AND <VERB? AGAIN>
			<OR <EQUAL? ,L-PRSA ,V?BRIEF ,V?SUPER-BRIEF ,V?VERBOSE>
			    <EQUAL? ,L-PRSA ,V?SAVE ,V?RESTORE ,V?SCRIPT>
			    <EQUAL? ,L-PRSA ,V?RESTART ,V?QUIT ,V?SCORE>
			    <EQUAL? ,L-PRSA ,V?VERSION ,V?HELP ,V?UNSCRIPT>>>
		   T)
		  (T
		   <STATUS-LINE>
		   <SET V <CLOCKER>>)>
	    <COND (<NOT <EQUAL? ,ELAPSED-TIME 0>>
		   <SET V <CLOCKER>>)>
	    <STATUS-LINE>
	    <SETG PRSA <>>
	    <SETG PRSO <>>
	    <SETG PRSI <>>)>>

<ROUTINE DONT-ALL? (O I ALL-O? "AUX" LOCATION)
	 <SET LOCATION <LOC .O>>
	 <COND (<EQUAL? .O .I>
		<RTRUE>)
	       (<VERB? TAKE>
		<COND (<EQUAL? .LOCATION ,PLAYER ,WINNER>
		       <RTRUE>)
		      (<AND <NOT <FSET? .O ,TAKEBIT>>
			    <NOT <FSET? .O ,TRYTAKEBIT>>>
		       <RTRUE>)
		      (.I
		       <COND (<NOT <EQUAL? .LOCATION .I>>
			      <RTRUE>)
			     (<SEE-INSIDE? .I>
			      <RFALSE>)
			     (T
			      <RTRUE>)>)
		      (<EQUAL? .LOCATION ,HERE ,SHOWER>
		       <RFALSE>)
		      (<FSET? .LOCATION ,SURFACEBIT>
		       <RFALSE>)
		      (<FSET? .LOCATION ,ACTORBIT>
		       <RFALSE>)
		      (T
		       <RTRUE>)>)
	       (<VERB? DROP PUT PUT-ON THROW>
		<COND (<EQUAL? .LOCATION ,PLAYER ,WINNER>
		       <RFALSE>)
		      (T
		       <RTRUE>)>)
	       (<AND <VERB? TURN-ON SHUT-OFF>
		     <EQUAL? ,HERE ,INTERFACE-ROOM>>
		<COND (<EQUAL? ,WINNER ,HVAC-CONTROLLER>
		       <COND (<EQUAL? .I ,ALPHA-SECTOR ,BETA-SECTOR>
			      <RFALSE>)
			     (<EQUAL? .I ,GAMMA-SECTOR ,DELTA-SECTOR>
			      <RFALSE>)
			     (T
			      <RTRUE>)>)
		      (T
		       <COND (<EQUAL? .I ,ALPHA-SECTOR>
			      <RFALSE>)
			     (T
			      <RTRUE>)>)>)
	       (T
		<RFALSE>)>>

<ROUTINE FAKE-ORPHAN ("AUX" TMP)
	 <ORPHAN ,P-SYNTAX <>>
	 <TELL "[Be specific: what object do you want to ">
	 <SET TMP <GET ,P-OTBL ,P-VERBN>>
	 <COND (<EQUAL? .TMP 0>
		<TELL "tell">)
	       (<0? <GETB ,P-VTBL 2>>
		<PRINTB <GET .TMP 0>>)
	       (T
		<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>
		<PUTB ,P-VTBL 2 0>)>
	 <SETG P-OFLAG T>
	 <SETG P-WON <>>
	 <PREP-PRINT
	     <GETB ,P-SYNTAX ,P-SPREP1>>
	 <TELL "?]" CR>>

<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" (V <>) OA OO OI)
	;<COND (,DEBUG
	       <TELL "[Perform: ">
	       %<COND (<GASSIGNED? PREDGEN> '<TELL N .A>)
		      (T '<PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>)>
	       <COND (<AND .O <NOT <EQUAL? .A ,V?WALK>>>
		      <TELL " / PRSO = " D .O>)>
	       <COND (.I <TELL " / PRSI = " D .I>)>
	       <TELL "]" CR>)>
	<SET OA ,PRSA>
	<SET OO ,PRSO>
	<SET OI ,PRSI>
	<SETG PRSA .A>
	<COND (<EQUAL? ,IT .I .O>
	       <COND (<NOT .I>
		      <FAKE-ORPHAN>)
		     (T
		      <TELL ,REFERRING CR>)>
	       <RFATAL>)>
	<SETG PRSO .O>
	<COND (<AND ,PRSO
		    <NOT <PRSO? ,INTNUM>>
		    <NOT <VERB? WALK>>
		    <NOT <PRSO? ,NOT-HERE-OBJECT>>>
	       <SETG P-IT-OBJECT ,PRSO>)>
	<SETG PRSI .I>
	;<COND (<NOT <EQUAL? .A ,V?AGAIN>>
	       <SETG L-PRSA .A>
	       <COND (<EQUAL? .A ,V?WALK>
		      <SETG L-PRSO <>>)
		     (T
		      <SETG L-PRSO .O>)>
	       <SETG L-PRSI .I>)>
	<COND (<AND <NOT <EQUAL? .A ,V?WALK>>
		    <EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
		    <SET V <D-APPLY "Not Here" ,NOT-HERE-OBJECT-F>>>
	       <SETG P-WON <>>
	       .V)
	      (T
	       <SET O ,PRSO>
	       <SET I ,PRSI>
	       <COND (<SET V <D-APPLY "Actor" <GETP ,WINNER ,P?ACTION>>>
		      .V)
		     (<SET V <D-APPLY "M-Beg" <GETP ,HERE ,P?ACTION> ,M-BEG>>
		      ;<D-APPLY <GETP <LOC ,WINNER> ,P?ACTION ,M-BEG>>
		      .V)
		     (<SET V <D-APPLY "Preaction" <GET ,PREACTIONS .A>>>
		      .V)
		     (<AND .I <SET V <D-APPLY "PRSI" <GETP .I ,P?ACTION>>>>
		      .V)
		     ;(<AND .O
			   <NOT <EQUAL? .A ,V?WALK>>
			   <LOC .O>
			   <GETP <LOC .O> ,P?CONTFCN>
			   <SET V <D-APPLY "Cont" <GETP <LOC .O> ,P?CONTFCN>>>>
		      .V) 
		     (<AND .O
			   <NOT <EQUAL? .A ,V?WALK>>
			   <SET V <D-APPLY "PRSO" <GETP .O ,P?ACTION>>>>
		      .V)
		     (<SET V <D-APPLY <> <GET ,ACTIONS .A>>>
		      .V)>)>
	<SETG PRSA .OA>
	<SETG PRSO .OO>
	<SETG PRSI .OI>
	.V>

<ROUTINE D-APPLY (STR FCN "OPTIONAL" (FOO <>) "AUX" RES)
	<COND (<NOT .FCN> <>)
	      (T
	       ;<COND (,DEBUG
		      <COND (<NOT .STR>
			     <TELL CR "  Default ->" CR>)
			    (T <TELL CR "  " .STR " -> ">)>)>
	       <SET RES
		    <COND (.FOO <APPLY .FCN .FOO>)
			  (T <APPLY .FCN>)>>
	       ;<COND (<AND ,DEBUG .STR>
		      <COND (<EQUAL? .RES ,M-FATAL>
			     <TELL "Fatal" CR>)
			    (<NOT .RES>
			     <TELL "Not handled">)
			    (T
			     <TELL "Handled" CR>)>)>
	       .RES)>>

;"former CLOCK.ZIL stuff"

<GLOBAL C-TABLE %<COND (<GASSIGNED? PREDGEN>
			'<ITABLE NONE 50>)
		       (T
			'<ITABLE NONE 100>)>>

<CONSTANT C-TABLELEN 100>

<GLOBAL C-INTS 100>

<CONSTANT C-INTLEN 4>

;<CONSTANT C-ENABLED? 0>

<CONSTANT C-TICK 1>

<CONSTANT C-RTN 0>

<ROUTINE QUEUE (INTERRUPT-ROUTINE TICK-NUMBER "AUX" CLOCKER-INT)
	 <PUT <SET CLOCKER-INT <INT .INTERRUPT-ROUTINE>> ,C-TICK .TICK-NUMBER>
	 .CLOCKER-INT>

<ROUTINE INT (RTN "OPTIONAL" E C (INT <>))
	 <SET E <REST ,C-TABLE ,C-TABLELEN>>
	 <SET C <REST ,C-TABLE ,C-INTS>>
	 <REPEAT ()
		 <COND (<EQUAL? .C .E>
			<COND (<NOT .INT>
			       <COND (<L? ,C-INTS ,C-INTLEN>
				      <TELL "Bug #25I" CR>)>
			       <SETG C-INTS <- ,C-INTS ,C-INTLEN>>
			       <SET INT <REST ,C-TABLE ,C-INTS>>)>
			<PUT .INT ,C-RTN .RTN>
			<RETURN .INT>)
		       (<EQUAL? <GET .C ,C-RTN> .RTN>
			<RETURN .C>)
		       (<AND <NOT .INT>
			     <ZERO? <GET .C ,C-RTN>>>
			<SET INT .C>)>
		 <SET C <REST .C ,C-INTLEN>>>>

<ROUTINE CLOCKER ("AUX" C E TICK RTN (FLG <>))
	 <COND (,CLOCK-WAIT
		<SETG CLOCK-WAIT <>>
		<RFALSE>)>
	 <SET C <REST ,C-TABLE ,C-INTS>>
	 <SET E <REST ,C-TABLE ,C-TABLELEN>>
	 <REPEAT ()
	      <COND (<==? .C .E>
		     <RETURN .FLG>)>
	      <SET RTN <GET .C ,C-RTN>>
	      <COND (<NOT <ZERO? .RTN>>
		     <SET TICK <GET .C ,C-TICK>>
		     <COND (T ;<NOT <ZERO? .TICK>>;"test only if <QUEUE ... 0>"
			    <COND (<==? .TICK -1>
				   <COND (<APPLY .RTN>
					  <SET FLG T>)>)
				  (T
				   <SET TICK <- .TICK ,ELAPSED-TIME>>
				   <COND (<G? .TICK 0>
					  <PUT .C ,C-TICK .TICK>)
					 (T
					  ;<PUT .C ,C-TICK 0>
					  <COND (T ;<ZERO? .TICK>
						 <PUT .C ,C-RTN 0>)>
					  <COND (<APPLY .RTN>
						 <SET FLG T>)>)>)>)>)>
	      <SET C <REST .C ,C-INTLEN>>>>

<GLOBAL INCREMENT-WAIT <>>

<GLOBAL STOP-WAIT <>>

<ROUTINE INCREMENT-TIME (X "AUX" TMP)
	 <SETG TIME <+ ,TIME .X>>
	 <COND (<G? ,TIME 1439>
		<SETG TIME <- ,TIME 1440>>
		<SETG DATE <+ ,DATE 1>>
		<COND (<EQUAL? ,DATE 18>
		       <SETG FEED-BUFFER ,REPORT-BUFFER>)
		      (T
		       <SETG FEED-BUFFER ,NEWS-BUFFER>)>
		<COND (<G? ,DATE 28>
		       <COND (<OR <EQUAL? ,DATE 32>
				  <EQUAL? ,MONTH 2>
				  <AND <EQUAL? ,DATE 31>
				       <OR <EQUAL? ,MONTH 4 6 9>
					   <EQUAL? ,MONTH 11>>>>
			      <SETG DATE 1>
			      <SETG MONTH <+ ,MONTH 1>>
			      ;<COND (<EQUAL? ,MONTH 13>
				     <SETG MONTH 1>
				     <SETG YEAR <+ ,YEAR 1>>)>)>)>
		<COND (<EQUAL? ,HERE ,ROOF>
		       <COND (<EQUAL? ,TIME 348>
			      <TELL CR
"The first glow of dawn appears on the horizon." CR>)
			     (<EQUAL? ,TIME 378>
			      <TELL CR
"The sun is now well above the horizon; day has begun." CR>)
			     (<EQUAL? ,TIME 1073>
			      <TELL CR
"The sky begins to darken as the sun sinks into the western sky." CR>)
			     (<EQUAL? ,TIME 1103>
			      <TELL CR
"The last glow of dusk fades as nighttime falls across the rooftop." CR>)>)>)>
	 <COND (,SIMULATING
		<SET TMP ,STIME>
		<SETG STIME <+ ,STIME .X>>
		<COND (<G? ,STIME 1439>
		       <SETG STIME <- ,STIME 1440>>
		       <SETG SDATE <+ ,SDATE 1>>
		       <COND (<G? ,SDATE 28>
			      <COND (<OR <EQUAL? ,SDATE 32>
					 <EQUAL? ,SMONTH 2>
					 <AND <EQUAL? ,SDATE 31>
					      <OR <EQUAL? ,SMONTH 4 6 9>
						  <EQUAL? ,SMONTH 11>>>>
				     <SETG SDATE 1>
				     <SETG SMONTH <+ ,SMONTH 1>>
				     ;<COND (<EQUAL? ,SMONTH 13>
					    <SETG SMONTH 1>
					    <SETG SYEAR <+ ,SYEAR 1>>)>)>)>)>
		<PUT ,SIM-LEVEL-TABLE <CONVERT-SYEAR-TO-NUM>
		     <+ .X <GET ,SIM-LEVEL-TABLE <CONVERT-SYEAR-TO-NUM>>>>
		;<COND (<EQUAL? ,SYEAR 2041>
		       <SETG 2041-SIMULATION-LEVEL
			     <+ ,2041-SIMULATION-LEVEL .X>>)
		      (<EQUAL? ,SYEAR 2051>
		       <SETG 2051-SIMULATION-LEVEL
			     <+ ,2051-SIMULATION-LEVEL .X>>)
		      (<EQUAL? ,SYEAR 2061>
		       <SETG 2061-SIMULATION-LEVEL
			     <+ ,2061-SIMULATION-LEVEL .X>>)
		      (<EQUAL? ,SYEAR 2071>
		       <SETG 2071-SIMULATION-LEVEL
			     <+ ,2071-SIMULATION-LEVEL .X>>)
		      (T
		       <SETG 2081-SIMULATION-LEVEL
			     <+ ,2081-SIMULATION-LEVEL .X>>)>
		<COND (<TUBES-CLOSE?>
		       <TELL CR
"A surly cop warns that curfew is approaching and hustles you out of the ">
		       <PRINTD ,TUBE-STATION>
		       <TELL "." CR CR>
		       <COND (<EQUAL? ,HERE ,RED-TUBECAR ,BROWN-TUBECAR>
			      <MOVE ,PLAYER <GET ,RED-TABLE ,RED-POINTER>>
			      <SETG HERE <GET ,RED-TABLE ,RED-POINTER>>)>
		       <DO-WALK ,P?UP>)
		      (<AND <EQUAL? ,HERE ,ROCKVIL-STADIUM>
			    <EQUAL? ,SYEAR 2061 2071>>
		       <COND (<AND <G? ,STIME 1154>
				   <L? ,STIME 1200>
				   <NOT ,INCREMENT-WAIT>
				   ;"already told during wait">
			      <SETG INCREMENT-WAIT T>
			      <TELL CR
"As the day's executions wind to a conclusion, the people in the stands
begin heading toward the exits." CR>)
			     (<EQUAL? ,STIME 480> ;"already told during wait"
			      <SETG STOP-WAIT T>
			      <TELL CR
"People begin gathering in the stands as the day's executions begin." CR>)>)>
		<COND (<NOT <EQUAL? ,SYEAR 2041 2081>>
		       <COND (<AND <G? ,STIME 1260>
				   <NOT <G? .TMP 1260>>>
			      ;"has it just passed 9:00pm?"
			      <QUEUE I-CURFEW 15>
			      <SETG STOP-WAIT T>
			      <SCORE 116> ;"2 points"
			      <TELL CR
"A surge of adrenal fear passes through you as sirens all around begin
wailing, an audio sine wave announcing the beginning of curfew." CR>)
			     (<AND <G? ,STIME 420>
				   <NOT <G? .TMP 420>>
				   <NOT <VERB? SLEEP>>>
			      ;"has it just passed 7:00am?"
			      <SETG STOP-WAIT T>
			      <TELL CR "T">
			      <END-CURFEW>
			      <CRLF>)>)>)>
	 <COND (,RECORDING
		<COND (<OR <EQUAL? ,HERE ,LIVING-ROOM ,KITCHEN>
			   <EQUAL? ,HERE ,BEDROOM ,BATHROOM>>
		       ;<IN-APARTMENT?>
		       <PUT ,RECORDING-TABLE 16 1>)
		      (<EQUAL? ,HERE ,COURTHOUSE>
		       <PUT ,RECORDING-TABLE 10 1>)
		      (<EQUAL? ,HERE ,POWER-STATION>
		       <PUT ,RECORDING-TABLE 4 1>)>
		<COND (<EQUAL? ,SYEAR 2051>
		       <SETG 2051-RECORDED T>)
		      (<EQUAL? ,SYEAR 2061>
		       <SETG 2061-RECORDED T>)
		      (<EQUAL? ,SYEAR 2071>
		       <SETG 2071-RECORDED T>)
		      (<EQUAL? ,SYEAR 2081>
		       <SETG 2081-RECORDED T>)>
		<SET TMP <GETP ,RECORD-BUFFER ,P?SIZE>>
		<PUTP ,RECORD-BUFFER ,P?SIZE <+ .TMP .X>>
		<COND (,SIMULATING
		       <SETG RECORDINGS-INCLUDE-SIMULATION T>)>
		<COND (<AND <G? <GETP ,RECORD-BUFFER ,P?SIZE> 45>
			    <NOT <G? .TMP 45>>>
		       <SOUND 1>
		       <TELL CR "WARNING: Record buffer is now half-full." CR>)
		      (<G? <GETP ,RECORD-BUFFER ,P?SIZE> 90>
		       <SETG RECORDING <>>
		       <PUTP ,RECORD-BUFFER ,P?SIZE 90>
		       <SOUND 1>
		       <TELL CR
"WARNING: Record buffer full. Auto-deactivation of record feature." CR>)>)>>

<ROUTINE TUBES-CLOSE? ()
	 <COND (<EQUAL? ,SYEAR 2041>
		<RFALSE>)
	       (<L? ,STIME 1250>
		<RFALSE>)
	       (<FSET? ,HERE ,TUBEBIT>
		<RTRUE>)
	       (<AND <EQUAL? ,HERE ,RED-TUBECAR>
		     ,RED-TUBECAR-IN-STATION>
		<RTRUE>)
	       (<AND <EQUAL? ,HERE ,BROWN-TUBECAR>
		     ,BROWN-TUBECAR-IN-STATION>
		<RTRUE>)
	       (T
		<RFALSE>)>>

<ROUTINE ITALICIZE (STR "OPTIONAL" (NO-CAPS? <>)
			"AUX" LEN (PTR 2) CHAR (SCRIPTING-ON <>))
	 <BUFOUT <>>
	 <BUFOUT T>
	 <COND (<BTST <GET 0 8> 1>
		<SET SCRIPTING-ON T>)>
	 <COND (.SCRIPTING-ON
		<DIROUT ,D-PRINTER-OFF>)>
	 <DIROUT ,D-SCREEN-OFF>
	 <DIROUT ,D-TABLE-ON ,SL-BUFFER>
	 <TELL .STR>
	 <DIROUT ,D-TABLE-OFF>
	 <COND (.SCRIPTING-ON
		<DIROUT ,D-PRINTER-ON>)>
	 <COND (<NOT <VERB? SCRIPT UNSCRIPT>>
		<DIROUT ,D-SCREEN-ON>)>
	 <SET LEN <+ <GET ,SL-BUFFER 0> 1>>
	 <COND (<EQUAL? .LEN 1>
		<RTRUE>)
	       (<OR <ZERO? <GETB 0 18>>  ; "ZIL?"
		    <BAND <GETB 0 1> 8>> ; "ITALICS BIT SET?"
		<HLIGHT ,H-ITALIC>
		<REPEAT ()
			<SET CHAR <GETB ,SL-BUFFER .PTR>>
			<COND (<EQUAL? .CHAR 32> ; "SPACE?"
			       <HLIGHT ,H-NORMAL>
			       <PRINTC 32>
			       <HLIGHT ,H-ITALIC>)
			      (T
			       <PRINTC .CHAR>)>
			<COND (<EQUAL? .PTR .LEN>
			       <RETURN>)
			      (T
			       <SET PTR <+ .PTR 1>>)>>
		<HLIGHT ,H-NORMAL>)
	       (.NO-CAPS?
		<TELL .STR>)
	       (T                       ; "NO ITALICS, CAPITALIZE"
		<REPEAT ()
			<SET CHAR <GETB ,SL-BUFFER .PTR>>
			<COND (<AND <G? .CHAR 96>
				    <L? .CHAR 123>>
			       <SET CHAR <- .CHAR 32>>)>
			<PRINTC .CHAR>
			<COND (<EQUAL? .PTR .LEN>
			       <RETURN>)
			      (T
			       <SET PTR <+ .PTR 1>>)>>)>>

<ROUTINE CONVERT-SYEAR-TO-NUM ()
	 <RETURN </ <- ,SYEAR 2041> 10>>>