trivia-1976-1977/trivia/9005143/marc/tvguts.149

<USE "ASYLUM" "MADMAN" "INFERIOR" "MUDTEC">

<SETG FROBS
      '![<ASK.QUESTIONS>					       ;"Answer"
	 <BABBLE-SORT>					       ;"Babble, slowly"
	 <RUNJOB "SYS2;TS BABBLE" "BABBLE" T>		      ;"Babble, quickly"
	 <GRADE.STUFF>						        ;"Grade"
	 <MAKE.QUESTIONS>				       ;"Make questions"
	 <RUNJOB "SYS2;TS TVPEEK" "TVPEEK" <>>				 ;"Peek"
	 <PSCORES>					      ;"Printing scores"
	 <QUIT>							        ;"Leave"
	 <READ.MAIL>						    ;"Read mail"
	 <PRINT.QSCORE>					  ;"Status of questions"
	 <PRINT.QSCORE <>>			  ;"Summary status of questions"
	 <BABBLE-SORT T>					  ;"Tiny babble"
	 <RUNJOB "SYS2;TS TWHOIS" "TWHOIS" T>			   ;"Twhois"!]>

<SETG FROB-NAMES
      '["
Answering Questions.
"
	"
Babbling
"
	"
DDT.babbling
"
	"
Grading/Reading Answers.
"
	"
Making questions
"
	"
Peeking
"
	"
Printing score
"
	"
Quitting
"
	"
Reading mail.	
"
	"
Status of questions
"
	"
Summary status of questions
"
	"
Tiny babbling
"
	"
Twhois
"]>

<SETG TECO <>>

<OR <GASSIGNED? TUV> <SETG TUV <IUVECTOR 4 0>>>

<SETG TTUV <IUVECTOR 1 0>>

<SETG NTTUV <IUVECTOR 1 0>>

<SETG TBUV <IUVECTOR 4 0>>

<SETG FOOUV <IUVECTOR 4 0>>

<SETG CTRLG-KILL <>>

<GDECL (TUV TBUV FOOUV)
       <UVECTOR [4 FIX]>
       (TTUV NTTUV)
       <UVECTOR FIX>
       (CTRLG-KILL)
       <OR ATOM FALSE>>

<SETG STATUS-VECTOR
      '[0
	"Grading"
	1
	"Answer "
	2
	"Babbling"
	3
	"Reading mail"
	4
	"Making "
	5
	"Peek"
	6
	"Start up"
	7
	"Printing score"
	8
	"Command"
	9
	"Updating"
	10
	"Status"
	11
	"FLUSH"
	12
	"ERROR"
	13
	"SHOUT"]>

<DEFINE DFUMP ("OPTIONAL" (FNAM "MADMAN;TV FOO")) 
	#DECL ((FNAM) STRING)
	<DBG>
	<CHAR-INIT>
	<FUMP -1 ,TIME -1 .FNAM>>

<SETG PLAYER-CT 0>

<GDECL (PG PLAYER-CT) FIX (LASTMAIL) WORD>

<DEFINE FUMP (VERSION
	      "OPTIONAL" (SAVER ,TIME) (MODIF 0) (FNAM "MADMAN;TV FILE")
	      "AUX" M PG PLAYERS TEMP PLAYER)
   #DECL ((VERSION MODIF) FIX (M) <OR FALSE LIST> (SAVER) APPLICABLE
	  (PLAYERS) STRUCTURED (PG TEMP) FIX (FNAM) STRING (PLAYER) TIME
	  (IMLAC) <SPECIAL <OR ATOM FALSE>>)
   <SETG ASPACE <AFIND 1>>
   <SETG SSPACE <AFIND 1>>
   <SETG QSPACE <AFIND 1>>
   <SETG TVSPACE ,ASPACE>
   <SETG LOSSSPACE <AFIND 2>>
   <PAGE-GIVE <PAGE-FIND 15> 15>
   <COND
    (<=? <APPLY .SAVER "MADMAN;TRV SAVFIL"> "SAVED">)
    (<AND <DINIT> <>>)
    (<AND <=? <JNAME> "DEBUG"> <MEMQ <CHTYPE <XUNAME> TIME> ,WINNERS>>
     <SETG TVASS <OPEN-DATA-FILE .FNAM <> 7 5>>
     "LOSING")
    (<SETG TVASS <OPEN-DATA-FILE .FNAM <> 7 5>>
     <UNWIND <PROG ()
		   <OR <MEMQ <SETG PLAYER <SET PLAYER <CHTYPE <XUNAME> TIME>>>
			     ,WINNERS>
		       <SETG CTRLG-KILL T>>
		   <PRINC "
TRIVIA.">
		   <PRIN1 .VERSION>
		   <COND (<0? .MODIF>) (<PRINC "."> <PRIN1 .MODIF>)>
		   <CRLF>
		   <IPC-OFF>
		   <IPC-ON <SETG SPLAYER <MYSIXTOS .PLAYER>> "TRIVIA">
		   <COMREP>
		   <INIT>					 ;"SET UP TTY'S"
		   <SET IMLAC?!-CALRDR!-PACKAGE .IMLAC?>
		   <GET-SPACE ,ASPACE>
		   <GET-SPACE ,SSPACE>
		   <GET-SPACE ,QSPACE>
		   <GET-SPACE ,LOSSSPACE>
		   <NEW-LOSS>
		   <RESET ,INCHAN>
		   <COND (<SET M <MEMQ .PLAYER ,LOSSTABLE>>
			  <SETG LUBLK <3 .M>>
			  <SETG TINDEX <4 .M>>
			  <OR <PASS-CHECK <2 .M>> <QUIT>>
			  <PRINC "
Last played ">
			  <PDSKDATE <DATA-READW ,TVASS <+ ,LUBLK ,LASTIN>>>)
			 (<SETG LUBLK <NEW-USER .PLAYER>>)>
		   <AND <SET PG <DIRMAP ,TVASS ,PEEK-PAGE>>
			<DIR-INIT .PG>
			<PUT <MEMQ .PG <5 ,TVASS>> 3 1>
			<SET TEMP
			     <+ ,PEEK-START
				<SETG PG <* .PG 1024>>
				<SETG TINDEX <* ,TINDEX 4>>>>
			<COND (<DHLOCK .TEMP>)
			      (T <VALRET ":KILL
:ALREADY PLAYING
">)>>
		   <UPDATE-BABBLE ,LUBLK ,TINDEX>
		   <PUT ,TUV 2 <CHTYPE .PLAYER FIX>>
		   <PUT ,TUV 3 <CHTYPE <DSKDATE> FIX>>
		   <SET-STATUS ,$SWAKE>
		   <DATA-PRINTW ,TVASS
				<+ ,LUBLK ,LASTIN>
				<SETG DATA-READ-WORD
				      <SETG DATA-WRITE-WORD <DSKDATE>>>>
		   <SETG DATA-AUTHOR-WORD <SQUOZE ,PLAYER>>
		   <SETG LASTMAIL
			 <CHTYPE <1 <GET-LOC <+ ,PG 1 ,TELEC-START ,TINDEX>
					     ,TTUV>>
				 WORD>>
		   <SETG CTRLG-KILL <>>
		   <READ.ANNOUNCE>
		   <PLAY-BALL>>
	     <AND ,CTRLG-KILL <QUIT>>>)
    (<PRINC "
TRIVIA DATA BASE MISSING?
"> <QUIT>)>>

<DEFINE UPDATE-BABBLE (LUBLK TINDEX
		       "AUX" SCORE (TBUV ,TBUV) (PG ,PG) LOC (TTUV ,TTUV))
	#DECL ((LOC LUBLK TINDEX PG) FIX (TBUV) <UVECTOR [3 FIX]>
	       (SCORE) <OR FALSE <UVECTOR [REST UVECTOR]>> (TTUV) <UVECTOR FIX>)
	<PUT-LOC <+ .PG ,TELEC-START .TINDEX 2> <PUT .TTUV 1 0>>
	<SET LOC <+ .PG ,BABBLE-START .TINDEX>>
	<UNWIND <PROG ((TOTAL 0.000) (POSS 0.000))
		      #DECL ((TOTAL POSS) FLOAT)
		      <COND (<DHLOCK .LOC>
			     <SET SCORE
				  <DATA-AREAD ,TVASS
					      <+ .LUBLK ,SCORE>
					      <ARESET ,SSPACE T <>>>>
			     <GET-LOC .LOC .TBUV>
			     <PUT .TBUV 2 <GETLASTQ .LUBLK>>
			     <MAPF <>
				   <FUNCTION (X) 
					   <SET TOTAL <+ .TOTAL <1 .X>>>
					   <SET POSS <+ .POSS <2 .X>>>>
				   .SCORE>
			     <PUT .TBUV 3 <CHTYPE .TOTAL FIX>>
			     <PUT .TBUV 4 <CHTYPE .POSS FIX>>
			     <PUT-LOC .LOC .TBUV>
			     <DUNLOCK .LOC>)
			    (<SLEEP 1> <AGAIN>)>>
		<DUNLOCK .LOC>>>

<SETG VERBOSE <>>

<DEFINE DO-TELECON ("AUX" FX) 
	#DECL ((FX) <OR FALSE FIX>)
	<COND (<SET FX
		    <READER '[] "at intervals of " '["" ""] '["FIX"] ,VERBOSE>>
	       <TELECON .FX>)>>

<SETG TELEC-INTERVAL 0>

<GDECL (TELEC-INTERVAL) FIX>

<DEFINE TELECON (AMT) 
	#DECL ((AMT) FIX)
	<SETG TELEC-INTERVAL .AMT>
	<COND (<GASSIGNED? RTIMINT>)
	      (<SETG RTIMINT <ON "REALT" ,CHECK.MAIL 1>>)>
	<PUT-LOC <+ ,PG ,TELEC-START ,TINDEX 2>
		 <PUT ,TTUV 1 *400000000000*>>
	<REALTIMER .AMT>>

<DEFINE OFFTELECON () 
	<COND (<GASSIGNED? RTIMINT>
	       <SETG TELEC-INTERVAL 0>
	       <OFF ,RTIMINT>
	       <PUT-LOC <+ ,PG ,TELEC-START ,TINDEX 2> <PUT ,TTUV 1 0>>
	       <GUNASSIGN RTIMINT>)>>

<DEFINE CHECK.MAIL ("AUX" LST (UV ,TTUV) (TINDEX ,TINDEX)) 
	#DECL ((LST) WORD (UV) <UVECTOR FIX> (TINDEX) FIX)
	<COND (<==? <CHTYPE <GETBITS <1 <GET-LOC <+ ,PG ,PEEK-START .TINDEX 3>
						 .UV>>
				     <BITS 18 18>>
			    FIX>
		    ,$SREAD>)
	      (<==? <SET LST
			 <CHTYPE <1 <GET-LOC <+ ,TELEC-START ,PG .TINDEX 1>
					     .UV>>
				 WORD>>
		    ,LASTMAIL>)
	      (<SETG LASTMAIL .LST>
	       <SETG EXISTS T>
	       <PRINC "
--MESSAGE HERE--
">)>
	<INT-LEVEL 0>
	<DISMISS T>>

<SETG PNEWMAIL <>>

<SETG EXISTS <>>

<GDECL (PNEWMAIL EXISTS) <OR ATOM FALSE>>

<SETG WINNERS
      (<CHTYPE #WORD *554162430000* TIME>
       <CHTYPE #WORD *644141000000* TIME>
       <CHTYPE #WORD *525542000000* TIME>
       <CHTYPE #WORD *435462000000* TIME>
       <CHTYPE #WORD *604454000000* TIME>)>

"MARC, TAA, JMB, CLR, PDL"

<DEFINE PASS-CHECK (PW "AUX" PS I) 
	#DECL ((PS PW) STRING (I) HANDLER)
	<SET I
	     <ON "CHAR"
		 <FUNCTION (R N) 
			 #DECL ((R) CHARACTER (N) CHANNEL)
			 <COND (<==? .R <ASCII 19>>
				<OR <MEMQ ,PLAYER ,WINNERS> <QUIT>>)>>
		 8
		 0
		 ,INCHAN>>
	<REPEAT ((N 3))
		<RESET .INCHAN>
		<TTYECHO .INCHAN <>>
		<PRINC "
Password: ">
		<READSTRING <SET PS <ISTRING 10>> .INCHAN ,PWTERM>
		<UPPERCASE .PS>
		<TTYECHO .INCHAN T>
		<COND (<=? .PS .PW> <OFF .I> <RETURN T>)
		      (<SET N <- .N 1>> <AND <L? .N 0> <OFF .I> <RETURN <>>>)>>>

<DEFINE NEW-USER (XUNM "AUX" PS VEC (TVA ,TVASS) (LSP ,LOSSSPACE) (SSP ,SSPACE)) 
   #DECL ((PS) STRING (XUNM) TIME (VEC) <UVECTOR [REST UVECTOR]> (TVA) ASYLUM
	  (LSP SSP) SPACE)
   <PROG ()
     <SET PS <ISTRING 10>>
     <PRINC "
Your TRIVIA password: ">
     <RESET .INCHAN>
     <TTYECHO .INCHAN <>>
     <READSTRING .PS .INCHAN ,PWTERM>
     <UPPERCASE .PS>
     <COND (<MEMQ <1 .PS> " 
î">
	    <PRINC "
Illegal password.">
	    <AGAIN>)>
     <TTYECHO .INCHAN T>
     <PRINC "
Please confirm your chosen password,">
     <OR <PASS-CHECK .PS> <AGAIN>>
     <UNWIND
      <PRINT-HELP T>
      <QUIT>>
     <PROG (L)
       #DECL ((L) <OR FALSE FIX>)
       <COND
	(<SET L <DATA-RESERVE .TVA ,LBLEN>>
	 <PROG (CRAZY P)
	   #DECL ((CRAZY) <OR FALSE MANIAC> (P) LIST)
	   <COND
	    (<SET CRAZY <DATA-OPEN "PRINT" .TVA ,LUSERS>>
	     <UNWIND
	      <PROG (TINDEX)
		    #DECL ((TINDEX) FIX)
		    <COND (<==? <SET TINDEX
				     <CHTYPE <DATA-READW .TVA ,HIPOFFSET> FIX>>
				83>
			   <PERR "Can't make NEW-USER--no slots available">)
			  (T
			   <SETG TINDEX .TINDEX>
			   <DATA-PRINTW .TVA ,HIPOFFSET <+ .TINDEX 1>>
			   <SETG PLAYER-CT <+ .TINDEX 1>>)>
		    <SET VEC <AIUVECTOR <ARESET .SSP T <>> ,NCAT <AUVECTOR .SSP>>>
		    <MAPR <>
			  <FUNCTION (X) <PUT .X 1 <AUVECTOR .SSP 0.000 0.000>>>
			  .VEC>
		    <DATA-APRINT .TVA <+ .L ,SCORE> .SSP .VEC>
		    <DATA-APRINT .TVA
			  <+ .L ,QASKED>
			  .SSP
			  <AIVECTOR <ARESET .SSP T <>> ,NCAT <ALIST .SSP>>>
		    <ARESET .LSP T <>>
		    <SET P <DATA-AREAD .TVA ,LUSERS .LSP>>
		    <SET P <ACONS .LSP .TINDEX .P>>
		    <SET P <ACONS .LSP .L .P>>
		    <SET P <ACONS .LSP <ACOPY .LSP .PS> .P>>
		    <SET P <ACONS .LSP .XUNM .P>>
		    <SETG LOSSTABLE .P>
		    <OR <DATA-IPRINT .TVA .CRAZY .LSP .P>
			<PERR "Can't print NEW-USER">>
		    <DATA-CLOSE .TVA .CRAZY>>
	      <DATA-CLOSE .TVA .CRAZY>>
	     <DATA-PRINTW .TVA <+ .L ,QNEXT> ,LOWQUES>
	     <DATA-PRINTW .TVA <+ .L ,ALAST> <+ .L ,ANEXT>>
	     <DATA-PRINTW .TVA <+ .L ,MLAST> <+ .L ,MNEXT>>
	     <DATA-PRINTW .TVA <+ .L ,ANNEXT> ,LOMAIL>
	     .L)
	    (<AGAIN>)>>)
	(<AGAIN>)>>>>

<DEFINE PRINT-HELP ("OPTIONAL" (NEW-PLAYER? <>))
  #DECL ((NEW-PLAYER?) <OR ATOM FALSE>)
  <COND (.NEW-PLAYER?
	 <CRLF>
	 <PRINC ,NEWMSG>)>
  <COND (<RUNJOB "SYS1;TS PR" "TVDOC" <COND (.NEW-PLAYER? "HELP")
					    (T)>>)>>

<SETG LOSEMSG
      "
Full documentation can be found in MADMAN;TVDOC > and MADMAN;TVUPD >.">

<SETG NEWMSG
      
"
The following information has been found more or less essential to new
TRIVIA users.  Please read it.">

<DEFINE COMMAND ("AUX" RD) 
	#DECL ((RD) <OR FALSE SYMBOL>)
	<REPEAT ()
		<AND ,PNEWMAIL ,EXISTS <READ.MAIL>>
		<AND ,FLUSH <FLUSH-EM>>
		<SET-STATUS ,$SCOM>
		<COND (<SET RD <READER ,MCOMS "
@" '["" ""] '["SYM"] <>>>
		       <EVAL <2 .RD>>)>>>

<SETG COMS
      <MAKEBST "COMMANDS"
	       '["Announce"
		 <ANNOUNCE>
		 "Answer"
		 <ASK.QUESTIONS>
		 "Auto.read"
		 <COND (<SETG PNEWMAIL <NOT ,PNEWMAIL>>
			<PRINC "
Automatic reading">)
		       (T <PRINC "
Manual reading">)>
		 "Babble"
		 <BABBLE-SORT>
		 "DDT.babble"
		 <RUNJOB "SYS2;TS BABBLE" "BABBLE" T>
		 "End.teleconference"
		 <OFFTELECON>
		 "Grade"
		 <GRADE.STUFF>
		 "Help"
		 <PRINT-HELP>
		 "Intest"
		 <PROG ()
		       <READ.ANNOUNCE>
		       <PLAY-BALL>>
		 "Kill.teco"
		 <TECO-KILL>
		 "Load.scores"
		 <MOBY-VEC>
		 "Make"
		 <MAKE.QUESTIONS>
		 "No.simple"
		 <COND (<SETG IGNORE-SIMPLE <NOT ,IGNORE-SIMPLE>>
			<PRINC "
Ignore simple questions">)
		       (<PRINC "
Read simple questions">)>
		 "Peek"
		 <RUNJOB "SYS2;TS TVPEEK" "TVPEEK" <>>
		 "Print.score"
		 <PSCORES>
		 "Question.print"
		 <PRINT.QSCORE T T>
		 "Quit"
		 <QUIT>
		 "Read.mail"
		 <READ.MAIL>
		 "Rpeek"
		 <RUNJOB "SYS2;TS TVPEEK" "TVPEEK" "R">
		 "Safety"
		 <COND (<SETG BUFSAFE <NOT ,BUFSAFE>> <PRINC "
Safe">)
		       (<PRINC "
Sorry">)>
		 "Save.tailor"
		 <SAVE-TAILOR>
		 "Send.mail"
		 <SEND.MAIL>
		 "Sequence"
		 <GET-SEQUENCE>
		 "Shout"
		 <SHOUT>
		 "Simple.load"
		 <LOAD.SIMPLE>
		 "Simple.print"
		 <PRINT.SIMPLE>
		 "Simple.update"
		 <UPDATE.QUESTION <>>
		 "Status.of.question"
		 <PRINT.QSCORE>
		 "Summary.status.of.question"
		 <PRINT.QSCORE <>>
		 "Teleconference"
		 <DO-TELECON>
		 "Tiny.babble"
		 <BABBLE-SORT T>
		 "Tvbug"
		 <RUNJOB "SYS2;TS TVBUG" "TVBUG" <>>
		 "Tvtodo"
		 <RUNJOB "SYS2;TS TVTODO" "TVTODO" T>
		 "Twhois"
		 <RUNJOB "SYS2;TS TWHOIS" "TWHOIS" T>
		 "Update.question"
		 <UPDATE.QUESTION>
		 "Verbosity"
		 <COND (<SETG VERBOSE <NOT ,VERBOSE>> <PRINC "
Verbose">)
		       (<PRINC "
Unverbose">)>
		 "Which.teco"
		 <GET-TECO>]>>

<SETG BUFSAFE <>>

<SETG DCOMS <MAKESST "DCOM" []>>

<SETG MCOMS <MAKEMST "MCOM" [,COMS ,DCOMS]>>

<SETG DCOM
      '["Recurse"
	<RECURSE>
	"Play"
	<PLAY>
	"Erret"
	<DO-ERRET>
	"Evaluate"
	<DO-EVAL>]>

<SETG DP " with JCL of ">

<GDECL (DP) STRING>

<DEFINE RUNJOB (FILE JNAME JCL? "AUX" (JCL <>) (JOB <>))
  #DECL ((FILE JNAME) STRING (JCL?) <OR STRING ATOM FALSE> (JCL) <OR FALSE STRING>
	 (JOB) <OR FALSE INF>)
  <COND (.JCL?
	 <COND (<TYPE? .JCL? STRING>
		<SET JCL .JCL?>)
	       (T
		<SET JCL <READER [] ,DP "" ["LINE"] ,VERBOSE>>)>)>
  <CRLF>
  <UNWIND
   <COND (<SET JOB <INF-LOAD .FILE .JNAME .JCL>>
	  <INF-START .JOB>
	  <OR <NOT <2 .JOB>>
	      <INF-KILL .JOB>>)
	 (T
	  <CRLF>
	  <PRIN1 .JOB>)>
   <AND .JOB <2 .JOB> <INF-KILL .JOB>>>>

<DEFINE DO-ERRET () <ERRET <READER '[] "" "" '["ANY"] <>>>>

<DEFINE DO-EVAL () <AND <MEMQ <CHTYPE <XUNAME> TIME> ,WINNERS>
			<EVAL <READER '[] "" "" '["ANY"] <>>>>>

<SETG DEBUGSW <>>

<DEFINE DBG () <PUT ,DCOMS 2 ,DCOM> <SETG DEBUGSW T>>

<SETG FLUSH <>>

<SETG QTYPES
      <MAKEBST "QT"
	       '["Command"
		 1
		 "Joint"
		 8
		 "Long Answer"
		 2
		 "Matching"
		 3
		 "Multiple Choice"
		 4
		 "None"
		 0
		 "Quit"
		 6
		 "Ranking"
		 9
		 "Simple"
		 7
		 "True/False"
		 5]>>

<SETG CATS
      <MAKEBST "CAT"
	       '["Athletics"
		 1
		 "Cinema"
		 2
		 "Events"
		 3
		 "General"
		 4
		 "History"
		 5
		 "Literature"
		 6
		 "Music"
		 7
		 "Science Fiction"
		 8
		 "TV/Radio"
		 9]>>

<DEFINE QUESTIONABLE? (STR) 
	#DECL ((STR) STRING)
	<NOT <MAPF <>
		   <FUNCTION (X) <COND (<G? <ASCII .X> 32> <MAPLEAVE T>)>>
		   .STR>>>

<DEFINE TP (QUESTION)			      ;"Hack to get Q's to print evenly"
	#DECL ((QUESTION) STRING)
	<COND (<L=? <14 .OUTCHAN> 40> <PUT .OUTCHAN 14 41>)>
	.QUESTION>

<DEFINE UNTASTEFUL-CODE (Q "OPTIONAL" (GST <>) (LETR <>) "AUX" (IDX 0)) 
	#DECL ((Q) STRUCTURED (GST LETR) <OR 'T FALSE> (IDX) FIX)
	<MAPF ,VECTOR
	      <FUNCTION (X) 
		      <SET IDX <+ .IDX 1>>
		      <COND (<AND <1? .IDX> .GST>
			     <MAPRET 2
				     ,MATCH-HACK
				     <STRING <UNPARSE .IDX>
					     ".     "
					     .X>
				     0>)>
		      <MAPRET <STRING <COND (.LETR <ASCII <+ .IDX 96>>)
						   (<UNPARSE .IDX>)>
				      ".     "
				      .X>
			      <COND (.GST 0) (.IDX)>>>
	      .Q>>

<DEFINE FLUSH-EM () 
	<COND (<==? ,FLUSH SYSDOWN>
	       <OUT SYSTEM\ GOING\ DOWN>)
	      (<==? ,FLUSH SHOUT> <SETG FLUSH <>> <PRINT.SHOUT>)
	      (<==? ,FLUSH PURGE> <OUT EXCESSIVE-SYSTEM-LOAD>)
	      (<==? ,FLUSH TECO>
	       <SETG FLUSH <>>
	       <COND (,TECO
		      <TECO-KILL>
		      <PRINC "
TECO killed to free system resources.
">)>)
	      (T <OUT ,FLUSH>)>>

<DEFINE OUT (WHY? "AUX" MSG)
  #DECL ((WHY?) ATOM (MSG) <VECTOR TIME STRING>)
  <SET-STATUS ,$SFLUSH>
  <OFF "CHAR" ,INCHAN>
  <IPC-OFF>
  <INT-LEVEL 999>
  <COND (<==? .WHY? T>
	 <SET MSG <DATA-AREAD ,TVASS ,SHOUTMSG <ARESET ,ASPACE T <>>>>
	 <CRLF>
	 <PRINC "TRIVIA brought down by ">
	 <PRINC <1 .MSG>>
	 <CRLF>
	 <PRINC <2 .MSG>>)
	(T
	 <PRINC "TRIVIA brought down due to ">
	 <PRINC .WHY?>)>
  <VALRET ":KILL
:
TRIVIA DOWN!

">>

<DEFINE PRINT.SHOUT ("AUX" (MSG
			    <DATA-AREAD ,TVASS ,SHOUTMSG <ARESET ,ASPACE T <>>>))
	#DECL ((MSG) <VECTOR TIME STRING>)
	<CRLF>
	<CRLF>
	<CRLF>
	<IMAGE 7>
	<IMAGE 7>
	<IMAGE 7>
	<PRINC "Message from ">
	<6PRINC <1 .MSG>>
	<CRLF>
	<PRINC <2 .MSG>>
	<CRLF>>

<DEFINE FLUSH-TECOS ()
	<COND (<MEMQ ,PLAYER ,WINNERS>
	       <SEND-TRIVIAS TECO>)>>

<DEFINE SHOUT ("AUX" MSG ID (TVA ,TVASS) (ASP ,ASPACE)) 
   #DECL ((MSG) STRING (ID) <OR FALSE MANIAC> (TVA) ASYLUM (ASP) SPACE)
   <COND (<MEMQ ,PLAYER ,WINNERS>
	  <SET MSG <GETBUF "Message: ">>
	  <COND (<NOT <QUESTIONABLE? .MSG>>
		 <COND (<SET ID <DATA-OPEN "PRINT" .TVA ,SHOUTMSG>>
			<DATA-IPRINT .TVA
				     .ID
				     .ASP
				     <AVECTOR <ARESET .ASP T <>>
					      ,PLAYER
					      <ACOPY .ASP .MSG>>>
			<SEND-TRIVIAS SHOUT>
			<DATA-CLOSE .TVA .ID>)
		       (<CRLF>
			<PRINC 
"The right hand knows not what the left hand does.">
			<CRLF>)>)>)>>

<DEFINE FLUSH-ALL ("OPTIONAL" (WHY? <>) "AUX" ID CH MSG (TVA ,TVASS) (ASP ,ASPACE)) 
	#DECL ((WHY?) <OR ATOM FALSE> (MSG) STRING (CH) <OR CHANNEL FALSE>
	       (ID) <OR MANIAC FALSE> (TVA) ASYLUM (ASP) SPACE)
	<COND (<MEMQ ,PLAYER ,WINNERS>
	       <CRLF>
	       <OR <SET CH <OPEN "PRINT" "_MSGS_;TRIVIA DEATH">>
		   <ERROR .CH>>
	       <COND (.WHY?
		      <MSGOUT .WHY? .CH>
		      <SEND-TRIVIAS .WHY?>)
		     (T
		      <SET MSG <GETBUF "Message:  ">>
		      <COND (<NOT <QUESTIONABLE? .MSG>>
			     <COND (<SET ID <DATA-OPEN "PRINT" .TVA ,SHOUTMSG>>
				    <DATA-IPRINT .TVA .ID .ASP
						 <AVECTOR <ARESET .ASP T <>>
							  ,PLAYER
							  <ACOPY .ASP .MSG>>>
				    <MSGOUT .MSG .CH>
				    <SEND-TRIVIAS T>
				    <DATA-CLOSE .TVA .ID>)
				   (T
				    <CRLF>
				    <PRINC "One at a time, please!">
				    <CRLF>)>)>)>)
	      (<QUIT>)>>

<DEFINE MSGOUT (MSG CH) #DECL ((MSG) <OR ATOM STRING> (CH) CHANNEL)
   <PRINC "TRIVIA brought down by " .CH>
   <PRINC ,PLAYER .CH>
   <CRLF .CH>
   <PRINC .MSG .CH>
   <CLOSE .CH>>

<DEFINE SEND-TRIVIAS (WHAT?
		      "AUX" (PG ,PG) (UV ,FOOUV) (SENDER ,PLAYER)
			    (MSG <STRING "<SETG FLUSH " <UNPARSE .WHAT?> ">">))
	#DECL ((WHAT?) ANY (PG) FIX (UV) <UVECTOR [4 FIX]> (MSG) STRING (SENDER) TIME)
	<SET-STATUS ,$SHOUT>
	<REPEAT ((N 0) (LOC <+ .PG ,PEEK-START>) LOSER)
		#DECL ((N LOC) FIX (LOSER) TIME)
		<COND (<G? .N 83> <RETURN>)
		      (<AND <GET-LOC .LOC .UV> <0? <1 .UV>>>
		       <COND (<==? <SET LOSER <CHTYPE <2 .UV> TIME>> .SENDER>)
			     (T
			      <SEND <MYSIXTOS .LOSER> "TRIVIA" .MSG *400000000000*>
			      <6PRINC .LOSER>
			      <CRLF>)>)>
		<SET N <+ .N 1>>
		<SET LOC <+ .LOC 4>>>>

<SETG GIVEUP <MAKESST "GIVE" ["
Give up (CR)" <>]>>

<SETG SYMTAB <MAKESST "SYMS" []>>

<SETG ALLSYMS <MAKEMST "ALLSYMS" [,GIVEUP ,SYMTAB]>>

<SETG ALWAYS-ANSWER <>>

<SETG KEEPASKING <>>

<SETG IGNORE-SIMPLE <>>

<SETG T/F <MAKESST "T/F" ["Yes" T "No" <>]>>

<DEFINE TRUE? (STR1 STR2 TRUELST FALSELST "OPTIONAL" INTCHR "AUX" CHR) 
	#DECL ((STR1 STR2) STRING (INTCHR CHR) CHARACTER (TRUELST FALSELST) STRING)
	<PROG ()
	      <PRINC .STR1>
	      <RESET ,INCHAN>
	      <PRINC " (">
	      <PRINC .STR2>
	      <PRINC ") ">
	      <SET CHR <TYI>>
	      <COND (<AND <ASSIGNED? INTCHR> <==? .CHR .INTCHR>>
		     <INTERRUPT "CHAR" .INTCHR ,INCHAN>)>
	      <COND (<MEMQ .CHR .TRUELST>)
		    (<MEMQ .CHR .FALSELST> <>)
		    (<AGAIN>)>>>

<DEFINE SEND-PLAYER (WHO WHAT
		     "OPTIONAL" (WHR ,ALAST) (MUNG-SLOT? <>) (MUNG-SLOT1? <>)
		     (ASP ,ASPACE) "AUX" (TVA ,TVASS) (TTUV ,NTTUV) NUTS LAST
			   LOC)
   #DECL ((WHO) TIME (WHAT) ANY (ASP) SPACE (NUTS) LIST (LOC LAST WHR) FIX
	  (TVA) ASYLUM (MUNG-SLOT MUNG-SLOT1) <OR FIX FALSE>
	  (TTUV) <UVECTOR FIX> (MUNG-SLOT? MUNG-SLOT1?) <OR FIX FALSE>)
   <COND (<==? ,PLAYER ,DEBUGNAME>)
	 (<SET NUTS <GET-LOSER .WHO>>
	  <SET LAST <+ .WHR <3 .NUTS>>>
	  <COND (.MUNG-SLOT?
		 <SET LOC <+ ,PG <* 4 <4 .NUTS>> .MUNG-SLOT?>>
		 <UNWIND <PROG ()
			       <COND (<DHLOCK .LOC>
				      <GET-LOC .LOC .TTUV>
				      <PUT .TTUV 1 <CHTYPE <4 .WHAT> FIX>>
				      <PUT-LOC <+ .LOC 1> .TTUV>
				      <DUNLOCK .LOC>)
				     (<SLEEP 2> <AGAIN>)>>
			 <DUNLOCK .LOC>>)
		(.MUNG-SLOT1?
		 <SET LOC <+ 3 ,PG <* 4 <4 .NUTS>> .MUNG-SLOT1?>>
		 <GET-LOC .LOC .TTUV>
		 <PUT .TTUV 1 <+ <1 .TTUV> 1>>
		 <PUT-LOC .LOC .TTUV>)>
	  <COND (<CHAIN-APPEND .TVA .ASP .WHAT .LAST>
		 <CRLF>
		 <PRINC "Sent.">)
		(<PERR "SEND-PLAYER FAILURE -- PLEASE REPORT TO MARC">)>)>>

<DEFINE NEW-LOSS ("AUX" NUTS) 
	#DECL ((NUTS) <OR LIST FALSE>)
	<COND (<N==? ,PLAYER-CT
		     <SETG PLAYER-CT
			   <CHTYPE <DATA-READW ,TVASS ,HIPOFFSET> FIX>>>
	       <GUNASSIGN PLAYER-SYMS>
	       <COND (<SET NUTS <DATA-AREAD ,TVASS ,LUSERS <ARESET ,LOSSSPACE T <>>>>
		      <SETG LOSSTABLE .NUTS>
		      .NUTS)
		     (T
		      <PERR "Can't read losstable--your TRIVIA is DEAD"
			    .NUTS
			    NEW-LOSS>)>)
	      (T ,LOSSTABLE)>>

<DEFINE CHAIN-APPEND (TVA TVS WHAT CHAIN "AUX" OINT) 
	#DECL ((TVA) ASYLUM (TVS) SPACE (WHAT) ANY (OINT CHAIN) FIX)
	<SET OINT <INT-LEVEL 20>>
	<PROG (FROB HIA WHR RETVAL)
	      #DECL ((FROB HIA) <OR FALSE MANIAC> (RETVAL WHR) FIX)
	      <COND (<SET FROB <DATA-APRINT .TVA -1 .TVS .WHAT>>
		     <OR <0? <CHTYPE <DATA-READW .TVA <SET RETVAL <1 .FROB>>>
				     FIX>>
			 <AND <INT-LEVEL 0>
			      <PERR "Non-zero chain pointer"
				    CHAIN-APPEND
				    .FROB>>>
		     <COND (<AND <SET HIA <DATA-OPEN "PRINTW" .TVA .CHAIN>>
				 <SET WHR <CHTYPE <DATA-READW .TVA .CHAIN> FIX>>
				 <DATA-PRINTW .TVA .WHR .RETVAL>
				 <DATA-PRINTW .TVA .HIA .RETVAL>>
			    <INT-LEVEL .OINT>
			    .RETVAL)
			   (<AND <NOT .HIA> <MEMQ <1 .HIA> '(5 6)>>
			    <STALL <1 .HIA>>
			    <AGAIN>)
			   (<PERR "Can't CHAIN-APPEND" .FROB .HIA>)>)
		    (<MEMQ <1 .FROB> '(5 6)> <STALL <1 .FROB>> <AGAIN>)
		    (<INT-LEVEL 0>
		     <PERR "Can't PRINT append, CHAIN-APPEND" .FROB>)>>>

<DEFINE STALL (WHY) 
	#DECL ((WHY) FIX)
	<PRINC "
NON-FATAL TIME OUT, STALLING BECAUSE --">
	<PRINC <NTH ,DATA-ERRORS .WHY>>
	<SLEEP 4>>

<DEFINE GET-LOSER (PLAYER "AUX" (NUTS ,LOSSTABLE) OINT) 
	#DECL ((PLAYER) TIME (NUTS) <OR LIST FALSE> (OINT) FIX)
	<SET OINT <INT-LEVEL 20>>
	<COND (<SET NUTS <MEMQ .PLAYER .NUTS>>)
	      (<SET NUTS <NEW-LOSS>>
	       <COND (<SET NUTS <MEMQ .PLAYER .NUTS>>)
		     (<PERR "Player does not exist!!" .PLAYER GET-LOSER>)>)>
	<INT-LEVEL .OINT>
	.NUTS>

<DEFINE ADDSCORE (WHO QUES AMT
		  "AUX" (NUTS <GET-LOSER .WHO>) (TVA ,TVASS) (SSP ,SSPACE) ID
			SCORE SCUVEC LBLK CATSCR OINT)
   #DECL ((WHO) TIME (QUES) VECTOR (AMT) <OR FIX FLOAT> (TVA) ASYLUM
	  (NUTS) LIST (SSP) SPACE (ID) <OR MANIAC FALSE> (SCORE) WORD
	  (SCUVEC) <UVECTOR [REST <UVECTOR FLOAT FLOAT>]>
	  (OINT LBLK) FIX (CATSCR) <UVECTOR FLOAT FLOAT>)
   <COND
    (<==? ,PLAYER ,DEBUGNAME>)
    (<SET OINT <INT-LEVEL 20>>
     <COND
      (<SET ID <DATA-OPEN "PRINTW" .TVA <NTH .QUES ,QSCORE>>>
       <SET SCORE <DATA-READW .TVA <1 .ID>>>
       <SET SCORE
	    <PUTBITS .SCORE
		     <BITS 18 18>
		     <CHTYPE <+ 1 <CHTYPE <GETBITS .SCORE <BITS 18 18>> FIX>>
			     WORD>>>
       <DATA-PRINTW
	.TVA
	.ID
	<PUTBITS .SCORE
		 <BITS 18 0>
		 <CHTYPE <+ <FIX <* 1000 .AMT>>
			    <CHTYPE <GETBITS .SCORE <BITS 18 0>> FIX>>
			 WORD>>>)
      (<INT-LEVEL 0> <PERR "Can't update QUESTION-SCORE" .QUES>)>
     <SET LBLK <3 .NUTS>>
     <PROG (QVAL (TBUV ,TBUV) (TINDEX <4 .NUTS>)
	    (LOC <+ ,PG ,BABBLE-START <* 4 .TINDEX>>))
	   #DECL ((QVAL) FLOAT (TBUV) <UVECTOR [4 FIX]> (TINDEX LOC) FIX)
	   <COND
	    (<SET ID <DATA-OPEN "PRINT" .TVA <+ .LBLK ,SCORE>>>
	     <SET SCUVEC <DATA-IREAD .TVA .ID <ARESET .SSP T <>>>>
	     <SET CATSCR <NTH .SCUVEC <NTH .QUES ,QCAT>>>
	     <PUT .CATSCR 1 <FLOAT <+ .AMT <1 .CATSCR>>>>
	     <PUT .CATSCR
		  2
		  <+ <SET QVAL <FLOAT <NTH .QUES ,QVAL>>> <2 .CATSCR>>>
	     <DATA-IPRINT .TVA .ID .SSP .SCUVEC>
	     <PROG ()
		   <COND (<DHLOCK .LOC>
			  <GET-LOC .LOC .TBUV>
			  <PUT .TBUV
			       3
			       <CHTYPE <+ <CHTYPE <3 .TBUV> FLOAT> <FLOAT .AMT>>
				       FIX>>
			  <PUT .TBUV
			       4
			       <CHTYPE <+ <CHTYPE <4 .TBUV> FLOAT> .QVAL> FIX>>
			  <PUT-LOC .LOC .TBUV>
			  <DUNLOCK .LOC>)
			 (<SLEEP 2> <AGAIN>)>>
	     <DATA-CLOSE .TVA .ID>)
	    (<MEMQ <1 .ID> '(5 6)> <STALL <1 .ID>> <AGAIN>)
	    (<INT-LEVEL 0>
	     <PERR "Can't update PLAYER-SCORE" .WHO .AMT .NUTS>)>>
     <INT-LEVEL .OINT>)>>

<DEFINE PERR (STR "TUPLE" ARG) 
	#DECL ((STR) STRING (ARG) TUPLE)
	<SET-STATUS ,$SERROR>
	<CRLF>
	<PRINC "ERROR, ">
	<PRINC .STR>
	<PRINC ".  ">
	<SETG REP ,SAVEREP>
	<COND (<NOT ,CTRLG-KILL>
	       <SEND-ERROR .STR .ARG>)>
	<ERROR TRIVIA-LOSSAGE!-ERRORS !.ARG>>

<SETG TAASIX <CHTYPE -12322603008 TIME>>

<SETG MARCSIX <CHTYPE -19834195968 TIME>>

<MANIFEST TAASIX MARCSIX>

<SETG TAASTR "TAA">

<SETG MARCSTR "MARC">

<SETG MAINT "MARC or TAA">

<DEFINE SEND-ERROR (STR ARG "AUX" IT)
  #DECL ((STR) STRING (IT) FIX (ARG) TUPLE)
  <COND (<OR <AND <SET IT <IDLE-TIME ,TAASIX>>
		  <L? .IT 600>
		  <CLI-SEND ,TAASTR .STR .ARG>>
	     <AND <SET IT <IDLE-TIME ,MARCSIX>>
		  <L? .IT 600>
		  <CLI-SEND ,MARCSTR .STR .ARG>>>)
	(T
	 <PRINC "Please report to ">
	 <PRINC ,MAINT>)>>

<DEFINE CLI-SEND (PLAYER MSG ARG "AUX" CH)
  #DECL ((CH) <OR CHANNEL FALSE> (PLAYER) STRING)
  <COND (<AND <N=? ,SPLAYER .PLAYER>
	      <SET CH <OPEN "PRINT" .PLAYER "HACTRN" "CLI">>>
	 <PRINC ,SPLAYER .CH>
	 <CRLF .CH>
	 <PRINC .MSG .CH>
	 <MAPF <> <FUNCTION (X) <PRINT .X .CH>> .ARG>
	 <CLOSE .CH>
	 <CRLF>
	 <PRINC <7 .CH>>
	 <PRINC " is on line and has been informed.">)>>

<SETG WHOSYMS <MAKESST "FOO" []>>

<DEFINE P-SYMS ("AUX" (NUTS <NEW-LOSS>) (CURSPACE ,LOSSSPACE)
		(LS ,LOSSSPACE)) 
   #DECL ((NUTS) LIST (CURSPACE) <SPECIAL SPACE> (LS) SPACE)
   <COND (<GASSIGNED? PLAYER-SYMS> ,PLAYER-SYMS)
	 (<SETG PLAYER-SYMS
	   <PUT ,WHOSYMS
		2
		<MAPR ,ALVECTOR
		      <FUNCTION (X) 
			      <COND (<==? 1 <1 .X>> <MAPRET>)
				    (<TYPE? <1 .X> TIME>
				     <MAPRET <ASTRING .LS <MYSIXTOS <1 .X>>> <3 .X>>)
				    (<MAPRET>)>>
		      .NUTS>>>)>>

<DEFINE SEND.MAIL ("AUX" (ASP <ARESET ,ASPACE T <>>) WHO LST MSG) 
   #DECL ((ASP) SPACE (WHO) <OR FALSE VECTOR> (LST) <LIST [REST SYMBOL]>
	  (MSG) STRING)
   <COND
    (<SET WHO <READARGS <P-SYMS> "To " '["" ""] '["SYM" "MULT"]>>
     <COND (<EMPTY? <SET LST <1 .WHO>>>)
	   (<SET MSG <GETBUF "Message: " .ASP>>
	    <MAPF <>
		  <FUNCTION (X) 
			  <SEND-PLAYER <CHTYPE <STRTOX <1 .X>> TIME>
				       <AVECTOR .ASP
						.MSG
						1
						,PLAYER
						<DSKDATE>>
				       ,MLAST
				       ,TELEC-START>>
		  .LST>)>)>>

<DEFINE CHAIN-FOLLOW (APP FROM TO "OPTIONAL" (FROB? <>)
		      "AUX" (TVA ,TVASS)
			    (LO <CHTYPE <DATA-READW .TVA <+ ,LUBLK .FROM>> FIX>)
			    (ASP <ARESET ,ASPACE T <>>) (TTUV ,NTTUV) MAIL NEXT)
	#DECL ((TVA) ASYLUM (LO FROM TO) FIX (ASP) SPACE
	       (MAIL) <OR FALSE VECTOR> (NEXT) WORD (TTUV) <UVECTOR <PRIMTYPE WORD>>
	       (APP) <VECTOR [REST APPLICABLE]> (FROB?) <OR FIX FALSE>)
	<COND (<0? .LO> #FALSE ())
	      (<SET MAIL <DATA-AREAD .TVA .LO .ASP>>
	       <APPLY <NTH .APP <NTH .MAIL ,ATYPE>> .MAIL>
	       <AND .FROB?
		    <GET-LOC .FROB? .TTUV>
		    <PUT-LOC .FROB? <PUT .TTUV 1 <- <1 .TTUV> 1>>>>
	       <DATA-PRINTW .TVA
			    <+ ,LUBLK .FROM>
			    <SET NEXT <DATA-READW .TVA .LO>>>
	       <COND (<==? .NEXT #WORD *000000000000*>
		      <DATA-PRINTW .TVA <+ ,LUBLK .TO> <+ ,LUBLK .FROM>>)>
	       <DATA-DELETE .TVA .LO>)>>

<DEFINE VERBOHACK ("TUPLE" TUP) 
	<CRLF>
	<COND (<SETG KEEPASKING <NOT ,KEEPASKING>>
	       <PRINC "Continuous questions mode">
	       <AND <ASSIGNED? topask>
		    <LEGAL? .topask>
		    <RETURN T .topask>>)
	      (<PRINC "One at a time mode">)>
	<CRLF>>

<DEFINE ANSHACK () 
	<CRLF>
	<COND (<SETG ALWAYS-ANSWER <NOT ,ALWAYS-ANSWER>>
	       <PRINC "Always give answer mode">
	       <AND <ASSIGNED? topask>
		    <LEGAL? .topask>
		    <RETURN T .topask>>)
	      (<PRINC "Dont give answers">)>
	<CRLF>>

<DEFINE ANSWERHACK ("TUPLE" X) 
	<PROG ()
	      <COND (<AND <ASSIGNED? Q.A>
			  <ASSIGNED? BUF>
			  <==? <NTH .Q.A ,QTYPE> ,$TLONG>>
		     <ADDSTRING .BUF <NTH .Q.A 10>>
		     <PRINC "[Answer added]">)
		    (<ANSHACK>)>>>

<DEFINE CHAR-INIT ("AUX" FOO)
	#DECL ((FOO) <VECTOR [REST CHARACTER <OR APPLICABLE FORM>]>) 
	<CALRDRINIT>
	<SETG SPCCHARS <STRING <ASCII 22> !,SPCCHARS>>
	<SET FOO <MEMQ <ASCII 12> .CHRTABLE>>
	<PUT .FOO 2 ,BUFHACK>
	<SET CHRTABLE
	     [<ASCII 20> ,ANSWERHACK <ASCII 22> ,VERBOHACK !.CHRTABLE]>
	<SET FOO <MEMQ <ASCII 5> .CHRTABLE>>
	<PUT .FOO 2 ,BUFTECO>
	<SET FOO <MEMQ <ASCII 12> ,XSPCCHARS>>
	<PUT .FOO 2 '<CLEAR>>
	<SETG XSPCCHARS
	      [<ASCII 20> '<ANSHACK> <ASCII 22> '<VERBOHACK> !,XSPCCHARS]>
	<SETG INPUT-INT <ON "CHAR" ,CHARINT 8 0 ,INCHAN>>
	'<SETG MORE-INT <ON "CHAR" ,MORE-HANDLE 8 0 ,OUTCHAN>>>

<DEFINE GET-TECO ("AUX" EDT FIL TEMP)
  #DECL ((EDT) <LIST [REST TIME]> (FIL TEMP) STRING)
  <PRINC "Please give the name of the TECO  you desire:  'E', 'RMODE',
or whatever.  ">
  <PROG ()
    <COND (<NOT <EMPTY? <SET TEMP <READER [] "Program name " "" ["LINE"] ,VERBOSE>>>>
	   <SET EDT <BUFLEX .TEMP ,DBRKS>>
	   <COND (<==? <LENGTH .EDT> 1>
		  <SET FIL <MYSIXTOS <1 .EDT>>>
		  <SETG TECO-PROGRAM .FIL>
		  <CRLF>
		  <PRINC "Using 'TS ">
		  <PRINC .FIL>
		  <PRINC "' as TECO">)
		 (T
		  <PRINC
"I can't understand that.  Please type the name of the job to run,
e.g., TECO, EMACS, RMODE, etc.
">
		  <AGAIN>)>)>>>

<DEFINE CLEAR () 
	<PRINC "C">
	<COND (<ASSIGNED? QUESTION?>
	       <PQHEADER .QUESTION?>
	       <COND (<==? <NTH .QUESTION? ,QTYPE> ,$TMATCH>
		      <MATCH-PRINT <REST .QUESTION? ,QQUES>>)
		     (<==? <NTH .QUESTION? ,QTYPE> ,$TRANK>
		      <PRINC <NTH .QUESTION? <+ ,QQUES 4>>>
		      <CRLF>
		      <PRINC "Number to rank: ">
		      <PRIN1 <NTH .QUESTION? <+ ,QQUES 5>>>
		      <CRLF>
		      <SSTPOSSYM!-ICALSYM "" 0 <2 .TBL>>)
		     (<PRINC <NTH .QUESTION? <+ ,QQUES 1>>>)>)
	      (<ASSIGNED? Q.A>
	       <TERPRI>
	       <PRINC "Answer from ">
	       <PRINC <NTH .A ,AAUTH>>
	       <PRINC ": ">
	       <PRINC <NTH .A ,ARESP>>)>
	<COND (<GASSIGNED? MATCH>
	       <TERPRI>
	       <PRINC "Match ">
	       <PRINC ,MATCH>)
	      (<ASSIGNED? MARKING>
	       <PRINC "
Score (out of ">
	       <PRIN1 .MARKING>
	       <PRINC ")">)>
	<RETYPE-BUFFER!-ICALRDR T>>

<DEFINE CHARINT (CHR CHN) 
	#DECL ((CHR) CHARACTER (CHN) CHANNEL)
	<INT-LEVEL 0>
	<COND (<==? .CHR <ASCII 7>>
	       <COND (<MEMQ ,PLAYER ,WINNERS> <RECURSE> <DISMISS T>)
		     (,CTRLG-KILL <QUIT>)
		     (<DISMISS T>)>)
	      (<==? .CHR <ASCII 22>> <VERBOHACK>)
	      (<==? .CHR <ASCII 20>> <ANSHACK>)>>

<DEFINE MORE-HANDLE (X "OPTIONAL" Y "AUX" CHAR) 
	#DECL ((X) <OR FIX CHANNEL> (Y) CHANNEL (CHAR) CHARACTER)
	<COND (<TYPE? .X FIX>)
	      (T
	       <PRINC "--More--" .X>
	       <COND (<==? <SET CHAR <TYI ,INCHAN>> !\ > <CRLF .X> <DISMISS T>)
		     (<AND <ASSIGNED? MORE-ACT> <LEGAL? MORE-ACT>>
		      <INT-LEVEL 0>
		      <PRINC "Flushed" .X>
		      <CRLF .X>
		      <DISMISS T .MORE-ACT>)
		     (<CRLF .X>
		      <DISMISS T>)>)>>

<DEFINE BUFHACK (BUF CHR) 
	#DECL ((CHR) CHARACTER (BUF) BUFFER)
	<PRINC "C">
	<AND <ASSIGNED? QUESTION?> <PQHEADER .QUESTION?>>
	<COND (<ASSIGNED? qprompt> <PRINC .qprompt> <CRLF>)>
	<COND (<ASSIGNED? bprompt> <PRINC .bprompt>)>
	<COND (<ASSIGNED? aprompt>
	       <PRINC .aprompt>
	       <TERPRI>
	       <PRINC "Correct answer">)>
	<AND ,VERBOSE <PRINC " (BUFFER): ">>
	<IBUFPRINT .BUF <ASCII 4>>>

<SETG SCOREVEC <IVECTOR 2 0>>

<DEFINE GETQSCORE (QLOC "AUX" (SCWD <DATA-READW ,TVASS .QLOC>) (SV ,SCOREVEC)) 
	#DECL ((QLOC) FIX (SCWD) WORD (SV) <VECTOR [2 <OR FIX FLOAT>]>)
	<PUT .SV 1 <CHTYPE <GETBITS .SCWD <BITS 18 18>> FIX>>
	<PUT .SV
	     2
	     </ <CHTYPE <GETBITS .SCWD <BITS 18 0>> FIX> 1000.000>>>

<DEFINE PQSCORE (QLOC QMAX
		 "OPTIONAL" (SV <GETQSCORE .QLOC>) (MX <* <1 .SV> .QMAX>)
		 "AUX")
	#DECL ((QLOC) FIX (MX QMAX) <OR FIX FLOAT>
	       (SV) <VECTOR [2 <OR FIX FLOAT>]>)
	<PRIN1 <1 .SV>>
	<PRINC " players received ">
	<PRIN1 <2 .SV>>
	<PRINC " points of maximum ">
	<PRIN1 .MX>
	<PRINC " [">
	<PRIN1 <FIX </ <* 100 <2 .SV>> .MX>>>
	<PRINC "%]">
	.SV>

<DEFINE GETSCORE (PLAYER "AUX" (TVA ,TVASS) (SSP ,SSPACE) NUTS WHR) 
	#DECL ((PLAYER) TIME (TVA) ASYLUM (SSP) SPACE (NUTS) LIST (WHR) FIX)
	<SET WHR
	     <+ ,SCORE
		<COND (<==? .PLAYER ,PLAYER> ,LUBLK)
		      (<SET NUTS <GET-LOSER .PLAYER>> <3 .NUTS>)>>>
	<DATA-AREAD .TVA .WHR <ARESET .SSP T <>>>>

<DEFINE PSCORE (PLAYER
		"AUX" SCUVEC (SSP ,SSPACE) (TVA ,TVASS) (N 1) (TOT 0) (SCTOT 0)
		      (QTOT 0) QTEMP QASKED LUBLK NSC NSC1 USLOT (TUV ,FOOUV) M
		      CODE VAL)
	#DECL ((PLAYER) TIME (SCUVEC) UVECTOR (QTEMP QTOT N CODE) FIX
	       (TVA) ASYLUM (SSP) SPACE (TOT SCTOT) <OR FIX FLOAT>
	       (NSC NSC1) FLOAT (QASKED) <VECTOR [REST LIST]> (LUBLK USLOT) FIX
	       (TUV) <UVECTOR [4 FIX]> (VAL) <LIST [REST TIME STRING FIX FIX]>
	       (M) <OR FALSE <VECTOR [REST FIX STRING]>>)
	<SET SCUVEC <GETSCORE .PLAYER>>
	<SET LUBLK <3 <SET VAL <MEMQ .PLAYER ,LOSSTABLE>>>>
	<SET USLOT <* 4 <4 .VAL>>>
	<SET QASKED
	     <DATA-AREAD
	      .TVA
	      <+ .LUBLK
		 ,QASKED>
	      .SSP>>
	<MAPF <>
	      <FUNCTION (X) 
		      #DECL ((X) <OR STRING FIX>)
		      <COND (<TYPE? .X STRING>
			     <CRLF>
			     <PRINC .X>
			     <INDENT-TO 19>
			     <PRIN1 <SET NSC <1 <1 .SCUVEC>>>>
			     <SET SCTOT <+ .SCTOT .NSC>>
			     <INDENT-TO 33>
			     <PRIN1 <SET NSC1 <2 <1 .SCUVEC>>>>
			     <SET TOT <+ .TOT .NSC1>>
			     <SET N <+ .N 1>>
			     <INDENT-TO 47>
			     <COND (<==? .NSC1 0.000> <PRINC "---">)
				   (T <PRIN1 </ .NSC .NSC1>>)>
			     <SET SCUVEC <REST .SCUVEC>>
			     <INDENT-TO 61>
			     <PRIN1 <SET QTEMP </ <LENGTH <1 .QASKED>> 2>>>
			     <SET QTOT <+ .QTEMP .QTOT>>
			     <SET QASKED <REST .QASKED>>)>>
	      <2 ,CATS>>
	<CRLF>
	<PRINC "Total of ">
	<PRIN1 .SCTOT>
	<PRINC " points out of ">
	<PRIN1 .TOT>
	<PRINC " [">
	<PRIN1 <FIX </ <* 100 .SCTOT> .TOT>>>
	<PRINC "%].  ">
	<PRIN1 .QTOT>
	<PRINC <COND (<1? .QTOT> " question.")
		     (t " questions.")>>
	<CRLF>
	<PRINC "Progress:  ">
	<PRIN1 <GETLASTQ .LUBLK>>
	<PRINC "   ">
	<GET-LOC <+ ,PG ,PEEK-START .USLOT> .TUV>
	<COND (<0? <1 .TUV>>
	       <PRINC "Playing:  ">
	       <COND (<SET M
			   <MEMQ <CHTYPE <GETBITS <4 .TUV> <BITS 18 18>> FIX>
				 ,STATUS-VECTOR>>
		      <PRINC <2 .M>>)
		     (<PRINC "??">)>
	       <COND (<OR <1? <SET CODE <1 .M>>> <==? .CODE 9>>
		      <COND (<0? <SET CODE
				      <CHTYPE <GETBITS <4 .TUV> <BITS 18>>
					      FIX>>>)
			    (<PRINC "#"> <PRIN1 .CODE>)>)
		     (<==? .CODE ,$SMAKE>
		      <COND (<0? <SET CODE
				      <CHTYPE <GETBITS <4 .TUV> <BITS 18>>
					      FIX>>>)
			    (<PRINC <NTH ,MAKETYPES .CODE>>)>)>)
	      (T
	       <PRINC "Last played on">
	       <PDSKDATE <CHTYPE <3 .TUV> WORD>>
	       <PRINC <ASCII 46>>)>>

<DEFINE GETLASTQ (LUBLK "AUX" (QSP ,QSPACE) Q LOWQ) 
	#DECL ((LOWQ LUBLK) FIX (Q) <OR FALSE <VECTOR FIX [REST ANY]>>
	       (QSP) SPACE)
	<COND (<==? <SET LOWQ
			 <CHTYPE <DATA-READW ,TVASS <+ .LUBLK ,QNEXT>> FIX>>
		    ,LOWQUES>
	       0)
	      (<SET Q <DATA-AREAD ,TVASS .LOWQ <ARESET .QSP T <>>>>
	       <QQNUM .Q>)>>

<DEFINE PDSKDATE (WD
		  "AUX" (TIM <CHTYPE <GETBITS .WD <BITS 18 0>> FIX>)
			(A/P " AM ") HR)
	#DECL ((WD) <PRIMTYPE WORD> (TIM HR) FIX (A/P) STRING)
	<PRINC " ">
	<COND (<0? <CHTYPE .WD FIX>>
	       <PRINC "unknown ">)
	      (T
	       <PRINC <NTH ,MONTHS <CHTYPE <GETBITS .WD <BITS 4 23>> FIX>>>
	       <PRINC " ">
	       <PRIN1 <CHTYPE <GETBITS .WD <BITS 5 18>> FIX>>
	       <PRINC " at ">
	       <SET HR </ .TIM 7200>>
	       <COND (<G=? .HR 12> <SET HR <- .HR 12>> <SET A/P " PM ">)>
	       <COND (<0? .HR> <SET HR 12>)>
	       <PRIN1 .HR>
	       <PRINC ":">
	       <SET HR </ <MOD .TIM 7200> 120>>
	       <COND (<L? .HR 10> <PRINC "0">)>
	       <PRIN1 .HR>
	       <PRINC .A/P>)>>

<SETG MONTHS
      ["January"
       "February"
       "March"
       "April"
       "May"
       "June"
       "July"
       "August"
       "September"
       "October"
       "November"
       "December"]>

<GDECL (MONTHS) <VECTOR [12 STRING]>>

<DEFINE 6PRINC (FROB "AUX" (BITTBL ,6BIT))
  #DECL ((FROB) <PRIMTYPE WORD> (BITTBL) <UVECTOR [REST BITS]>)
  <REPEAT (CHAR) #DECL ((CHAR) FIX)
    <SET CHAR <CHTYPE <GETBITS .FROB <1 .BITTBL>> FIX>>
    <COND (<0? .CHAR> <RETURN .FROB>)
	  (T
	   <PRINC <CHTYPE <+ .CHAR 32> CHARACTER>>
	   <COND (<EMPTY? <SET BITTBL <REST .BITTBL>>>
		  <RETURN .FROB>)>)>>>

<PRINTTYPE TIME ,6PRINC>

<SETG 6BIT
      <UVECTOR <BITS 6 30>
	       <BITS 6 24>
	       <BITS 6 18>
	       <BITS 6 12>
	       <BITS 6 6>
	       <BITS 6 0>>>

<SETG SCRATCH "MARCGR">

<GDECL (6BIT) <UVECTOR [6 BITS]> (PLAYER) TIME (SCRATCH) STRING>

<DEFINE MYSIXTOS (X "AUX" (S ,SCRATCH) (CT 0) (BIT ,6BIT))
  #DECL ((X) <PRIMTYPE WORD> (CT) FIX (BIT) <UVECTOR [REST BITS]> (VALUE S) STRING)
  <REPEAT (TCHAR)
    #DECL ((TCHAR) FIX)
    <COND (<0? <SET TCHAR <CHTYPE <GETBITS .X <1 .BIT>> FIX>>>
	   <RETURN <SUBSTRUC .S 0 .CT>>)
	  (T
	   <SET CT <+ .CT 1>>
	   <PUT .S .CT <CHTYPE <+ .TCHAR 32> CHARACTER>>
	   <COND (<EMPTY? <SET BIT <REST .BIT>>>
		  <RETURN <STRING .S>>)>)>>>

<DEFINE SQUOZE (SIXBIT
		"AUX" (MULF <* 40 40 40 40 40 40>) (VAL 0) (COUNT 6) (TC 0)
		(SBITS ,6BIT))
	#DECL ((VAL COUNT TC MULF) FIX (SIXBIT) <PRIMTYPE WORD>
	       (SBITS) <UVECTOR [REST BITS]>)
	<REPEAT ()
		<COND (<OR <EMPTY? .SBITS> <L? .COUNT 1>>
		       <RETURN>)>
		<SET TC <CHTYPE <GETBITS .SIXBIT <1 .SBITS>> FIX>>
		<SET SBITS <REST .SBITS>>
		<COND (<AND <G=? .TC 17> <L=? .TC 26>>
		       <SET TC <- .TC 16>>)
		      (<AND <G=? .TC 33> <L=? .TC 58>>
		       <SET TC <- .TC 22>>)
		      (<==? .TC <ASCII !\.>> <SET TC 37>)
		      (<==? .TC <ASCII !\$>> <SET TC 38>)
		      (<==? .TC <ASCII !\%>> <SET TC 39>)
		      (T <AGAIN>)>
		<SET COUNT <- .COUNT 1>>
		<SET VAL <+ .VAL <* .TC <SET MULF </ .MULF 40>>>>>>
	<CHTYPE .VAL WORD>>

<DEFINE ANNOUNCE ("AUX" (ASP <ARESET ,ASPACE T <>>) (TVA ,TVASS) ANN) 
	#DECL ((TVA) ASYLUM (ASP) SPACE (ANN) STRING)
	<COND (<AND <PRINC 
"
[PLEASE ONLY MAKE ANNOUNCEMENTS IF REALLY NECESSARY
 TYPE ALTMODE TO FLUSH THIS COMMAND]
">
		    <SET ANN <GETBUF "Announcement: " .ASP>>
		    <NOT <QUESTIONABLE? .ANN>>>
	       <CHAIN-APPEND .TVA
			     .ASP
			     <AVECTOR .ASP <DSKDATE> ,PLAYER .ANN>
			     ,HIMAIL>)>>

<DEFINE READ.ANNOUNCE ("AUX" (TVA ,TVASS) (ASP <ARESET ,ASPACE T <>>) ANN
			     (NXT
			      <CHTYPE <DATA-READW .TVA <+ ,LUBLK ,ANNEXT>>
				      FIX>) DAT)
   #DECL ((TVA) ASYLUM (NXT) FIX (ASP) SPACE (ANN) <OR FALSE VECTOR>
	  (DAT) <PRIMTYPE WORD>)
   <REPEAT ()
	   <COND (<0? <SET NXT <CHTYPE <DATA-READW .TVA .NXT> FIX>>>
		  <RETURN>)
		 (<SET ANN <DATA-AREAD .TVA .NXT .ASP>>
		  <PRINC "

From ">
		  <6PRINC <2 .ANN>>
		  <PDSKDATE <1 .ANN>>
		  <CRLF>
		  <PRINC <3 .ANN>>
		  <SET DAT <DSKDATE>>
		  <COND (<==? <GETBITS .DAT <BITS 4 23>>
			      <GETBITS <1 .ANN> <BITS 4 23>>>
			 <AND <G? <- <CHTYPE <GETBITS .DAT <BITS 5 18>> FIX>
				     <CHTYPE <GETBITS <1 .ANN> <BITS 5 18>>
					     FIX>>
				  14>
			      <DELETE.ANNOUNCE .NXT>>)
			(<G? <- <+ <CHTYPE <GETBITS .DAT <BITS 5 18>> FIX> 30>
				<CHTYPE <GETBITS <1 .ANN> <BITS 5 18>> FIX>>
			     14>
			 <DELETE.ANNOUNCE .NXT>)>)>
	   <DATA-PRINTW .TVA <+ ,LUBLK ,ANNEXT> .NXT>>>

<DEFINE DELETE.ANNOUNCE (WHR "AUX" DAT LOC) 
	#DECL ((WHR LOC) FIX (DAT) <UVECTOR [4 WORD]>)
	<SET DAT <DATA-FIND ,TVASS .WHR>>
	<SET LOC <CHTYPE <NTH .DAT <+ ,NAMDATA 1>> FIX>>
	<PUT .DAT 2 #WORD *000000000000*>
	<PUT .DAT 3 #WORD *000000000000*>
	<DATA-PUT ,TVASS .WHR .DAT>
	<DATA-BLOCK-FREE ,TVASS .LOC>>

<DEFINE COMREP () <SNAME ,SPLAYER> <SETG SAVEREP ,REP> <SETG REP ,COMMAND>>

<DEFINE RECURSE () <COND (<MEMQ <CHTYPE <XUNAME> TIME> ,WINNERS>
			  <SETG REP ,SAVEREP>
			  <SNAME "MARC">
			  <LISTEN>
			  <SNAME ,SPLAYER>
			  <SETG REP ,COMMAND>)>>

<DEFINE ANSWER? () 
	<OR ,ALWAYS-ANSWER
	    <PROG topask ()
		  #DECL ((topask) <SPECIAL ACTIVATION>)
		  <TRUE? "
Want the answer "
			 "Y/N"
			 "Yy"
			 "Nn"
			 <ASCII 20>>>>>

<DEFINE FLOATPRINT (FLT "AUX" DEC X1000) 
	#DECL ((FLT) FLOAT (DEC X1000) FIX)
	<COND (<==? <MOD <SET X1000 <FIX <* 1000 .FLT>>> 10> 9>
	       <SET X1000 <+ .X1000 1>>)>
	<PRIN1 </ .X1000 1000>>
	<PRINC ".">
	<SET DEC <MOD .X1000 1000>>
	<AND <L? .DEC 100> <PRINC <ASCII 48> ;"Char 0">>
	<AND <L? .DEC 10> <PRINC <ASCII 48> ;"Char 0">>
	<PRINC .DEC>>

<PRINTTYPE FLOAT ,FLOATPRINT>

<OVERFLOW <>>

<DEFINE TVSAVE (VER DBG "OPTIONAL" (MODIF 0)) 
	#DECL ((DBG) <OR 'T FALSE> (VER MODIF) FIX)
	<CHAR-INIT>
	<AND .DBG <DBG>>
	<FUMP .VER ,SAVE .MODIF>>

<SETG QSYMS <MAKESST "QSYMS" []>>

<DEFINE Q-SYMS ("AUX" QPOSS (TVA ,TVASS) (CURSPACE <ARESET ,ASPACE T <>>) (IDX 1) WHR) 
   #DECL ((TVA) ASYLUM (CURSPACE) <SPECIAL SPACE> (WHR IDX) FIX
	  (QPOSS) <VECTOR [REST <LIST [REST FIX]>]>)
   <COND
    (<SET QPOSS <DATA-AREAD .TVA <+ ,LUBLK ,QASKED> .CURSPACE>>
     <PUT
      ,QSYMS
      2
      <MAPF ,ALVECTOR
       <FUNCTION (X "AUX" CATNM) 
	       #DECL ((X) LIST (CATNM) STRING)
	       <AND <EMPTY? .X> <SET IDX <+ .IDX 1>> <MAPRET>>
	       <SET CATNM <NTH <2 ,CATS> <- <* .IDX 2> 1>>>
	       <REPEAT ((Y .X))
		       #DECL ((Y) LIST)
		       <COND (<EMPTY? .Y> <RETURN>)
			     (<SET WHR <1 .Y>>
			      <PUT .Y
				   1
				   <ASTRING .CURSPACE
					    .CATNM
					    "."
					    <UNPARSE <2 .Y>>>>
			      <PUT .Y 2 .WHR>
			      <SET Y <REST .Y 2>>)>>
	       <SET IDX <+ .IDX 1>>
	       <MAPRET !.X>>
       .QPOSS>>)>>

<DEFINE GET.QUESTION ("OPTIONAL" (MULT <>) "AUX" SYMS SYMV) 
	#DECL ((SYMS) <OR FALSE SYMTABLE> (SYMV) <OR FALSE VECTOR>
	       (MULT) <OR FALSE 'T>)
	<COND (<SET SYMS <Q-SYMS>>
	       <COND (<SET SYMV
			   <READARGS .SYMS
				     "Question "
				     '["" ""]
				     <COND (.MULT '["SYM" "MULT"]) ('["SYM"])>>>
		      <AND <NOT <EMPTY? <1 .SYMV>>> <1 .SYMV>>)>)
	      (<PERR "Can't get QUESTION SYMBOLS, Q-SYMS">)>>

<GDECL (SIMPLE-SPACE) SPACE>

<SETG MY-SIMPLE <MAKESST "SI1" []>>

<SETG HIS-SIMPLE <MAKESST "SI2" []>>

<SETG SIMTABLE <MAKEMST "SSS" [,MY-SIMPLE ,HIS-SIMPLE]>>

<SETG SIMTABLE? <>>

<GDECL (SIMTABLE MY-SIMPLE HIS-SIMPLE) SYMTABLE (SIMTABLE?) <OR ATOM FALSE>>

<DEFINE GET.SIMPLE ("OPTIONAL" (EVERYBODY? <>) "AUX" SYMV) 
	#DECL ((SYMV) <OR FALSE VECTOR> (EVERYBODY?) <OR ATOM FALSE>)
	<COND (<NOT ,SIMTABLE?>
	       <LOAD.SIMPLE>)>
	<COND (<SET SYMV
		    <READARGS <COND (.EVERYBODY? ,SIMTABLE)
				    (T ,MY-SIMPLE)>
			      "Question "
			      '["" ""]
			      <COND (.EVERYBODY? '["SYM" "MULT"]) ('["SYM"])>>>
	       <AND <NOT <EMPTY? <1 .SYMV>>> <1 .SYMV>>)>>

<DEFINE LOAD.SIMPLE ("AUX" (TVA ,TVASS)
			 (CURSPACE
			    <COND (<GASSIGNED? SIMPLE-SPACE>
				   <ARESET ,SIMPLE-SPACE T <>>)
				  (T <SETG SIMPLE-SPACE <AFIND 1>>)>)
			 (SISP ,SIMPLE-SPACE) SLIST (PLAYER ,PLAYER)
			 (SPLAYER ,SPLAYER))
   #DECL ((CURSPACE) <SPECIAL SPACE> (TVA) ASYLUM
	  (SLIST) <LIST [REST TIME FIX FIX]> (SISP) SPACE (PLAYER) TIME
	  (SPLAYER) STRING)
   <SET SLIST <DATA-AREAD .TVA ,SIMPLE-LIST .SISP>>
   <PUT ,MY-SIMPLE
	2
	<MAPR ,ALVECTOR
	      <FUNCTION (X "AUX" (Y <1 .X>)) #DECL ((X) <LIST [REST <PRIMTYPE WORD>]>)
	        <COND (<==? .Y .PLAYER>
		       <MAPRET <ASTRING .SISP
					.SPLAYER
					<ASCII 46> ;"Char ."
					<UNPARSE <2 .X>>>
			       <3 .X>>)
		      (<MAPRET>)>>
	      .SLIST>>
   <PUT ,HIS-SIMPLE
	2
	<MAPR ,ALVECTOR
	      <FUNCTION (X "AUX" (Y <1 .X>)) #DECL ((X) <LIST [REST <PRIMTYPE WORD>]>)
	        <COND (<AND <TYPE? .Y TIME>
			    <N==? .Y .PLAYER>>
		       <MAPRET <ASTRING .SISP <MYSIXTOS .Y> <ASCII 46> <UNPARSE <2 .X>>>
			       <3 .X>>)
		      (<MAPRET>)>>
	      .SLIST>>
   <SETG SIMTABLE? T>>

<DEFINE PRINT.QSCORE ("OPTIONAL" (PRINT? T) (VERBOSE? <>)
		      "AUX" (TVA ,TVASS) (QSP ,QSPACE) (PL 0) (PS 0.000)
			    (MX 0.000) SYML)
   #DECL ((SYML) <OR FALSE <LIST [REST SYMBOL]>> (TVA) ASYLUM (QSP) SPACE
	  (PS MX) FLOAT (PL) FIX (PRINT? VERBOSE?) <OR ATOM FALSE>)
   <COND
    (<SET SYML <GET.QUESTION T>>
     <CRLF>
     <PROG MORE-ACT
	   ()
	   #DECL ((MORE-ACT) <SPECIAL ACTIVATION>)
	   <RESET ,INCHAN>
	   <MAPF <>
		 <FUNCTION (X "AUX" FROB QUES) 
			   #DECL ((X) SYMBOL (QUES) VECTOR
				  (FROB) <VECTOR [2 <OR FIX FLOAT>]>)
			   <SET QUES <DATA-AREAD .TVA <2 .X> <ARESET .QSP T <>>>>
			   <COND (.PRINT?
				  <PQHEADER .QUES>
				  <COND (.VERBOSE? <PRINT-QUESTION .QUES>)
					(T <PRINC <NTH .QUES <+ ,QQUES 1>>>)>
				  <CRLF>
				  <CRLF>
				  <SET FROB
				       <PQSCORE <NTH .QUES ,QSCORE> <NTH .QUES ,QVAL>>>
				  <CRLF>
				  <PRINC "------">)
				 (<SET FROB <GETQSCORE <NTH .QUES ,QSCORE>>>)>
			   <SET PL <+ .PL <1 .FROB>>>
			   <SET PS <+ .PS <2 .FROB>>>
			   <SET MX <+ .MX <* <NTH .QUES ,QVAL> <1 .FROB>>>>>
		 .SYML>
	   <AND <NOT <LENGTH? .SYML 1>>
		<CRLF>
		<PRINC "
Total for all questions...">
		<CRLF>>
	   <OR <AND <LENGTH? .SYML 1> <OR .PRINT? .VERBOSE?>>
	       <PQSCORE 0 0 <VECTOR .PL .PS> .MX>>>)>>

<DEFINE PSCORES ("AUX" SYMV) 
	#DECL ((SYMV) <OR FALSE VECTOR>)
	<SET-STATUS ,$SPSCORE>
	<COND (<SET SYMV
		    <READARGS <P-SYMS> "for " '["" ""] '["SYM" "MULT"]>>
	       <PROG MORE-ACT
		     ()
		     #DECL ((MORE-ACT) <SPECIAL ACTIVATION>)
		     <RESET ,INCHAN>
		     <MAPF <>
			   <FUNCTION (X) 
				     #DECL ((X) SYMBOL)
				     <PRINC "
Score for ">
				     <PRINC <1 .X>>
				     <INDENT-TO 19>
				     <PRINC 
"Points        Possible      Average       Questions">
				     <CRLF>
				     <PSCORE <CHTYPE <STRTOX <1 .X>> TIME>>
				     <CRLF>>
			   <1 .SYMV>>>)>>

<DEFINE GETBUF (bprompt "OPTIONAL" (SP ,QSPACE) qprompt SPROMPT "AUX" BUF) 
	#DECL ((qprompt bprompt) <SPECIAL STRING> (SPROMPT) <OR FALSE STRING>
	       (BUF) <SPECIAL BUFFER> (SP) SPACE)
	<TERPRI>
	<SET BUF <BUFMAKE 20>>
	<AND <ASSIGNED? SPROMPT>
	     .SPROMPT
	     <ADDSTRING .BUF .SPROMPT>>
	<REPEAT ()
		<COND (,VERBOSE <GETSTR .BUF .CHRTABLE .bprompt " (BUFFER):">)
		      (<GETSTR .BUF .CHRTABLE .bprompt>)>
		<COND (,BUFSAFE <AND <CONFIRM> <RETURN>>) (<RETURN>)>>
	<ACOPY .SP <BUFTOS .BUF>>>

<DEFINE CONFIRM () 
	<PRINC "[confirm]">
	<AND <RESET ,INCHAN> <==? <TYI> <ASCII 27>>>>

<DEFINE PLAY-BALL ("AUX"
		   (TAILOR
		    <DATA-AREAD ,TVASS <+ ,LUBLK ,TAILOR> <ARESET ,SSPACE T <>>>)
		   SWITCHES (SEQUENCE ,SEQUENCE)) 
	#DECL ((TAILOR) <OR FALSE <UVECTOR [3 WORD]>> (SEQUENCE SWITCHES) WORD)
	<COND (<NOT .TAILOR>)
	      (T
	       <SET SEQUENCE <SETG SEQUENCE <SEQ-WORD .TAILOR>>>
	       <SET SWITCHES <SWITCH-WORD .TAILOR>>
	       <MAPF <>
		     <FUNCTION (BT SW) 
			       #DECL ((BT) BITS (SW) ATOM)
			       <COND (<==? <GETBITS .SWITCHES .BT> #WORD *000000000000*>
				      <SETG .SW <>>)
				     (<SETG .SW T>)>>
		     ,BIT-TABLE
		     ,SWITCH-TABLE>
	       <COND (<0? <SETG TELEC-INTERVAL
				<CHTYPE <GETBITS .SWITCHES ,RIGHT-HALF> FIX>>>)
		     (<TELECON ,TELEC-INTERVAL>)>
	       <SETG TECO-PROGRAM <MYSIXTOS <TECO-WORD .TAILOR>>>)>
	<MAPF <>
	      <FUNCTION (BT "AUX" COD) 
		      #DECL ((BT) BITS (COD) FIX)
		      <COND (<0? <SET COD <CHTYPE <GETBITS .SEQUENCE .BT> FIX>>>
			     <MAPLEAVE T>)
			    (<PRINC <NTH ,FROB-NAMES .COD>>
			     <EVAL <NTH ,FROBS .COD>>)>>
	      ,SEQ-BITS>
	<COMMAND>>

<SETG SWITCH-TABLE
      '[VERBOSE ALWAYS-ANSWER PNEWMAIL IGNORE-SIMPLE KEEPASKING BUFSAFE]>

<SETG BIT-TABLE
      '[#BITS *430100000000*
	#BITS *420100000000*
	#BITS *410100000000*
	#BITS *400100000000*
	#BITS *370100000000*
	#BITS *360100000000*]>

<SETG RIGHT-HALF <BITS 18 0>>

<MANIFEST RIGHT-HALF>

<DEFINE SAVE-TAILOR ("AUX" (SWITCH #WORD 0) (SEQ ,SEQUENCE)
		     (SSP <ARESET ,SSPACE T <>>)) 
	#DECL ((SEQ SWITCH) WORD (SSP) SPACE)
	<MAPF <>
	      <FUNCTION (BT SW) 
		      #DECL ((BT) BITS (SW) ATOM)
		      <SET SWITCH <PUTBITS .SWITCH .BT <COND (,.SW 1) (0)>>>>
	      ,BIT-TABLE
	      ,SWITCH-TABLE>
	<SET SWITCH
	     <PUTBITS .SWITCH
		      ,RIGHT-HALF
		      ,TELEC-INTERVAL>>
	<DATA-APRINT ,TVASS
		     <+ ,LUBLK ,TAILOR>
		     .SSP
		     <AUVECTOR .SSP
			       .SEQ
			       .SWITCH
			       <CHTYPE <STRTOX ,TECO-PROGRAM> WORD>>>>

<DEFINE GET-SEQUENCE ("AUX" SEQ (S #WORD *000000000000*)) 
	#DECL ((SEQ) <OR FALSE <VECTOR LIST>> (S) WORD)
	<UNWIND
	 <PROG ()
	   <SETG COMPLETES " ,">
	   <COND (<SET SEQ
		       <READARGS ,SEQ-SYMS "will be " '["" ""] '["SYM" "MULT"]>>
		  <MAPF <>
			<FUNCTION (BT SYM) 
				  #DECL ((BT) BITS (SYM) <PRIMTYPE VECTOR>)
				  <SET S <PUTBITS .S .BT <2 .SYM>>>>
			,SEQ-BITS
			<1 .SEQ>>
		  <SETG SEQUENCE .S>)>
	   <SETG COMPLETES " ">>
	 <SETG COMPLETES " ">>>

<SETG SEQ-SYMS
      <MAKEBST "SS"
	       ["Answer"
		1
		"Babble"
		2
		"DDT.babble"
		3
		"Grade"
		4
		"Make"
		5
		"Peek"
		6
		"Print.score"
		7
		"Quit"
		8
		"Read.mail"
		9
		"Status.of.question"
		10
		"Summary.status.of.question"
		11
		"Tiny.babble"
		12
		"Twhois"
		13]>>

<DEFINE SET-STATUS (CODE "OPTIONAL" (FROB 0) "AUX" (PG ,PG) (TU ,TUV)) 
	#DECL ((PG CODE FROB) FIX (TU) <UVECTOR [4 FIX]>)
	<COND (<GASSIGNED? TINDEX>
	       <PUT-LOC <+ ,PEEK-START .PG ,TINDEX>
			<PUT .TU 4 <PUTBITS .FROB <BITS 18 18> .CODE>>>)>>

<SETG TOBRKS " ,
">

<SETG DBRKS ",./ 	
">

<GDECL (TOBRKS DBRKS) STRING>

<DEFINE BUFLEX (S "OPTIONAL" (BRKS ,TOBRKS) "AUX" (LL (<CHTYPE 0 TIME>))
		(L .LL) (S1 .S)) 
	#DECL ((S S1 BRKS) STRING (VALUE LL L) <LIST [REST TIME]>)
	<REPEAT ()
		<COND (<OR <EMPTY? .S1> <MEMQ <1 .S1> .BRKS>>
		       <AND
			<N==? .S .S1>
			<PUTREST
			 .L
			 <SET L
			      (<CHTYPE <STRTOX <SUBSTRUC
						.S
						0
						<- <LENGTH .S> <LENGTH .S1>>>> TIME>)>>>
		       <AND <EMPTY? .S1> <RETURN <REST .LL>>>
		       <SET S <REST .S1>>)>
		<SET S1 <REST .S1>>>>

<SETG MAKETYPES
      ["ZORK!"
       "long answer"
       "matching"
       "M.C."
       "T/F"
       "ZORK!"
       "simple"
       "ZORK!"
       "ranking"]>

;"POINTER TO START OF USER BLOCK FOR USER FOO
   SETG'S FOO TO THAT FIX"

<DEFINE UBLOCK (STR "OPTIONAL" (L ,LOSSTABLE) M) 
	#DECL ((STR) STRING (L) LIST (M) <OR LIST FALSE>)
	<COND (<GASSIGNED? <PARSE .STR>> ,<PARSE .STR>)
	      (<SET M <MEMQ <CHTYPE <STRTOX .STR> TIME> .L>>
	       <SETG <PARSE .STR> <3 .M>>)>>

<SETG ERRFLAG <>>

<GDECL (ERRFLAG) <OR ATOM FALSE>>

<DEFINE HANDLE (EFRM "TUPLE" JUNK "AUX" VAL TLIST TTY-HEADER) 
   #DECL ((EFRM) FRAME (JUNK) TUPLE (VAL) FIX
	  (TLIST) <OR FALSE <LIST [REST TIME STRING FIX FIX]>>
	  (TTY-HEADER) IHEADER)
   <COND
    (,ERRFLAG
     <PRINC "ERROR in error handler.">
     <QUIT>)
    (,CTRLG-KILL
     <SETG ERRFLAG T>
     <DISABLE <SET TTY-HEADER <GET ,INCHAN INTERRUPT!- >>>
     <INT-LEVEL 100000>
     <PRINC "*ERROR*">
     <CRLF>
     <MAPF <>
       <FUNCTION (X)
         <PRIN1 .X>
	 <CRLF>>
       .JUNK>
     <PRINC "ERROR during startup.">
     <COND (<SEND-ERROR "STARTUP ERROR" .JUNK>
	    <VALRET ":GENJOB
:DISOWN
">
	    <ENABLE .TTY-HEADER>
	    <OFF ,ERRH>)
	   (T
	    <CRLF>
	    <PRINC "TRIVIA suicided.">
	    <QUIT>)>)
    (<AND <==? <LENGTH .JUNK> 3>
	  <==? <1 .JUNK> UNASSIGNED-VARIABLE!-ERRORS>
	  <==? <3 .JUNK> GVAL>>
     <COND (<AND <GASSIGNED? LOSSTABLE>
		 <SET TLIST
		      <MEMQ <CHTYPE <STRTOX <SPNAME <2 .JUNK>>> TIME>
			    ,LOSSTABLE>>>
	    <SETG <2 .JUNK> <SET VAL <3 .TLIST>>>
	    <INT-LEVEL 0>
	    <ERRET .VAL .EFRM>)>)
    (<OR <==? ,PLAYER <CHTYPE <STRTOX "TAA"> TIME>>
	 <==? ,PLAYER <CHTYPE <STRTOX "MARC"> TIME>>>
     <SETG REP ,SAVEREP>
     <SNAME "MARC">)>>

<DEFINE AFIXCHOMP ("AUX" TTY-HEADER)
  #DECL ((TTY-HEADER) IHEADER)
  <DISABLE <SET TTY-HEADER <GET ,INCHAN INTERRUPT!- >>>
  <CLOSE <OPEN "PRINT" "_MSGS_;TRIVIA DEATH">>
  <CRLF>
  <PRINC "GROSS LOSSAGE">
  <CRLF>
  <PRINC "TRIVIA is down.  Please tell other triviators to go away,
then use TVBUG to describe EXACTLY what you were doing.">
  <CRLF>
  <VALRET ":GENJOB
:DISOWN
:TVBUG
">
  <ENABLE .TTY-HEADER>
  <OFF ,ERRH>
  <LISTEN>>

<DEFINE SYSDOWN (DWNTIME) #DECL ((DWNTIME) FIX)
  <COND (<L? .DWNTIME 0>
	 <CRLF>
	 <PRINC "ITS revived!">
	 <CRLF>
	 <AND <==? ,FLUSH SYSDOWN> <SETG FLUSH <>>>)
	(T
	 <SETG FLUSH SYSDOWN>)>>

<AND <NOT <LOOKUP "COMPILE" <ROOT>>>
     <NOT <LOOKUP "GLUE" <GET PACKAGE OBLIST>>>
     <SETG ERRH <HANDLER <GET ERROR!-INTERRUPTS INTERRUPT> ,HANDLE>>
     <SETG SYSDOWNH <HANDLER <EVENT "SYSDOWN" 1> ,SYSDOWN>>>

<DEFINE PLAY ("OPTIONAL" (PLAYER <>) "AUX" FOO TINDEX LUBLK) 
	#DECL ((PLAYER) <OR STRING FALSE> (FOO) <OR FALSE FIX> (TINDEX LUBLK) FIX)
	<COND (<MEMQ <CHTYPE <XUNAME> TIME> ,WINNERS>
	       <COND (<NOT .PLAYER>
		      <SET PLAYER <READER '[] "as " "" '["LINE"] <>>>)>
	       <COND (<SET FOO <UBLOCK .PLAYER>>
		      <SET TINDEX <* 4 <4 <MEMQ <CHTYPE <STRTOX .PLAYER> TIME>
						,LOSSTABLE>>>>
		      <COND (<DHLOCK <+ .TINDEX ,PEEK-START ,PG>>
			     <DUNLOCK <+ ,TINDEX ,PEEK-START ,PG>>
			     <SETG TINDEX .TINDEX>
			     <SETG LUBLK .FOO>
			     <SETG PLAYER <CHTYPE <STRTOX .PLAYER> TIME>>
			     <PUT ,TUV 2 <CHTYPE ,PLAYER FIX>>
			     .PLAYER)
			    (T <PRINC "Already playing">)>)
		     (T <PRINC "You blew it, champ.">)>)>>

<DEFINE UNLOCK-PLAYER (NAME "AUX" (L <MEMQ <CHTYPE <STRTOX .NAME> TIME> <NEW-LOSS>>)
		       TINDEX TEMP)
	#DECL ((L) <OR FALSE <LIST [REST TIME STRING FIX FIX]>> (NAME) STRING
	       (TINDEX TEMP) FIX)
	<COND (.L
	       <SET TINDEX <4 .L>>
	       <SET TEMP <+ ,PEEK-START
			    <SETG PG <* .PG 1024>>
			    <* .TINDEX 4>>>
	       <COND (<0? <1 <GET-LOC .TEMP ,NTTUV>>>
		      <OR <DUNLOCK .TEMP>
			  <PUT-LOC .TEMP ![-1]>>
		      T)
		     (T
		      #FALSE ("ALREADY UNLOCKED"))>)
	      (#FALSE ("NOT A PLAYER"))>>

<DEFINE RDELETE (FOO "AUX" (DC ,TVASS) (S <ARESET ,ASPACE T <>>)
		 (ZORK <ALIST .S 1>) FWEEP)
  #DECL ((FOO) <OR FIX <LIST [REST FIX]>> (DC) ASYLUM (S) SPACE (ZORK) LIST
	 (FWEEP) <OR <FALSE FIX> <PRIMTYPE VECTOR>>)
  <COND (<TYPE? .FOO FIX>
	 <COND (<SET FWEEP <DATA-DELETE .DC .FOO>>)
	       (<==? <1 .FWEEP> 8>
		<DATA-APRINT .DC .FOO .S .ZORK>
		<DATA-DELETE .DC .FOO>)>)
	(T
	 <MAPF <>
	   <FUNCTION (X) #DECL ((X) FIX)
	     <COND (<SET FWEEP <DATA-DELETE .DC .X>>)
		   (<==? <1 .FWEEP> 8>
		    <DATA-APRINT .DC .X .S .ZORK>
		    <DATA-DELETE .DC .X>)>>
	   .FOO>)>>