trivia-1976-1977/trivia/9005143/ar2.tv/recrea.11

<COND (<GASSIGNED? $TLOSE>
       <SETG PG <* 1024 <DIRMAP ,TVASS ,PEEK-PAGE>>>)
      (T
       <SETG HIPOFFSET 23>
       <SETG PEEK-START 7>
       <SETG BABBLE-START 679>
       <SETG ANEXT 1>
       <SETG SCORE 3>
       <SETG QNEXT 0>
       <SETG TELEC-START 343>
       <MANIFEST HIPOFFSET PEEK-START BABBLE-START ANEXT SCORE QNEXT
		 TELEC-START>)>


<DEFINE CONVERT-LOSS ("AUX" HIDX
			    (NUTS
			     <REVERSE
			      <DATA-AREAD ,TVASS ,LUSERS <ARESET ,LOSSSPACE>>>))
	#DECL ((HIDX) FIX (NUTS) <LIST [REST FIX FIX STRING TIME]>)
	<DATA-PRINTW ,TVASS
		     ,HIPOFFSET
		     <SET HIDX </ <LENGTH .NUTS> 4>>>
	<REPEAT ((NNUTS .NUTS) (HIDX 0) PLAYER (TUV ,TUV)
		 (LOC <+ ,PG ,PEEK-START>) (LOC1 <+ ,PG ,BABBLE-START>) LUBLK)
		#DECL ((NNUTS) <LIST [REST FIX FIX STRING TIME]>
		       (HIDX LOC LOC1 LUBLK)  FIX
		       (TUV) <UVECTOR [REST <PRIMTYPE WORD>]> (PLAYER) TIME)
		<SET PLAYER <4 .NNUTS>>
		<SET LUBLK <2 .NNUTS>>
		<PUT .NNUTS 1 .HIDX>
		<GET-LOC .LOC .TUV>
		<PUT .TUV 2 <CHTYPE .PLAYER FIX>>
		<PUT .TUV 3 <CHTYPE <DATA-READW ,TVASS <+ .LUBLK ,LASTIN>> FIX>>
		<PUT-LOC .LOC .TUV>
		<GET-LOC .LOC1 .TUV>
		<PUT .TUV 2 <GETLASTQ .LUBLK>>
		<GET-TOTAL .LUBLK <REST .TUV 2>>
		<PUT-LOC .LOC1 .TUV>
		<COND (<EMPTY? <SET NNUTS <REST .NNUTS 4>>>
		       <DATA-APRINT ,TVASS
				    ,LUSERS
				    ,LOSSSPACE
				    <SETG LOSSTABLE <REVERSE .NUTS>>>
		       <RETURN>)
		      (T
		       <SET LOC <+ .LOC 4>>
		       <SET HIDX <+ .HIDX 1>>
		       <SET LOC1 <+ .LOC1 4>>)>>
	<NEW-TODO>>

<DEFINE GET-TOTAL (LUBLK UV
		   "AUX" (SCORED
			  <DATA-AREAD ,TVASS
				      <+ .LUBLK ,SCORE>
				      <ARESET ,ASPACE>>)
			 (TOTAL 0.000)
			 (POSS 0.000))
	#DECL ((LUBLK) FIX (UV) <UVECTOR [REST <PRIMTYPE WORD>]>
	       (SCORED) <UVECTOR [REST <UVECTOR [2 FLOAT]>]>
	       (TOTAL POSS) FLOAT)
	<MAPF <>
	      <FUNCTION (X) 
		      <SET TOTAL <+ <1 .X> .TOTAL>>
		      <SET POSS <+ <2 .X> .POSS>>>
	      .SCORED>
	<PUT .UV 1 <CHTYPE .TOTAL FIX>>
	<PUT .UV 2 <CHTYPE .POSS FIX>>>

<DEFINE FLUSH-PLAYER (PLAYER "AUX" (LOSSTABLE <DATA-AREAD ,TVASS 3 <ARESET ,QSPACE>>)
	       (RPLAYER <CHTYPE <STRTOX .PLAYER> TIME>)
	       (LUBLK <3 <MEMQ .RPLAYER .LOSSTABLE>>)
	       (TINDEX <4 <MEMQ .RPLAYER .LOSSTABLE>>)
	       (FOO <ALIST <ARESET ,ASPACE> 1>) (TVA ,TVASS) (ASP ,ASPACE))
	#DECL ((PLAYER) STRING (LOSSTABLE) LIST (LUBLK TINDEX) FIX (RPLAYER) TIME)
  <DATA-APRINT .TVA <+ .LUBLK ,QNEXT> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,QNEXT>>
  <DATA-APRINT .TVA <+ .LUBLK ,ANEXT> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,ANEXT>>
  <DATA-APRINT .TVA <+ .LUBLK ,ALAST> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,ALAST>>
  <DATA-DELETE ,TVASS <+ .LUBLK ,SCORE>>
  <DATA-APRINT .TVA <+ .LUBLK ,LASTIN> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,LASTIN>>
  <DATA-APRINT .TVA <+ .LUBLK ,LASTGRD> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,LASTGRD>>
  <DATA-DELETE ,TVASS <+ .LUBLK ,QASKED>>
  <DATA-APRINT .TVA <+ .LUBLK ,MNEXT> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,MNEXT>>
  <DATA-APRINT .TVA <+ .LUBLK ,MLAST> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,MLAST>>
  <DATA-APRINT .TVA <+ .LUBLK ,ANNEXT> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,ANNEXT>>
  <DATA-APRINT .TVA <+ .LUBLK ,TAILOR> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK ,TAILOR>>
  <DATA-APRINT .TVA <+ .LUBLK 11> .ASP .FOO>
  <DATA-DELETE .TVA <+ .LUBLK 11>>
  <COND (<==? <1 .LOSSTABLE> .RPLAYER>
	 <SET LOSSTABLE <REST .LOSSTABLE 4>>)
	(<REPEAT ((L .LOSSTABLE) (M <REST .L>))
		 <COND (<==? <1 .M> .RPLAYER>
			<PUTREST .L <REST .M 4>>
			<RETURN>)>
		 <SET L .M>
		 <SET M <REST .M>>>)>
  <SET LOSSTABLE <ACOPY <ARESET ,LOSSSPACE> .LOSSTABLE>>
  <DATA-APRINT ,TVASS 3 ,LOSSSPACE .LOSSTABLE>
  <DATA-PRINTW ,TVASS ,HIPOFFSET <- <CHTYPE <DATA-READW ,TVASS ,HIPOFFSET> FIX> 1>>
  <GET-LOC <+ ,PG ,PEEK-START <* 4 .TINDEX>> ,TUV>
  <PUT ,TUV 2 0>
  <PUT ,TUV 3 0>
  <PUT ,TUV 4 0>
  <PUT-LOC <+ ,PG ,PEEK-START <* 4 .TINDEX>> ,TUV>
  <SETG LOSSTABLE <DATA-AREAD ,TVASS 3 <ARESET ,LOSSSPACE>>>>

<DEFINE CHAIN-LENGTH (WD "AUX" (CNT 0))
    #DECL ((WD) <PRIMTYPE WORD> (CNT) FIX)
    <REPEAT ((WD <CHTYPE .WD FIX>))
	<COND (<0? <SET WD <CHTYPE <DATA-READW ,TVASS .WD> FIX>>>
	       <RETURN .CNT>)
	      (<SET CNT <+ .CNT 1>>)>>>

<DEFINE NEW-TODO ("AUX" (LOSSTABLE ,LOSSTABLE))
  #DECL ((LOSSTABLE) <LIST [REST TIME STRING FIX FIX]>)
  <REPEAT ((UV <UVECTOR 0 0 0>) (CT 0) (BEG <+ ,PG ,TELEC-START 1>))
	  #DECL ((UV) <UVECTOR <PRIMTYPE WORD>> (CT BEG) FIX)
	<PUT .UV 3 <CHAIN-LENGTH <+ <3 .LOSSTABLE> ,ANEXT>>>
	<PUT-LOC <+ .BEG <* 4 <4 .LOSSTABLE>>> .UV>
	<COND (<EMPTY? <SET LOSSTABLE <REST .LOSSTABLE 4>>>
	       <RETURN>)>>>

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