trivia-1976-1977/trivia/9005183/ar2.tv/gc.7

<USE-TOTAL "ASYLUM">

<USE "MADMAN" "STR">

<FLOAD "AR2:TAA;SSNAME NBIN">

<GDECL (QSPACE ASPACE SSPACE MOBYSPACE LOSSSPACE)
       SPACE
       (TVASS)
       ASYLUM>

<DEFINE MUNG ("OPTIONAL" (FN "MADMAN;TV NEW") (FLEN 300) "AUX" (D ,TVASS) N
		    (QSP ,QSPACE) (ASP ,ASPACE) (SSP ,SSPACE) (LSP ,LOSSSPACE)
		    (MOBYSPACE
		     <COND (<GASSIGNED? MOBYSPACE> ,MOBYSPACE)
			   (T <SETG MOBYSPACE <AFIND 4>>)>) DHIGH MARKV TPG)
	#DECL ((D N) ASYLUM (QSP ASP SSP LSP MOBYSPACE) SPACE (DHIGH) FIX
	       (MARKV) <UVECTOR [REST FIX]> (FN) STRING (FLEN TPG) FIX)
	<ALLOC-MAP .D>
	<CONS-IT .FN .FLEN>
	<SETG N <SET N <OPEN-DATA-FILE .FN <COND (<GASSIGNED? N> ,N)> 7 5>>>
	<SETG PEEK-PAGE </ <DATA-ALLOC .N <CHTYPE #WORD *410000000000* FIX>> 1024>>
	<AND <SET TPG <DIRMAP .N ,PEEK-PAGE>>
	     <DIR-INIT .TPG>
	     <PUT <MEMQ .TPG <5 .N>> 3 1>>
	<SET DHIGH
	     <CHTYPE <1 <GET-LOC <+ <* 1024 <ALLOCPAGE .D>> ,HIGHID> ![0!]>>
		     FIX>>
	<SET MARKV <AIUVECTOR .MOBYSPACE .DHIGH 0>>
	<DATA-RESERVE .N 27>
	<MAPR <>
	      <FUNCTION (X Y) <PUT .X 1 <1 .Y>>>
	      .MARKV
	      '![1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
		 25 26 27!]>
	<SSNAME <STRTOX "MUNGLO">>
	<SETG LOSSTABLE
	      <MUNG-LOSS .N
			 .D
			 <ARESET .LSP>
			 <ARESET .SSP>
			 <ARESET .QSP>
			 .MARKV>>
	<SSNAME <STRTOX "RESERV">>
	<DATA-PRINTW .N ,HIQNUM <DATA-READW .D ,HIQNUM>>
	<DATA-PRINTW .N ,TOTSCR <DATA-READW .D ,TOTSCR>>
	<REPEAT ((CT ,1STCAT))
		#DECL ((CT) FIX)
		<DATA-PRINTW .N .CT <DATA-READW .D .CT>>
		<COND (<G? <SET CT <+ .CT 1>> 22> <RETURN>)>>
	<DATA-PRINTW .N ,HIPOFFSET <DATA-READW .D ,HIPOFFSET>>
	<SSNAME <STRTOX "ANNOUN">>
	<MUNG-ANNOUNCE .N .D .SSP .ASP .MARKV>
	<SSNAME <STRTOX "MUNGQ">>
	<MUNG-Q .N .D .QSP .ASP .MARKV>
	<MUNG-LUSERS .N .D .ASP .SSP .MARKV>
	ZORK>

<DEFINE CONS-IT (FN FLEN "AUX" (CH <OPEN "PRINTB" .FN>) (FOO <IUVECTOR 1024>)
		 (FOO1 <IUVECTOR .FLEN '.FOO>))
  #DECL ((FN) STRING (CH) CHANNEL (FOO) <UVECTOR [REST <PRIMTYPE WORD>]>
	 (FOO1) <UVECTOR [REST UVECTOR]> (FLEN) FIX)
  <MAPF <>
    <FUNCTION (X) <PRINTB .X .CH>>
    .FOO1>
  <CLOSE .CH>>

"MOVE LUBLKS AND SCORES"

<DEFINE MUNG-LOSS (N D LSP SSP QSP MARKV "AUX" LOSSTABLE L1 L2 NEWID NEW) 
	#DECL ((N D) ASYLUM (LSP SSP QSP) SPACE (L1 L2 LOSSTABLE) LIST
	       (NEWID) FIX)
	<SET LOSSTABLE <SET L1 <REVERSE <DATA-AREAD .D 3 <ARESET .QSP>>>>>
	<REPEAT ()
		<SET NEW <- <SET NEWID <DATA-RESERVE .N 12>> 1>>
		<MAPR <>
		      <FUNCTION (X Y) 
			      #DECL ((X Y) <UVECTOR [REST FIX]>)
			      <PUT .X 1 <SET NEW <+ .NEW 1>>>>
		      <REST .MARKV <- <2 .L1> 1>>
		      '![0 0 0 0 0 0 0 0 0 0 0 0!]>
		<DATA-APRINT .N
			     <+ .NEWID ,SCORE>
			     .SSP
			     <DATA-AREAD .D <+ <2 .L1> ,SCORE> <ARESET .SSP>>>
		<PUT .L1 2 .NEWID>
		<COND (<EMPTY? <SET L2 <REST .L1 4>>>
		       <SET LOSSTABLE <AGC <ARESET .LSP> <REVERSE .LOSSTABLE>>>
		       <DATA-APRINT .N 3 .LSP .LOSSTABLE>
		       <RETURN .LOSSTABLE>)
		      (<SET L1 .L2>)>>>

<DEFINE MUNG-ANNOUNCE (N D SSP ASP MARKV) 
	#DECL ((N D) ASYLUM (SSP ASP) SPACE (MARKV) <UVECTOR [REST FIX]>)
	<REPEAT ((NEW ,LOMAIL) (NSTART ,LOMAIL) OLD (START ,LOMAIL) CANN)
		#DECL ((NSTART OLD NEW START) FIX (CANN) <OR FALSE VECTOR>)
		<COND (<0? <SET OLD <CHTYPE <DATA-READW .D .START> FIX>>>
		       <DATA-PRINTW .N ,HIMAIL .NEW>
		       <RETURN>)
		      (<SET CANN <DATA-AREAD .D .OLD <ARESET .SSP>>>
		       <SET NEW <1 <DATA-APRINT .N -1 .SSP .CANN>>>
		       <PUT .MARKV .OLD .NEW>
		       <DATA-PRINTW .N .NSTART .NEW>
		       <SET NSTART .NEW>
		       <SET START .OLD>)
		      (T <PUT .MARKV .OLD ,LOMAIL> <SET START .OLD>)>>>

<DEFINE MUNG-Q (N D QSP ASP MARKV "AUX" SLIST) 
	#DECL ((N D) ASYLUM (QSP ASP) SPACE (MARKV) <UVECTOR [REST FIX]>
	       (SLIST) <LIST [REST <PRIMTYPE WORD>]>)
	<REPEAT ((NSTART ,LOWQUES) CQUES (START ,LOWQUES) NEW NEW-SCORE
		 OLD-SCORE)
		#DECL ((NSTART START NEW NEW-SCORE) FIX (CQUES) VECTOR)
		<COND (<0? <SET START <CHTYPE <DATA-READW .D .START> FIX>>>
		       <DATA-PRINTW .N ,HIQLOC .NEW>
		       <RETURN>)
		      (T
		       <SET CQUES <DATA-AREAD .D .START <ARESET .QSP>>>
		       <COND (<N==? <QTYPE .CQUES> ,$TSIMPLE>
			      <SET OLD-SCORE <QSCORE .CQUES>>
			      <DATA-PRINTW .N
					   <SET NEW-SCORE <DATA-RESERVE .N 1>>
					   <DATA-READW .D .OLD-SCORE>>
			      <PUT .MARKV .OLD-SCORE .NEW-SCORE>
			      <PUT .CQUES ,QSCORE .NEW-SCORE>)>
		       <SET NEW <1 <DATA-APRINT .N -1 .QSP .CQUES>>>
		       <PUT .MARKV .START .NEW>
		       <DATA-PRINTW .N .NSTART .NEW>
		       <SET NSTART .NEW>)>>
	<SETG SIMPLE-SPACE <AFIND 1>>
	<SET SLIST <DATA-AREAD .D ,SIMPLE-LIST ,SIMPLE-SPACE>>
	<MAPR <>
	  <FUNCTION (X)  #DECL ((X) <LIST [REST <OR TIME FIX>]>)
	    <COND (<TYPE? <1 .X> TIME>
		   <PUT .X 3 <NTH .MARKV <3 .X>>>)>>
	  .SLIST>
	<DATA-APRINT .N ,SIMPLE-LIST ,SIMPLE-SPACE .SLIST>>

<DEFINE MUNG-LUSERS (N D ASP SSP MARKV "AUX" OLOSSTABLE) 
   #DECL ((N D) ASYLUM (ASP SSP) SPACE (MARKV) <UVECTOR [REST FIX]>
	  (LOSSTABLE) <LIST [REST TIME STRING FIX FIX]>)
   <SET LOSSTABLE <DATA-AREAD .D 3 <ARESET ,LOSSSPACE>>>
   <REPEAT (NINDEX CPLAYER CINDEX QASKED)
     #DECL ((CPLAYER) TIME (NINDEX CINDEX) FIX)
     <SET CPLAYER <1 .LOSSTABLE>>
     <SET CINDEX <3 .LOSSTABLE>>
     <SET NINDEX <NTH .MARKV .CINDEX>>
     <SSNAME .CPLAYER>
     <DATA-PRINTW .N
		  <+ .NINDEX ,LASTIN>
		  <DATA-READW .D <+ .CINDEX ,LASTIN>>>
     <DATA-PRINTW .N
		  <+ .NINDEX ,LASTGRD>
		  <DATA-READW .D <+ .CINDEX ,LASTGRD>>>
     <DATA-APRINT .N
		  <+ ,NINDEX ,TAILOR>
		  .SSP
		  <DATA-AREAD .D <+ .CINDEX ,TAILOR> <ARESET .SSP T>>>
     <DATA-PRINTW .N
		  <+ .NINDEX ,QNEXT>
		  <NTH .MARKV
		       <CHTYPE <DATA-READW .D <+ .CINDEX ,QNEXT>> FIX>>>
     <DATA-PRINTW .N
		  <+ .NINDEX ,ANNEXT>
		  <NTH .MARKV
		       <CHTYPE <DATA-READW .D <+ .CINDEX ,ANNEXT>> FIX>>>
     <MUNG-MAIL-CHAIN .N
		 .D
		 .ASP
		 .SSP
		 .CINDEX
		 .NINDEX
		 .MARKV>
     <MUNG-GRADE-CHAIN .N
		 .D
		 .ASP
		 .SSP
		 .CINDEX
		 .NINDEX
		 .MARKV>
     <SET QASKED
	  <DATA-AREAD .D <+ .CINDEX ,QASKED> <ARESET .SSP>>>
     <MAPF <>
	   <FUNCTION (X) 
		   #DECL ((X) <LIST [REST FIX]>)
		   <COND (<EMPTY? .X>)
			 (T
			  <REPEAT ()
				  <PUT .X 1 <NTH .MARKV <1 .X>>>
				  <COND (<EMPTY? <SET X <REST .X 2>>>
					 <RETURN>)>>)>>
	   .QASKED>
     <DATA-APRINT .N <+ .NINDEX ,QASKED> .SSP .QASKED>
     <COND (<EMPTY? <SET LOSSTABLE <REST .LOSSTABLE 4>>>
	    <RETURN>)>>>

<DEFINE MUNG-MAIL-CHAIN (N D ASP SSP CINDEX NINDEX  MARKV) 
	#DECL ((N D) ASYLUM (ASP SSP) SPACE (CINDEX NINDEX) FIX
	       (MARKV) <UVECTOR [REST FIX]>)
	<REPEAT ((OLD <+ .CINDEX ,MNEXT>) (NEW <+ .NINDEX ,MNEXT>)
		 (NSTART .NEW) CFROB)
		#DECL ((NSTART OLD NEW) FIX (CFROB) VECTOR)
		<COND (<0? <SET OLD <CHTYPE <DATA-READW .D .OLD> FIX>>>
		       <DATA-PRINTW .N .NEW 0>
		       <DATA-PRINTW .N <+ ,MLAST .NINDEX> .NEW>
		       <RETURN>)
		      (T
		       <SET CFROB <DATA-AREAD .D .OLD <ARESET .ASP>>>
		       <SET NEW <1 <DATA-APRINT .N -1 .ASP .CFROB>>>
		       <DATA-PRINTW .N .NSTART .NEW>
		       <SET NSTART .NEW>
		       <PUT .MARKV .OLD .NEW>)>>>

<DEFINE MUNG-GRADE-CHAIN (N D ASP SSP CINDEX NINDEX MARKV) 
	#DECL ((N D) ASYLUM (ASP SSP) SPACE (CINDEX NINDEX) FIX
	       (MARKV) <UVECTOR [REST FIX]>)
	<REPEAT ((OLD <+ .CINDEX ,ANEXT>) (NEW <+ .NINDEX ,ANEXT>)
		 (NSTART .NEW) CFROB)
		#DECL ((NSTART OLD NEW) FIX (CFROB) VECTOR)
		<COND (<0? <SET OLD <CHTYPE <DATA-READW .D .OLD> FIX>>>
		       <DATA-PRINTW .N .NEW 0>
		       <DATA-PRINTW .N <+ ,ALAST .NINDEX> .NEW>
		       <RETURN>)
		      (T
		       <SET CFROB <DATA-AREAD .D .OLD <ARESET .ASP>>>
		       <PUT .CFROB ,AQUES <NTH .MARKV <AQUES .CFROB>>>
		       <SET NEW <1 <DATA-APRINT .N -1 .ASP .CFROB>>>
		       <DATA-PRINTW .N .NSTART .NEW>
		       <SET NSTART .NEW>
		       <PUT .MARKV .OLD .NEW>)>>>

<DEFINE REVERSE (FOO "AUX" (TTE <REST .FOO>) (RETL ())) 
	#DECL ((FOO TTE RETL VALUE) LIST)
	<COND (<EMPTY? .TTE> .FOO)
	      (T
	       <REPEAT ()
		       <SET RETL <PUTREST .FOO .RETL>>
		       <COND (<EMPTY? <SET TTE <REST <SET FOO .TTE>>>>
			      <RETURN <PUTREST .FOO .RETL>>)>>)>>