tvguts.4
<SETG FROBS
'![<MAKE.QUESTIONS>
<ASK.QUESTIONS>
<GRADE.STUFF>
<READ.MAIL>
<BABBLE-SORT>
<PSCORES>
<PRINT.QSCORE>!]>
<SETG FROB-NAMES
'["
Making Questions.
"
"
Answering Questions.
"
"
Grading/Reading Answers.
"
"
Reading mail.
"
"
Babbling.
"
"
Printing scores.
"
"
Status of questions
"]>
<SETG TUV <IUVECTOR 4 0>>
<SETG TTUV <IUVECTOR 1 0>>
<SETG TBUV <IUVECTOR 4 0>>
<SETG FOOUV <IUVECTOR 4 0>>
<GDECL (TUV TBUV FOOUV)
<UVECTOR [4 FIX]>
(TTUV)
<UVECTOR FIX>>
<SETG STATUS-VECTOR
'[0
"Grade"
1
"Answer"
2
"Babble"
3
"Read mail"
4
"Make"
5
"Peek"
6
"Start up"
7
"Print score"
8
"Command"
9
"Update"
10
"Status"
11
"FLUSH"
12
"ERROR"
13
"SHOUT"]>
<DEFINE DFUMP ("OPTIONAL" (FNAM "MADMAN;TV FOO"))
#DECL ((FNAM) STRING)
<DEBUG>
<FUMP -1 ,TIME -1 .FNAM>>
<GDECL (PG) FIX (LASTMAIL) WORD>
<DEFINE FUMP (VERSION
"OPTIONAL" (SAVER ,TIME) (MOD 0) (FNAM "MADMAN;TV FILE")
"AUX" M PLAYERS TEMP)
#DECL ((VERSION MOD) FIX (M) <OR FALSE LIST> (SAVER) APPLICABLE
(PLAYERS) STRUCTURED (TEMP) FIX (FNAM) STRING)
<COND (<=? <APPLY .SAVER "MADMAN;TRV SAVFIL"> "SAVED">)
(<AND <DINIT> <>>)
(<AND <=? <JNAME> "DEBUG"> <MEMBER <XUNAME> ,WINNERS>>
<SETG TVASS <OPEN-DATA-FILE .FNAM <> 7 5>>
"LOSING")
(<SETG TVASS <OPEN-DATA-FILE .FNAM <> 7 5>>
<COMREP>
<PRINC "
TRIVIA.">
<PRIN1 .VERSION>
<COND (<0? .MOD>) (<PRINC "."> <PRIN1 .MOD>)>
<CRLF>
<IPC-OFF>
<IPC-ON <XUNAME> "TRIVIA">
<INIT> ;"SET UP TTY'S"
<SET IMLAC? <==? <MOD <11 ,INCHAN> 128> 2>>
<SETG TVSPACE <AFIND 1>>
<SETG TVSPACE1 <AFIND 1>>
<SETG TVSPACE2 <AFIND 1>>
<SETG LOSSSPACE <AFIND 1>>
<SETG MOBYSPACE <AFIND 4>>
<SETG LOSSTABLE <DATA-AREAD ,TVASS ,LUSERS ,LOSSSPACE>>
<RESET ,INCHAN>
<COND (<SET M <MEMBER <SETG PLAYER <XUNAME>> ,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>>>>
<PUT-LOC <+ .TEMP 1> '![0!]>
<DHLOCK .TEMP>>
<UPDATE-BABBLE ,LUBLK ,TINDEX>
<PUT ,TUV 2 <STRTOX ,PLAYER>>
<PUT ,TUV 3 <CHTYPE <DSKDATE> FIX>>
<SET-STATUS ,$SWAKE>
<DATA-PRINTW ,TVASS <+ ,LUBLK ,LASTIN> <DSKDATE>>
<SETG LASTMAIL
<CHTYPE <1 <GET-LOC <+ ,PG 1 ,TELEC-START ,TINDEX> ,TTUV>>
WORD>>
<READ.ANNOUNCE>
<PLAY-BALL>)
(<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 (SCOREM (TOTAL 0.000) (POSS 0.000))
#DECL ((SCOREM) <OR FALSE MANIAC> (TOTAL POSS) FLOAT)
<COND (<DHLOCK .LOC>
<SET SCORE
<DATA-AREAD ,TVASS
<+ .LUBLK ,SCORE>
<ARESET ,TVSPACE>>>
<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" (TVA ,TVASS) LST (UV ,TTUV) (TINDEX ,TINDEX))
#DECL ((TVA) ASYLUM (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> <PRINC "
--MESSAGE HERE--
">)>
<INT-LEVEL 0>
<DISMISS T>>
<SETG PNEWMAIL <>>
<SETG WINNERS ("MARC" "TAA" "JMB")>
<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 <MEMBER <XUNAME> ,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) (TVS ,TVSPACE))
#DECL ((PS XUNM) STRING (VEC) <UVECTOR [REST UVECTOR]> (TVA) ASYLUM
(TVS) 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>>
<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>>)>
<ARESET .TVS>
<SET P <DATA-AREAD .TVA ,LUSERS .TVS>>
<SET P <PUTREST <ALIST .TVS .TINDEX> .P>>
<SET P <PUTREST <ALIST .TVS .L> .P>>
<SET P <PUTREST <ALIST .TVS <ACOPY .TVS .PS>> .P>>
<SET P <PUTREST <ALIST .TVS <ACOPY .TVS .XUNM>> .P>>
<OR <DATA-IPRINT .TVA .CRAZY .TVS .P>
<PERR "Can't print NEW-USER">>
<DATA-CLOSE .TVA .CRAZY>>
<DATA-CLOSE .TVA .CRAZY>>
<SET VEC <AIUVECTOR <ARESET .TVS> ,NCAT <AUVECTOR .TVS>>>
<MAPR <>
<FUNCTION (X) <PUT .X 1 <AUVECTOR .TVS 0.000 0.000>>>
.VEC>
<DATA-APRINT .TVA <+ .L ,SCORE> .TVS .VEC>
<DATA-APRINT .TVA
<+ .L ,QASKED>
.TVS
<AIVECTOR <ARESET .TVS> ,NCAT <ALIST .TVS>>>
<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 COMMAND ("AUX" RD)
#DECL ((RD) <OR FALSE SYMBOL>)
<REPEAT ()
<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>
"Babble"
<BABBLE-SORT>
"End.teleconference"
<OFFTELECON>
"Grade"
<GRADE.STUFF>
"Load.players"
<NEW-LOSS>
"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"
<TVPEEK>
"Print.score"
<PSCORES>
"Question.print"
<PRINT.QSCORE T T>
"Quit"
<QUIT>
"Read.mail"
<READ.MAIL>
"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 ,PLAYER>
"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>
"Update.question"
<UPDATE.QUESTION>
"Verbosity"
<COND (<SETG VERBOSE <NOT ,VERBOSE>> <PRINC "
Verbose">)
(<PRINC "
Unverbose">)>]>>
<SETG BUFSAFE <>>
<SETG DCOMS <MAKESST "DCOM" []>>
<SETG MCOMS <MAKEMST "MCOM" [,COMS ,DCOMS]>>
<SETG DCOM
'["Recurse"
<RECURSE>
"Play"
<PLAY>
"Erret"
<DO-ERRET>
"Evaluate"
<DO-EVAL>]>
<DEFINE DO-ERRET () <ERRET <READER [] "" "" ["ANY"] <>>>>
<DEFINE DO-EVAL () <EVAL <READER [] "" "" ["ANY"] <>>>>
<SETG DEBUGSW <>>
<DEFINE DEBUG () <PUT ,DCOMS 2 ,DCOM> <SETG DEBUGSW T>>
<SETG DSKDATE
%<FIXUP!-RSUBRS '[
#CODE ![23751557122 23085678677 25614352384 4701028359 -26289897472 17188483128
23085698016 *400000000000* -14200726235 -34091302910 2 5804174166 0 262146!]
DSKDATE
#DECL ("VALUE" WORD)]
'(53
FINIS!-MUDDLE
229461
(2)
$TLOSE!-MUDDLE
225280
(6)
MPOPJ!-MUDDLE
248800
(7))>>
<AND <ASSIGNED? GLUE>
.GLUE
<PUT ,DSKDATE GLUE '![17448304640 2!]>>
<SETG FLUSH <>>
<SETG QTYPES
<MAKEBST "QT"
'["Command"
1
"Joint"
8
"Long Answer"
2
"Matching"
3
"Multiple Choice"
4
"None"
0
"Quit"
6
"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 <>) "AUX" (IDX 0))
<MAPF ,VECTOR
<FUNCTION (X)
<SET IDX <+ .IDX 1>>
<COND (<AND <1? .IDX> .GST>
<MAPRET 2
,MATCH-HACK
<STRING <UNPARSE .IDX> ". " .X>
0>)>
<MAPRET <STRING <UNPARSE .IDX> ". " .X>
<COND (.GST 0) (.IDX)>>>
.Q>>
<DEFINE FLUSH-EM ()
<COND (<TYPE? ,FLUSH FIX> <OUT ,FLUSH>)
(<==? ,FLUSH SHOUT> <SETG FLUSH <>> <PRINT.SHOUT>)
(T
<OUT <MOD <RANDOM <CHTYPE <TIME> FIX> <FIX <SIN <TIME>>>> 20>>)>>
<DEFINE OUT ("OPTIONAL" (DELAY 10.000))
#DECL ((DELAY) <SPECIAL <OR FIX FLOAT>>)
<SET-STATUS ,$SFLUSH>
<OFF "CHAR" ,INCHAN>
<INT-LEVEL 999>
<ON "CLOCK"
<FUNCTION ("AUX" (D .DELAY))
<AND <0? <- .D <FIX .D>>>
<PRINC "TRIVIA going down in ">
<PRIN1 <FIX .D>>
<PRINC <COND (<1? .D> " second.") (" seconds.")>>
<CRLF>>
<SET DELAY <- .D 0.500>>>
1000>
<SLEEP .DELAY>
<VALRET ":KILL
:
TRIVIA DOWN!
">>
<DEFINE PRINT.SHOUT ("AUX" (MSG
<DATA-AREAD ,TVASS ,SHOUTMSG <ARESET ,TVSPACE>>))
#DECL ((MSG) <VECTOR STRING STRING>)
<CRLF>
<CRLF>
<CRLF>
<IMAGE 7>
<IMAGE 7>
<IMAGE 7>
<PRINC "Message from ">
<PRINC <1 .MSG>>
<CRLF>
<PRINC <2 .MSG>>
<CRLF>>
<DEFINE SHOUT ("AUX" MSG ID (TVA ,TVASS) (TVS ,TVSPACE))
#DECL ((MSG) STRING (ID) <OR FALSE MANIAC> (TVA) ASYLUM)
<COND (<MEMBER ,PLAYER ,WINNERS>
<SET MSG <GETBUF "Message: ">>
<COND (<NOT <QUESTIONABLE? .MSG>>
<COND (<SET ID <DATA-OPEN "PRINT" .TVA ,SHOUTMSG>>
<DATA-IPRINT .TVA
.ID
.TVS
<AVECTOR <ARESET .TVS>
<ACOPY .TVS ,PLAYER>
<ACOPY .TVS .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" (GRACE 10) "AUX" CH)
#DECL ((GRACE) FIX (CH) <OR CHANNEL FALSE>)
<COND (<MEMBER ,PLAYER ,WINNERS>
<CRLF>
<VALRET ":COPY AR1:MARC;TS TVDOWN,SYS;TS TRIVIA
:CONTIN
">
<AND <SET CH <OPEN "PRINT" "_MSGS_;TRIVIA DEBUG">>
<CLOSE .CH>>
<SEND-TRIVIAS .GRACE>)
(<QUIT>)>>
<DEFINE SEND-TRIVIAS (WHAT?
"AUX" (PG ,PG) (UV ,FOOUV) (SENDER ,PLAYER)
(MSG <STRING "<SETG FLUSH " <UNPARSE .WHAT?> ">">))
#DECL ((PG) FIX (UV) <UVECTOR [4 FIX]> (SENDER MSG) STRING)
<SET-STATUS ,$SHOUT>
<REPEAT ((N 0) (LOC <+ .PG ,PEEK-START>) LOSER)
#DECL ((N LOC) FIX (LOSER) STRING)
<COND (<G? .N 83> <RETURN>)
(<AND <GET-LOC .LOC .UV> <0? <1 .UV>>>
<COND (<=? <SET LOSER <SIXTOS <2 .UV>>> .SENDER>)
(T
<SEND .LOSER "TRIVIA" .MSG *400000000000*>
<PRINC .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 NEW-MATCH <>>
<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) LIST)
<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? <>)
"AUX" (TVS ,TVSPACE2) (TVA ,TVASS) (TTUV ,TTUV) NUTS LAST
NEW (RETRY? T) LOC)
#DECL ((WHO) STRING (WHAT) ANY (TVS) SPACE (NUTS) LIST (LOC LAST WHR) FIX
(TVA) ASYLUM (MUNG-SLOT) <OR FIX FALSE> (NEW) <OR FALSE MANIAC>
(RETRY?) <OR ATOM FALSE> (TTUV) <UVECTOR FIX>)
<COND (<=? ,PLAYER "DEBUG">)
(<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>>)>
<COND (<CHAIN-APPEND .TVA .TVS .WHAT .LAST>
<CRLF>
<PRINC "Sent.">)
(<PERR "SEND-PLAYER FAILURE -- PLEASE REPORT TO MARC">)>)>>
<DEFINE NEW-LOSS ("AUX" NUTS)
#DECL ((NUTS) <OR LIST FALSE>)
<GUNASSIGN PLAYER-SYMS>
<COND (<SET NUTS <DATA-AREAD ,TVASS ,LUSERS <ARESET ,LOSSSPACE>>>
<SETG LOSSTABLE .NUTS>
.NUTS)
(T
<PERR "Can't read losstable--your TRIVIA is DEAD"
.NUTS
NEW-LOSS>)>>
<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)
<PRINC "
NON-FATAL TIME OUT, STALLING BECAUSE --">
<PRINC <NTH ,ERRORS .WHY>>
<SLEEP 4>>
<DEFINE GET-LOSER (PLAYER "AUX" (NUTS ,LOSSTABLE) OINT)
#DECL ((PLAYER) STRING (NUTS) <OR LIST FALSE> (OINT) FIX)
<SET OINT <INT-LEVEL 20>>
<COND (<SET NUTS <MEMBER .PLAYER .NUTS>>)
(<SET NUTS <NEW-LOSS>>
<COND (<SET NUTS <MEMBER .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) (TVS ,TVSPACE1) ID
SCORE SCUVEC LBLK M CATSCR OINT)
#DECL ((WHO) STRING (QUES) VECTOR (AMT) <OR FIX FLOAT> (TVA) ASYLUM
(NUTS) LIST (TVS) SPACE (ID) <OR MANIAC FALSE> (SCORE) WORD
(SCUVEC) <UVECTOR [REST <UVECTOR FLOAT FLOAT>]> (M) <OR FALSE LIST>
(LBLK) FIX (CATSCR) <UVECTOR FLOAT FLOAT>)
<COND
(<=? ,PLAYER "DEBUG">)
(<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 .TVS>>>
<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 .TVS .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 ". Please report to ">
<PRINC ,MAINT>
<SETG REP ,SAVEREP>
<ERROR TRIVIA-LOSSAGE!-ERRORS !.ARG>>
<SETG MAINT "MARC or TAA">
<SETG WHOSYMS <MAKESST "FOO" []>>
<DEFINE P-SYMS ("AUX" (NUTS ,LOSSTABLE) (CURSPACE ,LOSSSPACE))
#DECL ((NUTS) LIST (CURSPACE) <SPECIAL SPACE>)
<COND (<GASSIGNED? PLAYER-SYMS> ,PLAYER-SYMS)
(<SETG PLAYER-SYMS
<PUT ,WHOSYMS
2
<MAPR ,ALVECTOR
<FUNCTION (X)
<COND (<==? 1 <1 .X>> <MAPRET>)
(<AND <TYPE? <1 .X> STRING>
<NOT <TYPE? <2 .X> FIX>>>
<MAPRET <1 .X> <3 .X>>)
(<MAPRET>)>>
.NUTS>>>)>>
<DEFINE SEND.MAIL ("AUX" (TVS <ARESET ,TVSPACE2>) WHO LST MSG)
#DECL ((TVS) 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: ">>
<MAPF <>
<FUNCTION (X)
<SEND-PLAYER <1 .X>
<AVECTOR .TVS
.MSG
1
<ACOPY .TVS ,PLAYER>
<DSKDATE>>
,MLAST
,TELEC-START>>
.LST>)>)>>
<DEFINE CHAIN-FOLLOW (APP FROM TO
"AUX" (TVA ,TVASS)
(LO <CHTYPE <DATA-READW .TVA <+ ,LUBLK .FROM>> FIX>)
(TVS <ARESET ,TVSPACE>) MAIL NEXT)
#DECL ((TVA) ASYLUM (LO FROM TO) FIX (TVS) SPACE
(MAIL) <OR FALSE VECTOR> (NEXT) WORD
(APP) <VECTOR [REST APPLICABLE]>)
<COND (<0? .LO> #FALSE ())
(<SET MAIL <DATA-AREAD .TVA .LO .TVS>>
<APPLY <NTH .APP <NTH .MAIL ,ATYPE>> .MAIL>
<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 ()
<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 12> ,XSPCCHARS>>
<PUT .FOO 2 '<CLEAR>>
<SETG XSPCCHARS
[<ASCII 20> '<ANSHACK> <ASCII 22> '<VERBOHACK> !,XSPCCHARS]>
<ON "CHAR" ,CHARINT 8 0 ,INCHAN>>
<DEFINE CLEAR ()
<PRINC "C">
<COND (<ASSIGNED? QUESTION?>
<PQHEADER .QUESTION?>
<COND (<==? <NTH .QUESTION? ,QTYPE> ,$TMATCH>
<MATCH-PRINT <REST .QUESTION? ,QQUES>>)
(<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 (<MEMBER ,PLAYER ,WINNERS> <RECURSE> <DISMISS T>)
(<DISMISS T>)>)
(<==? .CHR <ASCII 22>> <VERBOHACK>)
(<==? .CHR <ASCII 20>> <ANSHACK>)>>
<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) (TVS ,TVSPACE1) NUTS WHR)
#DECL ((PLAYER) STRING (TVA) ASYLUM (TVS) SPACE (NUTS) LIST (WHR) FIX)
<SET WHR
<+ ,SCORE
<COND (<=? .PLAYER ,PLAYER> ,LUBLK)
(<SET NUTS <GET-LOSER .PLAYER>> <3 .NUTS>)>>>
<DATA-AREAD .TVA .WHR <ARESET .TVS>>>
<DEFINE PSCORE (PLAYER
"AUX" SCUVEC (TVS ,TVSPACE1) (TVA ,TVASS) (N 1) (TOT 0)
(SCTOT 0) (QTOT 0) QTEMP QASKED LUBLK NSC NSC1)
#DECL ((PLAYER) STRING (SCUVEC) UVECTOR (QTEMP QTOT N) FIX (TVA) ASYLUM
(TVS) SPACE (TOT SCTOT) <OR FIX FLOAT> (NSC NSC1) FLOAT
(QASKED) <VECTOR [REST LIST]> (LUBLK) FIX)
<SET SCUVEC <GETSCORE .PLAYER>>
<SET QASKED
<DATA-AREAD .TVA
<+ <SET LUBLK <3 <MEMBER .PLAYER ,LOSSTABLE>>> ,QASKED>
.TVS>>
<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 " questions.">
<CRLF>
<PRINC "Progress: ">
<PRIN1 <GETLASTQ .LUBLK>>>
<DEFINE GETLASTQ (LUBLK "AUX" (TVS ,TVSPACE1) Q LOWQ)
#DECL ((LOWQ LUBLK) FIX (Q) <OR FALSE <VECTOR FIX [REST ANY]>>)
<COND (<==? <SET LOWQ
<CHTYPE <DATA-READW ,TVASS <+ .LUBLK ,QNEXT>> FIX>>
,LOWQUES>
0)
(<SET Q <DATA-AREAD ,TVASS .LOWQ <ARESET .TVS>>>
<QQNUM .Q>)>>
<DEFINE PDSKDATE (WD
"AUX" (TIM <CHTYPE <GETBITS .WD <BITS 18 0>> FIX>)
(A/P " AM ") HR)
#DECL ((WD) WORD (TIM HR) FIX (A/P) STRING)
<PRINC " ">
<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 ANNOUNCE ("AUX" (TVS <ARESET ,TVSPACE2>) (TVA ,TVASS) ANN)
#DECL ((TVA) ASYLUM (TVS) SPACE (ANN) STRING)
<COND (<AND <PRINC
"
[PLEASE ONLY MAKE ANNOUNCEMENTS IF REALLY NECESSARY
TYPE ALTMODE TO FLUSH THIS COMMAND]
">
<SET ANN <GETBUF "Announcement: ">>
<NOT <QUESTIONABLE? .ANN>>>
<CHAIN-APPEND .TVA
.TVS
<AVECTOR .TVS <DSKDATE> <ACOPY .TVS ,PLAYER> .ANN>
,HIMAIL>)>>
<DEFINE READ.ANNOUNCE ("AUX" (TVA ,TVASS) (TVS <ARESET ,TVSPACE>) ANN
(NXT
<CHTYPE <DATA-READW .TVA <+ ,LUBLK ,ANNEXT>>
FIX>))
#DECL ((TVA) ASYLUM (NXT) FIX (TVS) SPACE (ANN) <OR FALSE VECTOR>)
<REPEAT ()
<COND (<0? <SET NXT <CHTYPE <DATA-READW .TVA .NXT> FIX>>>
<RETURN>)
(<SET ANN <DATA-AREAD .TVA .NXT .TVS>>
<PRINC "
From ">
<PRINC <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 () <SETG SAVEREP ,REP> <SETG REP ,COMMAND>>
<DEFINE RECURSE () <SETG REP ,SAVEREP> <LISTEN> <SETG REP ,COMMAND>>
<DEFINE ANSWER? ()
<OR ,ALWAYS-ANSWER
<PROG topask ()
#DECL ((topask) <SPECIAL ACTIVATION>)
<TRUE? "
Want the answer "
"Y/N"
'(!"Y !"y)
'(!"N !"n)
<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 !"0>>
<AND <L? .DEC 10> <PRINC !"0>>
<PRINC .DEC>>
<PRINTTYPE FLOAT ,FLOATPRINT>
<OVERFLOW <>>
<DEFINE TVSAVE (VER DBG "OPTIONAL" (MOD 0) "AUX")
#DECL ((DBG) <OR 'T FALSE> (VER MOD) FIX)
<CHAR-INIT>
<AND .DBG <DEBUG>>
<FUMP .VER ,SAVE .MOD>>
<SETG QSYMS <MAKESST "QSYMS" []>>
<DEFINE Q-SYMS ("AUX" (TVA ,TVASS) (CURSPACE <ARESET ,TVSPACE>) (IDX 1) WHR)
#DECL ((TVA) ASYLUM (CURSPACE) <SPECIAL SPACE> (WHR IDX) 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 SIMTABLE <MAKESST "SIMTABLE" []>>
<GDECL (SIMTABLE) <OR FALSE SYMTABLE>>
<DEFINE GET.SIMPLE ("OPTIONAL" (MULT <>) "AUX" SYMV)
#DECL ((SYMV) <OR FALSE VECTOR> (MULT) <OR ATOM FALSE>)
<COND (<NOT <GASSIGNED? SIMPLE-SPACE>>
<COND (<SETG SIMTABLE <LOAD.SIMPLE ,PLAYER>>)
(T <PERR "Can't get QUESTION SYMBOLS" GET.SIMPLE>)>)>
<COND (<SET SYMV
<READARGS ,SIMTABLE
"Question"
'["" ""]
<COND (.MULT '["SYM" "MULT"]) ('["SYM"])>>>
<AND <NOT <EMPTY? <1 .SYMV>>> <1 .SYMV>>)>>
<DEFINE LOAD.SIMPLE (PLAYER
"AUX" (TVA ,TVASS)
(CURSPACE
<COND (<GASSIGNED? SIMPLE-SPACE> ,SIMPLE-SPACE)
(T <SETG SIMPLE-SPACE <AFIND 1>>)>)
(TVS ,TVSPACE1) (CQID ,LOWQUES) RES)
#DECL ((PLAYER) STRING (CURSPACE) <SPECIAL SPACE> (TVS) SPACE (TVA) ASYLUM
(CQID) FIX (RES) VECTOR)
<PUT
,SIMTABLE
2
<MAPF ,ALVECTOR
<FUNCTION ()
<COND
(<0? <SET CQID <CHTYPE <DATA-READW .TVA .CQID> FIX>>>
<MAPSTOP>)
(<SET CQUES <DATA-AREAD .TVA .CQID <ARESET .TVS>>>
<COND (<AND <==? <QTYPE .CQUES> ,$TSIMPLE>
<=? <QAUTH .CQUES> .PLAYER>>
<MAPRET <ASTRING .CURSPACE <UNPARSE <QQNUM .CQUES>>>
.CQID>)
(T <MAPRET>)>)
(<PERR "Can't read question" LOAD.SIMPLE .CQID> <MAPRET>)>>>>>
<DEFINE PRINT.QSCORE ("OPTIONAL" (PRINT? T) (VERBOSE? <>)
"AUX" (TVA ,TVASS) (TVS ,TVSPACE) (PL 0) (PS 0.000)
(MX 0.000) SYML)
#DECL ((SYML) <OR FALSE <LIST [REST SYMBOL]>> (TVA) ASYLUM (TVS) SPACE
(PS MX) FLOAT (PL) FIX (PRINT? VERBOSE?) <OR ATOM FALSE>)
<COND
(<SET SYML <GET.QUESTION T>>
<CRLF>
<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 .TVS>>>
<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"]>>
<MAPF <>
<FUNCTION (X)
#DECL ((X) SYMBOL)
<PRINC "
Score for ">
<PRINC <1 .X>>
<INDENT-TO 19>
<PRINC
"Points Possible Average Questions">
<CRLF>
<PSCORE <1 .X>>>
<1 .SYMV>>)>>
<DEFINE GETBUF (bprompt "OPTIONAL" qprompt SPROMPT "AUX" BUF)
#DECL ((qprompt bprompt) <SPECIAL STRING> (SPROMPT) <OR FALSE STRING>
(BUF) <SPECIAL BUFFER>)
<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 ,TVSPACE2 <BUFTOS .BUF>>>
<DEFINE CONFIRM ()
<PRINC "[confirm]">
<AND <RESET ,INCHAN> <==? <TYI> <ASCII 27>>>>
<DEFINE PLAY-BALL ("AUX" (TWORD <DATA-READW ,TVASS <+ ,LUBLK ,TAILOR>>))
#DECL ((TWORD) WORD)
<AND <==? .TWORD #WORD *000000000000*>
<DATA-PRINTW ,TVASS <+ ,LUBLK ,TAILOR> ,T-DEF>
<SET TWORD ,T-DEF>>
<SETG SEQUENCE <GETBITS .TWORD <BITS 27 0>>>
<MAPF <>
<FUNCTION (BT SW)
#DECL ((BT) BITS (SW) ATOM)
<COND (<==? <GETBITS .TWORD .BT> #WORD *000000000000*>
<SETG .SW <>>)
(<SETG .SW T>)>>
,BIT-TABLE
,SWITCH-TABLE>
<COND (<0? <SETG TELEC-INTERVAL
<CHTYPE <GETBITS .TWORD ,TCON-BITS> FIX>>>)
(<TELECON ,TELEC-INTERVAL>)>
<MAPF <>
<FUNCTION (BT)
#DECL ((BT) BITS)
<COND (<0? <SET COD <CHTYPE <GETBITS .TWORD .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 TCON-BITS <BITS 6 0>>
<MANIFEST TCON-BITS>
<DEFINE SAVE-TAILOR ("AUX" (SEQ ,SEQUENCE))
#DECL ((SEQ) WORD)
<MAPF <>
<FUNCTION (BT SW)
#DECL ((BT) BITS (SW) ATOM)
<SET SEQ <PUTBITS .SEQ .BT <COND (,.SW 1) (0)>>>>
,BIT-TABLE
,SWITCH-TABLE>
<SET SEQ
<PUTBITS .SEQ
,TCON-BITS
<COND (<G? ,TELEC-INTERVAL 60> 60) (T ,TELEC-INTERVAL)>>>
<DATA-PRINTW ,TVASS <+ ,LUBLK ,TAILOR> .SEQ>>
<DEFINE GET-SEQUENCE ("AUX" SEQ (S #WORD *000000000000*))
#DECL ((SEQ) <OR FALSE <VECTOR LIST>> (S) WORD)
<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 SEQ-SYMS
<MAKESST "SS"
["Make"
1
"Answer"
2
"Grade"
3
"Read.mail"
4
"Babble"
5
"Print.score"
6
"Status.of.question"
7]>>
<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 PWINNERS ("MARC " "TAA " "JMB ")>
<SETG PTTUV <IUVECTOR 1 0>>
<GDECL (PTTUV) <UVECTOR FIX>>
<DEFINE TVPEEK ("AUX" (FIRST <>) (PG ,PG) (UV ,FOOUV) FROB CODE NAME
(PWINNERS ,PWINNERS) (PTTUV ,PTTUV))
#DECL ((FIRST) <OR 'T FALSE> (PG FROB CODE) FIX (UV) <UVECTOR [4 FIX]>
(NAME) STRING (PWINNERS) <LIST [REST STRING]> (PTTUV) <UVECTOR FIX>)
<SET-STATUS ,$SPEEK>
<REPEAT ((N 0) (LOC <+ .PG ,PEEK-START>) M)
#DECL ((N LOC) FIX (M) <OR FALSE VECTOR>)
<COND
(<G? .N 83> <RETURN>)
(<AND <GET-LOC .LOC .UV> <0? <1 .UV>>>
<OR .FIRST
<PRINC "
Player Status Entered">>
<SET FIRST T>
<CRLF>
<COND (<0? <2 .UV>>
<PRINC "HACKER Password">
<INDENT-TO 27>
<PDSKDATE <DSKDATE>>)
(<PRINC <SET NAME <SIXTOS <2 .UV>>>>
<COND (<MEMBER .NAME .PWINNERS> <PRINC " *">)
(T <PRINC " ">)>
<OR <0? <1 <GET-LOC <+ .LOC 338> .PTTUV>>> <PRINC " T">>
<INDENT-TO 12>
<COND (<SET M
<MEMQ <CHTYPE <GETBITS <4 .UV> <BITS 18 18>> FIX>
,STATUS-VECTOR>>
<PRINC <2 .M>>)
(<PRINC "??">)>
<INDENT-TO 21>
<COND (<MEMQ <SET CODE
<CHTYPE <GETBITS <4 .UV> <BITS 18 18>> FIX>>
'(9 1)>
<COND (<0? <SET FROB
<CHTYPE <GETBITS <4 .UV> <BITS 18>> FIX>>>)
(<PRINC "#"> <PRIN1 .FROB>)>)
(<==? .CODE ,$SMAKE>
<COND (<0? <SET FROB
<CHTYPE <GETBITS <4 .UV> <BITS 18>> FIX>>>)
(<PRINC <NTH ,MAKETYPES .FROB>>)>)>
<INDENT-TO 28>
<PDSKDATE <CHTYPE <3 .UV> WORD>>)>)>
<SET N <+ .N 1>>
<SET LOC <+ .LOC 4>>>
<CRLF>>
<SETG TOBRKS " ,
">
<DEFINE BUFLEX (S "OPTIONAL" (BRKS ,TOBRKS) "AUX" (LL ("")) (L .LL) (S1 .S))
#DECL ((S S1 BRKS) STRING (VALUE LL L) <LIST [REST STRING]>)
<REPEAT ()
<COND (<OR <EMPTY? .S1> <MEMQ <1 .S1> .BRKS>>
<AND <N==? .S .S1>
<PUTREST .L
<SET L
(<SUBSTRUC
.S
0
<- <LENGTH .S> <LENGTH .S1>>>)>>>
<AND <EMPTY? .S1> <RETURN <REST .LL>>>
<SET S <REST .S1>>)>
<SET S1 <REST .S1>>>>
<SETG MAKETYPES
["ZORK!" "Long" "Match" "M.C." "T/F" "ZORK!" "Simple"]>
;"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 <MEMBER .STR .L>> <SETG <PARSE .STR> <3 .M>>)>>
<DEFINE PLAY ("OPTIONAL" (PLAYER <>) "AUX" FOO TINDEX LUBLK)
#DECL ((PLAYER) <OR STRING FALSE> (FOO) <OR FALSE FIX>)
<COND (<MEMBER <XUNAME> ,WINNERS>
<COND (<NOT .PLAYER>
<SET PLAYER <READER '[] "as " "" '["LINE"] <>>>)>
<COND (<SET FOO <UBLOCK .PLAYER>>
<SET TINDEX <* 4 <4 <MEMBER .PLAYER ,LOSSTABLE>>>>
<COND (<DHLOCK <+ .TINDEX ,PEEK-START ,PG>>
<DUNLOCK <+ ,TINDEX ,PEEK-START ,PG>>
<SETG TINDEX .TINDEX>
<SETG LUBLK .FOO>
<SETG PLAYER .PLAYER>
<PUT ,TUV 2 <CHTYPE <STRTOX .PLAYER> FIX>>
.PLAYER)
(T <PRINC "Already playing">)>)
(T <PRINC "You blew it, champ.">)>)>>
<SETG INDEX
%<FIXUP!-RSUBRS '[
#CODE ![23751557122 23085678677 25614352384 4793303046 17188483073 23085698016
4980738 2 6302928656 0 262146!]
INDEX
#DECL ("VALUE" FIX)]
'(53
FINIS!-MUDDLE
229461
(2)
$TLOSE!-MUDDLE
225280
(5)
MPOPJ!-MUDDLE
248800
(6))>>
<AND <ASSIGNED? GLUE>
.GLUE
<PUT ,INDEX GLUE '![17448304640 2!]>> 