check.4
<COND (<GASSIGNED? $TSIMPLE>)
(T
<SETG ATYPE 2>
<SETG AQUES 1>
<SETG QAUTH 4>
<SETG QQNUM 1>
<SETG ANEXT 1>
<SETG MNEXT 7>
<SETG HIQNUM 5>
<MANIFEST ATYPE AQUES QAUTH QQNUM ANEXT MNEXT HIQNUM>
<NEWTYPE SPACE VECTOR>
<NEWTYPE ASYLUM VECTOR>)>
<FLOAD "AR2:TAA;SSNAME NBIN">
<SETG QNUMS <REST <IUVECTOR 100 0> 100>>
<GDECL (QNUMS) <UVECTOR [REST FIX]>>
<DEFINE WINNING-ANSWER? (ANS PLAYER PROGRESS "AUX" TQUES (TVA ,TVASS) (TVS ,TVSPACE)
(QNUM <AQUES .ANS>) (QNUMS ,QNUMS))
#DECL ((PLAYER) TIME (PROGRESS QNUM) FIX (TQUES) <VECTOR FIX FIX FIX TIME>
(ANS) <VECTOR FIX FIX TIME> (TVA) ASYLUM (TVS) SPACE
(QNUMS) <UVECTOR [REST FIX]>)
<COND (<1? <ATYPE .ANS>>
<L=? <SET QNUM <QQNUM <DATA-AREAD .TVA .QNUM <ARESET .TVS>>>>
.PROGRESS>)
(<MEMQ .QNUM .QNUMS>)
(<SET TQUES <DATA-AREAD .TVA <AQUES .ANS> <ARESET .TVS>>>
<COND (<==? <QAUTH .TQUES> .PLAYER>
<PUT <SETG QNUMS <BACK .QNUMS>> 1 .QNUM>
T)>)>>
<DEFINE ANS-CHAIN-CHECK (PLAYER IDX PROGRESS "AUX" (START <+ .IDX ,ANEXT>)
(TVA ,TVASS)(TVS ,QSPACE))
#DECL ((PLAYER) TIME (IDX PROGRESS START) FIX (TVA) ASYLUM (TVS) SPACE)
<SETG QNUMS <REST ,QNUMS <LENGTH ,QNUMS>>>
<REPEAT (ANS NEXT) #DECL ((ANS) <OR FALSE VECTOR>)
<COND (<0? <SET START <CHTYPE <DATA-READW .TVA .START> FIX>>>
<RETURN>)
(<SET ANS <DATA-AREAD .TVA .START <ARESET .TVS>>>
<COND (<WINNING-ANSWER? .ANS .PLAYER .PROGRESS>)
(T
<PRIN1 .START>
<PRINC " ">
<&1 .ANS>
<CRLF>)>)
(<PRINC "CAN'T READ ">
<PRIN1 .START>
<PRINC " ">
<PRINC <NTH ,DATA-ERRORS <1 .ANS>>>
<CRLF>)>>>
<DEFINE SCHECK ("OPTIONAL" (CHECK? T) "AUX" (OUTCHAN <OPEN "PRINT" "TAA;CHECK OUTPUT">))
#DECL ((CHECK?) <OR ATOM FALSE> (OUTCHAN) <SPECIAL CHANNEL>)
<DO-CHECK .CHECK?>
<CLOSE .OUTCHAN>
ZORK>
<DEFINE DO-CHECK ("OPTIONAL" (CHECK? T) "AUX" (TVA ,TVASS))
#DECL ((CHECK?) <OR ATOM FALSE> (TVA) ASYLUM)
<REPEAT ((L ,LOSSTABLE) PROGRESS PLAYER IDX)
#DECL ((L) <LIST [REST TIME STRING FIX FIX]>
(PROGRESS) FIX (PLAYER) TIME (IDX) FIX)
<SSNAME <SET PLAYER <1 .L>>>
<SET IDX <3 .L>>
<SET PROGRESS <GETLASTQ .IDX>>
<6PRINC .PLAYER>
<PRINC " ">
<PRIN1 .PROGRESS>
<PRINC " ">
<PDSKDATE <DATA-READW .TVA <+ .IDX ,LASTIN>>>
<CRLF>
<COND (.CHECK?
<SCORE-CHECK .PLAYER .IDX>
<QASKED-CHECK .PLAYER .IDX>
<ANS-CHAIN-CHECK .PLAYER .IDX .PROGRESS>
<MAIL-CHAIN-CHECK .PLAYER .IDX>)>
<COND (<EMPTY? <SET L <REST .L 4>>><RETURN>)>>>
<DEFINE SCORE-CHECK (PLAYER IDX "AUX" SCORE)
#DECL ((PLAYER) TIME (IDX) FIX (SCORE) ANY)
<COND (<SET SCORE <DATA-AREAD ,TVASS <+ .IDX ,SCORE> <ARESET ,SSPACE>>>
<COND (<AND <TYPE? .SCORE UVECTOR>
<==? <UTYPE .SCORE> UVECTOR>
<==? <LENGTH .SCORE> 15>>)
(<PRINC "SCORE">
<PRINC " ">
<PRINC .SCORE>)>)
(<PRINC "SCORE">
<PRINC " ">
<PRINC .SCORE>)>>
<DEFINE QASKED-CHECK (PLAYER IDX "AUX" QASKED)
#DECL ((PLAYER) TIME (IDX) FIX (QASKED) ANY)
<COND (<SET QASKED <DATA-AREAD ,TVASS <+ .IDX ,QASKED> <ARESET ,SSPACE>>>
<COND (<AND <TYPE? .QASKED VECTOR>
<==? <LENGTH .QASKED> 15>
<MAPF ,AND?
<FUNCTION (X)
<TYPE? .X LIST>>
.QASKED>>)
(<PRINC "QASKED">
<PRINC " ">
<PRINC .QASKED>)>)
(<PRINC "QASKED">
<PRINC " ">
<PRINC .QASKED>)>>
<GDECL (TVASS) ASYLUM (TVSPACE1) SPACE>
<DEFINE MAIL-CHAIN-CHECK (PLAYER IDX "AUX" (PROGRESS #WORD *0*) (START <+ .IDX ,MNEXT>)
(TVA ,TVASS) (TVS ,QSPACE))
#DECL ((PLAYER) TIME (IDX) FIX (PROGRESS) <OR WORD <FALSE WORD>>
(START) FIX (TVA) ASYLUM (TVS) SPACE)
<REPEAT (MAIL NEXT) #DECL ((MAIL) <OR VECTOR FALSE>)
<COND (<0? <SET START <CHTYPE <DATA-READW .TVA .START> FIX>>>
<RETURN>)
(<SET MAIL <DATA-AREAD .TVA .START <ARESET .TVS>>>
<COND (<SET PROGRESS <WINNING-MAIL? .MAIL .PROGRESS>>)
(T
<PRIN1 .START>
<PRINC " ">
<&1 .MAIL>
<CRLF>
<SET PROGRESS <1 .PROGRESS>>)>)
(<PRINC "CAN'T READ ">
<PRIN1 .START>
<PRINC " ">
<PRINC <NTH ,DATA-ERRORS <1 .ANS>>>
<CRLF>)>>>
<DEFINE WINNING-MAIL? (MAIL PROGRESS "AUX" (TP <4 .MAIL>))
#DECL ((MAIL) <VECTOR [4 ANY]> (PROGRESS) WORD (TP) ANY)
<COND (<AND <TYPE? <3 .MAIL> TIME>
<TYPE? <4 .MAIL> WORD>
<TYPE? <1 .MAIL> STRING>
<G? <CHTYPE .TP FIX> <CHTYPE .PROGRESS FIX>>>
.PROGRESS)
(T <CHTYPE (.TP) FALSE>)>>