trivia-1976-1977/trivia/9006234/marc/tvfrob.1

<DEFINE MAKE.QUESTIONS ("AUX" TYPE (OUTCHAN ,OUTCHAN) (TVS ,TVSPACE2)
			      (TVA ,TVASS) (TVS1 ,TVSPACE1) ITM VEC NEW
			      COMPLEX?)
   #DECL ((QUTCHAN) <CHANNEL FIX [9 STRING]> (TVS TVS1) SPACE (TVA) ASYLUM
	  (VEC) VECTOR (ITM) <LIST [REST FIX]> (NEW) <OR FALSE FIX>
	  (COMPLEX?) <OR ATOM FALSE>)
   <SET-STATUS ,$SMAKE>
   <REPEAT (Q QUES HIQ QNUM (COAUTH 0))
     #DECL ((Q) <OR FALSE LIST> (QUES) VECTOR (HIQ) <OR FALSE MANIAC> (QNUM) FIX
	    (COAUTH) <OR FIX <LIST [REST STRING]>>)
     <AND ,FLUSH <FLUSH-EM>>
     <ARESET .TVS>
     <PROG ()
	   <SET TYPE
		<READER ,QTYPES
			<TP "Question type: ">
			'["" ""]
			'["SYM"]
			,VERBOSE>>
	   <AND .TYPE
		<==? <2 .TYPE> ,$TCOAUTH>
		<SET COAUTH <BUFLEX <STRING <GETBUF "Other authors: ">>>>
		<AGAIN>>>
     <COND (<NOT .TYPE> <RETURN>) (<SET TYPE <2 .TYPE>>)>
     <COND (<0? .TYPE> <RETURN>)>
     <SET-STATUS ,$SMAKE .TYPE>
     <SET COMPLEX? <N==? .TYPE ,$TSIMPLE>>
     <COND
      (<SET Q <APPLY <NTH ,MAKERS .TYPE>>>
       <SET QUES <AVECTOR .TVS 0 0 0 0 0 0 0 0 !.Q>>
       <PUT .QUES ,QAUTH <ACOPY .TVS ,PLAYER>>
       <PUT .QUES ,QTYPE .TYPE>
       <COND (.COMPLEX?
	      <PROG (TMP)
		    <COND (<SET TMP <DATA-RESERVE .TVA 1>>
			   <PUT .QUES ,QSCORE .TMP>)
			  (T <AGAIN>)>>
	      <PUT .QUES
		   ,QCAT
		   <REPEAT (BAR)
			   #DECL ((BAR) <OR SYMBOL FALSE>)
			   <COND (<SET BAR
				       <READER ,CATS
					       <TP "Category: ">
					       ""
					       ["SYM"]
					       ,VERBOSE>>
				  <RETURN <2 .BAR>>)>>>
	      <PUT .QUES
		   ,QVAL
		   <REPEAT (SC)
			   #DECL ((SC) <OR FALSE FIX FLOAT>)
			   <COND (<AND <SET SC
					    <READER []
						    <TP "Value: ">
						    '[
"
Enter the value of this question (maximum 2.0)"
						      ""]
						    '["FIX" "FLOAT"]
						    ,VERBOSE>>
				       <L=? .SC 2>
				       <G=? .SC 0>>
				  <RETURN <FLOAT .SC>>)>>>)>
       <CRLF>
       <PUT .QUES ,QCOAUTH <ACOPY .TVS .COAUTH>>
       <PUT .QUES
	    ,QQNUM
	    <SET QNUM <CHTYPE <DATA-READW .TVA ,HIQNUM> FIX>>>
       <DATA-PRINTW .TVA ,HIQNUM <+ .QNUM 1>>
       <PUT <SET FOOV ,TTUV> 1 .QNUM>
       <PUT-LOC <+ ,PG ,BABBLE-HIQ> .FOOV>
       <COND
	(<SET NEW <CHAIN-APPEND .TVA .TVS .QUES ,HIQLOC>>
	 <COND (.COMPLEX?
		<DATA-PRINTW
		 .TVA
		 <+ ,1STCAT <NTH .QUES ,QCAT>>
		 <+ <NTH .QUES ,QVAL>
		    <CHTYPE <DATA-READW .TVA <+ ,1STCAT <NTH .QUES ,QCAT>>>
			    FLOAT>>>
		<DATA-PRINTW .TVA
			     ,TOTSCR
			     <+ <NTH .QUES ,QVAL>
				<CHTYPE <DATA-READW .TVA ,TOTSCR> FLOAT>>>
		<AND <SET HIQ <DATA-OPEN "PRINT" .TVA <+ ,LUBLK ,QASKED>>>
		     <SET VEC <DATA-IREAD .TVA .HIQ <ARESET .TVS1>>>
		     <SET ITM <NTH .VEC <NTH .QUES ,QCAT>>>
		     <SET ITM <PUTREST <ALIST .TVS1 <NTH .QUES ,QQNUM>> .ITM>>
		     <PUT .VEC
			  <NTH .QUES ,QCAT>
			  <PUTREST <ALIST .TVS1 .NEW> .ITM>>
		     <DATA-IPRINT .TVA .HIQ .TVS1 .VEC>
		     <DATA-CLOSE .TVA .HIQ>>)>
	 <CRLF>
	 <PRINC "Question is #">
	 <PRIN1 .QNUM>)
	(<PERR "Can't make new question, MAKE.QUESTION" .QUES>)>)
      (<CRLF> <PRINC "ERROR - "> <PRINC <1 .Q>> <CRLF>)>>>

<DEFINE MAKE.MATCH ("OPTIONAL" UPDATE "AUX" C1 C2 TBL KEY HDR) 
	#DECL ((C1 C2) <OR FALSE <LIST [REST STRING]>> (KEY) <OR FALSE LIST>
	       (TBL) SYMTABLE (UPDATE) VECTOR (HDR) STRING)
	<PROG ()
	      <COND (<AND <SET HDR <GETBUF "Heading: ">>
			  <NOT <QUESTIONABLE? .HDR>>
			  <SET C1 <GRAB-BUNCH "Column A #">>
			  <SET C2 <GRAB-BUNCH "Column B #">>>
		     <SET TBL <MAKESST "TBL" <UNTASTEFUL-CODE .C2>>>
		     <COND (<SET KEY <GRAB-ANSWERS .C1 .TBL>>
			    (.C1 .C2 .KEY <GETBUF "Comment: "> .HDR))>)
		    (T '#FALSE ("Question aborted"))>>>

<DEFINE GRAB-ANSWERS (C1 TBL "AUX" (CURSPACE ,TVSPACE2) LST) 
	#DECL ((C1) <SPECIAL <LIST [REST STRING]>> (TBL) SYMTABLE
	       (LST) <OR LIST FALSE> (CURSPACE) <SPECIAL SPACE>)
	<SET LST
	     <MAPF ,ALLIST
		   <FUNCTION (MCHOICE "AUX" CA) 
			   #DECL ((MCHOICE) STRING (CA) <OR FALSE SYMBOL>)
			   <SETG MATCH .MCHOICE>
			   <PRINC "
For ">
			   <PRINC .MCHOICE>
			   <COND (<SET CA
				       <READER .TBL
					       "which is the correct match? "
					       '["" ""]
					       '["SYM"]
					       ,VERBOSE>>
				  <MAPRET <ACOPY .CURSPACE <2 .CA>>>)
				 (<MAPLEAVE
				   #FALSE ("No correct answer given")>)>>
		   .C1>>
	<GUNASSIGN MATCH>
	.LST>

<DEFINE MAKE.TF ("OPTIONAL" UPDATE) 
	#DECL ((UPDATE) VECTOR)
	<COND (<ASSIGNED? UPDATE> <MAKE.MC T .UPDATE>)
	      (<MAKE.MC T>)>>

<DEFINE MAKE.REGULAR ("OPTIONAL" UPDATE "AUX" Q A (CURSPACE ,TVSPACE2) HINTS) 
   #DECL ((Q A) <OR FALSE STRING> (UPDATE HINTS) VECTOR
	  (CURSPACE) <SPECIAL SPACE>)
   <COND
    (<EMPTY? <SET Q
		  <GETBUF "Question: "
			  ""
			  <COND (<ASSIGNED? UPDATE>
				 <NTH .UPDATE <+ ,QQUES 1>>)>>>>
     '#FALSE ("Question aborted"))
    (<QUESTIONABLE? .Q> '#FALSE ("Empty question"))
    (<AND
      <SET HINTS
       <MAPF ,ALVECTOR
	<FUNCTION ("AUX" HINT NVALUE) 
	   #DECL ((HINT) STRING (NVALUE) <OR FALSE FLOAT>)
	   <COND (<AND <SET HINT <GETBUF "Hint: " "">>
		       <NOT <QUESTIONABLE? .HINT>>
		       <PROG ()
			     <COND (<OR <G=? <SET NVALUE
						  <READER []
							  "Fractional credit "
							  ""
							  '["FLOAT"]
							  ,VERBOSE>>
					     1.000>
					<L=? .NVALUE 0.000>>
				    <CRLF>
				    <PRINC "Out of range">
				    <AGAIN>)>
			     .NVALUE>>
		  <MAPRET .HINT .NVALUE>)
		 (<MAPSTOP>)>>>>
      <>>)
    (<EMPTY?
      <SET A
	   <PROG ((aprompt .Q))
		 #DECL ((aprompt) <SPECIAL STRING>)
		 <GETBUF "Answer: "
			 ""
			 <COND (<ASSIGNED? UPDATE>
				<COND (<G=? <LENGTH .UPDATE> <+ ,QQUES 2>>
				       <NTH .UPDATE <+ ,QQUES 2>>)
				      ("")>)>>>>>
     (.Q <ALSTRING>))
    (<QUESTIONABLE? .A> (.Q <ALSTRING>))
    (ELSE (.Q .A .HINTS))>>

<DEFINE GRAB-BUNCH (STR "AUX" FROB FROBS (IDX 1) (TVS ,TVSPACE2)) 
	#DECL ((STR) STRING (FROB) STRING (FROBS) LIST (IDX) FIX)
	<COND
	 (<NOT <EMPTY? <SET FROB <GETBUF <STRING .STR "1: ">>>>>
	  <SET FROBS <ALIST .TVS .FROB>>
	  <REPEAT ((CRUFT .FROBS))
		  <SET FROB
		       <GETBUF <STRING .STR
				       <UNPARSE <SET IDX <+ .IDX 1>>>
				       ": ">>>
		  <COND (<QUESTIONABLE? .FROB> <RETURN .FROBS>)>
		  <SET CRUFT <REST <PUTREST .CRUFT <ALIST .TVS .FROB>>>>>)
	 ('#FALSE ("Question aborted"))>>

<DEFINE MAKE.MC ("OPTIONAL" (T/F <>) UPDATE
		 "AUX" QUESTION ANSWER ANSWERS CORRECT.ANSWER TBL)
	#DECL ((QUESTION ANSWER) STRUCTURED (T/F) <OR 'T VECTOR FALSE>
	       (ANSWERS) <OR FALSE <LIST [REST STRING]>> (UPDATE) VECTOR)
	<AND <TYPE? .T/F VECTOR> <SET UPDATE .T/F> <SET T/F <>>>
	<PROG ()
	      <SET QUESTION
		   <GETBUF "Question: "
			   ""
			   <COND (<ASSIGNED? UPDATE>
				  <NTH .UPDATE <+ ,QQUES 1>>)>>>
	      <COND (<EMPTY? .QUESTION> <RETURN '#FALSE ("Question aborted")>)
		    (<QUESTIONABLE? .QUESTION>
		     <RETURN '#FALSE ("Empty QUESTION")>)>
	      <COND (.T/F
		     <SET ANSWERS
			  (<ASTRING ,TVSPACE2 "True">
			   <ASTRING ,TVSPACE2 "False">)>)
		    (T
		     <COND (<SET ANSWERS <GRAB-BUNCH "Answer#">>
			    <COND (<L? <LENGTH .ANSWERS> 2>
				   <RETURN '#FALSE ("Too few choices")>)>)
			   (<RETURN '#FALSE ("Question aborted")>)>)>
	      <SET CORRECT.ANSWER
		   <READER <SET TBL <MAKESST "FJB" <UNTASTEFUL-CODE .ANSWERS>>>
			   <TP "Correct answer is ">
			   '["" ""]
			   '["SYM"]
			   ,VERBOSE>>
	      <COND (.CORRECT.ANSWER
		     (.QUESTION
		      <GETBUF "Comment: " .QUESTION>
		      <2 .CORRECT.ANSWER>
		      !.ANSWERS))
		    ('#FALSE ("No correct answer given"))>>>

<SETG MAKERS
      [,COMMAND
       ,MAKE.REGULAR
       ,MAKE.MATCH
       ,MAKE.MC
       ,MAKE.TF
       ,QUIT
       ,MAKE.REGULAR]>

<SETG SCORED? <>>

<GDECL (SCORED?) <OR ATOM FALSE>>

<DEFINE ASK.QUESTIONS ("AUX" QUESTION? QUESTION (OUTCHAN .OUTCHAN)) 
   #DECL ((QUESTION?) <SPECIAL <OR VECTOR FALSE>> (QUESTION) VECTOR
	  (OUTCHAN) CHANNEL)
   <UNWIND
    <REPEAT ()
	    <TERPRI>
	    <COND (,FLUSH <FLUSH-EM>)
		  (<SET QUESTION? <GETNEXTQ>>
		   <SET-STATUS ,$SASK <NTH .QUESTION? ,QQNUM>>
		   <SET QUESTION .QUESTION?>
		   <ARESET ,TVSPACE2>
		   <COND (<OR <=? ,PLAYER <NTH .QUESTION ,QAUTH>>
			      <AND <N==? <NTH .QUESTION ,QCOAUTH> 0>
				   <MEMBER ,PLAYER <NTH .QUESTION ,QCOAUTH>>>>)
			 (<APPLY <NTH ,ASKERS <NTH .QUESTION ,QTYPE>>
				 .QUESTION>)>
		   <PROGRESS>
		   <SETG SCORED? <>>
		   <COND (<OR ,KEEPASKING
			      <PROG topask ()
				    #DECL ((topask) <SPECIAL ACTIVATION>)
				    <TRUE? "More "
					   "Y/N"
					   '(!"Y !"y)
					   '(!"N !"n)
					   <ASCII 22>>>>)
			 (<RETURN>)>)
		  (T <RETURN <>>)>>
    <COND (,SCORED? <SET SCORED? <>> <PROGRESS>)>>>

<DEFINE GETNEXTQ ("AUX" (QHI <+ ,QNEXT ,LUBLK>) (TVA ,TVASS) (TVS ,TVSPACE)
			(QNM <THISQ>) Q)
	#DECL ((QHI QNM) FIX (TVS) SPACE (TVA) ASYLUM (Q) <OR FALSE VECTOR>)
	<PROG ()
	      <COND (<N==? .QNM 0>
		     <COND (<SET Q <DATA-AREAD .TVA .QNM <ARESET .TVS>>>
			    <PQHEADER .Q>
			    .Q)
			   (<PROGRESS> <AGAIN>)>)>>>

<DEFINE PQHEADER (Q) 
	#DECL ((Q) VECTOR)
	<CRLF>
	<PRINC "Question #">
	<PRIN1 <NTH .Q ,QQNUM>>
	<PRINC " by ">
	<PRINC <NTH .Q ,QAUTH>>
	<COND (<N==? <NTH .Q ,QCOAUTH> 0>
	       <PRINC " with ">
	       <MAPF <>
		     <FUNCTION (X) <PRINC .X> <PRINC " ">>
		     <NTH .Q ,QCOAUTH>>)>
	<COND (<==? <NTH .Q ,QTYPE> 7> <PRINC "  Worthless">)
	      (<PRINC "  Category: ">
	       <PRINC <NTH <2 ,CATS> <- <* 2 <NTH .Q ,QCAT>> 1>>>
	       <PRINC "  Worth: ">
	       <PRIN1 <NTH .Q ,QVAL>>
	       <PRINC " points">)>
	<CRLF>
	<CRLF>>

<DEFINE THISQ ("AUX" (TVA ,TVASS) (QHI <+ ,LUBLK ,QNEXT>)) 
	<CHTYPE <DATA-READW .TVA <CHTYPE <DATA-READW .TVA .QHI> FIX>>
		FIX>>

<DEFINE PROGRESS ("AUX" (QHI <+ ,QNEXT ,LUBLK>) (TVA ,TVASS)
			(QNM <CHTYPE <DATA-READW .TVA .QHI> FIX>) QNXT)
	#DECL ((QHI QNM QNXT) FIX (TVA) ASYLUM)
	<COND (<0? <SET QNXT <CHTYPE <DATA-READW .TVA .QNM> FIX>>>)
	      (<DATA-PRINTW .TVA .QHI .QNXT>
	       <PROG ((LOC <+ ,PG ,BABBLE-START ,TINDEX>) (TBUV ,TBUV))
		     #DECL ((LOC) FIX (TBUV) <UVECTOR [4 FIX]>)
		     <COND (<DHLOCK .LOC>
			    <GET-LOC .LOC .TBUV>
			    <PUT .TBUV
				 2
				 <PUTBITS <2 .TBUV>
					  <BITS 18 0>
					  <GETLASTQ ,LUBLK>>>
			    <PUT-LOC .LOC .TBUV>
			    <DUNLOCK .LOC>)
			   (<SLEEP 2> <AGAIN>)>>)>>

<DEFINE ASK.MC (Q
		"AUX" (RQ <REST .Q ,QQUES>) ANSWER ANSNUM CORRECT
		      (TVS ,TVSPACE2) (SEEN 0))
   #DECL ((Q RQ) VECTOR (SEEN ANSNUM CORRECT) FIX (TVS) SPACE)
   <UNWIND
    <PROG ()
      <SET CORRECT <3 .RQ>>
      <PUT <2 <2 ,ALLSYMS>> 2 <UNTASTEFUL-CODE <REST .RQ 3>>>
      <PRINC <1 .RQ>>
      <MSTPOSSYM!-ICALSYM "" 0 <2 ,ALLSYMS>>
      <SET ANSWER
	   <READER ,ALLSYMS
		   <TP "Take your pick: ">
		   '["" ""]
		   '["SYM"]
		   ,VERBOSE>>
      <CRLF>
      <AND .ANSWER <SET ANSNUM <2 .ANSWER>>>
      <INT-LEVEL 20>
      <SET SEEN 1>
      <COND (<==? .ANSNUM .CORRECT>
	     <PRINC "Right! ">
	     <ADDSCORE ,PLAYER .Q <NTH .Q ,QVAL>>
	     <SET SEEN 0>)
	    (T
	     <COND (<NOT .ANSWER> <PRINC "Chicken! ">)
		   (<PRINC "Wrong! ">)>
	     <PRINC "The correct answer is ">
	     <PRINC <NTH <REST .RQ 3> .CORRECT>>
	     <PRINC !".>
	     <ADDSCORE ,PLAYER .Q 0>
	     <SET SEEN 0>)>
      <SETG SCORED? T>
      <INT-LEVEL 0>
      <AND <ANSWER?>
	   <CRLF>
	   <NOT <QUESTIONABLE? <2 .RQ>>>
	   <PRINC "Comment: ">
	   <PRINC <2 .RQ>>
	   <CRLF>>
      <SEND-PLAYER
       <NTH .Q ,QAUTH>
       <ANS-VEC .Q
		<COND (<==? .ANSNUM .CORRECT> <ASTRING .TVS " won.">)
		      (<NOT .ANSWER> <ASTRING .TVS ,IDUNNO>)
		      (<ASTRING .TVS
				" lost with "
				<REST <MEMBER ". " <1 .ANSWER>> 2>>)>>>
      <CRLF>>
    <COND (<1? .SEEN>
	   <COND (<==? .ANSNUM .CORRECT> <ADDSCORE ,PLAYER .Q <QVAL .Q>>)
		 (T <ADDSCORE ,PLAYER .Q 0>)>
	   <SETG SCORED? T>)>>>

<SETG IDUNNO " gave up.">

<DEFINE ASK.REGULAR (Q
		     "AUX" (RQ <REST .Q ,QQUES>) ANSWER (TVA ,TVASS)
			   (CURSPACE ,TVSPACE1) (TVS ,TVSPACE2) (SEEN 0)
			   (HVAL -1.000) (HNUM 0))
   #DECL ((Q RQ) VECTOR (ANSWER) STRING (TVA) ASYLUM (TVS) SPACE (SEEN HNUM) FIX
	  (HVAL) FLOAT (CURSPACE) <SPECIAL SPACE>)
   <UNWIND
    <PROG ((QVAL <QVAL .Q>)
	   (HINTS <COND (<LENGTH? .RQ 2> '[]) (<3 .RQ>)>))
      #DECL ((HINTS) VECTOR (QVAL) <OR FLOAT FIX>)
      <PRINC <1 .RQ>>
      <PROG ()
	    <SET ANSWER
	     <GETBUF
	      <ASTRING <ARESET .CURSPACE>
		       <MAPR ,ALSTRING
			     <FUNCTION (X) 
				     <COND (<==? .X .HINTS> <MAPSTOP>)
					   (<TYPE? <1 .X> STRING>
					    <MAPRET "Hint: " <1 .X> "
">)
					   (<MAPRET>)>>
			     <TOP .HINTS>>
		       <COND (<EMPTY? .HINTS> "
Your answer: ")
			     (<ASTRING .CURSPACE
				       "
Your answer [Hint for "
				       <UNPARSE <* .QVAL <2 .HINTS>>>
				       " points] : ">)>>
	      <1 .RQ>>>
	    <COND (<AND <QUESTIONABLE? .ANSWER> <NOT <EMPTY? .HINTS>>>
		   <CRLF>
		   <SET HNUM <+ .HNUM 1>>
		   <SET HVAL <* <2 .HINTS> .QVAL>>
		   <SET HINTS <REST .HINTS 2>>
		   <AGAIN>)>>
      <COND (<N==? <LENGTH .RQ> 1>
	     <AND <ANSWER?>
		  <SET SEEN 1>
		  <CRLF>
		  <PRINC "Answer is: ">
		  <PRINC <2 .RQ>>
		  <CRLF>>)>
      <INT-LEVEL 20>
      <COND (<QUESTIONABLE? .ANSWER>
	     <ADDSCORE ,PLAYER .Q 0.000>
	     <SEND-PLAYER <NTH .Q ,QAUTH>
			  <ANS-VEC .Q <ASTRING .TVS " gave up."> .SEEN>>)
	    (T
	     <SEND-PLAYER <NTH .Q ,QAUTH>
			  <ANS-VEC .Q .ANSWER .SEEN .HNUM .HVAL>>)>
      <SETG SCORED? T>
      <INT-LEVEL 0>
      <CRLF>>
    <COND (<1? .SEEN>
	   <COND (<QUESTIONABLE? .ANSWER> <ADDSCORE ,PLAYER .Q 0.000>)
		 (T <SEND-PLAYER <QAUTH .Q> <ANS-VEC .Q .ANSWER .SEEN>>)>
	   <SETG SCORED? T>)>>>

<DEFINE ASK.SIMPLE (Q
		    "AUX" (RQ <REST .Q ,QQUES>) ANSWER (TVS ,TVSPACE2)
			  (SEEN 0))
	#DECL ((Q RQ) VECTOR (ANSWER) STRING (TVS) SPACE (SEEN) FIX)
	<COND
	 (,IGNORE-SIMPLE)
	 (<PRINC <1 .RQ>>
	  <COND (<N==? <LENGTH .RQ> 1>
		 <AND <ANSWER?>
		      <SET SEEN 1>
		      <CRLF>
		      <PRINC "Answer is: ">
		      <PRINC <2 .RQ>>
		      <CRLF>
		      <SET ANSWER <GETBUF "Nonsense: " <1 .RQ>>>
		      <COND (<NOT <QUESTIONABLE? .ANSWER>>
			     <SEND-PLAYER <NTH .Q ,QAUTH>
					  <ANS-VEC .Q .ANSWER .SEEN>>)>>)
		(T
		 <CRLF>
		 <SET ANSWER <GETBUF "Nonsense: " <1 .RQ>>>
		 <COND (<NOT <QUESTIONABLE? .ANSWER>>
			<SEND-PLAYER <NTH .Q ,QAUTH>
				     <ANS-VEC .Q .ANSWER .SEEN>>)>)>
	  <CRLF>)>>

<DEFINE ANS-VEC (Q "TUPLE" STUFF "AUX" (TVS ,TVSPACE2)) 
	#DECL ((Q) VECTOR (STUFF) TUPLE (TVS) SPACE)
	<AVECTOR .TVS
		 <THISQ>
		 <NTH .Q ,QTYPE>
		 <ACOPY .TVS ,PLAYER>
		 !.STUFF>>

<SETG MATBL <MAKEGST "FROB" [0 T]>>

<SETG MBTBL <MAKESST "FROB" []>>

<SETG MATCH-SYMBOL <CHTYPE ["" 0] SYMBOL>>

<SETG MATCH-SYM ["SYM" "DEF" ,MATCH-SYMBOL]>

<GDECL (MATCH-SYMBOL)
       SYMBOL
       (MATCH-SYM)
       <VECTOR STRING STRING SYMBOL>>

<DEFINE GRAB-MATCH ("AUX" (A ,MATBL) (B ,MBTBL) (S ,MATCH-SYMBOL)
			  (CURSPACE ,TVSPACE2) (QUIT-D '["" -1])
			  (AVEC <REST <2 .A> 2>) (SYM ,MATCH-SYM))
	#DECL ((A B) SYMTABLE (CURSPACE) <SPECIAL SPACE>
	       (SYM AVEC QUIT-D) VECTOR (S) SYMBOL)
	<PUT .S 2 .AVEC>
	<PUT .S 1 <1 .AVEC>>
	<REPEAT (ACH BCH TEMP MSTR (TACH <REST <2 .A> 2>))
		#DECL ((ACH BCH TEMP) <OR FALSE <PRIMTYPE VECTOR>>
		       (TACH) <VECTOR ANY ANY> (MSTR) STRING)
		<GUNASSIGN MATCH>
		<COND (<AND <SET ACH <READER .A "
Match " "" .SYM ,VERBOSE>>
			    <N==? <2 <SET ACH <2 .ACH>>> -1>>
		       <SETG MATCH <MEMQ !". <1 .ACH>>>
		       <COND (<SET BCH <READER .B "with " "" '["SYM"] ,VERBOSE>>
			      <PUT .ACH 2 <2 .BCH>>
			      <SET MSTR <MEMQ <ASCII 46> <1 .ACH>>>
			      <PUT .MSTR 2 <ASCII 91>>
			      <PUT .MSTR 3 <ASCII <+ 48 </ <2 .BCH> 10>>>>
			      <AND <==? <3 .MSTR> <ASCII 48>>
				   <PUT .MSTR 2 <ASCII 32>>
				   <PUT .MSTR 3 <ASCII 91>>>
			      <PUT .MSTR 4 <ASCII <+ 48 <MOD <2 .BCH> 10>>>>
			      <PUT .MSTR 5 <ASCII 93>>)>
		       <COND (<SET TEMP <MEMQ 0 .TACH>>
			      <PUT .S 2 <SET TEMP <BACK .TEMP>>>
			      <PUT .S 1 <1 .TEMP>>)
			     (T <PUT .S 1 ""> <PUT .S 2 .QUIT-D>)>)
		      (<RETURN <MAPF ,ALLIST
				     <FUNCTION (X) 
					     <COND (<TYPE? .X FIX> .X)
						   (<MAPRET>)>>
				     <REST <2 ,MATBL> 2>>>)>>>

<DEFINE ASK.MATCH (Q
		   "AUX" (RQ <REST .Q ,QQUES>) (TVS ,TVSPACE2) LOSER EACH TBL
			 SCORE)
	#DECL ((Q RQ) VECTOR (TVS) SPACE (LOSER) <OR LIST FALSE>
	       (EACH SCORE) FLOAT (TBL) SYMTABLE)
	<CRLF>
	<MATCH-PRINT .RQ>
	<PUT ,MBTBL 2 <UNTASTEFUL-CODE <2 .RQ>>>
	<PUT ,MATBL 2 <UNTASTEFUL-CODE <1 .RQ> T>>
	<SET LOSER <GRAB-MATCH>>
	<SET EACH </ <NTH .Q ,QVAL> <FLOAT <LENGTH .LOSER>>>>
	<INT-LEVEL 20>
	<ADDSCORE ,PLAYER
		  .Q
		  <SET SCORE
		       <MAPF ,+
			     <FUNCTION (X Y) 
				     <COND (<N==? .X .Y> 0.000) (.EACH)>>
			     .LOSER
			     <3 .RQ>>>>
	<SETG SCORED? T>
	<INT-LEVEL 0>
	<PRINC "

Score of ">
	<PRIN1 .SCORE>
	<AND <ANSWER?>
	     <PRINC "

Correct matchings:">
	     <MATCH-PRINT .RQ T <> <>>
	     <CRLF>
	     <NOT <QUESTIONABLE? <4 .RQ>>>
	     <PRINC "Comment: ">
	     <PRINC <4 .RQ>>>
	<AND <NOT .LOSER> <SET LOSER <CHTYPE <ALIST .TVS> FALSE>>>
	<SEND-PLAYER <NTH .Q ,QAUTH> <ANS-VEC .Q .SCORE .LOSER>>>

<DEFINE MATCH-PRINT (RQ "OPTIONAL" (CORRECT <>) C3 (PRINT-HEAD T)) 
	#DECL ((RQ) VECTOR (CORRECT) <OR 'T FALSE> (C3) <OR FALSE LIST>)
	<COND
	 (<OR <NOT .CORRECT> <AND .CORRECT <SET C3 <3 .RQ>>>>
	  <CRLF>
	  <COND (.PRINT-HEAD <PRINC <5 .RQ>> <CRLF>)>
	  <PRINC "
Column A                            Column B
">
	  <REPEAT ((C1 <1 .RQ>) (C2 <2 .RQ>) (IDX 1))
		  #DECL ((C1 C2) LIST (IDX) FIX)
		  <COND (<AND <EMPTY? .C1> <EMPTY? .C2> <RETURN>>)
			(<EMPTY? .C1>
			 <AND .CORRECT <RETURN>>
			 <FORMAT <1 .C2> 36 .IDX>
			 <SET C2 <REST .C2>>)
			(<EMPTY? .C2>
			 <PRIN1 .IDX>
			 <PRINC ". ">
			 <PRINC <1 .C1>>
			 <SET C1 <REST .C1>>)
			(T
			 <FORMAT <1 .C1> 0 .IDX>
			 <FORMAT <COND (.CORRECT
					<COND (<0? <1 .C3>> "--gave up--")
					      (<NTH <2 .RQ> <1 .C3>>)>)
				       (<1 .C2>)>
				 36
				 .IDX>
			 <SET C1 <REST .C1>>
			 <SET C2 <REST .C2>>)>
		  <AND .CORRECT <SET C3 <REST .C3>>>
		  <SET IDX <+ .IDX 1>>
		  <CRLF>>)
	 (<PRINC "
Gave up.">)>>

<DEFINE FORMAT (STR NUM "OPTIONAL" IDX) 
	#DECL ((STR) STRING (NUM IDX) FIX)
	<COND (<0? .NUM>) (<INDENT-TO .NUM>)>
	<AND <ASSIGNED? IDX> <PRINC .IDX> <PRINC ". ">>
	<COND (<G? <LENGTH .STR> 33> <PRINC .STR> <CRLF>)
	      (<PRINC .STR>)>>

<SETG ASKERS
      [,TIME
       ,ASK.REGULAR
       ,ASK.MATCH
       ,ASK.MC
       ,ASK.MC
       ,TIME
       ,ASK.SIMPLE]>

<DEFINE GRADE.STUFF () 
	<SET-STATUS ,$SGRADE>
	<DATA-PRINTW ,TVASS <+ ,LUBLK ,LASTGRD> <DSKDATE>>
	<REPEAT ()
		<AND ,FLUSH <FLUSH-EM>>
		<COND (<CHAIN-FOLLOW ,READERS ,ANEXT ,ALAST>) (<RETURN>)>>>

<DEFINE READ.MAIL () 
	<SET-STATUS ,$SREAD>
	<REPEAT ()
		<AND ,FLUSH <FLUSH-EM>>
		<COND (<CHAIN-FOLLOW ,MREADERS ,MNEXT ,MLAST>) (<RETURN>)>>>

<DEFINE PRINT.MAIL (ML) 
	#DECL ((ML) VECTOR)
	<PRINC "
Message from ">
	<PRINC <3 .ML>>
	<PDSKDATE <SETG LASTMAIL <4 .ML>>>
	<CRLF>
	<PRINC <1 .ML>>>

<SETG MREADERS [,PRINT.MAIL]>

<DEFINE READ.COMM (A "AUX" Q.A) 
	#DECL ((A Q.A) VECTOR)
	<SET Q.A <QPRINT .A>>
	<PRINC " awarded ">
	<PRIN1 <4 .A>>
	<PRINC " points out of ">
	<PRIN1 <QVAL .Q.A>>
	<COND (<QUESTIONABLE? <5 .A>> <PRINC ".">)
	      (<PRINC "  and said 
'"> <PRINC <5 .A>> <PRINC "'">)>>

<DEFINE READ.SANS (A "AUX" Q.A) 
	#DECL ((A Q.A) VECTOR)
	<SET Q.A <QPRINT .A>>
	<PRINC " said
'">
	<PRINC <NTH .A ,ARESP>>
	<PRINC <ASCII 39>>>

<DEFINE READ.MATCH (A "AUX" Q.A KEY) 
	#DECL ((A Q.A) VECTOR (KEY) <OR FALSE <LIST [REST FIX]>>)
	<SET Q.A <QPRINT .A T>>
	<PRINC " scored ">
	<PRIN1 <NTH .A ,ARESP>>
	<PRINC " points ">
	<COND (<SET KEY <5 .A>>
	       <PUT .Q.A <+ ,QQUES 3> .KEY>
	       <MATCH-PRINT <REST .Q.A ,QQUES> T <> <>>)
	      (<PRINC " by giving up.">)>
	<CRLF>>

<DEFINE READ.MC (A "AUX" Q.A) 
	#DECL ((A Q.A) VECTOR)
	<SET Q.A <QPRINT .A>>
	<PRINC <NTH .A ,ARESP>>
	<CRLF>>

<DEFINE READ.REGULAR (A
		      "AUX" Q.A (TVS ,TVSPACE2) (TVS1 ,TVSPACE) (LBK ,LUBLK)
			    COMM (TVA ,TVASS) (GAVE-UP <>) TEMP)
	#DECL ((A Q.A) <SPECIAL VECTOR> (TVS TVS1) SPACE (COMM) STRING
	       (LBK TEMP) FIX (TVA) ASYLUM (GAVE-UP) <OR ATOM FALSE>)
	<SET Q.A <QPRINT .A>>
	<COND (<AND <NOT <LENGTH? .A ,ASEEN>>
		    <N==? <SET TEMP <NTH .A ,AHNUM>> 0>>
	       <PRINC ", with ">
	       <PRIN1 .TEMP>
	       <PRINC <COND (<1? .TEMP> " hint, ") (T " hints, ")>>)>
	<COND (<=? <NTH .A ,ARESP> ,IDUNNO>
	       <PRINC ,IDUNNO>
	       <SET GAVE-UP T>)
	      (<PRINC " said :
"> <PRINC <NTH .A ,ARESP>>)>
	<ARESET .TVS>
	<CRLF>
	<AND <G=? <LENGTH .A> ,ASEEN>
	     <==? <NTH .A ,ASEEN> 1>
	     <PRINC "[Answer seen] ">>
	<SET COMM <GETBUF "Comment: " <NTH .A ,ARESP>>>
	<REPEAT ((SCORE 0)
		 (MARKING
		  <COND (<AND <NOT <LENGTH? .A ,ASEEN>> <N==? <AHNUM .A> 0>>
			 <NTH .A ,AHVAL>)
			(<NTH .Q.A ,QVAL>)>))
		#DECL ((SCORE) <OR FIX FALSE FLOAT>
		       (MARKING) <SPECIAL <OR FLOAT FIX>>)
		<COND (<OR .GAVE-UP
			   <AND <AND <PRINC "Score (out of ">
				     <PRIN1 .MARKING>
				     <PRINC ")">
				     <SET SCORE
					  <READER '[]
						  " : "
						  '["" ""]
						  '["FIX" "FLOAT"]
						  ,VERBOSE>>
				     <G=? .SCORE 0>
				     <L=? .SCORE .MARKING>>
				<CRLF>
				<ADDSCORE <NTH .A ,AAUTH> .Q.A .SCORE>>>
		       <OR <AND .GAVE-UP <QUESTIONABLE? .COMM>>
			   <SEND-PLAYER <NTH .A ,AAUTH>
					<AVECTOR .TVS
						 <NTH .A ,AQUES>
						 ,$TLOSE
						 <ACOPY .TVS ,PLAYER>
						 .SCORE
						 .COMM>>>
		       <RETURN>)
		      (<NOT .SCORE>
		       <CHAIN-APPEND .TVA .TVS1 .A <+ .LBK ,ALAST>>
		       <PRINC "
Grading postponed.">
		       <RETURN>)
		      (<PRINC "
Illegal score (above VALUE or below 0)
">)>>>

<SETG READERS
      [,READ.COMM
       ,READ.REGULAR
       ,READ.MATCH
       ,READ.MC
       ,READ.MC
       ,TIME
       ,READ.SANS]>

<DEFINE QPRINT (A
		"OPTIONAL" (MATCH-ANS <>)
		"AUX" (TVA ,TVASS) (TVS ,TVSPACE) Q QR)
	#DECL ((A QR) VECTOR (TVS) SPACE (TVA) ASYLUM
	       (MATCH-ANS) <OR ATOM FALSE>)
	<COND (<SET Q <DATA-AREAD .TVA <NTH .A ,AQUES> .TVS>>
	       <CRLF>
	       <SET QR <REST .Q ,QQUES>>
	       <CRLF>
	       <PRINC "Re: Question #">
	       <PRIN1 <NTH .Q ,QQNUM>>
	       <CRLF>
	       <COND (<NOT .MATCH-ANS>
		      <COND (<==? <NTH .Q ,QTYPE> 3> <MATCH-PRINT .QR>)
			    (<PRINC <1 .QR>>)>
		      <CRLF>)
		     (<PRINC <5 .QR>> <CRLF> <CRLF>)>
	       <PRINC <NTH .A ,AAUTH>>
	       .Q)
	      (<PERR "Can't read QUESTION, QPRINT" <NTH .A ,AQUES>>)>>

<DEFINE UPDATE.QUESTION ("OPTIONAL" (COMPLEX? T)
			 "AUX" QUES Q (TVS <ARESET ,TVSPACE2>) (TVA ,TVASS) NEW
			       SYM QTOP)
	#DECL ((QUES) <OR FALSE VECTOR> (Q) <OR FALSE LIST> (TVS) SPACE
	       (TVA) ASYLUM (NEW) <OR MANIAC FALSE> (QTOP) VECTOR
	       (SYM) <OR FALSE SYMBOL> (COMPLEX?) <OR ATOM FALSE>)
	<SET-STATUS ,$SUPDATE>
	<COND (<COND (.COMPLEX? <SET SYM <GET.QUESTION>>)
		     (T <SET SYM <GET.SIMPLE>>)>
	       <SET QUES <DATA-AREAD .TVA <2 .SYM> <ARESET ,TVSPACE>>>
	       <SET-STATUS ,$SUPDATE <NTH .QUES ,QQNUM>>
	       <COND (<SET Q <APPLY <NTH ,MAKERS <NTH .QUES ,QTYPE>> .QUES>>
		      <SET QTOP <SUBSTRUC .QUES 0 ,QQUES>>
		      <SET QUES <AVECTOR .TVS 0 0 0 0 0 0 0 0 !.Q>>
		      <MAPR <>
			    <FUNCTION (X Y) 
				    #DECL ((X Y) VECTOR)
				    <PUT .X 1 <ACOPY .TVS <1 .Y>>>>
			    .QUES
			    .QTOP>
		      <PROG (LOSS)
			    #DECL ((LOSS) <OR MANIAC <FALSE FIX>>)
			    <COND (<SET LOSS
					<DATA-APRINT .TVA <2 .SYM> .TVS .QUES>>)
				  (<MEMQ <1 .LOSS> '(5 6)>
				   <STALL <1 .LOSS>>
				   <AGAIN>)
				  (<PERR "Can't PRINT UPDATE, UPDATE.QUESTION"
					 .LOSS>)>>)>)>>

<DEFINE PRINT-QUESTION (QUES
			"AUX" (QTYPE <QTYPE .QUES>) (RQ <REST .QUES ,QQUES>)
			      CORRECT (QVAL <QVAL .QUES>))
   #DECL ((QUES) <VECTOR FIX FIX FIX STRING ANY FIX ANY ANY ANY [REST ANY]>
	  (QVAL) <OR FIX FLOAT> (QTYPE CORRECT) FIX (RQ) VECTOR)
   <COND (<OR <==? .QTYPE ,$TSIMPLE> <==? .QTYPE ,$TLONG>>
	  <PRINC <1 .RQ>>
	  <COND (<NOT <LENGTH? .RQ 2>>
		 <MAPR <>
		       <FUNCTION (HINTS) 
			       #DECL ((HINTS) <VECTOR [REST
						       <OR STRING FLOAT>]>)
			       <COND (<TYPE? <1 .HINTS> STRING>
				      <CRLF>
				      <PRINC "Hint [for ">
				      <PRIN1 <* <2 .HINTS> .QVAL>>
				      <PRINC " points]: ">
				      <PRINC <1 .HINTS>>)>>
		       <3 .RQ>>
		 <CRLF>)>
	  <COND (<N==? <LENGTH .RQ> 1>
		 <CRLF>
		 <PRINC "Answer: ">
		 <PRINC <2 .RQ>>)>)
	 (<OR <==? .QTYPE ,$TMC> <==? .QTYPE ,$TTF>>
	  <SET CORRECT <3 .RQ>>
	  <PUT <2 <2 ,ALLSYMS>> 2 <UNTASTEFUL-CODE <REST .RQ 3>>>
	  <PRINC <1 .RQ>>
	  <MSTPOSSYM!-ICALSYM "" 0 <2 ,ALLSYMS>>
	  <CRLF>
	  <PRINC "Correct answer is ">
	  <PRINC <NTH <REST .RQ 3> .CORRECT>>
	  <PRINC ".">
	  <CRLF>
	  <COND (<NOT <QUESTIONABLE? <2 .RQ>>>
		 <PRINC "Comment: ">
		 <PRINC <2 .RQ>>
		 <CRLF>)>)
	 (<==? .QTYPE ,$TMATCH>
	  <MATCH-PRINT .RQ>
	  <CRLF>
	  <PRINC "Correct matchings:">
	  <MATCH-PRINT .RQ T <> <>>
	  <COND (<NOT <QUESTIONABLE? <4 .RQ>>>
		 <PRINC "Comment: ">
		 <PRINC <4 .RQ>>)>)>>

<DEFINE PRINT.SIMPLE ("AUX" (TVA ,TVASS) (TVS ,TVSPACE) SYML) 
	#DECL ((TVA) ASYLUM (TVS) SPACE (SYML) <OR FALSE <LIST [REST SYMBOL]>>)
	<COND (<SET SYML <GET.SIMPLE T>>
	       <CRLF>
	       <MAPF <>
		     <FUNCTION (X "AUX" QUES) 
			     #DECL ((X) SYMBOL (QUES) VECTOR)
			     <SET QUES <DATA-AREAD .TVA <2 .X> <ARESET .TVS>>>
			     <PQHEADER .QUES>
			     <PRINT-QUESTION .QUES>
			     <CRLF>>
		     .SYML>)>>

<DEFINE MATCH-HACK (X) .X>