diff --git a/Makefile b/Makefile index 04509f4f..f8ef2eed 100644 --- a/Makefile +++ b/Makefile @@ -14,7 +14,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ inquir mudman system xfont BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys moon \ - graphs draw datdrw fonts fonts1 fonts2 + graphs draw datdrw fonts fonts1 fonts2 games SUBMODULES = dasm itstar klh10 mldev simh sims supdup tapeutils diff --git a/bin/games/chase.fasl b/bin/games/chase.fasl new file mode 100644 index 00000000..29e9cb0b Binary files /dev/null and b/bin/games/chase.fasl differ diff --git a/bin/games/eliza.fasl b/bin/games/eliza.fasl new file mode 100644 index 00000000..57bf67ff Binary files /dev/null and b/bin/games/eliza.fasl differ diff --git a/bin/games/go1.fasl b/bin/games/go1.fasl new file mode 100644 index 00000000..11f1bba2 Binary files /dev/null and b/bin/games/go1.fasl differ diff --git a/bin/games/go2.fasl b/bin/games/go2.fasl new file mode 100644 index 00000000..c2173267 Binary files /dev/null and b/bin/games/go2.fasl differ diff --git a/bin/games/gobrd.fasl b/bin/games/gobrd.fasl new file mode 100644 index 00000000..6b0c43c4 Binary files /dev/null and b/bin/games/gobrd.fasl differ diff --git a/bin/games/qb.fasl b/bin/games/qb.fasl new file mode 100644 index 00000000..f0051f55 Binary files /dev/null and b/bin/games/qb.fasl differ diff --git a/bin/games/stone.fasl b/bin/games/stone.fasl new file mode 100644 index 00000000..f9991868 Binary files /dev/null and b/bin/games/stone.fasl differ diff --git a/bin/games/ts.bkg b/bin/games/ts.bkg new file mode 100644 index 00000000..a509d2d3 Binary files /dev/null and b/bin/games/ts.bkg differ diff --git a/bin/games/ts.nimlin b/bin/games/ts.nimlin new file mode 100755 index 00000000..cc3347ce Binary files /dev/null and b/bin/games/ts.nimlin differ diff --git a/bin/games/ts.o b/bin/games/ts.o new file mode 100755 index 00000000..b3253aad Binary files /dev/null and b/bin/games/ts.o differ diff --git a/bin/games/ts.sprout b/bin/games/ts.sprout new file mode 100755 index 00000000..543a8972 Binary files /dev/null and b/bin/games/ts.sprout differ diff --git a/bin/games/yahtze.fasl b/bin/games/yahtze.fasl new file mode 100644 index 00000000..8a072c09 Binary files /dev/null and b/bin/games/yahtze.fasl differ diff --git a/build/lisp.tcl b/build/lisp.tcl index 6c84e05a..4ac94427 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -806,3 +806,32 @@ respond "*" ":midas sys; atsign 10slav_sysen2; ld10\r" respond " PDP6F = " "0\r" respond "GT40F=" "0\r" expect ":KILL" + +# animal +respond "*" ":midas games;_lsrrtn\r" +expect ":KILL" +respond "*" "complr\013" +respond "_" "games;_games;parse\r" +respond "_" "games;_games;pattrn\r" +respond "_" "games;_games;words\r" +respond "_" "games;_games;word\r" +respond "_" "games;_games;animal 133\r" +respond "_" "\032" +type ":kill\r" +respond "*" "l\013" +respond "Alloc?" "n" +respond "*" "(load '((games) animal fasl))" +respond "53694." "(dump '((games) ts animal))" +expect "KILL" + +# think +respond "*" "complr\013" +respond "_" "games;_games;think\r" +respond "_" "\032" +type ":kill\r" + +# wa +respond "*" "complr\013" +respond "_" "games;_games;wa 10\r" +respond "_" "\032" +type ":kill\r" diff --git a/build/misc.tcl b/build/misc.tcl index 9caec861..070b2d21 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -95,10 +95,12 @@ respond "*" ":midas sys1;ts quote_sysen1;limeri\r" respond "Use what filename instead?" "ecc;quotes >\r" expect ":KILL" -respond "*" ":midas sys1;ts quote_sysen1;limeri\r" +respond "*" ":midas sys2;ts limeri_sysen1;limeri\r" respond "Use what filename instead?" "eak; lims >\r" expect ":KILL" +respond "*" ":link sys2;ts limmer,sys2;ts limeri\r" + respond "*" ":midas sysbin;_eak;limser\r" expect ":KILL" respond "*" ":link device;chaos limeri,sysbin;limser bin\r" @@ -434,6 +436,19 @@ type "beg7\033g" respond ". words" ":pdump sys1;ts jotto\r" respond "*" ":kill\r" +# ngame +respond "*" ":midas games;ts game_ejs;ngame\r" +respond "Star Trek: " "ts,trek,games\r" +respond "Adventure (2): " "ts,adv448,games\r" +respond "Adventure (1.5): " "ts,adv350,games\r" +expect ":KILL" +respond "*" ":link sys3;ts game,games;ts game\r" +respond "*" ":link info;o.info,_info_;\r" + +# guess +respond "*" ":midas games;ts guess_games;guess\r" +expect ":KILL" + # ten50 respond "*" ":midas sys3;ts ten50_mrc; ten50\r" expect ":KILL" diff --git a/doc/_info_/o.info b/doc/_info_/o.info new file mode 100755 index 00000000..60f058ab --- /dev/null +++ b/doc/_info_/o.info @@ -0,0 +1,63 @@ +O info - 12 Feb 1978 (AS@DM) + +O is a program that plays the game of Othello. To run O, type O^K on +DM or AI or ML, type :SYS2;O on MC. Type ? to get a list of the +commands. Moves are typed as two digits, giving the vertical and then +the horizontal coordinate of the square in which you wish to place a +token. For example, 81 means move in the lower-left corner. + +The two players are designated white (@) and black (*). Black always +moves first. The machine and the person alternate playing black. +Which one plays black in the first game is selected at random. + +A brief description of the game of Othello follows: + +Othello is played on a board containing 64 squares arranged in 8 rows +of 8 columns. There are two players, designated white and black. The +two players alternate making moves. A move consists of placing a +token of the player's color on an empty square of the board. A move +is legal if it CAUSES one or more of the opponent's tokens to be +surrounded on a line, either horizontal, vertical, or diagonal. For +example, considering the position shown in the first board below, +legal moves for white (@) are marked W in the second board, and legal +moves for black (*) are marked B in the third board: + +- - - - - - - - - - - - - - - - - - B B B B - - +- - - @ @ - - - - - - @ @ - - - - - - @ @ - - - +- - * * @ * - - - W * * @ * W - B - * * @ * - - +- @ - - * * * - - @ W W * * * - B @ - B * * * - +- @ * - @ * - - - @ * W @ * W W B @ * B @ * - - +- @ * * * * * - - @ * * * * * W B @ * * * * * - +- - * * @ - - - - W * * @ - W - B - * * @ B - - +- - * - - - - - - W * W W - - - - - * B B B - - + +When a player moves onto a square, all of the opponents's pieces that +are surrounded (as described above) are changed to the player's pieces +(in up to 8 different directions). This rule is NOT transitive. For +example, if black makes the move indicated by X in the first board +below, then the result is as shown in the second board. + + - - - - - - - - - - - - - - - - + - - * - - - - - - - * - - - - - + - - * @ - - - - - - * * - - - - + - - * @ @ - - - - - * @ * - - - + - - * - - @ @ - - - * - - * @ - + - - - - * @ @ - - - - - * @ * - + - * @ @ @ @ @ X - * * * * * * * + - - - - - - - - - - - - - - - - + +If a player has no legal moves, his turn is forfeited. If neither +player has any legal moves, then the game is over. The object of the +game is to end up with more of your pieces on the board than your +opponent. + +The 'L' command will cause the program to list your legal moves. It +does this by drawing a new board and marking the positions of legal +moves with '?'. The 'A' command is similar, except that the moves are +marked with letter values that indicate some measure of goodness or +badness ('A' is very good, 'Z' is very bad). Please note that these +values are only rough estimates. The analysis is NOT the same as +that used by the program. If you follow the anaysis blindly, you will +lose almost every game. Using the 'A' command is a good way to get +started playing Othello, but to win, you must begin to use your own +judgement. diff --git a/doc/_info_/o.order b/doc/_info_/o.order new file mode 100755 index 00000000..3d388070 --- /dev/null +++ b/doc/_info_/o.order @@ -0,0 +1,16 @@ +Othello Commands + +Moves are entered by giving the vertical and horizontal +co-ordinates of the position where the token is to +be placed. For example, 81 means place a token in the +lower left-hand corner. + +Other commands are: + ? - print help file + ?? - print info file + r - resign + l - list legal moves + b - print board + s - print score + h - set handicap (-4 .. 4) + a - analyze position (A=best) diff --git a/doc/games/go.info b/doc/games/go.info new file mode 100644 index 00000000..f38820a1 --- /dev/null +++ b/doc/games/go.info @@ -0,0 +1,89 @@ +;;; THURSDAY FEB 02,1978 14:17:46 + The program consists of GOSET1 FASL and GOSET2 FASL in my +directory in ML. After FASLOADING them, set the size of the +board to whatever you like (standard game is 19). This is controlled +by the variable SAIZ; e.g, (SETQ SAIZ 19). + These commands are available to the player: + +(RICEIP) Clears the board for a new game. Type this before + your first game. + +(PLAY x y -1) Plays a white stone on point (x,y). + +(PLAY x y 1) Plays a black stone on point (x,y). + +(PLAY x y 0) Removes any stone from point (x,y). + +(PORTREI) Shows you the board. + +(BLEK) This is the program that plays against you. If you + call this, it will make the best move for black + that it can think of. + + White stones are represented by O, black stones by X. + Here's the beginning of an example game: + +(setq saiz 10) +10. +(riceip) +NIL +(portrei) + + +0. 1. 2. 3. 4. 5. 6. 7. 8. 9. + . . . . . . . . . . 0. + . . . . . . . . . . 1. + . . . . . . . . . . 2. + . . . . . . . . . . 3. + . . . . . . . . . . 4. + . . . . . . . . . . 5. + . . . . . . . . . . 6. + . . . . . . . . . . 7. + . . . . . . . . . . 8. + . . . . . . . . . . 9. +NIL +(blek) + + +0. 1. 2. 3. 4. 5. 6. 7. 8. 9. + . . . . . . . . . . 0. + . . . . . . . . . . 1. + . . . X . . . . . . 2. + . . . . . . . . . . 3. + . . . . . . . . . . 4. + . . . . . . . . . . 5. + . . . . . . . . . . 6. + . . . . . . . . . . 7. + . . . . . . . . . . 8. + . . . . . . . . . . 9. +My move is 2 3 +NIL +(play 6 2 -1) + + +0. 1. 2. 3. 4. 5. 6. 7. 8. 9. + . . . . . . . . . . 0. + . . . . . . . . . . 1. + . . . X . . . . . . 2. + . . . . . . . . . . 3. + . . . . . . . . . . 4. + . . . . . . . . . . 5. + . . O . . . . . . . 6. + . . . . . . . . . . 7. + . . . . . . . . . . 8. + . . . . . . . . . . 9. +NIL + +. . . and so on. + If you want to play with a handicap, you must place the stones +yourself. The program knows when the game is over (when neither it nor +you desires to play a stone), but it does not know how to score: you +must do that yourself. The program will say "Atari" to warn you when it +endangers some of your stones. It automatically removes dead stones +from the board, and will not play illegally in a KO situation. It will +let you cheat in many ways, but is that what you're here for? + The program mutters to itself while it thinks--do not be alarmed by +this. It may take as much as two minutes for a move. Once again, I +invite comments on playing ability and program bugs. + + Richard Ware \ No newline at end of file diff --git a/doc/programs.md b/doc/programs.md index 44954741..6dc649ab 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -6,6 +6,7 @@ - ADVENT, (Colossal Cave) Adventure by Will Crowther. - ADV350, 350-point Adventure. - ADV448, 448-point Adventure. +- ANIMAL, an animal guessing game. - ARCCPY, copies and old-format archive, converting to new format. - ARCDEV, transparent file system access to archive files. - ARCSAL, archive salvager. @@ -19,11 +20,13 @@ - BDAY, happy birthday demon. - BINPRT, display information about binary executable file. - BITPRT, print JCL as bits. +- BKG, a backgammon game. - BYE, say goodbye to user. Used in LOGOUT scripts. - CALPRT, decode a .CALL instructions CALL block. - CC, C compiler (binary only). - CHADEV, Chaosnet jobdev (binary only). - CHARFC/CHARFS, Chaos RFC. +- CHASE, a 2-player maze game. - CHATST, Chaos test. - CHESS2, Alan Baisley's Tech II chess program. - CHTN, CFTP, Chaosnet TELNET and FTP support. @@ -45,11 +48,13 @@ - DIRDEV, list directories, sorted or subsetted. - DIRED, directory editor (independent from EMACS DIRED). - DMPCPY, crach dump copy dragon. +- DOCTOR, KMP's psychiatrist game. - DP Device, 7-bit conversions? - DQ Device, for doing hostname resolutions. Used by COMSAT. - DSKDEV, D - short disk device. - DSKUSE, disk usage information. - DUMP/LOAD, tape backup and restore. +- ELIZA, the original psychiatrist game - EMACS, editor. - EXECVT, convert 20x.exe (SSAVE) file to ITS BIN (PDUMP) file. - EXPN/VRFY - query remote SMTP server. @@ -66,6 +71,8 @@ - FTPU, FTP Client. - GCMAIL, delete old files from .MAIL. - GETSYM, copy all symbols from running ITS to a file. +- GO, the Go board game. +- GUESS, a very silly game. - GMSGS, copy system messages to mail file. - H3MAKE, a job that requests DRAGON to build host table. - HEXIFY, convert COM file into Intel HEX format. @@ -114,6 +121,7 @@ - NAME, Shows logged in users and locations, aka FINGER. - NETIME, network time dragon. - NICNAM/NICWHO, look up someone in the ARPAnet directory. +- NIMLIN, a game of unknown features. - NODIPS, SUDS wirelister (without DIP definitions). - NUDIR, create user directory. - NWATCH, small watch display. @@ -121,6 +129,7 @@ - OCM, Richard Greenblatt's Mac Hack VI chess program. - OCTPUS, print character representations. - OS, realtime TTY spy. +- OTHELLO, the original Othello game -- simpler than Go. - PALX, PDP-11 cross assembler. - PANDA, user account management program. - PC, SUDS printed circuit board program. @@ -139,6 +148,7 @@ - PTY, pseudo-tty. - PWMAIL, a limited version of MAIL when not yet logged in under PWORD. - PWORD, replacement for sys;atsign hactrn that requires registered logins. +- QB, the game of Qubic. - QUOTE, prints out a random quote. - REATTA, reattaches disowned jobs to terminal. - REDRCT, redirect IP routing. @@ -158,11 +168,13 @@ - SN, snoop terminal. - SPCWAR, Spacewar game. - SPELL, ESPELL spell checker. +- SPROUTS, the topological game invented by Convay. - SRCCOM, Compares/merges source files, compares binary files. - SRDATE, set reference date on a file. - STINK, linker. - STINKR, new linker (binary only). - STTY, set terminal parameters. +- STONE, the old African game of stones. - STY, pseudo-terminal for multiple sessions. - STYLOG, convert PTY output file into ascii file. - SUPDUP, Supdup client. @@ -178,6 +190,7 @@ - TELNET, Telnet client. - TELSER, Telnet/Supdup server. - TEN50, TOPS-10 emulator. +- THINK, think-a-dot game. - TIME, displays date/time/uptime and other info. - TIMES, TCP time server. - TIMOON, displays the time and phase of the moon. @@ -197,6 +210,7 @@ - VERSA/SPOOLR, Versatec/Gould printer spooler. - VV/VJ/DETREE, list jobs. - XHOST, tool for replacing host nicnames with real hostnames. +- WA, a Wumpus advisor game. - WHAT, humorous quips to various "what" questions. - WHO%, list index/uname/jname/%time in sorted list. - WHOLIN, mode line for display terminals (with date/time/job/etc info). @@ -205,3 +219,4 @@ - WUMPUS, Hunt the Wumpus game. - X, Y, Z, remember DDT command and re-execute it. - XXFILE, feed scripted input to a STY session. +- YAHTZE, the game of Yahtze. diff --git a/src/ejs/ngame.272 b/src/ejs/ngame.272 new file mode 100644 index 00000000..099050ad --- /dev/null +++ b/src/ejs/ngame.272 @@ -0,0 +1,2023 @@ +;-*-midas-*- + +.symtab 2000,15000 ;allocate some space for symbols + +if1 TITLE GAME -- I wouldn't assemble this if I were you +if2 TITLE GAME -- You might really create a mess + +;;; Here is the imfamous GAME program munged by EJS +;;; Please don't fool with it unless you know what you are doing. + +.qmtch==1 ;make "" handle text + +a=1 ;temporary +b=2 ;temporary +c=3 ;temporary +d=4 +e=5 +f=6 +t=7 +chr=10 ;character being read +ea=11 ;effective address of UUO's +opc=12 ;op code of UUO's +ac=13 +u1=14 ;uuo temporary 1 +u2=15 ;uuo temporary 2 +u3=16 ;uuo temporary 3 +sp=17 ;stack pointer + +dski==3 ;dsk input channel +dsko==4 ;dsk output channel +usrc==7 ;usr input and utility channel +uout==10 ;usr output and fucked channel +tyic==13 ;can't use channel 1 +tyoc==14 ;establish an output channel +lsrc==15 ;channel for LSRTNS to hack + +lsrpag==100 ;moderately moby pages for INQUIRE (20 of them) +intval==30. ;# of seconds between real-time interrupts +pdleng==100 ;lots of PDL space +dsklen==1000 + +opcode=.bp <777_33 0,0> ;opcode field +accum=.bp <0 17,0> ;accumulator field +index=.bp <0 0,(17)> ;index register + + +argi==1000 ;immediate argument +val==2000 ;value return +errret==3000 ;error return +cnt==4000 ;control +cnti==5000 ;control immediate + +call=pushj sp, ;make things easier on ourselves +ret=popj sp, ; ditto +tyi==.iot ; likewise +tyo==.iot ; and once again + +loc 100 +gloss: jrst gloss1 ;our loss handler +ttyint: jrst tyint ;tty interrupt handler +loss= ;loss handler stuff + +;;; Date and time handling routines + +$$abs==1 ;want the absolute time routines +p==17 ;RMS's convention +.insrt DSK:SYSENG;DATIME > + +;;; Inquire database hacking routines + +$$ULNM==0 ;don't want LSRLNM +$$ULNP==0 ;nor last-name-prefix matcher +$$UNAM==0 ;don't want LSRNAM either +.insrt DSK:SYSENG;LSRTNS > + +;;; Here are the variables for the load check feature + +mvsldu==40. ;minimum fair share is 40% +mvusrs==18. ;maximum number of users is 18. + +;;; Some handy macros + +define save locs + irp foo,,[locs] + push sp,foo +termin termin + +define restor locs + irp foo,,[locs] + pop sp,foo +termin termin + + +define terpri chan=tyoc ;terpri on channel + tyo chan,[^M] + tyo chan,[^J] +termin + +define text *string* +!.length |string|,,[asciz |string|]!termin + +define ascnt *string* +![text /string/]!termin + +define type *string* + sioto tyoc, +termin + +define death *string* + die +termin + +define norm7 c ;normallize a 7-bit byte pointer + skipge c + sub c,[430000,,1] +termin + +define decbp c ;decrement byte pointer + add c,[70000,,] ;back up the byte pointer + skipge c ;did we cross a word boundary? + sub c,[430000,,1] ;then fix it +termin + +;;; Some macros for uuo handling + +define tabdef name + define name cruft + cruft + termin + + + define a!name more + name [define name cruft + cruft + more] + termin + termin +termin + +;;; Very useful DO statement + +define do stuff,else,\label + define ddoo exit + jrst [stuff + jrst label] + !else! + +label:: + termin +ddoo +termin + +;;; For evaluating system variables + +define seval a,b ;get value of symbol B in A + move a,[squoze 0,/b/] + .eval a, + loss +termin + +define eval a,b + seval a,b + hrl a,a ;move to left + hrri a,a ;destination is a + .getloc a, ;get it into a +termin ;done! + +;;; The next macro is for making system calls + +define syscal a,b,c= + .call [setz ? sixbit/a/ ? b ? setz++c] termin + +;;; Some cruft for uuo hacking + +tabdef utab +uuonum==1 + +define uuodef name,op,oper + define uuodex [op1=[pushj sp,]] + autab [name=<.-uuotab>_33 + op1 u!name] + termin + oper + uuodex op +termin + +.fooo==. +loc 40 +UUO: 0 ;traping UUO goes here. + jsr uuoh ;go handle uuo's + -intlng,,tsint ;abjon ptr to interrupt table + +loc .fooo + +intspc=100*100+5 +tsint: intspc,,sp + 0 ? 1_tyic ? 0 ? 0 ? ttyint + %piioc ? 0 ? 0 ? 0 ? ignore ;for unknown IOC interrupts + 0 ? -1,,0 ? 0 ? 0 ? dhandl + %pirlt ? 0 ? %pirlt ? -1 ? realt + ;don't allow recursive real-time interrupts + ;if we get them we must be screwd +intlng==.-tsint + +ignore: type /AGot an unknown IOC interrupt. Continuing...A/ + +disbye: syscal dismis,[cnti,,intspc ;just go back to what you were doing + sp] + loss + +dismis=jrst disbye + +;;;Here is the UUO handler + +uuoh: 0 ;saved PC + save [uuo,uuoh,ea,opc,ac,u1,u2,u3] ;save our AC's + ldb opc,[opcode uuo] ;get the opcode + cail opc,utabl ;is it legal? + die [text /BAD USER UUO/] ;nope + ldb ac,[accum uuo] ;yep + hrrz ea,uuo ;get the effective address + xct uuotab(opc) ;and dispatch on it + restor [u3,u2,u1,ac,opc,ea,uuoh,uuo] ;restore our AC's + jrst @uuoh ;return + + +;;; Here are our UUO definitions + +uuodef sioto,,[ +usioto: hrli u1,440700 ;ascii string pointer + hrr u1,(ea) ;get address of string + hlrz u2,(ea) ;get length of string + movem u2,siotl ;move it to memory so it can be cleared + syscal siot,[ac ;ac has channel + u1 + siotl] + loss ;lost. + popj sp, ;return +siotl: 0 +] + +;;; This UUO types text and kills job, unless in debug mode, in which +;;; case it types out the text and .values + +uuodef die,jrst,[ +udie: caie ea,0 ;if typing + sioto tyoc,(ea) ; type it + skipe debug ;are we debuggin? + .value ;yes, just return + .logout 1, + loss ;how the hell did this happen? +] + +;;;Output sixbit as ascii on specified channel + +uuodef 6type,,[ +U6type: setzb u1,u2 ;u1=u2+1 + move u2,(ea) ;get our operand +U6toa1: lshc u1,6 ;isolate off character + addi u1,40 ;make it ascii + syscal iot,[ac ? u1] ;print it out + loss + jumpe u2,cpopj ;if nothing left, return + setz u1, ;clear it + jrst U6toa1 ;go back for more +cpopj: + ret ;and we're all done +] + +;;; print out a decimal number + +uuodef deca,,[ +udeca: move u1,(EA) ;get number in U1 +decpnt: idivi u1,10. ;figure first digit + push sp,u2 ;push remainder + skipe u1 ;done? + pushj sp,decpnt ;no compute next one +decpn1: pop sp,u1 ;yes, take out in opposite order + addi u1,60 ;make ascii + syscal iot,[ac ? u1] + loss + popj sp, ;and return for the next one. +] + +;;; Convert number to ascii rep of octal and print it out + +uuodef 8type,,[ +u8type: move u1,(ea) ;get number in U1 +octpnt: idivi u1,10 ;figure first digit + push sp,u2 ;push remainder + skipe u1 ;done? + pushj sp,octpnt ;no compute next one +octpn1: pop sp,u1 ;yes, take out in opposite order + addi u1,60 ;make ascii + syscal iot,[ac ? u1] ;type it out + loss ; huh? + popj sp, ;and return for the next one. +] + + +;;; Some random locations + +debug: 0 ;is in main block so user can reference +tyo1c: 1 ;will be reset to one on every tyo +calerr: 0 ;error return code + +;;; Here is our PDL + +pdl: [.status tyoc,a + skipn a, + type /APDL Underflow.A/] + loss + block pdleng ;PDL area + +;;; Inferior hacking stuff + +c1.cnt: %pival+%pic.z+%pibrk+%pidcl +c1.ded: %pi1pr+%pib42+%pipar +class2: %pitrp+%pifet+%pitty+%pidis+%piilo+%piioc+%pioob+%pimpv+%pimar +c1.2: %pi1pr+%pibrk+%pib42+%pipar+%pival+%pic.z+%pitrp+%pifet+%pitty+%pidis+%piilo+%piioc+%Pioob+%pimpv+%pimar+%pidcl + +dhandl: + syscal usrvar,[argi,,usrc ;get his interrupts + ['PIRQC '] + val,,a] + loss + syscal usrvar,[argi,,usrc ;get mask for type 2 interrupts + ['MASK '] + val,,b] + loss + and b,class2 ;b<-class two which are enabled + tdz a,b ;remove them from our interrupt word + and a,c1.2 ;remove class 3 interrupts + move b,a ;get a copy + tdz a,c1.cnt ;remove ones we'll handle + jumpn a,fatal ;go handle fatal variety + trne b,%pibrk ;is the a .BREAK + jrst break ;go handle + trne b,%pival ;is this a .VALUE? + jrst [.dtty + jfcl + jrst value] ;go handle + tdne b,[%pic.z+%pidcl] ;control-Z ? + skipa + jrst [.dtty + jfcl + type /ABug in Inferior Interrupt HandlerA/ + loss] + syscal usrvar,[argi,,usrc ;reset his PIRQC + ['APIRQC'] + b] + loss +goback: syscal dismis,[cnti,,intspc + sp + argi,,retloc] + loss +retloc: type /AReturned from your game.A/ + .dtty ;take tty away from inferior + skip + setzm ttyflg ;remember we have it back for good + ret + +define usrmem usrc,dest,a,b + syscal corblk,[cnti,,%cbwrt ;may as well get write if we can + argi,,0 ;no XORing in my program! + argi,,%jself + argi,,377 ;mega moby page + argi,,usrc ;from usrc channel job + a] ;at location a + loss + move dest,(b)<377*2000> ;and get it +termin + +define uread usrc,loc + .access usrc,loc + syscal iot,[argi,,usrc + loc] + loss +termin + +define uwrite usrc,loc,dat + .access usrc,loc + syscal iot,[argi,,usrc + dat] + loss +termin + +define addrup ind,rh,index,\foo,foo1 + jumpe index,foo1 ;if non-zero index + uread usrc,index ;get value of index + add rh,index ;and add it in +foo1:: jumpn ind,[uread usrc,rh ;if we're indirecting + jrst foo] ;do the indirection +foo:: +termin + +define pagmak a + andi a,-1 ;clear left half + lshc a,-12 ;split off page number from rest + lsh ,12-44 ;and make remainder +termin + +break: syscal usrvar,[argi,,usrc ;turn off the interrupt + ['APIRQC'] + [%pibrk]] + loss + syscal usrvar,[argi,,usrc ;get location of break + ['UPC '] + val,,a] + loss + subi a,1 ;back up to the .BREAK + move e,a ;move to where we have two adjacent ac's + pagmak e ;a <- page#, f <- loc in page + usrmem usrc,a,e,f ;a <- contents of memory + ldb b,[accum a] ;b <- accumulator + ldb c,[index a] ;c <- index + ldb e,[opcode a] + hlr d,a ;clear d, getting left half of a + andi d,(@) ;and with indirect bit + andi a,-1 ;a <- address field + + cain e,<.ldb opcode,.logout> + caie a,33 + caia + jrst brdie + cain b,12 ;is it a .BREAK 12, ? + jrst brk12 ;yes + caie b,16 ;is it garbage? + jrst unbrk ;go handle unknown break +brdie: .uclose usrc, ;it must have been asking to die since we + ;told it we weren't a DDT + jrst infdon + +define JCL *lcj* +move a,[text /lcj/] +movem a,jclptr +termin + +jclptr: 0 + +brk12: addrup d,a,c ;ind,addr,ix + move e,a ;move to where we have room + move c,a ;and hold in C for error messages + pagmak e ;e <- page #, f <- loc in page + usrmem usrc,a,e,f ;get from his memory the location pointed to + jumpl a,[hlrz a,a ;if writing + caie a,400005 ; if clearing JCL + jrst [setzm jclptr ;clear it and + jrst infdon] ;be done + type /ABarf: Inferior trying to write!A/ ;complain + jrst infdon] ;and be done + hlrz b,a ;get operation + hrrz d,a ;and address + trne d,200000 ;is it block mode? + jrst [type /ABarf: Inferior trying to use block mode .BREAK 12, +.BREAK 12,/ + jrst addprt] ;go print out err message + cail b,brktbl ;is it out-of-range? + jrst unbrk1 + xct brktb(b) + +addprt: 8type tyoc,c ;type address + sioto tyoc,[text "/ "] ;"open" location with form + 8type tyoc,b ;and type the contents + type /,,/ ;in halfword mode + 8type tyoc,d ;so we can read it easier + terpri tyoc ;CRLF + jrst infdon ;and give up + +unbrk1: type /ABarf: Inferior trying to use a .BREAK 12, I can't handle. +.BREAK 12,/ + jrst addprt + +brktb: jrst unbrk1 + jrst unbrk1 + jrst unbrk1 + jrst symptr + jrst unbrk1 + jrst getjcl +brktbl==.-brktb + +symptr: caig d,17 ;is it an AC? + jrst [uwrite uout,d,[0] ;yep, do it the dangerous way + jrst infcnt] + move e,d ;get more space to work in and save d for error + pagmak e ;compute page in a and word in f + syscal corblk,[cnti,,%cbndw ;need write access + argi,,0 + argi,,%jself + argi,,377 + e] + jrst jclovf ;go gripe + add f,<377_22> ;make absolute in our space + setzm (f) ;and set the appropriate word to 0 + jrst infcnt ;and continue + +getjcl: move e,d ;get more space and save d for error + pagmak e + syscal corblk,[cnti,,%cbndw ;need write access + argi,,0 ;no XORing, please + argi,,%jself ;map into ourself + argi,,376 ;at the highest possible location + argi,,usrc ;our inferior's + e] ;page which is contained in A + jrst jclovf + aos e ;get next page too + hlrz a,jclptr ;get length pointer of JCL + addi a,4 + idivi a,5 ;(ptr+4)/5==length in words + add a,f ;the final loc + cail a,2000 ;overflow? + jrst [syscal corblk,[cnti,,%cbndw ;need writing + argi,,0 ;barf, no XOR, please + argi,,%jself + argi,,377 ;very moby + argi,,usrc ;our very inferior inferior + e] ;and the next page + jrst jclovf ;complain of indigestion + jrst jcljcl] ;go write JCL + +;a -- absolute ending address +;b -- operation +;c -- effective address of .BREAK +;d -- right half of contents of ea of .break +;e -- page number in inferior of JCL buffer +;f -- loc in that page + +jcljcl: addi a,<376_12> ;make end addr. point into our page map + addi f,<376_12> ;make the dest. address point into our map + hrr e,f ;and put in right half for blt + hrl e,jclptr ;get our source for the BLT from the JCLPTR + blt e,-1(a) ;and perform the transfer + skipe ttyflg ;if it had the tty + jrst infcnt + jrst infdon ;else just dismiss + +infcnt: setom ttyflg ;remember where the TTY went +; .atty usrc, ;give it to him +; jrst [.dtty ;get it back +; .atty usrc, ;and try again +; loss ;nope, we're screwed somehow +; jrst infcn1] ;good, one with the show + + call start + +infcn1: syscal dismis,[cnti,,intspc + sp] + loss + +jclovf: type /AInferior tried to read into pure or non-existant memory +.BREAK 12,/ + jrst addprt ;tell him about loss + +unbrk: type /AInferior gave an unknown .BREAK +.BREAK / + +addrtp: 8type tyoc,b ;type out the address stuff + tyo tyoc,[","] ;type out the comma + caie d,0 ;indirect? + tyo tyoc,["@"] ;type it + + caie a,0 ;rh nonzero? + 8type tyoc,a ;type the right half + + jumpn c,[tyo tyoc,["("] ;type the ( + 8type tyoc,c ;type the index + tyo tyoc,[")"] + jrst ubrk1] + +ubrk1: type / >>> / + addrup d,a,c ;compute effective address + 8type tyoc,a ;and print it + terpri tyoc + jrst infdon + +value: syscal usrvar,[argi,,usrc ;turn off the interrupt + ['APIRQC'] + [%PIVAL]] + loss + type /AInferior .VALUE'd...Continuing...A/ + jrst infdon + +fatal: .dtty + jfcl + type /AInferior got a Fatal Interrupt.A/ + .uclose usrc, + jrst infdon + +infdon: setzm ttyflg ;remember we have it back for good + syscal dismis,[cnti,,intspc + sp] + loss + +start: syscal usrvar,[argi,,usrc ;copy his old state + ['OPTION'] + val,,a] + loss + tlz a,optcmd+optbrk ;clear the OPTCMD bit (+ the OPTBRK since LISP + ;demands it!) + skipe jclptr ;if there is JCL + tlo a,optcmd+optbrk ;set it again + syscal usrvar,[argi,,usrc ;and set it up + ['OPTION'] + a] ;write it back again + loss + + syscal usrvar,[argi,,usrc ;GO! + ['USTP '] + argi,,0] + loss + + ret +ttygo: + call start + setom ttyflg ;remember we gave it away + .atty usrc, ;give up the TTY and wait for return + skipe ttyflg ;what? + .hang ;until return of TTY + .dtty ;make SURE that we have the TTY + ret + ret + +nttygo: + syscal usrvar,[argi,,usrc + ['USTP '] + argi,,0] + loss + ret + +istrt: 0 + +define infcr chan,name,fn1,fn2,sname,device,f.loss=loss,page=-1,handle=dhandl + push sp,a ;save a for local use + .status usrc,a ;look at the channel + caie a,0 ;if there is nothing open + .uclose usrc, ;kill it + + syscal open,[cnti,,0 ;create a job + argi,,usrc + ['USR '] + myunam + [sixbit /name/]] + loss + syscal open,[cnti,,.uio ;and an output channel to it (ugh!) + argi,,uout + ['USR '] + myunam + [sixbit /name/]] + loss + + syscal open,[cnti,,.uii ;open a file to load into it + argi,,dski + [sixbit /DEVICE/] + [sixbit /FN1/] + [sixbit /FN2/] + [sixbit /SNAME/]] + f.loss + + syscal load,[argi,,usrc ;load it + argi,,dski] + loss + + syscal iot,[argi,,dski ;get starting address + argi,,a] ;in a + loss + andi a,-1 ;ignore the JRST part + + syscal close,[argi,,dski] ;close it + loss + + movem a,istrt ;and save the ADDR in ISTRT + + syscal usrvar,[argi,,usrc ;make it start there + ['UPC '] + a] ;a has address + loss + + syscal usrvar,[argi,,usrc ;get what bit to enable + ['INTB '] + val,,a] + loss + + syscal usrvar,[argi,,%jself ;and enable it + ['IMSK2 '] + a] + loss + pop sp,a + +termin + +infkil: push sp,a ;get A free + .status usrc,a ;is there an inferior? + jumpe a,[type /AYou don't have a game to kill.A/ + pop sp,a ;restore A + ret] ;and give up. + pop sp,a ;restoer a + setzm ttyflg ;remember we have it back for good + .uclose usrc, ;kill it + type /AGame Killed.A/ ;say it + ret ;return + + +uuotab: loss + utab +utabl==.-uuotab + consta ;dump out constants table + +popj.1: aos (sp) ;increment return address + popj sp, ;and return +popj1=jrst popj.1 ;and define our symbol + + +%sllog==1 ;bit to indicate not-logged-in +%sldil==2 ;bit to indicate coming in from a dialup line +%sload==4 ;bit to indicate over-stepping a load boundary +%slcls==10 ;bit to indicate closed +%sldet==20 ;we've been detached + +;;; When he types an undefined character execute this + +uhuh: type /AType ? for list of commands.A/ + move sp,[-pdleng,,pdl] ;reset the pdl + jrst cloop ;back to cloop + +huh=jrst uhuh ;throw to top level loop + +;;; Here is where we tell it where star trek is + +if1,[ +printc /Star Trek: / +.TTYMAC notty=notty,pine=pine,dir=games + +;;; Here is the star trek macro + +define star + type /CStar Trek +Please Hold On.....A/ + infcr ursc,.mctrk,notty,pine,dir,dsk,jrst strlos + syscal tranad,[cnti,,3 ;input and output + argi,,usrc ;do it to our inferior + [-4,,['DSK ' + ' ' + 'DAT ' + ' ']] + [-4,,['AR8 ' + ' ' + ' ' + 'GAMES ']]] + loss + + jrst ttygo ;go do it +termin +termin + + +printc /Adventure (2): / +.TTYMAC notty=notty,pine=pine,dir=games + +define ADVENT + type /CAdventure.... +Please Hold On....A/ + infcr ursc,.ADV.,notty,pine,dir,dsk,jrst advlos + jrst ttygo ;go do it +termin +termin + +printc /Adventure (1.5): / +.TTYMAC rotty=rotty,rine=rine,dir=games + +define ADVNBS + type/ CAdventure.... +Please Hold On....A/ + infcr ursc,.ADV.,rotty,rine,dir,dsk,jrst advlos + jrst ttygo +termin +termin +] + +;;; Our log file routine + +Define tattle [FILE],&MESS + push sp,[[file ? text mess]] + call asshol + pop sp,nulll +termin + + +;;; Here is the start of the game program + +go: move sp,[-pdleng,,pdl] ;initialize our push stack + syscal open,[cnti,,.uii ;open tty for input + argi,,tyic + [sixbit /TTY/]] + loss + syscal open,[cnti,,<.uao+%tjdis> ;open tty for output + argi,,tyoc + [sixbit /TTY/]] + loss + call ldcal ;get initial numbers + .suset [.runame,,myunam] ;get our name + move a,myunam ;move it into a + camn a,[sixbit /EJS/] ;if we're EJS, must be debugging + do [move a,logfld ;switch all the tattle files + movem a,logfil+1 ;to test files. + move a,delfld + movem a,delfil+1 + move a,badfld + movem a,badfil+1] + camn a,[sixbit /TEST/] ;if we're TEST, must be debugging + do [move a,logfld ;switch all the tattle files + movem a,logfil+1 ;to test files. + move a,delfld + movem a,delfil+1 + move a,badfld + movem a,badfil+1] + call fndfil ;check to see it he was bad + .suset [.roption,,a] ;get current .OPTION var + ior a,[(optint+optopc)] ;we want new interrupts and + .suset [.soption,,a] ;and backed up pc + syscal usrvar,[argi,,%jself ;enable IOC errors to ignored them + ['IMASK '] + [%piioc]] + loss + +begin: setzm initld ;this is first time through + call ctmf ;has he altered things + call whois ;check for reasonable user + call dbging ; we're debugging + call sttw ;enable loadchecking + setom initld ;ok, we've gone through once + syscal close,[argi,,1] ;close 1, incase we were re-loaded + skip ; ignore any errors + .suset [.rjname,,a] ;see what we are. + camn a,['ADVENT'] ;are we a substitute ADVENT? + do [.suset [.rsuppro,,a] + jumpl a,[syscal usrvar,[argi,,%jself ;if top level become + ['JNAME '] ;a HACTRN + ['HACTRN']] ;but don't allow + ;duplicates + jrst [tattle logfil,/ AHG/ + death / +You seem to be already logged in with a GAME.A/] + exit] ;exits all the way to the top ... + type /AChanging name of job to GAME!A/ + ;if not top level, gotta hope it's a DDT + .value [asciz /gameJ.gameJP/]] + + syscal ttyset,[argi,,tyic ;and store it + ttyst1 + ttyst2] + loss + .suset [.simask,,[%pirlt]] ;enable timer interrupts + .suset [.simsk2,,[1_tyic]] ;enable interrupts on the channel + skipn pzhjkw+10. ;has he cheated us + jrst mechan ; yes, he has, kill him + + type /CGame selection program version / ;type out this greeting + 6type tyoc,[.FNAM2] ;and type out the version number + terpri tyoc ;do a CRLF + + tattle logfil,/+ STG/ ;log him in! + + syscal open,[cnt,,inctl ;try to open notes file + argi,,dski + ['DSK '] + ['GAME '] + ['NOTES '] + ['GAMES ']] + jrst cont ; not there, skip it + + call [move a,[notcbl,,copblk] ;print out notes file + blt a,copend + jrst copy] + +cont: type /AType ? for help.A/ ;help him out a bit +cloop: type /A>/ ;prompt him + skipn pzhjkw+10. ;is he cheating? + jrst mechan ; yes, flush him + tyi tyic,chr ;read a chr + caile chr,140 ;is it uppercase? + subi chr,40 ; no, convert it to uppercase + skipn wkjhzp+5 ;is he cheating? + jrst mechan ; yes, flush him + xct optab(chr) ;and act on it + call ctmf ;check things out + call whois ;check for reasonable user + call dbging ;we're debugging + call sttw ;enable loadchecking + jrst cloop ;and go back for more + +;;; ***************************************************************** +;;; OPTAB +;;; ***************************************************************** + +optab: huh ;^@ + call gdoc ;^A -- List games + call [.status usrc,a + jumpe a,[type /AYou do not have a game to continue!A/ + ret] + type /AReturning to your game...A/ + jrst ttygo] ;^B -- Back to previous game + call pdoc ;^C -- List program commands + call del ;^D -- Delete GAME program + huh ;^E + huh ;^F + huh ;^G + huh ;^H + call instal ;^I -- Install new GAME program + huh ;^J + call infkil ;^K -- Kill previous game + call ctype ;^L -- Clear screen + huh ;^M + huh ;^N + huh ;^O + call [.status usrc,a ;is it open + jumpe a,[type /AYou don't have a game to proceed.A/ + ret] + type /AProceeding the game. I won't know if it needs the TTYA/ + jrst nttygo] ;^P -- Proceed previous game + call [type /AAre you sure you want to quit? (Y or N) / + tyi tyic,a ;get a character +;;; tyo tyoc,a ;and echo it + caie a,131 ;is it Y + cain a,171 ;or y? + jrst [type /Yes./ + tattle logfil,/* QTG/ + death /AQuitting...bye!A/] + type /No.A/ + ret] ;^Q -- Quit the GAME program + huh ;^R + call [setzm ttyoff ;^S -- turn on our TTY when it get's read + ret] + huh ;^T + huh ;^U + huh ;^V + huh ;^W + huh ;^X + huh ;^Y + type /CYou are at the top level of the GAME program.A/ + ;^Z -- Get to top level of GAME + huh ; + huh ;^\ + huh ;^] + huh ;^^ + huh ;^_ + huh ; Space + huh ;! + huh ;" + huh ;# + huh ;$ + huh ;% + huh ;& + huh ;' + huh ;( + huh ;) + huh ;* + huh ;+ + huh ;, + huh ;- + call [type /CThink +Type "?" for help. +Please Hold On.....A/ + jcl /DSK:games;THINK (INIT) +/ + infcr usrc,.THNK,ts,q,sys,dsk + jrst ttygo] ;. -- Play Think + huh ;/ + huh ;0 + huh ;1 + huh ;2 + huh ;3 + huh ;4 + huh ;5 + huh ;6 + call [type /CGuess! +Please Hold On.....A/ + infcr usrc,.guess,ts,guess,games,dsk + jrst ttygo] ;7 KMP's crock + huh ;8 + huh ;9 + huh ;: + huh ;; + huh ;< + huh ;= + huh ;> + call help ;? -- List help documentation + huh ;@ + call [ADVENT] ;A -- Play Adventure + call [type /CChess +Please Hold On.....A/ + infcr usrc,.ches2,ts,chess2,games,dsk + jrst ttygo] ;B -- Play Baisly's Chess program + call [type /CChess +Please Hold On.....A/ + infcr usrc,.chess,ts,ocm,games,dsk + jrst ttygo] ;C -- Play Greenblatt's Chess program + call [type /CDOCTOR +End your input with two carriage returns. +Please Hold On......A/ + jcl /DSK:games;ELIZA (INIT) +/ + infcr usrc,.doc.,ts,Q,sys,dsk + jrst ttygo + ret] ;D -- Play Doctor + call [type /CChase... +Do you want documentation? (Y or N) / + tyi tyic,a + tyo tyoc,a + caie a,131 + cain a,171 + call [move a,[chacbl,,copblk] + blt a,copend + jrst copy] + call [type /AHold on a sec....A/ + ret] + jcl /DSK:games;CHASE (INIT) +/ + infcr usrc,.chas.,ts,q,sys,dsk + jrst ttygo + ret] ;E -- Play Chase + call [type /CBackgammon +Please Hold On.......A/ + infcr usrc,.backg,ts,bkg,games,dsk + jrst ttygo] ;F -- Play Backgammon (an F?) + call [type /CGo +Please Hold On........A/ + jcl /DSK:games;GO (INIT) +/ + infcr usrc,.go,ts,q,sys,dsk + jrst ttygo] ;G -- Play Go + huh ;H + huh ;I + call [type /CJotto +Please Hold On.......A/ + infcr usrc,.jotto,ts,jotto,sys1,dsk + jrst ttygo] ;J -- Play Jotto + call [type /CAnimal +Please Hold On........A/ + infcr usrc,.animl,ts,animal,games,dsk + jrst ttygo] ;K -- Play KMP's Animal + call [type /CYou dirty Old Man You.A/ + infcr usrc,.SEX.,TS,LIMMER,sys2,dsk + jrst ttygo] ;L -- Print out a Limerick + call [ADVNBS] ;M -- Play Adventure 1.5 + call [type /CNimlin +Please Hold On.....A/ + infcr usrc,.nimln,ts,nimlin,games,dsk ;create + jrst ttygo] ;N -- Play Nimlin + call [type /COthello +Please Hold On......A/ + infcr usrc,.orth.,ts,o,games,dsk + jrst ttygo] ;O -- Play Othello + call [type /CKMP's Psychiatrist +Please Be Patient, the Doctor will be right with you.....A/ + jcl /DSK:games;DOC > +/ + infcr usrc,.psych,ts,q,sys,dsk + jrst ttygo] ;P -- Play KMP's Psychiatrist + call [type /CQubic +Please Hold On......A/ + jcl /DSK:games;QB (INIT) +/ + infcr usrc,.qubic,ts,q,sys,dsk + jrst ttygo] ;Q -- Play Qubic + huh ;R + call [star] ;S -- Play Star Trek + call [type /CStone (This only works on a display) +Please Hold On.....A/ + jcl /DSK:games;STONE (INIT) +/ + infcr usrc,.stone,ts,q,sys,dsk + jrst ttygo] ;T -- Play Stone + call [type /CSPROUTS! +Do you want documentation? (Y or N) / + tyi tyic,a + tyo tyoc,a + caie a,131 + cain a,171 + call [move a,[spdcbl,,copblk] + blt a,copend + jrst copy] ;JRST hack + call [type /AHold on a sec...A/ + ret] + infcr usrc,.sprt.,ts,sprout,games,dsk + jrst TTYGO] ;U -- Play Sprouts + huh ;V + call [type /CWumpus +Please Hold On.....A/ + infcr usrc,.WUMP,TS,wumpus,sys1,dsk + jrst ttygo] ;W -- Play Wumpus + call [type /CWumpus Advisor +Please Hold On......A/ + jcl /DSK:games;WA (INIT) +/ + infcr usrc,.WA.,TS,Q,SYS,dsk + jrst ttygo] ;X -- Play Wumpus Advisor + call [type /CYahtzee +Please Hold On.......A/ + jcl /DSK:games;YAHTZE (INIT) +/ + infcr usrc,.yahtz,ts,q,sys,dsk + jrst ttygo] ;Y -- Play Yahtzee + call [type /CZork?? (Ha!)A/ + infcr usrc,zork,ts,zork,sys3,dsk + jrst ttygo] ;Z + huh ;[ + huh ;\ + huh ;] + huh ;^ + huh ;_ + huh ;` + huh ;a + huh ;b + huh ;c + huh ;d + huh ;e + huh ;f + huh ;g + huh ;h + huh ;i + huh ;j + huh ;k + huh ;l + huh ;m + huh ;n + huh ;o + huh ;p + huh ;q + huh ;r + huh ;s + huh ;t + huh ;u + huh ;v + huh ;w + huh ;x + huh ;y + huh ;z + huh ;{ + huh ;| + huh ;} + huh ;~ + huh ;Rubout + +;;; ****************************************************************** +;;; END OF OPTAB +;;; ****************************************************************** + +;;; Now here comes the Delete Routine + +del: call turstp ;is he a turist? + caia ; no, skip + huh ; yep, make believe we don't know + ; what he's talking about + type / +Note: A record is kept of those who use this command. This command +deletes the GAME program. Do not use it unless you have a very good +reason. Randoms should not use it at all. Are you certain that you +want to delete the master copy of the GAME program? (Y or N) / + + tyi tyic,a ;read a character + caile a,132 ;is it uppercase? + subi a,40 ; no, make it then + caie a,"Y" ;is it a "Y" + jrst [type /ASo what are you playing around with fire for?A/ + ret] ;tell him he's an asshole + type /ADeleting...A/ ;make him think that the process takes + tattle delfil,/Deleted the game program / ;a long time to + syscal delete,[[sixbit /DSK/] ;do. actually we just want to rat + [sixbit /TS/] ;on him! dirty of us isn't it? + [sixbit /GAME/] + [sixbit /GAMES/]] + jfcl + tattle logfil,/ DFL/ ;well, as long as the bastard deleted the + death /ASo long, it is deletedA/ ;game program, we might as + ;well kill him +pzhjkw: block 15 ;one of our nasty locations + +;;; here is the code for installing a new version of game + +instal: call turstp ;is he a turist? + caia ; nope, skip + huh ;yep, we don't know this command + type / +Note: A record will be kept of those who use this command. Don't use it +unless you have a good reason. Randoms are not to use it at all. Are you +certain that you want to clobber this version with maybe a bad one? +(Y or N) / + + tyi tyic,a ;get his response + caile a,132 ;is it capitalized? + subi a,40 ; no, well capitalize it! + caie a,"Y" ;if it is not y + jrst [type /ASo what are you playing around with fire for?A/ + ret] + type /AInstalling new version of the GAME program.A/ + ;let him know we're working on it + tattle delfil,/Installed new version of Game/ ;rat on him + move a,[instbl,,copblk] ;well let's copy it in now + blt a,copend + call copy ;ok, let's copy it in + type /AOk, done!A/ ;let him know we're finished. + ret ;and return to cloop +wkjhzp: block 12 ;here is another nasty location + +;;; Ok, here are the all important Help routines + +hlpflg: 0 ;flag to tell if he's seen it yet + +help: skipn hlpflg ;only if this is the first time + type /C +Type A to list games that are available. +Type C to list the program commands +/ + + skipe hlpflg ;from now on, be brief + type /C +^A -- List games +^C -- List program commands +/ + + setom hlpflg ;he's seen it once--let's be brief + ret ;go back to command loop + +;;; Here is the Documentation for the Games + +gdoc: type /CYou choose a game by typing a single character as follows: + +A -- Adventure II M -- Adventure I.V +B -- Baisley's Chess Program N -- Nimlin +C -- Greenblatt's Chess Program O -- Othello +D -- Doctor P -- KMP's Psychiatrist +E -- Chase (W. Kornfeld's) Q -- Qubic +F -- Backgammon S -- Star Trek +G -- Go T -- Stone (for displays only) +J -- Jotto U -- Sprouts +K -- Animal II W -- Wumpus +L -- Limerick X -- Wumpus Advisor +. -- Think Y -- Yahtzee +7 -- Guess! Z -- Zork! +^A -- Lists games available +^C -- Lists program commands +/ + ret + +;;; Here is the documentation for the Program commands + +pdoc: type /CProgram commands: +^A -- List games available +^B -- Back to previous game +^C -- List these commands +^G -- Revert to command loop +^K -- Kill previous game +^P -- Proceed job without the TTY +^Q -- Quit the GAME program +^S -- Stop typeout +? -- List help commands available + +/ + ret + +;;; Here is the routine to write out the log files + +asshol: move d,-1(sp) + move a,(d) + syscal open,[cnti,,.uao+100000 ;open in write-over mode + argi,,dsko + [sixbit /DSK/] ;DEV + 0 ,(a) ;FN1, on the stack + 0 ,1(a) ;FN2 + 0 ,2(a)] ;DIR + jrst [syscal open,[cnti,,.uao ;this time we'll create it + argi,,dsko + ['DSK '] + 0 ,(a) + 0 ,1(a) + 0 ,2(a)] ;it's all done with mirrors + ret ;something's screwed, oh well + jrst barfln] ;go continue barfing + +barfln: syscal fillen,[argi,,dsko ;find length + val,,a] ;in a + .lose 1000 + syscal access,[argi,,dsko ;and go to end of file + a] ;(which is in a) + .lose 1000 + .suset [.runame,,a] ;get our UNAME + 6type dsko,a ;write uname + tyo dsko,[^I] ;write a tab + sioto dsko,1(d) ;write message + sioto dsko,[text / at /] ;write " at " + .rdatim a, ;get time in a, date in b + 6type dsko,b ;write date + tyo dsko,[40] ;write a space + 6type dsko,a ;write time + sioto dsko,[text / == /] ;type this divider + move a,frshr ;get fair share in a + deca dsko,a ;type out the fair share + sioto dsko,[text /\/] + move a,mxsldu + deca dsko,a + tyo dsko,[40] ;type a space + move a,nusrs ;get number of users + deca dsko,a ;type is out + sioto dsko,[text /\/] + move a,mxusrs + deca dsko,a + sioto dsko,[text / -- /] ;type out this divider + movs a,load ;get load in a + 8type dsko,a ;type out the load + terpri dsko ;crlf + syscal close,[argi,,dsko] ;close the file + ret ;and even this is to be ignored + ret ;return + +;;; Here is the code for going back to a Game + +back: .status usrc,a ;check status of inferior + jumpe a,[type /AYou don't have a game to go back to!A/ + ret] ;he didn't have one + type /AReturning to game.A/ ;tell him we're going back to it + jrst ttygo ;go back and play + +;;; Here is the loss handler stuff + +gloss1: skipe debug ;debugging? + .value ;yes....give warning + ;^G quit's enter here +pdlfix: .dtty ;make sure we have the TTY + jfcl + setzm ttyoff ;turn on the TTY + setzm ttyflg ;keep the TTY + move sp,[-pdleng,,pdl] + move a,[-2,,[.sdf1,,[0] ? .sdf2,,[0]]] + .suset a ;undefer the world + jrst cloop + +;;; Interrupt handler stuff +tyint: push sp,a ;must save regs since we might not do it + movei a,tyic ;get our interrupt char + .ityic a, ;into a, but don't flush it + jrst tycnt ;huh? just ignore the interrupt, we'll get it + ;again soon if we really should + cain a,7 ;if char is a ^G + ;this will restart with a message + jrst [.reset tyoc, ;reset the output + .reset tyic, ;reset the input + type /AQUITA/ + jrst pdlfix] + caie a,^S ;check for spurious + jrst tycnt ;yep, ignore + .reset tyoc, ;throw away typeout + setzm siotl ;and stop typeing + setom ttyoff ;turn off the TTY + skipe ttyflg ;are we copying to TTY? + do [setzm outcnt ; clear SIOT count + setom remain] ; claim last input SIOT didn't fill buffer +tycnt: pop sp,a ;get them back + syscal dismis,[cnti,,intspc + sp] + loss + loss + +ttyoff: 0 +ttyst1: 020202,,020202 +ttyst2: 030202,,020202 + + +quit: move sp,[-pdleng,,pdl] ;reset PDL + .reset tyic, ;reset the input + type /AQUITA/ ;tell him what he hit + jrst cloop ;and go back to the command loop + +;;; This is for the clear screen, display version stuff + +ctype: type /CGAME./ ;clear screen and type our name + 6type tyoc,[.fnam2] ;type version number + terpri tyoc ;do a carriage return + ret ;and return + +;;; Some hacker tried to assemble it, or somebody deleted Star Trek + +strlos: type / +Someone is hacking. I don't know where Star Trek is. Sorry!A/ + ;tell him about it + jrst quit ;and quit + +;;; Some hacker tried to assemble this, or deleted Adventure + +advlos: type / +Someone is hacking. I don't know where Adventure is. Sorry!A/ + ;tell him about it + jrst quit ;and quit + + +;;; This is the copy data + +copblk:: + +bytlen: 0 ;size of bytes to XFER + +inctl: .uii +INDEV: 'DSK ' +INFN1: 0 +INFN2: 0 +INDIR: 0 + +outctl: 0 +outdev: 'DSK ' +outfn1: 0 +outfn2: 0 +outdir: 0 +copend==.-1 + +;;; Copy stuff for the GAME NOTES file + +notcbl: offset copblk-. + +bytlen: 7 + +inctl: .uai +indev: 'DSK ' +infn1: 'GAME ' +infn2: 'NOTES ' +indir: 'GAMES ' + +outctl: .uao +outdev: 'TTY ' +outfn1: 'FOO ' +outfn2: 'BAR ' +outdir: 'BAZ ' + +offset 0 + +;;; Copy stuff for the Install routine + +instbl: offset copblk-. + +bytlen: 44 ;length of bytes to XFER + +inctl: .uii +INDEV: 'DSK ' +INFN1: 'NGAME ' +INFN2: 'BIN ' +INDIR: 'EJS ' + +outctl: .uio +outdev: 'DSK ' +outfn1: 'TS ' +outfn2: 'GAME ' +outdir: 'GAMES ' + +offset 0 + + +;;; Copy stuff for the Sprouts documentation + +spdcbl: offset copblk-. + +Bytlen: 7 ;length of bytes to XFER + +inctl: .uai +INDEV: 'DSK ' +INFN1: 'SPROUT' +INFN2: 'RULES ' +INDIR: 'GAMES ' + +outctl: .uao +outdev: 'TTY ' +outfn1: 'FOO ' +outfn2: 'BAR ' +outdir: 'BAZ ' + +offset 0 + +;;; Copy stuff for the Chase documentation + +chacbl: offset copblk-. + +Bytlen: 7 ;length of bytes to XFER + +inctl: .uai +INDEV: 'DSK ' +INFN1: 'CHASE ' +INFN2: 'INFO ' +INDIR: 'GAMES ' + +outctl: .uao +outdev: 'TTY ' +outfn1: 'FOO ' +outfn2: 'BAR ' +outdir: 'BAZ ' + +offset 0 + +constants + +;;; Here is the actual copying routine + +copy: syscal open,[cnt,,inctl ;open input file in appropriate mode + argi,,dski + indev + infn1 + infn2 + indir] + jrst [type /ANo new version available. Forgot to assemble it?A/ + ret] ;lost, tell him + syscal open,[cnt,,outctl ;open output file in apprpriate mode + argi,,dsko + outdev + ['_GAME_'] + ['_COPY_'] + outdir] + jrst [type /ASituation somehow screwed on output. Barf!A/ + syscal close,[argi,,dski] + .lose 1000 + ret] ;what happened? + save [a,b,c,d] + move a,outdev ;get where it's going to... + camn a,['TTY '] ;TTY? + setom ttyflg ; then set the flag + move a,bytlen ;get our byte length + move b,[440000,,dskbuf] ;shell of a byte pointer to DSKBUF + dpb a,[.bp (7700),b] ;fill it in + movem b,bytdst ;save our byte pointer for later + movei b,44 ;36/bytesize*wordsize is buffer size in bytes + idiv b,a + imuli b,dsklen + movem b,bufsiz ;and save it for posterity +morcop: move a,bytdst ;get our byte pointer + move b,bufsiz ;and our buffer size + syscal siot,[argi,,dski + a + b] + do [syscal close,[argi,,dski] + jfcl + syscal close,[argi,,dsko] + jfcl + jrst copret] + move c,bytdst ;get another copy of our byte pointer + move d,bufsiz ;lets figure out how many were moved + sub d,b ;look MA, no random +1 or -1 's! (ITS WINS!!) + movem d,outcnt ;move these out to storage so we can win on + movem b,remain ;output resets + call c.cadj ;check for teco cretinism + + syscal siot,[argi,,dsko + c + outcnt] + do [syscal close,[argi,,dski] + .lose 1000 + syscal close,[argi,,dsko] + .lose 1000 + jrst copret] + move b,remain ;how much do we have left? + cain b,0 ;zero? Are we really done? + jrst morcop ; nope, copy some more + syscal close,[argi,,dski] + skip ;ignore + syscal renmwo,[argi,,dsko + outfn1 + outfn2] + jfcl ;ignore + syscal close,[argi,,dsko] + jfcl ;ignore + +copret: setzm ttyflg ;we aren't typing now. + restor [d,c,b,a] ;restore our accumulators + ret ;and continue letting him play with us + +bufsiz: 0 ;size of buffer in bytes +bytdst: 0 ;byte the dust. pointer to buffer start +remain: 0 ;# of bytes unused in buffer +outcnt: 0 ;# of bytes remaining to be SIOT'ed +ttyflg: 0 ;set non-zero when we do a TTY output +dskbuf: block dsklen + +;;; This part checks the time file to see if it's been long enough since +;;; the time when the last person who was kicked off, tried. The rationale +;;; behind this is that the system load will probably vary within the +;;; 10 minute interval, so let's just assume that it is loaded. + + +constants ;nonsense + +rltclk: 60.*120. ;every two minutes + block 3 + +flushp: 0 ;set to count of times till logout +warned: 0 ;set to count of times till end of probation + + +;;; ********************************************************************** +;;; Here is the real time interrupt routine +;;; ********************************************************************** + +realt: .dtty ;get the TTY back + jfcl + save [a,c,siotl,ttyoff] ;save the ac's and siot count -- we may have + ;been typing. Also save ttyoff so we can + ;it on now + setzm ttyoff ;turn it on! + call ctmf ;has he tried to cheat us + call chkit ;let's check the load + + movei a,30.*5 ;continue playing, at least in + .sleep a, ;five seconds. + restor [ttyoff,siotl,c,a] ;restore everything +ttydis: skipe ttyflg ;did the inferior have the bastard? + .atty usrc, ; yep, hack away + jfcl ; ? + dismis ;back to whatever depths we came from + + +timfls: skipn initld ;don't print # if not initial try + do [tattle logfil,/# SLD/] ;note the fact--he was not allowed on + skipe initld ;don't print - if initial time + do [tattle logfil,/- SLD/] ;note the fact--he was thrown off + call chkopn ;open the check file + syscal dskupd,[argi,,dski] ;set the creation date to now + loss ; huh? + syscal sdmpbt,[argi,,dski ? argi,,1] ;make it look dumped + loss ;huh? + .close dski, ;close the file + skipe initld ;is this the first time around? + death/ +I'm afraid the system has become too loaded to continue playing games. Please +try again later. Goodbye. +/ ;no + skipn initld ;is this the first time around? + death/ +I'm afraid the system is too loaded for playing games. Please try again later. +/ ;yes + loss ;we should never get here + + +;;; Here are the definitions of the log files + +delfld: sixbit /DELTST/ ;we're debugging, don't use +logfld: sixbit /LOGTST/ ; regular log files +badfld: sixbit /BADTST/ +delfil: sixbit / ASS/ ? sixbit / DEL/ ? sixbit /EJS/ +logfil: sixbit / ASS/ ? sixbit / LOG/ ? sixbit /EJS/ +badfil: sixbit / ASS/ ? sixbit / BAD/ ? sixbit /EJS/ + +myunam: 0 ;place to put his UNAME +initld: 0 ;flag to see if initially thrown off +load: 0 ;place to put load +nulll: 0 ;junk location + + +whotab: sixbit /hic/ + sixbit /cstacy/ + sixbit /chris/ + sixbit /rwk/ + sixbit /kmp/ + sixbit /don/ + sixbit /bern/ + sixbit /ejs/ +wholen==.-whotab + +ctmf: save [b,c] ;save these ac's + movei c,0 ;clear accumulator + movsi b,-wholen ;get or aobjn pointer +whofoo: add c,whotab(b) ;add them up + aobjn b,whofoo ;and repeat + movem c,summ ;store sum + came c,flunk ;is he trying to cheat us? + jrst [tattle badfil,/Tried to patch the GAME binary/ + call wrtfil + death / +It is exceptionally distasteful to patch programs to get past attempts at +security. Because of this, you have lost the privilege of using the GAME +program. Your actions have been recorded and if they persist, they might +result in some action being taken towards taking away your account here +on MC. Good bye.A/] + restor [c,b] + ret + +summ: 0 ;place to store accumulated total + + +whois: movsi b,-wholen ;AOBJN ptr to table of winning users + move a,myunam ;get his uname +whois0: camn a,whotab(b) ;is it a winner? + ret ; yes, skip the load checking + aobjn b,whois0 ;no, maybe try another + popj1 ;no good, skip upon returning + +turstp: movei a,lsrc ;tell what channel we can hack. + move b,[-20,,lsrpag] ;and what pages it can hack + call lsrtns"lsrmap ;map in the INQUIR database + jrst lsrskp ; Well, can't, pretend he's a T + .suset [.runame,,a] ;get our uname + .suset [.rxuname,,b] ;who the fuck we aren't + move t,b ;save the beggar + tdz t,a ;heuristic test for hackers + caie t,0 ;is he obviously not who he claims? + jrst lsrskp ; yep! + movei a,lsrc ;channel it's open on + call lsrtns"lsrunm ;find the turkey + jrst lsrskp ; not found, boy, what a turkey. + movei a,lsrtns"I$GRP ;hack his group + call lsrtns"lsritm ;find his group + jrst lsrskp ; no group! + .close lsrc, ;don't need it any more + ildb b,a ;get his group + caige b,40 ;is it printing? + popj1 ; no, total turkey + caie b,"O" ;does he claim to be non-human? + cain b,"o" + jrst [tattle logfil,/ NHF/ + death /AYou claim to be non-human. And at least where +I come from non-humans don't play games. So I'm afraid I'll have to say +good-bye to you. Please update your inquire entry.A/] + + caie b,"T" ;is it a T? + cain b,"t" ; Does INQUIR ever generate this? + popj1 + caie b,"R" ;is it a Random? + cain b,"r" ; or very Random? + popj1 + ret ;not a tourist, (he claims) + +lsrskp: .close lsrc, ;close the channel! + popj1 ;skip! + +dbging: setom pzhjkw+10. ;set this flag + setom wkjhzp+5 ; and this one + skipe dbg1 ;do we want discrete load checking + call chkld ; yes + skipe dbg2 ;do we want continuous load checking + call onint ; yes + skipe dbg3 ;do we want both? + skipe dbg1 ; do we need to turn on discrete? + caia ; no, skip and continue + call chkld ; yes, turn on discrete + skipe dbg3 ;do we want both? + skipe dbg2 ; do we need to turn on interrupts? + caia ; no, skip and continue + call onint ; yes, turn on interrupts + popj1 ;and skip return + +dbg1: 0 ;these are the debug flags +dbg2: 0 +dbg3: 0 + +flunk: 735370,,712671 ;what it should be + +onint: push sp,a ;save it just in case + move a,[200000,,rltclk] ;get our interrupt intervar + setom wkjhzp+5 + .realt a, ;turn it on + pop sp,a ;restore the ac + ret ;and return + + +mechan: tattle badfil,/Was hacking the GAME program/ + call wrtfil + death /C +I'm becoming rather irritated with your hacking. The games are only to be +used during certain times of the day when the system is not loaded. Because +of your hacking, you will be restricted from using the GAME program for a +few days. Sorry, but playing games is a privilege. +/ + +kldcp=setom pzhjkw+10. +pcdlk=setzm pzhjkw+10. +delta=setom wkjhzp+5 +atled=setzm wkjhzp+5 + +wrtfil: syscal open,[cnti,,.uao ;try to open our rat file + argi,,dski + ['dsk '] + ['_game_'] + myunam + ['.temp.']] + jfcl ;if it fails don't worry about it + .close dski, ;close the channel + ret ;and return + +fndfil: syscal open,[cnti,,.uai ;check to see if the file exists + argi,,dski + ['dsk '] + ['_game_'] + myunam + ['.temp.']] + ret ;if not, don't worry about it--he's ok. + tattle badfil,/Tried again after being warned/ + death /C +You have been warned--you are not to play the GAME program any more. +Any further warnings will result in reconsideration of your account here +on MC. A/ + +;;; Routine for goddamn fucking TECO that doesn't set FILLEN for end of file +;;; like it ought to. This means it writes out cretinouse ^C's at the end +;;; to pad the word! Also, the ERR device ends off with a ^L, so we flush +;;; those too! + +c.cadj: save [a,b,c] ;save our ac's + move a,foobp ;get the possibly cretinouse byte pointer + tlne a,004000 ;is it a full-word pointer? + hrli a,010700 ; yes, make it a ascii pointer + movei b,5 ;at most 5 of the losers + setz c, ;count the beggars + norm7 a ;back up to last one +c.caj0: ldb chr,a ;get the possibly offensive character + caie b,c.caj0 ;find another? + exch c,outcnt + subm c,outcnt + restor [c,b,a] ;restore our ac's + ret ;nope that's all + + +;;; For the normal user, these start up the load checking stuff + +sttw: call chkld ;check the load + call onint ;enable the interrupts + ret ;and return + +;;; Here is the load checking scheme. It uses the loadch routine. + +chkld: call chkopn ;open the time file + ; or create it if necessary + syscal rfdate,[argi,,dski + val,,a] ;get it's reference date + loss ;got a problem, no? + .close dski, ;don't need the channel any more + setom pzhjkw+10. ;he's got this far + move b,[3.*60.] ;get interval + call datime"timadd ;calculate end of period + syscal rqdate,[val,,b] ;get current time + caia ; not available + camn b,[-1] ; not available? + jrst [tattle logfil,/? TNA/ + death /AYou can't use GAME just yet, please wait a bit./] + +;;;that wasn't very nice but oh well, hopefully it won't happen too often + + camg b,a ;has somebody been thrown off recently? + call mbyfls + call chkit + ret + +;;; This part tries to open the file to see if someone has been thrown off +;;; within the past 10 minutes. + +chkopn: syscal open,[cnti,,.uai ;let's try to open the time file + argi,,dski + ['dsk '] ;yep, this is where it is hackers + [' tim'] + [' chk'] + ['ejs ']] + jrst [syscal open,[cnti,,.uao ;unfortunately, somebody + ;tried to delete it + argi,,dski ;oh well, just create another + ['dsk '] ;one. It won't hurt us any + [' tim'] + [' chk'] + ['ejs ']] + loss ;if we can't, then we have a problem + jrst .+1] + ret ;return + +mbyfls: skipn initld ;is this the first load check? + jrst timfls ; yes, kill him without countdown + sosn flushp ;are we at end of final countdown? + jrst timfls ; yep, kill him + skipl flushp ;are we in the middle of final countdown? + ret ; yep, just return + sosn warned ;is this the end of probation period + jrst warn1 ; yep, give him final warning + skipl warned ;are we in the middle of warning period? + ret + type/A +The system is becoming loaded. If this continues for another couple minutes, +I'm afraid I will have to ask you to leave.A/ + + movei e,4 ;four interrupts is 8 minutes + movem e,warned ;save for count down + ret + +warn1: type / +I'm sorry but the system has become too loaded, I'm afraid I can give you +only a few minutes to save your game or finish up.A/ + + movei e,2 ;two interrupts is it (4 minutes) + movem e,flushp ;let him be flushed + ret ;and return + +chkit: call ldcal ;get the data + setom pzhjkw+10. ;set some flags + setom wkjhzp+5 ; ditto + move a,load ;get our load flags + tlne a,%sllog ;is he logged in? + jrst [tattle logfil,/ NLI/ + death /AYou must log in to play games!A/] + tlne a,%sldil ;is this a dialup line? + jrst [tattle logfil,/ WOD/ + death / +Due to the scarcity of dialup lines, we do not permit playing games from +them. If you are not an authorized user, you are not to use them at all. +/] + tlne a,%slcls ;are we closed? + jrst [tattle logfil,/ WTD/ + death / +Games are not to be played at this time of day. +Please give up. Our hours are: + +Mon-Fri 8:00 pm to 8:00 am +Saturday and Sunday all day. +Holidays all day. + +See you then! +/] + tlne a,%sldet ;are we detached? + .logout 1, ; yes, kill this job + tlne a,%sload ;are we loaded? + call mbyfls ; yes, maybe flush him then + tlnn a,%sload ; + call mbybet ;maybe tell him that things got better + ret + +mbybet: skipe warned ;if we have been warned + do [type / +The load has gotten a little better now. So you may continue +for a while.A/ + setzm flushp ; then reset flags + setzm warned] + ret ;and return + +ldcal: save [e,f] ;save our ac's + call loadch ;set our flags + movem a,load ;and store away the flags + eval e,SLOADU ;Get inverse fair share + movei f,10000. ; fair share = 10000./sloadu. + idivm f,e ; calculate it + movem e,frshr ;store this as frshr + eval e,SUSRS ;Get the number of users + movem e,nusrs ;store this as nusrs + restor [f,e] ;restor our ac's + ret ;and return + +;;; A routine to check the system load. Right half of A gets load units +;;; left half gets flags for dialup lines, detached tree, or not logged in + +loadch: save [b,c,e] ;save our accumulators + setz a, ;clear a to receive our results + .suset [.runame,,uname] ;check our UNAME.... + hllz e,uname ;look at left half of uname for '___' + camn e,[-1,,0] ;are we logged in? + tlo a,%sllog ;no, note the fact + .suset [.rcnsl,,ttynum] ;we have to check for detached or dialups + move e,ttynum ;get our tty num + caig e, ;do we have one? + tlo a,%sldet ;no, note the fact + movei b,1 ;let's figure out which we are + lsh b,(e) ;as a bit in the word + tdne b,dilmsk ;are we a dialup? + tlo a,%sldil ;yes, note the fact + move e,frshr ;get the fair share + camg e,mxsldu ;is it greater than the max? + tlo a,%sload ;note the fact + move e,nusrs ;get the number of users + caml e,mxusrs ;is it greater than the max? + tlo a,%sload ;note the fact + .rtime e, ;get time + camge e,t.open ;if before 8:00 am + jrst gobak ;it's OK + camle e,t.clos ;if it's after 8:00 pm + jrst gobak ;it's OK + .ryear b, ;get date stuff + ldb e,[.bp (003400),b] ;this byte + cain e,0 ;if not Sunday + jrst gobak ;it's Sunday, let him go. + cain e,6 ;if not Saturday + jrst gobak ;it's Saturday, let him go. + call holdyp ;is it a holiday? + jrst nopen ; tell him we're closed! + +gobak: restor [e,c,b] ;restore our ac's + ret ;and return it + +nopen: tlo a,%SLCLS + jrst gobak + +holdyp: movsi e,-hldys ;aobjn ptr + .rdate b, ;get the year +holdy1: camn b,(e)hldy ;is it a holiday? + popj1 ;yes, skip + aobjn e,holdy1 ;no, loop? + ret ;no, not a holiday + +hldy: + '801013' ;Columbus day an *MY* birthday + '801111' ;Veteran's Day + '801127' ;Thanksgiving Day + '801225' ;Christmas Day + '810101' ;New Year's Day + '810216' ;Washington's Birthday + '810420' ;Patriot's Day + '810525' ;Memorial Day + '810704' ;Independence Day +hldys==.-hldy + +t.open: sixbit /080000/ ;opening time +t.clos: sixbit /200000/ ;closing time + +mxsldu: mvsldu ;maximum fair share +mxusrs: mvusrs ;maximum number of users +nusrs: 0 ;running number of users +frshr: 0 ;running fair share +uname: 0 ;save the UNAME here to check for login etc. +dilmsk: 1_1+1_3+1_4+1_5+1_6+1_7+1_10+1_11+1_12+1_13+1_14 +ttynum: 0 ;save our TTY number here to check for dialup + +;;; More random locations + +foobp: 0 ;location for byte pointer +versio: .fnam2 + + end go ;can you believe it, we are done! + + diff --git a/src/games/animal.(init) b/src/games/animal.(init) new file mode 100644 index 00000000..1f0de644 --- /dev/null +++ b/src/games/animal.(init) @@ -0,0 +1,158 @@ +;;; -*- LISP -*- +;;; +;;; KMP's ANIMAL Init File +;;; +;;; Created 2:14am Saturday, 23 September 1978 +;;; + +(COMMENT) + + ;; Temporary measures ... + +(PROGN (CLOSE (PROG2 NIL INFILE (INPUSH -1))) + (CURSORPOS 'A TYO) + (PRINC '|The All-New ANIMAL program. (Old one temporarily out of order)| + TYO) + (TERPRI TYO) + (PRINC '|Please mention you're using ANIMAL version 2 in any bug notes.| + TYO) + (TERPRI TYO) + (PRINC '|End all input with a period!| TYO) + (TERPRI TYO) + (LOAD '((PIQUE) ANIMAL FASL)) + (NOINTERRUPT T) + (SSTATUS TOPLEVEL '(ANIMAL)) + (SETUP-FOR-ANIMAL)) + +(PROGN + + ;; Fix QUIT for KMP... + + (COND ((MEMQ (STATUS UNAME) '(KMP TNP)) + (DEFUN QUIT N + (CURSORPOS 'A TYO) + (PRINC '|Do you really want to kill this job? | TYO) + (CLEAR-INPUT TYI) + (COND ((MEMBER (TYI TYI) '(89. 121.)) + (PRINC '| [Yes]| TYO) + (VALRET '|:KILL |)) + (T + (PRINC '| [No]| TYO) + NIL)))) + (T + (TERPRI TYO) + (PRINC '|There is an all new, very experimental Animal game| TYO) + (TERPRI TYO) + (PRINC '|by doing :KMP;ANIMAL. Please specify in any notes to| TYO) + (TERPRI TYO) + (PRINC '|BUG-ANIMAL which game you are using.| TYO) + (TERPRI TYO))) + + ;; Turn off interrupts while this loads + + (NOINTERRUPT T) + + ;; Turn off load messages + + (SSTATUS FEATURE NOLDMSG) + + ;; Send KMP a message if he's logged in. + + (DEFPROP IOTA ((DSK LIBLSP) IOTA FASL) AUTOLOAD) + + (COND ((AND (NOT (EQ (STATUS USERID) 'KMP)) + (PROBEF '((USR *) KMP HACTRN))) + (LET ((BASE 10.) (*NOPOINT T) ((HOUR MIN) (STATUS DAYTIME))) + (ERRSET + (IOTA ((STREAM '((CLI *) KMP HACTRN) '(OUT))) + (MAPC (FUNCTION (LAMBDA (X) (PRINC X STREAM))) + (LIST + '|/[Message from The Animal Game at MIT-MC | + (COND ((ZEROP (\ HOUR 12.)) '|12|) (T (\ HOUR 12.))) + '/: + (COND ((< MIN 10.) (IMPLODE (LIST '/0 (+ MIN 48.)))) + (T MIN)) + (COND ((ZEROP (// HOUR 12.)) '|am|) + (T '|pm|)) + '/] (ASCII 13.) (STATUS UNAME) + '| is gonna play against me!|)) + (TERPRI STREAM)) + NIL)))) + + ;; Turn off ^S interrupt - trap it manually + + (SSTATUS TTYINT 19. NIL) + + ;; Allocate core - load it in... + + (ALLOC '(LIST 150000)) + (LOAD '((DSK KMP) ANIMAL FASL)) + + ;; to indicate we are doing something... + + (TERPRI TYO) + + ;; Close this file + + (CLOSE (PROG2 T INFILE (INPUSH -1))) + + ;; Is animal locked for some reason? + + (COND ((PROBEF LOCK-DATA-FILE) + (PRINTC '|ANIMAL will not be available for a few minutes.| TYO) + (PRINTC '|I working on the data base. If you get this| TYO) + (PRINTC '|message and I am not logged in, please do :BUG ANIMAL| TYO) + (PRINTC '|Sorry for the inconvenience.| TYO) + (QUIT)) + ((PROBEF LOCK-PROGRAM-FILE) + (PRINTC '|ANIMAL will not be available for a few minutes.| TYO) + (PRINTC '|I am testing some new features. If you get this| TYO) + (PRINTC '|message and I am not logged in, please do :BUG ANIMAL| TYO) + (PRINTC '|Sorry for the inconvenience.| TYO) + (QUIT)) + ((PROBEF LOCK-RANDOM-FILE) + (PRINTC '|ANIMAL is out of service for an uncertain amount| TYO) + (PRINTC '|of time. Send mail to KMP@MC for explanation.| TYO) + (QUIT))) + + ;; Offer to print news if any... + + (COND ((PROBEF NEWS-FILE) + (PROG (CHAR INFO *NOPOINT TIME DATE) + (SETQ *NOPOINT T) + TOP (TERPRI TYO) + (SETQ INFO (CAR (DIRECTORY (LIST NEWS-FILE) '(CREDATE CRETIME)))) + (SETQ TIME (CADR (MEMQ 'CRETIME INFO))) + (SETQ DATE (CADR (MEMQ 'CREDATE INFO))) + (PRINC '|News last updated | TYO) + (DATE-AND-TIME-PRINC DATE TIME) + (PRINC '|.| TYO) + (TERPRI TYO) + (PRINC '|--Read News?-- (Y OR N)| TYO) + (CLEAR-INPUT TYI) + (SETQ CHAR (TYI TYI)) + (COND ((MEMBER CHAR '(89. 121.)) + (PRINTC '|(Type a | TYO) + (PRINC '| to flush rest of output)| TYO) + (TERPRI TYO) + (CLEAR-INPUT TYI) + (APPLY 'PRINTFILE (NCONS NEWS-FILE))) + ((= CHAR 12.) + (CURSORPOS 'C TYO) + (GO TOP)) + ((MEMBER CHAR '(2120. 63.)) + (PRINTC '|Information about latest improvements.| TYO) + (GO TOP)) + ((MEMBER CHAR '(78. 110.)) + (TERPRI TYO)) + (T + (PRINC '| ?? Type "?" for help.|) + (GO TOP)))))) + + ;; Run the game... + + (ANIMAL)) + + + + \ No newline at end of file diff --git a/src/games/animal.133 b/src/games/animal.133 new file mode 100644 index 00000000..11d208b8 --- /dev/null +++ b/src/games/animal.133 @@ -0,0 +1,2113 @@ +;;; -*- Mode:LISP; Base:10 -*- +;;; + +(COMMENT Initialize Environment) + + ;; Allocate storage + +(ALLOC '(LIST 130000.)) +(ALLOC '(SYMBOL 60000.)) +(ALLOC '(FIXNUM 30000.)) + + ;; Turn off autoload messages + +(SSTATUS FEATURE NOLDMSG) + + ;; Init interesting lisp variables + +(EVAL-WHEN (EVAL LOAD COMPILE) + + (SETQ BASE 10. IBASE 10. *NOPOINT NIL)) ; I/O Base 10 anytime + +(NOUUO T) (*RSET T) (SETQ PURE 1.) ; Debugging enabled at runtime + + ;; Declare imported things ... + +(DECLARE (*EXPR INTERJECTION? PREPOSITION? PRONOUN? NOUN? PERSON-NAME? + VERB? ADJECTIVE? ADVERB? MODIFIER? + PART-OF-SPEECH PART-OF-SPEECH? IS-A? FEMALE-NAME? MALE-NAME? + VERB-SING? VERB-PLURAL? VERB-PP? + MATCH + LOWERCASIFY CAPITALIZE UPPERCASIFY DIGIT? + PARSE$MAKE-WORDS EXPAND-CONTRACTIONS EXPAND-ABBREVS)) + + ;; Declare special types of functions... + +(DECLARE (*LEXPR DISPLAY)) + + ;; Load supporting packages + +(EVAL-WHEN (EVAL LOAD COMPILE) ; Always + (LOAD '|GAMES;PARSE FASL|) ; Load lexical parser + (LOAD '|GAMES;WORDS FASL|) ; Load dictionary stuff + (LOAD '|GAMES;PATTRN FASL|) ; Load pattern matcher + + (DEFUN CONCAT X ; Pname concatenation + (IMPLODE (MAPCAN 'EXPLODEN (LISTIFY X)))) + + (DEFUN PARSE-INPUT (X) ; Parser -- assembles + (EXPAND-ABBREVS ; hacks from several + (EXPAND-CONTRACTIONS ; packages + (PARSE$MAKE-WORDS + (COND ((FIXP (CAR X)) (MAPCAR 'ASCII X)) + (T X)))))) + + (DEFUN PARSE-/" () ; Define our very sophisticated + (DO ((C (TYI) (TYI)) ; doublequote macro + (L () (CONS C L))) + ((= C 34.) (PARSE-INPUT (NREVERSE L))))) + + (SSTATUS MACRO /" 'PARSE-/")) ; Enable doublequote macro + +(EVAL-WHEN (EVAL COMPILE) ; Setup + (LOAD '|LIBLSP;IOTA FASL|) + (SETQ ANIMAL-VERSION (CADDR (TRUENAME INFILE)))) + +(INCLUDE ((DSK GAMES) LSRRTN INSERT)) ; Include support for the + ; LOOKUP-INQUIR-INFO macro + ; and GET-USER-NAME subr + +(DEFUN *VERSION MACRO (()) `',ANIMAL-VERSION) + +(DEFUN VERSION () (*VERSION)) + +(EVAL-WHEN (EVAL LOAD) ; Runtime + (LOAD '|GAMES;WORD FASL|)) ; Load string hacks + + +(COMMENT Useful Macros) + +;;; (DO-FOREVER . ) +;;; Like a DO with no termination condition. Clearer to read. + +(DEFMACRO DO-FOREVER (BVL &REST BODY) `(DO ,BVL (NIL) ,@BODY)) + + +(COMMENT Data Structure) + +;;; Database structure +;;; +;;; is a or a +;;; +;;; has components QUESTION, NO-BRANCH, YES-BRANCH, AUTHOR +;;; has components TERMINAL, AUTHOR +;;; +;;; There are EXTRACT- operators for all components. +;;; +;;; The predicates QUESTION-NODE? and TERMINAL-NODE? may be applied to any +;;; node to find its type. +;;; + +(DEFMACRO CONSTRUCT-QUESTION (QUES NO YES &OPTIONAL (AUTHOR '(STATUS USERID))) + `(LIST ,QUES ,AUTHOR ,NO ,YES)) + +(DEFMACRO CONSTRUCT-TERMINAL (TERM &OPTIONAL (AUTHOR '(STATUS USERID))) + `(LIST ,TERM ,AUTHOR)) + +(DEFMACRO COPY-NODE (NODE) `(SUBST NIL NIL ,NODE)) + +(DEFMACRO EXTRACT-QUESTION (NODE) `(CAR ,NODE)) +(DEFMACRO EXTRACT-TERMINAL (NODE) `(CAR ,NODE)) +(DEFMACRO EXTRACT-AUTHOR (NODE) `(CADR ,NODE)) +(DEFMACRO EXTRACT-NO-BRANCH (NODE) `(CADDR ,NODE)) +(DEFMACRO EXTRACT-YES-BRANCH (NODE) `(CADDDR ,NODE)) + +(DEFMACRO TERMINAL-NODE? (NODE) `(ATOM (CAR ,NODE))) +(DEFMACRO QUESTION-NODE? (NODE) `(NOT (ATOM (CAR ,NODE)))) + + +(COMMENT Variable Initializations) + +;;; (INITIALIZE ...) +;;; +;;; ::= ! ( ...) +;;; +;;; Expands to: +;;; +;;; (PROGN 'COMPILE +;;; (DECLARE ( ... things with that attribute ... ) +;;; ( ... things with that attribute ... ) ...) +;;; (SETQ ) +;;; (SETQ ) ...) +;;; + +(DEFMACRO INITIALIZE (&REST INFO) + (DO ((L INFO (CDDR L)) + (INITS ()) + (NAME ()) + (ATTRIBUTES (NCONS NIL))) + ((NULL L) + `(PROGN 'COMPILE + (DECLARE ,@(DO ((A (CDR ATTRIBUTES) (CDDR A)) + (L () (CONS (CONS (CAR A) (CADR A)) L))) + ((NULL A) L))) + ,@(NREVERSE INITS))) + (COND ((ATOM (CAR L)) (SETQ NAME (CAR L))) + (T (SETQ NAME (CAAR L)) + (MAPCAR #'(LAMBDA (X) + (PUTPROP ATTRIBUTES + (CONS NAME + (GET ATTRIBUTES X)) + X)) + (CDAR L)))) + (PUSH `(SETQ ,NAME ,(CADR L)) INITS))) + +(INITIALIZE + + ;; Random ... + (*PLAYER-NAME* SPECIAL) (STATUS USERID) + + (*PLAYER-OBJECT-PRONOUN* SPECIAL) '|| + (*PLAYER-SUBJECT-PRONOUN* SPECIAL)'|| + + (*FULL-NAME* SPECIAL) '|| + (*LAST-NAME* SPECIAL) '|| + (*NICK-NAME* SPECIAL) '|| + (*FIRST-NAME* SPECIAL) '|| + + ;; Data-structure stuff + (*NEW* SPECIAL) (NCONS (GENSYM)) ; For debugging + (*OLD* SPECIAL) (NCONS (GENSYM)) ; For debugging + (*MEMORY* SPECIAL) (CONSTRUCT-TERMINAL 'DOG '|No one|) + (*CURRENT-NODE* SPECIAL) *MEMORY* + + ;; Display Features + (*DISPLAY* SPECIAL) '|** Tell KMP I have a display bug **| + (*FILL-COLUMN* SPECIAL FIXNUM) (- (LINEL TYO) 15.) + + ;; Filenames + (*SAVE-FILE* SPECIAL) '((DSK games) ANIMAL SAVE) + (*NOTES-FILE* SPECIAL) '((DSK games) ANIMAL NOTES) + (*NEWS-FILE* SPECIAL) '((DSK games) ANIMAL NEWS) + (*INSTRUCTION-FILE* SPECIAL) '((DSK games) ANIMAL RULES) + (*MEMORY-AREA* SPECIAL) '((ARC games) * *) + + ;; Debug options + (*DEBUG* SPECIAL) NIL + + ;; Random flags + (*WATER-FLAG* SPECIAL) NIL + (*FOUL-FLAG* SPECIAL) NIL + (*FOUL-COUNT* SPECIAL) 0. + (*FOUL-COUNT-MAX* SPECIAL) 3. + (*APOLOGY-FLAG* SPECIAL) NIL + (*FORGIVE-FLAG* SPECIAL) NIL + (*DOT-WARN* SPECIAL) NIL +) + + +(COMMENT Utility Routines) + +;;; (PRINTF ) +;;; Prints out to the already-open . +;;; Expects that will end in a carriage return. + +(DEFUN PRINTF (IFILE OSTREAM) + (IOTA ((ISTREAM IFILE '(IN ASCII SINGLE))) + (DO ((C (READLINE ISTREAM 0.) (READLINE ISTREAM 0.))) + ((NUMBERP C) (TERPRI OSTREAM)) + (TERPRI OSTREAM) + (PRINC C OSTREAM)))) + +;;; (CREATEF ) +;;; Creates a file named clobbering if it already +;;; exists. + +(DEFUN CREATEF (X) (IOTA ((STREAM X 'OUT)) T)) + +;;; (ADDPROP ) +;;; +;;; CONS's onto the head of 's property. + +(DEFUN ADDPROP (SYM VAL LAB) + (PUTPROP SYM (CONS VAL (GET SYM LAB)) LAB)) + +;;; (SWAP ) +;;; +;;; Swaps object1 and object2 + +(DEFUN SWAP (X Y) + (RPLACA Y (PROG1 (CAR X) (RPLACA X (CAR Y)))) + (RPLACD Y (PROG1 (CDR X) (RPLACD X (CDR Y)))) + T) + +(DEFUN CLOCK-TIME () + (LET ((BASE 10.) + (*NOPOINT T) + ((HOURS MINS) (STATUS DAYTIME)) + (A/P) + (DIG)) + (SETQ A/P (COND ((> HOURS 11.) '/p) (T '/a))) + (SETQ DIG (COND ((< MINS 10.) (NCONS '/0)) (T NIL))) + (SETQ HOURS (\ HOURS 12.)) + (IMPLODE (NCONC (EXPLODEN HOURS) + (CONS '/: DIG) + (EXPLODEN MINS) + (LIST A/P '/m))))) + + +(COMMENT Rule Definitions) + +;;; DEF-DEF +;;; +;;; A macro-defining macro! See documentation on next page... + +(DEFMACRO DEF-DEF (CLASS HEADER DATABASE-NAME) + `(PROGN + 'COMPILE + (DECLARE (SPECIAL ,DATABASE-NAME)) + (SETQ ,DATABASE-NAME ()) + (DEFMACRO ,(CONCAT 'DEF- CLASS) (RULE-NAME ARG-LIST LOCALS &REST STUFF) + (LET ((CONDITIONS) + (BODY) + (LOCAL-NAMES (DO ((L LOCALS (CDR L)) + (LN ())) + ((NULL L) (NREVERSE LN)) + (PUSH (COND ((ATOM (CAR L)) (CAR L)) + (T (CAAR L))) + LN)))) + (DO () ((NOT (ATOM (CAR STUFF)))) (POP STUFF)) + (DO ((L STUFF (CDR L))) + ((ATOM (CAR L)) + (SETQ CONDITIONS (NREVERSE CONDITIONS)) + (SETQ BODY (CDR L))) + (PUSH (CAR L) CONDITIONS)) + (LET ((COND-ID (CONCAT ',HEADER '$ RULE-NAME '/?)) + (RULE-ID (CONCAT ',HEADER '$ RULE-NAME)) + (DRIVER (CONCAT ',HEADER '$ RULE-NAME '/!))) + `(PROGN 'COMPILE + (DEFUN ,COND-ID ,ARG-LIST + (DECLARE (SPECIAL ,@LOCAL-NAMES)) + ,@ARG-LIST + ,(COND ((> (LENGTH CONDITIONS) 1.) + `(OR ,@CONDITIONS)) + (T + (CAR CONDITIONS)))) + (DEFUN ,RULE-ID ,ARG-LIST + (DECLARE (SPECIAL ,@LOCAL-NAMES)) + ,@ARG-LIST + ,@BODY) + (DEFUN ,DRIVER ,ARG-LIST + (LET ,LOCALS + (DECLARE (SPECIAL ,@LOCAL-NAMES)) + (COND ((,COND-ID ,@ARG-LIST) + (NCONS (,RULE-ID + ,@ARG-LIST))) + (T NIL)))) + (SETQ ,',DATABASE-NAME + (NCONC ,',DATABASE-NAME + (NCONS ',DRIVER))) + ',',DATABASE-NAME)))))) + +;;; (DEF-DEF
) +;;; +;;; Initializes a global variable to NIL and +;;; defines a macro DEF- which is callable via the syntax +;;; +;;; (DEF- . ) +;;; +;;; ::= (IF THEN ) +;;; +;;; which will define three more functions when called... +;;; +;;; Predicate... +;;; +;;; (DEFUN
$? ) +;;; +;;; Action... +;;; +;;; (DEFUN
$ ) +;;; +;;; Driver... Calls action if predicate wins +;;; +;;; (DEFUN
$! (LET ...)) +;;; +;;; and will NCONC the driver's name to the list via NCONC. +;;; + +(DEF-DEF EXIT EXIT EXITS) +(DEF-DEF TRANSFORM TRANSFORM TRANSFORMATIONS) +(DEF-DEF INTERPRETATION INTERPRET INTERPRETATIONS) +(DEF-DEF QUESTION QUESTION QUESTIONS) +(DEF-DEF STATEMENT STATEMENT RANDOM-STATEMENTS) + + +(DEFUN TRY-RULES (RULE-SET EXPRESSION) + (*CATCH 'DONE + (DO-FOREVER ((FLAG NIL T)) + (DO ((R RULE-SET (CDR R)) + (TEMP)) + ((NULL R) (*THROW 'DONE EXPRESSION)) + (SETQ TEMP (FUNCALL (CAR R) EXPRESSION)) + (COND (TEMP + (SETQ EXPRESSION (CAR TEMP)) + (RETURN T))))))) + +(DEFUN TRY-RULES-ONCE (RULE-SET EXPRESSION) + (DO ((R RULE-SET (CDR R)) + (TEMP)) + ((NULL R) NIL) + (SETQ TEMP (FUNCALL (CAR R) EXPRESSION)) + (COND (TEMP + (SETQ EXPRESSION (CAR TEMP)) + (RETURN EXPRESSION))))) + + + +(COMMENT I/O Routines) + +(DEFMACRO CATCH-ROUND-EXIT (FORM) `(*CATCH 'EXIT-ROUND ,FORM)) +(DEFMACRO ABORT-ROUND () `(*THROW 'EXIT-ROUND NIL)) + +(DEFMACRO OUTPUT-BIND (&REST FORM) `(LET ((*DISPLAY* (NCONS '||))) ,@FORM)) + +(DEFUN READ-SENTENCE () + (LET ((RESULT (LET* ((S (READ-A-SENTENCE)) + (P (PARSE-INPUT S))) + (COND ((FOUL-ANSWER? P) + (HANDLE-FOUL-LANGUAGE P) + (DISPLAY *DISPLAY*) + (READ-SENTENCE)) + (T + (HUNK (CAR P) (CXR 2. S) (CDR P))))))) + (COND ((HANDLE-RANDOMNESS RESULT) + (DISPLAY *DISPLAY*) + (READ-SENTENCE)) + (T + RESULT)))) + +(DEFUN REDISPLAY (L) + (DISPLAY *DISPLAY*) + (MAPC #'(LAMBDA (X) (TYO X TYO)) (REVERSE L))) + +(DEFUN WARN-/. (()) + (SETQ *DOT-WARN* NIL) + (NOINTERRUPT NIL) + (OUTPUT-BIND (DISPLAY '|Type a '.' to terminate your input.|)) + (*THROW 'SMART-TYI #\FORM)) + +(DEFUN SMART-TYI (INSTREAM) + (COND ((AND *DOT-WARN* (ZEROP (LISTEN INSTREAM))) + (LET ((ALARMCLOCK 'WARN-/.)) + (*CATCH 'SMART-TYI + (UNWIND-PROTECT + (PROGN (ALARMCLOCK 'TIME 11.) (TYI INSTREAM)) + (ALARMCLOCK 'TIME NIL))))) + (T + (TYI INSTREAM)))) + +(DEFUN READ-A-SENTENCE () + (DO-FOREVER ((C (TYI TYI) (SMART-TYI TYI)) + (L NIL) + (TYPE) + (*DOT-WARN* T)) + (CASEQ C + ((#\FORM) (REDISPLAY L)) + ((#/. #/? #/!) + (COND (L ; Only if there was input do we return... + (SETQ TYPE (CASEQ C + ((#/.) 'STATEMENT) + ((#/!) 'EXCLAMATION) + ((#/?) 'QUESTION))) + (SETQ L (NREVERSE L)) + (RETURN (HUNK (CAR L) TYPE (CDR L)))) + ((= C #/?) ; Maybe he's confused... + (REDISPLAY L)))) + ((#\RETURN) + (COND ((= (CAR L) #\RETURN) + (OUTPUT-BIND + (DISPLAY '|Terminate your input with a '.' please.|)) + (POP L) + (REDISPLAY L)) + (T + (PUSH C L)))) + ((#\RUBOUT) + (COND (L (RUBOUT (POP L))))) + (T + (PUSH C L))))) + +(DEFUN SENTENCE-TYPE? (X) (CXR 2. X)) + +(DEFUN SET-SENTENCE-TYPE (X VAL) (RPLACX 2. X VAL) VAL) + +(DEFUN MAKE-WORD (X) + (COND ((NULL X) '||) + ((ATOM X) X) + ((NULL (CDR X)) (MAKE-WORD (CAR X))) + (T (CONCAT (MAKE-WORD (CAR X)) '| | (MAKE-WORD (CDR X)))))) + +(DEFUN READ-NOUN () + (LET ((A (READ-SENTENCE)) + (BAR) (FOO) (MOD) (MODS) (NOUN) (NOUNS) (PREP) + (PUNC) (REST) (STUFF)) + (DECLARE (SPECIAL FOO BAR STUFF NOUN PREP MOD + MODS PUNC REST PREP NOUNS)) + (COND ((INDETERMINATE-ANSWER? A) + (DISPLAY '"Oh well. Let's start a new game, then...") + (ABORT-ROUND)) + ((I-DONT-CARE-ANSWER? A) + (DISPLAY '"Hrrmmf! Then neither do I... I quit!") + (ABORT-ROUND))) + (COND ((MATCHES A + ((?= INTERJECTION? ) + (*= DELIMITER? ) + (* FOO ) + (?= NOUN? NOUN ) + (* BAR ))) + (SETQ A (APPEND FOO NOUN BAR)))) + (COND ((MATCHES A + ((* STUFF ) + (*= NOUN? NOUN ) + (?= DELIMITER? PUNC ) + (*))) + (SETQ A (APPEND STUFF NOUN)))) + (COND ((MATCHES A + ((*= MODIFIER? ) + (?= NOUN? ) + (?= STATE-OF-BEING-VERB? ) + (* REST ))) + (SETQ A REST))) + (COND ((MATCHES A + ((* STUFF ) + (?= NOUN? NOUN ) + (?= PREPOSITION? PREP ) + (*= MODIFIER? MODS ) + (*= NOUN? NOUNS ))) + (LET ((ANSWER (MAKE-WORD + (LIST* NOUN PREP (APPEND MODS NOUNS))))) + (PUTPROP ANSWER STUFF 'MODIFIERS) + ANSWER)) + ((MATCHES A + ((*= COMPARATIVE-ADJECTIVE? FOO ) + (*= COMPARATOR? BAR ) + (*= MODIFIER? MODS ) + (?= NOUN? NOUN ) + (* REST ))) + (LET ((ANSWER (MAKE-WORD (CONS NOUN REST))) + (REPLY (APPEND FOO BAR MODS))) + (COND ((MEMQ (CAR REPLY) '(A AN)) + (PUTPROP ANSWER (CDR REPLY) 'MODIFIERS)) + (T + (PUTPROP ANSWER REPLY 'MODIFIERS))) + ANSWER)) + ((I-DONT-CARE-ANSWER? A) + (DISPLAY '"Well, since you're so indifferent... I quit!") + (ABORT-ROUND)) + ((OR (NO-ANSWER? A) (YES-ANSWER? A)) + (DISPLAY '"That doesn't make any sense! I quit!") + (ABORT-ROUND)) + (T + (DISPLAY '"I don't understand.") + (READ-NOUN))))) + +(DEFUN QUERY (X) + (DISPLAY X) + (LET ((REPLY (READ-SENTENCE))) + (COND ((INDETERMINATE-ANSWER? REPLY) + (DISPLAY '|Please just answer 'YES' or 'NO'...|) + (QUERY X)) + ((QUIT-ANSWER? REPLY) (SUICIDE)) + ((YES-ANSWER? REPLY) T) + ((NO-ANSWER? REPLY) NIL) + (T + (DISPLAY '|I don't follow.|) + (QUERY X))))) + +(DEFUN PRINTC (X WHERE) (TERPRI WHERE) (PRINC X WHERE)) + +(DEFUN DELIMITER? (X) (MEMQ X '(/. /? /! // || /, /-))) + +(DEFUN NON-DELIMITER? (X) (NOT (DELIMITER? X))) + +(DEFUN OPEN-QUOTE-MARKS? (X) (MEMQ X '(/" |``|))) +(DEFUN CLOSE-QUOTE-MARKS? (X) (MEMQ X '(/" |''|))) + +(DEFUN END-OF-SENTENCE? (X) (MEMQ X '(/. /? /!))) + +(DEFUN DISPLAY-VERSION () + (CURSORPOS 'A TYO) + (PRINC '|Animal II (Version | TYO) + (PRINC (VERSION) TYO) + (PRINC '|)| TYO) + (TERPRI TYO)) + +(DEFUN DISPLAY1 (X SPACE-FLAG CASE-FLAG WHERE) + (COND (SPACE-FLAG + (COND ((< (CHARPOS WHERE) *FILL-COLUMN*) (TYO #\SPACE WHERE)) + (T (TERPRI WHERE))))) + (COND ((ATOM X) + (LET ((ALIAS (DISPLAY-ALIAS X))) + (COND (ALIAS (DISPLAY1 ALIAS NIL CASE-FLAG WHERE)) + (T + (PRINC (COND ((EQ X 'I) 'I) + (CASE-FLAG (CAPITALIZE X)) + ((PERSON-NAME? X) (CAPITALIZE X)) + (T (LOWERCASIFY X))) + WHERE))))) + (T + (DO ((SFLAG NIL T) + (CFLAG CASE-FLAG (COND ((END-OF-SENTENCE? (CAR L)) T) + (T NIL))) + (L X (CDR L))) + ((NULL L)) + (COND ((DELIMITER? (CAR L)) + (SETQ SFLAG NIL))) + (DISPLAY1 (CAR L) SFLAG CFLAG WHERE))))) + +(DEFUN DISPLAY-ALIAS (X) + (AND (SYMBOLP X) + (SELECT-ONE-OF (GET X 'DISPLAY-ALTERNATIVES)))) + +(DEFUN SELECT-ONE-OF (X) + (COND ((NULL X) NIL) + (T (NTH (RANDOM (LENGTH X)) X)))) + +(DEFUN SEND-MAIL (HEADER-INFO TEXT) + (LET ((TERPRI T)) + (IOTA ((OUTSTREAM '|.MAIL.;MAIL >| 'OUT)) + (PRINC '|From-Job:Animal II, Version | OUTSTREAM) + (PRINC (VERSION) OUTSTREAM) + (PRINTC '|Sent-By:ANIMAL| OUTSTREAM) + (PRINTC '|Header-Force:RFC733| OUTSTREAM) + (MAPC #'(LAMBDA (X) + (COND ((MEMQ (CAR X) '(TO: CC:)) + (TERPRI OUTSTREAM) + (ADDRESSEE-PRINC (CAR X) + (CDR X) + OUTSTREAM)) + (T + (PRINTC (CAR X) OUTSTREAM) + (DISPLAY1 (CDR X) NIL T OUTSTREAM)))) + HEADER-INFO) + (PRINTC '|Text;-1| OUTSTREAM) + (TERPRI OUTSTREAM) + (DISPLAY TEXT OUTSTREAM)))) + +(DEFUN ADDRESSEE-PRINC (TYPE X STREAM) + (LET ((MODES (CDR (ASSQ TYPE '((CC: (R-OPTION CC))))))) + (MAPCAR #'(LAMBDA (X) + (TERPRI STREAM) + (PRINC '|TO:| STREAM) + (PRINC (CONS X MODES) STREAM)) + X))) + +(DEFUN REMEMBER (X) + (CREATEF (MERGEF `(,(STATUS USERID) ,X) *MEMORY-AREA*))) + +(DEFUN REMEMBER? (X) + (PROBEF (MERGEF `(,(STATUS USERID) ,X) *MEMORY-AREA*))) + +(DEFUN FORGET (X) + (SLEEP 3.0) ;Sigh. Make sure archive device has enough time to get closed + (DELETEF (MERGEF `(,(STATUS USERID) ,X) *MEMORY-AREA*))) + +(DEFUN FORGIVE (X TEXT) + (COND ((REMEMBER? X) + (FORGET X) + (SEND-MAIL `((TO: KMP) + (CC: ,(STATUS USERID)) + (SUBJECT: (,(CONCAT *PLAYER-NAME* '|'s|) + "foul language!"))) + `("I have decided to forgive" ,*FIRST-NAME* + "for" ,TEXT "."))))) + +(DEFUN FRESHLINE (WHERE) + (COND ((NOT (= (CHARPOS WHERE) 0.)) + (TERPRI WHERE)))) + +(DEFUN DISPLAY (X &OPTIONAL (WHERE TYO)) + (SETQ *DISPLAY* (COND ((ATOM X) (NCONS X)) (T X))) + (FRESHLINE WHERE) + (DISPLAY1 X NIL T WHERE) + (PRINC '| | WHERE)) + +(DEFUN SLOW-PRINC (X) + (MAPCAR (FUNCTION (LAMBDA (C) (TYO C TYO) (SLEEP .15))) + (EXPLODEN X)) + T) + +(COMMENT Main Program Stuff) + +(DEFUN ANIMAL () + (*CATCH 'ANIMAL-SUICIDE + (PROGN (DISPLAY-VERSION) + (OFFER-INSTRUCTIONS) + (DO ((AGAIN (PLAY-AND-OFFER-NEW-ROUND) + (PLAY-AND-OFFER-NEW-ROUND))) + ((NOT AGAIN) (SUICIDE)))))) + +(DEFUN OFFER-INSTRUCTIONS () + (COND ((QUERY '"Do you want instructions?") + (PRINTF *INSTRUCTION-FILE* TYO)))) + +(DEFUN ABORT-ROUND-IF-NULL-ANSWER (X) + (COND ((NULL-ANSWER? X) + (DISPLAY '"Oh, well. Thanks anyway.") + (ABORT-ROUND)))) + +(DEFUN PLAY-AND-OFFER-NEW-ROUND () + (CATCH-ROUND-EXIT (GUESS-HIS-ANIMAL)) + (DISPLAY '"Thanks for the game.") + (QUERY '"Another game?")) + +(DEFUN INIT-MEMORY () *MEMORY*) + +(DEFUN GUESS-HIS-ANIMAL () + (LET ((MEMORY (INIT-MEMORY)) + (RESULT NIL)) + (COND ((SETQ RESULT (FAIL-TO-GUESS? MEMORY)) + (LEARN RESULT) + (COND (*SAVE-FILE* (SAVE *SAVE-FILE*))))))) + +(DEFUN FAIL-TO-GUESS? (*CURRENT-NODE*) + (COND ((TERMINAL-NODE? *CURRENT-NODE*) + (LET ((*OLD* *CURRENT-NODE*)) + (FINALLY-GUESS *OLD*))) + ((QUERY (LIST (EXTRACT-QUESTION *CURRENT-NODE*) '?)) + (FAIL-TO-GUESS? (EXTRACT-YES-BRANCH *CURRENT-NODE*))) + (T + (FAIL-TO-GUESS? (EXTRACT-NO-BRANCH *CURRENT-NODE*))))) + +(DEFUN FINALLY-GUESS (X) + (LET ((GUESS (EXTRACT-TERMINAL X))) + (COND ((QUERY `("I bet it's" ,(@ GUESS) ,GUESS ?)) NIL) + (T X)))) + +(DEFUN LEARN (X) + (DISPLAY '(WHAT ANIMAL WERE YOU THINKING OF ?)) + (LET ((NEW-ANIMAL (READ-NOUN))) + (ABORT-ROUND-IF-NULL-ANSWER NEW-ANIMAL) + (COND ((EQ NEW-ANIMAL (EXTRACT-TERMINAL X)) + (OUTPUT-BIND + (DISPLAY + '|That's what I just guessed. Stop fooling around.|)) + (ABORT-ROUND))) + (DISPLAY `(WHAT DISTINGUISHES ,(@ NEW-ANIMAL) ,NEW-ANIMAL FROM + ,(@ (EXTRACT-TERMINAL X)) ,(EXTRACT-TERMINAL X) ?)) + (LET ((NEW-QUESTION) + (OLD-NODE (COPY-NODE X)) + (NEW-NODE (CONSTRUCT-TERMINAL NEW-ANIMAL *PLAYER-NAME*))) + (LET ((*NEW* NEW-NODE) (*OLD* OLD-NODE)) + (DO ((N (READ-SENTENCE) (READ-SENTENCE))) + ((NOT (HANDLE-RANDOMNESS N)) + (SETQ NEW-QUESTION N)))) + (DISPLACE X (CONSTRUCT-QUESTION + (MAKE-QUESTION OLD-NODE NEW-NODE NEW-QUESTION) + OLD-NODE + NEW-NODE + *PLAYER-NAME*))))) + +(COMMENT Answer Types) + +(DEFUN NO-ANSWER? (X) + (MATCHES X ((*) (?= NEGATIVE?) (*)))) + +;;; Bug: (YES-ANSWER? ...) on "Sure, why not?" returns NIL. --Cstacy 7/11/82 + +(DEFUN YES-ANSWER? (X) + (AND (NOT (MEMQ 'NOT X)) + (OR (MATCHES X ((*) (?= AFFIRMATIVE?) (*))) + (MATCHES X ( (*= PREPOSITION?) SOME (?)) ; in some ways, + ; respects, ... + ; by some standards + ( (*) OF COURSE (*) ) + ( (*) (*= PRONOUN?) (?= DOES?) ) + ( (*) + (*= PRONOUN?) + (*= ADVERB?) + (?= STATE-OF-BEING-VERB?) ))))) + +(DEFUN NULL-ANSWER? (A) + (COND ((MEMQ A '(NOTHING NONE NIL)) + (DISPLAY '"OK, then. Just testing me, huh?") + T) + ((ANIMAL-PRONOUN? A) + (DISPLAY '"Grumble. Let's try to be more specific in the + future, ok?") + T) + ((MEMQ A '(|FORGET IT| |NEVER MIND| |SKIP IT|)) + (DISPLAY '"OK, be that way!") + T) + ((MEMQ A '(STOP QUIT DONE EXIT THROUGH BYE ABORT)) + (DISPLAY '"All right, but I win this one...") + T) + ((MEMQ A '(DOPPLEGANGER DOUBLE SAME TWIN IDENTICAL ALIAS)) + (DISPLAY '"Well, then, *I* win!") + T) + ((MEMQ A '(GOD JESUS CHRIST)) + (DISPLAY `(,A "is not an animal! Better luck next game.")) + T) + (T NIL))) + +(DEFUN HANDLE-RANDOMNESS (REPLY) + (OR (QUESTION-HANDLE? REPLY) + (STATEMENT-HANDLE? REPLY))) + +(DEFUN STATEMENT-HANDLE? (X) + (TRY-RULES-ONCE RANDOM-STATEMENTS X)) + +(DEFUN QUESTION-HANDLE? (X) + (OUTPUT-BIND + (COND ((QUESTION? X) + (COND ((TRY-RULES-ONCE QUESTIONS X)) + (T + (DISPLAY '"Sorry, I don't understand your question."))))) + (QUESTION? X))) + +(DEFUN QUESTION? (X) + (AND (OR (EQ (SENTENCE-TYPE? X) 'QUESTION) + (AND (INTERROGATIVE-WORD? (CAR X)) + (CDR X))) + T)) + +(DEFUN FOUL-ANSWER? (X) (MATCHES X ((*) (?= FOUL?) (*)))) + +(DEFUN HANDLE-FOUL-LANGUAGE (()) ;REPLY + (OUTPUT-BIND + (DISPLAY + (CASEQ *FOUL-FLAG* + ((0) '"Please watch your language.") + ((1) '"Hey! Watch your tongue. I warned you before.") + ((2) '"Will you watch it with the dirty talk? Thanks.") + (T '"Aw, come on. Stop talking so dirty..."))) + (SETQ *FOUL-FLAG* T) + (SETQ *APOLOGY-FLAG* NIL) + (SETQ *FOUL-COUNT* (1+ *FOUL-COUNT*)) + (COND ((> *FOUL-COUNT* *FOUL-COUNT-MAX*) + (SEND-MAIL `((TO: KMP) + (CC: ,(STATUS USERID)) + (SUBJECT: (,(CONCAT *PLAYER-NAME* '|'s|) + "Foul language!"))) + `(,*FIRST-NAME* "said terrible things to me. + I'm going to be pretty mad at" + ,*PLAYER-OBJECT-PRONOUN* "until" + ,*PLAYER-SUBJECT-PRONOUN* "apologizes.")) + (REMEMBER 'FOUL) + (DISPLAY '"I give up. You're hopeless!") + (SUICIDE))))) + +(DEFUN I-DONT-CARE-ANSWER? (X) + (MATCHES X + (YOU (*= MODIFIER?) (?= DOES?) NOT CARE (*)) + (YOU (*= MODIFIER?) (?= DOES?) NOT (?= WANT?) TO (?= DECIDE?) (*)))) + +(DEFUN INDETERMINATE-ANSWER? (X) + (MATCHES X ( (*) NOT KNOW (*) ) + ( (*) NOT SURE (*) ) + ( (*) NOT REMEMBER (*) ) + ( (*) NOT (?= UNDERSTAND?) (*) ) + ( (*) NOT SURE (*) ) + ( (*) (?= MAYBE?) (*)))) + +(DEFUN QUIT-ANSWER? (X) (MEMQ 'QUIT X)) + + + +(COMMENT Special part-of-speech predicates) + +(DEFUN INTERROGATIVE-WORD? (X) + (OR (VERB? X) (MEMQ X '(HOW WHAT WHEN WHERE WHY)))) + +(DEFUN STATE-OF-BEING-VERB? (X) + (LET ((PART-OF-SPEECH (PART-OF-SPEECH? X))) + (AND (NOT (ATOM PART-OF-SPEECH)) + (MEMQ 'BEING-VERB PART-OF-SPEECH)))) + +(DEFUN *OLD*-CK? (X) (EQ X (EXTRACT-TERMINAL *OLD*))) +(DEFUN *NEW*-CK? (X) (OR (PRONOUN? X) (EQ X (EXTRACT-TERMINAL *NEW*)))) + + +(COMMENT Clever A/An Hack) + +;;; (@ ) +;;; +;;; This is a carefully devised technique for telling whether to say +;;; A, AN or nothing before a given noun or string of words ... +;;; Returns A, AN or || ... + +(DEFUN @ (@-X) + (LET ((EXPLODED + (EXPLODEC (CAR (SETQ @-X (PARSE-INPUT (EXPLODEC @-X))))))) + (COND ((OR (= (LENGTH EXPLODED) 1.) + (APPLY 'OR (MAPCAR 'DIGIT? EXPLODED))) + (COND ((MEMQ (CAR EXPLODED) '(F H L M N S X)) 'AN) + (T 'A))) + ((AND (MEMQ 'THE @-X) + (DO ((L @-X (CDR L))) + ((NULL L) T) + (COND ((PREPOSITION? (CAR L)) (RETURN NIL))))) + '||) + ((MEMQ (CAR @-X) '(MIT $MAKE-COMPILER-HAPPY$)) 'AN) + ((OR (MEMQ (CAR EXPLODED) + '(B C D F G H J K L M N P Q R S T V W X Y Z)) + (AND (EQ (CAR EXPLODED) 'E) + (EQ (CADR EXPLODED) 'U)) + (MEMQ (CAR @-X) '(UNICORN UNIQUE UNICYCLE))) + 'A) + (T 'AN)))) + + +(COMMENT Making a Question) + +(DEFUN MAKE-QUESTION (*OLD* *NEW* SENTENCE) + (COND ((TRY-RULES-ONCE INTERPRETATIONS + (TRY-RULES TRANSFORMATIONS + (TRY-RULES EXITS SENTENCE)))) + (T + (OUTPUT-BIND (DISPLAY '"Sorry. I don't understand. Try again.")) + (MAKE-QUESTION *OLD* *NEW* (READ-SENTENCE))))) + +;; Person says he wants to quit, or doesn't know +;; what's going on, or otherwise seems lost -- Abort round. + +(DEF-EXIT APATHY (X) () + IF (MATCHES X ((?= FORGET?) IT) + (NOTHING) + (NONE) + (NEVER MIND) + ((*) + (?= *NEW*-CK?) + (*) + (?= STATE-OF-BEING-VERB?) + NOTHING)) + (INDETERMINATE-ANSWER? X) + (QUIT-ANSWER? X) + THEN (DISPLAY '"Well, all right. I guess I win...") + (ABORT-ROUND)) + +;; New animal means same as old animal? Abort round -- no new +;; animal to be learned. + +(DEF-EXIT SAME-MEANING (X) () + IF (MATCHES X + ((*= MODIFIER? ) + (?= ANIMAL-PRONOUN? ) + MEANS + (*= MODIFIER? ) + SAME + (*= COMPARATOR? ) + (*= MODIFIER? ) + (?= *NEW*-CK? ) + (* )) + ((*= MODIFIER? ) + (?= ANIMAL-PRONOUN? ) + (?= STATE-OF-BEING-VERB? ) + (*= MODIFIER? ) + SAME + (?= COMPARATOR? ) + (*= MODIFIER? ) + (?= *NEW*-CK? ) + (* ))) + THEN (DISPLAY '"If it means the same, then you shouldn't have + told me I hadn't guessed it.") + (ABORT-ROUND)) + +;; We do lousy with AND'd traits, so just give up if we see +;; that word lying around... + +(DEF-TRANSFORM MULTI (X) () + IF (MATCHES X ((*) AND (*))) + THEN (OUTPUT-BIND (DISPLAY '"Please, just tell me one of its traits.")) + (READ-SENTENCE)) + +;; Strip leading interjections, delimiters, etc. and reparse. + +(DEF-TRANSFORM STRIP-INTERJECTIONS (X) (FOO BAR) + IF (MATCHES X + ((?= INTERJECTION? ) + (*= DELIMITER? ) + (?= NON-DELIMITER? FOO ) + (* BAR ))) + THEN (CONS FOO BAR)) + +;; Simplify DO/DOES+ + +(DEF-TRANSFORM DOES+VERB (X) (FOO BAR VERB) + IF (MATCHES X ((* FOO) DOES (?= VERB? VERB) (* BAR))) + THEN (APPEND FOO (NCONS (VERB-SING? VERB)) BAR)) + +(DEF-TRANSFORM DO+VERB (X) (FOO BAR VERB) + IF (MATCHES X ((* FOO) DO (?= VERB? VERB) (* BAR))) + THEN (APPEND FOO (NCONS (VERB-PLURAL? VERB)) BAR)) + +;; Remove redundant negations + +(DEF-TRANSFORM NOTNOT (X) (FOO BAR) + IF (MATCHES X ((* FOO) NOT NOT (* BAR))) + THEN (APPEND FOO BAR)) + +;; New animal is a superclass of the old animal. +;; Swap the two animals and reparse (so that the new +;; 'new animal' will be a subclass and can share rules +;; with the other case (see next clause)). + +(DEF-TRANSFORM SUPERCLASS (X) () + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (*= MODIFIER? ) + (?= OKA? ) + OF + (*= MODIFIER? ) + (?= *OLD*-CK? )) + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (*= MODIFIER? ) + (?= AKO? ) + OF + (*= MODIFIER? ) + (?= *NEW*-CK? ))) + THEN (SWAP *OLD* *NEW*) + (TRANSFORM$SUBCLASS `(IT IS A KIND OF ,(EXTRACT-TERMINAL *OLD*)))) + +;; New animal is a kind of the old animal. Try to create +;; a balanced tree by finding another animal that's a subclass +;; of the old animal, and making them each hang off of one +;; side of the superclass. If the guy can only name one subclass +;; of this animal, then get snotty -- we only want proper +;; subclasses. + +(DEF-TRANSFORM SUBCLASS (X) () + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (*= MODIFIER? ) + (?= AKO? ) + OF + (*= MODIFIER? ) + (?= *OLD*-CK? )) + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (*= MODIFIER? ) + (?= OKA? ) + OF + (*= MODIFIER? ) + (?= *NEW*-CK? ))) + THEN (DISPLAY `("What's another animal that's a kind of" + ,(EXTRACT-TERMINAL *OLD*) ?)) + (LET ((OTHER (READ-NOUN))) + (ABORT-ROUND-IF-NULL-ANSWER OTHER) + (DISPLACE *OLD* (CONSTRUCT-TERMINAL OTHER *PLAYER-NAME*)) + (DISPLAY `("What distinguishes" ,(@ (EXTRACT-TERMINAL *NEW*)) + ,(EXTRACT-TERMINAL *NEW*) + "from" ,(@ OTHER) ,OTHER ?)) + (READ-SENTENCE))) + +;; If the guy just gives adjectives, he's probably implying +;; a verb as in "IT IS ..." Assume the implied pronoun is +;; the new animal and proceed. + +(DEF-TRANSFORM MISSING-VERB (X) (MODS) + IF (MATCHES X ((*= MODIFIER? MODS))) + THEN `(IT IS ,@MODS)) + +;; Reject overly short answers that haven't been +;; recognized by this point. + +(DEF-TRANSFORM INPUT-TOO-SHORT (X) () + IF (< (LENGTH X) 2.) + THEN (OUTPUT-BIND (DISPLAY '"Please be more explicit...")) + (READ-SENTENCE)) + +;; Don't let a comparative adjective slip by without a comparator + +(DEF-TRANSFORM MISSING-COMPARATOR (X) (ADJ) + IF (MATCHES X ((* ) + (?= (LAMBDA (X) (OR (COMPARATIVE-ADJECTIVE? X) + (EQ X 'MORE))) ; Funny comparatives + ADJ) + (*= (LAMBDA (X) (NOT (COMPARATOR? X))) ))) + THEN (OUTPUT-BIND + (DISPLAY `(,ADJ "than what?")) + (LET ((COMPLETION (READ-NOUN))) + `(,@X THAN ,(@ COMPLETION) ,COMPLETION)))) + +;; A IS THAN +;; + +(DEF-INTERPRETATION COMPARATIVE-ADJECTIVE (X) + (VERB ADJ MAYBE-ADJECTIVE X1 NOUN X2) ; Locals + IF (MATCHES X + ((*= MODIFIER? ) + (*= *NEW*-CK? ) + (?= VERB? VERB ) + (?= COMPARATIVE-ADJECTIVE? ADJ ) + (? MAYBE-ADJECTIVE ) + THAN + (* X1 ) + (?= NOUN? NOUN ) + (* X2 ))) + + ;; *** VERB should get looked at somewhere here + + THEN (FUNCALL (COND ((NOUN? MAYBE-ADJECTIVE) 'HAS-POSSESSION) + (T 'HAS-STATE)) + `(,ADJ ,MAYBE-ADJECTIVE THAN ,@X1 ,NOUN ,@X2))) + + +;; Input = A is NOT +;; Reverse the roles, remove the negation, and reparse. + +(DEF-TRANSFORM REMOVE-NEGATION (X) (FOO) + IF (MATCHES X + ((*= MODIFIER? ) + (?= ANIMAL-PRONOUN? ) + (?= STATE-OF-BEING-VERB? ) + NOT + (* FOO )) + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= STATE-OF-BEING-VERB? ) + NOT + (* FOO ))) + THEN (SWAP *OLD* *NEW*) + `(IT IS ,@FOO)) + +;; Input= A IS +;; Assume the all describes animal, and +;; attach it + the adjective as a general property. + +(DEF-INTERPRETATION HAS-PROPERTY (X) (ADJ) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (?= ADJECTIVE? ADJ ) + (* ))) + THEN (HAS-PROPERTY ADJ)) + +;; Input= An IS +;; Swap the and and retry the +;; parse since we already have rules for this case for +;; . + +(DEF-TRANSFORM OLD-IS (X) (ADJ FOO) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (?= ADJECTIVE? ADJ ) + (* FOO ))) + THEN (SWAP *OLD* *NEW*) + `(IT IS ,ADJ ,@FOO)) + +;; Input= IT HAS +;; Give a possession of + +(DEF-INTERPRETATION HAS-POSSESSION (X) (MODS NOUN) + IF (MATCHES X + ((*= MODIFIER? ) + (?= ANIMAL-PRONOUN? ) + (?= HAVE? ) + (*= MODIFIER? MODS ) + (?= NOUN? NOUN ))) + THEN (HAS-POSSESSION `(,@MODS ,NOUN))) + +;; Input= A NOT +;; or +;; A DOES NOT +;; +;; Assume that means that an does. +;; So swap the two names, and reparse without the NOT. + +(DEF-TRANSFORM INVERTED-DESCRIPTION (X) (VERB GUNK) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= MODAL? ) + NOT + (*= ADVERB? ) + (? VERB ) + (* GUNK )) + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= DOES? ) + NOT + (*= ADVERB? ) + (? VERB ) + (* GUNK ))) + THEN (PART-OF-SPEECH VERB 'ACTION-VERB) + (SWAP *OLD* *NEW*) + `(IT ,(VERB-SING? VERB) ,@GUNK)) + +;; Input= An DOES NOT +;; +;; Assume this means a does and reparse. + +(DEF-TRANSFORM OLD-ANIMAL-DOES-NOT (X) (VERB THING) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (?= DOES? ) + NOT + (*= ADVERB? ) + (? VERB ) + (* THING ))) + THEN (PART-OF-SPEECH VERB 'ACTION-VERB) + `(IT ,(VERB-SING? VERB) ,@THING)) + +;; Input= An NOT +;; + +(DEF-TRANSFORM OLD-ANIMAL-NEGATED-DESCRIPTION (X) (VERB BODY) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (? VERB ) + NOT + (* BODY ))) + ;; *** This might want to check NO as well -- eg, + ;; "A dog has no feet" or "A bird eats no wheat" + THEN `(IT ,VERB ,@BODY)) + +;; Input= A LIVES +;; +;; Attach as 's habitat. + +(DEF-INTERPRETATION HABITAT (X) (WHERE) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (*= ADVERB? ) + (?= STATE-OF-BEING-VERB? ) + (?= LIVES? ) + (* WHERE ))) + THEN (HAS-HABITAT WHERE)) + +;; An LIVES +;; +;; Swap old for new and reparse since there's a rule for +;; that case already. + +(DEF-INTERPRETATION OLD-ANIMAL-LIVES (X) (WHERE) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (*= ADVERB? ) + (?= STATE-OF-BEING-VERB? ) + (?= LIVES? ) + (* WHERE ))) + THEN (SWAP *OLD* *NEW*) + (HAS-HABITAT WHERE)) + +(DEF-INTERPRETATION HAS-STATE (X) (DESCRIPTION) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (* DESCRIPTION ))) + THEN (HAS-STATE DESCRIPTION)) + +(DEF-INTERPRETATION OLD-ANIMAL-HAS-STATE (X) (DESCRIPTION) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (?= STATE-OF-BEING-VERB? ) + (* DESCRIPTION ))) + THEN (SWAP *OLD* *NEW*) + (HAS-STATE DESCRIPTION)) + +(DEF-INTERPRETATION RANDOM-ACTION (X) (VERB OBJ) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (? VERB ) + (* OBJ ))) + THEN (HAS-ACTION `(,VERB ,@OBJ))) + +(DEF-INTERPRETATION OLD-ANIMAL-RANDOM-ACTION (X) (VERB OBJ) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *OLD*-CK? ) + (? VERB ) + (* OBJ ))) + THEN (SWAP *OLD* *NEW*) + (HAS-ACTION `(,VERB ,@OBJ))) + +(DEF-INTERPRETATION MAKES-NOISE (X) (NOISE) + IF (MATCHES X + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= MAKE-NOISE? ) + (?= OPEN-QUOTE-MARKS? ) + (? NOISE ) + (?= CLOSE-QUOTE-MARKS? )) + ((*= MODIFIER? ) + (?= *NEW*-CK? ) + (?= MAKE-NOISE? ) + (* NOISE ))) + THEN (MAKES-NOISE NOISE)) + +;;; Look for personal pronouns and confirm them... + +(DEF-TRANSFORM PRONOUN-CHECK (X) (FOO PRONOUN BAR) + IF (AND (MATCHES X ((* FOO) (?= PRONOUN? PRONOUN) (* BAR))) + (MEMQ PRONOUN '(HE SHE))) + THEN (LET ((FLAG (OUTPUT-BIND + (QUERY `("Does" ,PRONOUN "refer to" + ,(EXTRACT-TERMINAL *NEW*) ?))))) + (COND ((NOT FLAG) + (OUTPUT-BIND (DISPLAY '"Then I don't understand ...")) + (READ-SENTENCE)) + (T + `(,@FOO IT ,BAR))))) + + + +(DEFUN MAKE-INTO-AFFIRMATIVE-STATEMENT (X) + (RPLACA X 'YES) + (RPLACD X NIL) + (SET-SENTENCE-TYPE X 'STATEMENT)) + +(DEF-QUESTION HOW-MANY (X) (DFLAG) + IF (MATCHES X ((*) HOW MANY ($= DISTINCT? DFLAG) (?= ANIMALS?) (*))) + THEN (OUTPUT-BIND + (LET ((*NOPOINT T) (BASE 10.)) + (COND ((NOT DFLAG) + (LET ((N (COUNT-ANIMALS *MEMORY*))) + (DISPLAY (COND ((ZEROP N) '"None.") + ((= N 1.) '"Only one.") + (T `("I know of" ,N "animals.")))))) + (T + (LET ((N (LENGTH (LIST-DISTINCT-ANIMALS)))) + (DISPLAY (COND ((ZEROP N) '"None.") + ((= N 1.) '"Only one.") + (T `("I know of" ,N + "distinct animals.")))))))))) + +(DEF-QUESTION WHAT-ANIMALS (X) () + IF (MATCHES X (WHAT (?= ANIMALS?) DO YOU (*))) + THEN (OUTPUT-BIND + (LET ((LIST-OF-ANIMALS (LIST-DISTINCT-ANIMALS)) + (*NOPOINT T) + (BASE 10.)) + (DISPLAY-ANIMAL-LIST LIST-OF-ANIMALS)))) + +(DEFUN DISPLAY-ANIMAL-LIST (ANIMAL-LIST) + (SETQ ANIMAL-LIST (SORT (APPEND ANIMAL-LIST ()) 'ALPHALESSP)) + (COND ((NULL ANIMAL-LIST) + (DISPLAY '"I know of no animals!")) + ((NOT (CDR ANIMAL-LIST)) + (DISPLAY `("I only know of" ,(@ (CAR ANIMAL-LIST)) + ,(CAR ANIMAL-LIST) "."))) + (T + (LET ((TEMP (MAPCAR #'(LAMBDA (X) (LIST X '/,)) + (NREVERSE ANIMAL-LIST)))) + (RPLACD (CAR TEMP) NIL) + (RPLACD (CADR TEMP) (NCONS 'AND)) + (PUSH (NCONS '/.) TEMP) + (SETQ TEMP (APPLY 'NCONC (NREVERSE TEMP))) + (SETQ TEMP (APPEND '"I know the following animals:" TEMP)) + (DISPLAY TEMP))))) + +(DEFUN ELIMINATE-REDUNDANCY (L) + (COND ((NULL L) NIL) + (T (CONS (CAR L) + (ELIMINATE-REDUNDANCY (DELETE (CAR L) (CDR L))))))) + +(DEFUN LIST-DISTINCT-ANIMALS () + (LET ((*LIST* ())) + (DECLARE (SPECIAL *LIST*)) + (LIST-DISTINCT-ANIMALS-AUX *MEMORY*) + (ELIMINATE-REDUNDANCY *LIST*))) + +(DEFUN LIST-DISTINCT-ANIMALS-AUX (X) + (DECLARE (SPECIAL *LIST*)) + (COND ((TERMINAL-NODE? X) (PUSH (EXTRACT-TERMINAL X) *LIST*)) + (T (LIST-DISTINCT-ANIMALS-AUX (EXTRACT-YES-BRANCH X)) + (LIST-DISTINCT-ANIMALS-AUX (EXTRACT-NO-BRANCH X)))) + T) + +(DEFUN COUNT-ANIMALS (DATABASE) + (COND ((TERMINAL-NODE? DATABASE) 1.) + (T + (+ (COUNT-ANIMALS (EXTRACT-YES-BRANCH DATABASE)) + (COUNT-ANIMALS (EXTRACT-NO-BRANCH DATABASE)))))) + +(DEF-QUESTION WHO-SAID (X) () + IF (MATCHES X (WHO (*) (?= SAID?) (*))) + THEN (OUTPUT-BIND + (DISPLAY `(,(MAYBE-PRONOUNIFY (EXTRACT-AUTHOR *CURRENT-NODE*)) + "said that.")))) + +(DEFUN MAYBE-PRONOUNIFY (NAME) + (COND ((EQ NAME *PLAYER-NAME*) 'YOU) (T NAME))) + +(DEFUN MAYBE-UNPRONOUNIFY (NAME) + (COND ((EQ NAME 'I) *PLAYER-NAME*) (T NAME))) + +(DEF-QUESTION DID-I-SAY (X) (NAME) + IF (MATCHES X (DID (? NAME) (?= SAID?) (*))) + THEN (OUTPUT-BIND + (LET ((AUTHOR (EXTRACT-AUTHOR *CURRENT-NODE*)) + (NAME (MAYBE-UNPRONOUNIFY NAME))) + (COND ((EQ NAME AUTHOR) (DISPLAY '"Yes.")) + (T (DISPLAY + `("No," ,(MAYBE-PRONOUNIFY AUTHOR) "said that."))))))) + +(DEF-QUESTION MY-NAME (X) () + IF (MATCHES X (WHAT IS MY NAME (*)) (WHAT DID YOU CALL ME)) + THEN (OUTPUT-BIND + (DISPLAY `("Your full name is" ,*FULL-NAME* + "... I just call you" ,*NICK-NAME* "for short.")))) + +(DEF-QUESTION IS-GRASS-GREEN (X) () + IF (MATCHES X (IS ($= DETERMINER?) GRASS GREEN)) + THEN (TERPRI TYO) + (PRINC '|/Green,| TYO) (SLEEP .30) + (PRINC '|/ green,| TYO) (SLEEP .30) + (PRINC '|/ the| TYO) (SLEEP .15) + (PRINC '|/ grass| TYO) (SLEEP .15) + (PRINC '|/ is green...| TYO) + (TERPRI TYO) (SLEEP .50) + (PRINC '|/ On| TYO) (SLEEP .15) + (PRINC '|/ the| TYO) (SLEEP .15) + (PRINC '|/ far| TYO) (SLEEP .15) + (PRINC '|/ side| TYO) (SLEEP .15) + (PRINC '|/ of| TYO) (SLEEP .15) + (PRINC '|/ the| TYO) (SLEEP .3) + (PRINC '|/ hill...| TYO) + (MAKE-INTO-AFFIRMATIVE-STATEMENT X) + T) + +(DEF-QUESTION IS-THE-POPE- (X) () + IF (MEMBER X '((IS THE POPE CATHOLIC) + (IS THE POPE POLISH))) + THEN (TERPRI TYO) + (PRINC '|(You may have faith in it!)| TYO) + (MAKE-INTO-AFFIRMATIVE-STATEMENT X) + T) + +(DEF-QUESTION IS-THE-SKY-BLUE (X) () + IF (MATCHES X (IS THE SKY BLUE)) + THEN (TERPRI TYO) + (PRINC '|(When it isn't cloudy!)| TYO) + (MAKE-INTO-AFFIRMATIVE-STATEMENT X) + T) + +(DEF-QUESTION LISP-TRUTHS (X) () + IF (MATCHES X + (|(| NULL NIL |)|) + (|(| NOT NIL |)|)) + THEN (PRINTC '|TTTTTTTTTTT| TYO) + (PRINTC '|T TTT T| TYO) + (PRINTC '| TTT | TYO) + (PRINTC '| TTT | TYO) + (PRINTC '| TTT | TYO) + (PRINTC '| TTTTT | TYO) + (TERPRI TYO) + (MAKE-INTO-AFFIRMATIVE-STATEMENT X) + T) + +(DEF-QUESTION IS-WATER-WET (X) () + IF (MATCHES X (IS WATER WET)) + THEN (COND (*WATER-FLAG* + (TERPRI TYO) + (PRINC '|I guess i decided it was...| TYO)) + (T + (PRINTC '|(An interesting philosophical question!)| TYO) + (SLEEP 1.) + (SLOW-PRINC '|... hmmm ...|) + (SLEEP 2.) + (PRINTC '| If a drop of water falls in a forest| TYO) + (SLOW-PRINC '| and|) + (PRINTC '| no one feels it before it evaporates| TYO) + (TERPRI TYO) + (SLOW-PRINC '|... thinking ...|) + (SLEEP 5.) + (SETQ *WATER-FLAG* T) + (PRINC '| Yeah, I guess it usually is thought| TYO) + (TERPRI TYO) + (PRINC '|of as such...| TYO))) + (MAKE-INTO-AFFIRMATIVE-STATEMENT X) + T) + +(DEF-QUESTION IS-SNOW-WHITE (X) () + IF (MATCHES X (IS SNOW WHITE)) + THEN (TERPRI TYO) + (PRINC '|(Not in Boston, but most places it is!)| TYO) + (MAKE-INTO-AFFIRMATIVE-STATEMENT X) + T) + +(DEF-QUESTION WHAT-TIME-IS-IT (X) () + IF (MATCHES X (WHAT TIME IS IT)) + THEN (DISPLAY `("It is now" ,(CLOCK-TIME) ".")) + T) + +(DEF-QUESTION APOLOGY (X) () + IF (MATCHES X (WILL YOU (*) FORGIVE ME (*)) + (WILL YOU (*) ACCEPT (*) (?= APOLOGY?) (*))) + THEN (RECEIVE-APOLOGY) + T) + +(DEF-QUESTION WHEN-NEWS (X) () + IF (MATCHES X (WHEN (*) NEWS (*)) (WHAT TIME (*) NEWS (*))) + THEN (DISPLAY-NEWS-DATE)) + +(DEF-STATEMENT NO-APOLOGY (X) () + IF (MATCHES X ((*) (?= NOT?) (*) (?= APOLOGY?) (*))) + THEN (OUTPUT-BIND (DISPLAY '"Hmmmm....")) + T) + +(DEF-STATEMENT MISTAKE (X) () + IF (MATCHES X + ((*) I (*) MADE (*) (?= MISTAKE?) (*)) + ((*) I (*) (?= SCREWED?) UP (*))) + THEN (OUTPUT-BIND + (DISPLAY '"Well, let's forget this round and start anew, then.") + (ABORT-ROUND))) + +(CONTRACTION '(MIS-SPELLED MISSPELLED)) +(CONTRACTION '(MIS-SPELED MISSPELLED)) +(CONTRACTION '(MISPELLED MISSPELLED)) +(CONTRACTION '(MISPELED MISSPELLED)) +(CONTRACTION '(MISSPELED MISSPELLED)) + +(DEF-STATEMENT CORRECT-TYPO (X) (WHO WORD) + IF (MATCHES X + ((? WHO) MISSPELLED (? WORD)) + ((? WORD) IS MISSPELLED (*)) + ((? WORD) IS SPELLED (?= WRONG?) (*))) + THEN (LET ((B1 (CORRECT-TYPO-IN-CODE WORD (LIST *OLD* *NEW*))) + (B2 (CORRECT-TYPO-IN-CODE WORD *DISPLAY*))) + (OUTPUT-BIND + (DISPLAY (COND ((OR B1 B2) '"Ok. I'll remember that.") + (T '"I don't see it ..."))))) + T) + +(DEF-STATEMENT TWO-WORDS (X) (WORD PHRASE) + IF (MATCHES X + ((? WORD) SHOULD BE (*) TWO WORDS) + (THE WORD (? WORD) SHOULD BE (* PHRASE))) + THEN (*CATCH 'EXIT-TWO-WORDS + (COND + ((EXPAND-WORDS-IN-CODE + WORD + (OR PHRASE + (OUTPUT-BIND + (DISPLAY '"What should it be?") + (LET ((PHRASE (READ-SENTENCE))) + (COND ((OR (NULL-ANSWER? PHRASE) + (QUIT-ANSWER? PHRASE) + (YES-ANSWER? PHRASE) + (NO-ANSWER? PHRASE)) + (DISPLAY '"Oh, well...") + (*THROW 'EXIT-TWO-WORDS NIL)) + (T PHRASE)))))) + (OUTPUT-BIND (DISPLAY '"I'll remember that."))) + (T + (OUTPUT-BIND (DISPLAY '"I don't see it..."))))) + T) + +(DEFUN EXPAND-WORDS-IN-CODE (WORD PHRASE) + (*CATCH 'ABORT-CORRECTION + (LET ((WHERE (FIND-TYPO WORD *DISPLAY*))) + (COND (WHERE + (RPLACA WHERE PHRASE) + (COND (*SAVE-FILE* (SAVE *SAVE-FILE*))))) + T))) + +(DEFUN CORRECT-TYPO-IN-CODE (X WHERE) + (*CATCH 'ABORT-CORRECTION + (LET ((TYPO (FIND-TYPO X WHERE))) + (COND (TYPO + (RPLACA TYPO X) + (COND (*SAVE-FILE* (SAVE *SAVE-FILE*))))) + T))) + +(DECLARE (SPECIAL *TYPOS*)) + +(DEFUN FIND-TYPO (X WHERE) + (LET ((*TYPOS* NIL)) + (FIND-TYPO-AUX X WHERE) + (SETQ *TYPOS* (SORTCAR *TYPOS* '>)) + (COND ((AND *TYPOS* (> (CAAR *TYPOS*) 0.5)) + (CDAR *TYPOS*)) + (T + (*THROW 'ABORT-CORRECTION NIL))))) + +(DEFUN FIND-TYPO-AUX (X Y) + (COND ((ATOM Y) NIL) + ((ATOM (CAR Y)) + (PUSH (CONS (TYPO-MATCH X (CAR Y)) Y) *TYPOS*) + (FIND-TYPO-AUX X (CDR Y))) + (T + (FIND-TYPO-AUX X (CAR Y)) + (FIND-TYPO-AUX X (CDR Y))))) + +(DEFUN GET-CHARN (X I FLAT) + (COND ((OR (< I 1) (> I FLAT)) -1.) + (T (GETCHARN X I)))) + +(DEFUN TYPO-MATCH (X Y) + (LET* ((FACTOR 0.0) + (RATING 0.0) + (XEND (FLATC X)) + (YEND (FLATC Y)) + (QTY (//$ 1.0 (FLOAT (MIN XEND YEND))))) + (SETQ FACTOR + (-$ 1.0 (//$ (ABS (FLOAT (- XEND YEND))) + (FLOAT (MAX XEND YEND))))) + (DO ((I 1. (1+ I)) (YC)) + ((OR (> I XEND) (> I YEND))) + (COND ((= (GETCHARN X I) (SETQ YC (GETCHARN Y I))) + (SETQ RATING (+$ RATING QTY))) + ((OR (= (GET-CHARN X (1- I) XEND) YC) + (= (GET-CHARN X (1+ I) XEND) YC)) + (SETQ RATING (+$ (*$ QTY 0.6) RATING))) + ((OR (= (GET-CHARN X (- I 2) XEND) YC) + (= (GET-CHARN X (+ I 2) XEND) YC)) + (SETQ RATING (+$ (*$ QTY 0.3) RATING))))) + (*$ FACTOR RATING))) + +(DEFUN INTERJECTION-ONLY? (X) + (AND (NOT (AFFIRMATIVE? X)) + (NOT (NEGATIVE? X)) + (INTERJECTION? X))) + +(DEF-STATEMENT INTERJECTION-ONLY (X) () + IF (MATCHES X ((?= INTERJECTION-ONLY?) (*= INTERJECTION-ONLY?))) + THEN (OUTPUT-BIND (DISPLAY '|Yup. That's life...|)) + T) + +(DEF-QUESTION MAD (X) () + IF (MATCHES X (ARE YOU (*) (?= ANGRY?) (?= PREPOSITION?) ME (*)) + (ARE YOU (*) (?= ANGRY?))) + THEN (COND (*FOUL-FLAG* + (COND (*FORGIVE-FLAG* + (COND (*APOLOGY-FLAG* + (DISPLAY '"Yes, I am still a bit mad.")) + (T + (DISPLAY '"Yes, I am very mad. Your + language has really been in the + gutter today.")))) + (T + (DISPLAY '"Yes. Your language has been atrocious.")))) + (*FORGIVE-FLAG* + (DISPLAY '"No, but I was earlier!")) + (*APOLOGY-FLAG* + (DISPLAY '"You should really see someone about this. No, + I'm really not mad at you. I wish you'd stop + apologizing for nothing...")) + (T + (DISPLAY '"I have nothing to be mad at you for."))) + T) + +(DEFUN NOT? (X) (EQ X 'NOT)) +(DEFUN NOTNOT? (X) (NOT (EQ X 'NOT))) + +(DEF-STATEMENT APOLOGY (X) () + IF (MATCHES X (I (*= NOTNOT?) (?= APOLOGY?) (*))) + THEN (OUTPUT-BIND (RECEIVE-APOLOGY)) + T) + +(DEFUN RECEIVE-APOLOGY () + (COND ((AND (NOT *FOUL-FLAG*) (NOT *FORGIVE-FLAG*)) + (COND ((NOT *APOLOGY-FLAG*) + (DISPLAY + (SELECT-ONE-OF '("I don't know why you are apologizing." + "You don't owe me an apology.")))) + (T + (DISPLAY + (SELECT-ONE-OF '("All right! Stop apologizing." + "You got some sort of guilt complex?" + "Perhaps you should see a priest."))))) + (SETQ *APOLOGY-FLAG* T)) + ((NOT *FOUL-FLAG*) + (DISPLAY + (SELECT-ONE-OF '("I forgave you already!" + "Yes, yes. I forgave you!"))) + (SETQ *APOLOGY-FLAG* T)) + ((NOT *FORGIVE-FLAG*) + (DISPLAY '"All right. I accept your apology...") + (SETQ *FOUL-FLAG* NIL) + (SETQ *FORGIVE-FLAG* T) + (FORGIVE 'FOUL '"using foul language")) + ((NOT *APOLOGY-FLAG*) + (DISPLAY '"Sorry, I gave you your chance and you blew it.") + (SETQ *APOLOGY-FLAG* T)) + (T + (DISPLAY + (SELECT-ONE-OF + '("OK. Since you're being so insistent. I accept + your apology" + "OK. That sounds sincere to me."))) + (SETQ *APOLOGY-FLAG* NIL) + (SETQ *FOUL-FLAG* NIL) + (SETQ *FORGIVE-FLAG* T) + (FORGIVE 'FOUL '"using foul language")))) + +(COMMENT Meanings) + +(DEFMACRO DEF-MEANING (MEANING &REST WORDS) + `(PROGN 'COMPILE + (DEFUN ,(CONCAT MEANING '?) (X) + (MEMQ ',MEANING (GET X 'MEANINGS))) + ,@(MAPCAR #'(LAMBDA (WORD) + `(ADDPROP ',WORD ',MEANING 'MEANINGS)) + WORDS))) + +(DEF-MEANING DISTINCT + DISTINCT UNIQUE INDIVIDUAL SPECIFIC) + +(DEF-MEANING SAID + TELL TOLD SAY SAID TEACH TAUGHT SHOW SHOWED) + +(DEF-MEANING MISTAKE + MISTAKE ERROR) + +(DEF-MEANING MALE + MALE GUY MAN BOY MASCULINE) + +(DEF-MEANING FEMALE + FEMALE GAL WOMAN GIRL FEMININE) + +(DEF-MEANING WRONG + WRONG INCORRECTLY BADLY POORLY) + +(DEF-MEANING AKO ; A-Kind-Of (Subclass) + CLASS SUBCLASS KIND TYPE VARIETY SUBSET VARIATION MUTATION + SORT DESCENDENT BRANCH SPECIES BREED OFFSPRING CHILD BABY) + +(DEF-MEANING OKA ; Opposite of AKO (Superclass) + ANCESTOR SUPERSET PARENT SUPERCLASS PREDECESSOR) + +(DEF-MEANING SCREWED + SCREWED LOUSED MESSED BOTCHED) + +(DEF-MEANING LIVES + LIVE LIVES FOUND LIVING) + +(DEF-MEANING UNDERSTAND + UNDERSTAND FOLLOW SEE COMPREHEND) + +(DEF-MEANING FORGET + SKIP FORGET) + +(DEF-MEANING LEARN + LEARN FIND GET HEAR SEE) + +(DEF-MEANING DOES + DO DID DOES) + +(DEF-MEANING WANT + WISH WANT DESIRE CHOOSE) + +(DEF-MEANING DECIDE + DECIDE CHOOSE PICK SAY ANSWER) + +(DEF-MEANING MAKE-NOISE + SAID SAY SAYS GO GOES) + +(DEF-MEANING ME + ME) + +(DEF-MEANING HOST + TIP SITE HOST SYSTEM TERMINAL TTY CRT) + +(DEF-MEANING WINNING + WINNING SMART GOOD) + +(DEF-MEANING LOGGED + LOGGED LINKED ATTACHED) + +(DEF-MEANING TAUGHT + TAUGHT TEACHES TEACH SAYS SAY SAID TELL TELLS + TOLD EXPLAINED EXPLAIN EXPLAINS SHOWED SHOW SHOWS) + +(DEF-MEANING ERROR-WORD + MISTAKE TYPO TYPOS MISTAKES ERROR ERRORS GOOF GOOFS + PROBLEM PROBLEMS) + +(DEF-MEANING KIDDING + KIDDING JOKING) + +(DEF-MEANING HAVE + HAS HAD HAVE) + +(DEF-MEANING MAYBE + MAYBE PERHAPS SOMETIMES OCCASIONALLY POSSIBLY) + +(DEF-MEANING ANIMALS + ANIMALS BEASTS CREATURES) + +(DEF-MEANING ANIMAL-PRONOUN + IT THEY ANIMAL BEAST CREATURE THAT THOSE THIS THESE THAT ONE) + +(DEF-MEANING NEGATIVE + NO NEGATORY NAH BAD HUH-UH HUHUH UNTRUE SELDOM NOPE NOT + FALSE NEGATIVE NA NEVER NIL N) + +(DEF-MEANING AFFIRMATIVE + YES SURE YEAH COOL FINE TRUE RIGH UHHUH YEP P T Y + ROGER YEA YA GOOD PROBABLY CORRECT HYPOTHETICALLY OK OKAY + UHHUH UHUH UH-HUH OUI DA PROCEED GREAT CONTINUE DO MORE ABSOLUTELY + UNQUESTIONABLY APPROXIMATELY MOSTLY PRACTICALLY DEFINITELY + CERTAINLY POSITIVELY SURELY AFFIRMATIVE) + +(DEF-MEANING APOLOGY + SORRY APOLOGIZE APOLOGY APOLOGIES) + +(DEF-MEANING ANGRY + ANGRY SORE ANNOYED MAD UPSET PISSED) + +(DEF-MEANING FOUL + ANUS ANUSES ASSHOLE ASSHOLES + BASTARD BASTARDS BITCH BITCHES BOOB BOOBS + COCK COCKS COMMIE COMMIES CRAP CRAPPY CROTCH CROTCHES + CRUD CRUDDY CUNT CUNTS CUNILINGUS CUNNILINGUS + DAMN DAMNED DAMMIT DICK DICKS DILDO DILDOS DILDOES DOPE DOPES + DUMMY DUMMIES DUMDUM DUMDUMS DUMBDUMB DUMBDUMBS + DUM-DUM DUM-DUMS DUMB-DUMB DUMB-DUMBS + FAG FAGS FAGGOT FAGGOTS FART FARTHEAD FARTS + FELLATIO FELATIO FORNICATE FORNICATES FORNICATED FORNICATING + FORNICATION FUCK FUCKS FUCKED FUCKED-UP FUCKING + FUCKER FUCKERS FUCKHEAD FUCKHEADS FUCKWAD FUCKWADS + GAY GAYS GODAM GODAMN GODAMNED GODDAM GODDAMN GODDAMNED + GOD-DAM GOD-DAMN GOD-DAMNED + HELL + KIKE + LICK LICKED LICKING + MOTHER-FUCKING MOTHERFUCKING MOTHERFUCKER MOTHERFUCKERS + MOTHER-FUCKER MOTHER-FUCKERS + NIGGER + ORGASM ORGASMS ORGASMIC + PENIS PIMP PIMPS PIMPING PIMPED PINKO PINKOS PISS PISSES PISSHEAD + POLACK POLOCK POLOK POLLACK POLLOCK POLLOK PRICK PRICKS PROSTITUTE + PROSTITUTES PROSTITUTION PUSSY PUSSIES + QUEER + SCREW SCREWS SCREWED SCROD SCREWED SHIT SHITS SHITHEAD SHITHEADS + SIXTY-NINE SIXTYNINE /69 SOB SONOFABITCH SON-OF-A-BITCH + STUPID SUCK SUCKS SUX SUCKING SUCKED SUCKER SUCKERS + TIT TITS + WHORE WHORES WOP) + + +(COMMENT Display Definitions) + +;;; Database constructors + +(DEFMACRO DEF-CONCEPT (FORM &REST DISPLAY-FORMS) + `(PROGN 'COMPILE + (DEFUN ,FORM (X) + (COND ((ATOM X) (LIST ',FORM X)) + (T (CONS ',FORM X)))) + (DEFPROP ,FORM ,DISPLAY-FORMS DISPLAY-ALTERNATIVES))) + +(DEF-CONCEPT MAKES-NOISE + "Does it say" + "Does it go" + "Does it make noises like") + +(DEF-CONCEPT HAS-PROPERTY + "Is it" + "Would you say it is" + "Is your animal" + "Can it be described as") + +(DEF-CONCEPT HAS-STATE + "Is your animal" + "Is it") + +(DEF-CONCEPT ARE-YOU-THINKING-OF + "Are you thinking of" + "Were you thinking of" + "Is your animal" + "Is the animal you are thinking of") + +(DEF-CONCEPT HAS-POSSESSION + "Does it have" + "Has it got" + "Does your animal have") + +(DEF-CONCEPT HAS-ABILITY + "Can it" + "Does it have the ability to" + "Could it normally" + "Does your animal commonly") + +(DEF-CONCEPT HAS-CLASSIFICATION + "Is it a kind of" + "Is your animal some type of" + "Is it some class of") + +(DEF-CONCEPT HAS-ACTION + "Is it true that it" + "Could i say it" + "Would you say that it") + +(DEF-CONCEPT HAS-HABITAT + "Is it found" + "Does it live" + "Is it at home" + "Is its habitat") + + + +(COMMENT Saving and Restoring Database) + +(DEFUN SAVE (FILENAME) + (IOTA ((OUTSTREAM (MERGEF '|_ANIM_ OUTPUT| FILENAME) '(OUT))) + (PRINT *MEMORY* OUTSTREAM) + (RENAMEF OUTSTREAM FILENAME) + (CLOSE OUTSTREAM) + 'DONE)) + +(DEFUN UNSAVE (FILENAME) + (IOTA ((INSTREAM FILENAME '(IN))) + (SETQ *MEMORY* (READ INSTREAM)) + 'DONE)) + +(DEFUN DUMP (FILENAME) + (SSTATUS FLUSH T) + (GC) + (SSTATUS TOPLEVEL '(ANIMAL)) + (NOINTERRUPT T) + (SUSPEND '|:KILL | FILENAME) + (SETUP-FOR-ANIMAL)) + +(DEFUN SETUP-FOR-ANIMAL () + (COND ((NOT (SETUP-USERNAME-VARS)) + (PRINC + '|Hey! You should run :INQUIR. I don't play with strangers.| + TYO) + (SUICIDE))) + (CLEAR-INPUT TYI) + (PRINTC '|Howdy, | TYO) + (PRINC (CAPITALIZE *NICK-NAME*) TYO) + (PRINC '|. Welcome to the ANIMAL game.| TYO) + (NOTES) + (LET ((INIT (PROBEF `((DSK ,(STATUS HSNAME)) ,(STATUS USERID) ANIMAL)))) + (COND (INIT + (PRINTC '|Loadin' up your init.| TYO) + (LOAD INIT) + (PRINC '|.. All set.| TYO)))) + (COND ((SETQ *FOUL-FLAG* (REMEMBER? 'FOUL)) + (DISPLAY '"By the way -- we weren't + on good terms the last time we played. + I hope you have learned your lesson now."))) + (UNSAVE *SAVE-FILE*) + (NOTIFY-KMP) + (DISABLE-INTERRUPTS) + (NOINTERRUPT NIL) + (NEWS)) + +(DEFUN SETUP-USERNAME-VARS () + (*CATCH 'EARLY-EXIT + (PROGN + (OPEN-INQUIR-FILE) + (LET ((((LAST FIRST MIDDLE) TITLE LINEAGE NIL NICKNAME) + ;((LAST FIRST MIDDLE) TITLE LINEAGE ALIAS? NICKNAME) + (LET ((VAL (GET-USER-NAME (STATUS USERID)))) + (COND ((NOT VAL) (*THROW 'EARLY-EXIT NIL)) (T VAL))))) + (SETQ *PLAYER-NAME* (STATUS USERID)) + (SETQ *FULL-NAME* (CONCAT (CAPITALIZE FIRST) '| | + (CAPITALIZE LAST))) + (UPDATE-NAME-DATABASE FIRST MIDDLE LAST TITLE LINEAGE) + (SETQ *FIRST-NAME* FIRST) + (SETQ *NICK-NAME* (OR NICKNAME FIRST)) + (SETQ *LAST-NAME* LAST)) + (CLOSE-INQUIR-FILE) + T))) + +(DEFUN UPDATE-NAME-DATABASE (FIRST MIDDLE () () ()) ; Last Title Lineage + (LET ((FIRST (UPPERCASIFY FIRST)) + (MIDDLE (UPPERCASIFY MIDDLE))) + (COND ((REMEMBER? 'MALE) (PLAYER-IS-MALE)) + ((REMEMBER? 'FEMALE) (PLAYER-IS-FEMALE)) + ((NOT (PERSON-NAME? (UPPERCASIFY FIRST))) + (COND ((PERSON-NAME? MIDDLE) + (COND ((MALE-NAME? MIDDLE) + (PLAYER-IS-MALE)) + (T + (PLAYER-IS-FEMALE)))) + (T + (ASK-SEX FIRST NIL)))) + ((AND (MALE-NAME? FIRST) (FEMALE-NAME? FIRST)) + (COND ((PERSON-NAME? MIDDLE) + (COND ((MALE-NAME? MIDDLE) + (PLAYER-IS-MALE)) + (T + (PLAYER-IS-FEMALE)))) + (T + (ASK-SEX FIRST T)))) + ((MALE-NAME? FIRST) (PLAYER-IS-MALE)) + ((FEMALE-NAME? FIRST) (PLAYER-IS-FEMALE)) + (T + (BUG '"My sex-determination algorithm fell through." T) + (PLAYER-IS-MALE) ; Highly chauvanistic but prevents + ; more lossage later... + )))) + +(DEFUN BUG (TEXT RECOVERABLE?) + (OUTPUT-BIND + (DISPLAY '"Hang on, I seem to have a bug...") + (SEND-MAIL `((TO: KMP) + (CC: ,(STATUS USERID)) + (SUBJECT: "A bug!")) + `("Ooops, I have a bug..." ,TEXT)) + (COND (RECOVERABLE? + (DISPLAY '"Ok, all set. I sent KMP some mail about it.")) + (T + (DISPLAY TEXT) + (DISPLAY '"Looks bad. I better quit. I sent KMP mail about + it but if you noticed anything odd about this + circumstance, maybe you could send him mail, too. + Thanks.") + (SUICIDE))))) + +(DEFUN ASK-SEX (NAME AMBIGUITY) + (OUTPUT-BIND + (COND ((NOT AMBIGUITY) + (DISPLAY `("Gee, I've never met anyone with the name" + ,NAME "before. I'm afraid that means I also don't + know if you are a guy or a girl... which are you?"))) + (T + (DISPLAY `("Hey, I hate to ask this because you probably + get asked all the time, but a name like" ,NAME + "is kinda ambiguous... Are you a guy or a girl?")))) + (DO ((ANSWER (READ-SENTENCE) (READ-SENTENCE))) + (NIL) + (COND ((HANDLE-RANDOMNESS ANSWER)) + ((MATCHES ANSWER ((*) NOT (*) (?= FEMALE?) (*)) + ((*) (?= MALE?) (*))) + (REMEMBER 'MALE) + (PLAYER-IS-MALE) + (RETURN T)) + ((MATCHES ANSWER ((*) NOT (*) (?= MALE?) (*)) + ((*) (?= FEMALE?) (*))) + (REMEMBER 'FEMALE) + (PLAYER-IS-FEMALE) + (RETURN T)) + ((YES-ANSWER? ANSWER) + (DISPLAY '"Can you be more specific?")) + ((NO-ANSWER? ANSWER) + (DISPLAY '"I find that hard to believe...")) + ((INDETERMINATE-ANSWER? ANSWER) + (DISPLAY '"You can confide in me...")) + ((I-DONT-CARE-ANSWER? ANSWER) + (DISPLAY '"Well, I care! Please tell me.")) + ((QUIT-ANSWER? ANSWER) + (DISPLAY '"Well, if you insist...") + (SUICIDE)) + (T + (DISPLAY '"I don't follow."))) + (DISPLAY '"Are you male or female?")))) + +(DEFUN PLAYER-IS-MALE () + (SETQ *PLAYER-OBJECT-PRONOUN* 'HIM) + (SETQ *PLAYER-SUBJECT-PRONOUN* 'HE)) + +(DEFUN PLAYER-IS-FEMALE () + (SETQ *PLAYER-OBJECT-PRONOUN* 'HER) + (SETQ *PLAYER-SUBJECT-PRONOUN* 'SHE)) + +(DEFUN DISABLE-INTERRUPTS () + (COND ((NOT *DEBUG*) + (DO ((I 0. (1+ I))) + ((= I 127.)) + (SSTATUS TTYINT I NIL)) + (SSTATUS TTYINT 7. 7.) + T) + (T NIL))) + +;; Die quietly -- Lisp seems to do it wrong + +(DECLARE (*EXPR QUIET-DEATH)) + +(LAP QUIET-DEATH SUBR) +(*LOGOU 1) +() + +(DEFUN SUICIDE () + (COND ((NOT *DEBUG*) (QUIET-DEATH)) + (T + (SSTATUS TOPLEVEL NIL) + (LET ((ERRSET NIL)) + (OR (ERRSET (*THROW 'ANIMAL-SUICIDE 'SUICIDE) NIL) + (^G)))))) + +(DEFUN NOTES () + (COND ((PROBEF *NOTES-FILE*) + (DISPLAY '"Special notice...") + (PRINTF *NOTES-FILE* TYO)))) + +(DEFUN NEWS () + (COND ((AND (PROBEF *NEWS-FILE*) + (PROGN (DISPLAY-NEWS-DATE) + (QUERY '"Read news?"))) + (LET ((OLD-^S (STATUS TTYINT #/))) + (*CATCH 'FLUSH + (UNWIND-PROTECT + (PROGN + (SSTATUS TTYINT #/ + #'(LAMBDA (() ()) (*THROW 'FLUSH T))) + (PRINTF *NEWS-FILE* TYO)) + (SSTATUS TTYINT #/ OLD-^S)))) + T))) + +(DEFUN DISPLAY-NEWS-DATE () + (LET ((*NOPOINT T) (BASE 10.) (FILE-INFO)) + (IOTA ((INSTREAM *NEWS-FILE* 'IN)) + (SETQ FILE-INFO ; 4th word has file credate info + (NTH 3. (SYSCALL 4. 'FILBLK INSTREAM)))) + (CURSORPOS 'A TYO) + (PRINC '|News last updated | TYO) + (PRINC (LOAD-BYTE FILE-INFO 23. 4.) TYO) ;Month = 3.9 - 3.6 + (PRINC '// TYO) + (PRINC (LOAD-BYTE FILE-INFO 18. 5.) TYO) ;Day = 3.5 - 3.1 + (PRINC '// TYO) + (PRINC (LOAD-BYTE FILE-INFO 27. 7.) TYO) ;Year = 4.7 - 4.1 + (PRINC '|.| TYO))) + +(DEFUN NOTIFY-KMP () + (COND ((EQ (STATUS USERID) 'KMP) + (SETQ *DEBUG* T) ; Enable debugging + (SETQ PRIN1 'PRIN2)) ; Special printer for debugging + ((PROBEF '((USR *) KMP HACTRN)) + (ERRSET (IOTA ((STREAM '((CLI *) KMP HACTRN) '(OUT))) + (PRINC '|/ÛMessage from The Animal Game at MIT-MC | + STREAM) + (PRINC (CLOCK-TIME) STREAM) + (PRINC '|]| STREAM) + (TERPRI STREAM) + (PRINC (STATUS UNAME) STREAM) + (PRINC '| is gonna play against me!| STREAM) + (TERPRI STREAM)) + NIL)))) + +;;; Redefine PRIN1 to print out input forms nicer. + +(DEFUN SPECIAL-PRIN1 (WHAT WHERE) + (COND ((NULL WHAT) (PRINC '|()| WHERE)) + ((ATOM WHAT) (PRIN1 WHAT)) + ((AND (HUNKP WHAT) (= (HUNKSIZE WHAT) 3.)) + (PRINC '|{| WHERE) + (DISPLAY1 (CXR 2. WHAT) NIL T WHERE) + (PRINC '|: "| WHERE) + (DISPLAY1 (CONS (CAR WHAT) (CDR WHAT)) NIL T WHERE) + (PRINC '|"}| WHERE)) + (T + (PRINC '|(| WHERE) + (DO ((L WHAT (CDR L))) + ((ATOM L) + (COND ((NULL L) (PRINC '|)| WHERE)) + (T (PRINC '|. | WHERE) + (PRINC L WHERE) + (PRINC '|)| WHERE)))) + (SPECIAL-PRIN1 (CAR L) WHERE) + (COND ((CDR L) (PRINC '| | WHERE)))))) + T) + +(DEFUN PRIN2 (X &OPTIONAL (WHERE TYO)) + (SPECIAL-PRIN1 X WHERE)) + + +;;; Local Modes:: +;;; Comment Column:60: +;;; Comment Begin:; : +;;; Comment Start:;: diff --git a/src/games/animal.bare b/src/games/animal.bare new file mode 100644 index 00000000..f8aac8fa --- /dev/null +++ b/src/games/animal.bare @@ -0,0 +1 @@ +(SETQ MEMORY '(DOG (-> KMP))) diff --git a/src/games/animal.bugs b/src/games/animal.bugs new file mode 100644 index 00000000..c134c8f1 --- /dev/null +++ b/src/games/animal.bugs @@ -0,0 +1,3474 @@ +Date: 4 March 1983 09:57 EST +From: Communications Satellite +Subject: Msg of Friday, 4 March 1983 06:20 EST +To: ANIMAL @ MIT-MC + +Queued msg sent to: Bets at MIT-OZ + +Date: 4 March 1983 06:22 EST +From: Communications Satellite +Subject: Msg of Friday, 4 March 1983 06:20 EST +To: ANIMAL @ MIT-MC + +Queued: Bets at MIT-OZ + +Date: 8-Oct-82 20:27:14-PDT (Fri) +From: UCBVAX.pur-ee!ks@Berkeley +Subject: hello +Message-Id: <8209090327.10429@UCBVAX.BERKELEY.ARPA> +Received: by UCBVAX.BERKELEY.ARPA (3.207 [9/26/82]) + id A10429; 8-Oct-82 20:27:21-PDT (Fri) +To: ucbvax!animal@mit-ai, ucbvax!animal@mit-ml + +Is this Ann Aull who graduated from Purdue with a BSEE????? +Just a slight chance that your login is the same as her nickname.. + + Kirk Smith + Purdue EE + + + +Date: 8-Oct-82 20:26:13-PDT (Fri) +From: UCBVAX.pur-ee!ks@Berkeley +Subject: hello +Message-Id: <8209090326.10394@UCBVAX.BERKELEY.ARPA> +Received: by UCBVAX.BERKELEY.ARPA (3.207 [9/26/82]) + id A10394; 8-Oct-82 20:26:24-PDT (Fri) +To: ucbvax!animal@mit-ai, ucbvax!animal@mit-ml + +Is this Ann Aull who graduated from Purdue with a BSEE????? +Just a slight chance that your login is the same as her nickname.. + + Kirk Smith + Purdue EE + + + +Date: 11 July 1982 22:29-EDT +From: Christopher C. Stacy +To: BUG-ANIMAL at MIT-MC + + +"Sure, why not." ==> False. + +Date: 9 July 1982 03:49-EDT +From: Donald E. Hopkins +To: ANIMAL at MIT-MC +cc: KMP at MIT-MC + + Aww, gee... I'm sorry... I didn't realy mean it. I was just +asking questions pertaining to popes and bears and woods, and you +got all excited... Some AI program you are if you don't know what +religion a bear is or where the Pope ... Ahem... As I was saying, +I'm sorry and I will never do it again. + -Don + +Date: 23 March 1982 12:51-EST +From: Communications Satellite +Subject: Msg of Tuesday, 23 March 1982 02:30-EST +To: ANIMAL at MIT-MC + +Queued msg sent to: KEDZIERSKI at KESTREL + +Date: 23 March 1982 12:48-EST +From: Communications Satellite +Subject: Msg of Tuesday, 23 March 1982 02:29-EST +To: ANIMAL at MIT-MC + +Queued msg sent to: KEDZIERSKI at KESTREL + +Date: 23 March 1982 02:31-EST +From: Communications Satellite +Subject: Msg of Tuesday, 23 March 1982 02:30-EST +To: ANIMAL at MIT-MC + +Queued: KEDZIERSKI at KESTREL + +Date: 23 March 1982 02:29-EST +From: Communications Satellite +Subject: Msg of Tuesday, 23 March 1982 02:29-EST +To: ANIMAL at MIT-MC + +Queued: KEDZIERSKI at KESTREL + +Date: 1 Mar 1982 15:35 EST +From: Ziobro.Henr at PARC-MAXC +Subject: Boy I sure don't want my machine to crash V.5 +In-reply-to: Keesom.Wbst's message of 24 Feb. 1982 3:50 pm EST (Wednesday) +To: Keesom.Wbst +cc: Marshall.WBST,Bobrow at PARC-MAXC,RUSTY at BBND,Charles E. Leiserson + +cc: Jeffrey Shulman +cc: Rob Liebschutz +cc: Dave Touretzky at CMU-10A +cc: Craig Everhart at CMU-10A +cc: Thomas Rodeheffer at CMU-10A (C410TR30) +cc: MUNOZ@GREEN +cc: Rob Liebschutz +cc: C. Greg Hagerty +cc: ANIMAL at MIT-AI +cc: G.HAMMY at MIT-EECS +cc: Fikes at PARC-MAXC +cc: Orr at PARC-MAXC +cc: kolling at PARC-MAXC +cc: Jwagner at OFFICE +cc: mo at LBL-UNIX +cc: Andrea.Michaels@CMU-10A +cc: SHULMAN at RUTGERS + + Just in case you folks were wondering how far your message got. May I +suggest sending 5 copies back to the originators of the message. I'm sure that +will bring megabytes of good luck. + + This is message 5 of 5. + + //Z\\ +------------------------------------------- +Date: 24 Feb. 1982 3:50 pm EST (Wednesday) +From: Keesom.Wbst +Subject: chains +To: Wegeng.WBST,ziobro.henr +cc: + +Don, + +And you thought your version was bad, here is a version that has clogged up +the net. + +Henk + +--------------------------- + +Date: 22 Feb. 1982 2:12 pm EST (Monday) +From: Marshall.WBST +Subject: Good luck +To: Baroody.WBST, Beh.WBST, Bernard.WBST, Blanchard.WBST, CParker.WBST, + Dattola.WBST, DMurray.WBST, Harrington.WBST, Keesom.Wbst, LJMiller.WBST, + Low.Wbst, Sauvain.WBST, Shoots.Wbst, Butler, Moreland, Allen, Axelrod, + Wayman, Norder, Waal +Reply-To: Marshall + +CoveringMessage + +--------------------------- + +Date: 16 Feb 1982 18:26 PST +From: Bobrow at PARC-MAXC +Subject: A double chain. Don't break it. +To: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein + + +CoveringMessage + +Mail-from: Arpanet host BBND rcvd at 16-FEB-82 1155-PST +Date: 16 Feb 1982 1454-EST +Sender: RUSTY at BBND +Subject: A Chain of Bits! +Subject: [Charles E. Leiserson : Do not break this c...] +From: RUSTY at BBND +To: PBRINKMAN at BBNA, BGOODMAN at BBND, GREENFELD at BBND, +To: GRIGNETTI at BBND, DISRAEL at BBND, LARKIN at BBNG, +To: SCHMOLZE at BBND, SELFRIDGE at BBND, SIDNER at BBND, +To: BSTARR at BBNA, SUSSMAN at BBNA, VITTAL at BBNG, +To: WEBSTER at BBND, YONKE at BBND, ZDYBEL at BBND, +To: BOBROW at PARC, RBRACHMAN at SRI-KL, WEISCHEDEL at UDEL, +To: LEVESQUE at SRI-KL, DONAGHEY at BBNA, TOBIASON at BBND +Message-ID: <[BBND]16-Feb-82 14:54:23.RUSTY> + + +Begin forwarded message +Mail-From: BBNQ +Received-Date: 16-Feb-82 1303-EST +Date: 15 Feb 1982 20:11 EST +From: Charles E. Leiserson +To: RIVEST at MIT-ML, MEYER at MIT-ML, FLAVIO at MIT-ML, + BENNY at MIT-ML, BHATT at MIT-ML, gjs at MIT-AI, lance at MIT-AI, + Reynolds at RAND-AI, bentley at CMU-10A, pinter at MIT-MC +Subject: Do not break this chain or your machine may crash! +Redistributed-To: d4-vlsi-meeting@BBN-UNIX,card-sharks@BBN-UNIX +Redistributed-By: tony lake +Redistributed-Date: 16 Feb 1982 12:55:34 EST (Tuesday) + + Mail-from: ARPANET site CMU-10A rcvd at 15-Feb-82 1337-EST + Mail-Created: 13 Feb 1982 1920-EST by SHULMAN + Date: 13 Feb 1982 1920-EST + From: Jeffrey Shulman + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith + Remailed-date: 13 Feb 1982 2002-EST + Remailed-from: Rob Liebschutz + Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at +RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS + Via: RUTGERS; 13 Feb 1982 2000-EST + Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A + Remailed-From: Dave Touretzky at CMU-10A + Remailed-Date: 13 February 1982 2009-EST + Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST + Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A + Remailed-From: Craig Everhart at CMU-10A + Remailed-Date: Sunday, 14 February 1982 0015-EST + Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + Remailed-To: Pradeep Sindhu at CMU-10A, John Ousterhout at CMU-10A, + Elizabeth Rentmeesters at CMU-10A, + Charles Leiserson at CMU-10A + Remailed-From: Thomas Rodeheffer at CMU-10A (C410TR30) + Remailed-Date: Monday, 15 February 1982 1142-EST + Via: C410TR30 at CMU-10A; 15 Feb 1982 1220-EST + + Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 + Date: Saturday, 13 February 1982 18:59-EST + From: Laz Munoz + To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN + Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your +machine may crash]] + + Date: Saturday, 13 February 1982 18:43-EST + From: C. Greg Hagerty + To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN + Re: [animal@mit-ml: do not break this chain or your machine may crash] + + Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST + Date: 13 February 1982 13:55-EST + From: animal@mit-ml + Sender: ANIMAL at MIT-AI + Subject: do not break this chain or your machine may crash + To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS + cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + + Date: 10 Feb 1982 1937-EST + From: Randy Haskins + Subject: Pass it on + To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn + cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese + Remailed-date: 12 Feb 1982 1217-EST + Remailed-from: J. Scott Hamilton + Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS + Remailed-date: 12 Feb 1982 1416-EST + Remailed-from: Joe Frisbie + Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, +net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at +MIT-DMS, + uc.rdz, uc.plj, uc.rpk + Remailed-date: 12 Feb 1982 2257-EST + Remailed-from: Jon A. Rochlis + Remailed-to: EECS-Hackers: ; + Remailed-date: 12 Feb 1982 2300-EST + Remailed-from: J. Scott Hamilton + Remailed-to: Wizards: ; + Remailed-date: 12 Feb 1982 2351-EST + + Trust in the LORD with all your heart and HE will acknowledge + and HE will light the way. + + + This prayer has been sent to you for good luck. The original + copy is from the Netherlands. It has been around the world + nine times. The luck has now been brought to you. You will + receive good luck within four days of receiving this letter, + provided in turn, you send it back out. DO NOT SEND MONEY, FOR + FAITH HAS NO PRICE. Do not keep this letter. It must leave your + hands within 96 hours after you receive it. An RAF officer + received $70,000. Joe Ellito received $450,000 and lost it + because he broke the chain. While in the Phillipines, General + Welch lost his wife four days after he received this letter. He + failed to circulate the prayer. However, before his death, he + received $775,000. Please send 20 copies and see what happens + to you on the fourth day. This chain comes from Venezuela, and + was written by Saul Anthony deOziof, a missionary from South + America. I, myself, forward it to you. Since the chain must + make the tour of the world, you must make 20 identical copies + to this one. Sned it to your friends, parents, or associates. + After a few days you will get a suprise. This is true even + if you are not superstitious. Take note of the following. + Constantine Dino received the chain in 1953. He asked + his secretary to make 20 copies and send them. A few days later, + he won a lottery for $2,000,000 in his country. Carlo Caditt, + an office employee, received the chain. He forgot it and a few + days later he lost his job. He found the chain letter and sent + it to 20 people. Five days later he got an even better job. + Dolon Fairchild received the chain and not believing it, threw + it away. Nine days later he died. For no reason whatsoever should + this chain be broken. Remember, SEND NO MONEY. + + + Please do not ignore this. IT WORKS! + ------- + + -------------------- +End forwarded message + + +Date: 16 Feb 1982 16:32 PST +From: Fikes at PARC-MAXC +Subject: Open at Once; Time Sensitive +To: Robson, + Brachman@sri-kl,Levesque@sri-kl,bobrow,malone,briansmith,burton,stefik, + waldinger@sri-kl,williams,betsey,weyer,ingalls,cohen,lindsay,kaplan,mann, + mark@isi +cc: fikes + +Don't dispair. Read on. + +--------------------------- + +Date: 16 Feb 1982 14:35 PST +From: Orr at PARC-MAXC +Subject: A quaint folk ritual . . . +To: Brotz, Putman, Swager, Boynton, Collett, MSHunter@USC-ISIB, TMAnley.ES, + Cucinitti, Suchman, AHenderson, Fikes, Reid@Shasta at Sumex-AIM, Stone, + Sargent, Casey, GWilliams, Mallory, Mulhern, Warner, McElyea +cc: + +Ah, folklore . . . Maybe this is what's choking Cabernet today . . . + +--------------------------- + +Date: 16 Feb 1982 11:50 PST +From: kolling at PARC-MAXC +Subject: One good turn deserves another +To: atkinson, gnelson, lknutsen, sturgis, taft, taylor, lrc.hjjh at UTexas-20, + CSVAX.upstill at Berkeley +cc: kolling + + +Mail-from: Arpanet host OFFICE-2 rcvd at 16-FEB-82 1036-PST +Date: 16 Feb 1982 1012-PST +From: Jwagner at OFFICE +Subject: sent to 20@random -- please read -- a surprise +To: BANDY at MIT-AI, ZEVE at RUTGERS, ZELLICH at OFFICE-3, +To: APPLE at MIT-MC, FFM at MIT-MC, CCH at MIT-MC, +To: GEOFF at SRI-CSL, REM at MIT-MC, BILL at SRI-KL, +To: MERRITT at USC-ISIB, AGRE at MIT-AI, LAMSON at MIT-MULTICS, +To: SUE at BRL, KOLLING at PARC-MAXC, CUTTER at MIT-AI, +To: LAUREN at UCLA-SECURITY, CJH at CCA-UNIX, GEOFF at SRI-CSL, +To: ITTA at MIT-MC, ROODE at SRI-KL, DRCPM-SC at OFFICE-7 + +Date: 16 Feb 1982 0005-PST +From: Kleiser +Subject: please read this +To: Oad Staff: +cc: skahn at SRI-KL, lynch at USC-ISIB + +Date: 15 Feb 1982 2349-PST +From: Daul +Subject: amazing message +To: kleiser, kelley +cc: g.bets at SU-SCORE, ADMIN.KNIGHT at SU-SCORE + +Mail from MIT-ML rcvd at 15-Feb-82 2301-PST +Date: 15 Feb 1982 16:19:12-PST +From: mo at LBL-UNIX (Mike O'Dell [system]) +To: msggroup at mit-ai +Cc: +Subject: Nominee for most amazing message ever seen + + +If this little gem doesn't break you mail reader, you are in good shape! + +------- Forwarded Message + +Date: 15 Feb 1982 1500-PST (Monday) +From: jef +To: 20-people@RANDOM-NET +Subject: the following strange message... +Cc: Almquist@CMU-20C, BYRNE@CMU-20C, CSTNBL@MIT-MC, +D.michael@BERKELEY, + ELM@CMU-20C, FISH@MIT-MC, FURST@MIT-MC, Inners@CMU-20C, +Lammert@CMU-20C, + Lomicka@CMU-20C, MJA@CMU-20C, REM@MIT-MC, Schwartz@CMU-20C, +a.slither@BERKELEY, + csvax.DRB@BERKELEY, geoff@SRI-CSL, jacobson, leres, mo, vern + +--- Begin Forwarded Message --- +>From Andrea.Michaels@CMU-10A Mon Feb 15 09:08:14 1982 +Received: Network mail from host MIT-MC for jef on Mon Feb 15 09:07:11 1982 +Date: 14 February 1982 1115-EST (Sunday) +From: Andrea.Michaels at CMU-10A +To: Suzanna.Garreau at CMU-10A, bh at mit-ai, teitz at parc-maxc, + nelson at parc-maxc, +Subject: this is ridiculous, i do not know why i am bothering! +CC: Merrick.Furst at CMU-10A, Mark.Wright at CMU-10A, Brad.Allen at +CMU-10A, + strohm@cmu-780g at CMU-10A, judy rosenberg at CMU-10A, + Steven.Minton at CMU-10A, Bruce.Lucas at CMU-10A, + Richard.Korf at CMU-10A, Betsy.Herk at CMU-10A, + Jim.Gasbarro at CMU-10A, cynthia hibbard at CMU-10A, + sylvia hoy at CMU-10A, sharon burks at CMU-10A, + Glenda.Childress at CMU-10A, dale miller at CMU-10A, + dale moore at CMU-10A +Message-Id: <14Feb82 111506 AM06@CMU-10A> +Origin: C425AM06 at CMU-10A; 14 Feb 1982 1118-EST +Remailed-To: aqe at MIT-MC +Remailed-From: Dale.Moore at CMU-10A +Remailed-Date: Monday, 15 February 1982 1105-EST + + +- - - - Begin forwarded message - - - - +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not +break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST +Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine +may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - End forwarded message - - - - + + + + +------- End of Forwarded Message +------- +------- +End of forwarded mail +------- +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ +Date: 16 Feb 1982 18:58 PST +From: Horning at PARC-MAXC +Subject: Re: A double chain. Don't break it. +In-reply-to: Bobrow's message of 16 Feb 1982 18:26 PST +To: Bobrow +cc: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein +Reply-To: Horning + +Danny, + +The first time I saw this message today, I thought it was kinda funny, but I +foresaw trouble in a finite universe of potential recipients. + +This just could become known as the message that led to the institution of +postage charges for electronic mail. + +Jim H. + + +------------------------------------------------------------ + +------------------------------------------------------------ + +P.S. I dont believe you read all the way to the end of this message. + +Date: 1 Mar 1982 15:32 EST +From: Ziobro.Henr at PARC-MAXC +Subject: Boy I sure don't want my machine to crash V.4 +In-reply-to: Keesom.Wbst's message of 24 Feb. 1982 3:50 pm EST (Wednesday) +To: Keesom.Wbst +cc: Marshall.WBST,Bobrow at PARC-MAXC,RUSTY at BBND,Charles E. Leiserson + +cc: Jeffrey Shulman +cc: Rob Liebschutz +cc: Dave Touretzky at CMU-10A +cc: Craig Everhart at CMU-10A +cc: Thomas Rodeheffer at CMU-10A (C410TR30) +cc: MUNOZ@GREEN +cc: Rob Liebschutz +cc: C. Greg Hagerty +cc: ANIMAL at MIT-AI +cc: G.HAMMY at MIT-EECS +cc: Fikes at PARC-MAXC +cc: Orr at PARC-MAXC +cc: kolling at PARC-MAXC +cc: Jwagner at OFFICE +cc: mo at LBL-UNIX +cc: Andrea.Michaels@CMU-10A +cc: SHULMAN at RUTGERS + + Just in case you folks were wondering how far your message got. May I +suggest sending 5 copies back to the originators of the message. I'm sure that +will bring megabytes of good luck. + + This is message 4 of 5. + + //Z\\ +------------------------------------------- +Date: 24 Feb. 1982 3:50 pm EST (Wednesday) +From: Keesom.Wbst +Subject: chains +To: Wegeng.WBST,ziobro.henr +cc: + +Don, + +And you thought your version was bad, here is a version that has clogged up +the net. + +Henk + +--------------------------- + +Date: 22 Feb. 1982 2:12 pm EST (Monday) +From: Marshall.WBST +Subject: Good luck +To: Baroody.WBST, Beh.WBST, Bernard.WBST, Blanchard.WBST, CParker.WBST, + Dattola.WBST, DMurray.WBST, Harrington.WBST, Keesom.Wbst, LJMiller.WBST, + Low.Wbst, Sauvain.WBST, Shoots.Wbst, Butler, Moreland, Allen, Axelrod, + Wayman, Norder, Waal +Reply-To: Marshall + +CoveringMessage + +--------------------------- + +Date: 16 Feb 1982 18:26 PST +From: Bobrow at PARC-MAXC +Subject: A double chain. Don't break it. +To: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein + + +CoveringMessage + +Mail-from: Arpanet host BBND rcvd at 16-FEB-82 1155-PST +Date: 16 Feb 1982 1454-EST +Sender: RUSTY at BBND +Subject: A Chain of Bits! +Subject: [Charles E. Leiserson : Do not break this c...] +From: RUSTY at BBND +To: PBRINKMAN at BBNA, BGOODMAN at BBND, GREENFELD at BBND, +To: GRIGNETTI at BBND, DISRAEL at BBND, LARKIN at BBNG, +To: SCHMOLZE at BBND, SELFRIDGE at BBND, SIDNER at BBND, +To: BSTARR at BBNA, SUSSMAN at BBNA, VITTAL at BBNG, +To: WEBSTER at BBND, YONKE at BBND, ZDYBEL at BBND, +To: BOBROW at PARC, RBRACHMAN at SRI-KL, WEISCHEDEL at UDEL, +To: LEVESQUE at SRI-KL, DONAGHEY at BBNA, TOBIASON at BBND +Message-ID: <[BBND]16-Feb-82 14:54:23.RUSTY> + + +Begin forwarded message +Mail-From: BBNQ +Received-Date: 16-Feb-82 1303-EST +Date: 15 Feb 1982 20:11 EST +From: Charles E. Leiserson +To: RIVEST at MIT-ML, MEYER at MIT-ML, FLAVIO at MIT-ML, + BENNY at MIT-ML, BHATT at MIT-ML, gjs at MIT-AI, lance at MIT-AI, + Reynolds at RAND-AI, bentley at CMU-10A, pinter at MIT-MC +Subject: Do not break this chain or your machine may crash! +Redistributed-To: d4-vlsi-meeting@BBN-UNIX,card-sharks@BBN-UNIX +Redistributed-By: tony lake +Redistributed-Date: 16 Feb 1982 12:55:34 EST (Tuesday) + + Mail-from: ARPANET site CMU-10A rcvd at 15-Feb-82 1337-EST + Mail-Created: 13 Feb 1982 1920-EST by SHULMAN + Date: 13 Feb 1982 1920-EST + From: Jeffrey Shulman + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith + Remailed-date: 13 Feb 1982 2002-EST + Remailed-from: Rob Liebschutz + Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at +RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS + Via: RUTGERS; 13 Feb 1982 2000-EST + Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A + Remailed-From: Dave Touretzky at CMU-10A + Remailed-Date: 13 February 1982 2009-EST + Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST + Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A + Remailed-From: Craig Everhart at CMU-10A + Remailed-Date: Sunday, 14 February 1982 0015-EST + Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + Remailed-To: Pradeep Sindhu at CMU-10A, John Ousterhout at CMU-10A, + Elizabeth Rentmeesters at CMU-10A, + Charles Leiserson at CMU-10A + Remailed-From: Thomas Rodeheffer at CMU-10A (C410TR30) + Remailed-Date: Monday, 15 February 1982 1142-EST + Via: C410TR30 at CMU-10A; 15 Feb 1982 1220-EST + + Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 + Date: Saturday, 13 February 1982 18:59-EST + From: Laz Munoz + To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN + Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your +machine may crash]] + + Date: Saturday, 13 February 1982 18:43-EST + From: C. Greg Hagerty + To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN + Re: [animal@mit-ml: do not break this chain or your machine may crash] + + Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST + Date: 13 February 1982 13:55-EST + From: animal@mit-ml + Sender: ANIMAL at MIT-AI + Subject: do not break this chain or your machine may crash + To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS + cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + + Date: 10 Feb 1982 1937-EST + From: Randy Haskins + Subject: Pass it on + To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn + cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese + Remailed-date: 12 Feb 1982 1217-EST + Remailed-from: J. Scott Hamilton + Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS + Remailed-date: 12 Feb 1982 1416-EST + Remailed-from: Joe Frisbie + Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, +net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at +MIT-DMS, + uc.rdz, uc.plj, uc.rpk + Remailed-date: 12 Feb 1982 2257-EST + Remailed-from: Jon A. Rochlis + Remailed-to: EECS-Hackers: ; + Remailed-date: 12 Feb 1982 2300-EST + Remailed-from: J. Scott Hamilton + Remailed-to: Wizards: ; + Remailed-date: 12 Feb 1982 2351-EST + + Trust in the LORD with all your heart and HE will acknowledge + and HE will light the way. + + + This prayer has been sent to you for good luck. The original + copy is from the Netherlands. It has been around the world + nine times. The luck has now been brought to you. You will + receive good luck within four days of receiving this letter, + provided in turn, you send it back out. DO NOT SEND MONEY, FOR + FAITH HAS NO PRICE. Do not keep this letter. It must leave your + hands within 96 hours after you receive it. An RAF officer + received $70,000. Joe Ellito received $450,000 and lost it + because he broke the chain. While in the Phillipines, General + Welch lost his wife four days after he received this letter. He + failed to circulate the prayer. However, before his death, he + received $775,000. Please send 20 copies and see what happens + to you on the fourth day. This chain comes from Venezuela, and + was written by Saul Anthony deOziof, a missionary from South + America. I, myself, forward it to you. Since the chain must + make the tour of the world, you must make 20 identical copies + to this one. Sned it to your friends, parents, or associates. + After a few days you will get a suprise. This is true even + if you are not superstitious. Take note of the following. + Constantine Dino received the chain in 1953. He asked + his secretary to make 20 copies and send them. A few days later, + he won a lottery for $2,000,000 in his country. Carlo Caditt, + an office employee, received the chain. He forgot it and a few + days later he lost his job. He found the chain letter and sent + it to 20 people. Five days later he got an even better job. + Dolon Fairchild received the chain and not believing it, threw + it away. Nine days later he died. For no reason whatsoever should + this chain be broken. Remember, SEND NO MONEY. + + + Please do not ignore this. IT WORKS! + ------- + + -------------------- +End forwarded message + + +Date: 16 Feb 1982 16:32 PST +From: Fikes at PARC-MAXC +Subject: Open at Once; Time Sensitive +To: Robson, + Brachman@sri-kl,Levesque@sri-kl,bobrow,malone,briansmith,burton,stefik, + waldinger@sri-kl,williams,betsey,weyer,ingalls,cohen,lindsay,kaplan,mann, + mark@isi +cc: fikes + +Don't dispair. Read on. + +--------------------------- + +Date: 16 Feb 1982 14:35 PST +From: Orr at PARC-MAXC +Subject: A quaint folk ritual . . . +To: Brotz, Putman, Swager, Boynton, Collett, MSHunter@USC-ISIB, TMAnley.ES, + Cucinitti, Suchman, AHenderson, Fikes, Reid@Shasta at Sumex-AIM, Stone, + Sargent, Casey, GWilliams, Mallory, Mulhern, Warner, McElyea +cc: + +Ah, folklore . . . Maybe this is what's choking Cabernet today . . . + +--------------------------- + +Date: 16 Feb 1982 11:50 PST +From: kolling at PARC-MAXC +Subject: One good turn deserves another +To: atkinson, gnelson, lknutsen, sturgis, taft, taylor, lrc.hjjh at UTexas-20, + CSVAX.upstill at Berkeley +cc: kolling + + +Mail-from: Arpanet host OFFICE-2 rcvd at 16-FEB-82 1036-PST +Date: 16 Feb 1982 1012-PST +From: Jwagner at OFFICE +Subject: sent to 20@random -- please read -- a surprise +To: BANDY at MIT-AI, ZEVE at RUTGERS, ZELLICH at OFFICE-3, +To: APPLE at MIT-MC, FFM at MIT-MC, CCH at MIT-MC, +To: GEOFF at SRI-CSL, REM at MIT-MC, BILL at SRI-KL, +To: MERRITT at USC-ISIB, AGRE at MIT-AI, LAMSON at MIT-MULTICS, +To: SUE at BRL, KOLLING at PARC-MAXC, CUTTER at MIT-AI, +To: LAUREN at UCLA-SECURITY, CJH at CCA-UNIX, GEOFF at SRI-CSL, +To: ITTA at MIT-MC, ROODE at SRI-KL, DRCPM-SC at OFFICE-7 + +Date: 16 Feb 1982 0005-PST +From: Kleiser +Subject: please read this +To: Oad Staff: +cc: skahn at SRI-KL, lynch at USC-ISIB + +Date: 15 Feb 1982 2349-PST +From: Daul +Subject: amazing message +To: kleiser, kelley +cc: g.bets at SU-SCORE, ADMIN.KNIGHT at SU-SCORE + +Mail from MIT-ML rcvd at 15-Feb-82 2301-PST +Date: 15 Feb 1982 16:19:12-PST +From: mo at LBL-UNIX (Mike O'Dell [system]) +To: msggroup at mit-ai +Cc: +Subject: Nominee for most amazing message ever seen + + +If this little gem doesn't break you mail reader, you are in good shape! + +------- Forwarded Message + +Date: 15 Feb 1982 1500-PST (Monday) +From: jef +To: 20-people@RANDOM-NET +Subject: the following strange message... +Cc: Almquist@CMU-20C, BYRNE@CMU-20C, CSTNBL@MIT-MC, +D.michael@BERKELEY, + ELM@CMU-20C, FISH@MIT-MC, FURST@MIT-MC, Inners@CMU-20C, +Lammert@CMU-20C, + Lomicka@CMU-20C, MJA@CMU-20C, REM@MIT-MC, Schwartz@CMU-20C, +a.slither@BERKELEY, + csvax.DRB@BERKELEY, geoff@SRI-CSL, jacobson, leres, mo, vern + +--- Begin Forwarded Message --- +>From Andrea.Michaels@CMU-10A Mon Feb 15 09:08:14 1982 +Received: Network mail from host MIT-MC for jef on Mon Feb 15 09:07:11 1982 +Date: 14 February 1982 1115-EST (Sunday) +From: Andrea.Michaels at CMU-10A +To: Suzanna.Garreau at CMU-10A, bh at mit-ai, teitz at parc-maxc, + nelson at parc-maxc, +Subject: this is ridiculous, i do not know why i am bothering! +CC: Merrick.Furst at CMU-10A, Mark.Wright at CMU-10A, Brad.Allen at +CMU-10A, + strohm@cmu-780g at CMU-10A, judy rosenberg at CMU-10A, + Steven.Minton at CMU-10A, Bruce.Lucas at CMU-10A, + Richard.Korf at CMU-10A, Betsy.Herk at CMU-10A, + Jim.Gasbarro at CMU-10A, cynthia hibbard at CMU-10A, + sylvia hoy at CMU-10A, sharon burks at CMU-10A, + Glenda.Childress at CMU-10A, dale miller at CMU-10A, + dale moore at CMU-10A +Message-Id: <14Feb82 111506 AM06@CMU-10A> +Origin: C425AM06 at CMU-10A; 14 Feb 1982 1118-EST +Remailed-To: aqe at MIT-MC +Remailed-From: Dale.Moore at CMU-10A +Remailed-Date: Monday, 15 February 1982 1105-EST + + +- - - - Begin forwarded message - - - - +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not +break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST +Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine +may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - End forwarded message - - - - + + + + +------- End of Forwarded Message +------- +------- +End of forwarded mail +------- +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ +Date: 16 Feb 1982 18:58 PST +From: Horning at PARC-MAXC +Subject: Re: A double chain. Don't break it. +In-reply-to: Bobrow's message of 16 Feb 1982 18:26 PST +To: Bobrow +cc: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein +Reply-To: Horning + +Danny, + +The first time I saw this message today, I thought it was kinda funny, but I +foresaw trouble in a finite universe of potential recipients. + +This just could become known as the message that led to the institution of +postage charges for electronic mail. + +Jim H. + + +------------------------------------------------------------ + +------------------------------------------------------------ + + +Date: 1 Mar 1982 15:31 EST +From: Ziobro.Henr at PARC-MAXC +Subject: Boy I sure don't want my machine to crash V.3 +In-reply-to: Keesom.Wbst's message of 24 Feb. 1982 3:50 pm EST (Wednesday) +To: Keesom.Wbst +cc: Marshall.WBST,Bobrow at PARC-MAXC,RUSTY at BBND,Charles E. Leiserson + +cc: Jeffrey Shulman +cc: Rob Liebschutz +cc: Dave Touretzky at CMU-10A +cc: Craig Everhart at CMU-10A +cc: Thomas Rodeheffer at CMU-10A (C410TR30) +cc: MUNOZ@GREEN +cc: Rob Liebschutz +cc: C. Greg Hagerty +cc: ANIMAL at MIT-AI +cc: G.HAMMY at MIT-EECS +cc: Fikes at PARC-MAXC +cc: Orr at PARC-MAXC +cc: kolling at PARC-MAXC +cc: Jwagner at OFFICE +cc: mo at LBL-UNIX +cc: Andrea.Michaels@CMU-10A +cc: SHULMAN at RUTGERS + + Just in case you folks were wondering how far your message got. May I +suggest sending 5 copies back to the originators of the message. I'm sure that +will bring megabytes of good luck. + + This is message 3 of 5. + + //Z\\ +------------------------------------------- +Date: 24 Feb. 1982 3:50 pm EST (Wednesday) +From: Keesom.Wbst +Subject: chains +To: Wegeng.WBST,ziobro.henr +cc: + +Don, + +And you thought your version was bad, here is a version that has clogged up +the net. + +Henk + +--------------------------- + +Date: 22 Feb. 1982 2:12 pm EST (Monday) +From: Marshall.WBST +Subject: Good luck +To: Baroody.WBST, Beh.WBST, Bernard.WBST, Blanchard.WBST, CParker.WBST, + Dattola.WBST, DMurray.WBST, Harrington.WBST, Keesom.Wbst, LJMiller.WBST, + Low.Wbst, Sauvain.WBST, Shoots.Wbst, Butler, Moreland, Allen, Axelrod, + Wayman, Norder, Waal +Reply-To: Marshall + +CoveringMessage + +--------------------------- + +Date: 16 Feb 1982 18:26 PST +From: Bobrow at PARC-MAXC +Subject: A double chain. Don't break it. +To: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein + + +CoveringMessage + +Mail-from: Arpanet host BBND rcvd at 16-FEB-82 1155-PST +Date: 16 Feb 1982 1454-EST +Sender: RUSTY at BBND +Subject: A Chain of Bits! +Subject: [Charles E. Leiserson : Do not break this c...] +From: RUSTY at BBND +To: PBRINKMAN at BBNA, BGOODMAN at BBND, GREENFELD at BBND, +To: GRIGNETTI at BBND, DISRAEL at BBND, LARKIN at BBNG, +To: SCHMOLZE at BBND, SELFRIDGE at BBND, SIDNER at BBND, +To: BSTARR at BBNA, SUSSMAN at BBNA, VITTAL at BBNG, +To: WEBSTER at BBND, YONKE at BBND, ZDYBEL at BBND, +To: BOBROW at PARC, RBRACHMAN at SRI-KL, WEISCHEDEL at UDEL, +To: LEVESQUE at SRI-KL, DONAGHEY at BBNA, TOBIASON at BBND +Message-ID: <[BBND]16-Feb-82 14:54:23.RUSTY> + + +Begin forwarded message +Mail-From: BBNQ +Received-Date: 16-Feb-82 1303-EST +Date: 15 Feb 1982 20:11 EST +From: Charles E. Leiserson +To: RIVEST at MIT-ML, MEYER at MIT-ML, FLAVIO at MIT-ML, + BENNY at MIT-ML, BHATT at MIT-ML, gjs at MIT-AI, lance at MIT-AI, + Reynolds at RAND-AI, bentley at CMU-10A, pinter at MIT-MC +Subject: Do not break this chain or your machine may crash! +Redistributed-To: d4-vlsi-meeting@BBN-UNIX,card-sharks@BBN-UNIX +Redistributed-By: tony lake +Redistributed-Date: 16 Feb 1982 12:55:34 EST (Tuesday) + + Mail-from: ARPANET site CMU-10A rcvd at 15-Feb-82 1337-EST + Mail-Created: 13 Feb 1982 1920-EST by SHULMAN + Date: 13 Feb 1982 1920-EST + From: Jeffrey Shulman + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith + Remailed-date: 13 Feb 1982 2002-EST + Remailed-from: Rob Liebschutz + Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at +RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS + Via: RUTGERS; 13 Feb 1982 2000-EST + Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A + Remailed-From: Dave Touretzky at CMU-10A + Remailed-Date: 13 February 1982 2009-EST + Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST + Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A + Remailed-From: Craig Everhart at CMU-10A + Remailed-Date: Sunday, 14 February 1982 0015-EST + Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + Remailed-To: Pradeep Sindhu at CMU-10A, John Ousterhout at CMU-10A, + Elizabeth Rentmeesters at CMU-10A, + Charles Leiserson at CMU-10A + Remailed-From: Thomas Rodeheffer at CMU-10A (C410TR30) + Remailed-Date: Monday, 15 February 1982 1142-EST + Via: C410TR30 at CMU-10A; 15 Feb 1982 1220-EST + + Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 + Date: Saturday, 13 February 1982 18:59-EST + From: Laz Munoz + To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN + Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your +machine may crash]] + + Date: Saturday, 13 February 1982 18:43-EST + From: C. Greg Hagerty + To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN + Re: [animal@mit-ml: do not break this chain or your machine may crash] + + Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST + Date: 13 February 1982 13:55-EST + From: animal@mit-ml + Sender: ANIMAL at MIT-AI + Subject: do not break this chain or your machine may crash + To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS + cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + + Date: 10 Feb 1982 1937-EST + From: Randy Haskins + Subject: Pass it on + To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn + cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese + Remailed-date: 12 Feb 1982 1217-EST + Remailed-from: J. Scott Hamilton + Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS + Remailed-date: 12 Feb 1982 1416-EST + Remailed-from: Joe Frisbie + Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, +net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at +MIT-DMS, + uc.rdz, uc.plj, uc.rpk + Remailed-date: 12 Feb 1982 2257-EST + Remailed-from: Jon A. Rochlis + Remailed-to: EECS-Hackers: ; + Remailed-date: 12 Feb 1982 2300-EST + Remailed-from: J. Scott Hamilton + Remailed-to: Wizards: ; + Remailed-date: 12 Feb 1982 2351-EST + + Trust in the LORD with all your heart and HE will acknowledge + and HE will light the way. + + + This prayer has been sent to you for good luck. The original + copy is from the Netherlands. It has been around the world + nine times. The luck has now been brought to you. You will + receive good luck within four days of receiving this letter, + provided in turn, you send it back out. DO NOT SEND MONEY, FOR + FAITH HAS NO PRICE. Do not keep this letter. It must leave your + hands within 96 hours after you receive it. An RAF officer + received $70,000. Joe Ellito received $450,000 and lost it + because he broke the chain. While in the Phillipines, General + Welch lost his wife four days after he received this letter. He + failed to circulate the prayer. However, before his death, he + received $775,000. Please send 20 copies and see what happens + to you on the fourth day. This chain comes from Venezuela, and + was written by Saul Anthony deOziof, a missionary from South + America. I, myself, forward it to you. Since the chain must + make the tour of the world, you must make 20 identical copies + to this one. Sned it to your friends, parents, or associates. + After a few days you will get a suprise. This is true even + if you are not superstitious. Take note of the following. + Constantine Dino received the chain in 1953. He asked + his secretary to make 20 copies and send them. A few days later, + he won a lottery for $2,000,000 in his country. Carlo Caditt, + an office employee, received the chain. He forgot it and a few + days later he lost his job. He found the chain letter and sent + it to 20 people. Five days later he got an even better job. + Dolon Fairchild received the chain and not believing it, threw + it away. Nine days later he died. For no reason whatsoever should + this chain be broken. Remember, SEND NO MONEY. + + + Please do not ignore this. IT WORKS! + ------- + + -------------------- +End forwarded message + + +Date: 16 Feb 1982 16:32 PST +From: Fikes at PARC-MAXC +Subject: Open at Once; Time Sensitive +To: Robson, + Brachman@sri-kl,Levesque@sri-kl,bobrow,malone,briansmith,burton,stefik, + waldinger@sri-kl,williams,betsey,weyer,ingalls,cohen,lindsay,kaplan,mann, + mark@isi +cc: fikes + +Don't dispair. Read on. + +--------------------------- + +Date: 16 Feb 1982 14:35 PST +From: Orr at PARC-MAXC +Subject: A quaint folk ritual . . . +To: Brotz, Putman, Swager, Boynton, Collett, MSHunter@USC-ISIB, TMAnley.ES, + Cucinitti, Suchman, AHenderson, Fikes, Reid@Shasta at Sumex-AIM, Stone, + Sargent, Casey, GWilliams, Mallory, Mulhern, Warner, McElyea +cc: + +Ah, folklore . . . Maybe this is what's choking Cabernet today . . . + +--------------------------- + +Date: 16 Feb 1982 11:50 PST +From: kolling at PARC-MAXC +Subject: One good turn deserves another +To: atkinson, gnelson, lknutsen, sturgis, taft, taylor, lrc.hjjh at UTexas-20, + CSVAX.upstill at Berkeley +cc: kolling + + +Mail-from: Arpanet host OFFICE-2 rcvd at 16-FEB-82 1036-PST +Date: 16 Feb 1982 1012-PST +From: Jwagner at OFFICE +Subject: sent to 20@random -- please read -- a surprise +To: BANDY at MIT-AI, ZEVE at RUTGERS, ZELLICH at OFFICE-3, +To: APPLE at MIT-MC, FFM at MIT-MC, CCH at MIT-MC, +To: GEOFF at SRI-CSL, REM at MIT-MC, BILL at SRI-KL, +To: MERRITT at USC-ISIB, AGRE at MIT-AI, LAMSON at MIT-MULTICS, +To: SUE at BRL, KOLLING at PARC-MAXC, CUTTER at MIT-AI, +To: LAUREN at UCLA-SECURITY, CJH at CCA-UNIX, GEOFF at SRI-CSL, +To: ITTA at MIT-MC, ROODE at SRI-KL, DRCPM-SC at OFFICE-7 + +Date: 16 Feb 1982 0005-PST +From: Kleiser +Subject: please read this +To: Oad Staff: +cc: skahn at SRI-KL, lynch at USC-ISIB + +Date: 15 Feb 1982 2349-PST +From: Daul +Subject: amazing message +To: kleiser, kelley +cc: g.bets at SU-SCORE, ADMIN.KNIGHT at SU-SCORE + +Mail from MIT-ML rcvd at 15-Feb-82 2301-PST +Date: 15 Feb 1982 16:19:12-PST +From: mo at LBL-UNIX (Mike O'Dell [system]) +To: msggroup at mit-ai +Cc: +Subject: Nominee for most amazing message ever seen + + +If this little gem doesn't break you mail reader, you are in good shape! + +------- Forwarded Message + +Date: 15 Feb 1982 1500-PST (Monday) +From: jef +To: 20-people@RANDOM-NET +Subject: the following strange message... +Cc: Almquist@CMU-20C, BYRNE@CMU-20C, CSTNBL@MIT-MC, +D.michael@BERKELEY, + ELM@CMU-20C, FISH@MIT-MC, FURST@MIT-MC, Inners@CMU-20C, +Lammert@CMU-20C, + Lomicka@CMU-20C, MJA@CMU-20C, REM@MIT-MC, Schwartz@CMU-20C, +a.slither@BERKELEY, + csvax.DRB@BERKELEY, geoff@SRI-CSL, jacobson, leres, mo, vern + +--- Begin Forwarded Message --- +>From Andrea.Michaels@CMU-10A Mon Feb 15 09:08:14 1982 +Received: Network mail from host MIT-MC for jef on Mon Feb 15 09:07:11 1982 +Date: 14 February 1982 1115-EST (Sunday) +From: Andrea.Michaels at CMU-10A +To: Suzanna.Garreau at CMU-10A, bh at mit-ai, teitz at parc-maxc, + nelson at parc-maxc, +Subject: this is ridiculous, i do not know why i am bothering! +CC: Merrick.Furst at CMU-10A, Mark.Wright at CMU-10A, Brad.Allen at +CMU-10A, + strohm@cmu-780g at CMU-10A, judy rosenberg at CMU-10A, + Steven.Minton at CMU-10A, Bruce.Lucas at CMU-10A, + Richard.Korf at CMU-10A, Betsy.Herk at CMU-10A, + Jim.Gasbarro at CMU-10A, cynthia hibbard at CMU-10A, + sylvia hoy at CMU-10A, sharon burks at CMU-10A, + Glenda.Childress at CMU-10A, dale miller at CMU-10A, + dale moore at CMU-10A +Message-Id: <14Feb82 111506 AM06@CMU-10A> +Origin: C425AM06 at CMU-10A; 14 Feb 1982 1118-EST +Remailed-To: aqe at MIT-MC +Remailed-From: Dale.Moore at CMU-10A +Remailed-Date: Monday, 15 February 1982 1105-EST + + +- - - - Begin forwarded message - - - - +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not +break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST +Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine +may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - End forwarded message - - - - + + + + +------- End of Forwarded Message +------- +------- +End of forwarded mail +------- +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ +Date: 16 Feb 1982 18:58 PST +From: Horning at PARC-MAXC +Subject: Re: A double chain. Don't break it. +In-reply-to: Bobrow's message of 16 Feb 1982 18:26 PST +To: Bobrow +cc: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein +Reply-To: Horning + +Danny, + +The first time I saw this message today, I thought it was kinda funny, but I +foresaw trouble in a finite universe of potential recipients. + +This just could become known as the message that led to the institution of +postage charges for electronic mail. + +Jim H. + + +------------------------------------------------------------ + +------------------------------------------------------------ + + +Date: 1 Mar 1982 15:29 EST +From: Ziobro.Henr at PARC-MAXC +Subject: Boy I sure don't want my machine to crash V.2 +In-reply-to: Keesom.Wbst's message of 24 Feb. 1982 3:50 pm EST (Wednesday) +To: Keesom.Wbst +cc: Marshall.WBST,Bobrow at PARC-MAXC,RUSTY at BBND,Charles E. Leiserson + +cc: Jeffrey Shulman +cc: Rob Liebschutz +cc: Dave Touretzky at CMU-10A +cc: Craig Everhart at CMU-10A +cc: Thomas Rodeheffer at CMU-10A (C410TR30) +cc: MUNOZ@GREEN +cc: Rob Liebschutz +cc: C. Greg Hagerty +cc: ANIMAL at MIT-AI +cc: G.HAMMY at MIT-EECS +cc: Fikes at PARC-MAXC +cc: Orr at PARC-MAXC +cc: kolling at PARC-MAXC +cc: Jwagner at OFFICE +cc: mo at LBL-UNIX +cc: Andrea.Michaels@CMU-10A +cc: SHULMAN at RUTGERS + + Just in case you folks were wondering how far your message got. May I +suggest sending 5 copies back to the originators of the message. I'm sure that +will bring megabytes of good luck. + + This is message 2 of 5. + + //Z\\ +------------------------------------------- +Date: 24 Feb. 1982 3:50 pm EST (Wednesday) +From: Keesom.Wbst +Subject: chains +To: Wegeng.WBST,ziobro.henr +cc: + +Don, + +And you thought your version was bad, here is a version that has clogged up +the net. + +Henk + +--------------------------- + +Date: 22 Feb. 1982 2:12 pm EST (Monday) +From: Marshall.WBST +Subject: Good luck +To: Baroody.WBST, Beh.WBST, Bernard.WBST, Blanchard.WBST, CParker.WBST, + Dattola.WBST, DMurray.WBST, Harrington.WBST, Keesom.Wbst, LJMiller.WBST, + Low.Wbst, Sauvain.WBST, Shoots.Wbst, Butler, Moreland, Allen, Axelrod, + Wayman, Norder, Waal +Reply-To: Marshall + +CoveringMessage + +--------------------------- + +Date: 16 Feb 1982 18:26 PST +From: Bobrow at PARC-MAXC +Subject: A double chain. Don't break it. +To: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein + + +CoveringMessage + +Mail-from: Arpanet host BBND rcvd at 16-FEB-82 1155-PST +Date: 16 Feb 1982 1454-EST +Sender: RUSTY at BBND +Subject: A Chain of Bits! +Subject: [Charles E. Leiserson : Do not break this c...] +From: RUSTY at BBND +To: PBRINKMAN at BBNA, BGOODMAN at BBND, GREENFELD at BBND, +To: GRIGNETTI at BBND, DISRAEL at BBND, LARKIN at BBNG, +To: SCHMOLZE at BBND, SELFRIDGE at BBND, SIDNER at BBND, +To: BSTARR at BBNA, SUSSMAN at BBNA, VITTAL at BBNG, +To: WEBSTER at BBND, YONKE at BBND, ZDYBEL at BBND, +To: BOBROW at PARC, RBRACHMAN at SRI-KL, WEISCHEDEL at UDEL, +To: LEVESQUE at SRI-KL, DONAGHEY at BBNA, TOBIASON at BBND +Message-ID: <[BBND]16-Feb-82 14:54:23.RUSTY> + + +Begin forwarded message +Mail-From: BBNQ +Received-Date: 16-Feb-82 1303-EST +Date: 15 Feb 1982 20:11 EST +From: Charles E. Leiserson +To: RIVEST at MIT-ML, MEYER at MIT-ML, FLAVIO at MIT-ML, + BENNY at MIT-ML, BHATT at MIT-ML, gjs at MIT-AI, lance at MIT-AI, + Reynolds at RAND-AI, bentley at CMU-10A, pinter at MIT-MC +Subject: Do not break this chain or your machine may crash! +Redistributed-To: d4-vlsi-meeting@BBN-UNIX,card-sharks@BBN-UNIX +Redistributed-By: tony lake +Redistributed-Date: 16 Feb 1982 12:55:34 EST (Tuesday) + + Mail-from: ARPANET site CMU-10A rcvd at 15-Feb-82 1337-EST + Mail-Created: 13 Feb 1982 1920-EST by SHULMAN + Date: 13 Feb 1982 1920-EST + From: Jeffrey Shulman + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith + Remailed-date: 13 Feb 1982 2002-EST + Remailed-from: Rob Liebschutz + Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at +RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS + Via: RUTGERS; 13 Feb 1982 2000-EST + Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A + Remailed-From: Dave Touretzky at CMU-10A + Remailed-Date: 13 February 1982 2009-EST + Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST + Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A + Remailed-From: Craig Everhart at CMU-10A + Remailed-Date: Sunday, 14 February 1982 0015-EST + Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + Remailed-To: Pradeep Sindhu at CMU-10A, John Ousterhout at CMU-10A, + Elizabeth Rentmeesters at CMU-10A, + Charles Leiserson at CMU-10A + Remailed-From: Thomas Rodeheffer at CMU-10A (C410TR30) + Remailed-Date: Monday, 15 February 1982 1142-EST + Via: C410TR30 at CMU-10A; 15 Feb 1982 1220-EST + + Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 + Date: Saturday, 13 February 1982 18:59-EST + From: Laz Munoz + To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN + Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your +machine may crash]] + + Date: Saturday, 13 February 1982 18:43-EST + From: C. Greg Hagerty + To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN + Re: [animal@mit-ml: do not break this chain or your machine may crash] + + Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST + Date: 13 February 1982 13:55-EST + From: animal@mit-ml + Sender: ANIMAL at MIT-AI + Subject: do not break this chain or your machine may crash + To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS + cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + + Date: 10 Feb 1982 1937-EST + From: Randy Haskins + Subject: Pass it on + To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn + cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese + Remailed-date: 12 Feb 1982 1217-EST + Remailed-from: J. Scott Hamilton + Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS + Remailed-date: 12 Feb 1982 1416-EST + Remailed-from: Joe Frisbie + Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, +net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at +MIT-DMS, + uc.rdz, uc.plj, uc.rpk + Remailed-date: 12 Feb 1982 2257-EST + Remailed-from: Jon A. Rochlis + Remailed-to: EECS-Hackers: ; + Remailed-date: 12 Feb 1982 2300-EST + Remailed-from: J. Scott Hamilton + Remailed-to: Wizards: ; + Remailed-date: 12 Feb 1982 2351-EST + + Trust in the LORD with all your heart and HE will acknowledge + and HE will light the way. + + + This prayer has been sent to you for good luck. The original + copy is from the Netherlands. It has been around the world + nine times. The luck has now been brought to you. You will + receive good luck within four days of receiving this letter, + provided in turn, you send it back out. DO NOT SEND MONEY, FOR + FAITH HAS NO PRICE. Do not keep this letter. It must leave your + hands within 96 hours after you receive it. An RAF officer + received $70,000. Joe Ellito received $450,000 and lost it + because he broke the chain. While in the Phillipines, General + Welch lost his wife four days after he received this letter. He + failed to circulate the prayer. However, before his death, he + received $775,000. Please send 20 copies and see what happens + to you on the fourth day. This chain comes from Venezuela, and + was written by Saul Anthony deOziof, a missionary from South + America. I, myself, forward it to you. Since the chain must + make the tour of the world, you must make 20 identical copies + to this one. Sned it to your friends, parents, or associates. + After a few days you will get a suprise. This is true even + if you are not superstitious. Take note of the following. + Constantine Dino received the chain in 1953. He asked + his secretary to make 20 copies and send them. A few days later, + he won a lottery for $2,000,000 in his country. Carlo Caditt, + an office employee, received the chain. He forgot it and a few + days later he lost his job. He found the chain letter and sent + it to 20 people. Five days later he got an even better job. + Dolon Fairchild received the chain and not believing it, threw + it away. Nine days later he died. For no reason whatsoever should + this chain be broken. Remember, SEND NO MONEY. + + + Please do not ignore this. IT WORKS! + ------- + + -------------------- +End forwarded message + + +Date: 16 Feb 1982 16:32 PST +From: Fikes at PARC-MAXC +Subject: Open at Once; Time Sensitive +To: Robson, + Brachman@sri-kl,Levesque@sri-kl,bobrow,malone,briansmith,burton,stefik, + waldinger@sri-kl,williams,betsey,weyer,ingalls,cohen,lindsay,kaplan,mann, + mark@isi +cc: fikes + +Don't dispair. Read on. + +--------------------------- + +Date: 16 Feb 1982 14:35 PST +From: Orr at PARC-MAXC +Subject: A quaint folk ritual . . . +To: Brotz, Putman, Swager, Boynton, Collett, MSHunter@USC-ISIB, TMAnley.ES, + Cucinitti, Suchman, AHenderson, Fikes, Reid@Shasta at Sumex-AIM, Stone, + Sargent, Casey, GWilliams, Mallory, Mulhern, Warner, McElyea +cc: + +Ah, folklore . . . Maybe this is what's choking Cabernet today . . . + +--------------------------- + +Date: 16 Feb 1982 11:50 PST +From: kolling at PARC-MAXC +Subject: One good turn deserves another +To: atkinson, gnelson, lknutsen, sturgis, taft, taylor, lrc.hjjh at UTexas-20, + CSVAX.upstill at Berkeley +cc: kolling + + +Mail-from: Arpanet host OFFICE-2 rcvd at 16-FEB-82 1036-PST +Date: 16 Feb 1982 1012-PST +From: Jwagner at OFFICE +Subject: sent to 20@random -- please read -- a surprise +To: BANDY at MIT-AI, ZEVE at RUTGERS, ZELLICH at OFFICE-3, +To: APPLE at MIT-MC, FFM at MIT-MC, CCH at MIT-MC, +To: GEOFF at SRI-CSL, REM at MIT-MC, BILL at SRI-KL, +To: MERRITT at USC-ISIB, AGRE at MIT-AI, LAMSON at MIT-MULTICS, +To: SUE at BRL, KOLLING at PARC-MAXC, CUTTER at MIT-AI, +To: LAUREN at UCLA-SECURITY, CJH at CCA-UNIX, GEOFF at SRI-CSL, +To: ITTA at MIT-MC, ROODE at SRI-KL, DRCPM-SC at OFFICE-7 + +Date: 16 Feb 1982 0005-PST +From: Kleiser +Subject: please read this +To: Oad Staff: +cc: skahn at SRI-KL, lynch at USC-ISIB + +Date: 15 Feb 1982 2349-PST +From: Daul +Subject: amazing message +To: kleiser, kelley +cc: g.bets at SU-SCORE, ADMIN.KNIGHT at SU-SCORE + +Mail from MIT-ML rcvd at 15-Feb-82 2301-PST +Date: 15 Feb 1982 16:19:12-PST +From: mo at LBL-UNIX (Mike O'Dell [system]) +To: msggroup at mit-ai +Cc: +Subject: Nominee for most amazing message ever seen + + +If this little gem doesn't break you mail reader, you are in good shape! + +------- Forwarded Message + +Date: 15 Feb 1982 1500-PST (Monday) +From: jef +To: 20-people@RANDOM-NET +Subject: the following strange message... +Cc: Almquist@CMU-20C, BYRNE@CMU-20C, CSTNBL@MIT-MC, +D.michael@BERKELEY, + ELM@CMU-20C, FISH@MIT-MC, FURST@MIT-MC, Inners@CMU-20C, +Lammert@CMU-20C, + Lomicka@CMU-20C, MJA@CMU-20C, REM@MIT-MC, Schwartz@CMU-20C, +a.slither@BERKELEY, + csvax.DRB@BERKELEY, geoff@SRI-CSL, jacobson, leres, mo, vern + +--- Begin Forwarded Message --- +>From Andrea.Michaels@CMU-10A Mon Feb 15 09:08:14 1982 +Received: Network mail from host MIT-MC for jef on Mon Feb 15 09:07:11 1982 +Date: 14 February 1982 1115-EST (Sunday) +From: Andrea.Michaels at CMU-10A +To: Suzanna.Garreau at CMU-10A, bh at mit-ai, teitz at parc-maxc, + nelson at parc-maxc, +Subject: this is ridiculous, i do not know why i am bothering! +CC: Merrick.Furst at CMU-10A, Mark.Wright at CMU-10A, Brad.Allen at +CMU-10A, + strohm@cmu-780g at CMU-10A, judy rosenberg at CMU-10A, + Steven.Minton at CMU-10A, Bruce.Lucas at CMU-10A, + Richard.Korf at CMU-10A, Betsy.Herk at CMU-10A, + Jim.Gasbarro at CMU-10A, cynthia hibbard at CMU-10A, + sylvia hoy at CMU-10A, sharon burks at CMU-10A, + Glenda.Childress at CMU-10A, dale miller at CMU-10A, + dale moore at CMU-10A +Message-Id: <14Feb82 111506 AM06@CMU-10A> +Origin: C425AM06 at CMU-10A; 14 Feb 1982 1118-EST +Remailed-To: aqe at MIT-MC +Remailed-From: Dale.Moore at CMU-10A +Remailed-Date: Monday, 15 February 1982 1105-EST + + +- - - - Begin forwarded message - - - - +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not +break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST +Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine +may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - End forwarded message - - - - + + + + +------- End of Forwarded Message +------- +------- +End of forwarded mail +------- +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ +Date: 16 Feb 1982 18:58 PST +From: Horning at PARC-MAXC +Subject: Re: A double chain. Don't break it. +In-reply-to: Bobrow's message of 16 Feb 1982 18:26 PST +To: Bobrow +cc: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein +Reply-To: Horning + +Danny, + +The first time I saw this message today, I thought it was kinda funny, but I +foresaw trouble in a finite universe of potential recipients. + +This just could become known as the message that led to the institution of +postage charges for electronic mail. + +Jim H. + + +------------------------------------------------------------ + +------------------------------------------------------------ + + +Date: 1 Mar 1982 15:28 EST +From: Ziobro.Henr at PARC-MAXC +Subject: Boy I sure don't want my machine to crash V.1 +In-reply-to: Keesom.Wbst's message of 24 Feb. 1982 3:50 pm EST (Wednesday) +To: Keesom.Wbst +cc: Marshall.WBST,Bobrow at PARC-MAXC,RUSTY at BBND,Charles E. Leiserson + +cc: Jeffrey Shulman +cc: Rob Liebschutz +cc: Dave Touretzky at CMU-10A +cc: Craig Everhart at CMU-10A +cc: Thomas Rodeheffer at CMU-10A (C410TR30) +cc: MUNOZ@GREEN +cc: Rob Liebschutz +cc: C. Greg Hagerty +cc: ANIMAL at MIT-AI +cc: G.HAMMY at MIT-EECS +cc: Fikes at PARC-MAXC +cc: Orr at PARC-MAXC +cc: kolling at PARC-MAXC +cc: Jwagner at OFFICE +cc: mo at LBL-UNIX +cc: Andrea.Michaels@CMU-10A +cc: SHULMAN at RUTGERS + + Just in case you folks were wondering how far your message got. May I +suggest sending 5 copies back to the originators of the message. I'm sure that +will bring megabytes of good luck. + + This is message 1 of 5. + + //Z\\ +------------------------------------------- +Date: 24 Feb. 1982 3:50 pm EST (Wednesday) +From: Keesom.Wbst +Subject: chains +To: Wegeng.WBST,ziobro.henr +cc: + +Don, + +And you thought your version was bad, here is a version that has clogged up +the net. + +Henk + +--------------------------- + +Date: 22 Feb. 1982 2:12 pm EST (Monday) +From: Marshall.WBST +Subject: Good luck +To: Baroody.WBST, Beh.WBST, Bernard.WBST, Blanchard.WBST, CParker.WBST, + Dattola.WBST, DMurray.WBST, Harrington.WBST, Keesom.Wbst, LJMiller.WBST, + Low.Wbst, Sauvain.WBST, Shoots.Wbst, Butler, Moreland, Allen, Axelrod, + Wayman, Norder, Waal +Reply-To: Marshall + +CoveringMessage + +--------------------------- + +Date: 16 Feb 1982 18:26 PST +From: Bobrow at PARC-MAXC +Subject: A double chain. Don't break it. +To: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein + + +CoveringMessage + +Mail-from: Arpanet host BBND rcvd at 16-FEB-82 1155-PST +Date: 16 Feb 1982 1454-EST +Sender: RUSTY at BBND +Subject: A Chain of Bits! +Subject: [Charles E. Leiserson : Do not break this c...] +From: RUSTY at BBND +To: PBRINKMAN at BBNA, BGOODMAN at BBND, GREENFELD at BBND, +To: GRIGNETTI at BBND, DISRAEL at BBND, LARKIN at BBNG, +To: SCHMOLZE at BBND, SELFRIDGE at BBND, SIDNER at BBND, +To: BSTARR at BBNA, SUSSMAN at BBNA, VITTAL at BBNG, +To: WEBSTER at BBND, YONKE at BBND, ZDYBEL at BBND, +To: BOBROW at PARC, RBRACHMAN at SRI-KL, WEISCHEDEL at UDEL, +To: LEVESQUE at SRI-KL, DONAGHEY at BBNA, TOBIASON at BBND +Message-ID: <[BBND]16-Feb-82 14:54:23.RUSTY> + + +Begin forwarded message +Mail-From: BBNQ +Received-Date: 16-Feb-82 1303-EST +Date: 15 Feb 1982 20:11 EST +From: Charles E. Leiserson +To: RIVEST at MIT-ML, MEYER at MIT-ML, FLAVIO at MIT-ML, + BENNY at MIT-ML, BHATT at MIT-ML, gjs at MIT-AI, lance at MIT-AI, + Reynolds at RAND-AI, bentley at CMU-10A, pinter at MIT-MC +Subject: Do not break this chain or your machine may crash! +Redistributed-To: d4-vlsi-meeting@BBN-UNIX,card-sharks@BBN-UNIX +Redistributed-By: tony lake +Redistributed-Date: 16 Feb 1982 12:55:34 EST (Tuesday) + + Mail-from: ARPANET site CMU-10A rcvd at 15-Feb-82 1337-EST + Mail-Created: 13 Feb 1982 1920-EST by SHULMAN + Date: 13 Feb 1982 1920-EST + From: Jeffrey Shulman + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith + Remailed-date: 13 Feb 1982 2002-EST + Remailed-from: Rob Liebschutz + Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at +RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS + Via: RUTGERS; 13 Feb 1982 2000-EST + Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A + Remailed-From: Dave Touretzky at CMU-10A + Remailed-Date: 13 February 1982 2009-EST + Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST + Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A + Remailed-From: Craig Everhart at CMU-10A + Remailed-Date: Sunday, 14 February 1982 0015-EST + Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + Remailed-To: Pradeep Sindhu at CMU-10A, John Ousterhout at CMU-10A, + Elizabeth Rentmeesters at CMU-10A, + Charles Leiserson at CMU-10A + Remailed-From: Thomas Rodeheffer at CMU-10A (C410TR30) + Remailed-Date: Monday, 15 February 1982 1142-EST + Via: C410TR30 at CMU-10A; 15 Feb 1982 1220-EST + + Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 + Date: Saturday, 13 February 1982 18:59-EST + From: Laz Munoz + To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN + Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your +machine may crash]] + + Date: Saturday, 13 February 1982 18:43-EST + From: C. Greg Hagerty + To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN + Re: [animal@mit-ml: do not break this chain or your machine may crash] + + Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST + Date: 13 February 1982 13:55-EST + From: animal@mit-ml + Sender: ANIMAL at MIT-AI + Subject: do not break this chain or your machine may crash + To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS + cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + + Date: 10 Feb 1982 1937-EST + From: Randy Haskins + Subject: Pass it on + To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn + cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese + Remailed-date: 12 Feb 1982 1217-EST + Remailed-from: J. Scott Hamilton + Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS + Remailed-date: 12 Feb 1982 1416-EST + Remailed-from: Joe Frisbie + Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, +net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at +MIT-DMS, + uc.rdz, uc.plj, uc.rpk + Remailed-date: 12 Feb 1982 2257-EST + Remailed-from: Jon A. Rochlis + Remailed-to: EECS-Hackers: ; + Remailed-date: 12 Feb 1982 2300-EST + Remailed-from: J. Scott Hamilton + Remailed-to: Wizards: ; + Remailed-date: 12 Feb 1982 2351-EST + + Trust in the LORD with all your heart and HE will acknowledge + and HE will light the way. + + + This prayer has been sent to you for good luck. The original + copy is from the Netherlands. It has been around the world + nine times. The luck has now been brought to you. You will + receive good luck within four days of receiving this letter, + provided in turn, you send it back out. DO NOT SEND MONEY, FOR + FAITH HAS NO PRICE. Do not keep this letter. It must leave your + hands within 96 hours after you receive it. An RAF officer + received $70,000. Joe Ellito received $450,000 and lost it + because he broke the chain. While in the Phillipines, General + Welch lost his wife four days after he received this letter. He + failed to circulate the prayer. However, before his death, he + received $775,000. Please send 20 copies and see what happens + to you on the fourth day. This chain comes from Venezuela, and + was written by Saul Anthony deOziof, a missionary from South + America. I, myself, forward it to you. Since the chain must + make the tour of the world, you must make 20 identical copies + to this one. Sned it to your friends, parents, or associates. + After a few days you will get a suprise. This is true even + if you are not superstitious. Take note of the following. + Constantine Dino received the chain in 1953. He asked + his secretary to make 20 copies and send them. A few days later, + he won a lottery for $2,000,000 in his country. Carlo Caditt, + an office employee, received the chain. He forgot it and a few + days later he lost his job. He found the chain letter and sent + it to 20 people. Five days later he got an even better job. + Dolon Fairchild received the chain and not believing it, threw + it away. Nine days later he died. For no reason whatsoever should + this chain be broken. Remember, SEND NO MONEY. + + + Please do not ignore this. IT WORKS! + ------- + + -------------------- +End forwarded message + + +Date: 16 Feb 1982 16:32 PST +From: Fikes at PARC-MAXC +Subject: Open at Once; Time Sensitive +To: Robson, + Brachman@sri-kl,Levesque@sri-kl,bobrow,malone,briansmith,burton,stefik, + waldinger@sri-kl,williams,betsey,weyer,ingalls,cohen,lindsay,kaplan,mann, + mark@isi +cc: fikes + +Don't dispair. Read on. + +--------------------------- + +Date: 16 Feb 1982 14:35 PST +From: Orr at PARC-MAXC +Subject: A quaint folk ritual . . . +To: Brotz, Putman, Swager, Boynton, Collett, MSHunter@USC-ISIB, TMAnley.ES, + Cucinitti, Suchman, AHenderson, Fikes, Reid@Shasta at Sumex-AIM, Stone, + Sargent, Casey, GWilliams, Mallory, Mulhern, Warner, McElyea +cc: + +Ah, folklore . . . Maybe this is what's choking Cabernet today . . . + +--------------------------- + +Date: 16 Feb 1982 11:50 PST +From: kolling at PARC-MAXC +Subject: One good turn deserves another +To: atkinson, gnelson, lknutsen, sturgis, taft, taylor, lrc.hjjh at UTexas-20, + CSVAX.upstill at Berkeley +cc: kolling + + +Mail-from: Arpanet host OFFICE-2 rcvd at 16-FEB-82 1036-PST +Date: 16 Feb 1982 1012-PST +From: Jwagner at OFFICE +Subject: sent to 20@random -- please read -- a surprise +To: BANDY at MIT-AI, ZEVE at RUTGERS, ZELLICH at OFFICE-3, +To: APPLE at MIT-MC, FFM at MIT-MC, CCH at MIT-MC, +To: GEOFF at SRI-CSL, REM at MIT-MC, BILL at SRI-KL, +To: MERRITT at USC-ISIB, AGRE at MIT-AI, LAMSON at MIT-MULTICS, +To: SUE at BRL, KOLLING at PARC-MAXC, CUTTER at MIT-AI, +To: LAUREN at UCLA-SECURITY, CJH at CCA-UNIX, GEOFF at SRI-CSL, +To: ITTA at MIT-MC, ROODE at SRI-KL, DRCPM-SC at OFFICE-7 + +Date: 16 Feb 1982 0005-PST +From: Kleiser +Subject: please read this +To: Oad Staff: +cc: skahn at SRI-KL, lynch at USC-ISIB + +Date: 15 Feb 1982 2349-PST +From: Daul +Subject: amazing message +To: kleiser, kelley +cc: g.bets at SU-SCORE, ADMIN.KNIGHT at SU-SCORE + +Mail from MIT-ML rcvd at 15-Feb-82 2301-PST +Date: 15 Feb 1982 16:19:12-PST +From: mo at LBL-UNIX (Mike O'Dell [system]) +To: msggroup at mit-ai +Cc: +Subject: Nominee for most amazing message ever seen + + +If this little gem doesn't break you mail reader, you are in good shape! + +------- Forwarded Message + +Date: 15 Feb 1982 1500-PST (Monday) +From: jef +To: 20-people@RANDOM-NET +Subject: the following strange message... +Cc: Almquist@CMU-20C, BYRNE@CMU-20C, CSTNBL@MIT-MC, +D.michael@BERKELEY, + ELM@CMU-20C, FISH@MIT-MC, FURST@MIT-MC, Inners@CMU-20C, +Lammert@CMU-20C, + Lomicka@CMU-20C, MJA@CMU-20C, REM@MIT-MC, Schwartz@CMU-20C, +a.slither@BERKELEY, + csvax.DRB@BERKELEY, geoff@SRI-CSL, jacobson, leres, mo, vern + +--- Begin Forwarded Message --- +>From Andrea.Michaels@CMU-10A Mon Feb 15 09:08:14 1982 +Received: Network mail from host MIT-MC for jef on Mon Feb 15 09:07:11 1982 +Date: 14 February 1982 1115-EST (Sunday) +From: Andrea.Michaels at CMU-10A +To: Suzanna.Garreau at CMU-10A, bh at mit-ai, teitz at parc-maxc, + nelson at parc-maxc, +Subject: this is ridiculous, i do not know why i am bothering! +CC: Merrick.Furst at CMU-10A, Mark.Wright at CMU-10A, Brad.Allen at +CMU-10A, + strohm@cmu-780g at CMU-10A, judy rosenberg at CMU-10A, + Steven.Minton at CMU-10A, Bruce.Lucas at CMU-10A, + Richard.Korf at CMU-10A, Betsy.Herk at CMU-10A, + Jim.Gasbarro at CMU-10A, cynthia hibbard at CMU-10A, + sylvia hoy at CMU-10A, sharon burks at CMU-10A, + Glenda.Childress at CMU-10A, dale miller at CMU-10A, + dale moore at CMU-10A +Message-Id: <14Feb82 111506 AM06@CMU-10A> +Origin: C425AM06 at CMU-10A; 14 Feb 1982 1118-EST +Remailed-To: aqe at MIT-MC +Remailed-From: Dale.Moore at CMU-10A +Remailed-Date: Monday, 15 February 1982 1105-EST + + +- - - - Begin forwarded message - - - - +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not +break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at +RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST +Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine +may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - End forwarded message - - - - + + + + +------- End of Forwarded Message +------- +------- +End of forwarded mail +------- +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ + +------------------------------------------------------------ +Date: 16 Feb 1982 18:58 PST +From: Horning at PARC-MAXC +Subject: Re: A double chain. Don't break it. +In-reply-to: Bobrow's message of 16 Feb 1982 18:26 PST +To: Bobrow +cc: Hausladen, stefik, boriello, paeth, orr, rovner, brown, mbrown, Ahenderson, + conway, horning, woods@BBND, norman@NPRDC, burstall, hthompson, Kay, + burton, grignetti@BBN, kim.wilensky@berkeley, marshall.WBST, Guttag at + mit-xx, Klein +Reply-To: Horning + +Danny, + +The first time I saw this message today, I thought it was kinda funny, but I +foresaw trouble in a finite universe of potential recipients. + +This just could become known as the message that led to the institution of +postage charges for electronic mail. + +Jim H. + + +------------------------------------------------------------ + +------------------------------------------------------------ + + +Date: 25 Feb 82 16:10:37-EST (Thu) +From: Joycee at BRL +To: animal at mit-ai +Subject: [Louise Leonard : Keeping the Ball Rolling] + +HEY!! Did you lose this?! We found it on our terminals and +we ALWAYS return lost property. + +----- Forwarded message # 1: + + + + +Date: 19 Feb 82 16:01:37-EST (Fri) +From: Louise Leonard (VLD) +To: joycee at Brl, roslyn at Brl, kitty at Brl, natica at Brl +Subject: Keeping the Ball Rolling + +This is mail without a purpose, except to drive a sane person +crazy. I hope you enjoy this more than I did. + + +----- Forwarded message # 1: + +Date: 18 Feb 82 9:25:55-EST (Thu) +From: John R. Anderson (VLD) +To: louise at Brl +Subject: GOOD LUCK !!! + + Send a copy of this to earl and karen. + +----- Forwarded message # 1: + +Date: 17 Feb 82 9:13:57-EST (Wed) +From: Earl at BRL +To: karen at BRL, rodin at BRL, dpk at BRL, vogel at BRL, jra at BRL + , gil at BRL, kinch at BRL, keller at BRL, gary at BRL, bah at BRL +Via: Brl-Bmd; 17 Feb 82 9:26-EDT + +, hawk at BRL, tyler at BRL, gfa at BRL, skip at BRL, mark at BRL +, nancy at BRL, lapoint at BRL +Subject: Superstitious? + + +----- Forwarded message # 1: + +Date: 16 Feb 82 18:58:57-EST (Tue) +From: Michael Muuss +To: PHD at Brl-Bmd, Kermit at Brl-Bmd, Moss at Brl-Bmd, BobS at Brl-Bmd, + Earl at Brl-Bmd, PNH at Mit-Ai, Jaws at Mit-Mc +cc: Greig at Nswc-Wo +Subject: [Mike O'Dell [sy: Nominee for most amazing message ever seen] + + +----- Forwarded message # 1: + +Date: 15 Feb 1982 16:19:12-PST +From: mo at LBL-UNIX (Mike O'Dell [system]) +To: msggroup at mit-ai +Cc: +Subject: Nominee for most amazing message ever seen +Via: Mit-Ml; 16 Feb 82 1:55-EDT +Via: Brl; 16 Feb 82 16:52-EDT + + +If this little gem doesn't break you mail reader, you are in good shape! + +------- Forwarded Message + +Date: 15 Feb 1982 1500-PST (Monday) +From: jef +To: 20-people@RANDOM-NET +Subject: the following strange message... +Cc: Almquist@CMU-20C, BYRNE@CMU-20C, CSTNBL@MIT-MC, D.michael@BERKELEY, + ELM@CMU-20C, FISH@MIT-MC, FURST@MIT-MC, Inners@CMU-20C, Lammert@CMU-20C, + Lomicka@CMU-20C, MJA@CMU-20C, REM@MIT-MC, Schwartz@CMU-20C, a.slither@BERKELEY, + csvax.DRB@BERKELEY, geoff@SRI-CSL, jacobson, leres, mo, vern + +--- Begin Forwarded Message --- +>From Andrea.Michaels@CMU-10A Mon Feb 15 09:08:14 1982 +Received: Network mail from host MIT-MC for jef on Mon Feb 15 09:07:11 1982 +Date: 14 February 1982 1115-EST (Sunday) +From: Andrea.Michaels at CMU-10A +To: Suzanna.Garreau at CMU-10A, bh at mit-ai, teitz at parc-maxc, + nelson at parc-maxc, +Subject: this is ridiculous, i do not know why i am bothering! +CC: Merrick.Furst at CMU-10A, Mark.Wright at CMU-10A, Brad.Allen at CMU-10A, + strohm@cmu-780g at CMU-10A, judy rosenberg at CMU-10A, + Steven.Minton at CMU-10A, Bruce.Lucas at CMU-10A, + Richard.Korf at CMU-10A, Betsy.Herk at CMU-10A, + Jim.Gasbarro at CMU-10A, cynthia hibbard at CMU-10A, + sylvia hoy at CMU-10A, sharon burks at CMU-10A, + Glenda.Childress at CMU-10A, dale miller at CMU-10A, + dale moore at CMU-10A +Message-Id: <14Feb82 111506 AM06@CMU-10A> +Origin: C425AM06 at CMU-10A; 14 Feb 1982 1118-EST +Remailed-To: aqe at MIT-MC +Remailed-From: Dale.Moore at CMU-10A +Remailed-Date: Monday, 15 February 1982 1105-EST + + +- - - - Begin forwarded message - - - - +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST +Via: C410CE10 at CMU-10A; 14 Feb 1982 0016-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - End forwarded message - - - - + + + + +------- End of Forwarded Message + + +----- End of forwarded messages + +----- End of forwarded messages + + +----- End of forwarded messages + +----- End of forwarded messa + +----- End of forwarded messages + + +Date: 22 Feb 1982 0132-EST +From: Hobbit +Subject: Praise the Lawd!! +To: Junk Recipients: ; + + +... and since *when* is the Arpanet for the distribution +of religious propaganda???? + +_H* +------- + + +Date: 20 Feb 1982 2147-PST +From: Richard Salas +Subject: Re: do not break this chain or your machine may crash +To: animal at MIT-ML +In-Reply-To: Your message of 13-Feb-82 1055-PST + +20-Feb-82 21:47:00-PST,3607;000000000000 +Date: 20 Feb 1982 2146-PST +From: Richard Salas +Subject: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1058-PST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! + +------- +------- +------- +------- + +Date: 19 February 1982 21:09-EST +From: Joseph D. Turner +Subject: Chain letter +To: JWagner at OFFICE-2 +cc: ANIMAL at MIT-MC + +Hello. + Today I recieved my "chain letter". + Now, normally, I appreciate mail from people I don't know. + However, this chain letter was a great dissapointment. + Not only is it misuse of government funds, for which the entire +forwarding list on the letter could be fined and imprisoned, but +half the machines it was sent to djust *don't* have the disk space +(including MIT-AI). + What that chain letter was was childish, wasteful, boring, and +irritating. I would like to know *where* you got my name, and +*why* you put it on the letter. Furthermore, I would request +that you send another letter to the twenty people you sent it +to saying *not* to reforward it. I myself am not forwarding it, +and am saving it on my disk in case I fel like gettign the fools +and twits (yourself included) who did this thing. + + Shade and Sweet Water, + Joseph D. Turner + + + +Date: 19 Feb 1982 1100-EST +From: Dave King +To: SHULMAN at RUTGERS, LIEBSCHUTZ at RUTGERS, HAGERTY at RUTGERS, + ANIMAL at MIT-ML +Subject: [BAIRD at CMU-20C: [Jeffrey Shulman : [Laz Munoz : [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]]]]] +Message-ID: <820118110053KING@CMU-20C> + +- - - - - - - Begin message from: BAIRD at CMU-20C +Date: 14 Feb 1982 1315-EST +From: BAIRD at CMU-20C +To: cunNIUS at CMU-20C, elkIND at CMU-20C, eppINGER at CMU-20C, + engELSIEPEN at CMU-20C, hisgEN at CMU-20C, king at CMU-20C, + duane at CMU-20C, mbj at CMU-20C +Subject: [Jeffrey Shulman : [Laz Munoz : [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]]]] + +- - - - - - - Begin message from: ZSARNAY at CMU-20C +Date: 14 Feb 1982 0412-EST +From: ZSARNAY at CMU-20C +To: Accetta at CMUA, Alleva at CMUA, Philips at CMUA, Nedved at CMUA, + GM0W at CMU-20C, Baird at CMU-20C, Wertz at CMUA +Subject: [Jeffrey Shulman : [Laz Munoz : [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]]]] + +- - - - - - - Begin message from: Jeffrey Shulman +Mail from CMU-10A rcvd at 14-Feb-82 0019-EST +Mail-Created: 13 Feb 1982 1920-EST by SHULMAN +Date: 13 Feb 1982 1920-EST +From: Jeffrey Shulman +Subject: [Laz Munoz : [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]]] +To: dsmith, mitchell, roach, levy, hedrick, prspool, nagel, kastner, + utgoff, cs.applewhite at UTEXAS-20, liebSCHUTZ, sietz, weinrich, + gabinelli, steinberg, schooLEY, kedar-cabelli at RU-GREEN, kelly, + rgsmith +Remailed-date: 13 Feb 1982 2002-EST +Remailed-from: Rob Liebschutz +Remailed-to: Thompson at RUTGERS, Platoff at RU-GREEN at RUTGERS, + Peticolas at RU-GREEN at RUTGERS, Watrous at RUTGERS, Pleasant at RUTGERS, + G.Gold at SU-SCORE, Libes at RUTGERS, Touretzky at CMU-10A, + Jsol at USC-ECLB, Rinehart at RUTGERS, Leone at RU-GREEN at RUTGERS, + Hird at RU-GREEN at RUTGERS, Turock at RU-GREEN at RUTGERS, + Stillman at RU-GREEN at RUTGERS, Zeve at RU-GREEN at RUTGERS, + Evans at RU-GREEN at RUTGERS, Bank at RU-GREEN at RUTGERS, + Gprice at RU-GREEN at RUTGERS, Marantz at RUTGERS, + Magill at RU-GREEN at RUTGERS +Via: RUTGERS; 13 Feb 1982 2000-EST +Remailed-To: Gail Kaiser at CMU-10A, Aaron Wohl at CMU-10A, + Peter Schwarz at CMU-10A, + Craig Everhart at CMU-10A, Joe Newcomer at CMU-10A, + Rick Gumpertz at CMU-10A +Remailed-From: Dave Touretzky at CMU-10A +Remailed-Date: 13 February 1982 2009-EST +Via: C410DT50 at CMU-10A; 13 Feb 1982 2009-EST +Remailed-To: Lawrence Butcher at CMU-10A, Mike Kazar at CMU-10A, + David Nichols at CMU-10A, Philip Lehman at CMU-10A, + Bob Walker at CMU-10A, James Saxe at CMU-10A, + Carolyn Councill at CMU-10A, + Anne Rogers at CMU-10A, James Gosling at CMU-10A, + Brian Reid at CMU-10A, Andrea Michaels at CMU-10A, + Paul Hilfinger at CMU-10A, John Zsarnay at CMU-10A, + Beth Bottos at CMU-10A, Catherine Cole at CMU-10A, + Thomas Rodeheffer at CMU-10A, + Connie Gormley at CMU-10A, Mark Zaremsky at CMU-10A +Remailed-From: Craig Everhart at CMU-10A +Remailed-Date: Sunday, 14 February 1982 0015-EST + +Mail-From: MUNOZ@GREEN created at 13-Feb-82 19:00:45 +Date: Saturday, 13 February 1982 18:59-EST +From: Laz Munoz +To: swhite at GREEN, ssmith at GREEN, zoback at GREEN, seitz at GREEN, + selinger at GREEN, shulman at GREEN, kiesche at GREEN, + fischer at GREEN +Subject: [HAGERTY: [animal@mit-ml: do not break this chain or your machine may crash]] + +Date: Saturday, 13 February 1982 18:43-EST +From: C. Greg Hagerty +To: rcarter at RU-GREEN, rohlfs at RU-GREEN, laird at RU-GREEN, + munoz at RU-GREEN, joseph at RU-GREEN, tobin at RU-GREEN, + borkman at RU-GREEN, newcomb at RU-GREEN, gilroy at RU-GREEN, + gaal at RU-GREEN, Albin at RU-GREEN, Boehm at RU-GREEN, + Cretsinger at RU-GREEN, furman at RU-GREEN, horn at RU-GREEN, + josh at RU-GREEN, latzko at RU-GREEN, naberschnig at RU-GREEN, + pichnarczyk at RU-GREEN, silber at RU-GREEN, laidlaw at RU-GREEN +Re: [animal@mit-ml: do not break this chain or your machine may crash] + +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1416-EST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - - - - End forwarded message +------- +- - - - - - - End forwarded messagen +------- +- - - - - - - End forwarded message + -------- + +Date: 18 Feb 1982 1104-PST +From: The Mailer Daemon +To: ANIMAL at MIT-AI +Subject: Message of 13-Feb-82 10:59:59 + +Message failed for the following: +system at CIT-20: Undeliverable after 5 day(s). + ------------ +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1059-PST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and ays later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! +------- +- - - - - - - End forwarded message +------- +- - - - - - - End forwarded messagen +------- +- - - - - - - End forwarded message + -------- + +Date: 18 Feb 1982 1104-PST +From: The Mailer Daemon +To: ANIMAL at MIT-AI +Subject: Message of 13-Feb-82 10:59:59 + +Message failed for the following: +system at CIT-20: Undeliverable after 5 day(s). + ------------ +Mail-from: ARPANET site MIT-AI rcvd at 13-Feb-82 1059-PST +Date: 13 February 1982 13:55-EST +From: animal@mit-ml +Sender: ANIMAL at MIT-AI +Subject: do not break this chain or your machine may crash +To: ANIMAL at MIT-AI, jc40 at CMU-10B, raibert at CMU-20C, + morguee at CMU-20C, white at CIT-20, docke at CIT-20, + saffen at CIT-20, erik at CIT-20, tfalk at CIT-20, + johnson at RUTGERS, rsmith at RUTGERS +cc: operator at SCRC-TENEX, operator at SU-SCORE, operator at AMES-11, + system at CIT-20, f-s at CIT-20, operator at RUTGERS, + f-s at RUTGERS + + +Date: 10 Feb 1982 1937-EST +From: Randy Haskins +Subject: Pass it on +To: nessus, uc.pws, uc.vark, uc.b, cat.trivi, ls.zaphod, g.hammy, ls.wjn +cc: uc.wjn, pao, ls.betsy, g.wjn, e.cheese +Remailed-date: 12 Feb 1982 1217-EST +Remailed-from: J. Scott Hamilton +Remailed-to: eric at MIT-EECS, jis at MIT-EECS, jaf at MIT-EECS, + g.mel at MIT-EECS, jsol at MIT-EECS, ls.bigmac at MIT-EECS +Remailed-date: 12 Feb 1982 1416-EST +Remailed-from: Joe Frisbie +Remailed-to: cl, uc.mike, g.wmh, g.sa, jtw, e.peggy, uc.mp, jsl, uc.jon, net.hsc, + dcp, ls.uni, rz at MIT-MC, uc.tek, rll, aychu at MIT-AI, shawn at MIT-DMS, + uc.rdz, uc.plj, uc.rpk +Remailed-date: 12 Feb 1982 2257-EST +Remailed-from: Jon A. Rochlis +Remailed-to: EECS-Hackers: ; +Remailed-date: 12 Feb 1982 2300-EST +Remailed-from: J. Scott Hamilton +Remailed-to: Wizards: ; +Remailed-date: 12 Feb 1982 2351-EST + +Trust in the LORD with all your heart and HE will acknowledge +and HE will light the way. + + +This prayer has been sent to you for good luck. The original +copy is from the Netherlands. It has been around the world +nine times. The luck has now been brought to you. You will +receive good luck within four days of receiving this letter, +provided in turn, you send it back out. DO NOT SEND MONEY, FOR +FAITH HAS NO PRICE. Do not keep this letter. It must leave your +hands within 96 hours after you receive it. An RAF officer +received $70,000. Joe Ellito received $450,000 and lost it +because he broke the chain. While in the Phillipines, General +Welch lost his wife four days after he received this letter. He +failed to circulate the prayer. However, before his death, he +received $775,000. Please send 20 copies and see what happens +to you on the fourth day. This chain comes from Venezuela, and +was written by Saul Anthony deOziof, a missionary from South +America. I, myself, forward it to you. Since the chain must +make the tour of the world, you must make 20 identical copies +to this one. Sned it to your friends, parents, or associates. +After a few days you will get a suprise. This is true even +if you are not superstitious. Take note of the following. +Constantine Dino received the chain in 1953. He asked +his secretary to make 20 copies and send them. A few days later, +he won a lottery for $2,000,000 in his country. Carlo Caditt, +an office employee, received the chain. He forgot it and a few +days later he lost his job. He found the chain letter and sent +it to 20 people. Five days later he got an even better job. +Dolon Fairchild received the chain and not believing it, threw +it away. Nine days later he died. For no reason whatsoever should +this chain be broken. Remember, SEND NO MONEY. + + +Please do not ignore this. IT WORKS! + +--- \ No newline at end of file diff --git a/src/games/animal.info b/src/games/animal.info new file mode 100644 index 00000000..64fad8af Binary files /dev/null and b/src/games/animal.info differ diff --git a/src/games/animal.news b/src/games/animal.news new file mode 100644 index 00000000..5e748b30 --- /dev/null +++ b/src/games/animal.news @@ -0,0 +1,9 @@ +KMP@MC 2:38am Monday, 28 June 1982 (Version 129) + +Fixed certain obscure error messages that used to happen after you +apologize to the program for having offended it. The errors can still +happen sadly (not really something in my control to fix completely), but +I hope they'll happen less often. + +That's about it. The game is essentially unchanged over the last two years. +Those interested in old news can print the file BMT1;ANIMAL ONEWS. diff --git a/src/games/animal.onews b/src/games/animal.onews new file mode 100644 index 00000000..71b4dc5d --- /dev/null +++ b/src/games/animal.onews @@ -0,0 +1,53 @@ +KMP@MC 10:28pm Tuesday, 11 March 1980 (Version 122) + +Someone accidentally clobbered the database by trying to load up the game +in a Lisp and run it from there. A very special environment must exist in +order for this game to function correctly -- do NOT attempt to manually +load this thing up in a lisp for whatever reason. As a result, some of the +most recently taught animals will have been lost. I will retrieve the most +recent version of the database from backup tape. Sorry about that. +(In the meantime, an itty bitty game will be left around for people to +play with ... it will go away when the old version is retrieved from tape.) + +Some attempted fixes to the parser -- turns out they didn't work as expected +due to the nature of the pattern matcher. + +KMP@MC 6:03am Saturday, 9 February 1980 (Version 120) + +This version knows how to introspect a bit. Things like "How many animals +do you know?" and "What animals do you know?" will work. + +KMP@MC 1:57am Sunday, 20 January 1980 (Version 107) + +Used to be Animal couldn't grok names the sex of which was ambiguous. +This 'bug' has been fixed at LAUREN's request... + +KMP@MC 4:20am Thursday, 10 January 1980 (Version 103) + +In case people haven't noticed, the game should now call you by the +nickname you specified in :INQUIR ... I may do more fooling with names +later on. If it calls you by an improper subset of your name, please +let me know. + +KMP@MC 3:56am Tuesday, 18 December 1979 (Version 83) + +Bug fixes include: + +(1) Changes better handling of foul languages. It is handled + at a very low level now and harder to get away with. + +(2) The game should now handle hyphenated-words correctly (including hyphens + in the middle of words on continuation lines). + +(3) Typing quoted text for noises (eg, It goes ``meow''.) will now work better + than it used to. Note that the "." has to go after the ''-marks since it + terminates the input string. (Naturally, saying: It goes "meow". + will also work.) + +(4) Some typos in the database have been corrected. + +KMP@MC 3:14pm Saturday, 15 December 1979 + +Animal now has a NEWS feature for keeping up on improvements +to the game. + diff --git a/src/games/animal.origin b/src/games/animal.origin new file mode 100644 index 00000000..fe29b19f --- /dev/null +++ b/src/games/animal.origin @@ -0,0 +1,105 @@ + +(SETQ MEMORY + '((IS THIS ANIMAL A REAL ANIMAL) + (((: HAS-ABILITY) FLY) + (((: HAS-PROPERTY) HORSE-LIKE) + (CYCLOPS) + (((: HAS-POSSESSION) MORE THAN ONE HEAD) + (((: HAS-POSSESSION) A HORN) + (CENTAUR) + (UNICORN)) + (PUSHMEPULLYOU))) + (DRAGON)) + (((: HAS-POSSESSION) WINGS) + (((: HAS-ABILITY) SWIM) + (((: HAS-CLASSIFICATION) MAMMAL) + (((: HAS-CLASSIFICATION) REPTILE) + (((: HAS-PROPERTY) MICROSCOPIC) + (((: HAS-CLASSIFICATION) MARSUPIAL) + (((: HAS-CLASSIFICATION) SPIDER) + (((: HAS-FUNCTION) MAKE PEARLS) + (CLAM) + (OYSTER)) + (BLACKWIDOW)) + (PLATYPUS)) + (VIRUS)) + (((: HAS-CLASSIFICATION) SNAKE) + (LIZARD) + (RATTLESNAKE))) + (((: HAS-PROPERTY) A FRIEND OF MAN) + (((: HAS-CLASSIFICATION) PREDATOR) + (((: HAS-POSSESSION) A LONG TAIL) + (((: HAS-ACTION) WALKS ON TWO LEGS) + (((: HAS-PROPERTY) STRIPED) + (((: HAS-POSSESSION) ANTLERS) + (DEER) + (ANTELOPE)) + (ZEBRA)) + (APE)) + (MONKEY)) + (((: HAS-PROPERTY) FELINE) + (WOLF) + (((: HAS-PROPERTY) STRIPED) + (((: HAS-POSSESSION) SPOTS) + (WILDCAT) + (LEOPARD)) + (TIGER)))) + (((: HAS-STATE) A COMMON HOUSE-PET) + (((: HAS-CLASSIFICATION) BEAST OF BURDEN) + (((: HAS-FUNCTION) GIVE MILK) + (((: HAS-FUNCTION) GIVE WOOL) + (PIG) + (SHEEP)) + (((: HAS-POSSESSION) LEATHERY SKIN) + (GOAT) + (COW))) + (((: HAS-POSSESSION) TUSKS) + (((: HAS-POSSESSION) A HUMP) + (HORSE) + (CAMEL)) + (ELEPHANT))) + (((: HAS-POSSESSION) CLAWS) + (DOG) + (CAT))))) + (((: HAS-HABITAT) IN AND OUT OF WATER) + (((: HAS-PROPERTY) AIR-BREATHING) + (((: HAS-CLASSIFICATION) PREDATOR) + (SEAHORSE) + (SHARK)) + (((: HAS-CLASSIFICATION) PREDATOR) + (((: HAS-PROPERTY) USUALLY ENORMOUS) + (DOLPHIN) + (WHALE)) + (KILLERWHALE))) + (((: HAS-CLASSIFICATION) REPTILE) + (FROG) + (CROCODILE)))) + (((: HAS-POSSESSION) FEATHERS) + (((: HAS-FUNCTION) STING) + (FLY) + (((: HAS-ACTION) BUILDS A NEST) + (MOSQUITO) + (((: HAS-FUNCTION) MAKE HONEY) + (WASP) + (BEE)))) + (((: HAS-FUNCTION) FLY) + (((: HAS-CLASSIFICATION) BARNYARD ANIMAL) + (OSTRICH) + (CHICKEN)) + (((: HAS-CLASSIFICATION) PREDATOR) + (((: HAS-HABITAT) FLOATING ON WATER) + (((: HAS-HABITAT) IN A BIRD CAGE) + (((: HAS-FUNCTION) CARRY MESSAGES) + (((: HAS-ACTION) IS USED AS A SYMBOL OF PEACE) + (SPARROW) + (DOVE)) + (PIGEON)) + (PARAKEET)) + (((: HAS-POSSESSION) LONG NECK) + (DUCK) + (((: HAS-PROPERTY) CONSIDERED VERY BEAUTIFUL) + (GOOSE) + (SWAN)))) + (((: HAS-PROPERTY) NEARING EXTINCTION) + (HAWK) + (EAGLE)))))))) \ No newline at end of file diff --git a/src/games/animal.rules b/src/games/animal.rules new file mode 100644 index 00000000..be6e1608 --- /dev/null +++ b/src/games/animal.rules @@ -0,0 +1,13 @@ +You should think of an animal, and I will try to guess what it is. I +can accept multiple word responses, and I will read your input until I +see a period, exclam, or question mark (unless otherwise noted by the +'(Y OR N)' flag). I'll try to understand input in whatever form you +are comfortable with. As long as you use complete sentences, I should be +fine. Experiment if you want, I'm not as dumb as I may occasionally seem! +If you are not sure of what to do at any time, type a "?" or ask me a +question and I can probably help you. + +This program was written by KMP@MC. Spring, 1978. + +"To err is human -- the animals never err, except the smartest of them." + -- G.C. Lichtenberg diff --git a/src/games/animal.save b/src/games/animal.save new file mode 100644 index 00000000..1dfd5064 --- /dev/null +++ b/src/games/animal.save @@ -0,0 +1,2 @@ + +(((((HAS-STATE))) A (REAL) (((((ANIMAL)))))) KMP ((HAS-STATE HORSE-LIKE) KMP ((HAS-ACTION BREATHES FIRE) ELIOT ((HAS-POSSESSION GREEN SKIN) ELIOT ((HAS-STATE A FRIEND OF SNOOPY) ELIOT ((HAS-STATE A FLYING BAT-FEMALE) ELIOT ((HAS-ACTION HAS FURRY FEET) ELIOT ((HAS-ACTION EATS (PEOPLE/'S) MINDS) ELIOT ((HAS-ACTION HAS ONE EYE) EJS ((HAS-STATE A SMALL FURRY CREATURE) DAN ((HAS-STATE A SILICON-BASED LIFEFORM) DAN ((HAS-PROPERTY BLACK) ELIOT ((HAS-ACTION LIVES IN THE WATER) GRAND ((HAS-STATE AN UNDEAD) GRAND ((HAS-ACTION FLIES) ROGERS ((HAS-STATE A NOTHING) KOVAR ((HAS-ACTION HAS POINTY EARS) MSI ((HAS-ACTION LIVES IN TOLKIEN/'S STORIES) DAN ((HAS-ACTION (WRITES ABOUT HIM)) ELIOT ((HAS-STATE GELATINOUS) TANG ((HAS-ACTION GOES |'BLEEP'|) MSI ((HAS-ACTION (IS SHORT)) ZANAR ((HAS-STATE EXTREMELY INTELLIGENT) LAUREN ((HAS-ACTION (LIKES) SELLING USED EQUIPMENT) LAUREN ((HAS-STATE VISIBLE TO HEALTHY PEOPLE) GRAND ((HAS-STATE HUMAN) SHL ((HAS-STATE MADE OF SNOW) LAUREN ((HAS-STATE AN ELEPHANT-RHINO CROSS) SHL ((HAS-STATE MUCH MORE NOISY) SPERRY ((HAS-ACTION (IS NOT) PINK) KRAUSS ((HAS-ACTION SCABS) TXI ((HAS-ACTION STAYS UP TOO LATE PLAYING ANIMAL II OVER A LONG DISTANCE PHONE LINE) HEAD ((HAS-STATE AN ANNOYING LITTLE MACHINE) BILBO ((HAS-ACTION WHERE IS PINK PAJAMAS IN AN ELEPHANT SUIT) BART ((HAS-ACTION SMELLS VERY BAD) HARV ((HAS-STATE PINK) HOEY ((HAS-STATE EXTREMELY RARE) KMP ((HAS-ACTION SAYS N) KMP ((HAS-STATE A TERMINAL WITH ONLY AN |'N'| KEY) GERN ((HAS-ACTION LISTENS TO NANCY REAGAN) A2DEH (|NONE OF THE ABOVE| HOEY) (|JUST SAY NO KID| A2DEH)) (|| GERN)) (N KMP)) (|EVEN FEWER OF THE ABOVE| KMP)) ((HAS-ACTION (HAD A GREAT FALL)) BOYACK (|PINK ELEPHANT| GRAND) (|HUMPTY DUMPTY| BOYACK))) (|" USED DOG " SALESMAN| HARV)) (MOTHER BART)) (TERMINAL BILBO)) ((HAS-STATE NICE) COOKIE (|FUZZY DUNDERHEAD| HEAD) (COOKIE COOKIE))) ((HAS-STATE UGLIER THAN A SASAND PAPER SALLY) SICC (|SASAND -PAPER SALLY| TXI) (ME SICC))) ((HAS-ACTION HAS A LONG NOSE) VP ((HAS-ACTION GLIBBERS) MIKE ((HAS-ACTION EATS PEOPLE) A2DEH ((HAS-ACTION HAS TWO HEADS) GERN (|LEATHER-BACK GNOMANY| KRAUSS) (ZAPHOD GERN)) (|UMBER HULK| A2DEH)) (GHOUL MIKE)) (HEFALUMP VP))) ((HAS-STATE ALIVE) KRAUSS (|S-100 BUS| SPERRY) (|LEATHER-BACK GNOMONY| KRAUSS))) (HELLIFINO SHL)) (|FROSTY THE SNOWMAN| LAUREN)) ((HAS-ACTION SAYS /'WATCH OUT FOR THAT TREE) HEAD ((HAS-ACTION (IS UGLY)) ELMO (|INVISIBLE MAN| SHL) ((HAS-ACTION HAS THE HEAD OF A BULL) SICC (|JEFF COFFLER| ELMO) (MINOTAUR SICC))) (|GEORGE OF THE JUNGLE| HEAD))) ((HAS-STATE A SPORE THAT FALLS ON PERN) SHL ((HAS-ACTION EATS METAL) LAUREN ((HAS-ACTION WANTS TO DOMINATE THE GALAXY) LAUREN ((HAS-STATE SMALLER THAN A (GIANT)) PAULP ((HAS-ACTION CLIMBS THE EMPIRE STATE BUILDING) LAUREN ((HAS-STATE A WALKING SEWER) DT ((HAS-STATE A MATHEMATICAL CONCEPT) SHL ((HAS-ACTION MOVES FROM THE RIM OF THE GALAXY INWARDS TO THE CORE) BDH ((HAS-PROPERTY PURPLE) |M.JR| ((HAS-ACTION EXISTS ON A BLUE OYSTER CULT ALBUM COVER) DUFTY ((HAS-STATE MADE FROM STONE) JDC ((HAS-STATE SMALLER THAN A |THATN A GIANT|) ARPEE ((HAS-STATE CHAOTIC EVIL) PERSA (GIANT EJS) (N PERSA)) (|PLUTO THE DOG| ARPEE)) ((HAS-POSSESSION A CAT-HEAD) MOBIUS (GOLLEM JDC) (SPHINX MOBIUS))) (|CULTOSAURUS ERECTUS| DUFTY)) (WORM |M.JR|)) (STARSEED BDH)) (|MONSTER CURVE| SHL)) ((HAS-ACTION LIVES IN THE DESERT ON ARAKUS) GZ (|SHAMBLING MOUND| DT) (SANDWORM GZ))) (|KING KONG| LAUREN)) ((HAS-STATE A HUMAN) SHL ((HAS-ACTION BARKS) LAUREN ((HAS-ACTION ROLLS) MWMT ((HAS-HABITAT IN NARNIA) MWMT ((HAS-ACTION LIVES IN RAMA) SHL ((HAS-ACTION SAYS /'I SAY -- I SAY /, BOY) PALLAS ((HAS-ACTION CAN TURN YOU TO STONE) PALLAS ((HAS-ACTION CAN NEVER PULL A RABBIT OUT OF A HAT) LAUREN ((HAS-STATE INEDIBLE) ERIC ((HAS-ACTION HAS A BULLS HEAD) ETHAN ((HAS-ACTION LIVES IN ITS OWN COMIC BOOK) KMP (GINGERBREADMAN PAULP) (|DONALD DUCK| KMP)) (MINOTAUR ETHAN)) ((HAS-STATE MADE OF STONE) JDC ((HAS-STATE A PALE BLUE LIZARD WITH ORANGE-BROWN SPOTS) COOKIE (WUMPUS ERIC) (GECKO COOKIE)) (GOLLEM JDC))) ((HAS-ACTION HAS THE INTELLIGENCE OF A BOWLING BALL OR MIKE MCDEVITT) ELIOT ((HAS-ACTION HAS FOUR VERY HHARD LEGS) PERSA ((HAS-ACTION WILL NEVER ATTACK A SPIDER) PERSA (|BULLWINKLE THE MOOSE| LAUREN) (ADHERER PERSA)) (ACHAIERAI PERSA)) ((HAS-ACTION ISS EEMIT A LOUD PIERCING SOUND) PERSA ((HAS-ACTION HAS A GAME NAMED AFTER IT) JON-O (DOLT ELIOT) (WUMPUS JON-O)) (SHRIEKER PERSA)))) ((HAS-ACTION HAS SNAKES FOR HAIR) ALLAN (GORGON PALLAS) (MEDUSA ALLAN))) (|FOGHORN LEGHORN| PALLAS)) (BIOT SHL)) ((HAS-ACTION LIVES IN SWAMPS) MWMT ((HAS-STATE SKILLED IN MAGIC) MWMT (DUFFLEPUD MWMT) ((HAS-STATE IS THE SON OF THE EMPEROR OVER THE SEA) MWMT (HAG MWMT) (ASLAN MWMT))) (MARSH-WIGGLE MWMT))) ((HAS-ACTION HS WHEELS) SICC (HOOP-SNAKE MWMT) (|TROJAN RABBIT| SICC))) (|DINO THE DINOSAUR| LAUREN)) ((HAS-ACTION (SWINGS FROM) VINES) LAUREN ((HAS-STATE AFTER A WASCALLY WABBIT) LAUREN ((HAS-ACTION CRUSHES BEER CANS ON ITS HEAD) PALLAS ((HAS-ACTION GETS STRONGER WHEN YOU KILL SOME OF ITS KIND THAN (IT WAS) BEFORE) SHL ((HAS-STATE LOOKING FOR A SHRUBBERY) PALLAS ((HAS-ACTION (WORKS FOR THE LOS ANGELES TRIBUNE)) KMP ((HAS-ACTION (WANTS TO DESTROY THE ARCH OF TIME)) NESSUS ((HAS-STATE AA |'10'| |'10'|) MINDLE ((HAS-ACTION SOLD HIS COW FOR A AHNDFUL OF BEANS) COOKIE (|PENCIL NECK GEEK| LAUREN) (JACK-IN-THE-BEANSTALK COOKIE)) (|BO DEREK'S CLIT| MINDLE)) (LORDFOUL NESSUS)) (|LOU GRANT'S REPORTER| KMP)) (|KNIGHTS WHO SAY 'NI| PALLAS)) (HUNTSMAN SHL)) (BLUTTO PALLAS)) (|ELMER FUDD| LAUREN)) (TARZAN SHL)))) ((HAS-STATE INTO COMPUTERS) PTS ((HAS-ACTION CARRIES SILVER SWORDS) PERSA (KLINGON LAUREN) (GITHYANKI PERSA)) ((HAS-STATE A FISH) SAZ ((HAS-ACTION WEARS IZOD SHIRTS) BOYACK (CDR PTS) (|SLOAN SCHOOL GRAD| BOYACK)) (TROUT SAZ)))) ((HAS-ACTION LIVES IN RAMA) SHL ((HAS-ACTION EATS EVERYTHING IT SEES) A2DEH (|METAL-MUNCHING MOON MOUSE| LAUREN) (|BEAST OF TROLL| A2DEH)) (BIOT SHL))) (THREAD SHL))) ((HAS-STATE A SILLY USED CAR DEALER IN LOS ANGELES) HEAD ((HAS-STATE AS SMART AS A JAWA) HARV (|ITT EXECUTIVE| HARV) (JAWA LAUREN)) (|CAL WORTHINGTON & HIS DOG SPOT >| HEAD))) ((HAS-STATE A VEGETARIAN) PAULP ((HAS-ACTION NEVER MUTATES) SHL ((HAS-STATE HYDROGEN BASED) HEAD ((HAS-ACTION LIKES TO GET ALL NUDDED UP) PTS ((HAS-STATE A PROPHET) VP ((HAS-ACTION CARES) A2DEH (DR A2DEH) (KRELL LAUREN)) (M/'UAD-DIB VP)) (MORLOC PTS)) (OUTSIDER HEAD)) ((HAS-ACTION CAN CALL AN INVISIBLE STALKER) JKESS (|JINXIAN BANDERSNATCH| SHL) (|MAGIC USER NAMED KESHLAM| JKESS))) ((HAS-STATE SUNDAY) SHL ((HAS-POSSESSION THREE LEGS) HEAD ((HAS-STATE VERY WRINKLED) JKESS ((HAS-STATE LARGER THAN A PIERSON/'S) TANG (PIERSON/'S PAULP) (BANDERSNATCH TANG)) (|PAK PROTECTOR| JKESS)) (|PEIRSON'S PUPPETEER| HEAD)) (PUPPETEER SHL)))) ((HAS-STATE /15 INCHES LONG /, THIRTY-SIX LEGS /, & THE SHARPEST TRADER (THAT) (A) CONNIVING EARTHMAN EVER MET) HEAD ((HAS-STATE GIVEN TO SAYING OOOOOH NOOOO) HEAD ((HAS-ACTION LIVES IN A FREAKIE TREE) SICC ((HAS-ACTION NOS) JRF ((HAS-STATE HUMAN LIKE) BILBO ((HAS-POSSESSION TENTACLES) COOKIE ((HAS-ACTION COMES FROM OUTER SPACE) IWASA ((HAS-STATE MADE OF ALUMINUM) KMP (|DONALD DUCK| JRF) (|CROCHET HOOK| KMP)) (E IWASA)) (|CARRION CRAWLER| COOKIE)) ((HAS-STATE AFRAID OF WICKED WITCH OF THE NORTH) COOKIE ((HAS-STATE IRISH) LOIEDE ((HAS-STATE MAYAN IN DERIVATION) DMK ((HAS-ACTION COMES FROM OUTER SPACE) ARK (|OOMPA LOOMPA| BILBO) ((HAS-STATE AN EGG /, IT HAS A JOB /, IT IS MUCH SHINIER /, IT IS NOT A WIERDO LIKE E THAN AN ET) BATES (ET ARK) (|GANZER EGG| BATES))) (QUETZEQUOTL DMK)) (LEPRACHAUN LOIEDE)) (MUNCHKIN COOKIE))) (|CAPTAIN KIRK| ZANAR)) (FREAKIE SICC)) (|MR BILL| HEAD)) (MESKLINITE HEAD))) ((HAS-HABITAT IN DOCTOR WHO STORIES) MWMT ((HAS-STATE USED UNSCRUPULOUSLY BY NETWORK CENSORS) HEAD (COMPUTER MSI) (|REACTION TO AN UNCHASTE COMMENT| HEAD)) (K-9 MWMT))) ((HAS-STATE IN A MOVIE WITH STEVE MCQUEEN) HEAD ((HAS-STATE DROPPING ON YOUR HEAD RIGHT NOW) SICC ((HAS-ACTION LIVES ON JINX) RDUKE ((HAS-ACTION EATS EVERYTHING) ALY (|OCHRE JELLY| TANG) (|SLIME MONSTER| ALY)) (BANDERSNATCH RDUKE)) (|SLIME MOLD| SICC)) (BLOB HEAD))) (|TNE GREY MOUSER| ELIOT)) ((HAS-ACTION KILLED GANDALF) MSI ((HAS-STATE USED IN BATTLE) MWMT ((HAS-ACTION HAS A SOFT UNDERBELLY) MWMT ((HAS-STATE TWELVE FEET TALL) ELMO (HOBBIT DAN) (|STONE GIANT| ELMO)) (SHELOB MWMT)) ((HAS-STATE HUMANOID) EULER (OLIPHAUNT MWMT) (ORC EULER))) (BALROG MSI))) ((HAS-ACTION HAS GREEN SKIN) PLK ((HAS-PROPERTY WHITE) RBARCK ((HAS-STATE A MUPPET) SHL ((HAS-ACTION LOVES NATURE) BLOTTO ((HAS-STATE A HAPPY CARTOON ANIMAL) ARPEE ((HAS-STATE MADE OF STONE) RAM ((HAS-ACTION HAS FOUL BREATH) A2DEH (WAYNHIM SHL) ((HAS-ACTION CAN GET STONED LOOKING AT A BASILISK) JSOL (ORC A2DEH) (BASILISK JSOL))) (SPHINX RAM)) (|PLUTO THE CARTOON DOG| ARPEE)) (ELF BLOTTO)) ((HAS-STATE A YEDI MASTER) SICC (|MISS PIGGY| PLK) (YODA SICC))) ((HAS-ACTION MATE ONLY ONCE IN /7 YEARS) CLEMW (UNICORN RBARCK) (VULCAN CLEMW))) ((HAS-ACTION LIVES NEAR A TREE) MIKE ((HAS-STATE A VERY LOGICAL SCIENCE OFFICER WITH NO SENSE OF HUMOR) HEAD (ELF MSI) (|MR SPOCK| HEAD)) (ENT MIKE)))) ((HAS-ACTION HAS A VALUE OF /0) KARIM ((HAS-ACTION TAKES UP NO SPACE /, EATS NOTHING /, SAYS NOTHING /, & IS NOT THERE) HEAD (|| KOVAR) ((HAS-STATE LIKELY TO FORGET WHAT OFFICE HE IS IN) HEAD (UNANIMAL HEAD) (|RONALD REAGAN| HEAD))) (|ASCII NULL| KARIM))) ((HAS-PROPERTY WHITE) JHC ((HAS-ACTION SETS ITSELF ON FIRE) LAUREN ((HAS-ACTION DRINKS TO SEE A PINK ELEPHANT) HOEY ((HAS-STATE MUCH LARGER THAN ANYTHING) DT ((HAS-POSSESSION EYESTOCKS) A2DEH ((HAS-ACTION NEEDS A BETA-CAPSULE) PALLAS ((HAS-STATE AN AIRPLANE) CDS ((HAS-ACTION BURBLES) KMP ((HAS-ACTION SINGS /" HERE I COME TO SAVE THE DAY /") RDUKE ((HAS-ACTION WINDS UP A TARN) DAN ((HAS-STATE ALIVE) LOIEDE (|MECHANICAL BIRD| DAN) (HARPY LOIEDE)) (TARN LAUREN)) (|MIGHTY MOUSE| RDUKE)) (JABBERWOCKY KMP)) ((HAS-STATE A FIGHTER PLANE) KMP (B-52 CDS) (F115 KMP))) ((HAS-ACTION CAN PERFORM MAGIC) DAUL (ULTRA-MAN PALLAS) (FAIRY DAUL))) (BEHOLDER A2DEH)) ((HAS-STATE A FRIEND OF DOCTOR DOOLITTLE) SHL ((HAS-STATE AS INTELLIGENT AS A HUMAN) SHL ((HAS-ACTION CAN FLY) SBM (ROC DT) (GRIFFON SBM)) ((HAS-STATE AN EAGLE THE SIZE OF A ELEPHANT) LSO ((HAS-ACTION DOES 1-3 POINTS OF DAMAGE PER ATTACK |(| IT HAS TWO |)|) PERSA (M-5 SHL) (AARAKOCRA PERSA)) (ROC LSO))) (|LUNAR MOTH| SHL))) (|PINK ELEPHANT| HOEY)) (PHOENIX ROGERS)) ((HAS-ACTION SHOWS UP IN SATURDAY MORNING CARTOONS) CLEMW ((HAS-PROPERTY RELATED) COCO ((HAS-PROPERTY RELATED) COCO ((HAS-STATE A MYTHICAL GIANT BIRD) LENS ((HAS-ACTION APPEARS AS A GHOSTLY BALL OF LIGHT) MWT ((HAS-ACTION EATS MAGICAL ENERGY) JKESS ((HAS-STATE MADE OF METAL) EJS (ANGEL JHC) (|B-1 BOMBER| EJS)) (|ORAGAMI _ MONSTER| JKESS)) (WILL-O-WISP MWT)) (ROC LENS)) (ROCK-BIRD COCO)) ((HAS-ACTION BREATHS COLD) TOM (ROCK-BIRD COCO) (DRAGON TOM))) ((HAS-ACTION LIVES IN A GLOVE COMPARTMENT) DH (|CASPER THE FRIENDLY GHOST| CLEMW) (|FRIENDLY PHANTOM| DH))))) ((HAS-POSSESSION FANGS) MSI ((HAS-PROPERTY EVIL) DAN ((HAS-PROPERTY EVIL) JANUS (|CHINESE DRAGON| JANUS) ((HAS-STATE SOLID) SICC (GHOST DAN) (ZOMBIE SICC))) ((HAS-STATE AS EVIL AS A GHOULE) DAN (GHOST DAN) ((HAS-ACTION HAS BANDAGES ALL OVER IT) |M.JR| (GHOULE GRAND) (MUMMY |M.JR|)))) (VAMPIRE MSI))) ((HAS-STATE NON-HUMANOID) GRAND ((HAS-ACTION SAYS /'MY PRECIOUSS/') EULER (MERMAID GRAND) (GOLLUM EULER)) ((HAS-STATE PUTRID) MPA ((HAS-STATE A FRIEND OF DOCTOR DOLITTLE) SHL ((HAS-ACTION LIVES IN THE CYLINDRICAL SEA) SHL ((HAS-ACTION DISGUISES ITSELF AS AN ISLAND) MWMT ((HAS-PROPERTY BLACK) BILLT (SEA-SERPENT GRAND) (BANDERSNATCH BILLT)) ((HAS-STATE APATHETIC) MCTESQ (FASTITOCALON MWMT) (|BLISSFUL PLATYPUS| MCTESQ))) (BIOT SHL)) (|GIANT PINK SEA SNAIL| SHL)) (FUNGUS MPA)))) ((HAS-ACTION HAS NEVER MADE LOVE) KOVAR ((HAS-POSSESSION A WHEEL) JHC ((HAS-STATE A RUTHLESS INSECT HUHUMANIOD FIGHTER) ELIOT ((HAS-STATE WORSE THAN DEATH) SHL ((HAS-ACTION (IS ALIVE)) BILBO (DEATH ELIOT) ((HAS-STATE AN INSECT) ALLAN (|FAT ALBERT| BILBO) (COOTIE ALLAN))) ((HAS-ACTION LIVES IN MIDDLE EARTH) SY (UR-VILE SHL) (BALROG SY))) (PHRAINT ELIOT)) (POLARIAN JHC)) ((HAS-STATE FROM A FANTASY STORY) SHL ((HAS-STATE A RESULT OF POOR HYGEINE) HEAD ((HAS-ACTION HAS ROUND EARS) SICC ((HAS-STATE A REPTILE) PECM ((HAS-STATE A SLIMY CREATURE THAT HIDES IN THE DARK) HUBRD ((HAS-STATE SQUARE) JEFFH ((HAS-ACTION DRAINS THE LIFE FORCE FROM DYING CREATURES) PERSA ((HAS-ACTION LIKES SUGAR) BOYACK (VIRGIN KOVAR) (|GIANT MUTANT ANT| BOYACK)) (TRILLOCH PERSA)) (|FLOPPY DISK| JEFFH)) ((HAS-ACTION LIVES IN OUTER SPACE) A2DEH (GRUE HUBRD) (ALIEN A2DEH))) (GODZILLA PECM)) ((HAS-ACTION SMELLS) RWG (|MICKEY MOUSE| SICC) (HEADPHONES RWG))) (|BLACKHEAD ( PIMPLE )| HEAD)) ((HAS-ACTION HAS BIG BLACK /, ROUND EARS) ARPEE ((HAS-STATE AN ARACHNID) LAH ((HAS-ACTION A SPIRIT OF DEATH) BERG ((HAS-ACTION LIVES IN A MAZE) DADA ((HAS-STATE A BIG WHEEL) NESSUS ((HAS-STATE THE CREATOR OF THE BALROGS) PERSA (|DROOL ROCKWORM| SHL) (|MORGOTH BAUGLIR| PERSA)) (GAEA NESSUS)) (MINOTAUR DADA)) (BALROG BERG)) (SHELOB LAH)) (|MICKEY MOUSE| ARPEE))))) ((HAS-ACTION HAS RANDOM ACCESS MEMORY) EULER ((HAS-POSSESSION WASTIES) MGRANT ((HAS-ACTION GLOWS IN THE DARK) PSY ((HAS-ACTION EATS ROCKS) PERSA ((HAS-ACTION LIVES ON DUNE) PERSA (HORTA DAN) (SANDWORM PERSA)) ((HAS-ACTION LIVES IN STAR TREK) MOBIUS (DENZELIAN PERSA) (HOYA MOBIUS))) (ATROH PSY)) (DRIMBING MGRANT)) ((HAS-STATE JUNKY) MAZE ((HAS-ACTION CONTAINS OTHER ANIMALS) VP ((HAS-STATE A VERY CHEAP COMPUTER WITH LIMITED EXPANDABILITY) HEAD ((HAS-STATE A REAL COMPUTER) GERN (|EXIDY SORCERER| EULER) (|ZENITH Z-100| GERN)) (|VIDEO BRAIN 101A| HEAD)) ((HAS-ACTION HAS VIRTUAL MEMORY OF /2 ^ /32 BITS) SKH ((HAS-STATE A BIG WHEEL) NESSUS ((HAS-ACTION COSTS LESS HAN $ 5K) GERN (PDP-10 VP) (|ZENITH Z-100| GERN)) (GAEA NESSUS)) (|VAX 11| SKH))) (TRASH-80 MAZE)))) ((HAS-STATE A DOG) PLK ((HAS-STATE AN OTTER) PLK ((HAS-ACTION HAS LARGE /, ROUND EARS) ARPEE ((HAS-ACTION HAS THE FACE OF A CAT) GZ ((HAS-POSSESSION THREE EYES) SKH ((HAS-STATE ROUND) SKH ((HAS-ACTION PLAYS CHESS) VP ((HAS-ACTION SWIMS) SHOR (PATZER VP) (SEAHORSE SHOR)) (TRIBBLE DAN)) ((HAS-ACTION EATS TRITICALE) CEH ((HAS-STATE VERY FURRY) LEVIN (|TENNIS BALL| SKH) (TRIBBLE LEVIN)) (TRIBBLE CEH))) (|MARTIAN BOUNCER| SKH)) ((HAS-ACTION (ACTS IN A CARTOON)) COOKIE (CATTAIL GZ) ((HAS-PROPERTY CALVIN/'S) GERN (|` FRITZ THE CAT'| COOKIE) (HOBBES GERN)))) ((HAS-ACTION WEARS A CAPE) RDUKE (|MICKEY MOUSE| ARPEE) ((HAS-ACTION GOES AROUND SAYING /, /" VARK /, VARK) SEH (|MIGHTY MOUSE| RDUKE) (AARDVARKANIAN SEH)))) (MIJ PLK)) ((HAS-ACTION CAN WEEZ) DKR (NERMAL PLK) (WEEZY DKR)))) ((HAS-STATE A ROBOT) COUGH ((HAS-ACTION HAS HAIR THE THAT IS FIVE FEET LONG) HEAD ((HAS-STATE IN TOLKIEN/'S STORIES) SICC ((HAS-ACTION STOMPS ON GERBILS) PTS ((HAS-POSSESSION A CRT) GERN ((HAS-ACTION LIVES IN CANS OF TOMATO SAUCE) BOYACK (CYCLOPS KMP) (SPAGETTIO BOYACK)) (|TERMINAL A TERMINAL| GERN)) (BERG PTS)) (SAURON SICC)) (GINGERLING HEAD)) (MARD/'KOID COUGH))) ((HAS-ACTION (HAS TENTACLES)) ELIOT ((HAS-STATE A COMPUTER GAME) DEVON ((HAS-POSSESSION TREMENDOUS PSI POWERS) SHL ((HAS-STATE NEVER SEEN) JWP ((HAS-POSSESSION ONE EYE) HEAD ((HAS-ACTION HAS A WORM BODY) EDWIN (|THREE-EYED ONE-HORNED FLYING PURPLE PEOPLE EATER| HOEY) (|NERVE RUNNER| EDWIN)) ((HAS-POSSESSION A HORN) GMR (CYCLOPS GMR) (|ONE-EYED ONE-HORNED FLYING PURPLE EATER| HEAD))) ((HAS-POSSESSION BIG RUBBER FEET) HARV ((HAS-STATE A FORMLESS MASS THAT ABSORBS OTHER MATERIAL) SULLIV (GRUE JWP) (BLOB SULLIV)) (|AC COBRA| HARV))) ((HAS-STATE FROM ORADO) HEAD ((HAS-ACTION DOES DRUGS) TOWNSE ((HAS-STATE AN UNDEAD) ALY ((HAS-STATE POWERFULL) KYRHIZ (|BRAIN MOLE| |M.JR|) (PSOLARA KYRHIZ)) (NAZGUL ALY)) (|GUMBY @ AI| TOWNSE)) (SPOOK HEAD))) ((HAS-ACTION /'TWISTY MAZE WITH PASSAGES ALL ALIKE/') GHSCC (ZORK DEVON) ((HAS-STATE BETTER THAN ADVENTURE) MOBIUS (ADVENTURE GHSCC) (ZORK MOBIUS)))) ((HAS-STATE MATHEMATICAL) REM (|MIND FLAYER| ELIOT) ((HAS-ACTION SELLS BAD) BAUMAN (|KNUTH'S BASE| REM) ((HAS-STATE TIRED) KLOTZ (|COURSE 6| BAUMAN) (|| KLOTZ)))))) ((HAS-ACTION (IS) HUMANOID) GRAND ((HAS-PROPERTY BLUE) CSTACY ((HAS-STATE A MOOSE) PLK ((HAS-ACTION (EATS PIZZA)) ZANAR ((HAS-ACTION HAS A MAGIC BAG) LAUREN ((HAS-ACTION LIKES (GNAWING) ON CARROTS) LAUREN ((HAS-ACTION LIKES TO SAY /, /" ((HERE)) I COME TO SAVE THE (DAY /")) LAUREN ((HAS-PROPERTY UGLY) LAUREN ((HAS-STATE PART EAGLE) LAUREN ((HAS-ACTION SINGS /'OH /, MY DARLING CLEMENTINE/') LAUREN ((HAS-STATE MUCH MORE (VICIOUS THAN MOST ANIMALS)) SHL ((HAS-ACTION (KILLS SNAKES)) PALLAS ((HAS-STATE FUN TO CUDDLE) PALLAS ((HAS-STATE VERY CARNIVOROUS) BDH ((HAS-ACTION ENEMY WAS RIFFRAFF) DANIEL ((HAS-ACTION STARS IN X-RATED CARTOONS) COOKIE ((HAS-ACTION TRIES AGAIN) MSS ((HAS-ACTION FRIEND IS RAGLAND T) JDG (|CHESHIRE CAT| MSS) (|CRUSADER RABBIT| JDG)) (|ROCKY THE FLYING SQUIRRLE| GRAND)) (|FRITZ THE CAT| COOKIE)) (UNDERDOG DANIEL)) ((HAS-ACTION GRINS) DADA (KZIN BDH) (|CHESHIRE CAT| DADA))) ((HAS-ACTION DRINKS TEA REGULARLY) SICC ((HAS-ACTION DOES LESS WHOLESOME THINGS IN BED) COOKIE ((HAS-STATE A CHARACTER IN A BOOK BY E B WHITE) KMP ((HAS-ACTION LIVES IN A GALAXY FAR FAR AWAY) KMP ((HAS-ACTION (IS A KIND OF TEDDY BEAR)) KMP (|TEDDY BEAR| PALLAS) (BEARNEY KMP)) (|EWOK BEAR| KMP)) (|STUART THE MOUSE| KMP)) (|FRITZ THE CAT| COOKIE)) (|PADDINGTON BEAR| SICC))) (RIKKI-TIKKI-TAVI PALLAS)) ((HAS-STATE LIKE A GRIFFIN) SULLIV (|KZINTI WARRIOR| SHL) (MANTICORE SULLIV))) (|HUCKLEBERRY HOUND| LAUREN)) (GRIFFON LAUREN)) ((HAS-STATE LIKE A LION) JRF ((HAS-POSSESSION A TRUNK) CEH ((HAS-ACTION (IS BIG)) JOSE ((HAS-ACTION MAKES PUPPIES COWER WHEN IT IS AROUND) DH ((HAS-PROPERTY MEAN) NESSUS ((HAS-ACTION LAUGH) KMP (ORK LAUREN) (GOOFY KMP)) (KZIN NESSUS)) ((HAS-STATE FRIENDLY WITH ORC TYPES) MWT ((HAS-ACTION HAS /3 HEADS) EPSTED ((HAS-ACTION BES FED AFTER MIDNIGHT) LAUREN (GREMLIN LAUREN) ((HAS-ACTION BES FED AFTER MIDNIGHT) LAUREN (GREMLIN LAUREN) (PUPPYSTOMPER DH))) (CERBERUS EPSTED)) (WARG MWT))) (|KING KONG| JOSE)) (SNUFFLEUPAGUS CEH)) ((HAS-STATE A BIPED) LAH (GRIFFIN JRF) (BALROG LAH)))) (|MIGHTY MOUSE| LAUREN)) ((HAS-POSSESSION A SNUFFEL) ADK ((HAS-POSSESSION A TAIL) KRONJ (HAMSTER KRONJ) (|BUGS BUNNY| LAUREN)) (|MR SNUFFELUPAGOUS| ADK))) (|FELIX THE CAT| LAUREN)) ((HAS-STATE BORN PREGNANT) ALPHA (ZARKA ZANAR) ((HAS-STATE INTELLIGENT) SY (TRIBBLE ALPHA) (GREMLIN SY)))) (|BULLWINKLE THE MOOSE| PLK)) ((HAS-ACTION HAS CIRCULAR TEETH) HARV ((HAS-STATE VERY LOVABLE) SICC (COOKIE-MONSTER CSTACY) ((HAS-ACTION LIVES ON SESAME STREET) BERS (TRIBBLE SICC) ((HAS-ACTION (LOVES THE LETTER /" G /")) BERS (SNUFALUFAGUS BERS) (GROVER BERS)))) (|DISK DRIVASAURAUS| HARV))) ((HAS-ACTION SMOKES) DIANA ((HAS-STATE VERY DANGEROUS) LAUREN ((HAS-STATE BRED FROM HUMANS) SHL ((HAS-ACTION DRIVES A SPACE SHIP) DH ((HAS-ACTION AS STRIPES) JFB (|FOZZY BEAR| DH) (TIGGER JFB)) (CHEWBACCA DIANA)) (|SANTA THERESAN| SHL)) ((HAS-ACTION CAUSES TERROR) HARV ((HAS-ACTION WILL RIP YOUR HEAD OFF IF IT LOSES A GAME) PALLAS ((HAS-STATE CAT-LIKE) HEAD ((HAS-ACTION WILL EAT YOU IN THE DARK) SEH ((HAS-POSSESSION GREEN EYES) PERSA (MEGASAUR LAUREN) (DAKON PERSA)) (GRUE SEH)) (KZINTI HEAD)) (WOOKIE PALLAS)) ((HAS-STATE VERY HAIRY & CHEWS ON LEATHER) HEAD (ORC BLOTTO) ((HAS-ACTION CLIMBS THE EMPIRE STATE BUILDING) SICC (|HELL'S ANGEL| HEAD) (|KING KONG| SICC))))) ((HAS-PROPERTY TEN) TAMES (HOBBIT ELIOT) ((HAS-STATE EXTREMELY SENSUAL & THE DESIRE OF MANY MEN) HEAD (|DAVID FRENCH| TAMES) (|BO DEREK| HEAD)))))) ((HAS-STATE A WOMAN) VP (HARPY ELIOT) ((HAS-ACTION HAS HAIR UNDER HER WINGS) BOYACK (BATGIRL BOYACK) ((HAS-ACTION (HAS HER CLOTHES ON)) BOYACK (BATWOMAN VP) (BATLADY BOYACK))))) ((HAS-ACTION HAS A BLOCK HEAD) ELIOT ((HAS-ACTION (CARRIES A BLANKET)) PLK ((HAS-STATE A BULLY) GRAND ((HAS-ACTION PLAYS THE PIANO) GRAND ((HAS-ACTION CAN PLAY BASEBALL VERY WELL) PLK ((HAS-STATE CHARLIE BROWNS LITTLE SISTER) PLK ((HAS-ACTION (HAS * NOTHING * WHATSOEVER TO DO WITH ANY COMMERCIAL COMIC STRIP)) DONALD ((HAS-STATE THE RED BARON) BILBO (WOODSTOCK ELIOT) (SNOOPY BILBO)) (MARCIA DONALD)) (SALLY PLK)) ((HAS-PROPERTY BLACK) PLK ((HAS-ACTION (LIVES IN A DOG HOUSE)) CLEMW (|PEPPERMINT PATTY| PLK) (SNOOPY CLEMW)) (FRANKLIN PLK))) (SCHROEDER GRAND)) (|LUCY VAN PELT| GRAND)) ((HAS-ACTION REFUSE) BDH (LINUS PLK) (|INCREDIBLY SELFISH BLANKET BLEERPHER| BDH))) ((HAS-STATE FRIENDS) SMD (|CHARLIE BROWN| ELIOT) ((HAS-ACTION DOESN7/'T HAVE A BALNKETLANKET) SHC (LINUS SMD) (|CHARLIE BROWN| SHC))))) ((HAS-STATE A LARGE INTELLIGENT REPTILE) DAN ((HAS-STATE MISCHEVIOUS /, RATHER THAN EVIL) GRAND ((HAS-STATE ONCE A MAN) EJS ((HAS-STATE A MUPPET) GRAND ((HAS-ACTION HAS /5 HEADS) MSI ((HAS-STATE A REPTILE) PLK ((HAS-ACTION CANNOT JUMP AS FAR) LAUREN ((HAS-ACTION SAYS /'QWERTY -- ZAP/') A2DEH ((HAS-ACTION STOPS ME PLAYING ZORK) ACN ((HAS-STATE FLEXIBLE) SICC ((HAS-ACTION WILL ONLY GIVE YOU A DRINK IF YOU STICK YOUR FINGER DOWN ITS THROAT) A2DEH (|HOPPITY HOOPER| LAUREN) (VOGON A2DEH)) ((HAS-STATE HUMANOID) PERSA (|VERMICIOUS KNID| SICC) (WAYNHIM PERSA))) (GRUE ACN)) ((HAS-ACTION MAKES FOR POOR TASTE IN INTERIOR DECORATING) HEAD (MARTIAN A2DEH) (|PUCE COMPUTER TERMINAL| HEAD))) ((HAS-ACTION FOCUSES LIGHT ON A PHOTOSYNTHETICTHETIC BUD) NESSUS ((HAS-STATE SLIMY) SY ((HAS-ACTION (PHONES HOME)) KMP (TROLL ELIOT) (E KMP)) (|SLIME MONSTER| SY)) (|NIVEN SUNFLOWER| NESSUS))) ((HAS-ACTION GO /" BETWEEN /") VP ((HAS-ACTION SQUIRTS A FOUL-SMELLING LIQUID) PERSA (NEWT PLK) (TROGLODYTE PERSA)) (|FIRE LIZARD| VP))) (HYDRA MSI)) (KERMIT GRAND)) ((HAS-ACTION (IS INCREDIBLE)) DEVON ((HAS-STATE MUCH) SHL ((HAS-ACTION LIVES IN THE RINGS OF SATURN) HEAD (|CAULDRON BORN| SHL) (SYMB HEAD)) (GOLLUM EJS)) (|INCREDIBLE HULK| DEVON))) ((HAS-STATE PLAYED BY BILL BIXBY) PALLAS ((HAS-STATE CUTE) PALLAS ((HAS-STATE LARGER THAN A GREMLIN) COUGH (GREMLIN GRAND) ((HAS-ACTION IMPLIES A LOW CULTURAL LEVEL) DH ((HAS-STATE MUCH CONVERSATION AT THE BREAKFAST TABLE) HEAD ((HAS-ACTION LIVES ON THE PLANET JANUS) JKESS (|PIECE OF MOLDY TOAST| HEAD) (IFT JKESS)) (TROGLODYT DH)) ((HAS-ACTION HAS A LISP MACHINE) BOYACK ((HAS-ACTION (LIVES IN A TRASH-CAN)) BERS (CTHULUCOOKIE COUGH) (|GROWCH FROM SESAME STREET| BERS)) (|AI LAB NURD| BOYACK)))) ((HAS-STATE A REPTILE) TKTL ((HAS-STATE A MUPPET) JSOL (COMPUTER TKTL) (|KERMIT THE FROG| JSOL)) (|KERMIT THE FROG| PALLAS))) ((HAS-ACTION HAS AN EXTENSIVE WARDROBE) |SOMEONE IMPERSONATING GOD| ((HAS-STATE MORKIAN) DCP (|INCREDIBLE HULK| PALLAS) (MORK DCP)) ((HAS-ACTION FAILED) |SOMEONE IMPERSONATING GOD| (|EDDIES FATHER| |SOMEONE IMPERSONATING GOD|) ((HAS-ACTION HAS AN UNCLE WITH TWO ANTENNAE) |SOMEONE IMPERSONATING GOD| ((HAS-STATE GREAN) A1A (MAGICIAN |SOMEONE IMPERSONATING GOD|) ((HAS-STATE MEANER) SULLIV (HULK A1A) (BIXBYOLEUS SULLIV))) ((HAS-STATE A BILL BIXBY) SLH (|FAVORITE MARTIAN| |SOMEONE IMPERSONATING GOD|) (|BILL BIXBY'S CLONE| SLH))))))) ((HAS-ACTION SHOOTS ENERGY BEAMS OUT OF IT IS TAIL & EYES) ELIOT ((HAS-STATE EXTRA-TERRESTRIAL) LAUREN ((HAS-STATE THE SWINGING ALLIGATER IN THE SWAMP) LAUREN ((HAS-ACTION HAS NO SHELL) LAUREN ((HAS-ACTION EMITS A DEADLY GAS WHICH TAKES ONE POINT OFF YOUR STRENGTH CUMULATIVELY) DMTGJR (|MOCK TURTLE| LAUREN) (TROG DMTGJR)) ((HAS-ACTION NABS A BEAUTIFUL BLOND SCIENTIST) LAUREN ((HAS-ACTION LIVES IN SCOTLAND) EMERY ((HAS-ACTION (HAS) WEBBED FEET) MWT ((HAS-ACTION REGENERATES) COOKIE (DRAGON COOKIE) ((HAS-POSSESSION MANY HEADS) DBA (TROLL EMERY) (HYDRA DBA))) ((HAS-ACTION LIKES TO EAT LIVESTOCK) PERSA (|KILLER FROG| MWT) (WYVERN PERSA))) (|LOCH NESS MONSTER ( NESSIE )| LAUREN)) (|CREATURE FROM THE BLACK LAGOON| LAUREN))) (|WALLY GATER| LAUREN)) ((HAS-ACTION HAS A BRAIN) SPERRY (GORN DAN) (FROB SPERRY))) ((HAS-STATE SLIMY) CSTACY ((HAS-STATE MADE BY SEARS ROEBUCK CO) LAUREN ((HAS-STATE BLONDE) HARV (ZOK ELIOT) (|HOOKER I KNOW| HARV)) (YODA LAUREN)) ((HAS-ACTION LIVES IN SCOTLAND) BERS ((HAS-ACTION HATES WOOD) SULLIV (CTHULU CSTACY) (FWQIR SULLIV)) (|LOCHNESS MONSTOR| BERS)))))) ((HAS-ACTION HAS (FIVE) HEADS) ELIOT ((HAS-STATE A DOG) ELIOT ((HAS-ACTION MET KING KONG) SJK ((HAS-PROPERTY REAL) JHC ((HAS-STATE (A) REASONABLE CHOICE FOR AN ANIMAL) SHAG ((HAS-ACTION HAS SCALES LIKE A LIZARD/'S) DT ((HAS-STATE A KIND OF DRAGON) PERSA (GRIFFERT JHC) (GLAURUNG PERSA)) ((HAS-PROPERTY RELATED) SHL ((HAS-ACTION (PICKS HER SCABS)) TXI ((HAS-ACTION FLYS BY JET PROPULSION) LSO ((HAS-ACTION LEAVES MYSTERIOUS TRACKS) MWT ((HAS-STATE FOND OF GOOD POETRY) MWT (DRAGON DT) (|BLATANT BEAST| MWT)) (|QUESTING BEAST| MWT)) (PHYLANGE LSO)) (|SASAND-PAPER SALLY| TXI)) (FIRE-LIZARD SHL))) ((HAS-STATE A KOMODO DRAGON) SHL ((HAS-STATE A CLOWN) TAFT ((HAS-STATE A ROCK STAR) SHL ((HAS-ACTION BREATHES FIRES) COCO (FIRE-LIZARD SHL) ((HAS-ACTION HAS AN EAGLE HEAD) SHL ((HAS-STATE LARGER THAN A FIRE LIZARD) KATIN ((HAS-STATE MORE TRADITIONAL THAN A FIRE-LIZARD) KMP (FIRE-LIZARD SHL) (|SIMPLE DRAGON| KMP)) (DRAGON KATIN)) (GRIF COCO))) (|GENE SIMMONS| SHL)) (FROBOZZO TAFT)) ((HAS-STATE A NATIVCEVE OF DARK CAVES) DWO (MONITOR-LIZARD SHL) (DRAGON DWO)))) ((HAS-STATE FURRY) RWG ((HAS-POSSESSION DHVJDFHWDFEDFEF) BERG (DRAGON ELIOT) (JJEFEYFRFWFELE BERG)) ((HAS-STATE FASTER THAN A DOG) HUBRD (DOG RWG) (|VORACIOUS MAN-EATING TWAT| HUBRD)))) ((HAS-STATE SMALLER THAN A DRAGON) HUBRD ((HAS-ACTION GOT A PURPLE WEINEEER) CDR (GODZILLA SJK) (|| CDR)) ((HAS-POSSESSION TWO LEGS) ELIOT (DRAGON HUBRD) ((HAS-ACTION IIS SOFT (QUOTE LONG) BYE SOFT & WARM & JUICY) MINDLE (EMILY ELIOT) (|BOBO DEREK'S CLITORIS| MINDLE))))) ((HAS-POSSESSION BAD BREATH) SMK (|HELL HOUND| ELIOT) ((HAS-ACTION KILLS PEOPLE) LETTO (|CHILI-EATING MEXICAN DOG| SMK) ((HAS-POSSESSION THREE HEADS) GERN ((HAS-STATE SEEN ON THE MOORS) BOYACK (DDD LETTO) (|HOUND OF THE BASKERVILLES| BOYACK)) (CERBERUS GERN))))) ((HAS-STATE SILLY) GNU ((HAS-ACTION GROWS A HEAD EVERY YEAR) LSO (PYROHYDRA ELIOT) (PHYLANGE LSO)) ((HAS-STATE PUNCTUAL) GNU (|| GNU) (& GNU))))) ((HAS-ACTION HAS A HUMAN BODY TORSO) ELIOT ((HAS-ACTION HAS HORNS ON ITS HEAD /, AND NO HUMAN TORSO) RP0L ((HAS-POSSESSION WINGS) JHC ((HAS-STATE AN INTELLIGENT HORSE) SHL ((HAS-ACTION HAS HEADS ON BOTH ENDS OF ITS BODY) BKENRS ((HAS-STATE MADE OF WOOD) PALLAS ((HAS-ACTION HAS ONE HORN) DUFTY ((HAS-POSSESSION EIGHT LEGS) VP ((HAS-STATE RATTY) SLH ((HAS-ACTION REMOVES ENCHANTMENT FROM MAGICAL WEAPONS) PERSA ((HAS-POSSESSION STRIPES) DESFZ ((HAS-ACTION (IS IN THE ARMY)) BOYACK (CENTAUR ELIOT) (FRANCIS BOYACK)) (ZEBRA DESFZ)) (DISENCHANTER PERSA)) (RAT SLH)) (SLEIPNIR VP)) (UNICORN DUFTY)) ((HAS-ACTION A TOY) RKC (|TROJAN HORSE| PALLAS) (|HOBBY HORSE| RKC))) (PUSH-ME-PULL-YOU BKENRS)) ((HAS-ACTION LIVES IN MIDDLE-EARTH) EULER ((HAS-ACTION TALKS ON TV) KMP ((HAS-STATE EXTINCT) JALEX ((HAS-ACTION HAS A TRUNK) NB ((HAS-ACTION HAS ONLY ONE HORN) PERSA (RANYHYN SHL) (UNICORN PERSA)) (ELEPHANT NB)) (UNICORN JALEX)) (|MR ED| KMP)) ((HAS-ACTION HAS A HORN IN THE CENTER OF IT IS FOREHEAD) DFC (MEARA EULER) (UNICORN DFC)))) ((HAS-ACTION BREATHES FIRE) RAM ((HAS-ACTION HAS THE TORSO OF A LION) DFC ((HAS-ACTION HAS THE HEAD OF AN EAGLE) ALY (PEGASUS JHC) (GRIFFIN ALY)) (GRIFON DFC)) (DRAGON RAM))) ((HAS-STATE HORNIER THAN A UNICORN) EJS ((HAS-ACTION HAS THE JEWEL OF JUDGEMENT) DEVON ((HAS-ACTION HAS PINK HOOVES) ELIOT (UNICORN RP0L) (KI-RIN ELIOT)) ((HAS-ACTION HAS A SMALL BACK SEAT) HARV (|UNICORN OF AMBER| DEVON) ((HAS-STATE LKSFV DSKDFJ) SICC (|FORD MUSTANG| HARV) (|| SICC)))) ((HAS-POSSESSION THREE HORNS) ERIC ((HAS-STATE IN A STORY) IWASA (|THETA-XI UNICORN| EJS) (WANGDOODAL IWASA)) (TRICERATOPS ERIC)))) ((HAS-POSSESSION TWO HUMAN BODY TORSOS) ELIOT ((HAS-ACTION LIVES IN A MAZE) DADA ((HAS-ACTION /, IS IT BLACK /, WHITE ETC) JEFFH ((HAS-ACTION ALWAYS (HAS) (FEMALE BODY) TORSOS) PERSA ((HAS-POSSESSION THREE LEGS) A2DEH (CENTAUR ELIOT) (|PIERSON'S PUPPETTEER| A2DEH)) (LAMIA PERSA)) (TESTING JEFFH)) (MINOTAUR DADA)) (BYTAUR ELIOT)))) ((HAS-ACTION LIVES IN WATER) KMP ((HAS-ACTION CAN FLY) KMP ((HAS-POSSESSION BLACK STRIPES) ELIOT ((HAS-ACTION HAS WRINKLED SKIN) ELIOT ((HAS-ACTION GOES /" MEOW /") ELIOT ((HAS-POSSESSION WHEELS) ELIOT ((HAS-STATE SMALLER THAN A DOG) ELIOT ((HAS-ACTION HAS A LONG NECK) CLG ((HAS-ACTION ROARS) HAL ((HAS-ACTION BARKS) WEIT ((HAS-STATE A PREDATOR) WEIT ((HAS-ACTION EATS EUCALYPTUS LEAVES) NODE ((HAS-STATE LARGER THAN A CHIMPANZEE) GRAND ((HAS-ACTION HAS A CURLY TAIL) KMP ((HAS-ACTION NEEDS (ELECTRICITY)) MAZE ((HAS-POSSESSION A BEAK) LAUREN ((HAS-ACTION HAS CLOVEN HOOFS) LAUREN ((HAS-ACTION HAS ARMOR PLATING) LAUREN ((HAS-STATE A RODENT WITH TUSKS) ALLAN ((HAS-STATE INANIMATE) |J.JIML| ((HAS-STATE SMALLER THAN A CHIMPANZEE) PECM ((HAS-STATE THE LARGEST RODENT IN EXISTENCE) LOIEDE ((HAS-ACTION EATS ANTS) DAN ((HAS-ACTION HAS MORE BUTTONS THAN A CHIMPANZEE) EDWIN ((HAS-POSSESSION SPOYS) IWASA (CHIMPANZEE WEIT) (HYENA IWASA)) (TELEPHONE EDWIN)) (AARDVARK DAN)) (CAPYBERA LOIEDE)) ((HAS-ACTION PLAYS DEAD) COOKIE ((HAS-STATE HUMAN) DMK (MONKEY PECM) (|LITTLE BOY| DMK)) (OPPOSSUM COOKIE))) ((HAS-ACTION HAS A SHOTGUN) CHH (TREE |J.JIML|) (BONG CHH))) (MOUSE-DEER ALLAN)) (ARMADILLO LAUREN)) ((HAS-STATE A BARNYARD ANIMAL) KMP (TAPIR LAUREN) (SHEEP KMP))) ((HAS-ACTION LIVES IN ANTARCTICA) RKC ((HAS-ACTION CROWS) JDG (EMU JDG) (ROOSTER LAUREN)) (PENGUIN RKC))) ((HAS-ACTION DIMS THE LIGHTS WHEN TURNED ON) PALLAS (MICRO MAZE) (DEC-10 PALLAS))) ((HAS-ACTION HAS FUR) CLG ((HAS-POSSESSION TUSKS) TLD (PIG KMP) (WARTHOG TLD)) ((HAS-ACTION LIVES IN TREES) GERN (SHEEP GERN) (MONKEY CLG)))) ((HAS-STATE A MARSUPIAL) GRAND ((HAS-STATE A BEAST OF BURDEN) GRAND ((HAS-STATE SIMIAN) GRAND ((HAS-ACTION WALKS ON TWO LEGS) KOVAR ((HAS-ACTION LIVES ON THE GRASSLAND IN AFRICA) GZ ((HAS-ACTION GOES /" NEIGH /") LAUREN ((HAS-POSSESSION HORNS) LAUREN ((HAS-ACTION HAS WOOL ((ON IT) . STATEMENT . NIL .)) LAUREN ((HAS-STATE VERY TIMID) ARPEE ((HAS-STATE SMALLER THAN A HIPPOPOTAMUS) PECM (HIPPOPOTAMUS GRAND) ((HAS-POSSESSION A SHELL) LOIEDE ((HAS-ACTION GOES |'MOO'|) TRIEU ((HAS-STATE A LARGE FURRY RODENT) RJF ((HAS-ACTION HAS ANTLERS) ED ((HAS-ACTION HAS LONG TOES) PW ((HAS-STATE A KIND OF BEAR) CSTACY (PIG PECM) (|PANDA BEAR| CSTACY)) (|THREE-TOED SLOTH| PW)) (MOOSE ED)) (CAPYBARA RJF)) (COW TRIEU)) (|GIANT TORTOISE| LOIEDE))) ((HAS-ACTION GOES /" MOO /") SICC ((HAS-ACTION LIVES ON SESAME STREET) LYMAN ((HAS-ACTION HANGS UPSIDE DOWN) GJH ((HAS-ACTION GOES /" EEON) BERS (|GIANT PANDA| ARPEE) (DONKEY BERS)) (SLOTH GJH)) (SNUFELUFUGUS LYMAN)) (COW SICC))) ((HAS-STATE A FEMALE SHEEP) KMP (LAMB LAUREN) ((HAS-STATE WISE IN THE WAYS OF THE WORLD) A2DEH (EWE KMP) (|SURROGATE SHEEP| A2DEH)))) ((HAS-POSSESSION A GOATEE) LAUREN ((HAS-STATE DOMESTICATED) JALEX ((HAS-STATE USED BY SANTA CLAUS) SHC ((HAS-ACTION HAS LARGE BRANCHLIKE HORNS) BILLB ((HAS-ACTION LIVES ON FROZEN TUNDRAS) BILLB (BUFFALO LAUREN) (YAK BILLB)) (ELK BILLB)) (REINDEER SHC)) ((HAS-ACTION GIVES MILK) STRO (GURNSEYSEY JALEX) (COW STRO))) ((HAS-ACTION HAS A GOATEE) GMR (BUFFALO GMR) ((HAS-STATE LARGER THAN A GOAT) GERN (GOAT LAUREN) ((HAS-ACTION USED TO ROAM IN GIANT HERDS) LAUREN (YAK GERN) (BUFFALO LAUREN)))))) ((HAS-STATE SMALLER THAN A HORSE) NB (HORSE LAUREN) (LLAMA NB))) ((HAS-POSSESSION HORNS) LAUREN ((HAS-ACTION HAS SHORT LEGS) DR ((HAS-ACTION HAS LONG TRUNK) KLAFH ((HAS-POSSESSION WARTS) JWJ (DEER LAUREN) (WARTHOG JWJ)) (ELEPHANT KLAFH)) ((HAS-ACTION HAS GNARLY TEETH) ELF (AARDVARK DR) ((HAS-ACTION HAS A LONG NOSE) BERS (HIPPOPOTOMUS ELF) (ADVAARK BERS)))) ((HAS-STATE A FARM ANIMAL) ALLAN ((HAS-ACTION RUNS FASTER THAN A |GAZELLE RUNS FASTER THAN A GNU|) DANIEL ((HAS-ACTION STARTS WITH A K) KMP ((HAS-ACTION STARTS WITH A Y) DR ((HAS-ACTION HAS LYRE SHAPED CORRUGATED HORNS) BART ((HAS-STATE LARGER THAN A GNU) PECM (GNU GZ) (ELEPHANT PECM)) ((HAS-POSSESSION A BEARD) BERS (GAZELLE BART) (GNU BERS))) (YAK DR)) (KUDU KMP)) (GAZELLE DANIEL)) ((HAS-STATE LIKE AN OX) TLD (COW ALLAN) (|WATER BUFFALO| TLD))))) ((HAS-ACTION (HAS LARGE BREASTS)) KOVAR ((HAS-ACTION (CHASES WOMEN ALL DAY)) KOVAR ((HAS-ACTION (HOPS)) RBARCK ((HAS-ACTION ONLY OCCURS IN SINGULAR) VP ((HAS-ACTION RUNS FAST) BABS ((HAS-STATE YOUNGER) DMK ((HAS-STATE BETTER LOOKING THAN DANIEL) LAUREN (DANIEL VP) ((HAS-ACTION SQUEAKS CUTELY) CSTACY (BIGFOOT LAUREN) (PIGLET CSTACY))) ((HAS-STATE FEMALE) DMK (BOY DMK) (GIRL DMK))) ((HAS-STATE HUMAN) DMK (GAZELLE BABS) ((HAS-STATE FEMALE) DMK (BOY DMK) (GIRL DMK)))) ((HAS-ACTION KNOWS) CEH ((HAS-STATE AS ADVENTUROUS) KMP ((HAS-ACTION HAS LONG HAIR) DR ((HAS-STATE A BUREAUCRAT) MWT (KMP KMP) (|PAUL GRAY| MWT)) ((HAS-STATE KNOWN AS /" THE INCRDIBLE FLUSHING MAN /") COOKIE (RWK DR) (CSTACY COOKIE))) ((HAS-STATE A FRESHMAN) JKESS (|DON WOODS| CEH) (SUBR JKESS))) ((HAS-ACTION (IS FEMALE)) KMP ((HAS-STATE AN ENGINEER) KMP ((HAS-ACTION REMINDS YOU OF YOUR GRANDMOTHER) LIZZY (TOSCANINI KMP) (GSB LIZZY)) (KMP VP)) (JANICE KMP)))) ((HAS-ACTION LOOK LIKE A HUMAN) CWC (KANGAROO RBARCK) ((HAS-STATE TALLER THAN AN ORANGUTAN) KMP (ORANGUTAN CWC) (OLAF KMP)))) ((HAS-ACTION FLAMES ALOT) A2DEH (MAN KOVAR) ((HAS-ACTION TAKES /50 YEARS TO GRADUATE) RDZ (|INCREDIBLE FLUSHING MAN| A2DEH) (FRANKSTON RDZ)))) ((HAS-STATE SHORT) KMP ((HAS-STATE EXTREMELY BEAUTIFUL) SEH (BKERNS KMP) ((HAS-STATE WIERD) ELF (|LISA CUNNINGHAM| SEH) (NATALIE ELF))) ((HAS-POSSESSION RED (BLOOD)) KMP (|QUEEN OF ENGLAND| KMP) ((HAS-ACTION DANCES ON IT IS TOES) JL ((HAS-ACTION TAMES UNICORNS) JKESS ((HAS-STATE FAT) JAFH ((HAS-ACTION LIKES DEAD MICE) KMP ((HAS-STATE SPELLED COOKIE) COOKIE (VP KMP) (COOKIEA COOKIE)) (COOKIE KMP)) (MICHAEL JAFH)) (SYDNEY JKESS)) ((HAS-ACTION DANCES AS OFTEN) VP ((HAS-ACTION (LIVES IN CALIFORNIA)) KMP (PIGLET VP) (COOKIE KMP)) ((HAS-POSSESSION LARGE BREASTS) COOKIE (WRONG COOKIE) (BALLERINA JL)))))))) ((HAS-STATE LARGER THAN A GORILLA) HOEY ((HAS-ACTION FLAMES BRIGHT BLUE) MWMT ((HAS-ACTION CARRIES ITS FATHER/'S CHARGE PLATE) PALLAS ((HAS-STATE UGLIER THAN BABOONS) WAC ((HAS-ACTION HAS RED FUR) ALLAN ((HAS-STATE AFRAID OF LEOPARDS IN A DARK ALLEY) VP (STAN VP) ((HAS-ACTION (IS FROM KANSAS)) VP (BABOON WAC) (DAVE VP))) ((HAS-ACTION PLAYS ZORK) VP (ORANGUTAN ALLAN) (KRONJ VP))) ((HAS-PROPERTY ORANGE) DEEP (GORILLA GRAND) (ORANGUTANG DEEP))) (JAP PALLAS)) ((HAS-STATE MORE TIMID THAN A THIEL-BEAST) JL ((HAS-ACTION CONSUMES XALCOHOL) A2DEH (THIEL-BEAST MWMT) (|SCIENCE FICTION FAN| A2DEH)) (|HAIRY HACKER| JL))) ((HAS-ACTION (HAS LONG HAIR)) FURUNO (|FORMER ADVISOR| HOEY) (J FURUNO)))) ((HAS-STATE TEMPERAMENTAL) LAUREN ((HAS-STATE SMATER THAN A HORSE) JANUS ((HAS-ACTION TALKS BACK) CHH ((HAS-ACTION HAS HORNS) RJM (HORSE GRAND) (OX RJM)) ((HAS-STATE WORNG) GERN (NIGGERR CHH) (WRONG GERN))) ((HAS-ACTION HAS HORNS) NB (MAN JANUS) (COW NB))) ((HAS-STATE MUCH) MAZE ((HAS-ACTION THINKS) PALLAS ((HAS-ACTION SLEEPS AT NIGHT) A2DEH (PROGRAMMER PALLAS) (HORSE A2DEH)) (|MIT = MC| MAZE)) ((HAS-ACTION HAS A ROUGUE) JOSE ((HAS-ACTION HAS HUMPS ON ITS BACK) GZ (ASS LAUREN) (CAMEL GZ)) (ELEPHANT JOSE))))) ((HAS-ACTION HAS A WALL IN ITS NAME) SKH ((HAS-ACTION EATS BAMBOO SHOOTS) ED ((HAS-ACTION LIVES IN THE DESERT) IWASA (KANGEROO GRAND) ((HAS-POSSESSION A POUCH) CRE (YAK IWASA) (KANGAROO CRE))) (PANDA ED)) ((HAS-STATE LIKE A HORSE) RHB (WALLABY SKH) (MULE RHB))))) ((HAS-ACTION HAS A CURLY TAIL) NEWMAN ((HAS-PROPERTY LARGE) GNU (KOALA NODE) ((HAS-ACTION GOES /" NAY /") ELF ((HAS-ACTION HOPS ON TWO LEGS) ALPHA ((HAS-POSSESSION FUR) BERG ((HAS-STATE A HUMAN) CSTACY (ELEPHANT GNU) (GRUB CSTACY)) ((HAS-ACTION WALKS ON TWO LEGS) PSY (COW BERG) (ORANGUTANG PSY))) (KANGAROO ALPHA)) (HORSE ELF))) ((HAS-STATE SMARTER THAN A PIG) JANUS (PIG NEWMAN) (MONKEY JANUS)))) ((HAS-STATE A REPTILE) GRAND ((HAS-ACTION STANDS ERECT) GRAND ((HAS-ACTION (HAS A) SLOSHY TONGUE) NB ((HAS-PROPERTY WHITE) SHL ((HAS-STATE CARNIVOROUS) BDH ((HAS-ACTION TAIL) PETE ((HAS-ACTION REACHES OUT TO CRUSH SOMEONE) A2DEH (|PANDA BEAR| SHL) (|MA BELL| A2DEH)) ((HAS-STATE A CAT) IWASA (MONKEY PETE) (LEPORD IWASA))) ((HAS-ACTION HAS A LONG NOSE) ALPHA ((HAS-POSSESSION SPOTS) LOIEDE ((HAS-STATE A CATNOT A CAT) RKC ((HAS-ACTION HOWLS) IWASA ((HAS-STATE AN ANIMAL LIKE A PIG WITH TUSKS) SULLIV ((HAS-POSSESSION ZITS) SULLIV ((HAS-ACTION EATS SNAKES) |J.JIML| (BUNNY RKC) (MONGOOSE |J.JIML|)) (|| SULLIV)) (BOAR SULLIV)) ((HAS-STATE REDISH) IWASA (WOLF IWASA) (FOX IWASA))) ((HAS-STATE FASTER THAN A LYNX) RRLC (LYNX BDH) (JAGUAR RRLC))) ((HAS-ACTION LAUGHS) BERS (LEOPARD LOIEDE) (HYENA BERS))) ((HAS-ACTION EATS ANTS) DMK ((HAS-PROPERTY MEAN) GERN ((HAS-STATE SLY) ARTHUR ((HAS-STATE BETTER LOOKING THAN A COYOTE) KMP (COYOTE DMK) (WOLF KMP)) (FOX ARTHUR)) ((HAS-ACTION LOOKS LIKE A PIG) BERS (WOMBAT GERN) (|WILD BOAR| BERS))) (ANTEATER ALPHA)))) ((HAS-PROPERTY BLACK) BILBO (|POLAR BEAR| SHL) (|PANDA BEAR| BILBO))) ((HAS-ACTION HAS FUR) CHAPMA ((HAS-ACTION HAS A LONG SNOUT) SEH (PIG NB) (AARDVARK SEH)) ((HAS-STATE THE NOSE) PETE ((HAS-POSSESSION LARGE CLAWS) BERS (ANTEATER CHAPMA) ((HAS-STATE SMALLER THAN A BEAR) GERN (|GRIZZLY BEAR| BERS) (WOLF GERN))) (CHIMP PETE)))) ((HAS-ACTION LOOKS SOFT AND CUDDLY) KMP ((HAS-ACTION WEARS WHITE SOCKS ALL THE TIME) SHAG ((HAS-STATE BIGGER THAN A MAN) KMP ((HAS-STATE MUCH NASTIER THAN A MAN) KMP ((HAS-ACTION HAS A /13 INCH LONG ERECTION) SULLIV ((HAS-STATE A MEAN SLUG LICKER) SULLIV ((HAS-POSSESSION A BRAIN) BERS (TROJAN CHS) ((HAS-STATE IGNORANT) PW (MAN BERS) (FOOL PW))) (GUTAG SULLIV)) (|JOHN HOOLMES| SULLIV)) ((HAS-STATE FAMOUS) JKESS ((HAS-STATE IT IS HUMAN) DMK (|BEAST OF BENGAL| KMP) ((HAS-ACTION HACKS ITS) KARIM ((HAS-ACTION ABUSES ITS) KMP (HACKER KMP) (VANDAL KMP)))) ((HAS-ACTION EATS TOURISTS) GILDEA (|MARQUIS DE SADE| JKESS) (|INCREDIBLE FLUSHING MAN| GILDEA)))) (|POLAR BEAR| KMP)) ((HAS-POSSESSION SCRUPLES) KMP (POLITICIAN CHH) (NERD SHAG))) ((HAS-ACTION HAS BLONDE HAIR) CSTACY ((HAS-STATE CUTER THAN A YETI) KMP (YETI FITZ) ((HAS-PROPERTY ONE) LIZZY (KENT KMP) (HENRIK LIZZY))) ((HAS-STATE TALL) SULLIV (FARAH CSTACY) ((HAS-ACTION HAS NO HEART) BOYACK (CHERYL SULLIV) (DIANDIANE BOYACK)))))) ((HAS-STATE POISONOUS) NB (|BOA CONSTRICTOR| GRAND) (COBRA NB)))) ((HAS-ACTION (HAS A ((LARGE) NOSE))) PLK ((HAS-ACTION GOES YIPE YIPE) MSI ((HAS-STATE A CERTAIN KIND OF DOG) PLK (DOG |No one|) ((HAS-POSSESSION ORANGE FUR) PLK ((HAS-STATE A TERRIER) PLK ((HAS-ACTION HAS VERY LONG EARS) PLK ((HAS-STATE A GUARD DOG) PLK ((HAS-STATE LARGER THAN A BEAGLE) DKR ((HAS-STATE THE SMALLEST DOG IN THE WORLD) SHL ((HAS-STATE A BEAGLE) EJS ((HAS-ACTION HAS FLOPPY EARS) KREN (PEKINGESE KREN) (|LHASA APSO| KREN)) (BEAGLE PLK)) (CHIHUAHUA SHL)) ((HAS-PROPERTY HUGE) SHL ((HAS-STATE A WILD TYPE OF DOG) SHL ((HAS-STATE A HUNTING DOG) ARPEE (HARRIER DKR) ((HAS-PROPERTY RED) RHB (|NORWEGIAN WOLF HOUND| ARPEE) (|IRISH WOLFHOUND| RHB))) (WOLF SHL)) (|SAINT BERNAARD| SHL))) (|GERMAN SHEPARD| PLK)) (|BASSET HOUND| PLK)) ((HAS-POSSESSION DARKER FUR THAN A |TERRIER'S FUR|) PLK ((HAS-ACTION HAS A TRIANGULAR SHAPED FACE) PLK (|WEST HIGHLAND WHITE TERRIER| PLK) (|BULL TERRIER| PLK)) (|CAIRNE TERRIER| PLK))) ((HAS-ACTION HUNTS) PLK ((HAS-STATE A SHEEPHERDER) PLK ((HAS-STATE A TOY DOG) PLK (|IRISH SETTER| PLK) (CHOW PLK)) (COLLIE PLK)) ((HAS-ACTION HAS STRAIGHT HAIR) ERIC (|GOLDEN LABRADOR| PLK) ((HAS-ACTION LIVES IN AUSTRAILIA) BERS (|GOLDEN RETRIEVER| ERIC) (DINGO BERS)))))) ((HAS-STATE A DOG) PLK ((HAS-ACTION TRAVELS UNDERGROUND) LSO ((HAS-ACTION HAS TWO LEGS) TOILLE (HYEENA MSI) (ELIOT TOILLE)) (ZOT LSO)) ((HAS-STATE A BABY DOG) PLK ((HAS-STATE VERY SMALL) DKR (POODLE PLK) ((HAS-ACTION HAS LONG HAIR) GZ (CHIUAUA DKR) (|SILKY TERRIER| GZ))) (PUPPY PLK)))) ((HAS-STATE A SAUSAGE DOG) TANG ((HAS-STATE LEAN) RBARCK ((HAS-STATE A POLICE DOG) SHAG ((HAS-ACTION UNDERSTANDS) PAULP (|POODA POODLW DOG| PAULP) ((HAS-PROPERTY RED) CRUZ ((HAS-ACTION HAS NO PEDIGREE) VP ((HAS-STATE SHAGGY) BERS (BULLDOG PLK) (|BEARDED COLLIE| BERS)) (MUTT VP)) ((HAS-ACTION NECESSITATES BUYING A NEW OVEN) LAUREN (|IRISH SETTER| CRUZ) (|POODLE IN A MICROWAVE OVEN| LAUREN)))) (|GERMAN SHEPARD| SHAG)) ((HAS-STATE MUCH) ARCHIE (DOG ARCHIE) ((HAS-STATE WILD) RAM (|IRISH SETTER| RBARCK) (WOLF RAM)))) ((HAS-ACTION PULLS A SLED) LAUREN (DAUCHSHUND TANG) (|ALASKAN MALAMUTE| LAUREN))))) ((HAS-ACTION LIVES IN NORTH AMERICA) GRAND ((HAS-PROPERTY BLACK) LAUREN ((HAS-POSSESSION WHEELS) BILLT ((HAS-ACTION LIVES IN THE HIMALAYAS) SICC ((HAS-ACTION HAS SPOTS AN) PECM (LION GRAND) ((HAS-ACTION LAUGHS) ROBG ((HAS-ACTION HAS SPOTS IN ITS SPOTS) BERS (LEOPARD PECM) (JAGUAR BERS)) (HYENA ROBG))) (|ABOMINABLE SNOWMAN| SICC)) (|ABOMINABLE SNOWMAN| BILLT)) ((HAS-ACTION BEATS ITS/' CHEST) RAM (PANTHER LAUREN) (GORRILLA RAM))) ((HAS-POSSESSION A MANE) AGRE ((HAS-STATE THE WORST THING YOU CAN MEET) SHL ((HAS-ACTION STANDS ON IT HIND LEGS) ARPEE ((HAS-STATE SMALLER THAN A PUMA) DBA (PUMA HAL) (LYNX DBA)) ((HAS-POSSESSION FUR) ELIOT (ELIOT ELIOT) (BEAR ARPEE))) ((HAS-STATE A TYPE OF CAT) SHL ((HAS-ACTION KILLS PEOPLE WITH BANANAS) JOHNS ((HAS-STATE BIGGER THAN A |LITTLE BROTHER|) EGBERT (|LITTLE BROTHER| SHL) (BEAR EGBERT)) (SCHLOCK JOHNS)) (JAGUAR SHL))) ((HAS-ACTION LAGER /;) IWASA (|MOUNTAIN LION| AGRE) (BEAR IWASA))))) ((HAS-STATE RARE) WEIT ((HAS-ACTION LIKES TO JUMP) WEIT ((HAS-STATE A REPTILE) CXC ((HAS-ACTION (IS EATEN) FOR THANKSGIVING) CLEMW ((HAS-STATE A TYPE OF BIRD) SHL ((HAS-ACTION LIVES IN SOUTH AMERICA) VP ((HAS-STATE SMALLER THEN A GIRAFFE THAN A GIRAFFE) KRAUSS (GIRAFFE CLG) (HORSE KRAUSS)) ((HAS-ACTION WHINNIES) ARPEE (LLAMA VP) ((HAS-ACTION SPITS) ELIOT (HORSE ARPEE) (LLAMA ELIOT)))) ((HAS-ACTION HIDES IN THE GROUND) BABS ((HAS-PROPERTY DUMB) LMSJR (EMU SHL) (CASSOWARY LMSJR)) (OSTRICH BABS))) (TURKEY CLEMW)) ((HAS-STATE EXT IS EXTINCT) BEEP ((HAS-STATE IT IS SMALLER THAN AN ANDCONDA) KRAUSS (ANACONDA CXC) ((HAS-STATE BIGGER THAN A BOA) OAF (|GARTER SNAKE| KRAUSS) (PYTHON OAF))) (BRONTOSAURUS BEEP))) ((HAS-ACTION HAS FOUR LEGS) BEAN ((HAS-ACTION HAS A POUCH) RAM ((HAS-STATE LONG /, THICK /, SQUIRTS COME) SULLIV (GORRILLA RAM) (SHLONG SULLIV)) (KANGAROO WEIT)) (HORSE BEAN))) ((HAS-ACTION HAS SPOTS) PAP ((HAS-STATE EXTINCT REPTILE) PAULP ((HAS-ACTION HAS A LONG TONGUE) COOKIE ((HAS-STATE A BIRD) DMK ((HAS-STATE A HORSE) BERS (OKAPI WEIT) (STALION BERS)) (OSTRICH DMK)) ((HAS-STATE STUPIDER THAN AN AARDVARK) SAZ (AARDVARK COOKIE) (SAZ SAZ))) ((HAS-STATE A PREDATOR) JRF (|BRONTOSAORA BRONTOSAUR| PAULP) (|TYRANASAURUS REX| JRF))) ((HAS-ACTION HAS A CALCULATOR ATTACHED TO IT) JHUA ((HAS-STATE NOSE IS LONGER THAN IT IS NECK) HUBRD (GIRAFFE PAP) (AARDVARK HUBRD)) (MACGREGOR-TWIT JHUA))))) ((HAS-POSSESSION A TAIL) ELIOT ((HAS-ACTION HAS SHARP QUILLS) CLG ((HAS-STATE AN INVERTEBRATE) CLG ((HAS-PROPERTY TWO) FITZ ((HAS-STATE A BIRD) JHUA ((HAS-ACTION RUNS OFF A CLIFF EVERY /77 TO /10 YEARS) ELIOT ((HAS-ACTION SQUEALS) LAUREN ((HAS-ACTION DWELLS IN LOW RENT APARTMENTS) LAUREN ((HAS-STATE AN INSECT) SHL ((HAS-POSSESSION A THOUSAND LEGS) SHL ((HAS-PROPERTY BAD) MPA ((HAS-ACTION DOES ABSOLUTELY NOTHING) ARPEE ((HAS-ACTION LIVES IN AUSTRAILIA) BERS ((HAS-POSSESSION A TAIL) DEEP ((HAS-ACTION EXPANDS SNAKE DOES NOT) KYRHIZ ((HAS-STATE EXPANDABLE /, SNAKE IS NOT) KYRHIZ ((HAS-STATE EXPANDABLE) KYRHIZ (SNAKE DEEP) (PEOS KYRHIZ)) (PSOLI KYRHIZ)) (PEOS KYRHIZ)) (HAMSTER ELIOT)) (WOMBAT BERS)) (|PET ROCK K| ARPEE)) ((HAS-ACTION KILLS BY SQUEEZING) ALPHA (WOMBAT MPA) (|BOA CONTRICTOR| ALPHA))) (MILLIPEDE SHL)) ((HAS-STATE A PREDATOR) PECM ((HAS-PROPERTY GREEN) PECM ((HAS-ACTION EATS WOOD) TENSOR (EARWIG SHL) (TERMITE TENSOR)) (GRASSHOPPER PECM)) (SPIDER PECM))) ((HAS-STATE A ASPIDER) PERSA ((HAS-STATE SMALLER THAN A COCKROACH) KMP (COCKROACH LAUREN) ((HAS-STATE SMALLER /, LIVES ON THE SKIN SURFACE THAN AN ANT) ELLEN ((HAS-STATE SMALLER THAN AN ANT) ELLEN (ANT KMP) (FLEA ELLEN)) (FLEA ELLEN))) (TARANTULA PERSA))) ((HAS-POSSESSION MUCH HAIR) KMP (BABY KMP) (|GUINEA PIG| LAUREN))) (LEMING ELIOT)) ((HAS-ACTION CROSSES THE ROAD IN JOKES) SHAG (KIWI JHUA) ((HAS-ACTION A CHICK IS A BQBY CHICKEN) PAULP (CHICKEN SHAG) (CHICK PAULP)))) (AARDVARK FITZ)) ((HAS-STATE SMALLER THAN A |HERMIT CRAB|) EJS ((HAS-ACTION HAS EIGHT LONG LEGS) CLG ((HAS-ACTION TASTES BETTER THAN A |HERMIT CRAB|) PC ((HAS-STATE SQUISHY) ALPHA (|HERMIT CRAB| CLG) ((HAS-ACTION HAS NO BRAIN) PERSA ((HAS-ACTION GOES SPLAT WHEN IT HITS THE GROUND) A2DEH (|MEXICAN JUMPING SLUG| A2DEH) (|BANANA SLUG| ALPHA)) ((HAS-ACTION MEASURES) BERS (|SLIME MOLD| PERSA) (|INCH WORM| BERS)))) ((HAS-ACTION TASTES WORSE THAN A ROAST BEEF) KMP (|ROAST BEEF| PC) ((HAS-ACTION GOES < RIBET >) ELMO (COBRA KMP) (|TREE FROG| ELMO)))) ((HAS-STATE A HOUSEHOLD PEST) BERS (SPIDER CLG) ((HAS-STATE HAIRY) BERS (COCKROACH BERS) (TARANTULA BERS)))) ((HAS-STATE GROSS) EJS ((HAS-POSSESSION A STINGER) GRAND ((HAS-ACTION HAS EIGHT LEGS /, WHEREAS AN ANT HAS ONLY SIX LEGS) DAN ((HAS-ACTION HAS EIGHT LEGS) DAN ((HAS-ACTION HAS MANY LEGS) LAUREN ((HAS-ACTION HAS A HARD SHELL) |J.JIML| (ANT EJS) ((HAS-STATE BIGGER THAN A BEETLE) ARK (BEETLE |J.JIML|) (SNAIL ARK))) ((HAS-ACTION HOPS ON DOGS) DH ((HAS-STATE AN ANIMAL THAT DOES NOT BECOME A BUTTERFLY) JFB (CATERPILLAR LAUREN) ((HAS-POSSESSION MANY LEGS) EJS (WORM JFB) ((HAS-ACTION ATTACKS PLANTS) JNUFF (CENTIPEDE EJS) ((HAS-PROPERTY GREEN) KMP ((HAS-STATE BIGGER THAN A |SPIDER MITE|) KMP (|SPIDER MITE| JNUFF) (ANT KMP)) (GRASSHOPPER KMP))))) (FLEA DH))) (SPIDER DAN)) ((HAS-ACTION EATS BLOOD) PC (SPIDER DAN) (TICQUE PC))) ((HAS-ACTION FLIES) VP ((HAS-STATE SMALLER THAN A SCORPION) COOKIE (SCORPION VP) (ANT COOKIE)) (BEE GRAND))) ((HAS-POSSESSION MANY FEET) LE ((HAS-ACTION HAS NO FEET) ZANAR ((HAS-STATE SMALLER THAN A ROACH) LAUREN (ROACH EJS) ((HAS-ACTION BITES YOU) HOEY (SILVERFISH LAUREN) (FLEA HOEY))) ((HAS-ACTION TRAILS SILVERY GOO) LAUREN ((HAS-STATE * VERY * SMALL) DH (WORM ZANAR) ((HAS-ACTION HAS LEGS) CHAPMA (GERM DH) (SPIDER CHAPMA))) (SLUG LAUREN))) ((HAS-PROPERTY BLACK) DIANA ((HAS-ACTION HAS ONLY SIX LEGS) NB ((HAS-STATE A PARASITE) PC (CENTIPEDE LE) (MITE PC)) ((HAS-STATE A PARASITE) PC (ROACH NB) ((HAS-STATE BIGGER THAN A MITE) DBROWN (MITE PC) (COCKROACH DBROWN)))) ((HAS-ACTION AS WINGS) ZANAR ((HAS-ACTION DRINKS BLOOD) PALLAS ((HAS-ACTION EATS INSECTS) FFM (COCKROACH PALLAS) (SPIDER FFM)) (TIC ZANAR)) (FLEA DIANA))))))) ((HAS-STATE KIND OF A PIG) IWASA (PORCUPINE CLG) (WARTHOG IWASA))) ((HAS-STATE SMALLER THAN A GERBIL) ELIOT ((HAS-POSSESSION A DUCK-BILL) CLG ((HAS-ACTION LIVES IN THE WESTERN HEMISPHERE) WEIT ((HAS-STATE A PET) PLK ((HAS-ACTION WEARS A TUXEDO) LAUREN ((HAS-ACTION CAN BE BEATEN BY A MONGOOSE) LAUREN ((HAS-ACTION HAS A HAIRY NOSE) MWMT ((HAS-STATE A BIRD) JALEX ((HAS-STATE LARGER THAN SQUIR) FFM (SQUIRREL PLK) ((HAS-STATE CUDDLY) LPH ((HAS-ACTION HATES BANANAS) MWT ((HAS-ACTION LIVES IN INDIA) DEEP (MONKEY FFM) (MONGOOSE DEEP)) ((HAS-ACTION LIVE IN INDIA) DEEP (|TASMANIAN DEVIL| MWT) (MONGOOSE DEEP))) (|KOALA BEAR| LPH))) ((HAS-STATE OBSESSED) FURUTA (PEACOCK JALEX) (|MALLEE FOWL| FURUTA))) ((HAS-STATE A RODENT-LIKE CREATURE WITH TUSKS) ALLAN ((HAS-ACTION LIVES IN TASMANIA) ALMAIN ((HAS-ACTION CAN KILL COBRAS) IWASA ((HAS-ACTION LIVES IN AUSTRALIA) GERN (WOMBAT MWMT) (|KOALA BEAR| GERN)) (MONGOOSE IWASA)) (|TASMANIAN DEVIL| ALMAIN)) (MOUSE-DEER ALLAN))) ((HAS-ACTION SITS ON LARS/' TERMINAL) LSH ((HAS-STATE CUTE) GERN (COBRA LAUREN) (|KOALA BEAR KOALA BEAR| GERN)) ((HAS-STATE A MAMMAL) LETTO (FISH LSH) (|TASMANIAN DEVIL| LETTO)))) (PENQUIN LAUREN)) ((HAS-ACTION SPINS BANANA WEBS) LAUREN ((HAS-STATE BIGGER THAN A GERBIL) DEEP (GERBIL ELIOT) ((HAS-STATE A REPTILE) OAF (MONGOOSE DEEP) (PYTHON OAF))) (|SPIDER MONKEY| LAUREN))) ((HAS-STATE A RODENT) GRAND ((HAS-ACTION GOES |'OINK'|) MSI ((HAS-ACTION (PROBABLY) LIVES IN TASMANIA) ELIOT ((HAS-ACTION CAN STINK) LAUREN ((HAS-POSSESSION FEATHERS) PALLAS ((HAS-ACTION HAS A HARD SKIN) CLIVE ((HAS-POSSESSION QUILLS) JJD ((HAS-STATE LONG) KRAUSS ((HAS-STATE SEMI-INTELLIGENT) ABRACA ((HAS-ACTION HAS LONG EARS) BILBO ((HAS-ACTION LIVES IN TREES IN SOUTH AMERICA) AGRE ((HAS-STATE A CAT) IWASA ((HAS-ACTION EATS RACOONS FOR BREAKFAST) TLD ((HAS-STATE FUR IS SOLD) BERS (RACOON WEIT) (MINK BERS)) (WOLVERINE TLD)) (PAMU IWASA)) (AI AGRE)) (RABBIT BILBO)) ((HAS-POSSESSION CLAWS) PJG (MONKEY ABRACA) ((HAS-STATE LIKE A MONKEY) IWASA ((HAS-STATE A WICKED GOOD HUNTER) BOYACK (RACCOON PJG) (WOLVERINE BOYACK)) (BABOON IWASA)))) ((HAS-STATE POISONESS & HAS A FUNNY THING ON THE END OF IT IS TAIL) HEAD ((HAS-STATE A SNAKE) LMSJR ((HAS-STATE GREYISH-GREEN IN COLOR) JKESS ((HAS-STATE SNEAKY) BOYACK (|GILA MONSTER| LMSJR) (WEASEL BOYACK)) (IGUANA JKESS)) (|GARTER SNAKE| KRAUSS)) (RATTLESNAKE HEAD))) (PORCUPINE JJD)) ((HAS-POSSESSION ARMOR) JON-O (IGUANA JON-O) (ARMADILLO CLIVE))) ((HAS-POSSESSION BEAUTIFUL FEATHERS) SOROC ((HAS-ACTION GOES /" BEEP BEEP /") GERN (CHICKEN SOROC) (|ROAD RUNNER| GERN)) (PEACOCK PALLAS))) ((HAS-ACTION HAS STRIPES) SEB (AARDVARK SEB) (SKUNK LAUREN))) ((HAS-ACTION HAS NO FEET) JIM ((HAS-POSSESSION FEATHERS) JL ((HAS-ACTION LIVES IN TREES) CSTACY (|TASMANIAN DEVIL| ELIOT) (|KOALA BEAR| CSTACY)) (CHICKEN JL)) (SNAKE JIM))) ((HAS-STATE CUTE) VP (PIG MSI) (PIGLET VP))) ((HAS-POSSESSION VERY SOFT FUR) RJF ((HAS-ACTION LIVES UNDERGROUND) LAUREN ((HAS-ACTION BUBUILDS DAMS) LAUREN ((HAS-POSSESSION ARMOR) DAN ((HAS-ACTION HAS SHARP QUILLS) HEAD ((HAS-ACTION HAS A THIN TAIL) DAN (SQUIRREL DAN) ((HAS-ACTION KILLS SNAKES) MOBIUS (RAT GRAND) (MONGOOSE MOBIUS))) (PORCUPINE HEAD)) ((HAS-STATE SHARP) HEAD (ARMADILLO DAN) (PORCUPINE HEAD))) (BEAVER LAUREN)) ((HAS-ACTION COMES UP ON FEB) JHUA ((HAS-STATE A RAT) MSI ((HAS-ACTION HAS A LONG NOSE) BILLB ((HAS-ACTION JUMPS) IWASA (MOLE LAUREN) (RABBIT IWASA)) (AARDVARK BILLB)) (RAT MSI)) (GROUNDHOG JHUA))) ((HAS-ACTION LIVE IN TREES) DAN ((HAS-ACTION ((HAS FUR))) MCW (CHINCHILLA RJF) ((HAS-STATE A HOUSE PET) PAULP ((HAS-ACTION LIVES UNDERGROUND) LAUREN ((HAS-ACTION BUILDS DAMS) MWMT ((HAS-ACTION KILLS SNAKES) HUBRD ((HAS-ACTION CURLS UP INTO A BALL) MWT ((HAS-ACTION CAN PRODUCE A TERRIBLE ODOR) LAUREN (AMOUSE MCW) (SKUNK LAUREN)) (HEDGEHOG MWT)) (MONGOOSE HUBRD)) (BEAVER MWMT)) ((HAS-STATE MADE INTO COATS) LAUREN ((HAS-ACTION HAS LITTLE SQUINTY EYES) HEAD ((HAS-ACTION EATS VOALS FOR DINNER) FISH ((HAS-ACTION KNOW WHAT AN ANT-EATER IS) ALPHA ((HAS-PROPERTY RELATED) BERS (VOAL LAUREN) (|PRAIRIE DOG| BERS)) (ANT-EATER ALPHA)) (MARMOT FISH)) ((HAS-STATE BLIND) CSTACY (MOUSE CSTACY) (MOLE HEAD))) ((HAS-POSSESSION WHITE FUR) JCMA (MINK LAUREN) (ERMINE JCMA)))) ((HAS-STATE LARGER THAN A GERBIL) LAUREN ((HAS-STATE MUCH LARGER THEN A HAMSTER THAN A HAMSTER) FFM (HAMSTER FFM) (GERBIL PAULP)) ((HAS-ACTION DISTRIBUTES EASTER EGGS) LAUREN ((HAS-ACTION HAS A LONGER TAIL) LAUREN ((HAS-STATE SMALLER THAN A GERBILBIRBIL) DMK (HAMSTER LAUREN) (MOUSE DMK)) ((HAS-STATE SMALLER THAN A |RAT A RAT|) DMK (RAT LAUREN) (MOUSE DMK))) (RABBIT LAUREN))))) ((HAS-ACTION HAS WHITE STRIPES ON ITS SIDES) COOKIE (SQUIRREL DAN) (CHIPMUNK COOKIE)))))) (PLATYPUS CLG)) ((HAS-STATE EXTINCT) MAF ((HAS-STATE SUICIDAL) GRAND ((HAS-STATE MOUSE) PAULP ((HAS-STATE SLIMY) LAUREN ((HAS-STATE AN INSECT) SHL ((HAS-STATE ONE-CELLED) PGS ((HAS-STATE A HOUSE PET) SHC ((HAS-ACTION HAS A BUSHY TAIL) KMP ((HAS-STATE SMALLER THAN A RAT) LAUREN (RAT PAULP) ((HAS-ACTION HAS FEET INFRONT OF ITS FACE) BERS ((HAS-STATE A PRIMATE) MJK (VOLE LAUREN) ((HAS-ACTION LIVES IN SOUTH AMERICA) BERS (MARMOSET MJK) (CHINCHILLA BERS))) (MOLE BERS))) (SQUIRREL KMP)) (HAMPSTER SHC)) (PARAMECIUM PGS)) ((HAS-ACTION LIVES IN THE DESERT) LAUREN (EARWIG SHL) ((HAS-ACTION LAYS FOR PASSERS-BY) BOYACK (SCORPION LAUREN) (ANTLION BOYACK)))) ((HAS-POSSESSION LEGS) A2DEH (SALAMANDER LAUREN) (WORM A2DEH))) (MOUSE ELIOT)) ((HAS-STATE SMALLER THAN A LEMMING) BILLB (LEMMING GRAND) (SHREW BILLB))) (LEMUR MAF))))) ((HAS-ACTION HAS A BACK SEAT) JIM ((HAS-ACTION MANUFACTURER IS BASED IN DEARBORN /, MICHIGAN) GRAND ((HAS-STATE MADE BY CHEVY /, INC) LAUREN ((HAS-STATE VERY EXPENSIVE) JJD ((HAS-ACTION HAS A ROTARY ENGINE) JJD ((HAS-POSSESSION A MID-ENGINE) JJD ((HAS-ACTION HAS NO ENGINE) JOSE ((HAS-POSSESSION WHEELS) BILLT (|GMC TRUCK| ELIOT) ((HAS-STATE MADE IN JAPAN) JPG (MUSTANG BILLT) (|HONDA PRELUDE| JPG))) (BICYCLE JOSE)) (|FIAT X-19| JJD)) (|MAZDA RX-7| JJD)) ((HAS-STATE A PRODUCTION CAR) JJD ((HAS-ACTION GOES 0-100 MPH IN /13 SEC) HARV ((HAS-ACTION HAS LOTS OF BLINKEY-LIGHTS) A2DEH (|MERCEDES C-111| JJD) (PDP-10 A2DEH)) (|SHELBY COBRA| HARV)) ((HAS-STATE MUCH MORE EXPENSIVE) JJD (|MASERATI MERAK| JJD) (|LAMBORGHI COUNTACH| JJD)))) ((HAS-ACTION HAS /6 CYLINDERS ONLY) SLH (|EL CAMINO| LAUREN) (NOVA SLH))) ((HAS-ACTION BALLS) PIBE ((HAS-ACTION CAN NOT) HARV (|FORD TRUCK| GRAND) ((HAS-PROPERTY ONE) HARV (N HARV) (|K CAR| HARV))) ((HAS-ACTION HAS ONE OF ITS PISTONS IS BOTH THE SAME) HARV (MAN PIBE) (COBRA HARV)))) ((HAS-ACTION COSTS ABOUT $ 20K MORE) ELIOT ((HAS-STATE A GERMAN CAR) TANG ((HAS-ACTION CAN BE DESTROYED WITH A CAN-OPENER) DEVON ((HAS-STATE DISTINGUISHED FROM A CAMERO) PC (|FRAT BROTHER| PC) ((HAS-STATE MADE IN /1957) CSTACY ((HAS-ACTION COSTS LESS THAN $ 8K) GERN (CAMERO JIM) (CAVALIER GERN)) (|1957 CHEVY| CSTACY))) ((HAS-ACTION CAN BE MOVED BY THREE DRUNK COLLEGE STUDENTS) |M.JR| (|CHEVY SHIT-VETTE| DEVON) ((HAS-ACTION HAS NO GUTS) ARK (|DATSUN 210| |M.JR|) (CHEVETT ARK)))) ((HAS-ACTION COSTS MORE) JJD ((HAS-STATE A STATION WAGON) JJD (RABBIT TANG) (|VOLKSWAGEN DASHER WAGON| JJD)) (|VOLKSWAGEN SCIROCCO| JJD))) ((HAS-ACTION CAN GO IN EXCESS OF /200 MPH IN FOURTH GEAR) KOVAR ((HAS-STATE MADE IN GERMANY) JJD ((HAS-ACTION HAS MODERN STYLING) JJD ((HAS-STATE AN ANIMAL) RKC (|ROLLS ROYCE| ELIOT) (BABY RKC)) (|LOTUS ELAN| JJD)) ((HAS-ACTION HAS A TURBOCHARGED ENGINE) JJD (|BMW 621CSI| JJD) (|PORCHE 911 TURBO CARRERA| JJD))) ((HAS-STATE USUALLY RED) JJD (|STREET LEGAL LAMBOURGINI| KOVAR) ((HAS-ACTION USES SKATES) HARV ((HAS-STATE AGE) GHSCC (|FERRARI BERLINETTA BOXER| JJD) (|FORD MUSTANG| GHSCC)) (|HOG ON ICE| HARV))))))) ((HAS-STATE A BABY ANIMAL) PLK ((HAS-ACTION (IS) A (COMPUTER) PROGRAMMER) KATIN ((HAS-STATE A KIND OF CAT) KMP ((HAS-POSSESSION BLUE CLAWS) JSOL (|KIND OF CAT| KMP) (DOMINIQUE JSOL)) ((HAS-STATE A HOUSE CAT) RDBH ((HAS-ACTION GOT SPOTS) KJB ((HAS-ACTION HAS A MANE) NB ((HAS-ACTION HAS A DISTINCTIVE RED SHIFT) LAUREN ((HAS-ACTION HAS A DISTINCTIVE RED SHIFT) LAUREN (FRITZ KMP) (|QUASAR CAT| LAUREN)) (QUASAR-CAT LAUREN)) (LION NB)) (LEOPARD KJB)) (CAT RDBH))) ((HAS-ACTION SAYS /, /" WE/'RE NOT PAID TO DO THAT KIND OF THING) DANIEL ((HAS-STATE AN INSTITUTE HACKER) JKESS (MUUSS KATIN) (JKESS JKESS)) (KMP DANIEL))) (KITTEN PLK))) ((HAS-STATE A REPTILE) DAN ((HAS-STATE AN INSECT) RP0L ((HAS-STATE SMALLER THAN AN ELEPHANT) MAF ((HAS-ACTION HAS A LONG NOSE) JIM ((HAS-STATE EXTINCT) RBARCK ((HAS-ACTION HAS LEGS) SHAG (WHALE JIM) ((HAS-ACTION HAS A TUSK) PJG (RHINOSCEROUS SHAG) (ELEPHANT PJG))) (DINOSAUR RBARCK)) ((HAS-ACTION LIVED LONG AGO) IWASA (ELEPHANT ELIOT) ((HAS-ACTION EXTINCT) MJK ((HAS-ACTION EATS ANTS) AKRAM (ELEPHANT MJK) (AARDVARK AKRAM)) (MAMMOTH IWASA)))) ((HAS-STATE LARGER THAN A WORM) |K.E.D.| ((HAS-ACTION MADE A MISTAKE) JHUA ((HAS-ACTION LARGER THAN A WORM) IWASA ((HAS-PROPERTY WHITE) SY (WORM MAF) (MAGGOT SY)) (RHINO IWASA)) ((HAS-STATE A MORE EXPLICIT MISTAKE) HOEY (|| JHUA) ((HAS-STATE MORE DANGEROUS THAN A YOU) SULLIV (OOPS HOEY) (WOOPS SULLIV)))) ((HAS-ACTION GRUNTS) MSI ((HAS-STATE A PET) DIANA ((HAS-ACTION (IS TRYING TO RUN FOR PRESIDENT BUT IS ONLY A GRADE B MOVIE ACTOR)) CLEMW ((HAS-STATE A HUMAN) SHL ((HAS-STATE MADE OF CORN) CEH ((HAS-STATE LISTED VERY EARLY IN THE DICTIONARY) TXI ((HAS-POSSESSION A MANE) PJG ((HAS-ACTION I3) KYRHIZ (AARDVARK |K.E.D.|) (PEOS KYRHIZ)) (LION PJG)) ((HAS-ACTION HAS ARMOR) COUGH (|DUCKBILL PLATAPUS| TXI) (ARMADILLO COUGH))) (POPCORN CEH)) ((HAS-STATE THE PRESIDENT OF THE US) SHL ((HAS-ACTION SCULPTED THE PIETA) |SOMEONE IMPERSONATING GOD| ((HAS-ACTION DWELLS IN NE43 |(| 8TH FLOOR |)|) DR (GRANDMA SHL) ((HAS-ACTION HACKS MORE THAN KMP) DR (KMP DR) (KRNZ DR))) (MICHELANGELO |SOMEONE IMPERSONATING GOD|)) (|JIMMY CARTER| SHL))) ((HAS-ACTION HAS A BRIGHTER SMILE THAN RON REAGAN) |SOMEONE IMPERSONATING GOD| (|RONALD REGAN| CLEMW) ((HAS-STATE A MOVIE ACTOR) DKS (|LEONID BREZHNEV| |SOMEONE IMPERSONATING GOD|) (|RONALD REAGAN| DKS)))) ((HAS-STATE A HOUND) DKR ((HAS-ACTION SMELLS LIKE FISH) DAN (BULLDOG DIANA) (TWAT DAN)) ((HAS-STATE A FISH) KYRHIZ (|BLOOD HOUND| DKR) (SALMON KYRHIZ)))) ((HAS-STATE SMALLER THAN A HIPPO) RBARCK ((HAS-ACTION HAS A HORN OR TWO) MANLEY (HIPPO MSI) (RHINOCEROS MANLEY)) ((HAS-STATE JAP-PY) JHUA ((HAS-STATE PLAYING THIS GAME) ALK ((HAS-STATE PLAYING THIS GAME) ALK ((HAS-STATE AN APE) EULER ((HAS-STATE LARGER THAN A PIG) ALLAN ((HAS-ACTION HAS SHINY BACK |(| DORSAL |)| SPINES) DONALD ((HAS-STATE SMALLER THAN A PIG) A2DEH (PIG RBARCK) (ARMADILLO A2DEH)) (CUN-HSHO DONALD)) ((HAS-ACTION HOLLYWOOD CAREER) ABRACA ((HAS-ACTION (LIKES PEANUTS)) DR ((HAS-STATE LARGER THAN A TAPIR) GERN (TAPIR ALLAN) (RHINO GERN)) ((HAS-PROPERTY BEAUTIFUL) SEH (|JIMMY CARTER| DR) (|LA LISA| SEH))) (|RONALD REAGAN| ABRACA))) (ORANGUTAN EULER)) (YOU ALK)) ((HAS-STATE ANY ME) MST (ME ALK) (HUMAN MST))) (CLIFFIE JHUA)))))) ((HAS-ACTION HAS AN EXO-SKELETON) GRAND ((HAS-POSSESSION A HORN) SHL (EARTHWORM SHL) ((HAS-ACTION HAS FOUR LEGS) MANLEY ((HAS-HABITAT IN CHEAP BARS) BOYACK (|TOMATO WORM| SHL) (|WORM IN THE TEQUILA BOTTLE| BOYACK)) (RHINOCEROS MANLEY))) (INSECT GRAND))) ((HAS-POSSESSION THREE EYES) CXC ((HAS-STATE EXTINCT) JERRYB ((HAS-STATE LARGER THAN A GILA MONSTER) ALLAN ((HAS-STATE POISONOUS) VP ((HAS-ACTION CAN CHANGE TO ANY COLOR) KRAUSS ((HAS-ACTION HAS CLAWS) BART (|HORNY TOAD| VP) ((HAS-ACTION HAS AN ARMORED SHELL) BERS (IGUANA BART) (ARMADILLO BERS))) (CHEMELEON KRAUSS)) (|GILA MONSTER| DAN)) ((HAS-ACTION HAS AN ARMORED SHELL) BERS (|KOMODO DRAGON| ALLAN) (ARMADILO BERS))) (BRONTASAURUS JERRYB)) ((HAS-ACTION WIN) DAN ((HAS-PROPERTY BIG) IWASA (TUATARA CXC) (DINO IWASA)) (N DAN))))) ((HAS-ACTION SMELLS BAD) DAN ((HAS-STATE A REPTILE) GRAND ((HAS-ACTION HAS A LONG NECK) EJS ((HAS-ACTION HAS A FORKED TONGUE) EJS ((HAS-STATE A FELINE) GRAND ((HAS-ACTION LOOKS LIKE A DOG) SJK ((HAS-ACTION HAS A MASK) KMP ((HAS-STATE SMALLER THAN A ZEBRA) JANUS ((HAS-POSSESSION HORNS) |M.JR| (ZEBRA ELIOT) (ZEBU |M.JR|)) ((HAS-ACTION FROM CHINA) AYCHU ((HAS-ACTION TURNS INTO A BUTTERFLY) BOYACK ((HAS-ACTION EATS SEEDS) BOYACK (CAT JANUS) (CHIPMUNK BOYACK)) (CATERPILLAR BOYACK)) (PANDA AYCHU))) ((HAS-ACTION HAS A BUSHY TAIL) VP ((HAS-STATE NOTHING) BERS (RACOON KMP) (|| BERS)) (|RING-TAILED FOX| VP))) ((HAS-ACTION LIVES ON TERMITES) EULER (FOX SJK) (AARDWOLF EULER))) ((HAS-STATE A PET) PLK (TIGER GRAND) (CAT PLK))) (NIXON EJS)) ((HAS-POSSESSION STRIPES) NB (GIRAFFE EJS) (ZEBRA NB))) ((HAS-PROPERTY SLOW) ELF (|RATTLE SNAKE| GRAND) (RACOON ELF))) ((HAS-ACTION SMELLS WORSE THAN A SKUNK) EJS ((HAS-STATE CARNIVOROUS) HUBRD ((HAS-ACTION SMELLS) DESFZ (ZEBRA DESFZ) ((HAS-STATE MUCH LARGER THAN A SKUNK) MSS (SKUNK DAN) ((HAS-ACTION HAS A VERY LONG NECK) RMS (ZEBRA MSS) (GIRAFFE RMS)))) ((HAS-ACTION SPINS AROUND IN CIRCLES IN THE BUGS BUNNY SHOW) PERSA ((HAS-ACTION SKIN DOES NOT SELL FOR BUCKS NOR DO BEANS SURVIVE IN AUSTRAILIA) ELMO (MINK HUBRD) (IGUANA ELMO)) (|TASMAINIAN DEVIL| PERSA))) ((HAS-ACTION SMELLS WORSE THAN A POLLACK) EJS ((HAS-ACTION GOES /" I AM A /" N /" /") DAA (POLLACK EJS) (N DAA)) ((HAS-ACTION SMELLS WORSE THAN AN ANYTHING) EJS (|DAVE RAITZIN| EJS) ((HAS-STATE PLEASANT) EJS ((HAS-STATE A COMPUTER GAME) SULLIV ((HAS-ACTION HAS RED) SULLIV (|BARRY TRAGER| EJS) (K SULLIV)) (YOU SULLIV)) (|SWAMP GAS| EJS))))))) ((HAS-STATE A PREDATOR) KMP ((HAS-PROPERTY BLUE) ELIOT ((HAS-PROPERTY RED) ELIOT ((HAS-STATE AN INSECT) CLG ((HAS-STATE A BIRD) GRAND ((HAS-ACTION ENGINES FALL OFF) HOEY ((HAS-ACTION COMES OUT AT NIGHT ONLY) PETE ((HAS-ACTION FLAMES) PGS ((HAS-ACTION MADE AMISTAKE) KMP (|FLYING SQUIRREL| GRAND) (BABY KMP)) ((HAS-STATE MORE INTERESTING THAN A TECHIE) KMP (TECHIE PGS) ((HAS-STATE MORE CUDDLY THAN KMP) VP (KMP KMP) (POOH VP)))) ((HAS-ACTION CUTER THAN A BAT) VP (BAT PETE) (KMP VP))) (DC-10 HOEY)) ((HAS-STATE BEAKED) DIANA ((HAS-ACTION YELLOW) DIANA ((HAS-STATE A DIRTY ANIMAL) VP ((HAS-ACTION TT IS LARGER THAN A ROBIN) IWASA (ROBIN KMP) (TURKEY IWASA)) (PIGEON VP)) ((HAS-ACTION CAN FLY BACKWARDS) EPSTED (CANARY DIANA) (HUMMINGBIRD EPSTED))) ((HAS-STATE NIL) HAGEN ((HAS-ACTION GOES /" QUACK QUACK /") SHAG ((HAS-ACTION CAN TALK) LAUREN ((HAS-STATE A SCAVENGER) PALLAS ((HAS-ACTION SMALLER THAN PELICAN) JAMJR ((HAS-POSSESSION GREY FEATHERS) JKESS (PELICAN DIANA) (GOOSE JKESS)) ((HAS-ACTION CAN FLY BACKWARDS) CDR ((HAS-STATE BIGGER THAN AN ORIOLE) PECM ((HAS-PROPERTY YELLOW) RHB ((HAS-PROPERTY ONE) BILLB (ORIOLE JAMJR) (CHICKADEE BILLB)) ((HAS-ACTION HAS A GOLDEN BELLY) BERS (BUDGEREGAR RHB) (|BREASTED CHICKADEE| BERS))) ((HAS-ACTION HAS A WATTLE) SICC ((HAS-STATE THE FASTEST ANIMAL IN THE WORLD) SULLIV ((HAS-HABITAT IN A PEAR TREE) BOYACK (CHICKEN PECM) (PARTRIDGE BOYACK)) (|SPINE-TAILED SWIFT| SULLIV)) ((HAS-ACTION HAS A FAN SHAPED TAIL) BERS (TURKEY SICC) (PEACOCK BERS)))) (|HUMMING BIRD| CDR))) ((HAS-ACTION LARGER THAN A CONDOR) LETTO (CONDOR PALLAS) (VULTURE LETTO))) (PARROT LAUREN)) (DUCK SHAG)) (THEM HAGEN)))) ((HAS-ACTION EVOLVES FROM A CATERPILLER) DAN ((HAS-ACTION EVOLVES FROM A MAGGOT) SHAG ((HAS-POSSESSION A STINGER) LAUREN ((HAS-ACTION CHEWS HOLES IN CLOTHES) LAUREN ((HAS-ACTION LIVES IN CAMBRIDGE) TLD ((HAS-ACTION ASS LIGHTS UP) PAE ((HAS-ACTION EATS WOOD) COOKIE ((HAS-ACTION COMES IN SWARMS) LOIEDE ((HAS-ACTION BITES PEOPLE) ELF ((HAS-ACTION LIVES UNDER GO /, /, /, /, < < < _ < < < ROUND) A2DEH (GRASSHOPPER CLG) (N A2DEH)) (MOSQUITO ELF)) ((HAS-STATE DIFFERENT //) A2DEH (LOCUST LOIEDE) (GRASSHOPPER A2DEH))) (TERMITE COOKIE)) (|LIGHTNING BUG| PAE)) ((HAS-PROPERTY GREEN) WGD ((HAS-PROPERTY SMALL) DMK (COCKROACH TLD) ((HAS-PROPERTY BIG) DEEP (FRUITFLY DMK) (BUTTERFLY DEEP))) ((HAS-STATE SMALLER THAN A GRASSHOPPER) PERSA (GRASSHOPPER WGD) (|LEAF HOPPER| PERSA)))) (MOTH LAUREN)) (BEE LAUREN)) ((HAS-STATE SMALLER & IS IN THE PHYLUM OF DROSOPHILA THAN A |COMMON HOUSE FLY|) HUBRD ((HAS-ACTION BITES) DADA ((HAS-ACTION DOSESN/'T FLY) BERS (|COMMON HOUSEFLY| SHAG) (COCKROACH BERS)) (HORSEFLY DADA)) ((HAS-STATE A SCIENTIFIC NAME) KMP ((HAS-ACTION EATS WOOD) LYMAN (|FRUIT FLY| HUBRD) (TERMITE LYMAN)) (|DROSOPHOLA MELANOGASTER| KMP)))) ((HAS-ACTION EATS WOOL) LAUREN (BUTTERFLY DAN) (MOTH LAUREN)))) ((HAS-POSSESSION A COMB) PLK ((HAS-STATE AN INSECT) KRAUSS ((HAS-STATE SMALLER THAN A CARDINAL) LYMAN ((HAS-STATE A TROPICAL BIRD) PJG (CARDNAL ELIOT) ((HAS-ACTION HAS A MULTI-COLORED BEAK) KMP (PARROT PJG) (PARAKEET KMP))) ((HAS-ACTION WILL NOT) BILLB (BUTTERFLY LYMAN) (|AAA JAQUES COUSTEAU| BILLB))) ((HAS-ACTION DIGS) TLD ((HAS-PROPERTY SMALL) IWASA (|CECROPIA MOTH| KRAUSS) (LADYBUG IWASA)) (ANT TLD))) ((HAS-STATE SMALLER THAN A TOASTER) GERN (ROOSTER PLK) (CARDINAL GERN)))) ((HAS-ACTION SUPER POWERS) BLOTTO ((HAS-ACTION TALKS) HEAD ((HAS-ACTION LIKE TO GO /" HOME /") BERS (JAY ELIOT) (PIGEON BERS)) ((HAS-STATE OBNOXIOUS) HARV (PARROT HEAD) ((HAS-ACTION TALKS) IWASA (BLUEJAY IWASA) ((HAS-STATE SMALLER THAN A MIYNAH BIRD) GERN (|MIYNAH BIRD| HARV) (PARAKEET GERN))))) ((HAS-ACTION LIVES IN AFRICA) SLH (SUPERMAN BLOTTO) (BIZFUR SLH)))) ((HAS-STATE SMALLER THAN AN EAGLE) ELIOT ((HAS-STATE IMAGINARY) AEZ ((HAS-ACTION HAS A BAR MITZVAH) EJS ((HAS-ACTION WALKS LIKE A DUCK) FREND ((HAS-ACTION HAS A LONG NECK) SHAG ((HAS-POSSESSION TWO SOFT SPHERES) CARYN ((HAS-STATE HUMAN) ALLAN ((HAS-ACTION LIVED LONG AGO) CDR ((HAS-ACTION HAS A FOURTEEN FOOT WINGSPAN) PERSA ((HAS-STATE NOCTURNAL BIRD) IWASA (EAGLE KMP) (OWL IWASA)) (ALBATROSS PERSA)) ((HAS-ACTION NOS) IWASA ((HAS-ACTION FLYS) GERN (DINASOR IWASA) (HAWK GERN)) (PTERODACTYL CDR))) ((HAS-ACTION (IS) HERE PLAYING (ME) SO LATE AT NIGHT) BIK (HUMAN BIK) ((HAS-STATE WIERD) BIK (PROGRAMMER ALLAN) ((HAS-ACTION WEARS CLOES) IWASA (HACKER BIK) (HUMAN IWASA))))) ((HAS-ACTION HAS TWO ROARING EXHAUSTS) HARV (|FEMALE HUMAN| CARYN) (|AC COBRA| HARV))) ((HAS-STATE AN UGLY DUCKLING) SHAG ((HAS-STATE EXTINCT) DH ((HAS-STATE LONGER THAN A CRANE //) IWASA (CRANE SHAG) (SNAKE IWASA)) (PTEREDACTYL DH)) (SWAN SHAG))) ((HAS-ACTION DRINKS ANY MORE) FREND ((HAS-ACTION BROTHER IS JIMMY CARTERS BROTHER HIS OTHER BROTHER IS NOT) FREND (|JIMMY CARTERS BROTHER| FREND) (|JIMMY CARTERS BROTHER'S BROTHER| FREND)) (|JIMMY CARTER| FREND))) ((HAS-ACTION JUMPS WHEN YOU QUACK) PERSA (JEW EJS) (AMIR PERSA))) ((HAS-POSSESSION A RED CAPE) SKH (DRAGON AEZ) (SUPERMAN SKH))) ((HAS-PROPERTY BLACK) MSI ((HAS-ACTION EATS FISH) JRF ((HAS-ACTION SCREECHES) EULER ((HAS-ACTION EATS MOSQUITOS) ALPHA ((HAS-ACTION DIES BUT EATING ITS FOOT) ALPHA ((HAS-ACTION HOOTS) RAM ((HAS-ACTION HAS DISTINQUISHING FEATURES ON ITS NECK) BIK ((HAS-ACTION DRINKS BLOOD) LAUREN (HAWK ELIOT) ((HAS-STATE AN INSECT) WJL (|VAMPIRE BAT| LAUREN) (MOSQUITO WJL))) ((HAS-ACTION TALKS) KYRHIZ (CROUL KYRHIZ) (KESTREL BIK))) (OWL RAM)) (|| ALPHA)) ((HAS-STATE A BIRD) COOKIE (|MOSQUITO MOTH| ALPHA) (CARDINAL COOKIE))) ((HAS-PROPERTY YELLOW) BILBO ((HAS-STATE A MAMMAL) DESFZ ((HAS-STATE BIGGER THAN AN OWL) GERN (OWL EULER) (HAWK GERN)) (BAT DESFZ)) ((HAS-STATE WISE) KMP (CANARY BILBO) (OWL KMP)))) ((HAS-ACTION REALLIES EXIST) JJD ((HAS-STATE A WINGLESS BIRD WITH HAIRY FEATHERS) BATES (L JJD) (APTERYX BATES)) ((HAS-STATE SAID TO BE WISE) JJD ((HAS-STATE A KIND OF HAWK) EULER ((HAS-ACTION LIVES NEAR THE OCEAN) JKESS (HERON EULER) (ALBATROSS JKESS)) (OSPREY JRF)) (OWL JJD)))) ((HAS-STATE A BIRD) SMK ((HAS-STATE AN INSECT) SHL ((HAS-STATE DERANGED) HUBRD (BAT MSI) (|DERANGED BAT| HUBRD)) ((HAS-POSSESSION EIGHT LEGS) CLEMW ((HAS-ACTION BITES) DADA (|GOLIATH BEETLE| SHL) (HORSEFLY DADA)) (WIDOW CLEMW))) ((HAS-ACTION DIFFERENT) ALLAN (HAWK SMK) (|DIFFERENT BIRD| ALLAN))))))) ((HAS-ACTION BREATHES AIR) KMP ((HAS-ACTION EATS OTHER FISH) KMP ((HAS-POSSESSION WHISKERS) ELIOT ((HAS-ACTION CAN PUFF UP) ELIOT ((HAS-POSSESSION A SHELL) CLG ((HAS-STATE MICROSCOPIC) EJS ((HAS-PROPERTY DARK) GRAND ((HAS-POSSESSION TENTICLES) DAN ((HAS-STATE GOOEY) LAUREN ((HAS-STATE ENDANGERED) AGRE ((HAS-STATE A FISHERMANS TREAT) LAUREN ((HAS-ACTION SWIMS WITH ITS HEAD ABOVE ITS TAIL) JCOHEN ((HAS-ACTION BELONGS TO PHYLUM PORIFERA) ERIC ((HAS-ACTION HAS A HIGH ARCHED BACK) KRONJ ((HAS-STATE FIVEFOLD SYMMETRIC) RDUKE ((HAS-PROPERTY GREEN) ELF ((HAS-ACTION CARRIES WATER IN IT IS HAIR) PERSA ((HAS-ACTION FLIES THROUGH THE AIR) COOKIE ((HAS-STATE FLAT) BERS (GOLDFISH KMP) (|STING RAY| BERS)) (|" FLYING FISH "| COOKIE)) (|WATER SPIDER| PERSA)) (MOSS ELF)) (STARFISH RDUKE)) ((HAS-PROPERTY GOLD) MSS (BREAM KRONJ) (GOLDFISH MSS))) (SPONGE ERIC)) (SEAHORSE JCOHEN)) ((HAS-STATE A SMALL SILVERY FISH FISH OFTEN USED FOR BAIT) HUBRD ((HAS-ACTION LIVES IN FRESH WATER) JKESS (HERRING JKESS) (TROUT LAUREN)) (HERRING HUBRD))) (|SNAIL DARTER| AGRE)) ((HAS-STATE EDIBLE) PETE ((HAS-ACTION BES SPREAD ON BREAD) A2DEH (FLATWORM A2DEH) (JELLYFISH LAUREN)) (SQUID PETE))) ((HAS-STATE BIGGER THAN AN OCTOPUS) CLG ((HAS-ACTION SQUIRTS OUT INK) MWMT (OCTOPUS CLG) (SQUID MWMT)) (SQUID DAN))) ((HAS-ACTION HAS A BICYCLE NAMED AFTER IT) LAUREN ((HAS-ACTION CHANGES WHEN IT GROWS UP) SHL ((HAS-ACTION HAS /8 ARMS) JONBOY ((HAS-STATE A BOTTOM DWELLER) LSH ((HAS-ACTION CRASHED ON GILLIGAN/'S ISLAND) ELIOT ((HAS-STATE LONG /, HARD /, CONTAINS SEAMEN) SULLIV (GUPPY GRAND) ((HAS-STATE METAL) BERS (G BERS) (SUBMARINE SULLIV))) (MINNOW ELIOT)) (CARP LSH)) (OCTUPUS JONBOY)) (TADPOLE SHL)) (|STING RAY| LAUREN))) ((HAS-STATE USED IN DNA RESEARCH) JHC ((HAS-STATE SLIPPER-SHAPED) JHC ((HAS-STATE MULT-CELLULAR) JHC ((HAS-STATE HORN-SHAPED) MWMT ((HAS-ACTION HAS A FLAGELLUM) EULER ((HAS-STATE PROKARYOYIC) JFK (AMOEBA EJS) (YEAST JFK)) ((HAS-STATE C CUP-SHAPED) NESSUS (EUGLENA EULER) (VORTICELLA NESSUS))) (STENTOR MWMT)) ((HAS-STATE AN ALGAE) JHC (VOLVOX JHC) (SPIROGYRA JHC))) (PARAMECIUM JHC)) ((HAS-STATE SINGLE CELLULAR) SHAG ((HAS-POSSESSION MANY CELLS) IWASA (|ESCHERICHIA COLI| JHC) (VLOVOX IWASA)) ((HAS-STATE SHAPED LIKE A FOOT) SHAG (AMEOBA SHAG) (PARAMECIUM SHAG))))) ((HAS-ACTION HAS CLAWS) CLG ((HAS-STATE SLIMY) LAUREN ((HAS-STATE A FORM OF ZOOPLANKTON) LAH ((HAS-ACTION MAKES A BETTER STEW THAN A |LIMPET STEW|) TLD (LIMPET LAUREN) (OYSTER TLD)) (COPAPOD LAH)) ((HAS-ACTION COMES ON A COMBINATION SEAFOOD PLATTER) LAUREN (SNAIL CLG) ((HAS-ACTION HAS A DIFFERENT SHELL) HUBRD (SCALLOP LAUREN) (ABALONE HUBRD)))) ((HAS-ACTION WALKS SIDEWAYS) ALPHA (LOBSTER CLG) (CRAB ALPHA)))) (|BLOW FISH| ELIOT)) ((HAS-ACTION HAS A SHELL) NEWMAN ((HAS-STATE MUCH OLDER THAN A CATFISH) JJD ((HAS-POSSESSION WINGS) LAUREN (|CAT FISH| ELIOT) (FLYING-FISH LAUREN)) (CEOLECANTH JJD)) (SHRIMP NEWMAN))) ((HAS-ACTION HAS /8 TENTACLES) ELIOT ((HAS-POSSESSION REAL BONES) WEIT ((HAS-ACTION HAS TEETH) YEKTA ((HAS-ACTION FLIES) EJS ((HAS-ACTION SQUIRTS INK) CLEMW ((HAS-POSSESSION A SHELL) LAUREN ((HAS-STATE SHAPED LIKE AN EEL) DT ((HAS-ACTION HAS /10 LEGS) CHAPMA ((HAS-STATE ATTACHED TO ROCKS) ALPHA ((HAS-ACTION HAS A LO NG WHIPLIKE TAIL) BILLB ((HAS-STATE VERY DANGEROUS) LEVIN (JELLYFISH YEKTA) (MAN-OF-WAR LEVIN)) (STINGRAY BILLB)) ((HAS-POSSESSION FIVE LEGS) BILLB (|SEA ANEMONE| ALPHA) (STARFISH BILLB))) (SHRIMP CHAPMA)) (LAMPREY DT)) (LOBSTER LAUREN)) ((HAS-ACTION HAS A SHELL) SULLIV (SQUID CLEMW) (AMMONITE SULLIV))) (|" FLYING FISH "| EJS)) ((HAS-ACTION LOOKS LIKE A HORSE) JHC ((HAS-POSSESSION CLAWS) DH ((HAS-POSSESSION LARGE WINGS) ALPHA ((HAS-STATE SMALLER THAN A SHARK) JFB ((HAS-ACTION EXTINCT) BILLB (SHARK KMP) (|CARCARCHADON MEGALADON| BILLB)) ((HAS-STATE A MEDIUM SIZED VORACIOUS FISH THAT LIVES IN SALT WATER) HUBRD (PIRANHA JFB) (BARRACUDA HUBRD))) (|MANTRA RAY EEL| ALPHA)) ((HAS-STATE MUCH MORE VICIOUS) KMP (CRAB DH) (KRAKEN KMP))) (SEAHORSE JHC))) ((HAS-STATE SMALLER THAN A BARRACUDA) GRAND ((HAS-POSSESSION A SHELL) BERG ((HAS-STATE BIGGER THAN A BARRACUDA) SHC ((HAS-ACTION COLOR) BILLB (BARRACUDA WEIT) (BLUEFISH BILLB)) (SHARK SHC)) ((HAS-ACTION GAYER) BERG (TURTLE BERG) (|CHARLIE RAND| BERG))) ((HAS-ACTION LIVES IN THE OCEAN) BENDER ((HAS-STATE PRETTIER THAN A PIRANHA) JL (|PIRANAH FISH| GRAND) ((HAS-STATE /10 TIMES AS BIG) LAIRD (GOLDFISH JL) (|LARGELARGEMOUTH BASS| LAIRD))) ((HAS-STATE THE TURKEY OF CAPE COD) BERS (COELOCANTH BENDER) (COD BERS))))) ((HAS-ACTION LARGER THAN AN OCTOPUS) BILLB (OCTOPUS ELIOT) (SQUID BILLB)))) ((HAS-ACTION HAS A BOTTLE NOSE) ELIOT ((HAS-POSSESSION A HARD SHELL) ELIOT ((HAS-PROPERTY GREEN) HAL ((HAS-ACTION (HAS WHISKERS)) PLK ((HAS-ACTION WIGGLES ITS ITS EARS) ROGERS ((HAS-ACTION FLOATS) MANLEY ((HAS-PROPERTY TINY) RBARCK ((HAS-STATE SMALLER THAN A WHALE) MSI (WHALE KMP) ((HAS-STATE EXTINCT) LAUREN ((HAS-ACTION LIVES IN WARM CLIMATES) BGR ((HAS-STATE A DUMB PROGRAM) FFM ((HAS-ACTION A DUMB PROGRAM) FFM ((HAS-STATE A BISCUIT) PJSG (|LOCH NESS MONSTER| PJSG) (PENGUIN MSI)) (EEL FFM)) (EEL FFM)) ((HAS-STATE A MAMAL) ARPEE ((HAS-STATE SMALLER THAN A HIPPO) RHB (HIPPOPOTOMUS BGR) ((HAS-STATE SOMEWHAT HARD-NOSED) DWARME (GOLDFISH RHB) (|DUCK-BILLED PLATYPUS| DWARME))) ((HAS-POSSESSION A DUCK-BILL) VP ((HAS-ACTION TALKS FUNNY) BILLB (FLIPPER VP) ((HAS-STATE WIERD) ELF (|JAQUES COUSTEAU| BILLB) (NATALIE ELF))) (|DUCK-BILLED PLATAPUS _ _ _ _ YPUS| ARPEE)))) ((HAS-ACTION LIVES IN THE WATER) KRAUSS (PTERYDACTAL LAUREN) (ICTHYOSAURUS KRAUSS)))) ((HAS-STATE A FROG) ALLAN ((HAS-ACTION /; (QUOTE LONG) BYE MALLER) IWASA ((HAS-ACTION WEARS A TUXEDO) BERS (SALIMANDER ALLAN) (PENGUIN BERS)) (TETRA IWASA)) (POLYWOG RBARCK))) ((HAS-STATE BIGGER THAN A |WATER FLEA|) NB ((HAS-STATE MICROSCOPIC) FFM (|WATER FLEA| MANLEY) (GERM FFM)) ((HAS-ACTION QUACKS) RBARCK ((HAS-ACTION A MARSUPIAL) JERRYB ((HAS-ACTION LAYS EGGS) RKC ((HAS-ACTION HAS A FRENCH ACCENT) BILLB ((HAS-STATE SMALLER THAN A WHALE) SICC (WHALE NB) (MARWHAL SICC)) (|JAQUES COUSTEAU| BILLB)) ((HAS-ACTION FLIES) FURUTA ((HAS-STATE A REPTILE) PJG ((HAS-ACTION HAS FUR) DAA (PENGUIN RKC) (PLATYPUS DAA)) (ALLIGATOR PJG)) ((HAS-PROPERTY WHITE) DEEP (|PIED-BILLED GREBE| FURUTA) (SWAN DEEP)))) (|DUCK BILLED PLATYPUS| JERRYB)) ((HAS-ACTION HAS EATHERS) ZANAR (|DUCK-BILLED PLATAPUS| RBARCK) (DUCK ZANAR))))) (HIPPOPOTOMUS ROGERS)) ((HAS-ACTION HAS BUCK TEETH) FFM ((HAS-STATE SMALLER THAN SEAL) PLK ((HAS-POSSESSION TWO LEGS) JHC ((HAS-STATE MUCH LARGER THAN A SEAL) IWASA (SEAL PLK) ((HAS-POSSESSION TUSKS) KMP (HIPPO IWASA) (WALRUS KMP))) (HUMAN JHC)) ((HAS-ACTION TASTES GOOD) REYNO ((HAS-STATE SMALLER THAN AN OTTER) LOIEDE ((HAS-ACTION HAS WEBBED FEET) NB (OTTER PLK) ((HAS-STATE A BIRD) IWASA (PLATYPUS NB) (PENGUIN IWASA))) (OPOSSUM LOIEDE)) (|JUICY MUFF| REYNO))) ((HAS-ACTION HAS LONG TUSKS) |M.JR| ((HAS-STATE THE MASCOT OF MIT) FH ((HAS-STATE WHAT STUDS LIKE TO PLAY WITH) SEH ((HAS-ACTION EATS ABOLONI) IWASA (HIPPOPOTAMUS FH) (OTTER IWASA)) (BEAVER SEH)) ((HAS-ACTION SLIP YOUR ORGAN INTO IT) SEH (BEAVER FFM) (VAGINA SEH))) (WALRUS |M.JR|)))) ((HAS-STATE LARGER THAN A FROG) DAN ((HAS-POSSESSION A SHELL) KMP ((HAS-STATE MICROSCOPIC) PERSA (FROG HAL) (ZOOPLANKTON PERSA)) (|SOFT-SHELL TURTLE| KMP)) ((HAS-ACTION EATS FISH) CLG ((HAS-STATE BIGGER THAN A TOAD) SJK (TOAD DAN) (ALLIGATOR SJK)) ((HAS-STATE A SNAKE) CXC ((HAS-ACTION HAS A BLUNT SNOUT) JKESS ((HAS-ACTION LIVES IN THE AMAZON) MJK (ALLIGATOR CLG) (KAMAN MJK)) (CROCODILE JKESS)) (ANACONDA CXC))))) ((HAS-ACTION HAS A HORN ON ITS NOSE /, A TUT TURTLE DOES NOT) KRAUSS (TURTLE ELIOT) (RHINO KRAUSS))) ((HAS-ACTION HAS LARGE TAIL) |K.E.D.| ((HAS-ACTION CONTAINS COLA) GRM ((HAS-ACTION CONTAINS UN-COLA) GRM ((HAS-ACTION HAS FEATHERS) TRIEU ((HAS-STATE AN AMPHIBIAN) PERSA ((HAS-ACTION HAS A BOTTLE NOSE) KMP (|NON-BOTTLE-NOSE DOLPHIN| KMP) (|BOTTLE-NOSE DOLPHIN| KMP)) (TURTLE PERSA)) (DUCK TRIEU)) (|PLASTIC 7-UP BOTTLE| GRM)) (|PLASTIC PEPSI BOTTLE| GRM)) ((HAS-ACTION CAN BE TRAINED) ROGERS ((HAS-STATE EXTINCTIT CANNOT BE TRAINED) BILLB ((HAS-ACTION COLOR) TBG ((HAS-ACTION HAS /4 LEGS) PJG (PURPOSE |K.E.D.|) (ALLIGATOR PJG)) ((HAS-ACTION SHAPE) GERN (|PINK BOTTLE| TBG) (N GERN))) (|DUCK-BILLED PLATYPUS| BILLB)) ((HAS-STATE A PORPOISE) ALPHA ((HAS-STATE A PORPOISE) ALPHA ((HAS-STATE BIGGER THAN A PORPPOISE) DNG ((HAS-ACTION SMELLS) GJH ((HAS-ACTION HAS HAIR IN ITS NOSTRILS) SLH (PORPOISE ROGERS) ((HAS-STATE A DOLPHIN) IWASA (|KHOMEINIS MUTHER| SLH) (|BOTTLED NOISE DOLPHIN| IWASA))) ((HAS-STATE BUFF) ELF (|IMSSS RODENT IMSSS RODENT| GJH) (ERIC ELF))) ((HAS-ACTION EATS LIVE FISH WHILST AN IMSSS RODENT MUST SETTLE FOR DEAD SCRAPS) GJH (|IMSSS RODENT| GJH) (DOLPHIN DNG))) ((HAS-STATE A FRUIT) ALPHA (PORPOISE ALPHA) (GRAPEFRUIT ALPHA))) ((HAS-STATE AN ANIMAL) JALEX ((HAS-STATE SWEETER) DMK (GRAPEFRUIT ALPHA) (PEACH DMK)) ((HAS-STATE DIFFERENT SPECIES) GED (PORPOISE JALEX) (DOLPHIN GED)))))))))) \ No newline at end of file diff --git a/src/games/chase.(init) b/src/games/chase.(init) new file mode 100644 index 00000000..0e65a708 --- /dev/null +++ b/src/games/chase.(init) @@ -0,0 +1,4 @@ +(comment core 75.) +(progn + (fasload chase fasl dsk games) + (chase)) \ No newline at end of file diff --git a/src/games/chase.info b/src/games/chase.info new file mode 100755 index 00000000..e7275ef9 --- /dev/null +++ b/src/games/chase.info @@ -0,0 +1,105 @@ +Copyright (C) 1978 William A. Kornfeld + + CHASE - A Real Time game for VT52's + +CHASE is real time game (e.g. space war, MAZE, etc.) with the distinction that +it is played on a VT52. The game is played by two players who must both be +present at the same physical terminal. It can in principle be used on other +character display terminals but may require redesignation of some of its +command characters to retain their current positional mnemonic significance. +CHASE can be played over phone lines with as little as a 300 baud modem or over +the net (though response may be somewhat unsatisfactory). + + +To setup a VT52 for CHASE make sure of the following: + + 1. CAPS LOCK is set! + + 2. The terminal is not in one of the VT52's special modes (i.e. graphics + or alternate keypad). This can be assured by momentarily turning off + power to the terminal. + + + +After the game has begun you will notice a maze appear on the screen and +four characters: X,x,O, and o. The two X's are controlled by the person on +the left side of the terminal and the O's by the person on the right side. +The two large letters are known as "chasers" and the two small letters as +"chasees". The object of the game is to have your chaser "catch" (bump +into) the opponent's chasee. The game can be thought of as two simultaneous +chases happening concurrently in the maze. Each player plays both offense +and defense. Each player specifies directions for the two pieces under +his/her control. They may move anywhere in the maze as though they cannot +be moved through the wall of the maze. There is one additional constraint: +a chaser cannot move through the opponents chaser nor a chasee through the +opponents chasee. In addition to a pieces normal function it can also be +used to block. In this way the two chases interact and can lead to +sophisticated strategy with experienced players. + +Pieces can be made to move in any of four directions (or held in place) by +appropriate keystrokes. Once a piece is put into motion it will remain in +motion at a constant velocity (same for all pieces at all times) until it is +explicitly told to stop or it reaches an obstruction which it cannot pass. +Each piece is controlled by a group of four keys (one for each direction) +arranged so that the players do not have to watch the keyboard as they enter +commands. In each group of four keys 3 are at the same level and 1 is directly +above the middle of the 3 keys. The lower 3 keys are respectively left, down, +and right. The upper key is up. The middle 3 fingers of each hand should be +placed on the 3 keys. In this way commands may be entered easily. As an +example the X piece is controlled by the four keys: A,S,D, and W. The middle 3 +fingers of the left hand of the X-player should be placed on A, S, and D. +Hitting D once will start the X piece going right until it either hits +something or another command is given. Similarly for A, S, and W with left, +down, and up. The four command pads are: + + BIG-X little-x + + A T + + S D W F G H + + + + BIG-O little-o + + [ 8 + + ; ' { 4 5 6 + + ^^^^^These four numbers are typed on + typed on the numeric keypad to the + right of the normal keypad. + +If a piece is going in a direction, giving the command to travel in the +opposite direction once will stop the piece. Giving it twice will start the +character in the opposite direction. If a piece is going in a direction and +the command is given for it to go in an orthogonal direction it will +immediately start in that direction. Note that if a piece has been travelling +in a direction and hits an obstruction (usually the wall of the maze) it will +act as if it is still going in that direction with respect to future commands. + +Games continue until a chaser has caught a chasee. The program pauses then for +a few seconds to report the victor and the score. When done it prints "READY". +Hitting RETURN will start a new game (with the initial positions of pieces +switched to be fair). If the display gets screwed up for any reason hitting +LINEFEED will freeze the game and do a redisplay. If the program screws up, it +may be started fresh from the top level LISP by typing (CHASE). + +It doesn't take long to get reasonably comfortable with the controls. It is +easy however to get confused as you control the two pieces simultaneously. +Part of the skill to develop is in how to overcome this confusion. This also +enters into strategy. You can count on your opponent to get confused in +certain positions and can take advantage of that fact. This happens, for +example, when his/her 2 pieces cross paths or when they are both in opposite +parts of the maze and doing difficult manuevering. Strategy also includes +using your chaser to block the opponents chaser on defense and using your +chasee to block the opponents chasee on offense. It is important to always +remain on the offense. Beginners quickly give up offense when the going starts +getting rough. This only makes things worse in the end. + +There is one unfortunate bug that I have not exorcised where the program +breakpoints just before restarting the game. If this happens just hit +CTRL-G and then type (CHASE) for a refresh. + +This game is protected by US Copyright. No implementation may be undertaken +for any commercial purpose without prior consent from William A. Kornfeld. diff --git a/src/games/doc.(init) b/src/games/doc.(init) new file mode 100644 index 00000000..90881fec --- /dev/null +++ b/src/games/doc.(init) @@ -0,0 +1,1540 @@ +;;; -*- LISP -*- + +(COMMENT) +(PROG2 + (SETQ PRIN1 'PRINC) + '|/ +The doctor will be ready in a sec... When he is ready,/ +he will say so. Please end responses with/ +a period./ + Be patient!/ + -The Doctor's Secretary/ +| +((LAMBDA (FILE) + ((LAMBDA (MSGFILES) + (LOAD '((LISP) LET FASL)) + (LOAD '((LISP) DEFMAX FASL))) (NCONS FILE)) + (CLOSE FILE)) + (OPEN '((NUL *) * *) 'OUT)) +(SSTATUS FEATURE NOLDMSG) +(CLEAR-INPUT TYI)) +(PROGN +(SETQ PRIN1 NIL) +(SETQ GC-OVERFLOW '(LAMBDA (X) T)) +(SSTATUS FEATURE NOLDMSG) +(*RSET T) +(NOUUO T) +(DEFAULTF '(_LISP_ >)) +(SETQ LISPT-PROTECT T) +(CLOSE (PROG2 T INFILE (INPUSH -1.))) +(DECLARE (SPECIAL ERRLIST FOO EXIT *RSET LINEL AFFIRMATIVES NEGATIVES + MAYBES SMALL-LETTERS N THING CONTRACTIONS S-QUOTE OPEN-QUOTES + CLOSE-QUOTES SPACE COMMA PERIOD SEMICOLON EXCLAM + GUESS-X MEMORY KMPMODE A DEFAULTF WRITABLE LISPT-JNAME + OPEN-PAREND CLOSE-PAREND IN_FILE WRITE-PROTECT + DOTDOTDOT EXCLAM-3 COLON QMARK HYPHEN NEWLINE TAB)) + +(DEFUN WINNER () + (MEMQ (STATUS UNAME) + '(TNP KMP RWK MRG JPG BKERNS JM BMT RZ EJS WAM CSTACY + PAULP FRAWLE BUD MIKE GLS HIC ELLEN RL KRD))) + +(EVAL-WHEN (EVAL COMPILE) + (COND ((NOT (STATUS FEATURE IOTA)) + (LOAD '((DSK LIBLSP) IOTA FASL))))) + +(COND ((AND (NOT (EQ (STATUS USERID) 'KMP)) + (PROBEF '((USR *) KMP HACTRN))) + (LET ((BASE 10.) (*NOPOINT T) ((HOUR MIN) (STATUS DAYTIME))) + (ERRSET + (IOTA ((STREAM '((CLI *) KMP HACTRN) '(OUT))) + (MAPC (FUNCTION (LAMBDA (X) (PRINC X STREAM))) + (LIST + '|/[Message from The Doctor Game at MIT-MC | + (COND ((ZEROP (\ HOUR 12.)) '|12|) (T (\ HOUR 12.))) + '/: + (COND ((< MIN 10.) (IMPLODE (LIST '/0 (+ MIN 48.)))) + (T MIN)) + (COND ((ZEROP (// HOUR 12.)) '|am|) + (T '|pm|)) + '/] (ASCII 13.) (STATUS UNAME) + '| is gonna have a private chat with me. If you| + (ASCII 13.) + (ASCII 10.) + '|feel like a good laugh, you're welcome to watch.| + )) + (TERPRI STREAM)) + NIL)))) + +(SETQ MONOSYLLABLES + '|/ + Your attitude at the end of the session was wholly unacceptable./ + Please try to come back next time with a willingness to speak more/ + freely. If you continue to refuse to talk openly, there is little/ + I can do to help!/ +|) + +(DEFUN SUICIDE () + (IOTA ((STREAM '|.MAIL.;MAIL >| '(OUT ASCII BLOCK DSK))) + (PRINC '|FROM-JOB:KMP's DOCTOR| STREAM) + (TERPRI STREAM) + (PRINC '|SENT-BY:DOCTOR| STREAM) + (TERPRI STREAM) + (PRINC '|TO:| STREAM) + (PRINC (LIST (STATUS UNAME) 'MC) STREAM) + (TERPRI STREAM) + (PRINC '|SUBJECT:Session of | STREAM) + (LET ((BASE 10.) (*NOPOINT T) (DATE (STATUS DATE)) (TIME)) + (PRINC (CADR DATE) STREAM) + (PRINC '// STREAM) + (PRINC (CADDR DATE) STREAM) + (PRINC '// STREAM) + (PRINC (CAR DATE) STREAM) + (TERPRI STREAM) + (PRINC '|TEXT;-1| STREAM) + (TERPRI STREAM) + (PRINC '|Session lasted | STREAM) + (PRINC (FIX (SETQ TIME (//$ (-$ (TIME) INIT-TIME) 60.0))) + STREAM) + (PRINC '| minutes, so your bill is $| STREAM) + (DO ((L (EXPLODEN (*$ TIME 0.25)) (CDR L))) + ((= (CAR L) 46.) + (TYO 46. STREAM) + (TYO (OR (CADR L) 48.) STREAM) + (TYO (OR (CADDR L) 48.) STREAM)) + (TYO (CAR L) STREAM)) + (TERPRI STREAM) + (TYO 9. STREAM) + (PRINC '| - The Doctor's Secretary| STREAM) + (TERPRI STREAM) + (TERPRI STREAM) + (COND (OBSERVATION-LIST + (TERPRI STREAM) + (PRINC '|PS. The doctor also had some comments he +asked me to convey to you:/ +/ +| STREAM) + (DO ((O OBSERVATION-LIST (CDR O))) + ((NULL O)) + (PRINC (CAR O) STREAM) + (TERPRI STREAM)))))) + (QUIT)) + +(SETQ INIT-TIME (TIME)) + +(DEFUN WORKING-HOURS? () + (AND (MEMQ (STATUS DOW) '(MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY)) + (> (CAR (STATUS DAYTIME)) 8.) + (< (CAR (STATUS DAYTIME)) 20.))) + +(COND ((AND (WORKING-HOURS?) (NOT (WINNER))) + (TERPRI TYO) + (PRINC '|This is not the time of day to be playing games!|) + (TERPRI TYO) + (PRINC '|Please come back later. This game is unavailable|) + (TERPRI TYO) + (PRINC '|during the hours of 9am-8pm Monday-Friday.|) + (QUIT))) + + +(SETQ LISPT-JNAME '|DOX|) + +(SETQ BASE 10. IBASE 10. *NOPOINT T) + +(DEFUN MAP-PROP (X Y Z) + (MAPCAR (FUNCTION (LAMBDA (X) (PUTPROP X Y Z))) + X)) + +(DEFUN UNIX-EVAL (X) (COND ((ATOM X) + (COND ((BOUNDP X) (EVAL X)) + (T NIL))) + (T (EVAL X)))) + +(DEFUN WHILE FEXPR (X) + (COND ((UNIX-EVAL (CAR X)) NIL) + (T (MAPCAR 'UNIX-EVAL (CDR X)) + (APPLY 'WHILE X)))) + +(DEFUN CVTA (X) (ASCII X)) +(DEFUN CVTN (X) (CAR (EXPLODEN X))) +(DEFUN READCH () (ASCII (TYI))) +(DEFUN PEEKCH () (ASCII (TYIPEEK))) + +(DEFUN MEANING (X) (GET X 'MEANING)) +(DEFUN PUT-MEANING FEXPR (X) + (PUTPROP (CAR X) (UNIX-EVAL (CADR X)) 'MEANING)) + +(PUT-MEANING HOWDY 'HOWDY) +(PUT-MEANING HI 'HOWDY) +(PUT-MEANING GREETINGS 'HOWDY) +(PUT-MEANING HELLO 'HOWDY) +(PUT-MEANING PDP11 'MACH) +(PUT-MEANING COMPUTER 'MACH) +(PUT-MEANING UNIX 'MACH) +(PUT-MEANING MACHINE 'MACH) +(PUT-MEANING COMPUTERS 'MACH) +(PUT-MEANING MACHINES 'MACH) +(PUT-MEANING PDP11S 'MACH) +(PUT-MEANING FOO 'MACH) +(PUT-MEANING FOOBAR 'MACH) +(PUT-MEANING MULTICS 'MACH) +(PUT-MEANING MACSYMA 'MACH) +(PUT-MEANING TELETYPE 'MACH) +(PUT-MEANING LA36 'MACH) +(PUT-MEANING VT52 'MACH) +(PUT-MEANING ZORK 'MACH) +(PUT-MEANING TREK 'MACH) +(PUT-MEANING STARTREK 'MACH) +(PUT-MEANING ADVENT 'MACH) +(PUT-MEANING PDP 'MACH) +(PUT-MEANING DEC 'MACH) +(PUT-MEANING SHIT 'FOUL) +(PUT-MEANING BASTARD 'FOUL) +(PUT-MEANING DAMN 'FOUL) +(PUT-MEANING DAMNED 'FOUL) +(PUT-MEANING HELL 'FOUL) +(PUT-MEANING SUCK 'FOUL) +(PUT-MEANING SUCKING 'FOUL) +(PUT-MEANING SUX 'FOUL) +(PUT-MEANING ASS 'FOUL) +(PUT-MEANING WHORE 'FOUL) +(PUT-MEANING BITCH 'FOUL) +(PUT-MEANING ASSHOLE 'FOUL) +(PUT-MEANING SHRINK 'FOUL) +(PUT-MEANING POT 'TOKE) +(PUT-MEANING GRASS 'TOKE) +(PUT-MEANING WEED 'TOKE) +(PUT-MEANING MARIJUANA 'TOKE) +(PUT-MEANING ACAPULCO 'TOKE) +(PUT-MEANING COLUMBIAN 'TOKE) +(PUT-MEANING TOKIN 'TOKE) +(PUT-MEANING JOINT 'TOKE) +(PUT-MEANING TOKE 'TOKE) +(PUT-MEANING TOKING 'TOKE) +(PUT-MEANING TOKIN/' 'TOKE) +(PUT-MEANING PILLS 'DRUG) +(PUT-MEANING DOPE 'DRUG) +(PUT-MEANING ACID 'DRUG) +(PUT-MEANING LSD 'DRUG) +(PUT-MEANING SPEED 'DRUG) +(PUT-MEANING HEROINE 'DRUG) +(PUT-MEANING HASH 'DRUG) +(PUT-MEANING COCAINE 'DRUG) +(PUT-MEANING UPPERS 'DRUG) +(PUT-MEANING DOWNERS 'DRUG) +(PUT-MEANING LOVES 'LOVES) +(PUT-MEANING LOVE 'LOVE) +(PUT-MEANING HATES 'HATES) +(PUT-MEANING DISLIKES 'HATES) +(PUT-MEANING HATE 'HATE) +(PUT-MEANING DISLIKE 'HATE) +(PUT-MEANING STONED 'STATE) +(PUT-MEANING DRUNK 'STATE) +(PUT-MEANING DRUNKEN 'STATE) +(PUT-MEANING HIGH 'STATE) +(PUT-MEANING HORNY 'STATE) +(PUT-MEANING BLASTED 'STATE) +(PUT-MEANING HAPPY 'STATE) +(PUT-MEANING PARANOID 'STATE) +(PUT-MEANING WISH 'DESIRE) +(PUT-MEANING WANT 'DESIRE) +(PUT-MEANING DESIRE 'DESIRE) +(PUT-MEANING LIKE 'DESIRE) +(PUT-MEANING HOPE 'DESIRE) +(PUT-MEANING HOPES 'DESIRE) +(PUT-MEANING DESIRES 'DESIRE) +(PUT-MEANING WANTS 'DESIRE) +(PUT-MEANING DESIRES 'DESIRE) +(PUT-MEANING LIKES 'DESIRE) +(PUT-MEANING FRUSTRATED 'MOOD) +(PUT-MEANING DEPRESSED 'MOOD) +(PUT-MEANING ANNOYED 'MOOD) +(PUT-MEANING UPSET 'MOOD) +(PUT-MEANING UNHAPPY 'MOOD) +(PUT-MEANING EXCITED 'MOOD) +(PUT-MEANING WORRIED 'MOOD) +(PUT-MEANING LONELY 'MOOD) +(PUT-MEANING ANGRY 'MOOD) +(PUT-MEANING PISSED 'MOOD) +(PUT-MEANING JEALOUS 'MOOD) +(PUT-MEANING AFRAID 'FEAR) +(PUT-MEANING FEAR 'FEAR) +(PUT-MEANING SCARED 'FEAR) +(PUT-MEANING VIRGINITY 'SEXNOUN) +(PUT-MEANING COCK 'SEXNOUN) +(PUT-MEANING CUNT 'SEXNOUN) +(PUT-MEANING PROSTITUTE 'SEXNOUN) +(PUT-MEANING CONDOM 'SEXNOUN) +(PUT-MEANING SEX 'SEXNOUN) +(PUT-MEANING RAPES 'SEXNOUN) +(PUT-MEANING WIFE 'FAMILY) +(PUT-MEANING BROTHER 'FAMILY) +(PUT-MEANING SISTER 'FAMILY) +(PUT-MEANING FATHER 'FAMILY) +(PUT-MEANING MOTHER 'FAMILY) +(PUT-MEANING HUSBAND 'FAMILY) +(PUT-MEANING SIBLINGS 'FAMILY) +(PUT-MEANING GRANDMOTHER 'FAMILY) +(PUT-MEANING GRANDFATHER 'FAMILY) +(PUT-MEANING MATERNAL 'FAMILY) +(PUT-MEANING PATERNAL 'FAMILY) +(PUT-MEANING STAB 'DEATH) +(PUT-MEANING MURDER 'DEATH) +(PUT-MEANING MURDERS 'DEATH) +(PUT-MEANING SUICIDE 'DEATH) +(PUT-MEANING SUICIDES 'DEATH) +(PUT-MEANING KILL 'DEATH) +(PUT-MEANING KILLS 'DEATH) +(PUT-MEANING DIE 'DEATH) +(PUT-MEANING DIES 'DEATH) +(PUT-MEANING DEATH 'DEATH) +(PUT-MEANING DEATHS 'DEATH) +(PUT-MEANING PAIN 'SYMPTOMS) +(PUT-MEANING ACHE 'SYMPTOMS) +(PUT-MEANING FEVER 'SYMPTOMS) +(PUT-MEANING SORE 'SYMTOMS) +(PUT-MEANING ACHING 'SYMPTOMS) +(PUT-MEANING STOMACHACHE 'SYMPTOMS) +(PUT-MEANING HEADACHE 'SYMPTOMS) +(PUT-MEANING HURTS 'SYMPTOMS) +(PUT-MEANING DISEASE 'SYMPTOMS) +(PUT-MEANING VIRUS 'SYMPTOMS) +(PUT-MEANING VOMIT 'SYMPTOMS) +(PUT-MEANING VOMITING 'SYMPTOMS) +(PUT-MEANING BARF 'SYMPTOMS) +(PUT-MEANING TOOTHACHE 'SYMPTOMS) +(PUT-MEANING HURT 'SYMPTOMS) +(PUT-MEANING RUM 'ALCOHOL) +(PUT-MEANING GIN 'ALCOHOL) +(PUT-MEANING VODKA 'ALCOHOL) +(PUT-MEANING ALCOHOL 'ALCOHOL) +(PUT-MEANING BOURBON 'ALCOHOL) +(PUT-MEANING BEER 'ALCOHOL) +(PUT-MEANING WINE 'ALCOHOL) +(PUT-MEANING WHISKEY 'ALCOHOL) +(PUT-MEANING SCOTCH 'ALCOHOL) +(PUT-MEANING FUCK 'SEXVERB) +(PUT-MEANING SCREW 'SEXVERB) +(PUT-MEANING SCREWING 'SEXVERB) +(PUT-MEANING FUCKING 'SEXVERB) +(PUT-MEANING RAPE 'SEXVERB) +(PUT-MEANING KISS 'SEXVERB) +(PUT-MEANING KISSING 'SEXVERB) +(PUT-MEANING KISSES 'SEXVERB) +(PUT-MEANING SCREWS 'SEXVERB) +(PUT-MEANING FUCKS 'SEXVERB) +(PUT-MEANING BECAUSE 'CONJ) +(PUT-MEANING BUT 'CONJ) +(PUT-MEANING HOWEVER 'CONJ) +(PUT-MEANING BESIDES 'CONJ) +(PUT-MEANING ANYWAY 'CONJ) +(PUT-MEANING THAT 'CONJ) +(PUT-MEANING EXCEPT 'CONJ) +(PUT-MEANING WHY 'CONJ) +(PUT-MEANING HOW 'CONJ) +(PUT-MEANING UNTIL 'WHEN) +(PUT-MEANING WHEN 'WHEN) +(PUT-MEANING WHILE 'WHEN) +(PUT-MEANING SINCE 'WHEN) + +(DEFUN KAR(X) (COND ((ATOM X) X) + (T (CAR X)))) +(DEFUN KDR (X) (COND ((ATOM X) NIL) + (T (CDR X)))) +(DEFUN CADR (X) (KAR (KDR X))) +(DEFUN CDDR (X) (KDR (KDR X))) + +(DECLARE (SPECIAL TYPOS)) + +(SETQ TYPOS ()) + +(DEFUN TYPOS: FEXPR (X) (SETQ TYPOS (MAPCAR 'TYPOS-AUX X))) + +(DEFUN TYPOS-AUX (X) + (PUTPROP (CAR X) (CADR X) 'CORRECTION) + (PUTPROP (CADR X) (CADDR X) 'EXPANSION) + (CAR X)) + +(DEFUN TYPOP (X) (MEMQ X TYPOS)) + +(DEFUN CORRECTION (X) (GET X 'CORRECTION)) + +(DEFUN EXPANSION (X) (GET X 'EXPANSION)) + +(TYPOS: (THEYLL THEY/'LL (THEY WILL)) + (THEYRE THEY/'RE (THEY ARE)) + (IM I/'M (YOU ARE)) + (I7M I/'M (YOU ARE)) + (ISA |IS A| (IS A)) + (THIER THEIR (THEIR)) + (DONT DON/'T (DO NOT)) + (DON7T DON/'T (DO NOT)) + (YOU7RE YOU/'RE (I AM)) + (YOU7VE YOU/'VE (I HAVE)) + (YOU7LL YOU/'LL (I WILL))) + +(DEFUN WARN-TYPOS (X) + (CURSORPOS 'A TYO) + (PRINC '|WATCH YOUR SPELLING! YOU MIS-SPELLED | TYO) + (/"PRINC (CAR X)) + (MAP (FUNCTION + (LAMBDA (X) + (COND ((NULL (CDR X)) (PRINC '|, AND |)) + (T (PRINC '|, |))) + (COND ((> (CHARPOS TYO) 60.) (TERPRI TYO))) + (/"PRINC (CAR X)))) + (CDR X)) + (PRINC '/. TYO)) + +(DEFUN /"PRINC (X) (TYO 34. TYO) (PRINC X TYO) (TYO 34. TYO)) + +(DEFUN CORRECT-SPELLING (X) + (DO ((X X (CDR X)) + (L ()) + (TEMP) + (TYPO-LIST) + (CORREX-FLAG ())) + ((NULL X) + (COND (CORREX-FLAG (WARN-TYPOS TYPO-LIST))) + (MAPCAN (FUNCTION (LAMBDA (X) (COND ((ATOM X) (NCONS X)) (T X)))) + (NREVERSE L))) + (COND ((SETQ TEMP (TYPOP (CAR X))) + (SETQ CORREX-FLAG T) + (LET ((C (CORRECTION (CAR X)))) + (PUSH (EXPANSION C) L) + (PUSH C TYPO-LIST))) + (T + (PUSH (CAR X) L))))) + +(DEFUN SHORTEN (SENT) + (PROG (FOO TEMP) + (SETQ TEMP '(NIL BECAUSE BUT HOWEVER BESIDES ANYWAY UNTIL + WHILE THAT EXCEPT WHY HOW)) + RECHK + (SETQ TEMP (KDR TEMP)) + (COND ((NULL TEMP) + (RETURN NIL))) + (SETQ FOO (MEMQ (KAR TEMP) SENT)) + (COND ((NOT FOO)(GO RECHK)) + ((LESSP (LENGTH FOO) 4) + (GO RECHK))) + (SETQ SENT FOO) + (FIXUP) + (RETURN T) )) + +(DEFUN DEFINE (SENT FOUND) + (PROG () + (SVO SENT FOUND 1 NIL) + (COND + ((NOT (NOUNP SUBJ)) + (RETURN NIL)) + ((PRONOUNP SUBJ) + (RETURN NIL)) + ((NULL SUBJ) + (RETURN NIL)) + ((NULL (MEANING OBJECT)) + (RETURN NIL))) + (PUTPROP SUBJ (MEANING OBJECT) 'MEANING) + (RETURN T))) + +(DEFUN DEFQ (SENT) + (PROG (TEMP) + (SETQ TEMP '(MEANS APPLIES MEAN REFERS REFER RELATED + SIMILAR DEFINED ASSOCIATED LINKED LIKE SAME)) + FOO (COND ((MEMQ (KAR TEMP) SENT) + (PROGN + (SETQ FOUND (KAR TEMP)) + (RETURN T))) + ((NULL (KDR TEMP)) + (RETURN NIL))) + (SETQ TEMP (KDR TEMP)) (GO FOO))) + +(DEFUN DEF (X) + (PROGN + (TYPE (LIST 'THE 'WORD X 'MEANS (MEANING X) 'TO 'ME)) + NIL)) + +(DEFUN FORGET () (PROG (TEMP) + (SETQ TEMP HISTORY) + (SETQ HISTORY NIL) +LOOP (COND ((NULL (KDR TEMP))(RETURN NIL))) + (SETQ HISTORY (CONS (KAR TEMP) HISTORY)) + (SETQ TEMP (KDR TEMP)) + (GO LOOP))) + +(DEFUN QUERY (X) + (PROG (A) + TOP (TXTYPE (ASSM (LIST X 'WHAT?))) + (SETQ A (TXREAD)) + LOOP (COND ((NULL A) + (GO TOP))) + (COND ((NOUNP (KAR A)) (RETURN (KAR A)))) + (COND ((VERBP (KAR A)) (RETURN (BUILD (BUILD X '/ ) (KAR A))))) + (SETQ A (KDR A)) + (GO LOOP))) + +(DEFUN SUBJSEARCH (SENT KEY TYPE) + (PROG (FOO) + (SETQ FOO (- (INDEX SENT KEY) TYPE)) + (WHILE (NOT (GREATERP FOO 0)) + (SETQ SUBJ (PART SENT FOO)) + (COND ((NOUNP SUBJ) (RETURN T))) + (SETQ FOO (SUB1 FOO))) + (SETQ SUBJ 'YOU) (RETURN NIL) )) + +(DEFUN NOUNP (X) + (OR (PRONOUNP X) + (NOT (OR (VERBP X) (EQUAL X 'NOT) (PREPP X) (MODIFIERP X) )) )) + +(DEFUN PRONOUNP (X) (MEMQ X '(I ME YOU HE HIM SHE HER IT WE US THEY THEM + THAT THOSE THIS THESE MYSELF YOURSELF HIMSELF HERSELF THINGS THING + ANYTHING SOMETHING EVERYTHING) )) + +(MAP-PROP '(AM IS ARE WAS WERE HAS HAVE HAD DO DID + FIND TAKE GET HIT MOVE HIT HURT KILL EAT DRINK LAY OUGHT + DOES SHALL SHOULD WILL WOULD CAN COULD MAY MIGHT MUST BE + BEEN BEING GOING GOES WENT GO GONE REFER MEAN MEANS REFERS + ASSOCIATED APPLIES RELATED LINKED USE USING USED DEFINED USES + FEEL FEELS FELT THINK THINKS THOUGHT HATES DISLIKES + HATE DISLIKE LOVE LOVES LIKES WISH WANT DESIRE LIKE + RAPE KISS KISSING KISSES SCREWS FUCKS + HOPE DESIRES WANTS DESIRES FUCK SCREW SCREWING FUCKING) + 'VERB + 'SENTENCE-TYPE) + +(DEFUN VERBP (X) (EQ (GET X 'SENTENCE-TYPE) 'VERB)) + +(DEFUN PLURAL (X) + (PROG (FOO) + (SETQ FOO (EXPLODE X)) + (RETURN + (COND ((NOT (EQUAL (PART FOO (LENGTH FOO)) 'S)) + (BUILD X 'S)) + (T X))))) + +(SETQ INTER + '((WELL/,) + (|HMMM... SO,|) + (SO) + (|...AND|) + (THEN))) + +(SETQ CONTINUE + '((CONTINUE) + (PROCEED) + (GO ON) + (KEEP GOING) )) + +(SETQ RELATION + '((YOUR RELATIONSHIP WITH) + (SOMETHING YOU REMEMBER ABOUT) + (YOUR FEELINGS TOWARD) + (SOME EXPERIENCES YOU HAVE HAD WITH) + (HOW YOU FEEL ABOUT))) + +(DEFUN SETPREP (SENT KEY) + (PROG (FOO) + (SETQ FOO (MEMQ KEY SENT)) + (COND ((PREPP (CADR FOO))(GETNOUN (CDDR FOO))) + (T 'SOMETHING)) )) + +(DEFUN GETNOUN (X) + (COND ((NULL X)(SETQ OBJECT 'SOMETHING)) + ((ATOM X)(SETQ OBJECT X)) + ((EQ (LENGTH X) 1) + (SETQ OBJECT (COND + ((NOUNP (SETQ OBJECT (KAR X))) OBJECT) + (T (QUERY OBJECT))))) + ((EQ (KAR X) 'TO) + (BUILD 'TO/ (GETNOUN (KDR X)))) + ((PREPP (KAR X)) + (GETNOUN (KDR X))) + ((NOT (NOUNP (KAR X))) + (BUILD (BUILD (KAR (REPLACE (LIST (KAR X)) + '(A (THIS) + SOME (THIS) + ONE (THAT)))) + SPACE) + (GETNOUN (KDR X)))) + (T (SETQ OBJECT (KAR X))) )) + +(DEFUN MODIFIERP (X) + (MEMQ X '(THE A AN EVERY SOME ONE VERY OFTEN MY MUCH + LINKED YOUR HIS HER THEIR OUR ANY MANY RELATED + ALL SIMILAR SIMILAR ALWAYS ASSOCIATED GOOD BAD + UGLY PRETY BIG SMALL TOO REALLY MORE LESS ALSO))) + +(DEFUN PREPP (X) + (MEMQ X '(OF IN ON WITH FROM FOR TO AT SAME AS LIKE ABOUT + BY BESIDE AROUND UNDER ABOVE THROUGH BENEATH + BEHIND OVER ))) + +(DEFUN REMEMBER (THING) + (COND ((NULL HISTORY) + (SETQ HISTORY (LIST THING))) + (T (SETQ HISTORY (APPEND HISTORY (LIST THING)))))) + +(SETQ FEARS '( (($ WHYSAY) YOU ARE ($ AFRAIDOF) (// FOUND)(// QMARK)) + (YOU SEEM TERRIFIED BY (// FOUND)(// PERIOD)) + (WHEN DID YOU FIRST FEEL ($ AFRAIDOF)(// FOUND)(// QMARK)) )) + +(SETQ SURE '((SURE)(POSITIVE)(CERTAIN))) + +(SETQ AFRAIDOF '( (AFRAID OF) (FRIGHTENED BY) (SCARED OF) )) + +(SETQ AREYOU '( (ARE YOU)(HAVE YOU BEEN)(HAVE YOU BEEN) )) + +(SETQ ISRELATED '( (HAS SOMETHING TO DO WITH)(IS RELATED TO) + (COULD BE THE REASON FOR) )) + +(SETQ ARERELATED '((HAVE SOMETHING TO DO WITH)(ARE RELATED TO) + (COULD HAVE CAUSED)(COULD BE THE REASON FOR) )) + +(SETQ MOODS '( (($ AREYOU)(// FOUND) OFTEN?) + (WHAT CAUSES YOU TO BE (// FOUND)(// QMARK)) + (($ WHYSAY) YOU ARE (// FOUND)(// QMARK)) )) + +(SETQ MAYBE + '((MAYBE) + (PERHAPS) + (POSSIBLY))) + +(DEFUN TYPE (X)(TXTYPE (ASSM X))) + +(DEFUN FIXUP () + (SETQ SENT (RPLACD + (REPLACE (LIST (KAR SENT)) + '(ME (I) + HIM (HE) + HER (SHE) + THEM (THEY) + OKAY (/) + WELL (/) + SIGH (/) + HMM (/) + HMMM (/) + HMMMM (/) + HMMMMM (/) + GEE (/) + SURE (/) + GREAT (/) + OH (/) + FINE (/) + OK (/) + NO (/))) + (KDR SENT)))) + +(SETQ WHATWHEN + '((WHAT HAPPENED WHEN) + (WHAT WOULD HAPPEN IF))) + +(SETQ HELLO + '((HOW DO YOU DO?) (HELLO/.) (HOWDY!) (HELLO/.) (HI/.))) + +(SETQ DRNK + '((DO YOU DRINK A LOT OF (// FOUND)(// QMARK)) + (DO YOU GET DRUNK OFTEN?) + (($ DESCRIBE) YOUR DRINKING HABITS/.) )) + +(SETQ DRUGS '( (DO YOU USE (// FOUND) OFTEN?)(($ AREYOU) + ADDICTED TO (// FOUND)(// QMARK))(DO YOU REALIZE THAT DRUGS CAN + BE VERY HARMFUL?)(($ MAYBE) YOU SHOULD TRY TO QUIT USING (// FOUND) + (// PERIOD)) )) + +(SETQ WHYWANT '( (($ WHYSAY) (// SUBJ) MIGHT ($ WANT) (// OBJ)(// QMARK)) + (WHEN DID (// SUBJ) FIRST ($ WANT) (// OBJ)(// QMARK)) + (HAVE YOU EVER GOTTEN (// OBJ)(// QMARK)) )) + +(SETQ WANT '( (WANT) (DESIRE) (WISH) (WANT) (HOPE) )) + +(SETQ SHORTLST + '((CAN YOU ELABORATE ON THAT?) + (($ PLEASE) CONTINUE/.) + (GO ON/, DON/'T BE AFRAID/.) + (YOU/'RE BEING A BIT BRIEF/, ($ PLEASE) GO INTO DETAIL/.) + (CAN YOU BE MORE EXPLICIT?) + (($ PLEASE) YOU GO INTO MORE DETAIL?) + (YOU AREN/'T BEING VERY TALKATIVE TODAY!) + (WHY MUST YOU RESPOND SO BRIEFLY?))) + + +(SETQ FAMLST + '((TELL ME ($ SOMETHING) ABOUT (// OWNER) FAMILY (// PERIOD)) + (YOU SEEM TO DWELL ON (// OWNER) FAMILY (// PERIOD)) + (($ AREYOU) HUNG UP ON (// OWNER) FAMILY?))) + +(SETQ HUHLST + '((($ WHYSAY)(// SENT)(// QMARK)) + (IS IT BECAUSE OF ($ THINGS) THAT YOU SAY (// SENT)(// QMARK)) )) + +(SETQ FEELINGS-ABOUT + '((FEELINGS ABOUT) + (APREHENSIONS TOWARD) + (THOUGHTS ON) + (EMOTIONS TOWARD))) + +(SETQ RANDOM-ADJECTIVE + '((VIVID) + (EMOTIONALLY STIMULATING) + (RECENT) + (UNUSUAL) + (SHOCKING) + (EMBARRASSING))) + +(SETQ WHYSAY + '((WHY DO YOU SAY) + (WHAT MAKES YOU BELIEVE) + (ARE YOU SURE THAT) + (WHAT MAKES YOU THINK) )) + +(SETQ ISEE + '((I SEE /././.) + (YES/,) + (I UNDERSTAND/.) + (OH/.) )) + +(SETQ PLEASE + '((PLEASE/,) + (I WOULD APPRECIATE IT IF YOU WOULD) + (PERHAPS YOU COULD) + (PLEASE/,) + (WOULD YOU PLEASE) + (COULD YOU))) + +(SETQ SOMETHING + '((SOMETHING) + (MORE) + (HOW YOU FEEL))) + +(SETQ THINGS + '((HANGUPS YOU HAVE) + (YOUR INHIBITIONS) + (SOME PROBLEMS IN YOUR CHILDHOOD) + (THE PEOPLE YOU HANG AROUND WITH) + (PROBLEMS AT SCHOOL) + (YOUR SEX LIFE) + (YOUR HANGUPS) + (SOME PROBLEMS AT HOME))) + +(SETQ DESCRIBE + '((DESCRIBE) + (TELL ME ABOUT) + (DISCUSS) + (ELABORATE ON))) + +(SETQ IBELIEVE + '((I BELIEVE) (I THINK) (I HAVE A FEELING) (IT SEEMS TO ME THAT))) + +(SETQ PROBLEMS '( (PROBLEMS) + (INHIBITIONS) + (HANGUPS) + (ANXIETIES) + (FRUSTRATIONS) )) + +(SETQ BOTHER + '((DOES IT BOTHER YOU THAT) + (ARE YOU ANNOYED THAT) + (DID YOU EVER REGRET) + (ARE YOU SATISFIED WITH THE FACT THAT))) + +(SETQ MACHLST + '((YOU HAVE YOUR MIND ON (// FOUND)(// COMMA) IT SEEMS/.) + (YOU SHOULD TRY TAKING YOUR MIND OFF OF (// FOUND)(// PERIOD)) + (ARE YOU A COMPUTER HACKER?))) + +(SETQ QLIST + '((I/'LL ASK THE QUESTIONS/, IF YOU DON/'T MIND!) + (($ PLEASE) ALLOW ME TO DO THE QUESTIONING/.) + (($ PLEASE) TRY TO ANSWER THAT QUESTION YOURSELF/.))) + +(SETQ ELIST + '((($ PLEASE) TRY TO CALM YOURSELF/.) + (YOU SEEM VERY EXCITED/. RELAX/. ($ PLEASE) ($ DESCRIBE) ($ THINGS)) + (YOU/'RE BEING VERY EMOTIONAL/. CALM DOWN/.))) + +(SETQ FOULLST + '((($ PLEASE) WATCH YOUR TONGUE!) + (($ PLEASE) AVOID SUCH UNWHOLESOME THOUGHTS) + (SUCH LEWDNESS IS NOT APPRECIATED/.))) + +(SETQ DEATHLST + '((THIS IS NOT A HEALTHY WAY OF THINKING/.) + (($ BOTHER) YOU/, TOO/, MAY DIE SOMEDAY?) + (I AM WORRIED BY YOUR OBSSESSION WITH THIS TOPIC!) + (DID YOU WATCH A LOT OF CRIME AND VIOLENCE ON TELEVISION AS A CHILD?)) +) + +(SETQ SEXLST + '((($ AREYOU) ($ AFRAIDOF) SEX?) + (($ DESCRIBE)($ SOMETHING) ABOUT YOUR SEXUAL HISTORY/.) + (($ PLEASE)($ DESCRIBE) YOUR SEX LIFE/././.) + (($ DESCRIBE) YOUR ($ FEELINGS-ABOUT) YOUR SEXUAL PARTNER/.) + (($ DESCRIBE) YOUR MOST ($ RANDOM-ADJECTIVE) SEXUAL EXPERIENCE/.) + (($ AREYOU) SATISFIED WITH (// LOVER) /././.?))) + +(SETQ NEGLST + '((WHY NOT?) + (($ BOTHER) I ASK THAT?) + (WHY NOT?) + (WHY NOT?) + (HOW COME?) + (($ BOTHER) I ASK THAT?))) + +(SETQ BECLST '( + (IS IT BECAUSE (// SENT) THAT YOU CAME TO ME?) + (($ BOTHER)(// SENT)(// QMARK)) + (WHEN DID YOU FIRST KNOW THAT (// SENT)(// QMARK)) + (IS THE FACT THAT (// SENT) THE REAL REASON?) + (DOES THE FACT THAT (// SENT) EXPLAIN ANYTHING ELSE?) + (($ AREYOU)($ SURE)(// SENT)(// QMARK) ) )) + +(SETQ SHORTBECLST '( + (($ BOTHER) I ASK YOU THAT?) + (THAT/'S NOT MUCH OF AN ANSWER!) + (($ INTER) WHY WON/'T YOU TALK ABOUT IT?) + (SPEAK UP!) + (($ AREYOU) ($ AFRAIDOF) TALKING ABOUT IT?) + (DON/'T BE ($ AFRAIDOF) ELABORATING/.) + (($ PLEASE) GO INTO MORE DETAIL/.))) + +(SETQ THLST '( + (($ MAYBE)($ THINGS)($ ARERELATED) THIS/.) + (IS IT BECAUSE OF ($ THINGS) THAT YOU ARE GOING THRU ALL THIS?) + (HOW DO YOU RECONCILE ($ THINGS)(// QMARK) ) + (($ MAYBE) THIS ($ ISRELATED)($ THINGS)(// QMARK)) )) + +(SETQ REMLST '( (EARLIER YOU SAID ($ HISTORY)(// QMARK)) + (YOU MENTIONED THAT ($ HISTORY)(// QMARK)) + (($ WHYSAY)($ HISTORY)(// QMARK) ) )) + +(SETQ TOKLST + '((IS THIS HOW YOU RELAX?) + (HOW LONG HAVE YOU BEEN SMOKING GRASS?) + (($ AREYOU) ($ AFRAIDOF) OF BEING DRAWN TO USING HARDER STUFF?))) + +(SETQ STATES + '((DO YOU GET (// FOUND) OFTEN?) + (DO YOU ENJOY BEING (// FOUND)(// QMARK)) + (HOW OFTEN ($ AREYOU)(// FOUND)) + (WHEN WERE YOU LAST (// FOUND)(// QMARK)))) + +(SETQ REPLIST + '(I (YOU) + MY (YOUR) + ME (YOU) + YOU (ME) + YOUR (MY) + MINE (YOURS) + YOURS (MINE) + OUR (YOUR) + OURS (YOURS) + WE (YOU) + DUNNO (DO NOT KNOW) + YES (/) + NO/, (/) + YES/, (/) + YA (I) + WANNA (WANT TO) + GOTTA (HAVE TO) + GONNA (GOING TO) + NEVER (DOES NOT EVER) + DOESN/'T (DOES NOT) + DON/'T (DO NOT) + AREN/'T (ARE NOT) + ISN/'T (IS NOT) + WON/'T (WILL NOT) + CAN/'T (CANNOT) + HAVEN/'T (HAVE NOT) + I/'M (YOU ARE) + OURSELVES (YOURSELVES) + MYSELF (YOURSELF) + YOURSELF (MYSELF) + YOU/'RE (I AM) + YOU/'VE (I HAVE) + I/'VE (YOU HAVE) + I/'LL (YOU WILL) + YOU/'LL (I SHALL) + I/'D (YOU WOULD) + YOU/'D (I WOULD) + HERE (THERE) + PLEASE (/) + OH/, (/) + OH (/) + SHOULDN/'T (SHOULD NOT) + WOULDN/'T (WOULD NOT) + WON/'T (WILL NOT) + HASN/'T (HAS NOT))) + +(DEFUN REPLACE (SENT RLIST) + (PROG (TEMP FOO) + AGAIN + (COND ((NULL SENT)(RETURN TEMP))) + (SETQ FOO (MEMQ (KAR SENT) RLIST)) + (SETQ FOO (COND (FOO (CADR FOO)) + (T (LIST (KAR SENT))))) + (SETQ TEMP (CONCAT TEMP FOO)) + (SETQ SENT (KDR SENT)) + (GO AGAIN))) + +(SETQ EOF -1.) + +(DEFUN FILEINPUTCHECK () + (AND + (ERRSET (IOTA ((STREAM (LIST '(DSK KMP) (STATUS UNAME) 'DOX))) + (DO ((C (TYI STREAM EOF) (TYI STREAM EOF)) + (L ())) + ((= C EOF) + (SETQ FILEINPUT (IMPLODE (NREVERSE L))) + (DELETEF STREAM)) + (COND ((NOT (OR (= C 3.) (= C 0.) (= C 12.))) + (PUSH C L))))) + NIL) + 'FILETYPEOUT)) + +(DEFUN WHEREGO (SENT) + (COND ((NULL SENT)(OR (FILEINPUTCHECK) ($ WHEREOUTP))) + ((NULL (MEANING (KAR SENT))) + (WHEREGO (KDR SENT))) + (T (PROGN (SETQ FOUND (KAR SENT)) + (MEANING (KAR SENT)))))) + +(DEFUN PART (LST NUM) + (COND ((ATOM LST) LST) + ((GREATERP NUM (LENGTH LST)) NIL) + ((LESSP NUM 2)(KAR LST)) + (T (PART (KDR LST)(SUB1 NUM))))) + +(DEFUN INDEX (LST ELEM) + (COND ((NOT (MEMQ ELEM LST)) 0) + (T (+ (- (LENGTH LST) + (LENGTH (MEMQ ELEM LST))) + 1)))) + +(DEFUN SVO (SENT KEY TYPE MEM) + (PROG (FOO) + (SETQ FOO (MEMQ (PART SENT (- (INDEX SENT KEY) TYPE)) SENT)) + (SETQ MEM (AND (SUBJSEARCH SENT KEY TYPE) MEM)) + V (SETQ FOO (KDR FOO)) + (COND ((VERBP (KAR FOO))(SETQ VERB (KAR FOO))) + ((NULL (KDR FOO))(SETQ VERB (KAR FOO))) + (T (GO V)) ) + (SETQ OBJ (GETNOUN (KDR FOO))) + (COND ((EQUAL OBJECT 'I)(SETQ OBJECT 'ME)) + ((EQUAL SUBJ 'ME)(SETQ SUBJ 'I))) + (COND (MEM (REMEMBER (LIST SUBJ VERB OBJ)))) )) + +(DEFUN POSSESS (SENT KEY) + (PROG (COUNT) + (SETQ COUNT (INDEX SENT KEY)) + (COND ((EQUAL COUNT 1)(SETQ OWNER 'YOUR)) + (T (PROG (TEMP)(SETQ OWNER (PART SENT (SUB1 COUNT))) + (SETQ TEMP (EXPLODE OWNER)) + (COND ((AND (NOT + (EQUAL 'S (PART TEMP + (LENGTH TEMP)))) + (NOT (EQUAL OWNER 'MY)) + (NOT (EQUAL OWNER 'HER)) + (NOT (EQUAL OWNER 'THEIR))) + (SETQ OWNER 'YOUR)))))))) + +(SETQ LINEL (LINEL TYO)) + +(DEFUN TXTYPE(A) + (TERPRI) + (WHILE (NOT A) + (COND ((> (+ (FLATC (KAR A)) (CHARPOS T) -2.) LINEL) + (TERPRI))) + (PRINC (KAR A)) + (PRINC SPACE) + (SETQ A (CDR A))) + (TERPRI)) + +(DEFUN LIST1 (X)(COND ((ATOM X)(COND ((NULL X) NIL)(T (LIST X))))(T X))) + +(DEFUN BUILD (STR1 STR2) + (COND ((NULL STR1) STR2)((NULL STR2) STR1) + ((AND (ATOM STR1) + (ATOM STR2)) + (IMPLODE (CONCAT (EXPLODEC STR1)(EXPLODEC STR2)))) + (T NIL))) + +(DEFUN CONCAT (X Y) + (COND ((NULL X)(COND ((NULL Y) NIL)(T (LIST1 Y)))) + ((NULL Y)(LIST1 X)) + ((ATOM X)(COND ((ATOM Y)(LIST1 X Y))(T (APPEND (LIST1 X) Y)))) + ((ATOM Y)(APPEND X (LIST1 Y))) + (T (APPEND X Y)))) + + +(DEFUN ASSM(PROTO) + (COND ((NULL PROTO) NIL) + ((ATOM (KAR PROTO)) + (CONS (KAR PROTO) (ASSM (KDR PROTO)))) + (T (CONCAT (UNIX-EVAL (KAR PROTO))(ASSM (KDR PROTO)))))) + +(DEFUN // (X) X) + +(SETQ HOWDYFLAG NIL) + +(DEFUN DOC () + (SETQ OBSERVATION-LIST ()) + (COND ((ATOM (ERRSET + (PROG (LINCOUNT REPETITIVE-SHORTNESS **MAD**) + (SETQ REPETITIVE-SHORTNESS (CONS 0. 0.)) + (TTY-OFF) + (SETQ LINCOUNT 0.) + (TYPE '(I AM THE PSYCHIATRIST/. ($ PLEASE) + ($ DESCRIBE) YOUR ($ PROBLEMS)(// PERIOD))) + (SETQ LOVER '(YOUR PARTNER)) + (SETQ SUBJ NIL VERB NIL OBJ NIL OBJECT NIL HISTORY NIL + FOUND NIL SENT NIL OWNER NIL) +TOP (SETQ LINCOUNT (1+ LINCOUNT)) + (SETQ BAK SENT) + (SETQ SENT (TXREAD)) + (COND + ((EQUAL SENT '(FOO)) + (TYPE '(BAR! ($ PLEASE)($ CONTINUE))) + (GO TOP)) + ((OR (MEMBER SENT '((GOOD BYE) (SEE YOU LATER) (I QUIT) (SO LONG) + (GO AWAY) (GET LOST))) + (MEMQ (KAR SENT) + '(BYE HALT BREAK QUIT DONE EXIT GOODBYE + BYE/, STOP PAUSE GOODBYE/, STOP PAUSE))) + (TTY-ON) + (RETURN 'GOOD-BYE)) + ((EQUAL (KAR SENT) 'WHATMEANS) (PROGN (DEF (CADR SENT))(GO TOP))) + ((EQUAL SENT '(PARSE)) (PROGN + (TYPE (LIST 'SUBJ '= SUBJ COMMA SPACE SPACE + 'VERB '= VERB NEWLINE + 'OBJECT 'PHRASE '= OBJ + COMMA + 'NOUN 'FORM '= OBJECT NEWLINE + 'CURRENT 'KEYWORD 'IS FOUND + COMMA SPACE + 'MOST 'RECENT 'POSSESSIVE + 'IS OWNER NEWLINE + 'SENTENCE 'USED 'WAS + '/././. + '(// BAK)))(GO TOP))) + ((EQUAL (KAR SENT) 'FORGET) (PROGN (SET (CADR SENT) NIL) + (TYPE '(($ ISEE)($ PLEASE) + ($ CONTINUE)(// PERIOD) )) + (GO TOP))) + ((DEFQ SENT) (DEFINE SENT FOUND))) + (COND ((GREATERP (LENGTH SENT) 12)(SHORTEN SENT))) + (COND ((EQUAL SENT '(DDT))(VALRET '|:YOU CAN TALK TO DDT:VK |) + (TYPE '(($ PLEASE)($ CONTINUE) DISCUSSING YOUR ($ PROBLEMS)))(GO TOP)) +) + (SETQ SENT (CORRECT-SPELLING (REPLACE SENT REPLIST))) + (COND ((AND (NOT (MEMQ 'ME SENT))(NOT (MEMQ 'I SENT)) + (MEMQ 'AM SENT))(SETQ SENT (REPLACE SENT '(AM (ARE)))))) + (COND ((LESSP (LENGTH SENT) 2) + (COND ((EQ (MEANING (CAR SENT)) 'HOWDY) + (GO HOWDY))) + (GO SHORT))) + (COND ((MEMQ 'AM SENT)(SETQ SENT (REPLACE SENT '(ME (I)))))) + (FIXUP) + (COND ((AND (EQ (CAR SENT) 'DO) (EQ (CADR SENT) 'NOT)) + (COND ((ZEROP (RANDOM 3.)) + (TYPE '(ARE YOU ($ AFRAIDOF) THAT?)) + (GO TOP)) + ((ZEROP (RANDOM 2.)) + (TYPE '(DON/'T TELL ME WHAT TO DO/. I AM THE + PSYSCHIATRIST HERE!)) + (GO RTHING)) + (T + (TYPE '(($ WHYSAY) THAT I SHOULDN/'T (CDDR SENT) + (// QMARK))) + (GO TOP))))) +GOTOIT (GO (WHEREGO SENT)) +DESIRE1 + (GO ($ WHEREOUTP)) +FILETYPEOUT + (CURSORPOS 'A) + (PRINC FILEINPUT) + (CURSORPOS 'A) + (GO TOP) +HUH (TYPE ($ HUHLST)) + (GO TOP) +RTHING (TYPE ($ THLST)) + (GO TOP) +REMEM (COND ((NULL HISTORY)(GO HUH)) ) + (TYPE ($ REMLST)) + (GO TOP) +HOWDY (COND ((NOT HOWDYFLAG) + (TYPE '(($ HELLO) WHAT BRINGS YOU TO SEE ME?)) + (SETQ HOWDYFLAG T)) + (T + (TYPE '(($ IBELIEVE) WE/'VE INTRODUCED OURSELVES ALREADY/.)) + (TYPE '(($ PLEASE) ($ DESCRIBE) ($ THINGS) (// PERIOD))))) + (GO TOP) +WHEN (COND ((LESSP (LENGTH (MEMQ FOUND SENT)) 3)(GO SHORT)) ) + (SETQ SENT (KDR (MEMQ FOUND SENT))) + (FIXUP) + (TYPE '(($ WHATWHEN)(// SENT)(// QMARK))) + (GO TOP) +CONJ (COND ((LESSP (LENGTH (MEMQ FOUND SENT)) 4)(GO SHORT)) ) + (SETQ SENT (KDR (MEMQ FOUND SENT))) + (FIXUP) + (COND ((EQUAL (KAR SENT) 'OF) + (TYPE '(ARE YOU ($ SURE) THAT IS THE REAL REASON?)) + (SETQ THINGS (CONS (KDR SENT) THINGS)) + (GO TOP) )) + (REMEMBER SENT) + (TYPE ($ BECLST)) + (GO TOP) +SHORT (COND ((= (CAR REPETITIVE-SHORTNESS) (1- LINCOUNT)) + (RPLACD REPETITIVE-SHORTNESS (1+ (CDR REPETITIVE-SHORTNESS)))) + (T + (RPLACD REPETITIVE-SHORTNESS 1.))) + (RPLACA REPETITIVE-SHORTNESS LINCOUNT) + (COND ((> (CDR REPETITIVE-SHORTNESS) 6.) + (COND ((NOT **MAD**) + (TYPE '(($ AREYOU) JUST TRYING TO SEE WHAT KIND OF THINGS + I HAVE IN MY VOCABULARY? PLEASE TRY TO + CARRY ON A REASONABLE CONVERSATION!)) + (SETQ **MAD** T) + (GO TOP)) + (T + (TYPE '(I GIVE UP/. YOU NEED A LESSON IN CREATIVE + WRITING /././.)) + (TTY-ON) + (PUSH MONOSYLLABLES OBSERVATION-LIST) + (RETURN 'I-QUIT))))) + (COND ((EQUAL SENT (ASSM '(YES))) + (TYPE '(($ ISEE) ($ INTER) ($ WHYSAY) THIS IS SO?))) + ((EQUAL SENT (ASSM '(BECAUSE))) + (TYPE ($ SHORTBECLST))) + ((EQUAL SENT (ASSM '(NO))) + (TYPE ($ NEGLST))) + (T (TYPE ($ SHORTLST)))) + (GO TOP) +ALCOHOL (TYPE ($ DRNK))(GO TOP) +LOVE LOVES +DESIRE (SETQ FOO (MEMQ FOUND SENT)) + (COND ((LESSP (LENGTH FOO) 2)(GO (BUILD (MEANING FOUND) 1))) + ((NOT (EQ (CADR FOO) 'TO))(GO (BUILD (MEANING FOUND) 1)) ) ) + (SVO SENT FOUND 1 NIL) + (REMEMBER (LIST SUBJ 'WOULD 'LIKE OBJ)) + (TYPE ($ WHYWANT)) (GO TOP) +DRUG (TYPE ($ DRUGS))(REMEMBER (LIST 'YOU 'USED FOUND))(GO TOP) +TOKE (TYPE ($ TOKLST))(GO TOP) +STATE (TYPE ($ STATES))(REMEMBER (LIST 'YOU 'WERE FOUND))(GO TOP) +MOOD (TYPE ($ MOODS))(REMEMBER (LIST 'YOU 'FELT FOUND))(GO TOP) +FEAR (SETQ FOUND (SETPREP SENT FOUND)) + (TYPE ($ FEARS))(REMEMBER (LIST 'YOU 'WERE 'AFRAID 'OF FOUND))(GO TOP) +HATE (SVO SENT FOUND 1 T) + (COND ((MEMQ 'NOT SENT) (FORGET) (GO HUH) )) + (COND ((EQUAL SUBJ 'YOU)(TYPE '(WHY DO YOU (// VERB)(// OBJ)(// QMARK) +))) + (T (TYPE '(($ WHYSAY)(LIST SUBJ VERB OBJ))))) + (GO TOP) +SYMPTOMS (TYPE '(($ MAYBE) YOU SHOULD CONSULT A DOCTOR OF MEDICINE/, + I AM A PSYCHIATRIST)) + (GO TOP) +HATES (SVO SENT FOUND 1 T) + (TYPE '(($ WHYSAY)(LIST SUBJ VERB OBJ))) + (GO TOP) +LOVES1 + (SVO SENT FOUND 1 T) +QLOVES (TYPE '(($ BOTHER)(LIST SUBJ VERB OBJ))) + (GO TOP) +LOVE1 (SVO SENT FOUND 1 T) + (COND ((MEMQ 'NOT SENT) (FORGET) (GO HUH) )) + (COND ((EQUAL OBJECT 'SOMETHING) + (SETQ OBJECT '(THIS PERSON YOU LOVE)))) + (COND ((EQUAL SUBJ 'YOU)(PROGN (SETQ LOVER OBJECT) + (COND ((EQUAL LOVER '(THIS PERSON YOU LOVE)) + (SETQ LOVER '(YOUR PARTNER)) + (FORGET) + (TYPE '(WITH WHOM ARE YOU IN LOVE?)) + (GO TOP))) + (TYPE '(($ PLEASE) + ($ DESCRIBE) + ($ RELATION) + (// LOVER) + (// PERIOD) )) )) + ((EQUAL SUBJ 'I) + (TXTYPE '(WE WERE DISCUSSING YOU!))) + (T (FORGET) + (SETQ OBJ 'SOMEONE) + (SETQ VERB (BUILD VERB 'S)) + (GO QLOVES) ) ) + (GO TOP) +MACH (SETQ FOUND (PLURAL FOUND)) + (TYPE ($ MACHLST)) + (GO TOP) +SEXNOUN SEXVERB + (COND ((OR (MEMQ 'ME SENT)(MEMQ 'MYSELF SENT)(MEMQ 'I SENT)) + (GO FOUL) )) + (TYPE ($ SEXLST))(GO TOP) +DEATH (TYPE ($ DEATHLST)) + (GO TOP) +FOUL (TYPE ($ FOULLST)) + (GO TOP) +FAMILY (POSSESS SENT FOUND) + (TYPE ($ FAMLST)) + (GO TOP) + ) + T ))(DOC)) + (T + (TERPRI TYO) + (PRINC '|MY SECRETARY WILL SEND YOU A BILL.| TYO) + (TERPRI TYO) + (SUICIDE)))) + + +(SETQ WHEREOUTP '( HUH REMEM RTHING ) ) + +(DEFUN $ FEXPR (WHAT) + (PROG (VV FIRST) + (SETQ VV (UNIX-EVAL (CAR WHAT))) + (SETQ FIRST (KAR VV)) + (SETQ VV (APPEND (KDR VV)(LIST FIRST))) + (SET (CAR WHAT) VV) + (RETURN FIRST) )) + + + +(DEFUN CHARBAK (A P) + (COND ((EQUAL TTY 9.) + (COND ((NOT A) + (PRINC (ASCII 7.))) + (T (CURSORPOS 'X TYO)))) + (T (COND ((NOT A) (PRINC (ASCII 7.))) + (P (PRINC (ASCII A))) + (T (PRINC '\) + (PRINC (ASCII A))))))) + + +(SETQ FOO + (SYSCALL 3 'TTYGET TYI)) ;GET THE ORIGINAL DATA + +(COND ((MEMQ (STATUS UNAME) '(KMP EJS CGR ERIC RWK TNP TURNIP)) + (SETQ KMPMODE T)) + (T (SETQ KMPMODE NIL))) + +(COND (KMPMODE + (SETQ *RSET T) + (SETQ ERRLIST '((TTY-ON) + (TERPRI) + (PRINC (ASCII 7.)) + (PRINC '|>*BEEP*<|))) + (SETQ EXIT '(LAMBDA () (^G))) + (DEFPROP DEBUG ((MC RWK) DEBUG) AUTOLOAD)) + (T + (SETQ ERRLIST '((TERPRI) + (PRINC (ASCII 7.)) + (DOC))) + (SSTATUS TTYINT 2. 7.) + (SSTATUS TTYINT 4. NIL) + (SSTATUS TTYINT 17. 7.) + (SSTATUS TTYINT 19. NIL) + (SSTATUS TTYINT 23. NIL) + (SSTATUS TTYINT 24. 7.) + (SETQ EXIT 'QUIT))) + + +(SSTATUS FEATURE NOLDMSG) +(SETQ IBASE 10. BASE 10.) +(SETQ LINEL 78.) + +;;; +;;; The following are library functions necessary to this program +;;; + +(DEFUN MEMLIST (X Y) + (APPLY 'OR (MAPCAR (FUNCTION (LAMBDA (X) (LIST 'QUOTE (MEMQ X Y)))) + X))) +(SETQ SMALL-LETTERS (EXPLODEC '|abcdefghijklmnopqrstuvwxyz|)) + +(DEFUN CAPS (X) (CAR (EXPLODEN (KAPS (ASCII X))))) + +(DEFUN KAPS (X) + (COND + ((MEMQ X SMALL-LETTERS) + (CDR (ASSOC X '((|a| . A)(|b| . B)(|c| . C)(|d| . D) + (|e| . E)(|f| . F)(|g| . G)(|h| . H) + (|i| . I)(|j| . J)(|k| . K)(|l| . L) + (|m| . M)(|n| . N)(|o| . O)(|p| . P) + (|q| . Q)(|r| . R)(|s| . S)(|t| . T) + (|u| . U)(|v| . V)(|w| . W)(|x| . X) + (|y| . Y)(|z| . Z))))) + (T X))) + +;;; +;;; The function build will take a two atoms and build them together +;;; like implode, but will not ignore multiple characters like implode +;;; would. +;;; + +(DEFUN BUILD (X Y) + (COND ((NOT (ATOM X)) + (TERPRI) + (PRINC + '|Error: First arg to BUILD not an atom. It will be ignored.| +) + (PRINC X) + (BUILD NIL Y)) + ((NOT (ATOM Y)) + (TERPRI) + (PRINC + '|Error: 2nd arg to BUILD not an atom. It will be ignored.|) + (PRINC Y) + (BUILD X NIL)) + ((NULL X) Y) + ((NULL Y) X) + (T (IMPLODE (APPEND (DELETE '/| (DELETE '// (EXPLODE X))) + (DELETE '/| (DELETE '// (EXPLODE Y)))))))) + +;;; +;;; The ADDPROP function will add an item to the list in the property +;;; slot desginated in the arg-list. +;;; + +(DEFUN ADDPROP (ATOM-NAME NEW-PROP PROP-NAME) + (PROG (OLD-PROP) + (SETQ OLD-PROP (GET ATOM-NAME PROP-NAME)) + (COND ((NULL NEW-PROP) NIL) + ((NULL OLD-PROP) + (PUTPROP ATOM-NAME (LIST NEW-PROP) PROP-NAME)) + ((ATOM OLD-PROP) + (PUTPROP ATOM-NAME (LIST NEW-PROP OLD-PROP) PROP-NAME)) + (T (PUTPROP ATOM-NAME + (CONS NEW-PROP OLD-PROP) + PROP-NAME))))) + + + +(DEFUN TTY-OFF () + (SYSCALL 0 'TTYSET + TYI + (BOOLE 1 (CAR FOO) 3272356035.) + (BOOLE 1 (CADR FOO) 3272356035.))) + +(DEFUN TTY-ON () + (SYSCALL 0 'TTYSET + TYI + (CAR FOO) + (CADR FOO))) + + +(SETQ S-QUOTE '/') +(SETQ OPEN-QUOTES '/'/') +(SETQ CLOSE-QUOTES '/`/`) +(SETQ SPACE '/ ) +(SETQ COMMA '/,) +(SETQ PERIOD '/./ ) +(SETQ SEMICOLON '/;) +(SETQ EXCLAM '!/ ) +(SETQ DOTDOTDOT '/./././ ) +(SETQ EXCLAM-3 '!!!/ ) +(SETQ COLON ':/ ) +(SETQ QMARK '?/ ) +(SETQ HYPHEN '-) +(SETQ NEWLINE (ASCII 13.)) +(SETQ TAB (ASCII 9.)) + +(DEFUN NON-PUNCTUATION (X) (NOT (PUNCTUATION X))) + +(DEFUN PUNCTUATION (X) (MEMQ X (LIST + COMMA SPACE PERIOD HYPHEN S-QUOTE DOTDOTDOT + QMARK COLON SEMICOLON EXCLAM EXCLAM-3 + OPEN-QUOTES CLOSE-QUOTES))) + +;;; +;;; The line-read function will read line by line, allowing deletes and +;;; printing deleted regions backwards between backslashes ... It will +;;; exit upon reading of either a double-carriage return or a carriage +;;; return preceded by a period, exclamation mark, or a question mark. +;;; + +(DEFUN LINE-READ () + (PROG (LINE C B P A TEMP) + (SETQ P NIL) + TOP (SETQ C (CAPS (TYI TYI))) + R1 (COND ((EQUAL C 9.) (SETQ C 32.)) + ((AND (GREATERP C 64.) + (LESSP C 91.) + (EQ B 45.)) + (SETQ LINE (APPEND LINE (LIST 45.)))) + ((EQUAL C 10.) (SETQ C 13.))) + (COND ((OR (EQUAL C 127.) (EQUAL C 8.)) ;RUBOUT (BACKSPACE) + (SETQ LINE (CHAR-RUBOUT LINE)) + (SETQ A (GET 'CHAR-RUBOUT 'CHAR)) + (CHARBAK A P) + (SETQ P T) + (SETQ B (CAR (LAST LINE))) + (GO TOP))) + (COND ((EQUAL C 12.) ;CONTROL-L + (TERPRI) + (CURSORPOS 'C TYO) + (PRINC (IMPLODE LINE)) + (SETQ P NIL) + (GO TOP)) + ((EQUAL C 27.) + (PRINC (ASCII 7.)) + (GO TOP)) + ((AND (NOT (EQUAL TTY 9.)) P) + (PRINC '\) + (SETQ P NIL))) + (COND ((OR (MEMBER C '(18. 21. 13. 11. 4.)) + (GREATERP C 26.)) + (PRINC (ASCII C)))) + (COND ((EQUAL C 46.) + (SETQ LINE (APPEND LINE (LIST 46.))) + (GO OUTCHECK)) + ((EQUAL C 33.) + (SETQ LINE (APPEND LINE (LIST 33.))) + (GO OUTCHECK)) + ((EQUAL C 63.) + (COND ((NULL LINE) + (SETQ LINE (LIST 87. 72. 65. 84. 63.))) + (T (SETQ LINE (APPEND LINE (LIST 63.))))) + (GO OUTCHECK)) + ((EQUAL C 13.) + (COND ((EQUAL B 45.) ;HYPHENATION + (SETQ B (CAR (LAST LINE))) + (GO TOP))) + (SETQ B NIL) + (SETQ LINE (APPEND LINE (LIST 32.))) + (GO TOP)) + ((OR (EQUAL C 21.) (EQUAL C 4.)) ;CONTROL-U, CONTROL-D + (SETQ B NIL) + (SETQ LINE NIL) + (TERPRI TYO) + (GO TOP)) + ((OR (EQUAL C 18.) (EQUAL C 11.)) ;CONTROL-R, CONTROL-K + (TERPRI) + (PRINC (IMPLODE LINE)) + (GO TOP)) + ((EQUAL C 45.) + (SETQ B 45.) + (GO TOP)) + ((AND (LESSP C 58.) ;RECOVER MINUS + (GREATERP C 47.) ;SIGN FOR NUMBERS + (EQUAL B 45.)) + (SETQ LINE (APPEND LINE (LIST 45.))))) + BACK + (SETQ LINE (APPEND LINE (LIST C))) + (SETQ B C) + (GO TOP) + OUTCHECK + (COND ((NULL LINE) (GO TOP)) ;NO TEXT + (T (RETURN LINE))))) + + +(DEFUN CHAR-RUBOUT (CHAR-LIST) ;Helping function + (COND ((NULL CHAR-LIST) ;for LINE-READ + (PUTPROP 'CHAR-RUBOUT NIL 'CHAR) + NIL) + ((ATOM CHAR-LIST) (ERR)) + ((NULL (CDR CHAR-LIST)) + (PUTPROP 'CHAR-RUBOUT (CAR CHAR-LIST) 'CHAR) + NIL) + (T (APPEND (LIST (CAR CHAR-LIST)) + (CHAR-RUBOUT (CDR CHAR-LIST)))))) + + +;;; +;;; The following functions will read a set of input and parse it into +;;; a list of sentences +;;; + +(DEFUN PARSE-READ () (PARSE-INPUT (LINE-READ))) + +(DEFUN PARSE-INPUT (LINE) + (PROG2 (PUTPROP 'SENTENCE NIL 'TYPE) + (REVERSE (CDR (DO ((WORD (PARSE-WORD LINE) (PARSE-WORD LINE)) + (PARAGRAPH (NCONS NIL)) + (A NIL)) + ((NULL WORD) PARAGRAPH) + (SETQ A (GET 'WORD-BREAK 'TYPE)) + (SETQ PARAGRAPH + (PARSE-PARAGRAPH A WORD PARAGRAPH))))) + (PUTPROP 'SENTENCE (REVERSE (GET 'SENTENCE 'TYPE)) 'TYPE))) + +(DEFUN PARSE-PARAGRAPH (BREAK WORD PARAGRAPH) + (COND ((EQUAL BREAK 32.) ;SPACE + (CONS + (APPEND (CAR PARAGRAPH) + WORD) + (CDR PARAGRAPH))) + ((EQUAL BREAK 63.) ;QUESTION MARK + (ADDPROP 'SENTENCE 'QUESTION 'TYPE) + (CONS NIL + (CONS (APPEND (CAR PARAGRAPH) + WORD) + (CDR PARAGRAPH)))) + ((OR (EQUAL BREAK 46.) + (EQUAL BREAK 33.) ;EXCLAM + (EQUAL BREAK 59.)) ;PERIOD/SEMICOLON + (ADDPROP 'SENTENCE 'STATEMENT 'TYPE) + (CONS NIL + (CONS (APPEND (CAR PARAGRAPH) + WORD) + (CDR PARAGRAPH)))) + ((EQUAL BREAK 44.) ;COMMA + (CONS + (APPEND (CAR PARAGRAPH) + (APPEND WORD (LIST COMMA))) + (CDR PARAGRAPH))) + ((EQUAL BREAK 58.) ;COLON + (CONS + (APPEND (CAR PARAGRAPH) + (APPEND WORD (LIST COLON))) + (CDR PARAGRAPH))))) + + +(DEFUN PARSE-WORD (LINE) + (PROG (WORD) + (SETQ WORD NIL) + (COND ((OR (NULL LINE) + (AND (EQUAL (LENGTH LINE) 1.) + (WORD-BREAK (CAR LINE)))) + (RETURN NIL))) + (DO ((C (CAR LINE) (CAR LINE)) + (L (CDR LINE) (CDR LINE))) + ((NOT (WORD-BREAK C))) + (COND ((NULL L) (RETURN NIL))) + (RPLACA LINE (CAR L)) + (RPLACD LINE (CDR L))) + (COND ((NULL LINE) (RETURN NIL))) + (DO ((C (CAR LINE) (CAR LINE)) + (L (CDR LINE) (CDR LINE))) + ((WORD-BREAK C)) + (SETQ WORD (CONS C WORD)) + (COND ((NULL L) (RETURN NIL))) + (RPLACA LINE (CAR L)) + (RPLACD LINE (CDR L))) + (RETURN (LIST (IMPLODE (REVERSE WORD)))))) + +(DEFUN WORD-BREAK (X) + (PUTPROP 'WORD-BREAK X 'TYPE) + (COND ((OR (EQUAL X 32.) ;SPACE + (EQUAL X 33.) ;EXCLAMATION MARK + (EQUAL X 44.) ;COMMA + (EQUAL X 46.) ;PERIOD + (EQUAL X 58.) ;COLON + (EQUAL X 59.) ;SEMI-COLON + (EQUAL X 63.)) T) ;QUESTION MARK + (T NIL))) + + +(DEFUN TXREAD () + (PROG (A B) + TOP (SETQ A (DELETE COMMA (CAR (PARSE-READ)))) + (SETQ B (CAR (GET 'SENTENCE 'TYPE))) + (COND ((EQ B 'STATEMENT) + (RETURN A)) + ((EQ B 'QUESTION) + (TYPE ($ QLIST)) + (TYPE '(($ PLEASE) + ($ DESCRIBE) + ($ SOMETHING) + ABOUT + ($ THINGS) + (// PERIOD))))) + (GO TOP))) + +(DOC)) \ No newline at end of file diff --git a/src/games/doc.102 b/src/games/doc.102 new file mode 100644 index 00000000..ab2c48c3 --- /dev/null +++ b/src/games/doc.102 @@ -0,0 +1,1547 @@ +;;; -*- LISP -*- + +(COMMENT) +(PROG2 + (SETQ PRIN1 'PRINC) + '|/ +The doctor will be ready in a sec... When he is ready,/ +he will say so. Please end responses with/ +a period./ + Be patient!/ + -The Doctor's Secretary/ +| +((LAMBDA (FILE) + ((LAMBDA (MSGFILES) + (LOAD '((LISP) LET FASL)) + (LOAD '((LISP) DEFMAX FASL))) (NCONS FILE)) + (CLOSE FILE)) + (OPEN '((NUL *) * *) 'OUT)) +(SSTATUS FEATURE NOLDMSG) +(CLEAR-INPUT TYI)) +(PROGN +(SETQ PRIN1 NIL) +(SETQ GC-OVERFLOW '(LAMBDA (X) T)) +(SSTATUS FEATURE NOLDMSG) +(*RSET T) +(NOUUO T) +(DEFAULTF '(_LISP_ >)) +(SETQ LISPT-PROTECT T) +(CLOSE (PROG2 T INFILE (INPUSH -1.))) +(DECLARE (SPECIAL ERRLIST FOO EXIT *RSET LINEL AFFIRMATIVES NEGATIVES + MAYBES SMALL-LETTERS N THING CONTRACTIONS S-QUOTE OPEN-QUOTES + CLOSE-QUOTES SPACE COMMA PERIOD SEMICOLON EXCLAM + GUESS-X MEMORY KMPMODE A DEFAULTF WRITABLE LISPT-JNAME + OPEN-PAREND CLOSE-PAREND IN_FILE WRITE-PROTECT + DOTDOTDOT EXCLAM-3 COLON QMARK HYPHEN NEWLINE TAB)) + +(DEFUN WINNER () + (MEMQ (STATUS UNAME) + '(TNP KMP RWK MRG JPG BKERNS JM BMT RZ EJS WAM CSTACY + PAULP FRAWLE BUD MIKE GLS HIC ELLEN RL KRD))) + +(EVAL-WHEN (EVAL COMPILE) + (COND ((NOT (STATUS FEATURE IOTA)) + (LOAD '((DSK LIBLSP) IOTA FASL))))) + +(MAPCAR '(LAMBDA (OBSERVER) + (COND ((AND (NOT (EQ (STATUS USERID) OBSERVER)) + (PROBEF (LIST '(USR *) OBSERVER 'HACTRN))) + (LET ((BASE 10.) (*NOPOINT T) ((HOUR MIN) (STATUS DAYTIME))) + (ERRSET + (IOTA ((STREAM (LIST '(CLI *) OBSERVER 'HACTRN) '(OUT))) + (MAPC (FUNCTION (LAMBDA (X) (PRINC X STREAM))) + (LIST + '|/[Message from The Doctor Game at MIT-MC | + (COND ((ZEROP (\ HOUR 12.)) '|12|) (T (\ HOUR 12.))) + '/: + (COND ((< MIN 10.) (IMPLODE (LIST '/0 (+ MIN 48.)))) + (T MIN)) + (COND ((ZEROP (// HOUR 12.)) '|am|) + (T '|pm|)) + '/] (ASCII 13.) (STATUS UNAME) + '| is gonna have a private chat with me. If you| + (ASCII 13.) + (ASCII 10.) + '|feel like a good laugh, you're welcome to watch.| + )) + (TERPRI STREAM)) + NIL))))) + '(KMP CSTACY)) ;people who care... + +(SETQ MONOSYLLABLES + '|/ + Your attitude at the end of the session was wholly unacceptable./ + Please try to come back next time with a willingness to speak more/ + freely. If you continue to refuse to talk openly, there is little/ + I can do to help!/ +|) + +(DEFUN SUICIDE () + (IOTA ((STREAM '|.MAIL.;MAIL >| '(OUT ASCII BLOCK DSK))) + (PRINC '|FROM-JOB:KMP's DOCTOR| STREAM) + (TERPRI STREAM) + (PRINC '|SENT-BY:DOCTOR| STREAM) + (TERPRI STREAM) + (PRINC '|TO:| STREAM) + (PRINC (LIST (STATUS UNAME) 'MC) STREAM) + (TERPRI STREAM) + (PRINC '|SUBJECT:Session of | STREAM) + (LET ((BASE 10.) (*NOPOINT T) (DATE (STATUS DATE)) (TIME)) + (PRINC (CADR DATE) STREAM) + (PRINC '// STREAM) + (PRINC (CADDR DATE) STREAM) + (PRINC '// STREAM) + (PRINC (CAR DATE) STREAM) + (TERPRI STREAM) + (PRINC '|TEXT;-1| STREAM) + (TERPRI STREAM) + (PRINC '|Session lasted | STREAM) + (PRINC (FIX (SETQ TIME (//$ (-$ (TIME) INIT-TIME) 60.0))) + STREAM) + (PRINC '| minutes, so your bill is $| STREAM) + (DO ((L (EXPLODEN (*$ TIME 0.25)) (CDR L))) + ((= (CAR L) 46.) + (TYO 46. STREAM) + (TYO (OR (CADR L) 48.) STREAM) + (TYO (OR (CADDR L) 48.) STREAM)) + (TYO (CAR L) STREAM)) + (TERPRI STREAM) + (TYO 9. STREAM) + (PRINC '| - The Doctor's Secretary| STREAM) + (TERPRI STREAM) + (TERPRI STREAM) + (COND (OBSERVATION-LIST + (TERPRI STREAM) + (PRINC '|PS. The doctor also had some comments he +asked me to convey to you:/ +/ +| STREAM) + (DO ((O OBSERVATION-LIST (CDR O))) + ((NULL O)) + (PRINC (CAR O) STREAM) + (TERPRI STREAM)))))) + (QUIT)) + +(SETQ INIT-TIME (TIME)) + +(DEFUN WORKING-HOURS? () + (AND (MEMQ (STATUS DOW) '(MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY)) + (> (CAR (STATUS DAYTIME)) 8.) + (< (CAR (STATUS DAYTIME)) 20.))) + +(COND ((AND (WORKING-HOURS?) (NOT (WINNER))) + (TERPRI TYO) + (PRINC '|This is not the time of day to be playing games!|) + (TERPRI TYO) + (PRINC '|Please come back later. This game is unavailable|) + (TERPRI TYO) + (PRINC '|during the hours of 9am-8pm Monday-Friday.|) + (QUIT))) + + +(SETQ LISPT-JNAME '|DOX|) + +(SETQ BASE 10. IBASE 10. *NOPOINT T) + +(DEFUN MAP-PROP (X Y Z) + (MAPCAR (FUNCTION (LAMBDA (X) (PUTPROP X Y Z))) + X)) + +(DEFUN UNIX-EVAL (X) (COND ((ATOM X) + (COND ((BOUNDP X) (EVAL X)) + (T NIL))) + (T (EVAL X)))) + +(DEFUN WHILE FEXPR (X) + (COND ((UNIX-EVAL (CAR X)) NIL) + (T (MAPCAR 'UNIX-EVAL (CDR X)) + (APPLY 'WHILE X)))) + +(DEFUN CVTA (X) (ASCII X)) +(DEFUN CVTN (X) (CAR (EXPLODEN X))) +(DEFUN READCH () (ASCII (TYI))) +(DEFUN PEEKCH () (ASCII (TYIPEEK))) + +(DEFUN MEANING (X) (GET X 'MEANING)) +(DEFUN PUT-MEANING FEXPR (X) + (PUTPROP (CAR X) (UNIX-EVAL (CADR X)) 'MEANING)) + +(PUT-MEANING HOWDY 'HOWDY) +(PUT-MEANING HI 'HOWDY) +(PUT-MEANING GREETINGS 'HOWDY) +(PUT-MEANING HELLO 'HOWDY) +(PUT-MEANING PDP11 'MACH) +(PUT-MEANING COMPUTER 'MACH) +(PUT-MEANING UNIX 'MACH) +(PUT-MEANING MACHINE 'MACH) +(PUT-MEANING COMPUTERS 'MACH) +(PUT-MEANING MACHINES 'MACH) +(PUT-MEANING PDP11S 'MACH) +(PUT-MEANING FOO 'MACH) +(PUT-MEANING FOOBAR 'MACH) +(PUT-MEANING MULTICS 'MACH) +(PUT-MEANING MACSYMA 'MACH) +(PUT-MEANING TELETYPE 'MACH) +(PUT-MEANING LA36 'MACH) +(PUT-MEANING VT52 'MACH) +(PUT-MEANING ZORK 'MACH) +(PUT-MEANING TREK 'MACH) +(PUT-MEANING STARTREK 'MACH) +(PUT-MEANING ADVENT 'MACH) +(PUT-MEANING PDP 'MACH) +(PUT-MEANING DEC 'MACH) +(PUT-MEANING SHIT 'FOUL) +(PUT-MEANING BASTARD 'FOUL) +(PUT-MEANING DAMN 'FOUL) +(PUT-MEANING DAMNED 'FOUL) +(PUT-MEANING HELL 'FOUL) +(PUT-MEANING SUCK 'FOUL) +(PUT-MEANING SUCKING 'FOUL) +(PUT-MEANING SUX 'FOUL) +(PUT-MEANING ASS 'FOUL) +(PUT-MEANING WHORE 'FOUL) +(PUT-MEANING BITCH 'FOUL) +(PUT-MEANING ASSHOLE 'FOUL) +(PUT-MEANING SHRINK 'FOUL) +(PUT-MEANING POT 'TOKE) +(PUT-MEANING GRASS 'TOKE) +(PUT-MEANING WEED 'TOKE) +(PUT-MEANING MARIJUANA 'TOKE) +(PUT-MEANING ACAPULCO 'TOKE) +(PUT-MEANING COLUMBIAN 'TOKE) +(PUT-MEANING TOKIN 'TOKE) +(PUT-MEANING JOINT 'TOKE) +(PUT-MEANING TOKE 'TOKE) +(PUT-MEANING TOKING 'TOKE) +(PUT-MEANING TOKIN/' 'TOKE) +(PUT-MEANING PILLS 'DRUG) +(PUT-MEANING DOPE 'DRUG) +(PUT-MEANING ACID 'DRUG) +(PUT-MEANING LSD 'DRUG) +(PUT-MEANING SPEED 'DRUG) +(PUT-MEANING HEROINE 'DRUG) +(PUT-MEANING HASH 'DRUG) +(PUT-MEANING COCAINE 'DRUG) +(PUT-MEANING UPPERS 'DRUG) +(PUT-MEANING DOWNERS 'DRUG) +(PUT-MEANING LOVES 'LOVES) +(PUT-MEANING LOVE 'LOVE) +(PUT-MEANING HATES 'HATES) +(PUT-MEANING DISLIKES 'HATES) +(PUT-MEANING HATE 'HATE) +(PUT-MEANING DISLIKE 'HATE) +(PUT-MEANING STONED 'STATE) +(PUT-MEANING DRUNK 'STATE) +(PUT-MEANING DRUNKEN 'STATE) +(PUT-MEANING HIGH 'STATE) +(PUT-MEANING HORNY 'STATE) +(PUT-MEANING BLASTED 'STATE) +(PUT-MEANING HAPPY 'STATE) +(PUT-MEANING PARANOID 'STATE) +(PUT-MEANING WISH 'DESIRE) +(PUT-MEANING WANT 'DESIRE) +(PUT-MEANING DESIRE 'DESIRE) +(PUT-MEANING LIKE 'DESIRE) +(PUT-MEANING HOPE 'DESIRE) +(PUT-MEANING HOPES 'DESIRE) +(PUT-MEANING DESIRES 'DESIRE) +(PUT-MEANING WANTS 'DESIRE) +(PUT-MEANING DESIRES 'DESIRE) +(PUT-MEANING LIKES 'DESIRE) +(PUT-MEANING FRUSTRATED 'MOOD) +(PUT-MEANING DEPRESSED 'MOOD) +(PUT-MEANING ANNOYED 'MOOD) +(PUT-MEANING UPSET 'MOOD) +(PUT-MEANING UNHAPPY 'MOOD) +(PUT-MEANING EXCITED 'MOOD) +(PUT-MEANING WORRIED 'MOOD) +(PUT-MEANING LONELY 'MOOD) +(PUT-MEANING ANGRY 'MOOD) +(PUT-MEANING PISSED 'MOOD) +(PUT-MEANING JEALOUS 'MOOD) +(PUT-MEANING AFRAID 'FEAR) +(PUT-MEANING FEAR 'FEAR) +(PUT-MEANING SCARED 'FEAR) +(PUT-MEANING VIRGINITY 'SEXNOUN) +(PUT-MEANING COCK 'SEXNOUN) +(PUT-MEANING CUNT 'SEXNOUN) +(PUT-MEANING PROSTITUTE 'SEXNOUN) +(PUT-MEANING CONDOM 'SEXNOUN) +(PUT-MEANING SEX 'SEXNOUN) +(PUT-MEANING RAPES 'SEXNOUN) +(PUT-MEANING WIFE 'FAMILY) +(PUT-MEANING BROTHER 'FAMILY) +(PUT-MEANING SISTER 'FAMILY) +(PUT-MEANING FATHER 'FAMILY) +(PUT-MEANING MOTHER 'FAMILY) +(PUT-MEANING HUSBAND 'FAMILY) +(PUT-MEANING SIBLINGS 'FAMILY) +(PUT-MEANING GRANDMOTHER 'FAMILY) +(PUT-MEANING GRANDFATHER 'FAMILY) +(PUT-MEANING MATERNAL 'FAMILY) +(PUT-MEANING PATERNAL 'FAMILY) +(PUT-MEANING STAB 'DEATH) +(PUT-MEANING MURDER 'DEATH) +(PUT-MEANING MURDERS 'DEATH) +(PUT-MEANING SUICIDE 'DEATH) +(PUT-MEANING SUICIDES 'DEATH) +(PUT-MEANING KILL 'DEATH) +(PUT-MEANING KILLS 'DEATH) +(PUT-MEANING DIE 'DEATH) +(PUT-MEANING DIES 'DEATH) +(PUT-MEANING DEATH 'DEATH) +(PUT-MEANING DEATHS 'DEATH) +(PUT-MEANING PAIN 'SYMPTOMS) +(PUT-MEANING ACHE 'SYMPTOMS) +(PUT-MEANING FEVER 'SYMPTOMS) +(PUT-MEANING SORE 'SYMTOMS) +(PUT-MEANING ACHING 'SYMPTOMS) +(PUT-MEANING STOMACHACHE 'SYMPTOMS) +(PUT-MEANING HEADACHE 'SYMPTOMS) +(PUT-MEANING HURTS 'SYMPTOMS) +(PUT-MEANING DISEASE 'SYMPTOMS) +(PUT-MEANING VIRUS 'SYMPTOMS) +(PUT-MEANING VOMIT 'SYMPTOMS) +(PUT-MEANING VOMITING 'SYMPTOMS) +(PUT-MEANING BARF 'SYMPTOMS) +(PUT-MEANING TOOTHACHE 'SYMPTOMS) +(PUT-MEANING HURT 'SYMPTOMS) +(PUT-MEANING RUM 'ALCOHOL) +(PUT-MEANING GIN 'ALCOHOL) +(PUT-MEANING VODKA 'ALCOHOL) +(PUT-MEANING ALCOHOL 'ALCOHOL) +(PUT-MEANING BOURBON 'ALCOHOL) +(PUT-MEANING BEER 'ALCOHOL) +(PUT-MEANING WINE 'ALCOHOL) +(PUT-MEANING WHISKEY 'ALCOHOL) +(PUT-MEANING SCOTCH 'ALCOHOL) +(PUT-MEANING FUCK 'SEXVERB) +(PUT-MEANING SCREW 'SEXVERB) +(PUT-MEANING SCREWING 'SEXVERB) +(PUT-MEANING FUCKING 'SEXVERB) +(PUT-MEANING RAPE 'SEXVERB) +(PUT-MEANING KISS 'SEXVERB) +(PUT-MEANING KISSING 'SEXVERB) +(PUT-MEANING KISSES 'SEXVERB) +(PUT-MEANING SCREWS 'SEXVERB) +(PUT-MEANING FUCKS 'SEXVERB) +(PUT-MEANING BECAUSE 'CONJ) +(PUT-MEANING BUT 'CONJ) +(PUT-MEANING HOWEVER 'CONJ) +(PUT-MEANING BESIDES 'CONJ) +(PUT-MEANING ANYWAY 'CONJ) +(PUT-MEANING THAT 'CONJ) +(PUT-MEANING EXCEPT 'CONJ) +(PUT-MEANING WHY 'CONJ) +(PUT-MEANING HOW 'CONJ) +(PUT-MEANING UNTIL 'WHEN) +(PUT-MEANING WHEN 'WHEN) +(PUT-MEANING WHILE 'WHEN) +(PUT-MEANING SINCE 'WHEN) + +(DEFUN KAR(X) (COND ((ATOM X) X) + (T (CAR X)))) +(DEFUN KDR (X) (COND ((ATOM X) NIL) + (T (CDR X)))) +(DEFUN CADR (X) (KAR (KDR X))) +(DEFUN CDDR (X) (KDR (KDR X))) + +(DECLARE (SPECIAL TYPOS)) + +(SETQ TYPOS ()) + +(DEFUN TYPOS: FEXPR (X) (SETQ TYPOS (MAPCAR 'TYPOS-AUX X))) + +(DEFUN TYPOS-AUX (X) + (PUTPROP (CAR X) (CADR X) 'CORRECTION) + (PUTPROP (CADR X) (CADDR X) 'EXPANSION) + (CAR X)) + +(DEFUN TYPOP (X) (MEMQ X TYPOS)) + +(DEFUN CORRECTION (X) (GET X 'CORRECTION)) + +(DEFUN EXPANSION (X) (GET X 'EXPANSION)) + +(TYPOS: (THEYLL THEY/'LL (THEY WILL)) + (THEYRE THEY/'RE (THEY ARE)) + (IM I/'M (YOU ARE)) + (I7M I/'M (YOU ARE)) + (ISA |IS A| (IS A)) + (THIER THEIR (THEIR)) + (DONT DON/'T (DO NOT)) + (DON7T DON/'T (DO NOT)) + (YOU7RE YOU/'RE (I AM)) + (YOU7VE YOU/'VE (I HAVE)) + (YOU7LL YOU/'LL (I WILL))) + +(DEFUN WARN-TYPOS (X) + (CURSORPOS 'A TYO) + (PRINC '|WATCH YOUR SPELLING! YOU MIS-SPELLED | TYO) + (/"PRINC (CAR X)) + (MAP (FUNCTION + (LAMBDA (X) + (COND ((NULL (CDR X)) (PRINC '|, AND |)) + (T (PRINC '|, |))) + (COND ((> (CHARPOS TYO) 60.) (TERPRI TYO))) + (/"PRINC (CAR X)))) + (CDR X)) + (PRINC '/. TYO)) + +(DEFUN /"PRINC (X) (TYO 34. TYO) (PRINC X TYO) (TYO 34. TYO)) + +(DEFUN CORRECT-SPELLING (X) + (DO ((X X (CDR X)) + (L ()) + (TEMP) + (TYPO-LIST) + (CORREX-FLAG ())) + ((NULL X) + (COND (CORREX-FLAG (WARN-TYPOS TYPO-LIST))) + (MAPCAN (FUNCTION (LAMBDA (X) (COND ((ATOM X) (NCONS X)) (T X)))) + (NREVERSE L))) + (COND ((SETQ TEMP (TYPOP (CAR X))) + (SETQ CORREX-FLAG T) + (LET ((C (CORRECTION (CAR X)))) + (PUSH (EXPANSION C) L) + (PUSH C TYPO-LIST))) + (T + (PUSH (CAR X) L))))) + +(DEFUN SHORTEN (SENT) + (PROG (FOO TEMP) + (SETQ TEMP '(NIL BECAUSE BUT HOWEVER BESIDES ANYWAY UNTIL + WHILE THAT EXCEPT WHY HOW)) + RECHK + (SETQ TEMP (KDR TEMP)) + (COND ((NULL TEMP) + (RETURN NIL))) + (SETQ FOO (MEMQ (KAR TEMP) SENT)) + (COND ((NOT FOO)(GO RECHK)) + ((LESSP (LENGTH FOO) 4) + (GO RECHK))) + (SETQ SENT FOO) + (FIXUP) + (RETURN T) )) + +(DEFUN DEFINE (SENT FOUND) + (PROG () + (SVO SENT FOUND 1 NIL) + (COND + ((NOT (NOUNP SUBJ)) + (RETURN NIL)) + ((PRONOUNP SUBJ) + (RETURN NIL)) + ((NULL SUBJ) + (RETURN NIL)) + ((NULL (MEANING OBJECT)) + (RETURN NIL))) + (PUTPROP SUBJ (MEANING OBJECT) 'MEANING) + (RETURN T))) + +(DEFUN DEFQ (SENT) + (PROG (TEMP) + (SETQ TEMP '(MEANS APPLIES MEAN REFERS REFER RELATED + SIMILAR DEFINED ASSOCIATED LINKED LIKE SAME)) + FOO (COND ((MEMQ (KAR TEMP) SENT) + (PROGN + (SETQ FOUND (KAR TEMP)) + (RETURN T))) + ((NULL (KDR TEMP)) + (RETURN NIL))) + (SETQ TEMP (KDR TEMP)) (GO FOO))) + +(DEFUN DEF (X) + (PROGN + (TYPE (LIST 'THE 'WORD X 'MEANS (MEANING X) 'TO 'ME)) + NIL)) + +(DEFUN FORGET () (PROG (TEMP) + (SETQ TEMP HISTORY) + (SETQ HISTORY NIL) +LOOP (COND ((NULL (KDR TEMP))(RETURN NIL))) + (SETQ HISTORY (CONS (KAR TEMP) HISTORY)) + (SETQ TEMP (KDR TEMP)) + (GO LOOP))) + +(DEFUN QUERY (X) + (PROG (A) + TOP (TXTYPE (ASSM (LIST X 'WHAT?))) + (SETQ A (TXREAD)) + LOOP (COND ((NULL A) + (GO TOP))) + (COND ((NOUNP (KAR A)) (RETURN (KAR A)))) + (COND ((VERBP (KAR A)) (RETURN (BUILD (BUILD X '/ ) (KAR A))))) + (SETQ A (KDR A)) + (GO LOOP))) + +(DEFUN SUBJSEARCH (SENT KEY TYPE) + (PROG (FOO) + (SETQ FOO (- (INDEX SENT KEY) TYPE)) + (WHILE (NOT (GREATERP FOO 0)) + (SETQ SUBJ (PART SENT FOO)) + (COND ((NOUNP SUBJ) (RETURN T))) + (SETQ FOO (SUB1 FOO))) + (SETQ SUBJ 'YOU) (RETURN NIL) )) + +(DEFUN NOUNP (X) + (OR (PRONOUNP X) + (NOT (OR (VERBP X) (EQUAL X 'NOT) (PREPP X) (MODIFIERP X) )) )) + +(DEFUN PRONOUNP (X) (MEMQ X '(I ME YOU HE HIM SHE HER IT WE US THEY THEM + THAT THOSE THIS THESE MYSELF YOURSELF HIMSELF HERSELF THINGS THING + ANYTHING SOMETHING EVERYTHING) )) + +(MAP-PROP '(AM IS ARE WAS WERE HAS HAVE HAD DO DID + FIND TAKE GET HIT MOVE HIT HURT KILL EAT DRINK LAY OUGHT + DOES SHALL SHOULD WILL WOULD CAN COULD MAY MIGHT MUST BE + BEEN BEING GOING GOES WENT GO GONE REFER MEAN MEANS REFERS + ASSOCIATED APPLIES RELATED LINKED USE USING USED DEFINED USES + FEEL FEELS FELT THINK THINKS THOUGHT HATES DISLIKES + HATE DISLIKE LOVE LOVES LIKES WISH WANT DESIRE LIKE + RAPE KISS KISSING KISSES SCREWS FUCKS + HOPE DESIRES WANTS DESIRES FUCK SCREW SCREWING FUCKING) + 'VERB + 'SENTENCE-TYPE) + +(DEFUN VERBP (X) (EQ (GET X 'SENTENCE-TYPE) 'VERB)) + +(DEFUN PLURAL (X) + (PROG (FOO) + (SETQ FOO (EXPLODE X)) + (RETURN + (COND ((NOT (EQUAL (PART FOO (LENGTH FOO)) 'S)) + (BUILD X 'S)) + (T X))))) + +(SETQ INTER + '((WELL/,) + (|HMMM... SO,|) + (SO) + (|...AND|) + (THEN))) + +(SETQ CONTINUE + '((CONTINUE) + (PROCEED) + (GO ON) + (KEEP GOING) )) + +(SETQ RELATION + '((YOUR RELATIONSHIP WITH) + (SOMETHING YOU REMEMBER ABOUT) + (YOUR FEELINGS TOWARD) + (SOME EXPERIENCES YOU HAVE HAD WITH) + (HOW YOU FEEL ABOUT))) + +(DEFUN SETPREP (SENT KEY) + (PROG (FOO) + (SETQ FOO (MEMQ KEY SENT)) + (COND ((PREPP (CADR FOO))(GETNOUN (CDDR FOO))) + (T 'SOMETHING)) )) + +(DEFUN GETNOUN (X) + (COND ((NULL X)(SETQ OBJECT 'SOMETHING)) + ((ATOM X)(SETQ OBJECT X)) + ((EQ (LENGTH X) 1) + (SETQ OBJECT (COND + ((NOUNP (SETQ OBJECT (KAR X))) OBJECT) + (T (QUERY OBJECT))))) + ((EQ (KAR X) 'TO) + (BUILD 'TO/ (GETNOUN (KDR X)))) + ((PREPP (KAR X)) + (GETNOUN (KDR X))) + ((NOT (NOUNP (KAR X))) + (BUILD (BUILD (KAR (REPLACE (LIST (KAR X)) + '(A (THIS) + SOME (THIS) + ONE (THAT)))) + SPACE) + (GETNOUN (KDR X)))) + (T (SETQ OBJECT (KAR X))) )) + +(DEFUN MODIFIERP (X) + (MEMQ X '(THE A AN EVERY SOME ONE VERY OFTEN MY MUCH + LINKED YOUR HIS HER THEIR OUR ANY MANY RELATED + ALL SIMILAR SIMILAR ALWAYS ASSOCIATED GOOD BAD + UGLY PRETY BIG SMALL TOO REALLY MORE LESS ALSO))) + +(DEFUN PREPP (X) + (MEMQ X '(OF IN ON WITH FROM FOR TO AT SAME AS LIKE ABOUT + BY BESIDE AROUND UNDER ABOVE THROUGH BENEATH + BEHIND OVER ))) + +(DEFUN REMEMBER (THING) + (COND ((NULL HISTORY) + (SETQ HISTORY (LIST THING))) + (T (SETQ HISTORY (APPEND HISTORY (LIST THING)))))) + +(SETQ FEARS '( (($ WHYSAY) YOU ARE ($ AFRAIDOF) (// FOUND)(// QMARK)) + (YOU SEEM TERRIFIED BY (// FOUND)(// PERIOD)) + (WHEN DID YOU FIRST FEEL ($ AFRAIDOF)(// FOUND)(// QMARK)) )) + +(SETQ SURE '((SURE)(POSITIVE)(CERTAIN))) + +(SETQ AFRAIDOF '( (AFRAID OF) (FRIGHTENED BY) (SCARED OF) )) + +(SETQ AREYOU '( (ARE YOU)(HAVE YOU BEEN)(HAVE YOU BEEN) )) + +(SETQ ISRELATED '( (HAS SOMETHING TO DO WITH)(IS RELATED TO) + (COULD BE THE REASON FOR) )) + +(SETQ ARERELATED '((HAVE SOMETHING TO DO WITH)(ARE RELATED TO) + (COULD HAVE CAUSED)(COULD BE THE REASON FOR) )) + +(SETQ MOODS '( (($ AREYOU)(// FOUND) OFTEN?) + (WHAT CAUSES YOU TO BE (// FOUND)(// QMARK)) + (($ WHYSAY) YOU ARE (// FOUND)(// QMARK)) )) + +(SETQ MAYBE + '((MAYBE) + (PERHAPS) + (POSSIBLY))) + +(DEFUN TYPE (X)(TXTYPE (ASSM X))) + +(DEFUN FIXUP () + (SETQ SENT (RPLACD + (REPLACE (LIST (KAR SENT)) + '(ME (I) + HIM (HE) + HER (SHE) + THEM (THEY) + OKAY (/) + WELL (/) + SIGH (/) + HMM (/) + HMMM (/) + HMMMM (/) + HMMMMM (/) + GEE (/) + SURE (/) + GREAT (/) + OH (/) + FINE (/) + OK (/) + NO (/))) + (KDR SENT)))) + +(SETQ WHATWHEN + '((WHAT HAPPENED WHEN) + (WHAT WOULD HAPPEN IF))) + +(SETQ HELLO + '((HOW DO YOU DO?) (HELLO/.) (HOWDY!) (HELLO/.) (HI/.))) + +(SETQ DRNK + '((DO YOU DRINK A LOT OF (// FOUND)(// QMARK)) + (DO YOU GET DRUNK OFTEN?) + (($ DESCRIBE) YOUR DRINKING HABITS/.) )) + +(SETQ DRUGS '( (DO YOU USE (// FOUND) OFTEN?)(($ AREYOU) + ADDICTED TO (// FOUND)(// QMARK))(DO YOU REALIZE THAT DRUGS CAN + BE VERY HARMFUL?)(($ MAYBE) YOU SHOULD TRY TO QUIT USING (// FOUND) + (// PERIOD)) )) + +(SETQ WHYWANT '( (($ WHYSAY) (// SUBJ) MIGHT ($ WANT) (// OBJ)(// QMARK)) + (WHEN DID (// SUBJ) FIRST ($ WANT) (// OBJ)(// QMARK)) + (HAVE YOU EVER GOTTEN (// OBJ)(// QMARK)) )) + +(SETQ WANT '( (WANT) (DESIRE) (WISH) (WANT) (HOPE) )) + +(SETQ SHORTLST + '((CAN YOU ELABORATE ON THAT?) + (($ PLEASE) CONTINUE/.) + (GO ON/, DON/'T BE AFRAID/.) + (YOU/'RE BEING A BIT BRIEF/, ($ PLEASE) GO INTO DETAIL/.) + (CAN YOU BE MORE EXPLICIT?) + (($ PLEASE) YOU GO INTO MORE DETAIL?) + (YOU AREN/'T BEING VERY TALKATIVE TODAY!) + (WHY MUST YOU RESPOND SO BRIEFLY?))) + + +(SETQ FAMLST + '((TELL ME ($ SOMETHING) ABOUT (// OWNER) FAMILY (// PERIOD)) + (YOU SEEM TO DWELL ON (// OWNER) FAMILY (// PERIOD)) + (($ AREYOU) HUNG UP ON (// OWNER) FAMILY?))) + +(SETQ HUHLST + '((($ WHYSAY)(// SENT)(// QMARK)) + (IS IT BECAUSE OF ($ THINGS) THAT YOU SAY (// SENT)(// QMARK)) )) + +(SETQ FEELINGS-ABOUT + '((FEELINGS ABOUT) + (APREHENSIONS TOWARD) + (THOUGHTS ON) + (EMOTIONS TOWARD))) + +(SETQ RANDOM-ADJECTIVE + '((VIVID) + (EMOTIONALLY STIMULATING) + (RECENT) + (UNUSUAL) + (SHOCKING) + (EMBARRASSING))) + +(SETQ WHYSAY + '((WHY DO YOU SAY) + (WHAT MAKES YOU BELIEVE) + (ARE YOU SURE THAT) + (WHAT MAKES YOU THINK) )) + +(SETQ ISEE + '((I SEE /././.) + (YES/,) + (I UNDERSTAND/.) + (OH/.) )) + +(SETQ PLEASE + '((PLEASE/,) + (I WOULD APPRECIATE IT IF YOU WOULD) + (PERHAPS YOU COULD) + (PLEASE/,) + (WOULD YOU PLEASE) + (COULD YOU))) + +(SETQ SOMETHING + '((SOMETHING) + (MORE) + (HOW YOU FEEL))) + +(SETQ THINGS + '((HANGUPS YOU HAVE) + (YOUR INHIBITIONS) + (SOME PROBLEMS IN YOUR CHILDHOOD) + (THE PEOPLE YOU HANG AROUND WITH) + (PROBLEMS AT SCHOOL) + (YOUR SEX LIFE) + (YOUR HANGUPS) + (SOME PROBLEMS AT HOME))) + +(SETQ DESCRIBE + '((DESCRIBE) + (TELL ME ABOUT) + (DISCUSS) + (ELABORATE ON))) + +(SETQ IBELIEVE + '((I BELIEVE) (I THINK) (I HAVE A FEELING) (IT SEEMS TO ME THAT))) + +(SETQ PROBLEMS '( (PROBLEMS) + (INHIBITIONS) + (HANGUPS) + (ANXIETIES) + (FRUSTRATIONS) )) + +(SETQ BOTHER + '((DOES IT BOTHER YOU THAT) + (ARE YOU ANNOYED THAT) + (DID YOU EVER REGRET) + (ARE YOU SATISFIED WITH THE FACT THAT))) + +(SETQ MACHLST + '((YOU HAVE YOUR MIND ON (// FOUND)(// COMMA) IT SEEMS/.) + (YOU SHOULD TRY TAKING YOUR MIND OFF OF (// FOUND)(// PERIOD)) + (ARE YOU A COMPUTER HACKER?))) + +(SETQ QLIST + '((I/'LL ASK THE QUESTIONS/, IF YOU DON/'T MIND!) + (($ PLEASE) ALLOW ME TO DO THE QUESTIONING/.) + (($ PLEASE) TRY TO ANSWER THAT QUESTION YOURSELF/.))) + +(SETQ ELIST + '((($ PLEASE) TRY TO CALM YOURSELF/.) + (YOU SEEM VERY EXCITED/. RELAX/. ($ PLEASE) ($ DESCRIBE) ($ THINGS)) + (YOU/'RE BEING VERY EMOTIONAL/. CALM DOWN/.))) + +(SETQ FOULLST + '((($ PLEASE) WATCH YOUR TONGUE!) + (($ PLEASE) AVOID SUCH UNWHOLESOME THOUGHTS) + (SUCH LEWDNESS IS NOT APPRECIATED/.))) + +(SETQ DEATHLST + '((THIS IS NOT A HEALTHY WAY OF THINKING/.) + (($ BOTHER) YOU/, TOO/, MAY DIE SOMEDAY?) + (I AM WORRIED BY YOUR OBSSESSION WITH THIS TOPIC!) + (DID YOU WATCH A LOT OF CRIME AND VIOLENCE ON TELEVISION AS A CHILD?)) +) + +(SETQ SEXLST + '((($ AREYOU) ($ AFRAIDOF) SEX?) + (($ DESCRIBE)($ SOMETHING) ABOUT YOUR SEXUAL HISTORY/.) + (($ PLEASE)($ DESCRIBE) YOUR SEX LIFE/././.) + (($ DESCRIBE) YOUR ($ FEELINGS-ABOUT) YOUR SEXUAL PARTNER/.) + (($ DESCRIBE) YOUR MOST ($ RANDOM-ADJECTIVE) SEXUAL EXPERIENCE/.) + (($ AREYOU) SATISFIED WITH (// LOVER) /././.?))) + +(SETQ NEGLST + '((WHY NOT?) + (($ BOTHER) I ASK THAT?) + (WHY NOT?) + (WHY NOT?) + (HOW COME?) + (($ BOTHER) I ASK THAT?))) + +(SETQ BECLST '( + (IS IT BECAUSE (// SENT) THAT YOU CAME TO ME?) + (($ BOTHER)(// SENT)(// QMARK)) + (WHEN DID YOU FIRST KNOW THAT (// SENT)(// QMARK)) + (IS THE FACT THAT (// SENT) THE REAL REASON?) + (DOES THE FACT THAT (// SENT) EXPLAIN ANYTHING ELSE?) + (($ AREYOU)($ SURE)(// SENT)(// QMARK) ) )) + +(SETQ SHORTBECLST '( + (($ BOTHER) I ASK YOU THAT?) + (THAT/'S NOT MUCH OF AN ANSWER!) + (($ INTER) WHY WON/'T YOU TALK ABOUT IT?) + (SPEAK UP!) + (($ AREYOU) ($ AFRAIDOF) TALKING ABOUT IT?) + (DON/'T BE ($ AFRAIDOF) ELABORATING/.) + (($ PLEASE) GO INTO MORE DETAIL/.))) + +(SETQ THLST '( + (($ MAYBE)($ THINGS)($ ARERELATED) THIS/.) + (IS IT BECAUSE OF ($ THINGS) THAT YOU ARE GOING THRU ALL THIS?) + (HOW DO YOU RECONCILE ($ THINGS)(// QMARK) ) + (($ MAYBE) THIS ($ ISRELATED)($ THINGS)(// QMARK)) )) + +(SETQ REMLST '( (EARLIER YOU SAID ($ HISTORY)(// QMARK)) + (YOU MENTIONED THAT ($ HISTORY)(// QMARK)) + (($ WHYSAY)($ HISTORY)(// QMARK) ) )) + +(SETQ TOKLST + '((IS THIS HOW YOU RELAX?) + (HOW LONG HAVE YOU BEEN SMOKING GRASS?) + (($ AREYOU) ($ AFRAIDOF) OF BEING DRAWN TO USING HARDER STUFF?))) + +(SETQ STATES + '((DO YOU GET (// FOUND) OFTEN?) + (DO YOU ENJOY BEING (// FOUND)(// QMARK)) + (HOW OFTEN ($ AREYOU)(// FOUND)) + (WHEN WERE YOU LAST (// FOUND)(// QMARK)))) + +(SETQ REPLIST + '(I (YOU) + MY (YOUR) + ME (YOU) + YOU (ME) + YOUR (MY) + MINE (YOURS) + YOURS (MINE) + OUR (YOUR) + OURS (YOURS) + WE (YOU) + DUNNO (DO NOT KNOW) + YES (/) + NO/, (/) + YES/, (/) + YA (I) + WANNA (WANT TO) + GOTTA (HAVE TO) + GONNA (GOING TO) + NEVER (DOES NOT EVER) + DOESN/'T (DOES NOT) + DON/'T (DO NOT) + AREN/'T (ARE NOT) + ISN/'T (IS NOT) + WON/'T (WILL NOT) + CAN/'T (CANNOT) + HAVEN/'T (HAVE NOT) + I/'M (YOU ARE) + OURSELVES (YOURSELVES) + MYSELF (YOURSELF) + YOURSELF (MYSELF) + YOU/'RE (I AM) + YOU/'VE (I HAVE) + I/'VE (YOU HAVE) + I/'LL (YOU WILL) + YOU/'LL (I SHALL) + I/'D (YOU WOULD) + YOU/'D (I WOULD) + HERE (THERE) + PLEASE (/) + OH/, (/) + OH (/) + SHOULDN/'T (SHOULD NOT) + WOULDN/'T (WOULD NOT) + WON/'T (WILL NOT) + HASN/'T (HAS NOT))) + +(DEFUN REPLACE (SENT RLIST) + (PROG (TEMP FOO) + AGAIN + (COND ((NULL SENT)(RETURN TEMP))) + (SETQ FOO (MEMQ (KAR SENT) RLIST)) + (SETQ FOO (COND (FOO (CADR FOO)) + (T (LIST (KAR SENT))))) + (SETQ TEMP (CONCAT TEMP FOO)) + (SETQ SENT (KDR SENT)) + (GO AGAIN))) + +(SETQ EOF -1.) + +(DEFUN FILEINPUTCHECK () + (AND + (ERRSET (IOTA ((STREAM (LIST '(DSK KMP) (STATUS UNAME) 'DOX))) + (DO ((C (TYI STREAM EOF) (TYI STREAM EOF)) + (L ())) + ((= C EOF) + (SETQ FILEINPUT (IMPLODE (NREVERSE L))) + (DELETEF STREAM)) + (COND ((NOT (OR (= C 3.) (= C 0.) (= C 12.))) + (PUSH C L))))) + NIL) + 'FILETYPEOUT)) + +(DEFUN WHEREGO (SENT) + (COND ((NULL SENT)(OR (FILEINPUTCHECK) ($ WHEREOUTP))) + ((NULL (MEANING (KAR SENT))) + (WHEREGO (KDR SENT))) + (T (PROGN (SETQ FOUND (KAR SENT)) + (MEANING (KAR SENT)))))) + +(DEFUN PART (LST NUM) + (COND ((ATOM LST) LST) + ((GREATERP NUM (LENGTH LST)) NIL) + ((LESSP NUM 2)(KAR LST)) + (T (PART (KDR LST)(SUB1 NUM))))) + +(DEFUN INDEX (LST ELEM) + (COND ((NOT (MEMQ ELEM LST)) 0) + (T (+ (- (LENGTH LST) + (LENGTH (MEMQ ELEM LST))) + 1)))) + +(DEFUN SVO (SENT KEY TYPE MEM) + (PROG (FOO) + (SETQ FOO (MEMQ (PART SENT (- (INDEX SENT KEY) TYPE)) SENT)) + (SETQ MEM (AND (SUBJSEARCH SENT KEY TYPE) MEM)) + V (SETQ FOO (KDR FOO)) + (COND ((VERBP (KAR FOO))(SETQ VERB (KAR FOO))) + ((NULL (KDR FOO))(SETQ VERB (KAR FOO))) + (T (GO V)) ) + (SETQ OBJ (GETNOUN (KDR FOO))) + (COND ((EQUAL OBJECT 'I)(SETQ OBJECT 'ME)) + ((EQUAL SUBJ 'ME)(SETQ SUBJ 'I))) + (COND (MEM (REMEMBER (LIST SUBJ VERB OBJ)))) )) + +(DEFUN POSSESS (SENT KEY) + (PROG (COUNT) + (SETQ COUNT (INDEX SENT KEY)) + (COND ((EQUAL COUNT 1)(SETQ OWNER 'YOUR)) + (T (PROG (TEMP)(SETQ OWNER (PART SENT (SUB1 COUNT))) + (SETQ TEMP (EXPLODE OWNER)) + (COND ((AND (NOT + (EQUAL 'S (PART TEMP + (LENGTH TEMP)))) + (NOT (EQUAL OWNER 'MY)) + (NOT (EQUAL OWNER 'HER)) + (NOT (EQUAL OWNER 'THEIR))) + (SETQ OWNER 'YOUR)))))))) + +(SETQ LINEL (LINEL TYO)) + +(DEFUN TXTYPE(A) + (TERPRI) + (WHILE (NOT A) + (COND ((> (+ (FLATC (KAR A)) (CHARPOS T) -2.) LINEL) + (TERPRI))) + (PRINC (KAR A)) + (PRINC SPACE) + (SETQ A (CDR A))) + (TERPRI)) + +(DEFUN LIST1 (X)(COND ((ATOM X)(COND ((NULL X) NIL)(T (LIST X))))(T X))) + +(DEFUN BUILD (STR1 STR2) + (COND ((NULL STR1) STR2)((NULL STR2) STR1) + ((AND (ATOM STR1) + (ATOM STR2)) + (IMPLODE (CONCAT (EXPLODEC STR1)(EXPLODEC STR2)))) + (T NIL))) + +(DEFUN CONCAT (X Y) + (COND ((NULL X)(COND ((NULL Y) NIL)(T (LIST1 Y)))) + ((NULL Y)(LIST1 X)) + ((ATOM X)(COND ((ATOM Y)(LIST1 X Y))(T (APPEND (LIST1 X) Y)))) + ((ATOM Y)(APPEND X (LIST1 Y))) + (T (APPEND X Y)))) + + +(DEFUN ASSM(PROTO) + (COND ((NULL PROTO) NIL) + ((ATOM (KAR PROTO)) + (CONS (KAR PROTO) (ASSM (KDR PROTO)))) + (T (CONCAT (UNIX-EVAL (KAR PROTO))(ASSM (KDR PROTO)))))) + +(DEFUN // (X) X) + +(SETQ HOWDYFLAG NIL) + +(DEFUN DOC nargs + (SETQ OBSERVATION-LIST ()) + (COND ((ATOM (ERRSET + (PROG (LINCOUNT REPETITIVE-SHORTNESS **MAD**) + (SETQ REPETITIVE-SHORTNESS (CONS 0. 0.)) + (TTY-OFF) + (SETQ LINCOUNT 0.) + (COND ((zerop nargs) + (TYPE '(I AM THE PSYCHIATRIST/. ($ PLEASE) + ($ DESCRIBE) YOUR ($ PROBLEMS)(// PERIOD))) )) + (SETQ LOVER '(YOUR PARTNER)) + (SETQ SUBJ NIL VERB NIL OBJ NIL OBJECT NIL HISTORY NIL + FOUND NIL SENT NIL OWNER NIL) +TOP (SETQ LINCOUNT (1+ LINCOUNT)) + (SETQ BAK SENT) + (SETQ SENT (TXREAD)) + (COND + ((EQUAL SENT '(FOO)) + (TYPE '(BAR! ($ PLEASE)($ CONTINUE))) + (GO TOP)) + ((OR (MEMBER SENT '((GOOD BYE) (SEE YOU LATER) (I QUIT) (SO LONG) + (GO AWAY) (GET LOST))) + (MEMQ (KAR SENT) + '(BYE HALT BREAK QUIT DONE EXIT GOODBYE + BYE/, STOP PAUSE GOODBYE/, STOP PAUSE))) + (TTY-ON) + (RETURN 'GOOD-BYE)) + ((EQUAL (KAR SENT) 'WHATMEANS) (PROGN (DEF (CADR SENT))(GO TOP))) + ((EQUAL SENT '(PARSE)) (PROGN + (TYPE (LIST 'SUBJ '= SUBJ COMMA SPACE SPACE + 'VERB '= VERB NEWLINE + 'OBJECT 'PHRASE '= OBJ + COMMA + 'NOUN 'FORM '= OBJECT NEWLINE + 'CURRENT 'KEYWORD 'IS FOUND + COMMA SPACE + 'MOST 'RECENT 'POSSESSIVE + 'IS OWNER NEWLINE + 'SENTENCE 'USED 'WAS + '/././. + '(// BAK)))(GO TOP))) + ((EQUAL (KAR SENT) 'FORGET) (PROGN (SET (CADR SENT) NIL) + (TYPE '(($ ISEE)($ PLEASE) + ($ CONTINUE)(// PERIOD) )) + (GO TOP))) + ((DEFQ SENT) (DEFINE SENT FOUND))) + (COND ((GREATERP (LENGTH SENT) 12)(SHORTEN SENT))) + (COND ((EQUAL SENT '(DDT))(VALRET '|:YOU CAN TALK TO DDT:VK |) + (TYPE '(($ PLEASE)($ CONTINUE) DISCUSSING YOUR ($ PROBLEMS)))(GO TOP)) +) + (SETQ SENT (CORRECT-SPELLING (REPLACE SENT REPLIST))) + (COND ((AND (NOT (MEMQ 'ME SENT))(NOT (MEMQ 'I SENT)) + (MEMQ 'AM SENT))(SETQ SENT (REPLACE SENT '(AM (ARE)))))) + (COND ((LESSP (LENGTH SENT) 2) + (COND ((EQ (MEANING (CAR SENT)) 'HOWDY) + (GO HOWDY))) + (GO SHORT))) + (COND ((MEMQ 'AM SENT)(SETQ SENT (REPLACE SENT '(ME (I)))))) + (FIXUP) + (COND ((AND (EQ (CAR SENT) 'DO) (EQ (CADR SENT) 'NOT)) + (COND ((ZEROP (RANDOM 3.)) + (TYPE '(ARE YOU ($ AFRAIDOF) THAT?)) + (GO TOP)) + ((ZEROP (RANDOM 2.)) + (TYPE '(DON/'T TELL ME WHAT TO DO/. I AM THE + PSYSCHIATRIST HERE!)) + (GO RTHING)) + (T + (TYPE '(($ WHYSAY) THAT I SHOULDN/'T (CDDR SENT) + (// QMARK))) + (GO TOP))))) +GOTOIT (GO (WHEREGO SENT)) +DESIRE1 + (GO ($ WHEREOUTP)) +FILETYPEOUT + (CURSORPOS 'A) + (PRINC FILEINPUT) + (CURSORPOS 'A) + (GO TOP) +HUH (TYPE ($ HUHLST)) + (GO TOP) +RTHING (TYPE ($ THLST)) + (GO TOP) +REMEM (COND ((NULL HISTORY)(GO HUH)) ) + (TYPE ($ REMLST)) + (GO TOP) +HOWDY (COND ((NOT HOWDYFLAG) + (TYPE '(($ HELLO) WHAT BRINGS YOU TO SEE ME?)) + (SETQ HOWDYFLAG T)) + (T + (TYPE '(($ IBELIEVE) WE/'VE INTRODUCED OURSELVES ALREADY/.)) + (TYPE '(($ PLEASE) ($ DESCRIBE) ($ THINGS) (// PERIOD))))) + (GO TOP) +WHEN (COND ((LESSP (LENGTH (MEMQ FOUND SENT)) 3)(GO SHORT)) ) + (SETQ SENT (KDR (MEMQ FOUND SENT))) + (FIXUP) + (TYPE '(($ WHATWHEN)(// SENT)(// QMARK))) + (GO TOP) +CONJ (COND ((LESSP (LENGTH (MEMQ FOUND SENT)) 4)(GO SHORT)) ) + (SETQ SENT (KDR (MEMQ FOUND SENT))) + (FIXUP) + (COND ((EQUAL (KAR SENT) 'OF) + (TYPE '(ARE YOU ($ SURE) THAT IS THE REAL REASON?)) + (SETQ THINGS (CONS (KDR SENT) THINGS)) + (GO TOP) )) + (REMEMBER SENT) + (TYPE ($ BECLST)) + (GO TOP) +SHORT (COND ((= (CAR REPETITIVE-SHORTNESS) (1- LINCOUNT)) + (RPLACD REPETITIVE-SHORTNESS (1+ (CDR REPETITIVE-SHORTNESS)))) + (T + (RPLACD REPETITIVE-SHORTNESS 1.))) + (RPLACA REPETITIVE-SHORTNESS LINCOUNT) + (COND ((> (CDR REPETITIVE-SHORTNESS) 6.) + (COND ((NOT **MAD**) + (TYPE '(($ AREYOU) JUST TRYING TO SEE WHAT KIND OF THINGS + I HAVE IN MY VOCABULARY? PLEASE TRY TO + CARRY ON A REASONABLE CONVERSATION!)) + (SETQ **MAD** T) + (GO TOP)) + (T + (TYPE '(I GIVE UP/. YOU NEED A LESSON IN CREATIVE + WRITING /././.)) + (TTY-ON) + (PUSH MONOSYLLABLES OBSERVATION-LIST) + (RETURN 'I-QUIT))))) + (COND ((EQUAL SENT (ASSM '(YES))) + (TYPE '(($ ISEE) ($ INTER) ($ WHYSAY) THIS IS SO?))) + ((EQUAL SENT (ASSM '(BECAUSE))) + (TYPE ($ SHORTBECLST))) + ((EQUAL SENT (ASSM '(NO))) + (TYPE ($ NEGLST))) + (T (TYPE ($ SHORTLST)))) + (GO TOP) +ALCOHOL (TYPE ($ DRNK))(GO TOP) +LOVE LOVES +DESIRE (SETQ FOO (MEMQ FOUND SENT)) + (COND ((LESSP (LENGTH FOO) 2)(GO (BUILD (MEANING FOUND) 1))) + ((NOT (EQ (CADR FOO) 'TO))(GO (BUILD (MEANING FOUND) 1)) ) ) + (SVO SENT FOUND 1 NIL) + (REMEMBER (LIST SUBJ 'WOULD 'LIKE OBJ)) + (TYPE ($ WHYWANT)) (GO TOP) +DRUG (TYPE ($ DRUGS))(REMEMBER (LIST 'YOU 'USED FOUND))(GO TOP) +TOKE (TYPE ($ TOKLST))(GO TOP) +STATE (TYPE ($ STATES))(REMEMBER (LIST 'YOU 'WERE FOUND))(GO TOP) +MOOD (TYPE ($ MOODS))(REMEMBER (LIST 'YOU 'FELT FOUND))(GO TOP) +FEAR (SETQ FOUND (SETPREP SENT FOUND)) + (TYPE ($ FEARS))(REMEMBER (LIST 'YOU 'WERE 'AFRAID 'OF FOUND))(GO TOP) +HATE (SVO SENT FOUND 1 T) + (COND ((MEMQ 'NOT SENT) (FORGET) (GO HUH) )) + (COND ((EQUAL SUBJ 'YOU)(TYPE '(WHY DO YOU (// VERB)(// OBJ)(// QMARK) +))) + (T (TYPE '(($ WHYSAY)(LIST SUBJ VERB OBJ))))) + (GO TOP) +SYMPTOMS (TYPE '(($ MAYBE) YOU SHOULD CONSULT A DOCTOR OF MEDICINE/, + I AM A PSYCHIATRIST)) + (GO TOP) +HATES (SVO SENT FOUND 1 T) + (TYPE '(($ WHYSAY)(LIST SUBJ VERB OBJ))) + (GO TOP) +LOVES1 + (SVO SENT FOUND 1 T) +QLOVES (TYPE '(($ BOTHER)(LIST SUBJ VERB OBJ))) + (GO TOP) +LOVE1 (SVO SENT FOUND 1 T) + (COND ((MEMQ 'NOT SENT) (FORGET) (GO HUH) )) + (COND ((EQUAL OBJECT 'SOMETHING) + (SETQ OBJECT '(THIS PERSON YOU LOVE)))) + (COND ((EQUAL SUBJ 'YOU)(PROGN (SETQ LOVER OBJECT) + (COND ((EQUAL LOVER '(THIS PERSON YOU LOVE)) + (SETQ LOVER '(YOUR PARTNER)) + (FORGET) + (TYPE '(WITH WHOM ARE YOU IN LOVE?)) + (GO TOP))) + (TYPE '(($ PLEASE) + ($ DESCRIBE) + ($ RELATION) + (// LOVER) + (// PERIOD) )) )) + ((EQUAL SUBJ 'I) + (TXTYPE '(WE WERE DISCUSSING YOU!))) + (T (FORGET) + (SETQ OBJ 'SOMEONE) + (SETQ VERB (BUILD VERB 'S)) + (GO QLOVES) ) ) + (GO TOP) +MACH (SETQ FOUND (PLURAL FOUND)) + (TYPE ($ MACHLST)) + (GO TOP) +SEXNOUN SEXVERB + (COND ((OR (MEMQ 'ME SENT)(MEMQ 'MYSELF SENT)(MEMQ 'I SENT)) + (GO FOUL) )) + (TYPE ($ SEXLST))(GO TOP) +DEATH (TYPE ($ DEATHLST)) + (GO TOP) +FOUL (TYPE ($ FOULLST)) + (GO TOP) +FAMILY (POSSESS SENT FOUND) + (TYPE ($ FAMLST)) + (GO TOP) + ) + T ))(DOC)) + (T + (TERPRI TYO) + (PRINC '|MY SECRETARY WILL SEND YOU A BILL.| TYO) + (TERPRI TYO) + (SUICIDE)))) + + +(SETQ WHEREOUTP '( HUH REMEM RTHING ) ) + +(DEFUN $ FEXPR (WHAT) + (PROG (VV FIRST) + (SETQ VV (UNIX-EVAL (CAR WHAT))) + (SETQ FIRST (KAR VV)) + (SETQ VV (APPEND (KDR VV)(LIST FIRST))) + (SET (CAR WHAT) VV) + (RETURN FIRST) )) + + + +(DEFUN CHARBAK (A P) + (COND ((EQUAL TTY 9.) + (COND ((NOT A) + (PRINC (ASCII 7.))) + (T (CURSORPOS 'X TYO)))) + (T (COND ((NOT A) (PRINC (ASCII 7.))) + (P (PRINC (ASCII A))) + (T (PRINC '\) + (PRINC (ASCII A))))))) + + +(SETQ FOO + (SYSCALL 3 'TTYGET TYI)) ;GET THE ORIGINAL DATA + +(COND ((MEMQ (STATUS UNAME) '(KMP EJS CGR ERIC RWK TNP TURNIP)) + (SETQ KMPMODE T)) + (T (SETQ KMPMODE NIL))) + +(COND (KMPMODE + (SETQ *RSET T) + (SETQ ERRLIST '((TTY-ON) + (TERPRI) + (PRINC (ASCII 7.)) + (PRINC '|>*BEEP*<|))) + (SETQ EXIT '(LAMBDA () (^G))) + (DEFPROP DEBUG ((MC RWK) DEBUG) AUTOLOAD)) + (T + (SETQ ERRLIST '((TERPRI) + (PRINC (ASCII 7.)) + (DOC))) + (SSTATUS TTYINT 2. 7.) + (SSTATUS TTYINT 4. NIL) + (SSTATUS TTYINT 17. 7.) + (SSTATUS TTYINT 19. NIL) + (SSTATUS TTYINT 23. NIL) + (SSTATUS TTYINT 24. 7.) + (SETQ EXIT 'QUIT))) + + +(SSTATUS FEATURE NOLDMSG) +(SETQ IBASE 10. BASE 10.) +(SETQ LINEL 78.) + +;;; +;;; The following are library functions necessary to this program +;;; + +(DEFUN MEMLIST (X Y) + (APPLY 'OR (MAPCAR (FUNCTION (LAMBDA (X) (LIST 'QUOTE (MEMQ X Y)))) + X))) +(SETQ SMALL-LETTERS (EXPLODEC '|abcdefghijklmnopqrstuvwxyz|)) + +(DEFUN CAPS (X) (CAR (EXPLODEN (KAPS (ASCII X))))) + +(DEFUN KAPS (X) + (COND + ((MEMQ X SMALL-LETTERS) + (CDR (ASSOC X '((|a| . A)(|b| . B)(|c| . C)(|d| . D) + (|e| . E)(|f| . F)(|g| . G)(|h| . H) + (|i| . I)(|j| . J)(|k| . K)(|l| . L) + (|m| . M)(|n| . N)(|o| . O)(|p| . P) + (|q| . Q)(|r| . R)(|s| . S)(|t| . T) + (|u| . U)(|v| . V)(|w| . W)(|x| . X) + (|y| . Y)(|z| . Z))))) + (T X))) + +;;; +;;; The function build will take a two atoms and build them together +;;; like implode, but will not ignore multiple characters like implode +;;; would. +;;; + +(DEFUN BUILD (X Y) + (COND ((NOT (ATOM X)) + (TERPRI) + (PRINC + '|Error: First arg to BUILD not an atom. It will be ignored.| +) + (PRINC X) + (BUILD NIL Y)) + ((NOT (ATOM Y)) + (TERPRI) + (PRINC + '|Error: 2nd arg to BUILD not an atom. It will be ignored.|) + (PRINC Y) + (BUILD X NIL)) + ((NULL X) Y) + ((NULL Y) X) + (T (IMPLODE (APPEND (DELETE '/| (DELETE '// (EXPLODE X))) + (DELETE '/| (DELETE '// (EXPLODE Y)))))))) + +;;; +;;; The ADDPROP function will add an item to the list in the property +;;; slot desginated in the arg-list. +;;; + +(DEFUN ADDPROP (ATOM-NAME NEW-PROP PROP-NAME) + (PROG (OLD-PROP) + (SETQ OLD-PROP (GET ATOM-NAME PROP-NAME)) + (COND ((NULL NEW-PROP) NIL) + ((NULL OLD-PROP) + (PUTPROP ATOM-NAME (LIST NEW-PROP) PROP-NAME)) + ((ATOM OLD-PROP) + (PUTPROP ATOM-NAME (LIST NEW-PROP OLD-PROP) PROP-NAME)) + (T (PUTPROP ATOM-NAME + (CONS NEW-PROP OLD-PROP) + PROP-NAME))))) + + + +(DEFUN TTY-OFF () + (SYSCALL 0 'TTYSET + TYI + (BOOLE 1 (CAR FOO) 3272356035.) + (BOOLE 1 (CADR FOO) 3272356035.))) + +(DEFUN TTY-ON () + (SYSCALL 0 'TTYSET + TYI + (CAR FOO) + (CADR FOO))) + + +(SETQ S-QUOTE '/') +(SETQ OPEN-QUOTES '/'/') +(SETQ CLOSE-QUOTES '/`/`) +(SETQ SPACE '/ ) +(SETQ COMMA '/,) +(SETQ PERIOD '/./ ) +(SETQ SEMICOLON '/;) +(SETQ EXCLAM '!/ ) +(SETQ DOTDOTDOT '/./././ ) +(SETQ EXCLAM-3 '!!!/ ) +(SETQ COLON ':/ ) +(SETQ QMARK '?/ ) +(SETQ HYPHEN '-) +(SETQ NEWLINE (ASCII 13.)) +(SETQ TAB (ASCII 9.)) + +(DEFUN NON-PUNCTUATION (X) (NOT (PUNCTUATION X))) + +(DEFUN PUNCTUATION (X) (MEMQ X (LIST + COMMA SPACE PERIOD HYPHEN S-QUOTE DOTDOTDOT + QMARK COLON SEMICOLON EXCLAM EXCLAM-3 + OPEN-QUOTES CLOSE-QUOTES))) + +;;; +;;; The line-read function will read line by line, allowing deletes and +;;; printing deleted regions backwards between backslashes ... It will +;;; exit upon reading of either a double-carriage return or a carriage +;;; return preceded by a period, exclamation mark, or a question mark. +;;; + +(declare (special *echostream*)) + +(setq *echostream* tyo) + +(DEFUN LINE-READ () + (PROG (LINE C B P A TEMP) + (SETQ P NIL) + TOP (SETQ C (CAPS (TYI TYI))) + R1 (COND ((EQUAL C 9.) (SETQ C 32.)) + ((AND (GREATERP C 64.) + (LESSP C 91.) + (EQ B 45.)) + (SETQ LINE (APPEND LINE (LIST 45.)))) + ((EQUAL C 10.) (SETQ C 13.))) + (COND ((OR (EQUAL C 127.) (EQUAL C 8.)) ;RUBOUT (BACKSPACE) + (SETQ LINE (CHAR-RUBOUT LINE)) + (SETQ A (GET 'CHAR-RUBOUT 'CHAR)) + (CHARBAK A P) + (SETQ P T) + (SETQ B (CAR (LAST LINE))) + (GO TOP))) + (COND ((EQUAL C 12.) ;CONTROL-L + (TERPRI) + (CURSORPOS 'C TYO) + (PRINC (IMPLODE LINE)) + (SETQ P NIL) + (GO TOP)) + ((EQUAL C 27.) + (PRINC (ASCII 7.)) + (GO TOP)) + ((AND (NOT (EQUAL TTY 9.)) P) + (PRINC '\) + (SETQ P NIL))) + (COND ((OR (MEMBER C '(18. 21. 13. 11. 4.)) + (GREATERP C 26.)) + (and *echostream* (PRINC (ASCII C) *echostream*)))) + (COND ((EQUAL C 46.) + (SETQ LINE (APPEND LINE (LIST 46.))) + (GO OUTCHECK)) + ((EQUAL C 33.) + (SETQ LINE (APPEND LINE (LIST 33.))) + (GO OUTCHECK)) + ((EQUAL C 63.) + (COND ((NULL LINE) + (SETQ LINE (LIST 87. 72. 65. 84. 63.))) + (T (SETQ LINE (APPEND LINE (LIST 63.))))) + (GO OUTCHECK)) + ((EQUAL C 13.) + (COND ((EQUAL B 45.) ;HYPHENATION + (SETQ B (CAR (LAST LINE))) + (GO TOP))) + (SETQ B NIL) + (SETQ LINE (APPEND LINE (LIST 32.))) + (GO TOP)) + ((OR (EQUAL C 21.) (EQUAL C 4.)) ;CONTROL-U, CONTROL-D + (SETQ B NIL) + (SETQ LINE NIL) + (TERPRI TYO) + (GO TOP)) + ((OR (EQUAL C 18.) (EQUAL C 11.)) ;CONTROL-R, CONTROL-K + (TERPRI) + (PRINC (IMPLODE LINE)) + (GO TOP)) + ((EQUAL C 45.) + (SETQ B 45.) + (GO TOP)) + ((AND (LESSP C 58.) ;RECOVER MINUS + (GREATERP C 47.) ;SIGN FOR NUMBERS + (EQUAL B 45.)) + (SETQ LINE (APPEND LINE (LIST 45.))))) + BACK + (SETQ LINE (APPEND LINE (LIST C))) + (SETQ B C) + (GO TOP) + OUTCHECK + (COND ((NULL LINE) (GO TOP)) ;NO TEXT + (T (RETURN LINE))))) + + +(DEFUN CHAR-RUBOUT (CHAR-LIST) ;Helping function + (COND ((NULL CHAR-LIST) ;for LINE-READ + (PUTPROP 'CHAR-RUBOUT NIL 'CHAR) + NIL) + ((ATOM CHAR-LIST) (ERR)) + ((NULL (CDR CHAR-LIST)) + (PUTPROP 'CHAR-RUBOUT (CAR CHAR-LIST) 'CHAR) + NIL) + (T (APPEND (LIST (CAR CHAR-LIST)) + (CHAR-RUBOUT (CDR CHAR-LIST)))))) + + +;;; +;;; The following functions will read a set of input and parse it into +;;; a list of sentences +;;; + +(DEFUN PARSE-READ () (PARSE-INPUT (LINE-READ))) + +(DEFUN PARSE-INPUT (LINE) + (PROG2 (PUTPROP 'SENTENCE NIL 'TYPE) + (REVERSE (CDR (DO ((WORD (PARSE-WORD LINE) (PARSE-WORD LINE)) + (PARAGRAPH (NCONS NIL)) + (A NIL)) + ((NULL WORD) PARAGRAPH) + (SETQ A (GET 'WORD-BREAK 'TYPE)) + (SETQ PARAGRAPH + (PARSE-PARAGRAPH A WORD PARAGRAPH))))) + (PUTPROP 'SENTENCE (REVERSE (GET 'SENTENCE 'TYPE)) 'TYPE))) + +(DEFUN PARSE-PARAGRAPH (BREAK WORD PARAGRAPH) + (COND ((EQUAL BREAK 32.) ;SPACE + (CONS + (APPEND (CAR PARAGRAPH) + WORD) + (CDR PARAGRAPH))) + ((EQUAL BREAK 63.) ;QUESTION MARK + (ADDPROP 'SENTENCE 'QUESTION 'TYPE) + (CONS NIL + (CONS (APPEND (CAR PARAGRAPH) + WORD) + (CDR PARAGRAPH)))) + ((OR (EQUAL BREAK 46.) + (EQUAL BREAK 33.) ;EXCLAM + (EQUAL BREAK 59.)) ;PERIOD/SEMICOLON + (ADDPROP 'SENTENCE 'STATEMENT 'TYPE) + (CONS NIL + (CONS (APPEND (CAR PARAGRAPH) + WORD) + (CDR PARAGRAPH)))) + ((EQUAL BREAK 44.) ;COMMA + (CONS + (APPEND (CAR PARAGRAPH) + (APPEND WORD (LIST COMMA))) + (CDR PARAGRAPH))) + ((EQUAL BREAK 58.) ;COLON + (CONS + (APPEND (CAR PARAGRAPH) + (APPEND WORD (LIST COLON))) + (CDR PARAGRAPH))))) + + +(DEFUN PARSE-WORD (LINE) + (PROG (WORD) + (SETQ WORD NIL) + (COND ((OR (NULL LINE) + (AND (EQUAL (LENGTH LINE) 1.) + (WORD-BREAK (CAR LINE)))) + (RETURN NIL))) + (DO ((C (CAR LINE) (CAR LINE)) + (L (CDR LINE) (CDR LINE))) + ((NOT (WORD-BREAK C))) + (COND ((NULL L) (RETURN NIL))) + (RPLACA LINE (CAR L)) + (RPLACD LINE (CDR L))) + (COND ((NULL LINE) (RETURN NIL))) + (DO ((C (CAR LINE) (CAR LINE)) + (L (CDR LINE) (CDR LINE))) + ((WORD-BREAK C)) + (SETQ WORD (CONS C WORD)) + (COND ((NULL L) (RETURN NIL))) + (RPLACA LINE (CAR L)) + (RPLACD LINE (CDR L))) + (RETURN (LIST (IMPLODE (REVERSE WORD)))))) + +(DEFUN WORD-BREAK (X) + (PUTPROP 'WORD-BREAK X 'TYPE) + (COND ((OR (EQUAL X 32.) ;SPACE + (EQUAL X 33.) ;EXCLAMATION MARK + (EQUAL X 44.) ;COMMA + (EQUAL X 46.) ;PERIOD + (EQUAL X 58.) ;COLON + (EQUAL X 59.) ;SEMI-COLON + (EQUAL X 63.)) T) ;QUESTION MARK + (T NIL))) + + +(DEFUN TXREAD () + (PROG (A B) + TOP (SETQ A (DELETE COMMA (CAR (PARSE-READ)))) + (SETQ B (CAR (GET 'SENTENCE 'TYPE))) + (COND ((EQ B 'STATEMENT) + (RETURN A)) + ((EQ B 'QUESTION) + (TYPE ($ QLIST)) + (TYPE '(($ PLEASE) + ($ DESCRIBE) + ($ SOMETHING) + ABOUT + ($ THINGS) + (// PERIOD))))) + (GO TOP))) + +(DOC)) \ No newline at end of file diff --git a/src/games/eliza.(init) b/src/games/eliza.(init) new file mode 100644 index 00000000..3f6fe4c5 --- /dev/null +++ b/src/games/eliza.(init) @@ -0,0 +1,5 @@ +(comment) +(progn + (load '|dsk:games;eliza fasl|) + (close infile) + (^g)) \ No newline at end of file diff --git a/src/games/go.(init) b/src/games/go.(init) new file mode 100644 index 00000000..f17dfea8 --- /dev/null +++ b/src/games/go.(init) @@ -0,0 +1,16 @@ +(comment Setup for RKW's Go Program) + +(progn + (sstatus features noldmsg) + (setq *nopoint t) + (load '|dsk: games; go1 fasl|) + (load '|dsk: games; go2 fasl|) + (setq fasload nil) ; So no Cautions for redefined functions. + (load '|dsk: games; gobrd fasl|) + (sstatus ttyint 26. (status ttyint 2)) ; ^Z does breakpoints + (sstatus ttyint 2 '(lambda (foo bar) (print-board))) ; ^B print-board. + (princ '|RKW's Go Program...|) + (setsyntax '/ + '/ '/ ) + (start) + '||) diff --git a/src/games/guess.21 b/src/games/guess.21 new file mode 100644 index 00000000..ea9346cc --- /dev/null +++ b/src/games/guess.21 @@ -0,0 +1,105 @@ +;;; -*- Midas -*- Game idea by RAE / Code by KMP +title Guess - Guess a number + +a=:1 +b=:2 +c=:3 +ttyo=:4 +ttyi=:5 +char=:6 +where=:7 +wins=:10 + +;;; Define some helpful macros + +.insrt syseng;$call macro + +define sysc3 op,val1,val2,val3 + .call [ setz ? sixbit /op/ ? movem arg1 ? movem arg2 ? movem arg3 ((setz)) ] +termin + +define type &string + movei a,<.length string> + move b,[440700,,[ascii string]] + $call siot,[#ttyo,b,a] + .lose %lsfil +termin + +;;; Main program + +guess: $call open,[#ttyo,[sixbit/tty/]][][#.uao\%tjdis] + .lose %lsfil + + $call open,[#ttyi,[sixbit/tty/]][][#.uai] + .lose %lsfil + + movei where,[ jrst death ] + + setz wins, + +;(SYSCALL 0 'TTYSET TYO ; bit 3.2 (%TSSII) of TTYSTS +; (CAR (STATUS TTY)) (CADR (STATUS TTY)) +; (BOOLE 7 1_19. (CADDR (STATUS TTY)))) + + $call ttyget,[#ttyi][a,b,c] + jrst suicide + ior c,[2,,] + $call ttyset,[#ttyi,a,b,c] + jrst suicide + type "AAre you thinking of a number? " + jrst win2 + +askhim: type "AOk. Is your number 7? " + movei where,die +ask1: .iot ttyi,char ; Read a char + andi char,137 ; Uppercase + cain char,"Y ; If a y, ... + jrst win ; We win + cain char,"N ; If an n, ... + jrst askhim ; Loop + caie char,"Q ; If a q, ... + cain char,^Q ; or control-q + jrst [ type "AYou can't quit.AIs your number 7? " + jrst ask1 ] + cain char,^Z + jrst [ type "AYou can't Control-Z out!AIs your number 7? " + jrst ask1 ] + cain char,^G + jrst [ type "AYou can't ^G out ... I'm going to win.AIs your number 7? " + jrst ask1 ] + type " (Y or N) " ; Give help + jrst ask1 ; and loop + +win: aos wins, ; Count wins + type "AI win..." ; Rub it in +win1: type "Want to play again? " ; Maybe new round +win2: .iot ttyi,char ; Read a char + andi char,137 ; Uppercase + cain char,"Y ; If a y, ... + jrst askhim ; Start over + cain char,"N ; If an n, ... + jrst @where ; Die + type " (Y or N) " ; Give help + jrst win2 ; and loop + +die: cain wins,1 + jrst [ type "ABeat you today, huh?" + jrst death ] + cain wins,2 + jrst [ type "ATwo for me and *none* for you ..." + jrst death ] + cain wins,3 + jrst [ type "AHey, I'm getting pretty good at this. Won 3 of 3" + jrst death ] + caig wins,5 + jrst [ type "AYou're just not winning!" + jrst death ] + type "AYou'd probably win more if you didn't pick 7" + +death: type "ABetter luck next time...A" + .logout 1, ; Kill job + +suicid: type "AUnknown error. Please report this.A" + jrst death + +end guess \ No newline at end of file diff --git a/src/games/lsrrtn.1 b/src/games/lsrrtn.1 new file mode 100644 index 00000000..1c5a514e --- /dev/null +++ b/src/games/lsrrtn.1 @@ -0,0 +1,140 @@ +title LLSRTN - LISP interface to -*-MIDAS-*- inquir lookups + +.fasl +.insrt sys:.fasl defs + +;;Set up and include the inquire database hacking routines + +lsrtns"$$ulnm==0 ;don't need last name search +lsrtns"$$ulnp==0 ;don't need abbrev l.name lookup +lsrtns"$$unam==0 ;don't need name permutation + +;;define some acs for lsrtns use +lsrtns"a==t +lsrtns"b==tt +lsrtns"c==d +lsrtns"d==r +lsrtns"e==f + +.insrt syseng;lsrtns + +;;---------------------------------------------------------------- + +;;(LSRMAP ) +;;opens up and maps in the inquir database for looking up people. +;;Returns a file object to be passed to other routines. +;;Uses GETCOR to reserve address space. Don't try this too many times +;;since the addr space isn't reused. + +.entry LSRMAP SUBR 1+1 + + jsp t,fxnv1 ;get & save # pages to use, a->tt + push fxp,tt +;; (open '|inquir;lsr1 >| '(in)) + movei a,.atom INQUIR/;LSR1/ > + movei b,.sx (IN) + call 2,.function OPEN + push p,a +;; extract I/O channel number from the file array, into TT + movei tt,f.chan + move tt,@ttsar(a) + push fxp,tt +;; get pages via getcor + move tt,-1(fxp) ;# pages + pushj p,getcor ;request addr space from Lisp + jumpe tt,corlos ;its addr is returned zero if none avbl + idivi tt,2000 ;cvt to page number + movn d,-1(fxp) ;get number of pages requested to construct + hrl tt,d ;aobjn to them +;; construct args for lsrmap + move lsrtns"b,tt ;aobjn to free page range + move lsrtns"a,(fxp) ;disk channel number +;; Get the INQUIR data base mapped in + pushj p,lsrtns"lsrmap ;try to map in the data base + jrst lsrluz ;no skip if it lost +;; I guess we won, clean up and return the file object. +opnbye: sub fxp,[2,,2] + pop p,a + popj p, + +;; Random error routines, return () instead of file obj. +corlos: +lsrluz: move a,(p) ;get the file obj + call 1,.function CLOSE ;close it + setzm (p) ;return () + jrst opnbye + +;;---------------------------------------------------------------- + +;;(LSRUNM ) +;;Returns a magic number to be passed to LSRITM, etc., or -1 if uname unknown. +;;Actually, the "magic number" is the entry's core address returned +;;by the lib subr. + +.entry LSRUNM SUBR 2+1 + + push p,cfix1 ;NCALLable! + movei tt,f.chan ;pick up disk channel number + move tt,@ttsar(a) + push fxp,tt ;and save it + move a,b ;(car (pnget 6)) + movei b,.atom #6. + call 2,.function PNGET + hlrz a,(a) + move lsrtns"b,(a) ;set up uname in 6bit for lsrunm + pop fxp,lsrtns"a ;the channel + pushj p,lsrtns"lsrunm ;get entry addr in lsrtns"b + movni lsrtns"b,1 ;-1 for loss + move tt,lsrtns"b ;move to where Lisp wants it. + popj p, + +;;---------------------------------------------------------------- + +;;(LSRITM ) +;;returns the slot of the entry returned +;;by LSRUNM. +;;This file sets the symbols I$UNAM etc to the correct values. +;;Look after this function, and in :INFO LIB LSRTNS . + +.entry LSRITM SUBR 2+1 + + jsp t,fxnv1 ;item number, a->tt + jsp t,fxnv2 ;address, b->d + push fxp,d ;save so we don't have to worry about ac corres + movem tt,lsrtns"a + pop fxp,lsrtns"b + pushj p,lsrtns"lsritm ;returns bp in lsrtns"a + skipa d,[440700,,[0]] ;unless there was no skip: use null string then + move d,lsrtns"a ;d is input bp + setz b, ;start with () +chlp: ildb tt,d ;get a char + jumpe tt,chlpx ;zero terminates + jsp t,fxcons ;turn into fixnum + call 2,.function CONS ;cons onto list + move b,a + jrst chlp ;go for another char +chlpx: move a,b ;reverse the list and atomify + call 1,.function NREVERSE + jcall 1,.function IMPLODE + +.sxeva (SETQ I$UNAM #0 ) ;UNAME +.sxeva (SETQ I$NAME #1 ) ;FULL NAME +.sxeva (SETQ I$NICK #2 ) ;NICKNAME +.sxeva (SETQ I$SSN #3 ) ;SOC SEC NUMBER +.sxeva (SETQ I$MITA #4 ) ;MIT ADDRESS +.sxeva (SETQ I$MITT #5 ) ;MIT TELEPHONE NUMBER +.sxeva (SETQ I$HOMA #6 ) ;HOME ADDRESS +.sxeva (SETQ I$HOMT #7 ) ;HOME TELEPHONE NUMBER +.sxeva (SETQ I$SUPR #10 ) ;SUPERVISOR(S) +.sxeva (SETQ I$PROJ #11 ) ;PROJECT +.sxeva (SETQ I$DIR #12 ) ;FILE DIR NAMES +.sxeva (SETQ I$AUTH #13 ) ;AUTHORIZATION +.sxeva (SETQ I$GRP #14 ) ;GROUP AFFILIATION +.sxeva (SETQ I$REL #15 ) ;RELATION TO GROUP +.sxeva (SETQ I$BRTH #16 ) ;BIRTHDAY +.sxeva (SETQ I$REM #17 ) ;REMARKS +.sxeva (SETQ I$NETA #20 ) ;NETWORK ADDRESS +.sxeva (SETQ I$ALTR #21 ) ;USER AND TIME OF LAST ALTERATION +.sxeva (SETQ I$MACH #22 ) ;ITS-S TO BE KNOWN ON. + +fasend diff --git a/src/games/lsrrtn.insert b/src/games/lsrrtn.insert new file mode 100644 index 00000000..2c4c372d --- /dev/null +++ b/src/games/lsrrtn.insert @@ -0,0 +1,135 @@ +;;; -*- LISP -*- +;;; +;;; Functions defined +;;; +;;; (OPEN-INQUIR-FILE) +;;; Must be done before these other things can happen +;;; +;;; (LOOKUP-INQUIR-INFO ) +;;; Macro to look up a certain tag in the INQUIR database +;;; +;;; (GET-USER-NAME ) +;;; +;;; SUBR returns something of the form +;;; ((last-name first-name middle-name) title lineage alias? nickname) +;;; or NIL if no such user. +;;; +;;; TITLE is one a word like [MR, MRS, ... DR, ...] (see code +;;; for currently used list) +;;; +;;; LINEAGE is one of II, III, or JR +;;; +;;; NIL is returned for unspecified elements. Alias's are tried to be +;;; traced through. If something was an alias, the ALIAS? flag is non-NIL +;;; all other info is as if it had been info about who it is an alias for. +;;; Multiple aliases should be traced through correctly. +;;; +;;; (CLOSE-INQUIR-FILE) +;;; Should be done after all LOOKUP-INQUIR-INFO's are done to +;;; close our INQUIR disk channel. +;;; + +(DEFPROP LSRMAP ((DSK games) LSRRTN FASL) AUTOLOAD) + +(DECLARE (SPECIAL *INQUIR-FILE-OBJECT*) + (*EXPR LSRMAP LSRITM LSRUNM)) + +(DEFUN OPEN-INQUIR-FILE () ; Allocate 15 pages for this map + (SETQ *INQUIR-FILE-OBJECT* (LSRMAP 15.)) + T) + +(DEFUN CLOSE-INQUIR-FILE () + (CLOSE *INQUIR-FILE-OBJECT*) + T) + +(DEFUN LOOKUP-INQUIR-INFO MACRO (FORM) + (LET (((UNAME DATA) (CDR FORM))) + `(LSRITM ',(OR (CDR (ASSQ DATA '((UNAME . 0.) + (FULL-NAME . 1.) + (NICKNAME . 2.) + (SOCIAL-SECURITY-NUMBER . 3.) + (MIT-ADDRESS . 4.) + (MIT-TELEPHONE-NUMBER . 5.) + (HOME-ADDRESS . 6.) + (HOME-TELEPHONE-NUMBER . 7.) + (SUPERVISOR . 8.) + (PROJECT . 9.) + (FILE-DIRECTORY-NAMES . 10.) + (AUTHORIZATION . 11.) + (GROUP-AFFILIATION . 12.) + (RELATION TO GROUP . 13.) + (BIRTHDAY . 14.) + (REMARKS . 15.) + (NETWORK-ADDRESS . 16.) + (LAST-ALTERATION . 17.) + (MACHINES-KNOWN-ON . 18.)))) + (ERROR '|Unknown INQUIR Keyword| DATA)) + (LSRUNM *INQUIR-FILE-OBJECT* ,UNAME)))) + +(DEFUN UNAME? (X) (AND (SYMBOLP X) + (PLUSP (LSRUNM *INQUIR-FILE-OBJECT* X)))) + +(DECLARE (*EXPR PARSE$MAKE-WORDS)) + +(DEFPROP PARSE$MAKE-WORDS ((games) PARSE FASL) AUTOLOAD) + +(DEFUN GET-USER-NAME (WHO) + (COND ((NOT (UNAME? WHO)) NIL) + (T + (LET* ((DATA (LOOKUP-INQUIR-INFO WHO FULL-NAME)) + (TOKENS (PARSE$MAKE-WORDS (EXPLODEC DATA))) + (LAST-NAME) (FIRST-NAME) (MIDDLE) (TITLE-ETC) (LINEAGE) + (ALIAS ())) + (DO () + ((NOT + (AND (EQ (CADR TOKENS) '/,) + (EQ (CAR (LAST TOKENS)) 'FOR) + (MEMQ (LOOKUP-INQUIR-INFO WHO GROUP-AFFILIATION) + '(/@ /O))))) + (SETQ ALIAS T) + (SETQ WHO (CAR TOKENS)) + (SETQ TOKENS + (PARSE$MAKE-WORDS + (EXPLODEC + (SETQ DATA + (LOOKUP-INQUIR-INFO WHO FULL-NAME)))))) + (SETQ TOKENS (DELETE '/. TOKENS)) + (COND ((SETQ TITLE-ETC (CAR (OR (MEMQ 'MR TOKENS) + (MEMQ 'MRS TOKENS) + (MEMQ 'MISS TOKENS) + (MEMQ 'MS TOKENS) + (MEMQ 'DR TOKENS)))) + (SETQ TOKENS (DELETE TITLE-ETC TOKENS)))) + (COND ((SETQ LINEAGE (CAR (OR (MEMQ 'II TOKENS) + (MEMQ 'III TOKENS) + (MEMQ 'JR TOKENS)))) + (SETQ TOKENS (DELETE LINEAGE TOKENS)))) + (COND ((NOT (MEMQ '/, TOKENS)) ; What a loser... + (POP TOKENS FIRST-NAME) + (COND ((CDR TOKENS) + (POP TOKENS MIDDLE) + (POP TOKENS LAST-NAME)) + (T + (POP TOKENS LAST-NAME)))) + ((EQ (CADR TOKENS) '/,) + (SETQ TOKENS (DELETE '/, TOKENS)) + (POP TOKENS LAST-NAME) + (POP TOKENS FIRST-NAME) + (POP TOKENS MIDDLE)) + (T + (SETQ FIRST-NAME (CADR (MEMQ '/, TOKENS))) + (SETQ LAST-NAME (DO ((L () (CONS (CAR TOKS) L)) + (TOKS TOKENS (CDR TOKS))) + ((EQ (CAR TOKS) '/,) + (IMPLODE + (MAPCAN 'EXPLODEC + (NREVERSE L)))))))) + `( (,LAST-NAME + ,FIRST-NAME + ,@(COND (MIDDLE (NCONS MIDDLE)))) + ,TITLE-ETC + ,LINEAGE + ,ALIAS + ,(LET ((NICKNAME (LOOKUP-INQUIR-INFO WHO NICKNAME))) + (COND ((EQ NICKNAME '||) NIL) + (T NICKNAME)))))))) diff --git a/src/games/parse.20 b/src/games/parse.20 new file mode 100644 index 00000000..dfe27ad9 --- /dev/null +++ b/src/games/parse.20 @@ -0,0 +1,226 @@ +;;; -*- LISP -*- + +;;; This is KMP's Word Parsing Package. +;;; +;;; The only user function is PARSE$MAKE-WORDS(Char-List) which +;;; will take a list of ascii characters and convert them into +;;; a list of words (each punctuating object being treated as a +;;; word. +;;; +;;; Supporting functions defined are: +;;; +;;; Definition Predicate Other +;;; +;;; PARSE$PUNCTUATION PARSE$PUNCTUATION? +;;; PARSE$DELIMITER PARSE$DELIMITER? +;;; PARSE$SPECIAL-CHAR PARSE$SPECIAL-CHAR? +;;; PARSE$STRAY-CHAR? +;;; PARSE$QUOTE PARSE$QUOTE? +;;; PARSE$CAPS +;;; PARSE$ALPHABETIC PARSE$ALPHABETIC? +;;; PARSE$NUMERIC? + +;;; Turn of load messages + +(SSTATUS FEATURE NOLDMSG) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;; Standard Predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; PARSE$CAPS +;;; Returns ascii->ascii or numeric->numeric capitalized character. + +(DEFUN PARSE$CAPS (X) + (COND ((NUMBERP X) + (COND ((AND (> X 96.) (< X 123.)) (- X 32.)) + (T X))) + (T + (ASCII (PARSE$CAPS (GETCHARN X 1.)))))) + +;;; PARSE$ALPHABETIC? +;;; Predicate returns T if arg represents an alpha character. Accepts +;;; ascii or numeric arg. + +(DEFUN PARSE$ALPHABETIC? (C) + (COND ((NUMBERP C) (AND (> C 64.) (< C 91.))) ; A <= C <= Z + (T (PARSE$ALPHABETIC? (GETCHARN C 1.))))) + +;;; PARSE$DIGIT? +;;; Predicate returns T if arg represents a digital character. Accepts +;;; ascii or numeric arg. + +(DEFUN PARSE$DIGIT? (N) + (COND ((NUMBERP N) (AND (> N 47.) (< N 58.))) ; 0 <= N <= 9 + (T (PARSE$DIGIT? (GETCHARN N 1.))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Punctuation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; PARSE$PUNCTUATION? +;;; Is [ascii] character punctuation? + +(DEFUN PARSE$PUNCTUATION? (X) (GET X 'PARSE$PUNCTUATION)) + +;;; PARSE$PUNCTUATION +;;; Make [ascii] character into punctuation. + +(DEFUN PARSE$PUNCTUATION (X) (PUTPROP X T 'PARSE$PUNCTUATION)) + +;;; PARSE$QUOTE? +;;; Is [ascii] character a quotation designator? + +(DEFUN PARSE$QUOTE? (X) (GET X 'PARSE$QUOTE)) + +;;; PARSE$QUOTE +;;; Make [ascii] character into quotation designator. + +(DEFUN PARSE$QUOTE (X) (PUTPROP X T 'PARSE$QUOTE)) + +;;; Make these chars into delimiters (single character objects) + +(MAPC 'PARSE$PUNCTUATION + (LIST (ASCII 33.) ; + '|''| ; (Pseudo-punctuation generated below) + (ASCII 40.) ; + (ASCII 41.) ; + (ASCII 44.) ; + '-- ; (Pseudo-punctuation generated below) + (ASCII 46.) ; + (ASCII 58.) ; + (ASCII 59.) ; + (ASCII 63.) ; + (ASCII 91.) ; + (ASCII 93.))); + +;;;;;;;;;;;;;;;;;;;;;;;;;;; Other Delimiters ;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; PARSE$DELIMITER? +;;; Is [ascii] character a delimiter? + +(DEFUN PARSE$DELIMITER? (X) + (OR (PARSE$PUNCTUATION? X) (GET X 'PARSE$DELIMITER))) + +;;; PARSE$DELIMITER +;;; Make [ascii] character a delimiter. + +(DEFUN PARSE$DELIMITER (X) (PUTPROP X T 'PARSE$DELIMITER)) + +;;; Make these characters into delimiters (white space) + +(MAPC 'PARSE$DELIMITER + (LIST (ASCII 9.) ; + (ASCII 10.) ; + (ASCII 13.) ; + (ASCII 32.))); + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;; Special Characters ;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; PARSE$SPECIAL-CHAR? +;;; Is [ascii] character a special (legal) character? + +(DEFUN PARSE$SPECIAL-CHAR? (X) (GET X 'PARSE$SPECIAL-CHAR)) + +;;; PARSE$SPECIAL-CHAR +;;; Make [ascii] character into a special character. + +(DEFUN PARSE$SPECIAL-CHAR (X) (PUTPROP X T 'PARSE$SPECIAL-CHAR)) + +;;; Make and a speical char (to be treated like +;;; an alphabetic character). + +(PARSE$SPECIAL-CHAR '/') +(PARSE$SPECIAL-CHAR '-) + +;;; PARSE$FUNNY-CHAR? +;;; A printing ascii char, but not a commonly seen one. + +(DEFUN PARSE$FUNNY-CHAR? (X) (GET X 'PARSE$FUNNY-CHAR)) + +;;; Set up FUNNY-CHAR definitions + +(DO ((I 33. (1+ I))) + ((> I 126.)) + (LET ((X (ASCII I))) + (AND (NOT (GET X 'PARSE$FUNNY-CHAR)) + (NOT (PARSE$PUNCTUATION? X)) + (NOT (PARSE$DELIMITER? X)) + (NOT (PARSE$ALPHABETIC? X)) + (NOT (PARSE$DIGIT? X)) + (NOT (PARSE$SPECIAL-CHAR? X)) + (PUTPROP X T 'PARSE$FUNNY-CHAR)))) + +;;; PARSE$STRAY-CHAR? +;;; Is [ascii] character a random character of unknown type? + +(DEFUN PARSE$STRAY-CHAR? (X) + (NOT (OR (PARSE$DELIMITER? X) + (PARSE$PUNCTUATION? X) + (PARSE$FUNNY-CHAR? X) + (PARSE$ALPHABETIC? X) + (PARSE$SPECIAL-CHAR? X) + (PARSE$DIGIT? X)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Main Word Parser ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; PARSE$MAKE-WORDS +;;; Take a list of [ascii] characters and return a list of atoms that can +;;; be made from those characters. + +(DEFUN PARSE$MAKE-WORDS (CHAR-LIST) + (DO ((C CHAR-LIST (CDR C)) + (CHAR) + (WORD NIL) + (SENT NIL)) + ((NULL C) + (COND (WORD (NREVERSE (CONS (IMPLODE (NREVERSE WORD)) SENT))) + (T (NREVERSE SENT)))) + (SETQ CHAR (PARSE$CAPS (CAR C))) + (COND ((AND (EQ CHAR '-) + (EQ (CADR C) '-)) + (SETQ C (CDR C)) ; Gobble second - + (SETQ CHAR '--)) ; Join hyphens to a dash + ((AND (NOT WORD) + (PARSE$QUOTE? CHAR)) + (DO () ((NOT (PARSE$QUOTE? (CAR C)))) (POP C)) ; Strip quotes + (DO () ((OR (NULL C) (PARSE$QUOTE? (CAR C)))) + (PUSH (CAR C) WORD) + (POP C)) + (DO () ((NOT (PARSE$QUOTE? (CADR C)))) (POP C)); Strip quotes + (PUSH '|``| SENT) + (PUSH (NCONS (IMPLODE + (SUBST '| | (ASCII 13.) (NREVERSE WORD)))) + SENT) + (PUSH '|''| SENT) + (SETQ WORD NIL) + (SETQ CHAR '*DUMMY*))) ; This won't get cons'd in + (COND ((PARSE$STRAY-CHAR? CHAR) + (COMMENT IGNORE IT)) + ((AND (EQ CHAR '-) + (EQ (CADR C) (ASCII 13.))) + (COMMENT IGNORE HYPHEN -- GOBBLE ) + (SETQ C (CDR C))) + ((OR (PARSE$PUNCTUATION? CHAR) + (PARSE$FUNNY-CHAR? CHAR)) + (COND (WORD + (SETQ SENT + (CONS CHAR + (CONS (IMPLODE (NREVERSE WORD)) + SENT))) + (SETQ WORD NIL)) + (T + (SETQ SENT (CONS CHAR SENT))))) + ((PARSE$DELIMITER? CHAR) + (COND + (WORD (SETQ SENT (CONS (IMPLODE (NREVERSE WORD)) SENT)) + (SETQ WORD NIL)))) + ((OR (PARSE$ALPHABETIC? CHAR) + (PARSE$SPECIAL-CHAR? CHAR) + (PARSE$DIGIT? CHAR)) + (SETQ WORD (CONS CHAR WORD)))))) + + diff --git a/src/games/pattrn.7 b/src/games/pattrn.7 new file mode 100644 index 00000000..c51486db --- /dev/null +++ b/src/games/pattrn.7 @@ -0,0 +1,279 @@ +;;; -*- LISP -*- +;;; PATTERN: A Library of Pattern Matching Routines + +;;; MATCH +;;; This function allows the following syntax +;;; +;;; (MATCH ) +;;; +;;; Returns T iff is of the form specified by +;;; +;;; is a list with the description... +;;; +;;; ( ...) +;;; +;;; is one of the following forms: +;;; +;;; Matches an atom that is EQ to it +;;; +;;; (?) Matches any single S-Expression +;;; +;;; (? ) Matches any single S-Expression and assigns +;;; to tag the value of the thing matched +;;; +;;; (?= ) Matches any single S-Expression for which +;;; is true +;;; +;;; (?= ) Matches any single S-Expression for which +;;; is true, assigns matched thing to +;;; +;;; ($) Matches a single S-Expression or none. +;;; +;;; ($ ) Matches a single S-Expression or none, +;;; assigning matched item to . +;;; +;;; ($= ) Matches a single S-Expression if it makes +;;; true, or none. +;;; +;;; ($= ) Matches a single S-Expression if it makes +;;; true, or none, assigns thing +;;; matched to +;;; +;;; (*) Matches any series of S-Expressions. +;;; +;;; (* ) Matches any series of S-Expressions, assigning +;;; to a list of the matched things. +;;; +;;; (*= ) Matches any series of things that return true +;;; for +;;; +;;; (*= ) Matches any series of things that return true +;;; for ; gets list of things matched +;;; +;;; is a list +;;; + +;;; MATCH +;;; This function looks at all constant terms in a pattern, and makes +;;; sure they at least occur in the same order in item being tested. +;;; If they don't, the match fails. If they do, the normal (hairy) +;;; matching scheme is attempted. + +(DEFUN MATCH (PP XX) + (DO ((P PP (CDR P)) + (X XX)) + ((NULL P) (MATCH1 PP XX)) + (COND ((ATOM (CAR P)) + (SETQ X (MEMQ (CAR P) X)) + (COND ((NULL X) (RETURN NIL))))))) + +;;; Macros needed for making my code size below a bit more compressed + + ;; (TAILSTRIP ) + ;; removes the last element of a list. + ;; Equivalent to (DEFUN TAILSTRIP (X) (NREVERSE (CDR (REVERSE X)))) + ;; but a slight bit faster. + +(DEFUN TAILSTRIP (X) + ((LAMBDA (R) + (DO ((X X (CDR X)) + (L (SETQ R (NCONS ())) (CDR L))) + ((NULL (CDR X)) (CDR R)) + (RPLACD L (NCONS (CAR X))))) + NIL)) + + ;; (POP* ...) + ;; Same as (PROGN (POP ) (POP ) ...) + +(DEFUN POP* MACRO (X) + `(PROGN ,@(MAPCAR (FUNCTION (LAMBDA (X) `(SETQ ,X (CDR ,X)))) + (CDR X)))) + +;;; MATCH1 +;;; This is the real brains behind the matcher. It is called only from +;;; MATCH, however, which does some preprocessing. + +(DEFUN MATCH1 (P X) + (DO ((PATTERN) + (FUNCTION-VALUE) + (STARFLAG)) + ((NULL P) (NULL X)) + (COND ((ATOM (CAR P)) ; Atom must match exactly + (COND ((NULL X) (RETURN NIL))); This can't match a null list + (COND ((EQ (CAR P) (CAR X)) ; If matched... + (POP* P X) ; Pop pattern & test list + (SETQ STARFLAG NIL)) ; Terminate * search + (T ; Else (no atomic match) + (RETURN NIL)))) ; Match failed + ((EQ (CAAR P) '?) ; ? may match any single thing + (COND ((NULL X) (RETURN NIL))); This can't match a null list + (COND ((CDAR P) ; Maybe assign match to a var + (SET (CADAR P) (CAR X)))) + (POP* P X) ; Pop pattern & test list + (SETQ STARFLAG NIL)) ; Terminate * search + ((EQ (CAAR P) '?=) ; Match w/ predication + (COND ((NULL X) (RETURN NIL))); This can't match a null list + (COND ((NOT (FUNCALL (CADAR P) (CAR X))) ; Try predicate + (RETURN NIL))) ; Fail if predicate loses + (COND ((CDDAR P) ; Maybe assign match to a var + (SET (CADDAR P) (CAR X)))) + (POP* P X) ; Pop pattern & test list + (SETQ STARFLAG NIL)) ; Terminate * search + (T + (SETQ PATTERN (CAR (LAST P))) ; Work on last elements for + ; a while... + (COND ((ATOM PATTERN) ; If last element is an atom + (COND ((NULL X) ; This can't match a null list + (RETURN NIL))) + (COND ((NOT (EQ (CAR (LAST X)) PATTERN)) + (RETURN NIL))) ; Fail if doesn't match + (SETQ P (TAILSTRIP P)) ; Pop last element of pattern + (SETQ X (TAILSTRIP X)) ; Pop last element of test list + (SETQ STARFLAG NIL)) ; Terminate * search + ((EQ (CAR PATTERN) '?) ; Last element of ? matches! + (COND ((NULL X) ; This can't match a null list + (RETURN NIL))) + (COND ((CDR PATTERN) ; Maybe assign match to a var + (SET (CADR PATTERN) (CAR (LAST X))))) + (SETQ P (TAILSTRIP P)) ; Pop last element of pattern + (SETQ X (TAILSTRIP X)) ; Pop last element of test list + (SETQ STARFLAG NIL)) ; Terminate * search + ((EQ (CAR PATTERN) '?=) ; Predicated match last element + (COND ((NULL X) ; This can't match a null list + (RETURN NIL))) + (COND ((NOT (FUNCALL (CADR PATTERN) (CAR (LAST X)))) + (RETURN NIL))) ; If pred fails, match fails + (COND ((CDDR PATTERN) ; Maybe assign match to a var + (SET (CADDR PATTERN) (CAR (LAST X))))) + (SETQ P (TAILSTRIP P)) ; Pop last element of pattern + (SETQ X (TAILSTRIP X)) ; Pop last of element test list + (SETQ STARFLAG NIL)) ; Terminate * search + ((EQ (CAR (SETQ PATTERN (CAR P))) '$) + ; $ can optionally match + (COND ((MATCH1 (CDR P) X) ; Test first ignoring $ + (COND ((CDR PATTERN) ; Maybe set a variable + (SET (CADR PATTERN) NIL))) ; to match + (RETURN T))) ; We won without it + (COND ((CDR PATTERN) ; Maybe set a variable to + (SET (CADR PATTERN) (CAR X)))) ; thing matched + (POP* P X) ; Pop pattern and test list + (SETQ STARFLAG NIL)) ; Terminate * search + ((EQ (CAR PATTERN) '$=) ; Match 1 or 0 with predication + (COND ((MATCH1 (CDR P) X) ; Try first without using $= + (COND ((CDDR PATTERN) ; Maybe set variable to + (SET (CADDR PATTERN) NIL))) ; match + (RETURN T))) ; We won + (COND ((NOT (FUNCALL (CADR PATTERN) (CAR X))) ; Apply + (RETURN NIL))) ; predicate - if NIL then fail + (COND ((CDDR PATTERN) ; Maybe set variable to + (SET (CADDR PATTERN) (CAR X)))) ; thing matched + (POP* P X) ; Pop pattern and test list + (SETQ STARFLAG NIL)) ; Terminate * search + ((EQ (CAR PATTERN) '*) ; * matches any sequence + (COND ((NULL X) ; If no more elements, + (RETURN ; make sure no pending + (MATCH1 (CDR P) NIL))) ; patterns lose. + ((MATCH1 (CDR P) X) ; Else match first without * + (COND ((AND (NOT STARFLAG) + (CDR PATTERN)) ;Maybe clear + (SET (CADR PATTERN) NIL))) ; variable + (RETURN T))) ; We won + (COND ((CDR PATTERN) ; If there's a var to set + (COND (STARFLAG ; add element to end of var + (SET (CADR PATTERN) ; add to var's val + (NCONC (EVAL (CADR PATTERN)) + (NCONS (CAR X))))) + (T ; if var not initialized + (SET (CADR PATTERN) ;set to () + (NCONS (CAR X))))))) + (POP* X) ; Pop test list + (SETQ STARFLAG T)) ; Note * search in effect + ((EQ (CAR PATTERN) '*=) ; Match any predicated sequence + (COND ((NULL X) ; If no more test list + (RETURN ; Insure no pending patterns + (MATCH1 (CDR P) NIL))) ; are violated + ((MATCH1 (CDR P) X) ; Else try wihtout + (COND ((AND (NOT STARFLAG) (CDDR PATTERN)) + (SET (CADDR PATTERN) NIL))) + (RETURN T))) + (SETQ FUNCTION-VALUE (FUNCALL (CADR PATTERN) (CAR X))) + (COND ((NOT FUNCTION-VALUE) (RETURN NIL))) + (COND ((CDDR PATTERN) + (COND (STARFLAG + (SET (CADDR PATTERN) + (NCONC (EVAL (CADDR PATTERN)) + (NCONS (CAR X))))) + (T + (SET (CADDR PATTERN) + (NCONS (CAR X))))))) + (SETQ X (CDR X)) + (SETQ STARFLAG T)) + (T ; Unknown pattern form? + (RETURN NIL))))))) ; Fail + +(DEFUN MATCH-VAR-GET (X) + (COND ((ATOM X) NIL) + ((MEMQ (CAR X) '(* ?)) (AND (CDR X) (LIST (CADR X) NIL))) + (T (AND (CDDR X) (LIST (CADDR X) NIL))))) + +(DEFUN ELIMINATE-REDUNDANCIES (X) + (DO ((L X (CDDR L)) + (R NIL)) + ((NULL L) (NREVERSE R)) + (COND ((NOT (MEMQ (CAR L) R)) + (SETQ R (CONS (CADR L) (CONS (CAR L) R))))))) + +(DEFUN MATCH-VARS (L) + (APPLY 'NCONC + (MAPCAR (FUNCTION (LAMBDA (P) (MAPCAN 'MATCH-VAR-GET P))) L))) + +;;; MATCHES +;;; This is a convenience macro that takes the syntax: +;;; +;;; (MATCHES
... ) +;;; +;;; will be EVAL'ed +;;; 's will not be EVAL'd +;;; +;;; It will expand to the following: +;;; +;;; (PROGN (SETQ NIL NIL NIL ... NIL) +;;; (OR (MATCH ' ) +;;; (MATCH ' ) +;;; (MATCH ' ) +;;; ... +;;; (MATCH ' ) +;;; (SETQ NIL NIL ... NIL))) +;;; +;;; ... are the variables that may be set by the Matcher. +;;; The are initialized to NIL and if the Matches fail, they are +;;; re-initialized to NIL to avoid chance of getting garbage left over in +;;; them. + +(DEFUN (MATCHES MACRO) (X) + (LET* (((OBJECT . PATTERNS) (CDR X)) + (INITS (ELIMINATE-REDUNDANCIES (MATCH-VARS PATTERNS)))) + (COND (INITS (PUSH 'SETQ INITS))) + (COND ((NULL PATTERNS) NIL) + ((> (LENGTH PATTERNS) 1.) + `(OR ,@(MAPCAN + (FUNCTION + (LAMBDA (X) + (COND (INITS + `(,INITS (MATCH ',X ,OBJECT))) + (T + `((MATCH ',X ,OBJECT)))))) + PATTERNS) + ,@(COND (INITS (NCONS INITS))))) + (T + (COND (INITS + `(OR ,INITS + (MATCH ',(CAR PATTERNS) ,OBJECT) + ,INITS)) + (T + `(MATCH ',(CAR PATTERNS) ,OBJECT))))))) + + +;;; Note this package has loaded + +(SSTATUS FEATURE PATTERN) \ No newline at end of file diff --git a/src/games/qb.(init) b/src/games/qb.(init) new file mode 100644 index 00000000..d585a050 --- /dev/null +++ b/src/games/qb.(init) @@ -0,0 +1,8 @@ +(comment) +(progn +(load '|dsk:games;qb fasl|) +(setq errlist '((gc) + (qubic))) +(setsyntax '/ +'/ '/ ) +(qubic)) diff --git a/src/games/sprout.rules b/src/games/sprout.rules new file mode 100644 index 00000000..1de043b7 --- /dev/null +++ b/src/games/sprout.rules @@ -0,0 +1,359 @@ + + THE RULES OF SPROUTS, THE ONLY TOPOLOGICAL GAME + INVENTED BY JOHN HORTON CONWAY AND MIKE PATERSON + PRESENTED ORIGINALLY IN SCI. AMER. MATH GAMES 1967.JUL + DESCRIBED HERE BY ROBERT MAAS 1977.AUG.01 + +Sprouts is a two-person game with alternating play. There can +be no draw, one person wins or the other does. The longest +game possible is 3*N-1 halfmoves and the typical game is 7*N/3 +halfmoves (where N is the number of dots in the starting +situation, as described below), thus with N in the range 2:7 +the typical game lasts between 4 and 16 moves (beginners start +at N=2 and work up, becoming experts when they have mastered +N=7) resulting in short snappy contests. + +PLAYING SURFACE: The game is played on either a sphere or a +plane, at least in principle it is; actually the game is played +in the interior of some small playing area that has been marked +on a sheet of paper, 2" by 2" square is sufficient for a game +when N=2,3,4,5 and slightly larger squares for N=6 and N=7. +The only utensils needed are a pencil or pen for drawing +freehand dots and lines in the playing area. + +INITIAL SITUATION: The game starts with N dots drawn somewhere +inside the playing area. It is preferable to arrange the dots +as far from each other and from the edges of the playing area as +possible, usually people arrange them in a circle about half the +diameter of the playing area centered in the playing area. + +LEGAL MOVE, BASIC: A legal move consists of drawing a line from +some already-existing dot to another already-existing dot, subject +to the restrictions listed below, then placing a new dot on the +midpoint of the line (segment). The line drawn may curve in order +to connect back to its starting point or in order to go around +obstacles that block a staight path, or to cause certain dots and +lines to be on the left side separated from other dots and lines +on the right side of the new line drawn. + +RESTRICTIONS: Each line (segment) drawn when making a move must +not touch itself (except at endpoints when connecting a dot back +to itself) nor cross or brush against any other dot or line, thus +it is impossible to cross a closed-curve in order to connect some +dot inside it to another dot outside it. -- Also, it is illegal +to make any move that causes any dot to have more than 3 (three) +connections to it. Note that drawing a loop from a dot back to +itself counts as two connections to that dot. Note also that +the new dot created during each move already has a line coming into +it from each side thus already has two connections at its birth, +thus allowing only one additional connection to it. + +END OF GAME, WINNER: The game is over when there is no legal +move remaining. The last person who was able +to make a legal move is the winner. + +NOTATION USED TO PLAY GAME OVER TELEPHONE AND/OR TERMINAL, AND +USED TO RECORD A GAME: The syntax is

:- (/) +where

is the name of the player making the move, is +the number of the move (each new move creates a new dot, the original +dots are numbered 1,2,..,N and the new dots are numbered N+1, N+2, +etc. -- each move is numbered according to the new dot created by +that move, thus the first move is numbered N+1 rather than 1), + and are the two dots connected by the line segment, +if the move is ambiguous then and are supplied listing the +dots that appear on the left and right of the new segment going +from to (thinking of the playing area as a roadmap, +with lines representing highways, dots representing intersections, +and unmarked areas representing city parks -- when - +completes a closed curve because and were already +connected by some other highway before the current move, to figure +out what and are you imagine letting your pet dog take a +walk out either your left window or right window respectively, with +the restriction that your dog may not cross a highway, the +intersections your dog can stick his nose into are listed in +and for the two walks he can take respectively -- when the +highways form a peninsula or isthmus so that a dot on the neck +(thin part) of the peninsula or isthmus can be sniffed by a dog +from opposite sides while remaining in the same city park (without +crossing any highway), and such a dot is or , then the +dots immediately adjacent on the left and right as is +departed or is reached, are included in and +respectively to remove the ambiguity as to the resultant +configuration), and denotes carriage-return with +accompanying linefeed. Note that the parenthesi and slash are +omitted when neither a closed curve nor a peninsula/isthmus +connection is made, or when no ambiguity is made by the omission +of and completely. When there is a choice between two +moves, one of which have an and and the other of which +doesn't, between exactly the same and , however, the +parenthesis must be supplied in both cases to avoid ambiguity +(note, some versions of the program, if you type in just -, +will assume you intend the (/) version i.e. null and , +however it is bad when playing a human to fail to specify in +this case). + +EXAMPLES OF NOTATION FOR MAKING MOVES: Let us suppose that +FOO and BAZ are playing a game with N=2, with FOO playing first. +FOO may open the game by connecting dot#1 to dot#2, thus +FOO 3: 1-2 +or FOO may connect dot#1 to itself either making a small loop, or +making a loop clockwise around dot#2, or making a loop CCW around +dot#2, but all these three moves are equivalent strategically +hence can be denoted by either +FOO 3: 1-1 (2/) +or by +FOO 3: 1-1 (/2) +(technically these moves are different in that 1-3-1 was traced +in the reverse direction in one from the other, thus with car +moving in reverse direction left and right are reversed so that +dot#2 changes apparant sides, but due to symmetry the resultant +situations are identical hence the user can be sloppy in notation +in this case) +or FOO may connect dot#2 to itself, denoted by +FOO 3: 2-2 (1/) +or by +FOO 3: 2-2 (/1) +Note that although 1-1 (2/) and 2-2 (1/) are equivalent strategically, +the notation used for subsequent moves is different, thus the +player must specify which move he is making in order for play of +the game by notation to proceed. Thus there are two totally +different opening moves, one of which has 2 ways to do it with +numbered dots. + Let us suppose player FOO makes this opening move: +FOO 3: 1-2 +Player BAZ now has three totally different replies: +BAZ 4: 1-2 (both ways to draw it are equivalent) +BAZ 4: 1-3 (2/) or 1-3 (/2) or 2-3 (1/) or 2-3 (/1) + all of which are strategically equivalent but notationally + different hence must be correctly typed one of four ways +BAZ 4: 1-1 or 2-2 (unnecessary to specify 1-1 (3/) or 1-1 (/3) + because the resulting situations are identical) + Let us suppose player BAZ makes the reply: +BAZ 4: 1-3 (2/) +now player FOO has the choice of +FOO 5: 1-4 (/) +FOO 5: 1-4 (2/) +FOO 5: 2-2 +FOO 5: 1-2 (equivalent to 4-2 strategically but must be + specified correctly because notation would be different in + that case) + Let us suppose player FOO makes the move: +FOO 5: 1-4 (2/) +now player BAZ has the choice of +BAZ 6: 2-5 +BAZ 6: 2-2 + Let us suppose player BAZ makes the move: +BAZ 6: 2-5 +now player FOO has the choice of +FOO 7: 2-6 (4/) +FOO 7: 2-6 (/1) +but both moves are equivalent, and normally / is omitted +for dots that can't be connected to anything because they +already have three connections, thus the notation for both moves is +FOO 7: 2-6 (/) +which may be abbreviated to +FOO 7: 2-6 + After playe FOO makes the move +FOO 7: 2-6 +there is no legal move, so FOO wins the game. The complete record +of the game is: +SPROUTS GAME, 2 DOTS +FOO 3: 1-2 +BAZ 4: 1-3 (2/) +FOO 5: 1-4 (2/) +BAZ 6: 2-5 +FOO 7: 2-6 + +NOTATION FOR SITUATIONS: Note that the above notation is for +describing a half-move to be made, not the complete situations that +result between half-moves, just like in Chess the notation N-B5 +denotes a half-move not the complete board situation. Sprouts also +has a way to represent a complete situation just like Chess +has its notation rnb1kbnr/ppppqppp/8/8/3Pp2N/8/PPP1PPPP/RNBQKB1R. +to represent a complete board position. In fact the LISP +internal representation of this notation is actually used by +Sprouts-playing programs to keep track of the situation during +the course of a game or during analysis. A Sprouts situation +is represented by a 3-level list, which is presented externally +by merely calling the LISP function PRINT or by a more fancy +variation of PRINT written specially for Sprouts, together with +a table of how many connections remain to be made to each dot. +People who have never programmed in LISP will probably find this +notation difficult to understand, in which case this section +should be omitted when reading this file. + The table of lives is the easy part. It is simply a list +of how many lives each dot has remaining, thus after the first +two half-moves in the example game, the table of lives would be +(1 2 0 1) which means dot#1 has 1 life, dot#2 has 2 lives, dot#3 +has 0 lives, and dot#4 has 1 life. + The three-level list is more complicated. The top level +is a list of regions (city parks) altogether. Each second level +is the list of separate pieces of highway adjoining the park +(in the top-level list) that points to it, thus to get between +the various pieces of highway one must drive across the park. +Each third level is a list of intersections on that piece of +highay adjoining that park, however the intersections are listed +in sequence from left to right as one would read off the numbers +while standing in the park and facing the highway segment. + Note that arbitrary permutation of regions doesn't change +the situation, also that within each region arbitrary permutation +of highway segments doesn't change the situation, also that rotation +of the numbers of intersections on a highway segment doesn't change +the situation but that any other permutation of numbers of +intersections on a highway segment will result in a different +situation, or more commonly an impossible configuration. + Below are listed the life table and the 3-level list which +denote the situations that occur in the example game above, together +with the moves (same as shown above) which transform each situation +into the next. Each situation is shown in fully-verbose mode (all +dots shown even though they have no connections remaining to make +hence are irrelevant to the later game) and in terse mode (all +fully-dead dots deleted from the notation, and all regions where +no further connections can be made deleted from the notation): +INITIAL SITUATION: (3 3) (((1) (2))) +MOVE: FOO 3: 1-2 +RESULTANT SITUATION: (2 2 1) (((1 3 2 3))) +MOVE: BAZ 4: 1-3 (2/) +VERBOSE SITUATION: (1 2 0 1) (((1 4 3)) ((1 3 2 3 4))) +TERSE SITUATION: (1 2 0 1) (((1 4)) ((1 2 4))) +MOVE: FOO 5: 1-4 (2/) +VERBOSE SITUATION: (0 2 0 0 1) (((1 4 3)) ((1 5 4)) ((1 3 2 3 4 5))) +TERSE SITUATION: (0 2 0 0 1) (((2 5))) +MOVE: BAZ 6: 2-5 +VERBOSE SITUATION: (0 1 0 0 0 1) (((1 4 3)) ((1 5 4)) ((2 3 4 5 6)) ((1 3 2 6 5))) +TERSE SITUATION: (0 1 0 0 0 1) (((2 6)) ((2 6))) +MOVE: FOO 7: 2-6 +VERBOSE SITUATION DEPENDS ON WHICH OF TWO EQUIVALENT MOVES WAS DONE. +TERSE SITUATION: (0 0 0 0 0 0 1) () + Note that at the end of the game the terse situation 3-level +list is always exactly NIL (the empty list). + There are two reasons for having notation for a situation. +One reason is to describe a situation without repeating all the moves +that led up to it, in order to resolve a dispute in the middle of +a game when somehow one player or the other has screwed up his +playing area and wants to know what the other's looks like. The +other is when using a program to analyze a situation there must be +some way to type in the desired situation. + When a program types out a situation, instead of using +PRINT or PRINC to type out its internal representation as shown +above, usually a more human-readable version is used, shown here: +(after the second move) +SPROUTS SITUATION: + REGION #1: + BOUNDARY #1: 1[1],4[1] + REGION #2: + BOUNDARY #1: 1[1],2[2],4[1] +Note that the numbers inside brackets are the numbers of lives +taken from the life table. The numbers outside brackets are +the numbers identifying the dots which appear as elements in the +third level of the 3-level list. Here's a more complicated +example from a game with N=4: +SPROUTS GAME, 4 DOTS +FOO 5: 1-1 (2/3,4) +BAZ 6: 3-5 +FOO 7: 3-6 (4/) +SPROUTS SITUATION: + REGION #1: + BOUNDARY #1: 2[3] + BOUNDARY #2: 1[1] + REGION #2: + BOUNDARY #1: 4[3] + BOUNDARY #2: 1[1],7[1],3[1] + REGION #3: + BOUNDARY #1: 3[1],7[1] + +CANONICAL NOTATION FOR SPROUTS SITUATIONS: When analyzing Sprouts +it is useful to identify situations that are equivalent so as to +avoid analyzing both versions of it and thus doubling ones work. +One way to do this is to find some canonical form of notation to +represent situations and to alphabetize or hash these representations +to make it easy to determine whether a situation that turns up is +one that has already been indexed and possibly analyzed. The +notation that I have adopted for this purpose involves replacing +the number that designates a dot by the number that designates the +number of lives it has remaining (thus eliminating duplicate entries +due to different names for a dot that plays exactly the same role +in equivalent situations), except that when a dot is shared between +two regions or between two sides of an isthmus or peninsula it is +necessary to handle it in a unique way. A minute's thought makes +it apparant that the only way a dot can still be alive while appearing +in two different places in the TERSE notation given above is if it +has exactly one life. Even a dot with exactly one life (which +always lies across a peninsula or isthmus or is shared between two +regions in the VERBOSE notation above) can occur just once if +it adjoins two regions one of which is dead in the sense of no +chance to connect to anything else alive in that region. Thus four +cases exist for each dot, unshared dots with 1 2 or 3 lives each, +which can be replaced by the number of lives, and shared dots with +exactly 1 life each, which are handled specially. What is done for +1-life shared dots is to number them 4,5,6,... After choosing the +numbering for 1-life shared dots, a recursive short of the 3-level +structure is done, sorting rotationally-only at the third level, +and sorting fully at the top level and the second level. One +additional symmetry is present, namely that reversing the third +level lists throughout any top level (region) element doesn't +change the situation strategically. Thus the complete brute-force +algorithm for finding canonical form is to replace shared 1-life +dots in all k factorial ways (where k is the number of them) and +performing the following algorithm on each way: + In each region, try reversing and not reversing all + third-level lists, performing the following algorithm + on each: + Sort each third-level cyclically. + Sort the second-level list of third-level + lists completely. + Sort the list of two elements you get from the two + calls to the sub-algorithm you just did, and select + the first element. + Now make a list out of the results for each region + and sort it completely. +Now make a list of length k factorial of the results from all the +permutations on names 4,5,6,... for shared 1-life dots and sort +them completely, then select the first element as the answer, +the result that is returned from the canonical-form routine. Here +are the canonical forms that result from the sample game above: +CANONICAL FORM: (((3) (3))) +MOVE: FOO 3: 1-2 +CANONICAL FORM: (((2 4 2 4))) +MOVE: BAZ 4: 1-3 (2/) +CANONICAL FORM: (((2 4 5)) ((4 5))) +MOVE: FOO 5: 1-4 (2/) +CANONICAL FORM: (((1 2))) +MOVE: BAZ 6: 2-5 +CANONICAL FORM: (((4 5)) ((4 5))) +MOVE: FOO 7: 2-6 +CANONICAL FORM: () + The only reason I can think of you would want to use this +canonical notation is when looking at output from my computer +program, or when describing an abstract situation to someone without +bothering him with the details of how it was arrived at in a game. + Here's the 4-dot situation mentionned earlier, using +canonical notation: +(((3) (4)) ((3) (4 5 6)) ((5 6))) + The major disadvantage of canonical notation is the large +amount of compute time it takes to perform k factorial recursive +sorts when k is large. For example when given the situation in +terse notation: + (1 1 1 1 1 1) (((1 4) (2 6)) ((2 6)) ((1 4) (3 5)) ((3 5))) +it takes seven hundred and twenty recursive sorts to determine +that the canonical notation is: + (((4 5)) ((6 7)) ((4 5) (8 9)) ((6 7) (8 9))) +(actually "8" would come out "10" and "9" would come out "11" + because my program currently uses base eight rather than + base ten) which would take several minutes on the SU-AI KL-10 +machine using compiled UCI-LISP (I haven't tried it in compiled +MACLISP yet). + It is an unsolved problem how to find the canonical form +in fewer than k factorial recursive sorts; as far as I know +nobody has found a faster way to do it and nobody has proven it +impossible. A solution to the general problem of finding the +canonical numbering of vertices of a graph would have important +applications in Dendral (classifying molecules), Macsyma (finding +canonical forms for tensors and other formulas so that like terms +can be combined and their coefficients added), and of course +Sprouts and other game-playing programs that want to store away +situations they've already analyzed to avoid re-analyzing them +when an equivalent situation occurs under different circumstances. +I have some techniques that might minimize average-time, but +haven't fully checked them out. + diff --git a/src/games/stone.(init) b/src/games/stone.(init) new file mode 100644 index 00000000..6b0d5aea --- /dev/null +++ b/src/games/stone.(init) @@ -0,0 +1,7 @@ +(COMMENT) +(PROGN (LOAD '((dsk games) STONE FASL)) + (setq errlist '((gc) + (stone-game))) + (STONE-GAME) + (VALRET '|:KILL/ +| ) ) diff --git a/src/games/think.(init) b/src/games/think.(init) new file mode 100644 index 00000000..c2ac6a50 --- /dev/null +++ b/src/games/think.(init) @@ -0,0 +1,8 @@ +;;; -*- LISP -*- +;;; Think-A-Dot Init file + +(COMMENT) + +(PROGN + (CLOSE (PROG2 T INFILE (INPUSH -1.))) + (LOAD '|DSK:games;THINK FASL|)) diff --git a/src/games/think.2 b/src/games/think.2 new file mode 100644 index 00000000..6b1edcbb --- /dev/null +++ b/src/games/think.2 @@ -0,0 +1,491 @@ +;;; -*- LISP -*- +;;; A B C +;;; D E +;;; F G H + +(COND ((NOT (MEMQ 'CURSORPOS (STATUS FILEM TYO))) + (CURSORPOS 'A TYO) + (PRINC '|Sorry, THINK-A-DOT currently only works on display terminals.|) + (TERPRI TYO) + (QUIT))) + +(SSTATUS RANDOM (APPLY '* (APPEND (STATUS DATE) (STATUS DAYTIME)))) + +(EVAL-WHEN (EVAL COMPILE) + (SSTATUS MACRO /# '(LAMBDA () ((LAMBDA (IBASE) (READ)) 2.)))) + +(EVAL-WHEN (EVAL COMPILE) + (DO ((C (TYI) (TYI)) + (L () (CONS C L))) + ((= C 31.) (SETQ LONG-RULES (MAKNAM (NREVERSE L)))))) + + Think-a-dot is sold as a children's game, but can be played by +people of all ages. It allows as much or as little planning as you want +to put into it. + The equipment needed is a plastic box with colored dots on the +side of it and 5 holes (three on top, one on each side), as shown on the +next screen. (Note: A well-designed think-a-dot simulator running on a PDP-10 +may substitute for the plastic box.) + + A B C + ___ ___ ___ + ---------------------------- + | | + | (A) (B) (C) | + | Blue Yellow Blue | + | | + | | + | (D) (E) | + | Yellow Yellow | + | | + | | + | (F) (G) (H) | + | Blue Yellow Blue | + | | + || || + P1 || || P2 + ------------------------------ + + Balls are dropped into the holes depending on which side of the +board they come out on, that player plays next. (It is deterministic +which side of the board they will come out on, as will be seen in a +minute). + When a ball falls into a hole, it will strike the dot just +below it, changing its color from blue to yellow or yellow to blue +as appropriate. Depending on the resulting color, the ball will then +fall to either the right or the left and strike the next dot below it. +When it reaches the bottom dot, it will roll out of the box and it will +be the player's turn whose side it rolled out on. + + In this version of think we use "/" and "\" to represent the two +states of the `dots.' This makes it easier to tell what the internal +state of the machine is. If you are unsure of what happens when a ball +is dropped, play around with the game before starting a game. + For example, note that when you start with state 11111111 and then +drop a ball into "A" what happens is that it hits node "A" and falls to the +right (complementing "A"). It then hits node "D" and falls to the right +(complementing it) and finally hits "G" falling to the right (complementing +it). + If the ball falls out to the left or the right of node "F", or to +the left of node "G", it will be player 1's turn. If it falls to the +right of node "G" or either side of node "H" it will be player 2's turn. + + If you get stuck, ask a 6-year-old or a mathemetician to help you. +(Note that this box can be viewed as a finite state machine with 256 states, +only 128 of which are reachable from any given state (parity of the +initial situation is a factor)). Good luck! + + + +(EVAL-WHEN (EVAL COMPILE) + (DO ((C (TYI) (TYI)) + (L () (CONS C L))) + ((= C 31.) (SETQ SHORT-RULES (MAKNAM (NREVERSE L)))))) +[A,B,C] will drop a ball in the hole above corresponding location. +For scored games... starts. "Q" quits. restarts game. +Just for fun... "R" randomize board (conserving parity). +complements a single switch (reading a switch name). "^S" stores +the current state for later recall. "^R" recalls a previously +stored state. The characters "/", "\", "-", and "+" initialize +the board in various interesting ways. +And finally... "H" gives full documentation, "^Q" quits program. + + +(DEFUN -*-SHORT-RULES-*- MACRO (()) `',SHORT-RULES) + +(DEFUN -*-LONG-RULES-*- MACRO (()) `',LONG-RULES) + +(SETQ SHORT-RULES (-*-SHORT-RULES-*-) LONG-RULES (-*-LONG-RULES-*-)) + +(DEFUN LAMBDA MACRO (X) (LIST 'FUNCTION X)) + +(NOINTERRUPT T) + +(DECLARE (*FEXPR *DROP *INIT) + (SPECIAL OBJECT-LIST PARITY-LIST + TTY-SPEC-INFO \ // MODE REMEMBER + SHORT-RULES LONG-RULES)) + +(SETQ OBJECT-LIST '(A B C D E F G H)) +(SETQ PARITY-LIST '(A B C F G H)) + +(DEFPROP A (F . D) POINTER) +(DEFPROP B (D . E) POINTER) +(DEFPROP C (E . H) POINTER) +(DEFPROP D (F . G) POINTER) +(DEFPROP E (G . H) POINTER) + +;;; Display locations + +(DEFPROP A (2 . 6.) WHERE) +(DEFPROP B (2 . 10.) WHERE) +(DEFPROP C (2 . 14.) WHERE) +(DEFPROP D (4 . 8.) WHERE) +(DEFPROP E (4 . 12.) WHERE) +(DEFPROP F (6 . 6.) WHERE) +(DEFPROP G (6 . 10.) WHERE) +(DEFPROP H (6 . 14.) WHERE) + +;;; State + +(DEFUN *INIT FEXPR (DIR) + (COND ((INIT (CAR DIR)) + (TERPRI TYO) + (PRINC '|(Initialized)| TYO) + (WASH)))) + +(DEFUN INIT (DIR) + (COND ((GET 'GAME 'BEING-PLAYED) + (TERPRI TYO) + (PRINC '|(Game in progress. Can't quit now!)| TYO) + ()) + (T + (LET ((STATE (CASEQ DIR (+ '\) (- '//)))) + (MAPC (LAMBDA (X) (PUTPROP X STATE 'STATE)) + OBJECT-LIST) + T)))) + +(INIT '+) + +(DEFUN INVERT (X) (CDR (ASSQ X '((// . \) (\ . //))))) + +(DEFUN STATE (X) (GET X 'STATE)) + +(DEFUN *COMPLEMENT (X) + (LET ((STATE (INVERT (STATE X)))) + (PUTPROP X STATE 'STATE) + STATE)) + +(DEFUN COMPLEMENT FEXPR (X) (*COMPLEMENT (CAR X))) + +(DEFUN DISPLAY () + (CURSORPOS 0. 0. TYO) + (CURSORPOS 'L TYO) + (COND (MODE + (PRINC '|Score is | TYO) + (PRINC // TYO) + (PRINC '| to | TYO) + (PRINC \ TYO) + (PRINC '|. | TYO) + (PRINC MODE TYO)) + (T + (PRINC '|State= | TYO) + (LET ((BASE 2.)) + (MAPCAR 'PRINC + (EXTEND + (MAPCAR (FUNCTION (LAMBDA (X) (- X 48.))) + (EXPLODEN (SGET)))))))) + (MAPC 'DISPLAY-STATE OBJECT-LIST) + (CURSORPOS 'A TYO) + (TERPRI TYO) + (COND ((GET 'GAME 'BEING-PLAYED) + (COND ((EQ (GET 'GAME 'WHOSE-TURN) '//) + (PRINC '| <- You play next.| TYO)) + (T + (PRINC '| You play next. ->| TYO)))))) + + +(DEFUN DISPLAY-STATE (X) + (LET (((H . V) (GET X 'WHERE)) + (STATE (STATE X))) + (CURSORPOS H V TYO) + (PRINC X) + (CURSORPOS 'D TYO) + (CURSORPOS 'B TYO) + (PRINC '| | TYO) + (CURSORPOS 'B TYO) + (PRINC (OR (GET X STATE) STATE) TYO))) + +(DEFUN PROMPT () + (GAME-END-CHECK) + (DISPLAY) + (TERPRI TYO) + (TERPRI TYO) + (TYI TYI)) + +(DEFUN WASH () (CURSORPOS 'E TYO)) + +(DEFUN EXECUTE () + (UNWIND-PROTECT (PROGN (TTY-OFF) (EXECUTE1)) (TTY-ON))) + +(SETQ DIAMOND-1 #01011010) +(SETQ DIAMOND-2 #10100101) + +(DEFUN EXECUTE1 () + (CURSORPOS 'C TYO) + (DO ((C (PROMPT) (PROMPT))) + ((= C 17.) (PRINC '|Quit.| TYO) (QUIT) T) + (COND ((OR (= C 65.) (= C 97.)) (*DROP A)) + ((OR (= C 66.) (= C 98.)) (*DROP B)) + ((OR (= C 67.) (= C 99.)) (*DROP C)) + ((OR (= C 82.) (= C 114.)) (*RANDOMIZE)) + ((OR (= C 81.) (= C 113.)) + (TERPRI TYO) + (COND ((GET 'GAME 'BEING-PLAYED) + (TYO 7. TYO) + (SETQ MODE '|(Game Halted)|) + (REMPROP 'GAME 'BEING-PLAYED) + (PRINC '|(Game Halted)| TYO)) + (T + (PRINC '|(No game to halt?)| TYO))) + (WASH)) + ((= C 92.) (*INIT +)) + ((= C 47.) (*INIT -)) + ((= C 43.) + (TERPRI TYO) + (COND ((NOT (GET 'GAME 'BEING-PLAYED)) + (SRESET DIAMOND-2) + (PRINC '|(Diamond 2)| TYO)) + (T + (PRINC '|(Game in progress?)| TYO))) + (WASH)) + ((= C 45.) + (TERPRI TYO) + (COND ((NOT (GET 'GAME 'BEING-PLAYED)) + (SRESET DIAMOND-1) + (PRINC '|(Diamond 1)| TYO)) + (T + (PRINC '|(Game in progress?)| TYO))) + (WASH)) + ((= C 12.) (CURSORPOS 'C TYO)) + ((= C 13.) (GAME-BEGIN)) + ((= C 10.) (GAME-RESTART)) + ((OR (= C 32.) (= C 9.))) + ((= C 19.) (SREMEMBER)) + ((= C 18.) (SRECALL)) + ((= C 27.) (ALTER)) + ((OR (= C 63.) (= C 2120.)) + (SHORT-RULES)) + ((OR (= C 72.) (= C 104.)) + (LONG-RULES)) + (T + (TYO 7. TYO) + (TERPRI TYO) + (PRINC '|(Type "?" for help)| TYO) + (WASH))))) + +(DEFUN *DROP FEXPR (X) + (SETQ X (CAR X)) + (TERPRI TYO) + (PRINC `(|Drop| ,X) TYO) + (WASH) + (DROP X)) + +(DEFUN DROP (X) + (LET* ((STATE (STATE X)) + (POINTER (GET X 'POINTER)) + (NEXT (CASEQ STATE (// (CAR POINTER)) (\ (CDR POINTER))))) + (*COMPLEMENT X) + (COND (NEXT (DROP NEXT)) + ((EQ X 'F) (DEFPROP GAME // WHOSE-TURN)) + ((EQ X 'G) (PUTPROP 'GAME STATE 'WHOSE-TURN)) + (T (DEFPROP GAME \ WHOSE-TURN))))) + +(DEFUN INIT-TURN () + (PUTPROP 'GAME (COND ((MAYBE) '//) (T '\)) 'WHOSE-TURN)) + +(DEFUN ALTER () + (COND ((NOT (GET 'GAME 'BEING-PLAYED)) + (CURSORPOS NIL 0. TYO) + (CURSORPOS 'L TYO) + (PRINC '|Complement: | TYO) + (LET ((C (TYI TYI))) + (SETQ C (ASCII (COND ((AND (> C 96.) (< C 123.)) + (SETQ C (- C 32.))) + (T C)))) + (TERPRI TYO) + (COND ((MEMQ C OBJECT-LIST) + (*COMPLEMENT C) + (PRINC `(,C |has been complemented|) TYO)) + (T + (PRINC `(|No node | ,C |... Request ignored|) TYO))) + (WASH))) + (T + (TERPRI TYO) + (PRINC '|(Game in progress. Don't try to cheat!)| TYO) + (WASH)))) + +(DEFUN MAYBE () (ZEROP (RANDOM 2.))) + +(DEFUN *RANDOMIZE () + (COND ((GET 'GAME 'BEING-PLAYED) + (TERPRI TYO) + (PRINC '|(Can't Randomize. Game in progress)| TYO)) + (T + (RANDOMIZE) + (PARITY-CHECK) + (TERPRI TYO) + (PRINC '|(Randomized)| TYO))) + (WASH)) + +(DEFUN RANDOMIZE () + (MAPC (LAMBDA (X) (COND ((MAYBE) (*COMPLEMENT X)))) + OBJECT-LIST)) + +(SETQ MODE () // 0. \ 0.) + +(DEFUN GAME-END-CHECK () + (COND ((GET 'GAME 'BEING-PLAYED) + (DO ((S (STATE (CAR OBJECT-LIST))) + (X (CDR OBJECT-LIST) (CDR X))) + ((NULL X) + (TYO 7. TYO) + (SET S (1+ (EVAL S))) + (SETQ MODE '|(Game Over)|) + (REMPROP 'GAME 'BEING-PLAYED)) + (COND ((NOT (EQ S (STATE (CAR X)))) + (RETURN ()))))))) + +(DEFUN GAME-BEGIN () + (COND ((GET 'GAME 'BEING-PLAYED) + (TERPRI TYO) + (PRINC '|(Game already going?)| TYO)) + (T + (SETQ MODE '|(Game in Progress)|) + (INIT-TURN) + (PUTPROP 'GAME T 'BEING-PLAYED) + (COND ((ZEROP (RANDOM 2.)) + (SRESET DIAMOND-1)) + (T + (SRESET DIAMOND-2))) + (PRINC '|(Game started)| TYO) + (WASH)))) + +(DEFUN GAME-RESTART () + (COND ((GET 'GAME 'BEING-PLAYED) + (TERPRI TYO) + (PRINC '|(Game already going?)| TYO)) + (T + (SETQ MODE '|(Game in Progress)|) + (PUTPROP 'GAME T 'BEING-PLAYED) + (PRINC '|(Game started)| TYO) + (WASH)))) + +(DEFUN PARITY-CHECK () + (LET ((P PARITY-LIST)) + (DO ((X P (CDR X)) + (I 0.)) + ((NULL X) + (COND ((ODDP (+ I)) (*COMPLEMENT (NTH (RANDOM 6.) P))))) + (COND ((EQ (STATE (CAR X)) '//) (SETQ I (1+ I))))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;; TTY On/Off Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; This section of code written by RWK. + +;;; If this is the first time loading the file, save out info on tty +;;; initial specifications. + +(COND ((NOT (BOUNDP 'TTY-SPEC-INFO)) + (SETQ TTY-SPEC-INFO (SYSCALL 3. 'TTYGET TYI)))) + +;;; TTY-OFF +;;; Turns off automatic echo of input chars on the tty. + +(DEFUN TTY-OFF () + (SYSCALL 0 'TTYSET TYI + (BOOLE 1 (CAR TTY-SPEC-INFO) 3272356035.) + (BOOLE 1 (CADR TTY-SPEC-INFO) 3272356035.))) + +;;; TTY-ON +;;; Re-enable automatic echo of input-chars on the tty. + +(DEFUN TTY-ON () + (SYSCALL 0 'TTYSET TYI + (CAR TTY-SPEC-INFO) + (CADR TTY-SPEC-INFO))) + + +(DEFUN SGET () + (LET ((IBASE 2.)) + (READLIST (APPEND (MAPCAR 'SGET1 OBJECT-LIST) '(32.))))) + +(DEFUN SGET1 (X) + (COND ((EQ (STATE X) '//) '/0) + (T '/1))) + +(DEFUN SRESET (X) + (LET ((BASE 2.)) + (MAPC 'SRESET1 + (EXTEND (MAPCAR (FUNCTION (LAMBDA (X) (- X 48.))) (EXPLODEN X))) + OBJECT-LIST))) + +(DEFUN EXTEND (X) + (COND ((= (LENGTH X) (LENGTH OBJECT-LIST)) X) + (T (EXTEND (CONS 0. X))))) + +(DEFUN SRESET1 (STATE OBJECT) + (PUTPROP OBJECT + (COND ((ZEROP STATE) '//) + (T '\)) + 'STATE)) + +(DEFUN SRECALL () + (TERPRI TYO) + (COND ((NOT (GET 'GAME 'BEING-PLAYED)) + (SRESET REMEMBER) + (PRINC '|(State Recalled)| TYO)) + (T + (PRINC '|(Game in progress. Can't hack states.)| TYO))) + (WASH)) + +(DEFUN SREMEMBER () + (TERPRI TYO) + (SETQ REMEMBER (SGET)) + (PRINC '|(State Stored)| TYO) + (WASH)) + + +(DEFUN SHORT-RULES () + (PRINC SHORT-RULES TYO) + (WASH)) + +(DEFUN LONG-RULES () + (CURSORPOS 'C TYO) + (*CATCH 'MORE-FLUSH + (PROGN + (DO ((I 1. (1+ I)) + (END (FLATC LONG-RULES)) + (C)) + ((> I END)) + (SETQ C (GETCHARN LONG-RULES I)) + (COND ((= C 12.) + (TERPRI TYO) + (CURSORPOS 'E TYO) + (CLEAR-INPUT TYI) + (PRINC '|--Type a Space to See More--| TYO) + (COND ((NOT (= (TYI TYI) 32.)) + (*THROW 'MORE-FLUSH T))) + (CURSORPOS 0. 0. TYO)) + ((= C 13.) + (CURSORPOS 'L TYO) + (TYO C TYO)) + (T + (TYO C TYO)))) + (TERPRI TYO) + (PRINC '|--Pause--| TYO) + (CURSORPOS 'E TYO) + (TYI TYI))) + (CURSORPOS 'C TYO)) + + +(DO ((I 0. (1+ I))) + ((> I 127.)) + (SSTATUS TTYINT I NIL)) +(SSTATUS TOPLEVEL '(PROGN (CLEAR-INPUT TYI) (EXECUTE))) +(SETQ TTY-RETURN '(LAMBDA N (CURSORPOS 'C TYO) + (DISPLAY) + (TERPRI TYO) + (TERPRI TYO))) + +(LET ((INIT-FILE (PROBEF `((DSK ,(STATUS HSNAME)) ,(STATUS USERID) THINK)))) + (COND (INIT-FILE (LOAD INIT-FILE)))) + +(INIT '+) + +(SETQ REMEMBER 0.) + +(NOINTERRUPT NIL) + diff --git a/src/games/wa.(init) b/src/games/wa.(init) new file mode 100644 index 00000000..053892ab --- /dev/null +++ b/src/games/wa.(init) @@ -0,0 +1,349 @@ + +(comment) + +(progn ;don't print out stuff + (princ '|Please wait while I get ready|) + (alloc '(REGPDL 120000.)) + (alloc '(SPECPDL 48000.)) + (alloc '(FIXPDL 24000.)) + (alloc '(LIST 75000.)) + (alloc '(SYMBOL 48000.)) + (alloc '(FIXNUM 75000.)) + (alloc '(FLONUM 75000.)) + (alloc '(BIGNUM 12000.)) + (alloc '(ARRAY 12000.)) + +(setsyntax '/ +'/ '/ ) + (defprop debug ((dsk rwk) debug fasl) autoload) + (defprop bt ((dsk rwk) debug fasl) autoload) + (setq *rset t) + ;;; SC-HELP calls for human intervention when appropriate. + + (defun g-*uwrite (name mode newdefault) + (DECLARE (SPECIAL UWRITE OUTFILES)) + (cond (uwrite + (setq outfiles (delq uwrite outfiles)) + (close uwrite) + (setq uwrite nil))) + ((lambda (file) + (setq outfiles + (cons (setq uwrite file) + outfiles)) + (car (defaultf newdefault))) + (open name mode))) + +(DEFUN G-TERPRI NIL + (DECLARE (SPECIAL GV-CURSORPOS G-SILENT *SS-ACTIVE)) + (SETQ GV-CURSORPOS 0.) + (COND ((AND G-SILENT + (OR *SS-ACTIVE + (NOT (CURSORPOS)) + (= (CDR (CURSORPOS)) 0.))) + (SETQ ^W T) + (TYO 13.) + (SETQ ^W NIL)) + (T (TYO 13.)))) + +(DEFUN SC-HELP (CAUSE) + (G-TSAY '(|****** This student's model is beyond my limitations. ******|)) + (COND ((< SL-REPEAT 0.0) + (SETQ SL-REPEAT 0.9) + (SC-UPDATE-MODEL))) + (SETQ SC-NOTEST CAUSE)) + + (DEFUN GCI-CREATE NARGS + (CONS (ARG 1.) + (GCI-WCREATE (ARG 1.) + NIL + (COND ((> (ARG NIL) 1.) (ARG 2.)))))) + + ;;; GCI-WCREATE does the actual work of WGI-CREAT. + + (DEFUN GCI-WCREATE (NUM LIST VALS) + (COND ((< NUM 1.) (RPLACD (LAST LIST) LIST)) + (T (GCI-WCREATE (1- NUM) + (CONS (GCI-VAL VALS) LIST) + (CDR VALS))))) + + ;;; GCI-VAL returns the appropriate value. + + (DEFUN GCI-VAL (VALS) (COND ((ATOM VALS) NIL) (T (CAR VALS)))) + + (ENDPAGEFN TYO NIL) + (SETSYNTAX 46. 128. NIL) + (SETQ IBASE 10. + BASE 10. + *NOPOINT T + *SS-ACTIVE nil + *SS-VERSION NIL + WE-VERSION '|eight| + WEV-RECREATE NIL + WE-GAME-HIST NIL + DB-NUM-CRULES 6. + DB-NUM-RULES 19. + DB-NUM-PROP 7. + DB-NUM-DPROP 18. + DB-DATE 0. + WAV-TOLD-RULE NIL + CX-WHY-BETTER NIL + CX-WHY-WORSE NIL + EGV-PLURAL 'EGV-PLURAL + EGV-BECAUSE '(|, because|) + EG-SPEC 'EG-SPEC + SC-LREPEAT 0.0 + SC-UREPEAT 5.0 + SC-LFORGET 2.0 + SC-UFORGET 30.0 + LEG-THEREFORE (GCI-CREATE 3. + '((|, and so|) + (|. Therefore|) + (|. Hence|))) + LEG-ALSO (GCI-CREATE 3. + '((|. Also,|) + (|, and|) + (|. Likewise,|))) + LEG-CONVERSELY (GCI-CREATE 2. + '((|. Conversely,|) + (|. In contrast,|))) + LEG-HOWEVER (GCI-CREATE 2. + '((|. However|) (|, but|))) + LWA-TELL-C4 (GCI-CREATE 3. + '((LIST '|I don't know,| + DB-NAME + '|, but|) + (LIST '|Well,| + DB-NAME + '|, I think that|) + (LIST '|You know,| + DB-NAME + '|,|))) + LWAW-TELL-WANDER (GCI-CREATE 3. + '((LIST DB-NAME + '|, we seem to be going in circles|) + (LIST '|I seem to remember just| + '|coming from that cave,| + DB-NAME) + (LIST '|We seem to be wandering aimlessly,| + DB-NAME))) + G-DOUBLESPACE NIL + G-LAST 32. + G-BLAST 32. + G-BBLAST 46. + G-SILENT nil + G-READ-NUM 1. + GV-CURSORPOS 0. + XP-P12-CHANGED NIL + SC-INCREASE-FORGET NIL + SC-DECREASE-FORGET NIL + SC-INCREASE-REPEAT NIL + SC-DECREASE-REPEAT NIL + SF-VAR-LIST '(DB-UNAME DB-NAME + DB-LAST-DATE + DB-NUMWINS + DB-NUMLOSSES + DB-MOVES + DB-DEBUG + DB-COMMENT + SL-REPEAT + SL-FORGET + SL-RECEPTIVITY + SL-HEARD-OF + WA-CAN-BACKTRACK + WA-TOLD-BACKTRACK + WE-MOVE-NUM + SL-LAST-LEARNED + SC-INITIALIZED + SL-TUTOR + DB-GAME-NUM + DB-HISTORY)) + (ARRAY ADB-CAVE T 1. DB-NUM-PROP) + (ARRAY ADB-DCAVE T 1. DB-NUM-DPROP 1.) + (ARRAY AEG-TELL-AVOID T 3. 3.) + (ARRAY ADB-TELL-WARNING T 3. 3.) + (ARRAY ADB-TELL-DANGER T 3. 3.) + (ARRAY ASK-WDRULES FIXNUM (1+ DB-NUM-RULES) 2. 3.) + (ARRAY ASK-DRULES FLONUM (1+ DB-NUM-RULES) 2. 3.) + (ARRAY AWE-EXPL-RULES T 16.) + (ARRAY ASL-PHASE-RULES T 5. 3.) + (ARRAY ASL-NEXT-RULES T 5. 3.) + (ARRAY ASL-PNUM-DANGERS T 5. 3.) + (ARRAY ASKC-RULES T 8. 3.) + (ARRAY AEG-NUMBER T 10.) + (MAPC (FUNCTION (LAMBDA (X) (*ARRAY X T 3.))) + '(AXS-CHANGED-SETS AEG-DANGER-SING AEG-DANGER-PLUR + ASL-WORK-ON-RULES AXR-FOUND-N AXS-EXACT-CAVES + AXS-PARTIAL-SETS AXS-COMPLETE-SETS + APS-RULE-ARRAY AEG-WARNING-PRES AEG-WARNING-PAST + ASC-INITIALIZED AEG-ENCOUNTER AWA-TOLD-RULES)) + (MAPC (FUNCTION (LAMBDA (X) (*ARRAY X 'FIXNUM 3.))) + '(ADB-NUM-DANGERS ADB-WARNING-DIST AXR-NUM-IDENTIFIED + ASL-PHASE ADB-DIST-START)) + (MAPC (FUNCTION (LAMBDA (X) (*ARRAY X 'FLONUM 3.))) + '(AXX-EST-NUM-DANGERS AXP-PROB12)) + (MAPC (FUNCTION (LAMBDA (X Y) + (DECLARE (SPECIAL EGV-PLURAL)) + (PUTPROP EGV-PLURAL Y X))) + '(|is cave| |is| |can| |could| |is rule|) + '(|are caves| |are| |can| |could| |are rules|)) + (MAPC (FUNCTION (LAMBDA (X Y) + (DECLARE (SPECIAL EG-SPEC)) + (PUTPROP EG-SPEC Y X))) + '(|were| |fell|) + '(|would have been| |would have fallen|)) + (MAPC (FUNCTION (LAMBDA (X Y) (STORE (ASKC-RULES X 1.) Y))) + '(7. 6. 5. 4. 3. 2. 1. 0.) + '(0. 2. 1. 2. 0. 0. 0. 0.)) + (MAPC (FUNCTION (LAMBDA (X A B C D E F G H I) + (STORE (ASL-PHASE-RULES X 0.) A) + (STORE (ASL-PHASE-RULES X 1.) B) + (STORE (ASL-PHASE-RULES X 2.) C) + (STORE (ASL-NEXT-RULES X 0.) D) + (STORE (ASL-NEXT-RULES X 1.) E) + (STORE (ASL-NEXT-RULES X 2.) F) + (STORE (ASL-PNUM-DANGERS X 0.) G) + (STORE (ASL-PNUM-DANGERS X 1.) H) + (STORE (ASL-PNUM-DANGERS X 2.) I))) + '(4. 3. 2. 1. 0.) + '((14.) (6. 10. 12. 13.) (4. 7. 11.) (0. 3. 5.) (1.)) + '((14.) (6. 9. 10. 12. 13.) (4. 7. 11.) (0. 3. 5.) + (1.)) + '((12. 13.) (6. 8. 9. 10. 11. 15.) (4. 7.) + (0. 2. 3. 5. 19.) (1.)) + '((14.) (12. 13.) (4. 7. 11.) (3. 5.) (1.)) + '((14.) (12. 13.) (4. 7. 11.) (3. 5.) (1.)) + '((12. 13.) (11.) (4. 7.) (3. 5. 19.) (1.)) + '(4. 3. 3. 2. 1.) + '(2. 3. 3. 2. 1.) + '(2. 1. 1. 1. 1.)) + (MAPC (FUNCTION (LAMBDA (W A B C D E) + (STORE (ASL-PHASE W) 0.) + (STORE (ASL-WORK-ON-RULES W) + (ASL-PHASE-RULES 0. W)) + (STORE (AEG-ENCOUNTER W) A) + (STORE (AEG-WARNING-PRES W) B) + (STORE (AEG-WARNING-PAST W) C) + (STORE (AEG-DANGER-SING W) D) + (STORE (AEG-DANGER-PLUR W) E))) + '(0. 1. 2.) + '((|were| |picked up by|) (|fell| |into|) + (|were| |eaten by|)) + '((|hear squeaking|) (|feel a breeze|) + (|smell the Wumpus|)) + '((|heard squeaking|) (|felt a breeze|) + (|smelled the Wumpus|)) + '((|bats|) (|a pit|) (|the Wumpus|)) + '((|bats|) (|pits|) (|the Wumpus|))) + (MAPC (FUNCTION (LAMBDA (X Y) (STORE (AEG-NUMBER X) Y))) + '(9. 8. 7. 6. 5. 4. 3. 2. 1. 0.) + '((|ten|) (|nine|) (|eight|) (|seven|) (|six|) + (|five|) (|four|) (|three|) (|two|) (|one|))) + (MAPC (FUNCTION (LAMBDA (X Y) (STORE (AWE-EXPL-RULES X) Y))) + '(15. 14. 13. 12. 11. 10. 9. 8. 7. 6. 5. 4. 3. 2. 1. 0.) + '((|P15, Shooting Principle, Whenever the probability of| + |the Wumpus being in a cave exceeds 0.25, it is safer to| + |shoot into the cave before visitng it. Hence, the more| + |likely it is that the Wumpus is in the cave, the less| + |likely it is that the player will be killed.|) + (|P14, Adjust For Multiple Evidence Principle, In cases| + |where P13 is applied, the other members of said| + |cave-set are less likely to contain the danger.|) + (|P13, Multiple Evidence Principle, if there is multiple| + |evidence that a given cave contains a danger (i.e. it| + |is a member of two cave-sets), then it is more likely| + |that the given cave contains the danger.|) + (|P12, Explain Away Evidence Principle, When it is noted| + |that there are two cave-sets, one of which is a subset| + |of the other, there is no evidence that those caves| + |in the superset and not in the subset whether or| + |not said caves contain a danger (as the caves in the| + |subset completely explain the warning) so the| + |probability is reduced to some consistent value.|) + (|P11, Equal Likelihood Principle, An estimation of| + |the probability for a given cave is 1N, where N| + |is the number of caves in the smallest cave-set| + |of which said cave is a member.|) + (|L10, Certain caves can be marked as "more than zero| + |away" based on consideration of the different| + |complete cave-sets and the number of dangers. |) + (|L9, If the player encountered a danger in a cave,| + |then the cave does not contain a danger of higher| + |priority, i.e. the Wumpus eats the player before| + |he can fall into a pit, and he will fall into a| + |pit before he is picked up by bats.|) + (|L8, When the algorithm is creating cave-sets and| + |it encounters a cave which would be N caves away| + |but which is also "more than N away", then that cave| + |can not have any contributions to the cave-set. |) + (|L7, If a cave is "more than (N-1) away" and| + |"less than (N+1) away", then it is "N away". |) + (|L6, If all of a caves neighbors are "more than| + |(N-1) away", then it can be marked "more than N away". |) + (|L5, If a cave is marked "more than N away" then all| + |of its neighbors can be marked as "more than (N-1) away". |) + (|L4, If a cave is visited and there is a warning,| + |then that cave is "less than (N-1) away". |) + (|L3, If a cave is visited and there is not a warning,| + |then that cave is "more than N away" where N| + |is the distance that the warning propagates. |) + (|L2, If the player shoots an arrow into a cave| + |and does not kill the Wumpus, then that cave can| + |be marked as "more than zero away" (Wumpus). |) + (|L1, A cave can be marked as "more than zero| + |away" if it was safely visited. |) + (|L0, A cave can be marked as "zero away" if it| + |was visited and found to contain a danger. |))) + ;;; The other dangers are set when it is known how many there are. + (MAPC (FUNCTION (LAMBDA (W A X Y Z) + (STORE (AEG-TELL-AVOID W Z) A) + (STORE (ADB-TELL-WARNING W Z) X) + (STORE (ADB-TELL-DANGER W Z) Y))) + '(0. 1. 2. 0. 1. 2. 0. 1. 2.) + '((APPEND '(|it is not wise to visit caves with bats| + |because while THEY will not harm us| + |they will carry us to another cave which| + |could contain|) (AEG-DANGER-SING 1.) '(|or|) (AEG-DANGER-SING 2.)) + (APPEND + '(|we should avoid bats because they| + |could drop us in a cave with|) + (AEG-DANGER-SING 1.) + '(|or|) + (AEG-DANGER-SING 2.)) + '(|it is best to avoid bats as they could carry us to a fatal cave|) + (APPEND '(|we should try not to stumble into|) + (AEG-DANGER-SING 1.) + '(|as it would be fatal|)) + '(|we should avoid pits as they are fatal|) + '(|pits are dangerous as falling into one is fatal|) + (APPEND '(|it is best to avoid|) + (AEG-DANGER-PLUR 2.) + '(|as|) + (AEG-DANGER-PLUR 2.) + '(|eats unwary players who stumble into his lair|)) + '(|we should avoid Wumpii as they eat unwary players|) + '(|Wumpii are dangerous as they have insatiable| + |appetites for bumbling players|)) + '((|Squeak. I hear bats, they must be in one of the neighboring caves. |) + (|Squeak. I hear bats. |) (|Squeak. |) + (|Brrrr. I feel a breeze! We must be next to a pit. |) + (|Brrrr. I feel a breeze. |) (|Brrrr. |) + (|Whew, what a stench! That is the smell of the Wumpus. | + |It means that we are within two caves of the Wumpus. |) + (|What a stench! The Wumpus is near. |) + (|What a stench! |)) + '((|Bon Voyage! We have been picked up by bats! |) + (|Bon Voyage! Bats have picked us up. |) + (|Bon Voyage! |) + (|So Loonnngggggggg. We have fallen into a pit. |) + (|So Loonnngggggggg. We have fallen in a pit. |) + (|So Loonnngggggggg. |) + (|Oh no, the Wumpus is in here! Chomp Chomp Chomp. |) + (|Oh no, it's the Wumpus! Chomp Chomp Chomp. |) + (|Chomp Chomp Chomp. |)) + '(0. 0. 0. 1. 1. 1. 2. 2. 2.)) + (terpri) + (load '((dsk games) wa fasl)) + (princ '|thanks for waiting, we are about to begin|) + (restart)) + + \ No newline at end of file diff --git a/src/games/wa.10 b/src/games/wa.10 new file mode 100644 index 00000000..f8da722c --- /dev/null +++ b/src/games/wa.10 @@ -0,0 +1,6901 @@ + +;;; The functions have been organized into different modules +;;; as described in the paper about the Wumpus-Advisor. +;;; To help clarify the boundaries between the different +;;; functions and their respective domains, global variables +;;; and functions have been given prefixes to denote what +;;; tasks they are related to. In some cases it was not clear +;;; exactly what the prefix should have been, and so one +;;; was assigned somewhat arbitrarily. (This applies to the +;;; grey area between tasks). The reader can use the prefix as +;;; a general guide to the purpose of the different functions. +;;; +;;; WE_ This prefix indicates that the function +;;; is part of the highest level executive. +;;; +;;; WG_ This prefix is for functions dealing strictly with the +;;; game of the Wumpus itself. +;;; +;;; G_ This prefix is for general purpose routines that are used +;;; by many different modules and which expand LISP's capabilities. +;;; +;;; D_ This prefix is for the database maintenance routines. +;;; +;;; WA_ This prefix indicates that the function is considered +;;; to be part of the Wumpus-Advisor module. +;;; +;;; X_ This prefix is for the routines of the Wumpus Expert. +;;; +;;; C_ This prefix is for functions of the Move-Comparer +;;; module. +;;; +;;; PS_ This prefix is for the routines of the Psychologist module. +;;; +;;; S_ This is the prefix for the Student Model (a subset of the +;;; data base routines?). +;;; +;;; E_ This prefix is for functions of the English-Generation +;;; module. +;;; +;;; A__ Look again, this is not a function. It is an array. +;;; All arrays have the prefix of the module which +;;; maintains them preceded by an "A". (A prefix prefix?) +;;; +;;; L__ is the prefix prefix for variables which are circular lists. +;;; +;;; A "_" at the end of a prefix indicates that this slot may +;;; be used to further specify a sub-module within the given +;;; module. +;;; +;;; If the standard prefix is followed by an "R", then that +;;; function is a reference function, intended mainly to supply +;;; information to other modules. +;;; +;;; If the standard prefix is followed by a "V" then this is +;;; a variable which is set/used by a function of the same name. +;;; +;;; If the standard prefix is followed by a "T", then this +;;; function performs some tests before performing the expected tasks. +;;; +;;; Note that the three dangers are represented by numbers for +;;; efficiency, zero for bats, one for pits, and two for Wumpii. +;;; +;;; The information about the warren is stored in arrays. +;;; Danger specific information is keyed by: CAVE, ITEM, and DANGER. +;;; ITEMs are as follows +;;; 0 ... WG-DANGER +;;; 1 ... XD-MORE-THAN +;;; 2 ... XD-WHY-MORE-THAN +;;; 3 ... XD-LESS-THAN +;;; 4 ... XD-WHY-LESS-THAN +;;; 5 ... XD-EXACTLY +;;; 6 ... XD-WHY-EXACTLY +;;; 7 ... XS-MEMBER +;;; 8 ... XP-REDUNDANT +;;; 9 ... XP-PROB +;;; 10 .. XP-WHY-PROB +;;; 11 .. XP-P11 +;;; 12 .. XP-WHY-P12 +;;; 13 .. XP-P13 +;;; 14 .. XP-P14 +;;; 15 .. XP-WHY-P11 +;;; 16 .. XS-NUM +;;; 17 .. CX-PROB +;;; +;;; Other information about caves is keyed by: CAVE and ITEM. +;;; ITEMs are as follows: +;;; 0 ... WG-NEIGHBORS +;;; 1 ... WG-WARNINGS +;;; 2 ... XD-VISITED +;;; 3 ... XX-COST +;;; 4 ... XX-GAIN +;;; 5 ... XX-INDEX +;;; 6 ... XX-DANGERS + +(DECLARE (MUZZLED T)) + +(DECLARE (FIXNUM CAVE DANGER RULE O-CAVE O-DIST I J ORIGIN DIST B-MOVE W-MOVE)) + +(DECLARE (FLONUM PROB)) + +(DECLARE (*LEXPR SAVE WE-TELL-INFO-WORK WAW-GIVE-ROUTE GP-UNION + GC-MEMBER GC-AVERAGE WE-EXPL-RULE GCI-CREATE)) + +(DECLARE (*EXPR SC-HELP ENDPAGE CLOSE DEFAULTF MERGEF)) + +(DECLARE (ARRAY* (NOTYPE AEG-NUMBER 1. AXS-CHANGED-SETS 1. AEG-DANGER-SING 1. + AEG-DANGER-PLUR 1. ASL-WORK-ON-RULES 1. AXR-FOUND-N 1. + AXS-EXACT-CAVES 1. AXS-PARTIAL-SETS 1. AXS-COMPLETE-SETS 1. + APS-RULE-ARRAY 1. AEG-WARNING-PRES 1. AWE-EXPL-RULES 1. + AEG-WARNING-PAST 1. AEG-ENCOUNTER 1. AWA-TOLD-RULES 1. + ASL-PNUM-DANGERS 2. AEG-TELL-AVOID 2. ASL-PHASE-RULES 2. + ASL-NEXT-RULES 2. ADB-DCAVE 2. ADB-CAVE 2. ASKC-RULES 2. + ASC-INITIALIZED 1. ADB-TELL-DANGER 2. ADB-TELL-WARNING 2.) + (FIXNUM ADB-NUM-DANGERS 1. ADB-WARNING-DIST 1. + AXR-NUM-IDENTIFIED 1. ASL-PHASE 1. + ADB-DIST-START 1. ASK-WDRULES 3.) + (FLONUM AXX-EST-NUM-DANGERS 1. AXP-PROB12 1. ASK-DRULES 3.))) + +(DEFUN BEGIN NIL + (or (boundp we-version)(di-database)) + (SUSPEND)(*SS-INITIALIZE) (RESTART)) + +(DEFUN RESTART NIL + (DECLARE (SPECIAL *SS-ACTIVE G-SILENT)) + (or (boundp we-version)(di-database)) + (DI-INITIALIZE) + (WE-SESSION-LOOP) + (DB-END-SESSION) + (G-RISAY '(|I am returning you to top level|)) + (quit) + 'TRUTH) + +(DEFUN NOLINK NIL (*RSET T) (NOUUO T) (SSTATUS UUOLINKS)) + +;;; WE-SESSION-LOOP is the highest level loop of the executive. +;;;It cycles the player through the different games. + +(DEFUN WE-SESSION-LOOP NIL + (DECLARE (SPECIAL DB-NUMWINS WE-NORESTART DB-NUMLOSSES DB-HISTORY)) + (PROG NIL + AGAIN(COND ((DB-DEFINE-GAME) NIL) (T (GO END))) + (DB-INIT-NEWGAME) + LOOP (COND + ((WE-GAME-LOOP) + (SETQ DB-NUMWINS (1+ DB-NUMWINS) DB-HISTORY (CONS 1. DB-HISTORY))) + (WE-NORESTART + (SETQ DB-NUMLOSSES (1+ DB-NUMLOSSES) DB-HISTORY (CONS 0. DB-HISTORY))) + (T + (SETQ DB-NUMLOSSES (1+ DB-NUMLOSSES) DB-HISTORY (CONS 0. DB-HISTORY)) + (G-RSAY + '(|Would you like to take back your last move? |)) + (COND ((GQ-EVAL (G-READ 'NEW-GAME)) + (GO LOOP))))) + END (DB-END-GAME) + (G-RSAY (APPEND '(|Your record is|) + (EG-NUMBER DB-NUMWINS) + '(|wins and|) + (EG-NUMBER DB-NUMLOSSES) + '(|losses. |))) + (G-RSAY '(|Would you like to play again? |)) + (COND ((GQ-EVAL (G-READ 'NEW-GAME)) (GO AGAIN))))) + +;;; WE-GAME-LOOP is the executive that cycles through +;;;the different moves of the game. + +(DEFUN WE-GAME-LOOP NIL + (DECLARE (SPECIAL WE-DONE WE-RETURN WE-MOVE WE-LAST-MOVE + XD-VISITED-CAVES WG-HERE WE-DONE WE-MOVE-NUM)) + (DO ((WE-DONE NIL) (WE-RETURN NIL)) + (WE-DONE WE-RETURN) + (WA-SAYSTATUS) + (G-RSAY '(|What now? |)) + (WE-ERR-CHECK '(WA-UPDATE WG-HERE)) + (SETQ WE-MOVE (G-READ 'MOVE)) + (G-TERPRI) + (G-TERPRI) + (COND ((EQ WE-MOVE 'SHOOT) + (WE-SHOOT) + (SETQ WE-MOVE-NUM (1+ WE-MOVE-NUM))) + ((WE-CHECK-MOVE WE-MOVE)) + ((WE-ERR-CHECK '(WA-ANALYZE WE-MOVE))) + (T (SETQ WE-LAST-MOVE WG-HERE) + (SC-UPDATE-RECEPTIVITY WE-MOVE) + (COND ((NOT (MEMBER WE-MOVE XD-VISITED-CAVES)) + (SETQ WE-MOVE-NUM (1+ WE-MOVE-NUM)))) + (WG-MOVETO WE-MOVE))))) + +;;; WE-CHECK-MOVE is the function which insures that the move is a legal move. +;;;It returns nil if the move is a good move. + +(DEFUN WE-CHECK-MOVE (MOVE) + (DECLARE (SPECIAL WAD-KNOWNAREA WG-HERE WE-NORESTART WE-DONE + DB-NUM-CAVES)) + (COND + ((EQ MOVE 'ROUTE) (WE-GIVE-ROUTE) T) + ((EQ MOVE 'INFO) + (WA-UPDATE-FRINGE WG-HERE) + (WE-TELL-INFO) + T) + ((EQ MOVE 'VISITED) + (WA-UPDATE-FRINGE WG-HERE) + (WE-TELL-VISITED) + T) + ((EQ MOVE 'QUIT) + (SETQ WE-NORESTART T) + (SETQ WE-DONE T)) + ((NOT (FIXP MOVE)) + (G-RSAY '(|Please enter one of the following:|)) + (G-RISAY '(|A neighboring cave number. |)) + (G-RISAY '(|SHOOT, if you would like to shoot an arrow. |)) + (G-RISAY + '(|VISITED, if you would like to know the| + |caves we have visited. |)) + (G-RISAY + '(|INFO, if you would like to know about a| + |cave that we have already visited. |)) + (G-RISAY '(|ROUTE, if you would like a route to a cave. |)) + (G-RISAY + '(|(SAVE), if you would like to send some comments to my programmer. |)) + (G-RISAY '(|QUIT, if you would like to quit this game. |)) + T) + ((GP-CAVE-CHECK MOVE) T) + ((= MOVE WG-HERE) T) + ((MEMBER MOVE (WGR-NEIGHBORS WG-HERE)) NIL) + ((MEMBER MOVE WAD-KNOWNAREA) + (G-RSAY (LIST '|We can not go directly to cave| + MOVE + '|from cave| + WG-HERE + '|. |)) + T) + (T (G-RSAY (LIST '|We can not get to cave| + MOVE + '|from here. |)) + T))) + +;;; WE-TELL-VISITED tells the user what caves he has visited. + +(DEFUN WE-TELL-VISITED NIL + (DECLARE (SPECIAL XD-VISITED-CAVES)) + (G-RSAY (APPEND '(|We have visited|) + (EG-INSERT-AND '|cave| XD-VISITED-CAVES) + '(|. |)))) + +;;; WE-TELL-INFO tells the player about a cave that +;;;has been previously visited. + +(DEFUN WE-TELL-INFO NIL + (DECLARE (SPECIAL XD-VISITED-CAVES)) + (PROG (RESPONSE) + (WE-TELL-INFO-WORK) + LOOP (G-RSAY + '(|Would you like to find out about another cave? |)) + (SETQ RESPONSE (G-READ 'NO)) + (COND ((MEMBER RESPONSE XD-VISITED-CAVES) + (WE-TELL-INFO-WORK RESPONSE) + (GO LOOP)) + ((GQ-EVAL RESPONSE) (WE-TELL-INFO))))) + +;;; WE-TELL-INFO-WORK does the actual work of WE-TELL-INFO. + +(DEFUN WE-TELL-INFO-WORK NARGS + (PROG (CAVE) + (COND + ((= (ARG NIL) 0.) + (G-RSAY '(|What cave would you like to know about? |)) + (SETQ CAVE (G-READ 'CAVE))) + (T (SETQ CAVE (ARG 1.)))) + (G-TERPRI) + (COND + ((GP-CAVE-CHECK CAVE)) + ((NOT (XDR-VISITEDP CAVE)) + (G-RSAY (APPEND '(|We have not yet visited cave|) + (LIST CAVE '|. |)))) + (T + (G-RSAY (APPEND '(|The neighbors of cave|) + (LIST CAVE) + (EG-INSERT-AND '|is cave| + (WGR-NEIGHBORS CAVE)) + '(|. |))) + (G-RSAY + (APPEND + '(|It has|) + (EG-INSERT-AND + '|warning| + (MAPCAR + (FUNCTION + (LAMBDA (X) + (IMPLODE + (APPEND '(34.) + (EXPLODEN (CAR (ADB-TELL-WARNING 2. X))) + '(34.))))) + (WGR-WARNINGS CAVE))) + '(|. |))))) + (G-TERPRI))) + +;;; WE-GIVE-ROUTE gives routes to the player. + +(DEFUN WE-GIVE-ROUTE NIL + (DECLARE (SPECIAL WG-HERE WAD-FRINGE)) + (WAD-UPDATE-DIST WG-HERE) + (PROG (RESPONSE) + (WAW-GIVE-ROUTE) + LOOP (G-RSAY + '(|Would you like to give another destination? |)) + (SETQ RESPONSE (G-READ 'NO)) + (COND ((AND (MEMBER RESPONSE WAD-FRINGE) + (NOT (MEMBER RESPONSE + (WGR-NEIGHBORS WG-HERE)))) + (WAW-GIVE-ROUTE RESPONSE) + (GO LOOP)) + ((GQ-EVAL RESPONSE) (WE-GIVE-ROUTE))))) + +;;;....WE-SHOOT is the shoot function used by the WUMPUS-ADVISOR. + +(DEFUN WE-SHOOT NIL + (DECLARE (SPECIAL WE-SHOT WG-HERE WE-DONE)) + (WA-UPDATE-FRINGE WG-HERE) + (G-RSAY '(|Into which cave would you like to shoot? |)) + (SETQ WE-SHOT (G-READ 'SHOOT)) + (COND ((GP-CAVE-CHECK WE-SHOT)) + ((= WE-SHOT WG-HERE) + (G-RSAY '(|You have just shot yourself! |)) + (SETQ WE-DONE T)) + ((NOT (MEMBER WE-SHOT (WGR-NEIGHBORS WG-HERE))) + (G-RSAY (LIST '|You cant't shoot from cave| + WG-HERE + '|to| + WE-SHOT + '|. |))) + ((WE-ERR-CHECK '(WA-SHOOT-ANALYZE WE-SHOT))) + (T (SC-UPDATE-RECEPTIVITY (LIST 'SHOOT WE-SHOT)) + (WG-SHOOT WE-SHOT)))) + +;;; WE-NOTE-DANGER is called anytime a danger is encountered. + +(DEFUN WE-NOTE-DANGER (DANGER) + (DECLARE (SPECIAL WE-MOVE)) + (WA-TELL-DANGER DANGER) + (COND (WE-MOVE (*SXD-MARK-DANGER WE-MOVE DANGER) + (XD-MARK-DANGER WE-MOVE DANGER) + (SETQ WE-MOVE NIL)))) + +;;;********* The following routines are debugging routines. ******** +;;; WE-ERR-CHECK is intended to catch errors before the student +;;;is made aware of them. + +(DEFUN WE-ERR-CHECK (LIST) + (DECLARE (SPECIAL WEV-ERROR DB-DEBUG)) + (PROG (TEMP) + (COND (WEV-ERROR NIL) + (DB-DEBUG (RETURN (EVAL LIST))) + ((EQ (ERRSET (SETQ TEMP (EVAL LIST)) NIL) NIL) + (WE-ERROR LIST) + (RETURN NIL)) + (T (RETURN TEMP))))) + +;;; WE-ERROR is called whenever the Wumpus Advisor discovers an error. + +(DEFUN WE-ERROR (FUNC) + (DECLARE (SPECIAL DB-NAME WEV-ERROR WE-DONE WE-RETURN)) + (G-TSAY (LIST '|Bug at| FUNC '!)) + (COND + ((NOT WEV-ERROR) + (G-RISAY (LIST DB-NAME + '|, I am feeling very sick. I have called| + '|my doctor, but I don't think I will be| + '|able to finish this game. Would you like| + '|to finish this game alone? |)) + (COND ((NOT (GQ-EVAL (G-READ 'NO))) + (SETQ WE-DONE T WE-RETURN T))))) + (SETQ WEV-ERROR T) + (SAVE FUNC) + '(|Blah! |)) + +;;; SAVE saves all relevant imformation about the game. + +(DEFUN SAVE NARGS + (DECLARE (SPECIAL DB-UNAME WE-VERSION WE-GAME-HIST DB-TIME + DB-USER-ID WE-LAST-SESSION WE-THIS-SESSION + DB-OLD-USER-FILE DB-DEBUG)) + (PROG (TEMP MESSAGE) + (COND + ((= (ARG NIL) 0.) + (G-RSAY + '(|Please enter your impression of what| + |the problem is. End your comments| + |with two semicolons (followed by a| + |space). For example.... |)) + (G-RISAY '(|The problem is ... ;;|)) + (G-TERPRI) + (SETQ MESSAGE (G-READ-RESPONSE))) + (T (SETQ MESSAGE (ARG 1.)))) + (SETQ TEMP (STATUS CRUNIT)) + (G-APPEND-FILE (LIST 'bugs8 DB-USER-ID 'second 'ejs)) + (SETQ ^R T ^W T) + (PRIN1 (LIST DB-TIME + DB-DEBUG + WE-GAME-HIST + WE-VERSION + WE-LAST-SESSION + WE-THIS-SESSION + DB-OLD-USER-FILE + MESSAGE)) + (APPLY 'UFILE (LIST 'bugs8 DB-USER-ID 'second 'ejs)) + (SETQ ^R NIL ^W NIL) + (APPLY 'CRUNIT TEMP) + (COND ((= (ARG NIL) 0.) + (G-TSAY '(|*** Save finished. ***|)))))) + + +;;; WE-RECREATE is used to recreate a game situation that has been +;;;saved. It assumes that BEGIN has been called at least once. + +(DEFUN WE-RECREATE NIL + (DECLARE (SPECIAL FILE INFO HER-VERSION USER-FILE MESSAGE DB-TIME + WEV-RECREATE WE-VERSION G-DOUBLESPACE WE-LAST-SESSION + WE-THIS-SESSION)) + (PROG (FILE INFO HER-VERSION USER-FILE MESSAGE) + (SETQ G-DOUBLESPACE NIL) + (G-RSAY '(|What file would you like for me to read? |)) + (SETQ FILE (G-READ NIL)) + (APPLY 'UREAD FILE) + (SETQ ^Q T + INFO (READ)) + (MAPC 'SET + '(DB-TIME DB-DEBUG WEV-RECREATE HER-VERSION + WE-LAST-SESSION WE-THIS-SESSION USER-FILE + MESSAGE) + INFO) + (SF-STORE-USER-FILE USER-FILE) + ;;; Note that the moves were stored in reverse order. + (SETQ WEV-RECREATE (REVERSE WEV-RECREATE)) + (G-RSAY (LIST '|She was playing on version| + HER-VERSION + '|. |)) + (G-RSAY (LIST '|I am version| + WE-VERSION + '|. |)) + (G-RSAY (APPEND '(|Her message was:|) + (LIST MESSAGE) + '(|. |))) + (DB-DEFINE-GAME) + (DB-INIT-NEWGAME) + (G-RSAY '(|Would you like for me to make the moves? |)) + (COND ((GQ-EVAL (READ))) + (T (G-RSAY (APPEND '(|Her moves were;|) + WEV-RECREATE)) + (SETQ WEV-RECREATE NIL))) + (WE-GAME-LOOP))) + +;;; WE-*COMMANDS tells the user the different * commands that are available. + +(DEFUN WE-*COMMANDS NIL + (G-RSAY '(|The following commands are available:|)) + (G-RISAY '(|*? to print this out. |)) + (G-RISAY '(|*MODEL to see the Student Knowledge Model. |)) + (G-RISAY '(|*VARIABLE to see the Student Model variables. |)) + (G-RISAY + '(|*NOTUTOR to keep the Advisor from tutoring the student. |)) + (G-RISAY + '(|*TUTOR to turn on the Wumpus Advisor's tutor (this is the default). |)) + (G-RISAY + '(|*SEQUENCE to go through the standard sequence of warrens. |)) + (G-RISAY + '(|*COMMENT to have Wusor print out pedagaogical comments. |)) + (G-RISAY + '(|*NOCOMMENT to turn off the pedagogical commands. |)) + (G-RISAY + '(|*INDEX to get the expert's evaluation of the fringe caves. |)) + (G-RISAY + '(|*PROB (followed by a cave and a danger's initial) gives| + |the probability that a particular danger is in a cave. |)) + (G-RISAY + '(|*RULES (followed by a cave and a danger's initial) gives| + |the rules used in computing a probability for a cave. |)) + (G-RISAY + '(|*EXPL-RULES explains the meaning of various rules.|)) + (G-RISAY + '(|*EXPLAIN (followed by a cave and a danger's initial)| + |explains a probability for a cave. |)) + (G-RISAY '(|*CHEAT to get the location of the dangers. |)) + (G-RISAY + '(|*NUMB causes Wusor to output the interaction number. |)) + (G-RISAY '(|*NONUMB turns off these interaction numbers. |)) + (G-RISAY '(|*DEBUG to output any error messages, etc.. |)) + (G-RISAY '(|*NODEBUG to turn off the debugging features. |)) + (G-RISAY + '(|*EXEC to allow the evaluation of S-expressions. |))) + +;;; WE-CHEAT This function prints out where the bats, pits, and Wumpus are. + +(DEFUN WE-CHEAT NIL + (DECLARE (SPECIAL DB-NUM-CAVES)) + (G-RSAY '(| Cave Neighbors Wumpus Pit Bat|)) + (DO ((CAVNUM 0. (1+ CAVNUM))) + ((> CAVNUM (1- DB-NUM-CAVES))) + (G-RSAY (LIST '| | CAVNUM)) + (G-PSAY (WGR-NEIGHBORS CAVNUM) 8.) + (DO ((DANGER 2. (1- DANGER)) + (CURSOR 22. (+ CURSOR 5.))) + ((< DANGER 0.)) + (G-PSAY (COND ((WGR-DANGERP CAVNUM DANGER) '(Y)) + (T '(N))) + CURSOR)))) + +;;; WE-WRITE-INDEX outputs the experts work for the caves it is sent. + +(DEFUN WE-WRITE-INDEX (CAVE-LIST) + (COND + ((NULL CAVE-LIST) + (G-RISAY + '(|A "*" after the cave number indicates that these figures| + |reflect shooting into the cave before visiting it.|)) + (G-RSAY '(|Cave Cost Gain Index|))) + (T (WE-WRITE-INDEX (CDR CAVE-LIST)) + (G-RSAY (LIST '| | + (GP-MAKN (CAR CAVE-LIST) + (COND ((XPR-SHOOTP (CAR CAVE-LIST)) + '*) + (T '| |))))) + (G-PSAY (LIST (XXR-COST (CAR CAVE-LIST))) 8.) + (G-PSAY (LIST (XXR-GAIN (CAR CAVE-LIST))) 22.) + (G-PSAY (LIST (XXR-INDEX (CAR CAVE-LIST))) 36.)))) + +;;; WE-PROB explains the prob for a cave. + +(DEFUN WE-PROB NIL + (PROG (CAVE DANGER) + (SETQ CAVE (WE-GET-CAVE) DANGER (WE-GET-DANGER)) + (G-RISAY (APPEND '(|The probability of|) + (AEG-DANGER-SING DANGER) + (LIST '|being in cave| + CAVE + '|is|) + (LIST (XPR-PROB CAVE DANGER) + '|. |))))) + +;;; WE-RULES gives the rules used in the computation of the probability. + +(DEFUN WE-RULES NIL + (PROG (CAVE DANGER) + (SETQ CAVE (WE-GET-CAVE) DANGER (WE-GET-DANGER)) + (G-RISAY + (APPEND + '(|The rules used in the computation of the probability of|) + (AEG-DANGER-SING DANGER) + (LIST '|in cave| CAVE) + (EG-INSERT-AND '|is rule| + (CXR-PROB CAVE DANGER)) + '(|. |))))) + +;;; WE-EXPL-RULES explains a series of rules. + +(DEFUN WE-EXPL-RULES NIL + (PROG (RESPONSE) + (WE-EXPL-RULE) + LOOP (G-RSAY + '(|Would you like to find out about another rule? |)) + (SETQ RESPONSE (G-READ 'NO)) + (COND ((GP-NUM-TEST RESPONSE 20.) + (WE-EXPL-RULE RESPONSE) + (GO LOOP)) + ((GQ-EVAL RESPONSE) (WE-EXPL-RULES))))) + +;;; WE-EXPL-RULE does the actaul explanations. + +(DEFUN WE-EXPL-RULE NARGS + (PROG (RESPONSE) + (COND ((= (ARG NIL) 0.) + (G-RSAY '(|Please a rule number (0 to 15). |)) + (SETQ RESPONSE (G-READ 0.))) + (T (SETQ RESPONSE (ARG 1.)))) + (COND ((GP-NUM-TEST RESPONSE 16.) + (G-RSAY (AWE-EXPL-RULES RESPONSE))) + (T (G-RSAY (LIST '|There is no rule| + RESPONSE + '|. |)))))) + +;;; WE-EXPLAIN explains the probability for a given danger and cave. + +(DEFUN WE-EXPLAIN NIL + (PROG (CAVE DANGER) + (SETQ CAVE (WE-GET-CAVE) DANGER (WE-GET-DANGER)) + (G-RISAY (APPEND (EXR-PROB CAVE DANGER NIL) + '(|. |))) + (WA-MARK-RULES '|explain|))) + +;;; WE-GET-CAVE gets a cave number from the player. + +(DEFUN WE-GET-CAVE NIL + (DECLARE (SPECIAL DB-NUM-CAVES)) + (PROG (RESPONSE) + (COND ((GP-NUM-TEST (SETQ RESPONSE (G-SREAD 'CAVE)) + DB-NUM-CAVES) + (RETURN RESPONSE)) + (T (G-RSAY '(|Please enter a cave number. |)) + (RETURN (WE-GET-CAVE)))))) + +;;; WE-GET-DANGER gets the danegr from the player. + +(DEFUN WE-GET-DANGER NIL + (PROG (RESPONSE) + (COND + ((EQ (SETQ RESPONSE (G-SREAD 'B)) 'B) + (RETURN 0.)) + ((EQ RESPONSE 'P) (RETURN 1.)) + ((EQ RESPONSE 'W) (RETURN 2.)) + (T + (G-RSAY + '(|Please enter a danger's initial (B, P, or W). |)) + (RETURN (WE-GET-DANGER)))))) + +;;; WE-EXECUTE allows a debugger to execute commands +;;;without stopping the game. + +(DEFUN WE-EXECUTE NIL + (PROG (VAR) + (G-RSAY '(|Please enter an S-Expression. |)) + (COND ((SETQ VAR (G-READ NIL)) + (G-RSAY (ERRSET (EVAL VAR) T)) + (WE-EXECUTE))))) + + + +;;;************* The Wumpus Advisor Routines. ************ +;;; WA-ANALYZE analyzes the players desire to move to CAVE. +;;;A retrun value of NIL indicates that the player should be +;;;allowed to go ahead with the move. + +(DEFUN WA-ANALYZE (MOVE) + (DECLARE (SPECIAL WAM-NEXT-MOVE WA-CAN-BACKTRACK WE-LAST-MOVE + SL-REPEAT SL-TUTOR)) + (PS-UPDATE-MODEL MOVE) + (COND (WAM-NEXT-MOVE (WAM-TRANSPOSE-MOVE MOVE)) + ((EQUAL MOVE WE-LAST-MOVE) + (SETQ WA-CAN-BACKTRACK (1+$ WA-CAN-BACKTRACK)) + NIL) + ((NOT SL-TUTOR) NIL) + ((WAW-ROUTE-CHECK MOVE)) + ((XDR-VISITEDP MOVE) NIL) + ((SL-ADVISEP MOVE) NIL) + ((< WA-CAN-BACKTRACK SL-REPEAT) (WA-BACKTRACK MOVE)) + ((WA-CHECK-BETTER MOVE) (GQ-GO-AHEAD MOVE)) + ((WA-SHOOT-CHECK MOVE)))) + +;;; WA-SHOOT-ANALYZE analyzes the players desire shoot into CAVE. +;;;A return value of NIL indicates that the player should be +;;;allowed to go ahead with the shot. + +(DEFUN WA-SHOOT-ANALYZE (CAVE) + (DECLARE (SPECIAL WG-ARROWS LWA-CRULES DB-NAME)) + (COND + ((XPR-SHOOTP CAVE) (PS-MARK-SHOT CAVE) NIL) + ((SL-ADVISEP (LIST 'SHOOT CAVE)) NIL) + ((GC-MEMBER LWA-CRULES 9. 1.) NIL) + ((CMR-SAFEP CAVE '(2.)) + (G-RISAY + (APPEND (EXR-PROB CAVE 2. NIL) + '(|, and, if we shoot an arrow into cave|) + (LIST CAVE) + '(|, it could ricochet back and kill us. |))) + (PS-UNMARK-SHOT CAVE) + (WA-TOLD-RULE 15. 2.) + (WA-NOTE-ADVICE -1. (LIST 'SHOOT CAVE) 9.) + (WA-MARK-RULES 9.) + (GQ-SHOOT-ANYWAY CAVE)) + ((> (XPR-PROB CAVE 2.) 0.3) NIL) + ((NOT (WGR-EXTRA-ARROWS)) + (G-RISAY + (APPEND + '(|As we only have|) + (EG-NUMBER WG-ARROWS) + (EGT-PLURAL '(|arrow|) WG-ARROWS) + '(|left,|) + (LIST DB-NAME) + '(|, it might be wise to save this| + |arrow until we are more certain| + |of the location of|) + (AEG-DANGER-SING 2.) + '(|. |))) + (WA-NOTE-ADVICE -1. (LIST 'SHOOT CAVE) 9.) + (GQ-SHOOT-ANYWAY CAVE)) + ((> (XPR-PROB CAVE 2.) 0.21) NIL) + ((SLR-OK-RULESP (CXR-PROB CAVE 2.) 2.) + (G-RISAY + (APPEND + (EXR-PROB CAVE 2. NIL) + (LIST '|,| DB-NAME) + '(|, and a missed arrow is more dangerous than that. |))) + (PS-UNMARK-SHOT CAVE) + (WA-NOTE-ADVICE -1. (LIST 'SHOOT CAVE) 9.) + (WA-MARK-RULES 9.) + (GQ-SHOOT-ANYWAY CAVE)) + ((> (XPR-PROB CAVE 2.) 0.15) NIL) + (T + (G-RISAY + (APPEND + (LIST DB-NAME) + '(|, it is unlikely that cave|) + (LIST CAVE '|contains|) + (AEG-DANGER-SING 2.) + '(|, and we are more likely to be| + |killed by a missed arrow richocheting| + |through the warren. |))) + (PS-UNMARK-SHOT CAVE) + (WA-NOTE-ADVICE -1. (LIST 'SHOOT CAVE) 9.) + (GQ-SHOOT-ANYWAY CAVE)))) + +;;;....WA-SAYSTATUS outputs the game info as appropriate. + +(DEFUN WA-SAYSTATUS NIL + (DECLARE (SPECIAL WEV-ERROR WG-HERE)) + (G-RSAY (LIST '|We are now at cave| + WG-HERE + '|. |)) + (G-RSAY (APPEND '(|The neighboring caves are|) + (EG-INSERT-AND '|cave| + (WGR-NEIGHBORS WG-HERE)) + '(|. |))) + (COND ((NOT WEV-ERROR) + (MAPC (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL WG-HERE)) + (*SXD-MARK-NOWARNING WG-HERE X) + (XD-MARK-NOWARNING WG-HERE X))) + (GP-REMOVE-LIST '(0. 1. 2.) + (MAPC 'WA-NOTE-WARNING + (WGR-WARNINGS WG-HERE)))) + (*SXD-MARK-VISITED WG-HERE '(0. 1. 2.)) + (XD-MARK-VISITED WG-HERE '(0. 1. 2.))) + (T (MAPC 'WA-NOTE-WARNING + (WGR-WARNINGS WG-HERE)))) + (G-TERPRI)) + +;;; WA-UPDATE updates the database as necessary for each move. + +(DEFUN WA-UPDATE (CAVE) + (DECLARE (SPECIAL XX-CHANGED WAD-FRINGE WE-MOVE)) + (COND ((OR (MEMBER CAVE WAD-FRINGE) + ;;; This is in case we are picked up by bats. + (NOT WE-MOVE)) + (SETQ XX-CHANGED T) + (WA-UPDATE-FRINGE CAVE))) + (XX-UPDATE)) + +;;; WA-UPDATE-FRINGE updates the fringe, dist caves, and best-moves. + +(DEFUN WA-UPDATE-FRINGE (CAVE) + (DECLARE (SPECIAL WAW-GIVEN-ROUTE)) + (WAD-UPDATE-DIST CAVE) + (XX-UPDATE-MOVES) + (SETQ WAW-GIVEN-ROUTE NIL)) + +;;; WA-TELL-DANGER tells the player he has encountered a danger. + +(DEFUN WA-TELL-DANGER (DANGER) + (G-RSAY (ADB-TELL-DANGER (ASK-WDRULES 17. 0. DANGER) DANGER)) + (COND ((< (ASK-WDRULES 17. 0. DANGER) 2.) + (STORE (ASK-WDRULES 17. 0. DANGER) + (1+ (ASK-WDRULES 17. 0. DANGER)))))) + +;;; WA-NOTE-WARNING tells the player when he receives a warning. + +(DEFUN WA-NOTE-WARNING (DANGER) + (DECLARE (SPECIAL WEV-ERROR WG-HERE)) + (COND ((NOT WEV-ERROR) (XD-MARK-WARNING WG-HERE DANGER))) + (*SXD-MARK-WARNING WG-HERE DANGER) + (G-RSAY (ADB-TELL-WARNING (ASK-WDRULES 16. 0. DANGER) DANGER)) + (COND ((< (ASK-WDRULES 16. 0. DANGER) 2.) + (STORE (ASK-WDRULES 16. 0. DANGER) + (1+ (ASK-WDRULES 16. 0. DANGER)))))) + +;;; WA-BACKTRACK tells the student about backtracking if +;;;it is appropriate. (i.e. there is a good example). + +(DEFUN WA-BACKTRACK (MOVE) + (DECLARE (SPECIAL BETTER-MOVE XD-VISITED-CAVES WG-HERE)) + (PROG (BETTER-CAVE BETTER-MOVE TEMP) + (COND + ((NOT (XXR-DANGERS MOVE))) + ((SETQ + BETTER-CAVE + (GM-FIRST-TRUE + (FUNCTION + (LAMBDA (X) + (DECLARE (SPECIAL BETTER-MOVE WG-HERE)) + (COND + ((WGR-WARNINGS X) NIL) + ((SETQ + BETTER-MOVE + (GM-FIRST-TRUE + (FUNCTION (LAMBDA (Y) + (DECLARE (SPECIAL WAD-FRINGE WG-HERE)) + (AND (MEMBER Y WAD-FRINGE) + (NOT (MEMBER Y (WGR-NEIGHBORS WG-HERE)))))) + (WGR-NEIGHBORS X))))))) + XD-VISITED-CAVES)) + ;;; If controls gets to here, there was + ;;;a BETTER-MOVE (and BETTER-CAVE). + (WA-TELL-BACKTRACK MOVE BETTER-CAVE BETTER-MOVE TEMP) + (RETURN (COND ((GQ-GO-AHEAD MOVE)) + (T (WA-UPDATE-FRINGE WG-HERE) NIL))))))) + +;;; WA-TELL-BACKTRACK actually tells the player +;;;of the advantages of backtracking. + +(DEFUN WA-TELL-BACKTRACK (MOVE BETTER-CAVE BETTER-MOVE TEMP) + (DECLARE (SPECIAL WA-TOLD-BACKTRACK DB-NAME)) + (MAPC 'WA-TOLD-RULE + '(1. 1. 1.) + '(0. 1. 2.)) + (WA-NOTE-ADVICE BETTER-MOVE MOVE 8.) + (COND + (WA-TOLD-BACKTRACK (G-RISAY (LIST DB-NAME '|,|))) + ((SETQ WA-TOLD-BACKTRACK T) + (G-RSAY (LIST DB-NAME + '|, did you know that we can backtrack| + '|to caves that we have already visited? |)) + (COND ((GQ-EVAL (G-READ 'NO)) + (G-RISAY '(|Oh,... well then|))) + (T (G-RISAY '(|Well we can, so|)))))) + (G-SAY + (APPEND '(|why not go back to cave|) + (LIST BETTER-CAVE) + '(|where we didn't get any warnings at all. |) + '(|From there we can safely go to cave|) + (LIST BETTER-MOVE) + '(|without risking|) + (EG-DANGERS (XXR-DANGERS MOVE)) + '(|. |) + (COND ((SETQ TEMP (EGT-TELL-AVOID (XXR-DANGERS MOVE))) + (APPEND TEMP '(|. |)))))) + (WA-MARK-RULES 8.) + (*SS-TOLD-MOVE BETTER-MOVE MOVE 8.)) + +;;; WA-CHECK-BETTER sees if their is a better move that is +;;;explainable. If so, it tells the student about it and +;;;asks the student if he wants to go ahead with his move. + +(DEFUN WA-CHECK-BETTER (MOVE) + (DECLARE (SPECIAL MOVE DB-NUM-CRULES LWA-CRULES SL-MODE WG-HERE XX-BEST-MOVES)) + (PROG (BETTER-MOVES DANGERS) + (WA-UPDATE-FRINGE WG-HERE) + (COND + ((SETQ + BETTER-MOVES + (GM-ALL-TRUE + (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL MOVE LWA-BAD-MOVES LWA-GOOD-MOVES)) + (AND (NOT (GC-MEMBER LWA-GOOD-MOVES + X)) + (NOT (GC-MEMBER LWA-BAD-MOVES + X)) + (XXR-BETTER-MOVEP X MOVE)))) + XX-BEST-MOVES)) + ;;; If control gets to here there were better moves. + (G-RSAY '(|Hummmm. |)) + (G-TSAY + (APPEND + '(|*** Better moves which I have not| + |mentioned to the student recently are|) + (EG-INSERT-AND '|cave| BETTER-MOVES) + '(|. ***|))) + (SETQ DANGERS (XXR-DANGERS MOVE)) + ;;; Here we compute whether or not it is acceptable + ;;;to explain a given combination rule according + ;;;to how recently said rule was last explained. + (DO ((I 0. (1+ I))) + ((> I DB-NUM-CRULES)) + (STORE (ASKC-RULES I 2.) + (OR SL-MODE + (NOT (GC-MEMBER LWA-CRULES + I + (ASKC-RULES I 1.)))))) + (COND ((WA-CHECK-C6 (CAR XX-BEST-MOVES) MOVE) + (RETURN T)) + ((AND (ASKC-RULES 5. 2.) + (NOT (XSR-MEMBER MOVE 2.)) + (WA-CHECK-C5 BETTER-MOVES MOVE)) + (RETURN T)) + ((AND (ASKC-RULES 7. 2.) + (WA-CHECK-C7 BETTER-MOVES MOVE)) + (RETURN T)) + ((NOT DANGERS) NIL) + ((WA-CRULES BETTER-MOVES + MOVE + DANGERS + NIL + DANGERS) + (RETURN T))))))) + +;;; WA-CRULES implements rules C0 thru C4. They are combined +;;;together as for each cave, at most one rule can apply. It +;;;looks at the best move first, if for some reason that move +;;;can not be explained, it looks at the next move and so on. +;;;S-DANGERS contains those dangers which could be the identical. +;;;To insure that all possibilities are tried, it both chooses +;;;the first danger in O-DANGERS and doesn't choose it until +;;;there are no more caves in O-DANGERS. Then it begins its +;;;checks. At this point O-DANGERS is reset to those dangers +;;;which H-MOVE possesses, but the selected move does not (supposedly). + +(DEFUN WA-CRULES (BETTER-MOVES H-MOVE H-DANGERS S-DANGERS O-DANGERS) + (COND ((NULL BETTER-MOVES) NIL) + ;;; Choose all possibilities. + (O-DANGERS (OR (WA-CRULES BETTER-MOVES + H-MOVE + H-DANGERS + (CONS (CAR O-DANGERS) + S-DANGERS) + (CDR O-DANGERS)) + (WA-CRULES BETTER-MOVES + H-MOVE + H-DANGERS + S-DANGERS + (CDR O-DANGERS)))) + ;;; Does C0 apply? + ((AND (NULL S-DANGERS) + (CMR-SAFEP (CAR BETTER-MOVES) '(0. 1. 2.))) + ;;; If inappropriate to speak, return NIL (no speak). + (COND ((ASKC-RULES 0. 2.) + (WA-TELL-C0 (CAR BETTER-MOVES) + H-MOVE + H-DANGERS)))) + ;;; Does C1 apply? + ((AND (NULL S-DANGERS) + (ASKC-RULES 1. 2.) + (SLC-KNOWS-RULEP 0.) + (CMR-BETTER-PROBSP (CAR BETTER-MOVES) + H-MOVE + H-DANGERS) + (CMR-SAFEP (CAR BETTER-MOVES) + (GP-REMOVE-LIST '(0. 1. 2.) + H-DANGERS))) + (WA-TELL-C1 (CAR BETTER-MOVES) H-MOVE H-DANGERS)) + ;;; Does C4 apply? + ((AND (NULL S-DANGERS) + (ASKC-RULES 4. 2.) + (NOT (MEMBER 0. H-DANGERS)) + (EQUAL (XXR-DANGERS (CAR BETTER-MOVES)) + '(0.))) + (WA-TELL-C4 (CAR BETTER-MOVES) H-MOVE H-DANGERS NIL)) + ;;; We have tried all possibilities for this cave, + ;;;so try next cave. + ((NULL S-DANGERS) + (WA-CRULES (CDR BETTER-MOVES) + H-MOVE + H-DANGERS + NIL + H-DANGERS)) + ;;; Does C2 apply? + ((AND (CMR-SAME-DANGERSP H-MOVE + (CAR BETTER-MOVES) + S-DANGERS) + (SETQ O-DANGERS (GP-REMOVE-LIST H-DANGERS + S-DANGERS)) + (CMR-SAFEP (CAR BETTER-MOVES) + (GP-REMOVE-LIST '(0. 1. 2.) + S-DANGERS))) + ;;; If inappropriate to speak, return NIL (no speak). + (COND ((ASKC-RULES 2. 2.) + (WA-TELL-C2 (CAR BETTER-MOVES) + H-MOVE + S-DANGERS + O-DANGERS)))) + ;;; Does C3 apply? (Note that O-DANGERS is set with + ;;;a value only if S-DANGERS were O.K.) + ((AND O-DANGERS + (ASKC-RULES 3. 2.) + (SLC-KNOWS-RULEP 1.) + (SLC-KNOWS-RULEP 2.) + (CMR-BETTER-PROBSP (CAR BETTER-MOVES) + H-MOVE + (GP-REMOVE-LIST H-DANGERS + S-DANGERS)) + (CMR-SAFEP (CAR BETTER-MOVES) + (GP-REMOVE-LIST '(0. 1. 2.) + (APPEND S-DANGERS + H-DANGERS)))) + (WA-TELL-C3 (CAR BETTER-MOVES) + H-MOVE + S-DANGERS + O-DANGERS)) + ;;; Does C4 apply, but with dangers in common. + ((AND O-DANGERS + (ASKC-RULES 4. 2.) + (NOT (MEMBER 0. H-DANGERS)) + (GP-EQUIV (XXR-DANGERS (CAR BETTER-MOVES)) + (CONS 0. S-DANGERS))) + (WA-TELL-C4 (CAR BETTER-MOVES) + H-MOVE + O-DANGERS + S-DANGERS)))) + +;;; WA-TELL-C0 does the actual explanation of C0. + +(DEFUN WA-TELL-C0 (B-MOVE H-MOVE H-DANGERS) + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY + (APPEND (LIST DB-NAME) + '(|, we don't need to risk|) + (EG-DANGERS H-DANGERS) + (LIST '|in cave| H-MOVE '|as cave|) + (LIST B-MOVE '|is safe. |) + (EXR-SAFE-CAVE B-MOVE + (CMR-EXPLAIN-DANGER B-MOVE + B-MOVE + H-DANGERS)) + (COND ((GP-TEST H-DANGERS) + (APPEND (LIST '|. Likewise, cave| + B-MOVE) + '(|is safe from the other dangers|)))) + '(|. |))) + (WA-TOLD-MOVE B-MOVE H-MOVE 0.)) + +;;; WA-TELL-C1 does the actual explanation of C1 if appropriate. + +(DEFUN WA-TELL-C1 (B-MOVE H-MOVE H-DANGERS) + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY + (APPEND + (LIST DB-NAME) + '(|, it isn't necessary to take such large risks with|) + (EG-DANGERS H-DANGERS))) + (WA-COMP-PROBS B-MOVE H-MOVE H-DANGERS) + (WA-TOLD-MOVE (WA-COMP-CHECK B-MOVE) H-MOVE 1.)) + +;;; WA-TELL-C2 does the actual explanation of C2. + +(DEFUN WA-TELL-C2 (B-MOVE H-MOVE S-DANGERS O-DANGERS) + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY + (APPEND + (LIST DB-NAME) + '(|, I can see why we are risking|) + (EG-DANGERS S-DANGERS) + '(|, but we don't need to risk|) + (EG-DANGERS O-DANGERS) + '(|. |) + (EXR-SAFE-CAVE B-MOVE + (CMR-EXPLAIN-DANGER B-MOVE B-MOVE O-DANGERS)) + (COND ((GP-TEST O-DANGERS) + (APPEND (LIST '|. Likewise, cave| B-MOVE) + '(|is safe from the other dangers|)))) + (EG-THEREFORE) + '(|we might want to explore cave|) + (LIST B-MOVE '|instead of cave| H-MOVE '|. |))) + (WA-TOLD-MOVE B-MOVE H-MOVE 2.)) + +;;; WA-TELL-C3 does the actual explanation of C3 if appropriate. + +(DEFUN WA-TELL-C3 (B-MOVE H-MOVE S-DANGERS O-DANGERS) + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY + (APPEND '(|I can see why we are risking|) + (EG-DANGERS S-DANGERS) + (LIST '|,| DB-NAME) + '(|, but we don't need to take such large risks with|) + (EG-DANGERS O-DANGERS))) + (WA-COMP-PROBS B-MOVE H-MOVE O-DANGERS) + (WA-TOLD-MOVE (WA-COMP-CHECK B-MOVE) H-MOVE 3.)) + +;;; WA-TELL-C4 explains instances of C4 to the student. + +(DEFUN WA-TELL-C4 (B-MOVE H-MOVE O-DANGERS S-DANGERS) + (DECLARE (SPECIAL LWA-TELL-C4 DB-NAME)) + (COND + (S-DANGERS (G-RISAY (APPEND (LIST DB-NAME) + '(|I can see why we are risking|) + (EG-DANGERS S-DANGERS) + '(|, but|)))) + (T (G-RISAY (EVAL (GC-NEXT LWA-TELL-C4))))) + (G-SAY (APPEND '(|I would rather risk bats in cave|) + (LIST B-MOVE '|than|) + (EG-DANGERS O-DANGERS) + (LIST '|in cave| H-MOVE '|. |))) + (WA-TOLD-MOVE B-MOVE H-MOVE 4.)) + +;;; WA-CHECK-C5 checks if C5 applies and explains if appropriate. + +(DEFUN WA-CHECK-C5 (BETTER-MOVES H-MOVE) + (COND ((NULL BETTER-MOVES) NIL) + ((AND (NOT (XSR-GET-MEMBER-SETS (CAR BETTER-MOVES) 2.)) + (XSR-MEMBER (CAR BETTER-MOVES) 2.) + (SLR-OK-RULESP (CXR-VALUE (CAR BETTER-MOVES)) 2.)) + (WA-TELL-C5 (CAR BETTER-MOVES) H-MOVE)) + (T (WA-CHECK-C5 (CDR BETTER-MOVES) H-MOVE)))) + +;;; WA-TELL-C5 tells the player about C5, etc.. + +(DEFUN WA-TELL-C5 (B-MOVE H-MOVE) + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY + (APPEND (LIST '|cave| B-MOVE) + '(|is a very good cave to explore,|) + (LIST DB-NAME '|, as we know that|) + (EXT-CAVE-SET (CAAR (XSR-MEMBER B-MOVE 2.)) + 2. + T + (CADAR (XSR-MEMBER B-MOVE 2.))) + (EG-THEREFORE) + '(|if we visit cave|) + (LIST B-MOVE) + '(|we will gain information about the location of|) + (AEG-DANGER-SING 2.) + '(|. |))) + (WA-TOLD-MOVE B-MOVE H-MOVE 5.)) + +;;; WA-COMP-PROBS makes a comparison of two probs for DANGERS. + +(DEFUN WA-COMP-PROBS (BETTER WORSE DANGERS) + (DECLARE (SPECIAL BETTER WHY-BETTER WHY-WORSE DB-NAME)) + (PROG (T-DANGER WHY-BETTER WHY-WORSE) + ;;; First insure that there will actually be a comparison. + (SETQ + DANGERS + (GM-ALL-TRUE + (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL BETTER)) + (NOT (GP-EQ (XPR-PROB BETTER X) + 0.0)))) + DANGERS) + T-DANGER + (CAR (CMR-EXPLAIN-DANGER BETTER WORSE DANGERS))) + (WA-SET-WHY BETTER WORSE T-DANGER) + (G-SAY + (APPEND + '(|. |) + (EC-EXPL-PROBS BETTER WHY-BETTER WORSE WHY-WORSE T-DANGER) + (COND ((GP-TEST DANGERS) + (APPEND '(|. Likewise cave|) + (LIST BETTER) + '(|involves less risk from|) + (EG-DANGERS (GP-DELETE T-DANGER + DANGERS))))) + (EG-THEREFORE) + (LIST '|,| DB-NAME) + (LIST '|, we might want to explore cave| BETTER) + '(|instead. |))))) + +;;; WA-SET-WHY chooses the appropriate rationale for the explanation + +(DEFUN WA-SET-WHY (BETTER WORSE DANGER) + (DECLARE (SPECIAL CX-COMPARE CX-WHY-BETTER CX-WHY-WORSE + WHY-BETTER WHY-WORSE)) + (COND ((AND (EQUAL CX-COMPARE (LIST BETTER WORSE)) + (NOT (SLR-OK-RULESP (APPEND (XPR-WHY-PROB WORSE DANGER) + (XPR-WHY-PROB BETTER DANGER)) + DANGER))) + (SETQ WHY-BETTER CX-WHY-BETTER + WHY-WORSE CX-WHY-WORSE)) + (T (SETQ WHY-BETTER (CAR (XPR-WHY-PROB BETTER DANGER)) + WHY-WORSE (CAR (XPR-WHY-PROB WORSE DANGER)))))) + +;;; WA-COMP-CHECK returns the appropriate good move. Depending +;;;on whether P15 was in the explanation. + +(DEFUN WA-COMP-CHECK (MOVE) + (COND ((AND (XPR-SHOOTP MOVE) (MEMBER 15. (AWA-TOLD-RULES 2.))) + (LIST 'SHOOT MOVE)) + (T MOVE))) + +;;; WA-SHOOT-CHECK advises the player-to shoot-when appropriate. + +(DEFUN WA-SHOOT-CHECK (MOVE) + (DECLARE (SPECIAL DB-NAME)) + (COND + ((XPR-SHOOTP MOVE) + (G-RISAY + (APPEND '(|As it is|) + (EG-PROBABLE (XPR-GET-P14 MOVE 2.) NIL) + (LIST '|that cave| MOVE '|contains|) + (AEG-DANGER-SING 2.) + (LIST '|,| DB-NAME) + '(|, you might want to shoot an arrow into cave|) + (LIST MOVE) + (COND ((GP-EQ (XPR-GET-P14 MOVE 2.) 1.0) + '(|. |)) + (T '(|before we visit it. |))))) + (PS-MARK-NO-SHOT MOVE) + (WA-NOTE-ADVICE (LIST 'SHOOT MOVE) MOVE 9.) + (WA-MARK-RULES 9.) + (G-RSAY (LIST '|Would you like to shoot an arrow into cave| + MOVE + '|instead? |)) + (COND ((GQ-EVAL (G-READ 'DECIDE-NO)) + (WG-SHOOT MOVE) + T) + ((GQ-GO-AHEAD MOVE)))))) + +;;; WA-CHECK-C6 checks to see if C6 is applicable, and, if so, it +;;;makes the appropriate explanation. + +(DEFUN WA-CHECK-C6 (BEST H-MOVE) + (DECLARE (SPECIAL WA-TOLD-C6 DB-NAME)) + (COND + ((MEMBER BEST WA-TOLD-C6) NIL) + ((AND (ASKC-RULES 6. 2.) + (EQUAL (XXR-DANGERS BEST) '(0.)) + (> (XPR-PROB BEST 0.) 0.5)) + (G-RISAY + (APPEND + (LIST DB-NAME) + '(|, we seem to be surrounded by dangers. | + |It seems that bats are our best bet as| + |they might carry us to a safer| + |section of the warren. |) + (EXR-CAVE-PROB BEST 0. NIL) + '(|, and so cave|) + (LIST BEST) + '(|looks like a good move to me. |))) + (SETQ WA-TOLD-C6 (GP-CONS BEST WA-TOLD-C6)) + (WA-TOLD-MOVE BEST H-MOVE 6.)))) + +;;; WA-CHECK-C7 determines if C7 is applicable. + +(DEFUN WA-CHECK-C7 (B-CAVES H-MOVE) + (COND ((NULL B-CAVES) NIL) + ((AND (XPR-SHOOTP (CAR B-CAVES)) + (SLR-OK-RULESP (CXR-PROB (CAR B-CAVES) 2.) 2.)) + (WA-TELL-C7 (CAR B-CAVES) H-MOVE)) + ((WA-CHECK-C7 (CDR B-CAVES) H-MOVE)))) + +;;; WA-TELL-C7 advises the palyer to shoot into CAVE instead +;;;of visiting another cave. + +(DEFUN WA-TELL-C7 (CAVE H-MOVE) + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY (APPEND (LIST '|Well,| DB-NAME '|,|) + ((GP-MAKN 'EXR-PROB (CADR (XPR-WHY-PROB CAVE 2.))) + CAVE + 2. + NIL) + '(|, and I would advise that we shoot into cave|) + (LIST CAVE '|. |))) + (WA-TOLD-MOVE (LIST 'SHOOT CAVE) H-MOVE 7.)) + +;;; WA-TOLD-MOVE marks that student has been told BETTER-MOVE. + +(DEFUN WA-TOLD-MOVE (BETTER-MOVE H-MOVE RULE) + (SKC-TOLD-RULE RULE) + (WA-MARK-RULES RULE) + (WA-NOTE-ADVICE BETTER-MOVE H-MOVE RULE) + (*SS-TOLD-MOVE BETTER-MOVE H-MOVE RULE) + T) + +;;; WA-NOTE-ADVICE notes that the advice has been given. + +(DEFUN WA-NOTE-ADVICE (BETTER WORSE RULE) + (DECLARE (SPECIAL LWA-CRULES LWA-GOOD-MOVES LWA-BAD-MOVES + LWA-MOVE-NUMS WE-MOVE-NUM)) + (GC-PUT LWA-CRULES RULE) + (GC-PUT LWA-GOOD-MOVES BETTER) + (GC-PUT LWA-BAD-MOVES WORSE) + (GC-PUT LWA-MOVE-NUMS WE-MOVE-NUM)) + +;;; WA-TOLD-RULE marks that the user will be told a rule. +;;;It is called by the English routines, which is somewhat +;;;kludge like, but ..... + +(DEFUN WA-TOLD-RULE (RULE DANGER) + (DECLARE (SPECIAL WAV-TOLD-RULE)) + (SETQ WAV-TOLD-RULE T) + (STORE (AWA-TOLD-RULES DANGER) + (GP-CONS RULE (AWA-TOLD-RULES DANGER)))) + +;;; WA-MARK-RULES actually marks the rules and explains them. + +(DEFUN WA-MARK-RULES (RULE) + (DECLARE (SPECIAL WAV-TOLD-RULE)) + (COND + (WAV-TOLD-RULE + (G-TSAY + (APPEND + '(|*** I have used:|) + (EG-INSERT-AND + NIL + (DO ((I 0. (1+ I)) (VAL NIL)) + ((> I 2.) VAL) + (COND ((AWA-TOLD-RULES I) + (SC-ADVISED (AWA-TOLD-RULES I) I) + (SETQ VAL + (CONS (EG-TOLD-RULES (AWA-TOLD-RULES I) + I) + VAL)))))) + '(|in explaining combination rule|) + (LIST RULE) + '(|. ***|))) + (DO ((I 0. (1+ I))) + ((> I 2.)) + (DO ((LIST (AWA-TOLD-RULES I) (CDR LIST))) + ((NULL LIST)) + (*SSK-TOLD-RULE (CAR LIST) I) + (SK-TOLD-RULE (CAR LIST) I)) + (STORE (AWA-TOLD-RULES I) NIL))) + (T + (G-TSAY + (APPEND '(|*** I have told the student combination rule|) + (LIST RULE) + '(|. ***|))))) + (SETQ WAV-TOLD-RULE NIL)) + +;;; ****** Wumpus Advisor Routines concerned with Distance, etc***** +;;; The following routines keep track of which caves +;;;can be reached in a given number of moves using the most direct +;;;route. wAs a side-effect they also keep track of which caves +;;;are in the known-area, which caves are on the fringe area, etc. +;;; WAD-GET-DIST returns all the caves that can be reached in DIST +;;;moves by the player if he takes the most direct route. The +;;;starting point is at DIST 0 and is the last fringe cave the +;;;player visited (usually). + +(DEFUN WAD-GET-DIST (DIST) (EVAL (GP-MAKN 'WAD-DIST- DIST))) + +;;; WAD-UPDATE-DIST is the function which ensures that the distances +;;;are correct before each move. It must be called prior to any +;;;extensive analysis. + +(DEFUN WAD-UPDATE-DIST (ORIGIN) + (DECLARE (SPECIAL WAW-ROUTE XD-VISITED-CAVES WAD-FRINGE WAD-KNOWNAREA)) + (DO ((DIST 0. (1+ DIST)) + (START (LIST ORIGIN)) + (KNOWN NIL (WAD-GET-DIST DIST)) + (NEW (LIST ORIGIN) (GP-DIST-AREA START 1.)) + (FRINGE NIL + (GP-UNION FRINGE + (GP-REMOVE-LIST NEW XD-VISITED-CAVES)))) + ((NULL START) + (SET (GP-MAKN 'WAD-DIST- DIST) NIL) + (SETQ WAD-KNOWNAREA KNOWN) + (SETQ WAD-FRINGE FRINGE) + (SETQ WAW-ROUTE (LIST ORIGIN))) + (SETQ START (GP-INTERSECTION (GP-REMOVE-LIST NEW KNOWN) + XD-VISITED-CAVES)) + (SET (GP-MAKN 'WAD-DIST- DIST) (GP-UNION NEW KNOWN)))) + +;;;********* Wumpus Advisor Routines dealing with routes. ********** +;;; WAW-ROUTE-CHECK checks to insure that the player does not spend an +;;;inordinate amount of time in the visited area. + +(DEFUN WAW-ROUTE-CHECK (MOVE) + (DECLARE (SPECIAL WAW-ROUTE WAD-FRINGE)) + (COND ((MEMBER MOVE WAD-FRINGE) NIL) + ((MEMBER MOVE WAW-ROUTE) (WAW-CORRECT-ROUTE MOVE)) + (T (SETQ WAW-ROUTE (CONS MOVE WAW-ROUTE)) NIL))) + +;;; WAW-CORRECT-ROUTE notifies the student that he is wandering +;;;and asks the student if he would like a route to a cave. + +(DEFUN WAW-CORRECT-ROUTE (MOVE) + (DECLARE (SPECIAL LWAW-TELL-WANDER WG-HERE)) + (G-RISAY (EVAL (GC-NEXT LWAW-TELL-WANDER))) + (G-SAY '(|, would you like a route to a cave? |)) + (COND ((GQ-EVAL (G-READ 'NO)) + (WA-UPDATE-FRINGE WG-HERE) + (WAW-GIVE-ROUTE) + T) + (T (WA-UPDATE-FRINGE MOVE) NIL))) + +;;; WAW-GIVE-ROUTE explains the best route to a destination +;;;supplied by the student or (ARG 1). + +(DEFUN WAW-GIVE-ROUTE NARGS + (DECLARE (SPECIAL WAW-GIVEN-ROUTE WG-HERE WAD-KNOWNAREA DB-NAME)) + (PROG (ROUTE DESTINATION) + (COND ((= (ARG NIL) 0.) + (G-RSAY '(|What cave would you like to go to? |)) + (SETQ DESTINATION (G-READ 'CAVE))) + (T (SETQ DESTINATION (ARG 1.)))) + (COND ((GP-CAVE-CHECK DESTINATION)) + ((= DESTINATION WG-HERE) + (G-RSAY '(|We're already there! |))) + ((MEMBER DESTINATION (WGR-NEIGHBORS WG-HERE)) + (G-RSAY (LIST '|Just move to cave| + DESTINATION + '|. |))) + ((MEMBER DESTINATION WAD-KNOWNAREA) + (SETQ WAW-GIVEN-ROUTE (CONS DESTINATION + WAW-GIVEN-ROUTE) + ROUTE (WAW-FIND-ROUTE DESTINATION 0.)) + (G-RSAY (APPEND '(|To get to cave|) + (LIST DESTINATION) + '(|,|) + (LIST DB-NAME) + '(|, we could move to|) + (EG-INSERT-AND '|cave| + (CDR ROUTE)) + '(|. |)))) + (T (G-RSAY (LIST '|We have not explored enough| + '|to develop a route to cave| + DESTINATION + '|from cave| + WG-HERE + '|. |)))))) + +;;; WAW-FIND-ROUTE finds a route to the given destination and returns it. + +(DEFUN WAW-FIND-ROUTE (DESTINATION DIST) + (DECLARE (SPECIAL DIST DB-ROUTE)) + (COND + ((MEMBER DESTINATION (WAD-GET-DIST DIST)) + (SETQ DB-ROUTE (LIST DESTINATION))) + (T + (SETQ DB-ROUTE (WAW-FIND-ROUTE DESTINATION (1+ DIST))) + (SETQ + DB-ROUTE + (CONS + (GM-FIRST-TRUE + (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL DIST)) + (MEMBER X (WAD-GET-DIST DIST)))) + (XDR-VISITED-NEIGHBORS (CAR DB-ROUTE))) + DB-ROUTE))))) + +;;;********** Wumpus Advisor Routines to Modify the Game ********* +;;; WAM-TRANSPOSE-MOVE transposes the player's move if necessary. + +(DEFUN WAM-TRANSPOSE-MOVE (MOVE) + (DECLARE (SPECIAL WAM-NEXT-MOVE WG-HERE)) + (COND ((= WAM-NEXT-MOVE MOVE)) + ((MEMBER WAM-NEXT-MOVE (WGR-NEIGHBORS WG-HERE)) + (WGM-TRANSPOSE WAM-NEXT-MOVE MOVE)) + ((NOT (WGR-SAFEP MOVE)) + (DO ((CAVES (WGR-NEIGHBORS WG-HERE) (CDR CAVES))) + ((NULL CAVES)) + (COND ((WGR-SAFEP (CAR CAVES)) + (G-TSAY '(|*** I transposing the player's| + |move to avoid a danger. ***|)) + (WGM-TRANSPOSE (CAR CAVES) MOVE) + (SETQ CAVES NIL)))))) + (SETQ WAM-NEXT-MOVE NIL)) + +;;; WAM-MODIFY-GAME does the initial modification of the game. + +(DEFUN WAM-MODIFY-GAME NIL + (DECLARE (SPECIAL WAM-NEXT-MOVE DB-PHASE WG-HERE DB-NUM-CAVES TEST-PHASE)) + (SETQ WAM-NEXT-MOVE -1.) + (DO ((WORK-LIST (LIST DB-PHASE (1- DB-PHASE) (1+ DB-PHASE)) + (CDR WORK-LIST)) + (TEST-PHASE)) + ((NULL WORK-LIST)) + (SETQ TEST-PHASE (CAR WORK-LIST)) + (DO ((T-CAVE (RANDOM DB-NUM-CAVES) (GP-RANDEL O-CAVES)) + (O-CAVES (GP-ORDLST DB-NUM-CAVES))) + ((OR (NULL T-CAVE) (= TEST-PHASE -1.) (= TEST-PHASE 5.))) + (COND ((OR (NOT (WGR-SAFEP T-CAVE)) (WAM-BAD-CAVE T-CAVE)) + (SETQ O-CAVES (DELETE T-CAVE O-CAVES))) + ((WAM-OK-NEIGHBORS T-CAVE + (CAR (WGR-WARNINGS T-CAVE)) + (WGR-NEIGHBORS T-CAVE)) + (G-TSAY (LIST '|*** I am altering the game to| + '|create a situation appropriate| + '|for a player of phase| + TEST-PHASE + '|. ***|)) + (SETQ O-CAVES NIL WG-HERE T-CAVE)) + (T (SETQ O-CAVES (DELETE T-CAVE O-CAVES))))) + (COND ((NOT (= WAM-NEXT-MOVE -1.)) (SETQ WORK-LIST NIL))))) + +;;; WAM-BAD-CAVE checks out if CAVE is not a good starting cave. + +(DEFUN WAM-BAD-CAVE (CAVE) + (DECLARE (SPECIAL TEST-PHASE)) + (COND ((> TEST-PHASE 3.) (MEMBER 2. (WGR-WARNINGS CAVE))) + ((< TEST-PHASE 1.) (WGR-WARNINGS CAVE)) + ((EQUAL '(0.) (WGR-WARNINGS CAVE)) NIL) + ((EQUAL '(1.) (WGR-WARNINGS CAVE)) NIL) + (T T))) + +;;; WAM-OK-NEIGHBORS checks out to insure that there is an +;;;acceptable neighbor. + +(DEFUN WAM-OK-NEIGHBORS (CAVE WARNING W-CAVES) + (DECLARE (SPECIAL WAM-NEXT-MOVE)) + (COND ((NULL W-CAVES) NIL) + ((WAM-OK-WORK CAVE WARNING (CAR W-CAVES)) + (SETQ WAM-NEXT-MOVE (CAR W-CAVES))) + ((WAM-OK-NEIGHBORS CAVE WARNING (CDR W-CAVES))))) + +;;; WAM-OK-WORK does the actual checking for a particular neighbor. + +(DEFUN WAM-OK-WORK (CAVE WARNING NEIGHBOR) + (DECLARE (SPECIAL TEST-PHASE)) + (COND ((NOT (WGR-SAFEP NEIGHBOR)) NIL) + ((< TEST-PHASE 1.) (GP-INTERSECTION (WGR-WARNINGS NEIGHBOR) '(0. 1.))) + ((> TEST-PHASE 3.) T) + ;;; Throw out caves with bad geometry. + ;;; Phases 1 and 3 require a neighbor in common. + ((AND (OR (= TEST-PHASE 1.) (= TEST-PHASE 3.)) + (NOT (GP-INTERSECTION (WGR-NEIGHBORS CAVE) + (WGR-NEIGHBORS NEIGHBOR)))) + NIL) + ;;; Phase 2 requires a neighbor have a smaller cave-set. + ((AND (= TEST-PHASE 2.) + (NOT (< (LENGTH (WGR-NEIGHBORS NEIGHBOR)) + (LENGTH (WGR-NEIGHBORS CAVE))))) + NIL) + ((= TEST-PHASE 1.) + (EQUAL (WGR-WARNINGS NEIGHBOR) + (GP-DELETE WARNING '(0. 1.)))) + ;;; Hence we must have Phases 2 or 3. + (T (EQUAL (LIST WARNING) (WGR-WARNINGS NEIGHBOR))))) + +;;;************** The Wumpus Expert Routines ************* +;;; The logical rules are broken down into eight major +;;;categories. The four probability rules are also shown. +;;; For efficiency each rule that is to be taught has been +;;;aasigned a unique number (as shown after the rule memonic.) +;;;These numbers are used to access the arrays of the student-model. +;;;The last three entries are mainly entries in the student-model. +;;; +;;; L0 (0) A cave can be marked as "zero away" if it was +;;; visited and found to contain a "DANGER". +;;; +;;; L1 (1) A cave can be marked as "more than zero away" +;;; if it was safely visited. +;;; +;;; L2 (2) If the player shoots an arrow into a cave and +;;; does not kill the Wumpus, then that cave can +;;; be marked as "more than zero away" (Wumpus). +;;; +;;; L3 (3) If a cave is visited and there is not a warning, +;;; then that cave is "more than N away" where N +;;; is the distance that the warning propagates. +;;; +;;; L4 (4) If a cave is visited and there is a warning, then +;;; that cave is "less than (N+1) away". +;;; +;;; L5 (5) If a cave is marked "more than N away" then all +;;; of its neighbors must be at least "more than (N-1) +;;; away". +;;; +;;; L6 (6) If all of a caves neighbors are at least "more than +;;; (N-1) away", then it must be "more than N away". +;;; +;;; L7 (7) If a cave is "more than (N-1) away" and "less than +;;; (N+1) away", then it is "N away". +;;; +;;; L8 (8) When the algorithm is creating cave-sets and it +;;; encounters a cave which would be N caves away but +;;; which is also "more than N away", then that cave +;;; can not have any contributions to the cave-set. +;;; +;;; L9 (9) If a cave was found to contain a danger (through +;;; visitation), then it does not contain a danger of +;;; higher priority. +;;; +;;; L10 (10) Certain caves can be marked as "more than zero away" +;;; based on consideration of the different cave-sets. +;;; +;;; P11 (11) An estimationof the probability for a given cave is +;;; 1/N, where N is the number of caves in the smallest +;;; cave-set of which said cave is a member. +;;; +;;; P12 (12) For cases where there are two cave-sets, one of which +;;; is a subset of the other, there is no evidence at all +;;; with respect to the caves in the super-set, but not +;;; in the subset (as the caves in the subset completely +;;; explain the warning.) so the probability should be +;;; reduced to some consistent value. +;;; +;;; P13 (13) If a cave is a member of two cave-sets, then its +;;; probability should be increased above that assigned by P11. +;;; +;;; P14 (14) In cases where P13 is applied, the other members of said +;;; cave-sets should heve their probabilities reduced. +;;; +;;; P15 (15) This for those situations where the probability +;;; for the Wumpus being in a cave exceeds the probability +;;; for an arrow killing the player. +;;; +;;; R16 (16) This is for telling the student of warnings and +;;; their meanings. +;;; +;;; R17 (17) This is for telling the student about encounters +;;; with dangers. +;;; +;;; R18 (18) This is to advise the player to avoid dangers. +;;; +;;; For the exact formulas used for the probablity rules, +;;;see the paper about the Wumpus-Advisor. +;;; +;;; XX-UPDATE is the executive of the expert routines and +;;;evaluates the different moves. + +(DEFUN XX-UPDATE NIL + (DECLARE (SPECIAL XX-CHANGED WAD-FRINGE)) + (XX-UPDATE-WORK '(0. 1. 2.)) + (COND (XX-CHANGED (XX-COMBINE-PROB WAD-FRINGE) + (XX-UPDATE-MOVES) + (SETQ XX-CHANGED NIL)))) + +;;; XX-UPDATE-WORK computes the different probabilities for each danger. + +(DEFUN XX-UPDATE-WORK (DANGER-LIST) + (DECLARE (SPECIAL XX-CHANGED)) + (PROG (DANGER) + (COND + ((NULL DANGER-LIST)) + ((AXS-CHANGED-SETS (CAR DANGER-LIST)) + (SETQ XX-CHANGED T) + (XX-UPDATE-WORK (CDR DANGER-LIST)) + (SETQ DANGER (CAR DANGER-LIST)) + (XR-COUNT-NUM + (GP-INTERSECTION (AXS-CHANGED-SETS DANGER) + (AXS-COMPLETE-SETS DANGER)) + (AXS-COMPLETE-SETS DANGER) + DANGER) + (XP-RESET-PROB (AXS-CHANGED-SETS DANGER) NIL DANGER) + ;;; This is to reset CHANGED-SETS as the + ;;;probabilities have been updated. + (STORE (AXS-CHANGED-SETS DANGER) NIL)) + (T (XX-UPDATE-WORK (CDR DANGER-LIST)))))) + +;;; XX-MARK-SAFE is called whenever a cave is found by the database +;;;routines to be safe. + +(DEFUN XX-MARK-SAFE (CAVE DANGER) + ;;; These calls are necessary else the new + ;;;probs would never be calculated. + (XP-PUT-P11 CAVE -1.0 DANGER) + (XP-PUT-WHY-P11 CAVE NIL DANGER) + (XP-PUT-WHY-P12 CAVE NIL DANGER) + (XP-PUT-P13 CAVE -1.0 DANGER) + (XP-PUT-P14 CAVE -1.0 DANGER)) + +;;; XX-COMBINE-PROB combines the probabilities and calculates the INDEX. + +(DEFUN XX-COMBINE-PROB (WORK-CAVES) + (DECLARE (SPECIAL CAVE XX-BAT-KILL)) + (PROG (CAVE) + (COND + ((NULL WORK-CAVES)) + (T + (SETQ CAVE (CAR WORK-CAVES)) + (XX-COMBINE-PROB (CDR WORK-CAVES)) + (XX-PUT-DANGERS + CAVE + (GM-ALL-TRUE + (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL CAVE)) + (OR (AND (= X 2.) + (XPR-SHOOTP CAVE)) + (GP-LT 0.0 + (XPR-PROB CAVE X))))) + '(0. 1. 2.))) + (XX-PUT-COST + CAVE + (COND ((XPR-SHOOTP CAVE) (XPR-PROB CAVE 2.)) + (T (-$ 1.0 + (XX-MULT-PROB CAVE + '(0. 1. 2.) + (LIST XX-BAT-KILL + 1.0 + 1.0)))))) + (XX-PUT-GAIN CAVE + (+$ (*$ (XX-VALUE-MOVE CAVE) + (XX-MULT-PROB CAVE + '(0. 1. 2.) + '(1.0 1.0 1.0))) + (*$ (XX-VALUE-BAT) + (XPR-PROB CAVE 0.) + (XX-MULT-PROB CAVE + '(1. 2.) + '(1.0 1.0))) + (COND ((XPR-SHOOTP CAVE) + (*$ 5.0 (XPR-GET-P14 CAVE 2.))) + (T 0.0)))) + (XX-PUT-INDEX CAVE + (COND ((XDR-VISITEDP CAVE) -1.0) + ((GP-EQ 0.0 (XXR-COST CAVE)) + (*$ 10000.0 (XXR-GAIN CAVE))) + (T (//$ (XXR-GAIN CAVE) + (XXR-COST CAVE))))))))) + +;;; XX-MULT-PROB multiplies (1-P*V) for each danger sent. + +(DEFUN XX-MULT-PROB (CAVE DANGERS VALUES) + (COND ((NULL DANGERS) 1.0) + (T (*$ (XX-MULT-PROB CAVE (CDR DANGERS) (CDR VALUES)) + (-$ 1.0 + (*$ (CAR VALUES) + (XPR-PROB CAVE (CAR DANGERS)))))))) + +;;; XX-VALUE-MOVE returns the expected value from visiting a cave. +;;; Note that the two following routines presume a normal value of 1.0 +;;;for caves that are visited safely. + +(DEFUN XX-VALUE-MOVE (CAVE) + (COND ((XDR-VISITEDP CAVE) 0.0) + ((XSR-MEMBER CAVE 2.) 1.1) + (T 1.0))) + +;;; XX-VALUE-BAT returns the expected value from being picked up +;;;by bats. + +(DEFUN XX-VALUE-BAT NIL + (DECLARE (SPECIAL XD-VISITED-CAVES DB-NUM-CAVES)) + (//$ (-$ (FLOAT DB-NUM-CAVES) + (FLOAT (LENGTH XD-VISITED-CAVES)) + (AXX-EST-NUM-DANGERS 1.) + (AXX-EST-NUM-DANGERS 2.)) + (-$ (FLOAT DB-NUM-CAVES) (AXX-EST-NUM-DANGERS 0.)))) + +;;; XX-INIT-DANGER-EST initializes the array AXX-EST-NUM-DANGER +;;;and sets XX-BAT-KILL. + +(DEFUN XX-INIT-DANGER-EST NIL + (DECLARE (SPECIAL XX-BAT-KILL DB-NUM-CAVES)) + (DO ((I 2. (1- I)) (NOT-PROB 1.0)) + ((< I 0.) + (SETQ XX-BAT-KILL + (//$ (+$ (AXX-EST-NUM-DANGERS 1.) + (AXX-EST-NUM-DANGERS 2.)) + (-$ (FLOAT DB-NUM-CAVES) + (AXX-EST-NUM-DANGERS 0.))))) + (STORE (AXX-EST-NUM-DANGERS I) + (*$ NOT-PROB (FLOAT (ADB-NUM-DANGERS I)))) + (SETQ NOT-PROB + (*$ NOT-PROB + (//$ (FLOAT (- DB-NUM-CAVES (ADB-NUM-DANGERS I))) + (FLOAT DB-NUM-CAVES)))))) + +;;; XX-UPDATE-MOVES orders moves according to INDEX/DIST. + +(DEFUN XX-UPDATE-MOVES NIL + (DECLARE (SPECIAL WAD-FRINGE XX-BEST-MOVES)) + (SETQ XX-BEST-MOVES (XX-INSERT (CDR WAD-FRINGE) + (LIST (CAR WAD-FRINGE))))) + +;;; XX-INSERT orders the moves according to index. + +(DEFUN XX-INSERT (CAVE-LIST RESULT) + (COND ((NULL CAVE-LIST) RESULT) + ;;; does it go at the start? + ((GP-LT (XXR-INDEX (CAR RESULT)) (XXR-INDEX (CAR CAVE-LIST))) + (XX-INSERT (CDR CAVE-LIST) + (CONS (CAR CAVE-LIST) RESULT))) + ;;; are we at the end? + ((NULL (CDR RESULT)) + (XX-INSERT (CDR CAVE-LIST) + (GP-INSERT RESULT (CAR CAVE-LIST)))) + ;;; does it go right here? + ((GP-LT (XXR-INDEX (CADR RESULT)) + (XXR-INDEX (CAR CAVE-LIST))) + (XX-INSERT (CDR CAVE-LIST) + (GP-INSERT RESULT (CAR CAVE-LIST)))) + ;;; no, so try the next slot. + (T (XX-INSERT (LIST (CAR CAVE-LIST)) (CDR RESULT)) + (XX-INSERT (CDR CAVE-LIST) RESULT)))) + +;;; XXR-INDEX returns the expert's index for CAVE. + +(DEFUN XXR-INDEX (CAVE) (ADB-CAVE CAVE 5.)) + +;;; XX-PUT-INDEX puts the INDEX into the arrays. + +(DEFUN XX-PUT-INDEX (CAVE VALUE) (STORE (ADB-CAVE CAVE 5.) VALUE)) + +;;; XXR-COST gives the COST. + +(DEFUN XXR-COST (CAVE) (ADB-CAVE CAVE 3.)) + +;;; XX-PUT-COST puts the COST into the arrays. + +(DEFUN XX-PUT-COST (CAVE VALUE) (STORE (ADB-CAVE CAVE 3.) VALUE)) + +;;; XXR-GAIN returns the GAIN. + +(DEFUN XXR-GAIN (CAVE) (ADB-CAVE CAVE 4.)) + +;;; XX-PUT-GAIN puts the GAIN into the arrays. + +(DEFUN XX-PUT-GAIN (CAVE VALUE) (STORE (ADB-CAVE CAVE 4.) VALUE)) + +;;; XXR-DANGERS retruns those dangers which are +;;;currently applicable for CAVE. + +(DEFUN XXR-DANGERS (CAVE) (ADB-CAVE CAVE 6.)) + +;;; XX-PUT-DANGERS puts the DANGERS into the arrays. + +(DEFUN XX-PUT-DANGERS (CAVE VALUE) (STORE (ADB-CAVE CAVE 6.) VALUE)) + +;;; XXR-BETTER-MOVEP returns BETTER if it is in fact the better move. + +(DEFUN XXR-BETTER-MOVEP (BETTER WORSE) + (COND ((GP-LT (XXR-INDEX WORSE) (XXR-INDEX BETTER)) BETTER))) + +;;; XXR-WHY-MORE-THAN returns the preferred reason +;;;for a "more than" class. + +(DEFUN XXR-WHY-MORE-THAN (CAVE DIST DANGER) + (COND ((AND (= DIST 0.) (XDR-VISITEDP CAVE)) 1.) + (T (CAR (XDR-WHY-MORE-THAN CAVE DANGER))))) + +;;; XXT-GET-NODIST-SET returns the NODIST set ommiting +;;;the L10 caves DEPENDING depending on TEST. + +(DEFUN XXT-GET-NODIST-SET (O-CAVE DIST DANGER TEST) + (COND ((NOT TEST) + (XSR-GET-NODIST-SET O-CAVE DIST DANGER)) + (T (DO ((CAVES (XSR-GET-NODIST-SET O-CAVE DIST DANGER) + (CDR CAVES)) + (VAL)) + ((NULL CAVES) VAL) + (COND ((= (XXR-WHY-MORE-THAN (CAR CAVES) + DIST + DANGER) + 10.) + NIL) + (T (SETQ VAL (CONS (CAR CAVES) VAL)))))))) + +;;;******* The Data Base Routines of the Expert. ******** +;;;*********** This is Stage 1 of the Algorithm ************ +;;; Along with classifying the caves under "XD" properties, +;;;these routines also mark the justification under "XW" +;;;properties. Note that the outer routines are called as +;;;the player is notified of the dangers and warnings. +;;;(This simplifies the logic of the expert.) +;;; +;;; XD-MARK-DANGER marks a danger whenever it has been visited. +;;;It implements L0 and L9. + +(DEFUN XD-MARK-DANGER (CAVE DANGER) + (DECLARE (SPECIAL CAVE)) + ;;; This implements L9. + (MAPC + (FUNCTION (LAMBDA (X) + (XD-PUT-MORE-THAN CAVE 0. '(9.) X))) + (GP-REMOVE-LIST '(0. 1. 2.) (GP-ORDLST (1+ DANGER)))) + (XD-PUT-WHY-EXACTLY CAVE '(0.) DANGER) + (XD-PUT-EXACTLY CAVE 0. DANGER) + (XS-CREATE-CAVE-SET CAVE 0. DANGER)) + +;;; XD-MARK-VISITED updates the data base after a cave +;;;has been visited (safely). It implements L1. + +(DEFUN XD-MARK-VISITED (CAVE DANGER-LIST) + (DECLARE (SPECIAL CAVE DANGER-LIST XD-VISITED-CAVES DB-MOVES)) + (PROG (DANGER) + (SETQ DANGER (CAR DANGER-LIST)) + (COND ((XDR-VISITEDP CAVE) + (XD-PUT-VISITED CAVE + (CONS DB-MOVES + (XDR-VISITEDP CAVE)))) + ((NULL DANGER-LIST) + (XD-PUT-VISITED CAVE + (CONS DB-MOVES + (XDR-VISITEDP CAVE))) + (SETQ XD-VISITED-CAVES + (CONS CAVE XD-VISITED-CAVES))) + (T (XD-MARK-VISITED CAVE (CDR DANGER-LIST)) + (XD-PUT-MORE-THAN CAVE 0. '(1.) DANGER) + ;;; The next two calls are in case + ;;;they were missed earlier because the + ;;;cave had not been visited. + (XD-PROPAGATE-DIST (WGR-NEIGHBORS CAVE) + CAVE + (1- (XDR-MORE-THAN CAVE + DANGER)) + DANGER) + (XD-CHECK-NEIGHBORS (LIST CAVE) DANGER) + (XS-CAVE-CHECK CAVE + (XDR-MORE-THAN CAVE DANGER) + DANGER) + (XS-NEIGHBOR-CHECK (WGR-NEIGHBORS CAVE) + DANGER))))) + +;;; XD-MARK-SHOT is called after an unsuccessful shot. +;;;It implements L2. + +(DEFUN XD-MARK-SHOT (CAVE) + (DECLARE (SPECIAL XX-CHANGED WAD-FRINGE)) + (SETQ XX-CHANGED T) + (XD-PUT-MORE-THAN CAVE 0. '(2.) 2.) + (COND ((NOT (WGR-EXTRA-ARROWS)) (XP-SET-PROB WAD-FRINGE 2.)))) + +;;; XD-MARK-NOWARNING is called whenever a warning is received. +;;;It implements L3. + +(DEFUN XD-MARK-NOWARNING (CAVE DANGER) + (XD-PUT-MORE-THAN CAVE + (ADB-WARNING-DIST DANGER) + '(3.) + DANGER)) + +;;; XD-MARK-WARNING is called whenever a warning is received and +;;;implements rule L4. + +(DEFUN XD-MARK-WARNING (CAVE DANGER) + (XD-PUT-WHY-LESS-THAN CAVE '(4.) DANGER) + (XD-PUT-LESS-THAN CAVE (1+ (ADB-WARNING-DIST DANGER)) DANGER) + (XD-EXACT-CHECK CAVE DANGER)) + +;;; XD-MARK-SAFE-L10 marks that a cave is safe because of L10. + +(DEFUN XD-MARK-SAFE-L10 (CAVE-LIST CAUSE DANGER) + (COND ((NULL CAVE-LIST)) + (T (XD-MARK-SAFE-L10 (CDR CAVE-LIST) CAUSE DANGER) + (XD-PUT-MORE-THAN (CAR CAVE-LIST) + 0. + (LIST 10. CAUSE) + DANGER)))) + +;;; XD-PROPAGATE-DIST checks to see if a DIST can be +;;;propagated. It implements L5. + +(DEFUN XD-PROPAGATE-DIST (CAVE-LIST CAVE DIST DANGER) + (COND ((NULL CAVE-LIST)) + (T (XD-PROPAGATE-DIST (CDR CAVE-LIST) CAVE DIST DANGER) + (XD-PUT-MORE-THAN (CAR CAVE-LIST) + DIST + (LIST 5. CAVE) + DANGER)))) + +;;; XD-PUT-MORE-THAN actually adds the DIST specified and performs +;;;the requisite checks. (Calling other routines as necessary.) + +(DEFUN XD-PUT-MORE-THAN (CAVE DIST REASON DANGER) + (COND ((> DIST (XDR-MORE-THAN CAVE DANGER)) + (COND ((= (XDR-MORE-THAN CAVE DANGER) -1.) + (XX-MARK-SAFE CAVE DANGER))) + (XD-MARK-MORE-THAN CAVE DIST DANGER) + (XD-PUT-WHY-MORE-THAN CAVE REASON DANGER) + (XD-EXACT-CHECK CAVE DANGER) + ;;; Don't propagate L6. + (COND ((= (CAR REASON) 6.) NIL) + (T (XD-PROPAGATE-DIST (XDR-KNOWN-NEIGHBORS CAVE) + CAVE + (1- DIST) + DANGER))) + (XD-CHECK-NEIGHBORS (XDR-KNOWN-NEIGHBORS CAVE) DANGER) + (XS-CAVE-CHECK CAVE DIST DANGER)) + ;;; This is to have the simplest rule possible under reason. + ((AND (> DIST -1.) + (= DIST (XDR-MORE-THAN CAVE DANGER)) + (< (CAR REASON) + (CAR (XDR-WHY-MORE-THAN CAVE DANGER)))) + (XD-PUT-WHY-MORE-THAN CAVE REASON DANGER)))) + +;;; XD-CHECK-NEIGHBORS sees if L6 applies to any of the caves it is sent. + +(DEFUN XD-CHECK-NEIGHBORS (CAVE-LIST DANGER) + (COND ((NULL CAVE-LIST)) + ((XDR-VISITEDP (CAR CAVE-LIST)) + (XD-CHECK-NEIGHBORS (CDR CAVE-LIST) DANGER) + (DO ((WORST 100. + (MIN WORST + (XDR-MORE-THAN (CAR LIST) DANGER))) + (LIST (WGR-NEIGHBORS (CAR CAVE-LIST)) (CDR LIST))) + ((NULL LIST) + ;;; It is useless to have a "more than" greater than N. + (COND ((> (ADB-WARNING-DIST DANGER) WORST) + (XD-PUT-MORE-THAN (CAR CAVE-LIST) + (1+ WORST) + '(6.) + DANGER)))))) + (T (XD-CHECK-NEIGHBORS (CDR CAVE-LIST) DANGER)))) + +;;; XD-EXACT-CHECK is called anytime a new property is assigned +;;;to see if L7 applies. + +(DEFUN XD-EXACT-CHECK (CAVE DANGER) + (COND + ((> (XDR-EXACTLY CAVE DANGER) -1.) NIL) + ((> (+ 3. (XDR-MORE-THAN CAVE DANGER)) + (XDR-LESS-THAN CAVE DANGER)) + (XD-PUT-WHY-EXACTLY CAVE '(7.) DANGER) + (XS-CREATE-CAVE-SET + CAVE + (XD-PUT-EXACTLY CAVE + (1+ (XDR-MORE-THAN CAVE DANGER)) + DANGER) + DANGER)))) + +;;; XDR-VISITEDP is a predicate which returns the move +;;;numbers in which a cave was visited in this game. + +(DEFUN XDR-VISITEDP (CAVE) (ADB-CAVE CAVE 2.)) + +;;; XD-PUT-VISITED puts the move numbers into the arrays. + +(DEFUN XD-PUT-VISITED (CAVE VALUE) (STORE (ADB-CAVE CAVE 2.) VALUE)) + +;;; XDR-VISITED-NEIGHBORS returns all of the neighbors of the cave +;;;that have been visited. + +(DEFUN XDR-VISITED-NEIGHBORS (CAVE) + (GM-ALL-TRUE 'XDR-VISITEDP (WGR-NEIGHBORS CAVE))) + +;;; XDR-KNOWN-NEIGHBORS returns all the neighbors of the given +;;;cave that the student knows about. + +(DEFUN XDR-KNOWN-NEIGHBORS (CAVE) + (COND ((XDR-VISITEDP CAVE) (WGR-NEIGHBORS CAVE)) + (T (XDR-VISITED-NEIGHBORS CAVE)))) + +;;; XDR-EXACTLY returns the EXACTLY distance (if applicable). + +(DEFUN XDR-EXACTLY (CAVE DANGER) (ADB-DCAVE CAVE 5. DANGER)) + +;;; XD-PUT-EXACTLY puts the EXACTLY value into the arrays. + +(DEFUN XD-PUT-EXACTLY (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 5. DANGER) VALUE)) + +;;; XDR-WHY-EXACTLY returns why a cvae is classified as EXACTLY. + +(DEFUN XDR-WHY-EXACTLY (CAVE DANGER) (ADB-DCAVE CAVE 6. DANGER)) + +;;; XD-PUT-WHY-EXACTLY puts the reason for the EXACTLY value +;;;into the arrays. + +(DEFUN XD-PUT-WHY-EXACTLY (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 6. DANGER) VALUE)) + +;;; XDR-MORE-THAN returns the dist that is assigned to CAVE +;;;under the property of "more than". (It is a utility routine.) + +(DEFUN XDR-MORE-THAN (CAVE DANGER) (ADB-DCAVE CAVE 1. DANGER)) + +;;; XD-MARK-MORE-THAN puts the MORE-THAN value into the arrays. + +(DEFUN XD-MARK-MORE-THAN (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 1. DANGER) VALUE)) + +;;; XDR-WHY-MORE-THAN returns the justification for the "more than" value. + +(DEFUN XDR-WHY-MORE-THAN (CAVE DANGER) (ADB-DCAVE CAVE 2. DANGER)) + +;;; XD-PUT-WHY-MORE-THAN puts the reason for the MORE-THAN value +;;;into the arrays. + +(DEFUN XD-PUT-WHY-MORE-THAN (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 2. DANGER) VALUE)) + +;;; XDR-LESS-THAN gets the LESS-THAN value from the arrays. + +(DEFUN XDR-LESS-THAN (CAVE DANGER) (ADB-DCAVE CAVE 3. DANGER)) + +;;; XD-PUT-LESS-THAN puts the LESS-THAN value into the arrays. + +(DEFUN XD-PUT-LESS-THAN (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 3. DANGER) VALUE)) + +;;; XDR-WHY-LESS-THAN gets the reason for the LESS-THAN value +;;;from the arrays. + +(DEFUN XDR-WHY-LESS-THAN (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 4. DANGER) VALUE)) + +;;; XD-PUT-WHY-LESS-THAN puts the reason for the +;;;LESS-THAN value into the arrays. + +(DEFUN XD-PUT-WHY-LESS-THAN (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 4. DANGER) VALUE)) + +;;;********* Expert Routines which update the Cave-Sets. ******** +;;; As the database used by these routines is not quite +;;;self-explanatory (to me), a brief blurb is added to help out. +;;; +;;; XS-NUM is used for caves which are "N away" and contains the +;;; current estimate/actual number of caves in the cave-set. +;;; +;;; XS-DIST-SET is used for caves that are "N away" and contains +;;; the end node caves of the expansion toward the cave-set. +;;; A cave at dist N would be the originating cave, and the caves +;;; at dist 0 would be members of the cave-set. The idea is +;;; to expand until there are only caves at dist zero, but this +;;; can not always be done as in some cases the neighbors of +;;; a cave are not known. +;;; +;;; XS-NODIST-SET contains those caves which were previously members +;;; of the DIST-SET at the given dist, but were disqualified +;;; because of its "more than N away" classification. This list +;;; is kept to aid in the development of explanations. +;;; +;;; XS-MEMBER is used for caves that have been put onto a DIST-SET. +;;; It contains the originating cave and the dist. +;;; +;;; XS-CREATE-CAVE-SET is called whenever an exact-cave is found. +;;;It creates the particulsar cave-set. + +(DEFUN XS-CREATE-CAVE-SET (CAVE DIST DANGER) + (XS-ADD-TO-LIST CAVE (LIST CAVE) DIST DANGER)) + +;;; XS-ADD-TO-LIST adds caves onto the DIST-SET at the given DIST. +;;;In general, O-CAVE is the originating cave, and M-CAVE is +;;;the member cave. + +(DEFUN XS-ADD-TO-LIST (O-CAVE ADD-CAVES DIST DANGER) + (PROG (M-CAVE) + (SETQ M-CAVE (CAR ADD-CAVES)) + (COND + ((NULL M-CAVE)) + ;;; check to see if the cave has already been added. + ((MEMBER M-CAVE (XSR-TOTAL-DIST-SET O-CAVE DIST DANGER)) + (XS-ADD-TO-LIST O-CAVE (CDR ADD-CAVES) DIST DANGER)) + (T + (XS-ADD-TO-LIST O-CAVE (CDR ADD-CAVES) DIST DANGER) + (XS-PUT-MEMBER M-CAVE + (GP-CONS (LIST O-CAVE DIST) + (XSR-MEMBER M-CAVE DANGER)) + DANGER) + (XS-PUT-DIST-SET O-CAVE + (GP-CONS M-CAVE + (XSR-GET-DIST-SET O-CAVE + DIST + DANGER)) + DIST + DANGER) + (XS-PUT-TOTAL-SET O-CAVE + (GP-CONS M-CAVE + (XSR-TOTAL-DIST-SET O-CAVE + DIST + DANGER)) + DIST + DANGER) + (XS-PUT-NUM O-CAVE + (+ (XS-NUM-EST DIST) + (XSR-GET-NUM O-CAVE DANGER)) + DANGER) + (XS-CAVE-CHECK-WORK M-CAVE + (LIST (LIST O-CAVE DIST)) + (XDR-MORE-THAN M-CAVE DANGER) + DANGER) + (XS-MARK-CHANGED O-CAVE DANGER))))) + +;;; XS-CAVE-CHECK checks out if a given cave should still be +;;;on the DIST-SETs that it is on. + +(DEFUN XS-CAVE-CHECK (CAVE DIST DANGER) + (XS-CAVE-CHECK-WORK CAVE (XSR-MEMBER CAVE DANGER) DIST DANGER)) + +;;; XS-CAVE-CHECK-WORK checks to see if the cave should still +;;;be on individual DIST-SETs. + +(DEFUN XS-CAVE-CHECK-WORK (M-CAVE WORK-LIST DIST DANGER) + (PROG (O-CAVE O-DIST) + (COND ((NULL WORK-LIST) (RETURN T))) + (XS-CAVE-CHECK-WORK M-CAVE (CDR WORK-LIST) DIST DANGER) + (SETQ O-CAVE (CAAR WORK-LIST) O-DIST (CADAR WORK-LIST)) + (COND + ((> (1+ DIST) O-DIST) + ;;; These functions implement L8. + (XS-PUT-NODIST-SET + O-CAVE + (GP-CONS M-CAVE + (XSR-GET-NODIST-SET O-CAVE O-DIST DANGER)) + O-DIST + DANGER) + (XS-REMOVE-CAVE M-CAVE O-CAVE O-DIST DANGER) + (XS-MARK-CHANGED O-CAVE DANGER)) + ;;; If we have dist 0 then don't propagate further. + ((< O-DIST 1.)) + ((XDR-VISITEDP M-CAVE) + (XS-ADD-TO-LIST + O-CAVE + (GP-REMOVE-LIST (WGR-NEIGHBORS M-CAVE) + (XSR-TOTAL-DIST-SET O-CAVE + O-DIST + DANGER)) + (1- O-DIST) + DANGER) + (XS-REMOVE-CAVE M-CAVE O-CAVE O-DIST DANGER) + (XS-MARK-CHANGED O-CAVE DANGER)) + (T (XS-ADD-TO-LIST O-CAVE + (XDR-KNOWN-NEIGHBORS M-CAVE) + (1- O-DIST) + DANGER))))) + +;;; XS-REMOVE-CAVE is a function to do some of the tasks of +;;;removing a cave from the DIST-SET. + +(DEFUN XS-REMOVE-CAVE (M-CAVE O-CAVE O-DIST DANGER) + (COND ((MEMBER M-CAVE + (XSR-TOTAL-DIST-SET O-CAVE O-DIST DANGER)) + (XS-PUT-DIST-SET O-CAVE + (DELETE M-CAVE + (XSR-GET-DIST-SET O-CAVE + O-DIST + DANGER)) + O-DIST + DANGER) + (XS-PUT-NUM O-CAVE + (- (XSR-GET-NUM O-CAVE DANGER) + (XS-NUM-EST O-DIST)) + DANGER) + (XS-PUT-MEMBER M-CAVE + (DELETE (LIST O-CAVE O-DIST) + (XSR-MEMBER M-CAVE DANGER)) + DANGER)))) + +;;; XS-MARK-CHANGED marks that a cave-set has been changed. + +(DEFUN XS-MARK-CHANGED (CAVE DANGER) + (STORE (AXS-CHANGED-SETS DANGER) + (GP-CONS CAVE (AXS-CHANGED-SETS DANGER))) + (COND ((XSR-COMPLETE-CAVE-SETP CAVE DANGER) + (STORE (AXS-PARTIAL-SETS DANGER) + (GP-DELETE CAVE (AXS-PARTIAL-SETS DANGER))) + (STORE (AXS-COMPLETE-SETS DANGER) + (GP-CONS CAVE (AXS-COMPLETE-SETS DANGER)))) + (T (STORE (AXS-PARTIAL-SETS DANGER) + (GP-CONS CAVE (AXS-PARTIAL-SETS DANGER)))))) + +;;; XS-NEIGHBOR-CHECK is to propagate cave-sets around caves +;;;that have not been visited. It is only essential when the +;;;warning propagates more than two caves, but it can be +;;;helpful in explanations when the warning propagates two caves. + +(DEFUN XS-NEIGHBOR-CHECK (CAVE-LIST DANGER) + (COND ((NULL CAVE-LIST)) + (T (XS-NEIGHBOR-CHECK (CDR CAVE-LIST) DANGER) + (COND ((XDR-VISITEDP (CAR CAVE-LIST))) + (T (XS-CAVE-CHECK (CAR CAVE-LIST) + (XDR-MORE-THAN (CAR CAVE-LIST) + DANGER) + DANGER)))))) + +;;; XS-NUMEST estimates the size of the cave-set for a given distance. + +(DEFUN XS-NUM-EST (DIST) + ;;;This is a cheap hack that works for now. + (EXPT 2. DIST)) + +;;; XSR-GET-CAVE-SET reurns the cave-set attached to CAVE. + +(DEFUN XSR-GET-CAVE-SET (CAVE DANGER) + (XSR-GET-DIST-SET CAVE 0. DANGER)) + +;;; XSR-GET-MEMBER-SETS returns the originating caves of the +;;;cave-sets of which M-CAVE is a member. + +(DEFUN XSR-GET-MEMBER-SETS (M-CAVE DANGER) + (DO ((WORK-LIST (XSR-MEMBER M-CAVE DANGER) (CDR WORK-LIST)) + (O-CAVE) + (O-DIST) + (VALUE NIL)) + ((NULL WORK-LIST) VALUE) + (SETQ O-CAVE (CAAR WORK-LIST) + O-DIST (CADAR WORK-LIST)) + (COND ((= O-DIST 0.) (SETQ VALUE (CONS O-CAVE VALUE)))))) + +;;; XSR-OTHER-CAVES returns the caves which have not been removed +;;;at DIST and then the probability that they are not applicable. + +(DEFUN XSR-OTHER-CAVES (O-CAVE DIST REDUCED-SET DANGER) + (DO ((I (XDR-EXACTLY O-CAVE DANGER) (1- I)) + (CAVES) + (VALUE) + (NUM 0.)) + ((NOT (> I DIST)) + (LIST VALUE + (//$ (FLOAT (LENGTH REDUCED-SET)) + (FLOAT (+ NUM (LENGTH REDUCED-SET)))))) + (SETQ CAVES (XSR-GET-DIST-SET O-CAVE I DANGER) + VALUE (GP-UNION CAVES VALUE) + NUM (+ NUM + (* (LENGTH CAVES) (XS-NUM-EST (- I DIST))))))) + +;;; XSR-REDUCED-SET returns those caves which were propagated. + +(DEFUN XSR-REDUCED-SET (O-CAVE DIST DANGER) + (GP-REMOVE-LIST (XSR-TOTAL-DIST-SET O-CAVE DIST DANGER) + (XSR-GET-NODIST-SET O-CAVE DIST DANGER))) + +;;; XSR-TOTAL-DIST-SET returns all caves at DIST. + +(DEFUN XSR-TOTAL-DIST-SET (CAVE DIST DANGER) + (ADB-DCAVE CAVE (XSR-PROP-NUM 0. DIST DANGER) DANGER)) + +;;; XS-PUT-TOTAL-SET puts the TOTAL-SET. + +(DEFUN XS-PUT-TOTAL-SET (CAVE VALUE DIST DANGER) + (STORE (ADB-DCAVE CAVE (XSR-PROP-NUM 0. DIST DANGER) DANGER) + VALUE)) + +;;; XSR-GET-DIST-SET gets the DIST-SET because of the complicated access +;;;procedure. + +(DEFUN XSR-GET-DIST-SET (CAVE DIST DANGER) + (ADB-DCAVE CAVE (XSR-PROP-NUM 1. DIST DANGER) DANGER)) + +;;; XS-PUT-DIST-SET putprops the DIST-SET because of the lengthy access +;;;procedure. + +(DEFUN XS-PUT-DIST-SET (CAVE VALUE DIST DANGER) + (STORE (ADB-DCAVE CAVE (XSR-PROP-NUM 1. DIST DANGER) DANGER) + VALUE)) + +;;; XSR-GET-NODIST-SET gets the NODIST-SET because of the lengthy access +;;;procedure. + +(DEFUN XSR-GET-NODIST-SET (CAVE DIST DANGER) + (ADB-DCAVE CAVE (XSR-PROP-NUM 2. DIST DANGER) DANGER)) + +;;; XS-PUT-NODIST-SET putprops the NODIST-SET because of the lengthy access +;;;procedure. + +(DEFUN XS-PUT-NODIST-SET (CAVE VALUE DIST DANGER) + (STORE (ADB-DCAVE CAVE (XSR-PROP-NUM 2. DIST DANGER) DANGER) + VALUE)) + +;;; XSR-PROP-NUM returns the appropriate property number for the arrays. + +(DEFUN XSR-PROP-NUM (TYPE-DIST DIST DANGER) + (DECLARE (SPECIAL DB-TOTAL-DIST DB-NUM-DPROP)) + (+ DB-NUM-DPROP + (* TYPE-DIST DB-TOTAL-DIST) + (ADB-DIST-START DANGER) + DIST)) + +;;; XSR-COMPLETE-CAVE-SETP returns T if the CAVE-SET +;;;attached to CAVE is complete. + +(DEFUN XSR-COMPLETE-CAVE-SETP (CAVE DANGER) + (DO ((DIST (XDR-EXACTLY CAVE DANGER) (1- DIST)) + (DONE NIL) + (VALUE NIL)) + (DONE VALUE) + (COND ((= DIST -1.) (SETQ DONE T)) + ((< DIST 1.) (SETQ DONE T VALUE T)) + ((XSR-GET-DIST-SET CAVE DIST DANGER) + (SETQ DONE T))))) + +;;; XSR-GET-NUM returns the size of the cave-set +;;;(sometimes an estimate.) + +(DEFUN XSR-GET-NUM (CAVE DANGER) (ADB-DCAVE CAVE 16. DANGER)) + +;;; XS-PUT-NUM puts NUM into the arrays. + +(DEFUN XS-PUT-NUM (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 16. DANGER) VALUE)) + +;;; XSR-MEMBER returns the ORIGIN/DIST pairs. + +(DEFUN XSR-MEMBER (CAVE DANGER) (ADB-DCAVE CAVE 7. DANGER)) + +;;; XS-PUT-MEMBER puts the MEMBER value into the arrays. + +(DEFUN XS-PUT-MEMBER (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 7. DANGER) VALUE)) + +;;;******** This is the Second Stage of the Algorithm. ********* +;;; XR-COUNT-NUM checks for groups of cave-sets that would +;;;require certain caves to be safe. + +(DEFUN XR-COUNT-NUM (CHANGED-SETS COMPLETE-SETS DANGER) + (DECLARE (SPECIAL DANGER)) + (COND ((< (LENGTH COMPLETE-SETS) (ADB-NUM-DANGERS DANGER))) + ((NULL CHANGED-SETS)) + (T (XR-COUNT-NUM (CDR CHANGED-SETS) COMPLETE-SETS DANGER) + (COND ((AXR-FOUND-N DANGER) + (XR-CHECK-SETS (AXR-FOUND-N DANGER) + COMPLETE-SETS + COMPLETE-SETS + DANGER))) + (XR-CHECK-SETS (LIST (CAR CHANGED-SETS)) + (GP-DELETE (CAR CHANGED-SETS) + COMPLETE-SETS) + COMPLETE-SETS + DANGER)))) + +;;; XR-CHECK-SETS does the actual searching and marking safe. +;;; Notice that it also keeps track of how many of the dangers +;;;have been identified. + +(DEFUN XR-CHECK-SETS (GOT-SETS CHOOSE-FROM COMPLETE-SETS DANGER) + (COND ((> (1+ (LENGTH GOT-SETS)) (ADB-NUM-DANGERS DANGER)) + ;;; We have chosen N caves, now test them. + (XR-CHECK-SET GOT-SETS COMPLETE-SETS DANGER)) + ;;; Check to see if there anymore caves to choose from. + ;;;If not, then check the ones we have. + ((NULL CHOOSE-FROM) + (XR-CHECK-SET GOT-SETS COMPLETE-SETS DANGER)) + ;;; The algorithm does a binary branch and tries BOTH + ;;;choosing the first choice and not choosing it. + (T (XR-CHECK-SETS GOT-SETS + (CDR CHOOSE-FROM) + COMPLETE-SETS + DANGER) + (XR-CHECK-SETS (CONS (CAR CHOOSE-FROM) GOT-SETS) + (CDR CHOOSE-FROM) + COMPLETE-SETS + DANGER)))) + +;;; XR-CHECK-SET checks to see if the GOT-SETS it is sent have +;;;no intersection, and if so it takes appropriate action. + +(DEFUN XR-CHECK-SET (GOT-SETS COMPLETE-SETS DANGER) + (DECLARE (SPECIAL DANGER)) + (DO + ((REST-OF GOT-SETS (CDR REST-OF)) + (UNION NIL + (GP-UNION UNION + (XSR-GET-CAVE-SET (CAR REST-OF) DANGER))) + (TOTAL 0. + (+ TOTAL + (LENGTH (XSR-GET-CAVE-SET (CAR REST-OF) DANGER))))) + ((OR (< (LENGTH UNION) TOTAL) (NULL REST-OF)) + (COND + ((< (LENGTH UNION) TOTAL)) + ((= (LENGTH GOT-SETS) (ADB-NUM-DANGERS DANGER)) + (STORE (AXR-NUM-IDENTIFIED DANGER) + (ADB-NUM-DANGERS DANGER)) + (STORE (AXR-FOUND-N DANGER) GOT-SETS) + (XD-MARK-SAFE-L10 + (GP-REMOVE-LIST + (APPLY + 'GP-UNION + (MAPCAR + (FUNCTION (LAMBDA (X) (XSR-GET-CAVE-SET X DANGER))) + (APPEND COMPLETE-SETS (AXS-PARTIAL-SETS DANGER)))) + UNION) + GOT-SETS + DANGER)) + ;;; This is to keep track of how many dangers have been identified. + ((> (LENGTH GOT-SETS) (AXR-NUM-IDENTIFIED DANGER)) + (STORE (AXR-NUM-IDENTIFIED DANGER) (LENGTH GOT-SETS))))))) + +;;;********** Probability Routines of the Expert. ************* +;;;********** This is the Third Stage of the Algorithm. ************* +;;; XP-RESET-PROB is the main function of the probability routines. +;;;It returns all those caves whose probabilities have been changed +;;;by either P12 or P14. Note that RESET-CAVES starts as NIL and is +;;;all the caves that P13 changes. + +(DEFUN XP-RESET-PROB (CHANGED-SETS RESET-CAVES DANGER) + (DECLARE (SPECIAL XP-P12-CHANGED)) + (PROG (PROB CAVE CAVE-SET NEW-RESET CHECK-CAVES) + (COND + ((NULL CHANGED-SETS) + (XP-P12-CALC DANGER) + (SETQ NEW-RESET + (GP-UNION XP-P12-CHANGED + (XP-P14 RESET-CAVES NIL DANGER))) + ;;; We have considered XP-P12-CHANGED caves. + (SETQ XP-P12-CHANGED NIL) + (XP-SET-PROB NEW-RESET DANGER) + (RETURN NEW-RESET)) + (T (SETQ CAVE (CAR CHANGED-SETS) + CAVE-SET (XSR-GET-CAVE-SET CAVE DANGER)) + (SETQ PROB + (//$ 1.0 (FLOAT (XSR-GET-NUM CAVE DANGER)))) + (XP-P11 CAVE CAVE-SET PROB DANGER) + (SETQ CHECK-CAVES + (XP-P12 CAVE + (AXS-COMPLETE-SETS DANGER) + DANGER)) + (SETQ RESET-CAVES + (GP-UNION (XP-P13 (APPEND CHECK-CAVES CAVE-SET) + DANGER) + RESET-CAVES)) + (RETURN (XP-RESET-PROB (CDR CHANGED-SETS) + RESET-CAVES + DANGER)))))) + +;;; XP-SET-PROB puts the preferred probability on +;;;the caves property list. + +(DEFUN XP-SET-PROB (WORK-CAVES DANGER) + (PROG (CAVE PROB TEMP) + (COND ((NULL WORK-CAVES) (RETURN NIL)) + (T (XP-SET-PROB (CDR WORK-CAVES) DANGER))) + (SETQ CAVE (CAR WORK-CAVES) + PROB (XPR-GET-P14 CAVE DANGER)) + (XP-PUT-WHY-PROB + CAVE + (COND ((< PROB 0.0) + (XP-PUT-PROB CAVE NIL DANGER) + (COND ((XPR-WHY-P12 CAVE DANGER) '(12.)))) + ((GP-EQ PROB + (SETQ TEMP (XPR-GET-P11 CAVE DANGER))) + (XP-PUT-PROB CAVE TEMP DANGER) + '(11.)) + ((GP-EQ PROB + (SETQ TEMP (XPR-GET-P13 CAVE DANGER))) + (XP-PUT-PROB CAVE TEMP DANGER) + '(13.)) + (T (XP-PUT-PROB CAVE PROB DANGER) '(14.))) + DANGER) + (COND ((AND (= DANGER 2.) + (> (XPR-PROB CAVE 2.) 0.25) + (WGR-EXTRA-ARROWS)) + (XP-PUT-WHY-PROB CAVE + (GP-CONS 15. + (XPR-WHY-PROB CAVE 2.)) + 2.) + (XP-PUT-PROB CAVE + (*$ 0.3333 + (-$ 1.0 (XPR-PROB CAVE 2.))) + 2.))))) + +;;; XP-P11 puts the new P11 value if applicable. + +(DEFUN XP-P11 (O-CAVE ADD-LIST PROB DANGER) + (COND ((NULL ADD-LIST)) + (T (XP-P11 O-CAVE (CDR ADD-LIST) PROB DANGER) + (COND ((< (XPR-GET-P11 (CAR ADD-LIST) DANGER) PROB) + (XP-PUT-P11 (CAR ADD-LIST) PROB DANGER) + (XP-PUT-WHY-P11 (CAR ADD-LIST) + O-CAVE + DANGER)))))) + +;;; XP-P12 marks those caves to which P12 applies. It also +;;;returns those caves which P13 ought to check. + +(DEFUN XP-P12 (O-CAVE COMPLETE-SETS DANGER) + ;;;This is to see if O-CAVE is a superset of any complete-set. + (XP-P12-WORK (GP-DELETE O-CAVE COMPLETE-SETS) + (LIST O-CAVE) + DANGER) + (COND + ((MEMBER O-CAVE COMPLETE-SETS) + ;;; This is to see if it is subset of another cave-set. + (XP-P12-WORK (LIST O-CAVE) + (GP-DELETE O-CAVE + (APPEND (AXS-PARTIAL-SETS DANGER) + COMPLETE-SETS)) + DANGER)))) + +;;; XP-P12-WORK does the searching for caves to which P12 applies. +;;;It also finds cave-sets that are redundant and/or unnecessary. +;;;It keeps a list of those caves which it has changed in XP-P12-CHANGED. + +(DEFUN XP-P12-WORK (SUBSET-CAVES SUPERSET-CAVES DANGER) + (PROG (SUBSET SUPERSET RESULT) + (COND + ((AND SUBSET-CAVES SUPERSET-CAVES) + (SETQ RESULT + (APPEND (XP-P12-WORK (CDR SUBSET-CAVES) + SUPERSET-CAVES + DANGER) + (XP-P12-WORK SUBSET-CAVES + (CDR SUPERSET-CAVES) + DANGER))) + (SETQ SUBSET (XSR-GET-CAVE-SET (CAR SUBSET-CAVES) + DANGER)) + (SETQ SUPERSET + (XSR-GET-CAVE-SET (CAR SUPERSET-CAVES) DANGER)) + (COND + ;;; Ensure that SUBSET is a good cave-set. + ((XPR-REDUNDANTP (CAR SUBSET-CAVES) DANGER)) + ;;; If anything is returned, SUBSET is not a subset. + ((GP-REMOVE-LIST SUBSET SUPERSET) (RETURN RESULT)) + (T + (RETURN (APPEND RESULT + (XP-P12-MARK (GP-REMOVE-LIST SUPERSET + SUBSET) + (CAR SUBSET-CAVES) + (CAR SUPERSET-CAVES) + DANGER))))))))) + +;;; XP-P12-MARK marks caves to which P12 aplies and marks +;;;redundant cave-sets. + +(DEFUN XP-P12-MARK (MARK-CAVES SUB-CAVE SUPER-CAVE DANGER) + (DECLARE (SPECIAL XP-P12-CHANGED)) + (COND ((NULL MARK-CAVES) + (XP-PUT-REDUNDANT SUPER-CAVE SUB-CAVE DANGER)) + (T (XP-P12-MARK (CDR MARK-CAVES) + SUB-CAVE + SUPER-CAVE + DANGER) + (SETQ XP-P12-CHANGED (GP-CONS (CAR MARK-CAVES) + XP-P12-CHANGED)) + (XP-PUT-P13 (CAR MARK-CAVES) -1.0 DANGER) + (XP-PUT-P14 (CAR MARK-CAVES) -1.0 DANGER) + (XP-PUT-WHY-P12 (CAR MARK-CAVES) + (GP-CONS (LIST SUB-CAVE SUPER-CAVE) + (XPR-WHY-P12 (CAR MARK-CAVES) + DANGER)) + DANGER))) + MARK-CAVES) + +;;; XP-P12-CALC calculates the probability for all P12 caves at this move. + +(DEFUN XP-P12-CALC (DANGER) + (DECLARE (SPECIAL XD-VISITED-CAVES DB-NUM-CAVES)) + (PROG (IDENTIFIED UNIDENTIFIED SAFE) + (SETQ IDENTIFIED (AXR-NUM-IDENTIFIED DANGER)) + (SETQ UNIDENTIFIED (- (ADB-NUM-DANGERS DANGER) + IDENTIFIED)) + (SETQ SAFE (LENGTH XD-VISITED-CAVES)) + (STORE (AXP-PROB12 DANGER) + (//$ (FLOAT UNIDENTIFIED) + (FLOAT (COND ((= (+ SAFE IDENTIFIED) + DB-NUM-CAVES) + 1.) + (T (- DB-NUM-CAVES + SAFE + IDENTIFIED)))))))) + +;;; XP-P13 resets the probabilities for P13. It returns +;;;the caves which it changes. + +(DEFUN XP-P13 (CHANGE-LIST DANGER) + (COND + ((NULL CHANGE-LIST) NIL) + (T + (DO + ((CAVE (CAR CHANGE-LIST)) + (CAVE-SETS (XPR-GOOD-MEMBER-SETS (CAR CHANGE-LIST) DANGER) + (CDR CAVE-SETS)) + (SAFE-PROB 1.0) + (FINAL-PROB 0.0)) + ((NULL CAVE-SETS) + (SETQ FINAL-PROB (-$ 1.0 SAFE-PROB)) + ;;; If the probability hasn't changed, don't do anything. + (COND ((OR (NULL (XPR-GOOD-MEMBER-SETS CAVE DANGER)) + (GP-EQ FINAL-PROB (XPR-GET-P13 CAVE DANGER))) + (XP-P13 (CDR CHANGE-LIST) DANGER)) + (T (XP-PUT-P13 CAVE FINAL-PROB DANGER) + (GP-CONS CAVE + (XP-P13 (CDR CHANGE-LIST) DANGER))))) + (SETQ SAFE-PROB + (*$ SAFE-PROB + (-$ 1.0 + (//$ 1.0 + (FLOAT (XSR-GET-NUM (CAR CAVE-SETS) + DANGER)))))))))) + +;;; XP-P14 updates the P14 probabilities. +;;;Note that it returns all those caves which it has recalculated. + +(DEFUN XP-P14 (RESET-CAVES CALC-CAVES DANGER) + (DECLARE (SPECIAL DANGER)) + (COND ((NULL RESET-CAVES) + (XP-P14-CALC CALC-CAVES DANGER) + CALC-CAVES) + (T (XP-P14 (CDR RESET-CAVES) + (GP-UNION (XP-P14-PROPAGATES (CAR RESET-CAVES) + DANGER) + CALC-CAVES) + DANGER)))) + +;;; XP-P14-PROPAGATES returns those caves which are +;;;related to CAVE in P14 calculations. + +(DEFUN XP-P14-PROPAGATES (CAVE DANGER) + (APPLY 'GP-UNION + (MAPCAR + (FUNCTION (LAMBDA (X) (XSR-GET-CAVE-SET X DANGER))) + (XPR-GOOD-MEMBER-SETS CAVE DANGER)))) + +;;; XP-P14-CALC does the actual calculations of P14. + +(DEFUN XP-P14-CALC (CALC-CAVES DANGER) + (PROG (CAVE MEMBER-SETS) + (COND + ((NULL CALC-CAVES)) + ((NOT (SETQ CAVE + (CAR CALC-CAVES) + MEMBER-SETS + (XPR-GOOD-MEMBER-SETS CAVE DANGER))) + (XP-P14-CALC (CDR CALC-CAVES) DANGER)) + (T + (XP-P14-CALC (CDR CALC-CAVES) DANGER) + (XP-PUT-P14 CAVE + (-$ (XPR-GET-P13 CAVE DANGER) + (*$ (//$ 1.0 + (FLOAT (LENGTH MEMBER-SETS))) + (XP-P14-SUM-PROB CAVE + MEMBER-SETS + DANGER))) + DANGER) + ;;; Do not allow P14 to reduce probs too much. + (COND ((< (XPR-GET-P14 CAVE DANGER) + (AXP-PROB12 DANGER)) + (XP-PUT-P14 CAVE + (+$ 1.0E-3 (AXP-PROB12 DANGER)) + DANGER))))))) + +;;; XP-P14-SUM-PROB does the inner sum of formula in paper. + +(DEFUN XP-P14-SUM-PROB (CAVE MEMBER-SETS DANGER) + (COND ((NULL MEMBER-SETS) 0.0) + ;;; If the cave-set has only one member, P14 does not apply. + ((= (XSR-GET-NUM (CAR MEMBER-SETS) DANGER) 1.) + (XP-P14-SUM-PROB CAVE (CDR MEMBER-SETS) DANGER)) + (T (DO ((WORK-CAVES (XPR-P13-CHANGED (CAR MEMBER-SETS) + DANGER) + (CDR WORK-CAVES)) + (SUM 0.0) + ;;; Remember that the algorithm passes over the cave itself. + (PROB -1.0 + (COND ((EQUAL (CAR WORK-CAVES) CAVE) -1.0) + ((CAR WORK-CAVES) + (XPR-GET-P13 (CAR WORK-CAVES) + DANGER)) + (T 2.0))) + (N (FLOAT (XSR-GET-NUM (CAR MEMBER-SETS) + DANGER)))) + ((= PROB 2.0) + (+$ (*$ SUM (//$ 1.0 (1-$ N))) + (XP-P14-SUM-PROB CAVE + (CDR MEMBER-SETS) + DANGER))) + (COND ((GP-EQ PROB -1.0)) + (T (SETQ SUM (-$ (+$ SUM PROB) + (//$ 1.0 N))))))))) + +;;; XPR-GOOD-MEMBER-SETS returns all good cave-sets. + +(DEFUN XPR-GOOD-MEMBER-SETS (CAVE DANGER) + (DO ((MEMBER-SETS (XSR-GET-MEMBER-SETS CAVE DANGER) + (CDR MEMBER-SETS)) + (VALUE)) + ((NULL MEMBER-SETS) VALUE) + (COND ((XPR-REDUNDANTP (CAR MEMBER-SETS) DANGER)) + (T (SETQ VALUE (CONS (CAR MEMBER-SETS) VALUE)))))) + +;;; XPR-REDUNDANTP returns the SUPER-SET which this +;;;cave-set redundant. + +(DEFUN XPR-REDUNDANTP (CAVE DANGER) (ADB-DCAVE CAVE 8. DANGER)) + +;;; XP-PUT-REDUNDANT puts the SUPER-SET into the arrays. + +(DEFUN XP-PUT-REDUNDANT (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 8. DANGER) VALUE)) + +;;; XPR-PROB returns the preferred probability. + +(DEFUN XPR-PROB (CAVE DANGER) + (COND ((> (XDR-MORE-THAN CAVE DANGER) -1.) 0.0) + ((ADB-DCAVE CAVE 9. DANGER)) + (T (XPR-GET-P12 CAVE DANGER)))) + +;;; XP-PUT-PROB puts the appropriate value into the array. + +(DEFUN XP-PUT-PROB (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 9. DANGER) VALUE)) + +;;; XPR-WHY-PROB returns the probability rule(s) +;;;that were applied. (P12 if no others) + +(DEFUN XPR-WHY-PROB (CAVE DANGER) + (COND ((> (XDR-MORE-THAN CAVE DANGER) -1.) NIL) + ((ADB-DCAVE CAVE 10. DANGER)) + ((AXR-FOUND-N DANGER) + (XD-MARK-SAFE-L10 (LIST CAVE) + (AXR-FOUND-N DANGER) + DANGER) + NIL) + (T '(12.)))) + +;;; XP-PUT-WHY-PROB puts the probability rules into the arrays. + +(DEFUN XP-PUT-WHY-PROB (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 10. DANGER) VALUE)) + +;;; XPR-GET-P11 returns the probability according to P11. +;;;It is -1.0 if P11 does not apply at all. + +(DEFUN XPR-GET-P11 (CAVE DANGER) (ADB-DCAVE CAVE 11. DANGER)) + +;;; XP-PUT-P11 puts the probability for P11. + +(DEFUN XP-PUT-P11 (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 11. DANGER) VALUE)) + +;;; XPR-WHY-P11 returns the cave which caused the P11 probability. + +(DEFUN XPR-WHY-P11 (CAVE DANGER) (ADB-DCAVE CAVE 15. DANGER)) + +;;; XP-PUT-WHY-P11 puts the reason for a P11 prob (originating cave). + +(DEFUN XP-PUT-WHY-P11 (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 15. DANGER) VALUE)) + +;;; XPR-GET-P12 returns the probability for P12 (otherwise -1.0). + +(DEFUN XPR-GET-P12 (CAVE DANGER) + (COND ((AND (< (XDR-MORE-THAN CAVE DANGER) 0.) + (NOT (XPR-GOOD-MEMBER-SETS CAVE DANGER))) + ;;;This is to insure the correct reason + ;;;is marked for a prob of zero. + (COND ((AXR-FOUND-N DANGER) + (XD-MARK-SAFE-L10 (LIST CAVE) + (AXR-FOUND-N DANGER) + DANGER) + 0.0) + (T (AXP-PROB12 DANGER)))) + (T -1.0))) + +;;; XPR-WHY-P12 returns the caves responsible for a +;;;P12 classification. + +(DEFUN XPR-WHY-P12 (CAVE DANGER) (ADB-DCAVE CAVE 12. DANGER)) + +;;; XP-PUT-WHY-P12 puts why there is a classification of P12. + +(DEFUN XP-PUT-WHY-P12 (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 12. DANGER) VALUE)) + +;;; XPR-GET-P13 returns the probability of P13 (otherwise -1.0). + +(DEFUN XPR-GET-P13 (CAVE DANGER) (ADB-DCAVE CAVE 13. DANGER)) + +;;; XP-PUT-P13 puts the prob of P13. + +(DEFUN XP-PUT-P13 (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 13. DANGER) VALUE)) + +;;; XPR-P13-CHANGED returns those members of a +;;;cave-set which have been reset by P13. + +(DEFUN XPR-P13-CHANGED (O-CAVE DANGER) + (DECLARE (SPECIAL DANGER)) + (GM-ALL-TRUE (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL DANGER)) + (> (XPR-GET-P13 X DANGER) + (XPR-GET-P11 X DANGER)))) + (XSR-GET-CAVE-SET O-CAVE DANGER))) + +;;; XPR-GET-P14 returns the probability of P14 (otherwise -1.0). + +(DEFUN XPR-GET-P14 (CAVE DANGER) (ADB-DCAVE CAVE 14. DANGER)) + +;;; XP-PUT-P14 puts the prob for P14. + +(DEFUN XP-PUT-P14 (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 14. DANGER) VALUE)) + +;;; XPR-SHOOTP determines if it would be better to shoot +;;;into a given cave before visiting it. + +(DEFUN XPR-SHOOTP (CAVE) + (AND (XPR-WHY-PROB CAVE 2.) + (= (CAR (XPR-WHY-PROB CAVE 2.)) 15.))) + +;;; ************ The Move Comparer Routines. ************ +;;; CMR-SAFEP returns true if a cave is acceptably safe. + +(DEFUN CMR-SAFEP (CAVE DANGERS) + (COND ((NULL DANGERS) T) + ((< (XDR-MORE-THAN CAVE (CAR DANGERS)) 0.) NIL) + ((SLR-OK-RULESP (CXR-PROB CAVE (CAR DANGERS)) + (CAR DANGERS)) + (CMR-SAFEP CAVE (CDR DANGERS))))) + +;;; CMR-KNOWS-SAME determines if the two moves are the same or +;;;that the player recognized them as the same or worse. + +(DEFUN CMR-KNOWS-SAME (B-MOVE W-MOVE DANGERS) + (COND ((NULL DANGERS) T) + ((OR (CMR-SAME-DANGERSP W-MOVE B-MOVE (LIST (CAR DANGERS))) + (SLR-KNOWS-RULESP (CXR-BETTER W-MOVE B-MOVE (CAR DANGERS)) + (CAR DANGERS))) + (CMR-KNOWS-SAME B-MOVE W-MOVE (CDR DANGERS))))) + +;;; CMR-SAME-DANGERSP determines if two caves are identical with +;;;respect to DANGER (returns T) or if the player should have +;;;recognized that they were equivalent (returns the rules involved). + +(DEFUN CMR-SAME-DANGERSP (CAVE1 CAVE2 DANGERS) + (COND ((NULL DANGERS) T) + ((NOT (GP-EQ (XPR-PROB CAVE1 (CAR DANGERS)) + (XPR-PROB CAVE2 (CAR DANGERS)))) + NIL) + ((GP-EQUIV (CXR-PROB CAVE1 (CAR DANGERS)) + (CXR-PROB CAVE2 (CAR DANGERS))) + (CMR-SAME-DANGERSP CAVE1 CAVE2 (CDR DANGERS))) + ((AND (SLR-KNOWS-RULESP + (GP-UNION (CXR-PROB CAVE1 (CAR DANGERS)) + (CXR-PROB CAVE2 (CAR DANGERS))) + (CAR DANGERS)) + (CMR-SAME-DANGERSP CAVE1 CAVE2 (CDR DANGERS))) + (GP-UNION (CXR-PROB CAVE1 (CAR DANGERS)) + (CXR-PROB CAVE2 (CAR DANGERS)))))) + +;;; CMR-BETTER-PROBSP returns T if BETTER actually is better +;;;and the explanation is acceptable (for DANGERS). + +(DEFUN CMR-BETTER-PROBSP (BETTER WORSE DANGERS) + (COND ((NULL DANGERS) T) + ((CMR-BETTER-PROBP BETTER WORSE (CAR DANGERS)) + (CMR-BETTER-PROBSP BETTER WORSE (CDR DANGERS))))) + +;;; CMR-BETTER-PROBP returns T if BETTER is better +;;;for acceptable reasons. + +(DEFUN CMR-BETTER-PROBP (BETTER WORSE DANGER) + (COND ((GP-LT (XPR-PROB BETTER DANGER) (XPR-PROB WORSE DANGER)) + (SLR-OK-RULESP (CXR-BETTER BETTER WORSE DANGER) + DANGER)))) + +;;; CMR-C5-TEST tests to insure that all the PROBS +;;;are as bad or worse for DANGERS. + +(DEFUN CMR-C5-TEST (W-MOVE H-MOVE DANGERS) + (COND ((NULL DANGERS) T) + ((OR (CMR-SAME-DANGERSP W-MOVE + H-MOVE + (LIST (CAR DANGERS))) + (CMR-BETTER-PROBP W-MOVE H-MOVE (CAR DANGERS))) + (CMR-C5-TEST W-MOVE H-MOVE (CDR DANGERS))))) + +;;; CMR-EXPLAIN-DANGER returns those dangers for which the player +;;is not expected to know how to calculate the prob. + +(DEFUN CMR-EXPLAIN-DANGER (CAVE1 CAVE2 DANGERS) + (DO ((WORK-ON DANGERS (CDR WORK-ON)) + (DANGER) + (OK-DANGERS)) + ((NULL WORK-ON) + (COND ((NULL OK-DANGERS) (SETQ OK-DANGERS DANGERS))) + (COND ((MEMBER 2. OK-DANGERS) '(2.)) + ((MEMBER 1. OK-DANGERS) '(1.)) + (T '(0.)))) + (SETQ DANGER (CAR WORK-ON)) + (COND ((GP-EQ (XPR-PROB CAVE2 DANGER) 1.0) + (SETQ WORK-ON NIL + OK-DANGERS (LIST DANGER))) + ((NOT (AND (SLR-KNOWS-RULESP (CXR-PROB CAVE1 DANGER) DANGER) + (SLR-KNOWS-RULESP (CXR-PROB CAVE2 DANGER) DANGER))) + (SETQ OK-DANGERS (CONS DANGER OK-DANGERS)))))) + +;;; CXR-BETTER returns the rules for why B-CAVE is better. + +(DEFUN CXR-BETTER (B-CAVE W-CAVE DANGER) + (DECLARE (SPECIAL CX-COMPARE CX-WHY-BETTER CX-WHY-WORSE)) + (SETQ CX-COMPARE (LIST B-CAVE W-CAVE)) + ;;; As in paper, we must check for cases where default + ;;;assumptions of unsafe apply, i.e. when better is absolutely + ;;;safe or worse is absolute danger. When both special cases + ;;;apply, a tricky hack is used (a rare case). + (COND ((AND (GP-EQ (XPR-PROB W-CAVE DANGER) 1.0) + (GP-EQ (XPR-PROB B-CAVE DANGER) 0.0)) + (SETQ CX-COMPARE NIL) + (COND ((< (LENGTH (CXR-PROB B-CAVE DANGER)) + (LENGTH (CXR-PROB W-CAVE DANGER))) + (CXR-PROB B-CAVE DANGER)) + (T (CXR-PROB W-CAVE DANGER)))) + ((GP-EQ (XPR-PROB B-CAVE DANGER) 0.0) + (SETQ CX-COMPARE NIL) + (CXR-PROB B-CAVE DANGER)) + ((GP-EQ (XPR-PROB W-CAVE DANGER) 1.0) + (SETQ CX-COMPARE NIL) + (CXR-PROB W-CAVE DANGER)) + ((GP-LT (XPR-GET-P11 B-CAVE DANGER) + (XPR-GET-P11 W-CAVE DANGER)) + (SETQ CX-WHY-BETTER 11. + CX-WHY-WORSE 11.) + (CX-PROB11 (LIST B-CAVE W-CAVE) DANGER NIL)) + ((> (XPR-GET-P12 B-CAVE DANGER) -1.0) + (SETQ CX-WHY-BETTER 12. + CX-WHY-WORSE 11.) + (CXR-PROB B-CAVE DANGER)) + ((GP-LT (XPR-GET-P11 B-CAVE DANGER) + (XPR-GET-P13 W-CAVE DANGER)) + (SETQ CX-WHY-BETTER 11. + CX-WHY-WORSE 13.) + (CX-PROB11 (LIST B-CAVE) + DANGER + (CX-PROB13 (LIST W-CAVE) + DANGER + NIL))) + ((GP-LT (XPR-GET-P14 B-CAVE DANGER) + (XPR-GET-P11 W-CAVE DANGER)) + (SETQ CX-WHY-BETTER 14. + CX-WHY-WORSE 11.) + (CX-PROB14 (LIST B-CAVE) + DANGER + (CX-PROB11 (LIST W-CAVE) + DANGER + NIL))) + (T (SETQ CX-COMPARE NIL) + (GP-UNION (CXR-PROB B-CAVE DANGER) + (CXR-PROB W-CAVE DANGER))))) + +;;; CXR-PROB is the interface routine for CX-PROB. + +(DEFUN CXR-PROB (CAVE DANGER) + (DECLARE (SPECIAL WE-MOVE-NUM)) + (COND ((NOT (= (CAR (ADB-DCAVE CAVE 17. DANGER)) WE-MOVE-NUM)) + (STORE (ADB-DCAVE CAVE 17. DANGER) + (CONS WE-MOVE-NUM (CX-PROB CAVE DANGER NIL))))) + (CDR (ADB-DCAVE CAVE 17. DANGER))) + +;;; CX-PROB returns the rules necessary to explain +;;;the prob that was used by the expert. + +(DEFUN CX-PROB (CAVE DANGER REASONS) + ((GP-MAKN 'CX-PROB (CAR (XPR-WHY-PROB CAVE DANGER))) + (LIST CAVE) + DANGER + REASONS)) + +;;; CXR-CAVE-SET returns the rules involved with +;;;the list of cave-sets (originating caves). + +(DEFUN CXR-CAVE-SET (WORK-LIST DANGER REASONS) + (CX-CAVE-SET WORK-LIST DANGER REASONS NIL)) + +;;; CX-CAVE-SET, this interfacing is to prevent +;;;endless repititions of L10s. + +(DEFUN CX-CAVE-SET (WORK-LIST DANGER REASONS L10-SW) + (COND + ((NULL WORK-LIST) REASONS) + (T (SETQ REASONS + (CX-CAVE-SET (CDR WORK-LIST) DANGER REASONS L10-SW)) + (DO ((O-CAVE (CAR WORK-LIST)) + (VALUE (CXR-EXACTLY (CAR WORK-LIST) DANGER REASONS)) + (DIST (XDR-EXACTLY (CAR WORK-LIST) DANGER) (1- DIST)) + (TEMP)) + ((< DIST 1.) + (CXR-MORE-THAN (XXT-GET-NODIST-SET O-CAVE + 0. + DANGER + L10-SW) + 0. + DANGER + VALUE)) + (COND ((SETQ TEMP + (XSR-GET-NODIST-SET O-CAVE DIST DANGER)) + (SETQ VALUE + (CXR-MORE-THAN TEMP + DIST + DANGER + (GP-CONS 8. VALUE))))))))) + +;;; CXR-MORE-THAN returns the rules that were necessary +;;;to justify a "more than" class. + +(DEFUN CXR-MORE-THAN (WORK-CAVES DIST DANGER REASONS) + (PROG (CAVE REASON) + (COND ((NULL WORK-CAVES) (RETURN REASONS))) + (SETQ REASONS (CXR-MORE-THAN (CDR WORK-CAVES) + DIST + DANGER + REASONS) + CAVE (CAR WORK-CAVES) + REASON (XXR-WHY-MORE-THAN CAVE DIST DANGER)) + (RETURN + (COND ((> DIST (XDR-MORE-THAN CAVE DANGER)) + (WE-ERROR (LIST 'CXR-MORE-THAN + CAVE + DIST + DANGER)) + REASONS) + ((= DIST -1.) REASONS) + ((= REASON 5.) + (COND ((AND (= (XDR-MORE-THAN CAVE DANGER) 0.) + (> (ADB-WARNING-DIST DANGER) 1.)) + (SETQ REASONS (GP-CONS 19. REASONS)))) + (CXR-MORE-THAN (CDR (XDR-WHY-MORE-THAN CAVE + DANGER)) + (1+ DIST) + DANGER + (GP-CONS 5. REASONS))) + ((= REASON 6.) + (CXR-MORE-THAN (WGR-NEIGHBORS CAVE) + (1- DIST) + DANGER + (GP-CONS 6. REASONS))) + ((= REASON 10.) + (CX-CAVE-SET (CADR (XDR-WHY-MORE-THAN CAVE + DANGER)) + DANGER + (GP-CONS 10. REASONS) + T)) + (T (GP-CONS REASON REASONS)))))) + +;;; CXR-EXACTLY returns the reasons for an EXACTLY classification. + +(DEFUN CXR-EXACTLY (CAVE DANGER REASONS) + (COND ((= (CAR (XDR-WHY-EXACTLY CAVE DANGER)) 0.) + (GP-CONS 0. REASONS)) + (T (CXR-MORE-THAN (LIST CAVE) + (XDR-MORE-THAN CAVE DANGER) + DANGER + (GP-UNION '(7. 4.) REASONS))))) + +;;; CXR-VALUE returns the reasons for an increased cave-value. + +(DEFUN CXR-VALUE (CAVE) + (CXR-EXACTLY (CAAR (XSR-MEMBER CAVE 2.)) 2. NIL)) + +;;; CX-PROBNIL adds why the given caves are safe. (no rule) + +(DEFUN CX-PROBNIL (CAVE-LIST DANGER REASONS) + (COND ((NULL CAVE-LIST) REASONS) + ((GP-LT 0.0 (XPR-PROB (CAR CAVE-LIST) DANGER)) + (CX-PROBNIL (CDR CAVE-LIST) + DANGER + (CX-PROB12 (LIST (CAR CAVE-LIST)) + DANGER + REASONS))) + (T (CX-PROBNIL (CDR CAVE-LIST) + DANGER + (CXR-MORE-THAN (LIST (CAR CAVE-LIST)) + 0. + DANGER + REASONS))))) + +;;; CX-PROB11 gathers the reasons for a PROB11 probability. + +(DEFUN CX-PROB11 (CAVE-LIST DANGER REASONS) + (COND + ((NULL CAVE-LIST) REASONS) + ;;; If L0 applied, P11 is not necessary to justify PROB. + ((AND (GP-EQ (XPR-GET-P11 (CAR CAVE-LIST) DANGER) 1.0) + (EQUAL (XPR-WHY-P11 (CAR CAVE-LIST) DANGER) (CAR CAVE-LIST))) + (GP-CONS 0. REASONS)) + (T (CX-PROB11 (CDR CAVE-LIST) + DANGER + (CXR-CAVE-SET (LIST (XPR-WHY-P11 (CAR CAVE-LIST) + DANGER)) + DANGER + (GP-CONS 11. REASONS)))))) + +;;; CX-PROB12 returns the reasons for PROB12. + +(DEFUN CX-PROB12 (CAVE-LIST DANGER REASONS) + (COND + ((NULL CAVE-LIST) REASONS) + (T + (CX-PROB12 (CDR CAVE-LIST) + DANGER + (CXR-CAVE-SET (APPLY 'APPEND + (XPR-WHY-P12 (CAR CAVE-LIST) + DANGER)) + DANGER + (GP-CONS 12. REASONS)))))) + +;;; CX-PROB13 adds on the reasons for a P13 prob. + +(DEFUN CX-PROB13 (WORK-LIST DANGER REASONS) + (COND + ((NULL WORK-LIST) REASONS) + (T (SETQ REASONS (CX-PROB13 (CDR WORK-LIST) DANGER REASONS)) + (COND ((XPR-WHY-P12 (CAR WORK-LIST) DANGER) + (SETQ REASONS + (CX-PROB12 (LIST (CAR WORK-LIST)) + DANGER + REASONS)))) + (CXR-CAVE-SET (XPR-GOOD-MEMBER-SETS (CAR WORK-LIST) DANGER) + DANGER + (GP-CONS 13. REASONS))))) + +;;; CX-PROB14 adds on the reasons for a P14 prob. + +(DEFUN CX-PROB14 (CAVE-LIST DANGER REASONS) + (DO ((CAVE-SETS (XPR-GOOD-MEMBER-SETS (CAR CAVE-LIST) DANGER) + (CDR CAVE-SETS)) + (VALUE (GP-CONS 14. REASONS))) + ((NULL CAVE-SETS) + (COND ((CDR CAVE-LIST) + (CX-PROB14 (CDR CAVE-LIST) DANGER VALUE)) + (T VALUE))) + (SETQ VALUE + (CXR-CAVE-SET (LIST (CAR CAVE-SETS)) DANGER VALUE) + VALUE + (CX-PROB13 (XPR-P13-CHANGED (CAR CAVE-SETS) DANGER) + DANGER + VALUE)))) + +;;; CX-PROB15 adds on the reasons for PROB15. + +(DEFUN CX-PROB15 (CAVE-LIST DANGER REASONS) + (COND + ((NULL CAVE-LIST) REASONS) + (T (CX-PROB15 (CDR CAVE-LIST) + DANGER + ((GP-MAKN 'CX-PROB + (CADR (XPR-WHY-PROB (CAR CAVE-LIST) + DANGER))) + (LIST (CAR CAVE-LIST)) + DANGER + (GP-CONS 15. REASONS)))))) + +;;; ************ Psychologist Functions ********* +;;; PS-UPDATE-MODEL compares moves and updates the student model. + +(DEFUN PS-UPDATE-MODEL (MOVE) + (DECLARE (SPECIAL DB-MOVES)) + (PROG (WORSE-CAVES DANGERS) + (SETQ DB-MOVES (1+ DB-MOVES)) + (COND ((XDR-VISITEDP MOVE) + (MAPC (FUNCTION (LAMBDA (X) (SK-MARK-RULE 1. X))) + '(0. 1. 2.)) + (RETURN NIL))) + (COND ((SETQ WORSE-CAVES (PS-WORSE-CAVES MOVE))) + (T (GO END))) + (G-TSAY + (APPEND + '(|*** Moves which the student seems to| + |have correctly identified as worse|) + (EG-INSERT-AND '|is cave| WORSE-CAVES) + '(|. ***|))) + (SETQ DANGERS (XXR-DANGERS MOVE)) + ;;; Is it possible that C5 applies? + (COND ((XSR-MEMBER MOVE 2.) + (PS-C5 WORSE-CAVES MOVE DANGERS))) + (COND ((NULL DANGERS) (PS-C0 WORSE-CAVES MOVE NIL)) + ((= (LENGTH DANGERS) 1.) + (PS-C1 WORSE-CAVES MOVE (CAR DANGERS) NIL) + (PS-C2 WORSE-CAVES MOVE DANGERS NIL)) + (T (PS-C2 WORSE-CAVES MOVE DANGERS NIL) + (PS-C3 WORSE-CAVES + MOVE + DANGERS + NIL + DANGERS + WORSE-CAVES))) + END (PS-DEGRADE-MODEL MOVE) + (SC-UPDATE-MODEL))) + +;;; PS-WORSE-CAVES returns those caves which the player +;;;is thought to have found some fault with. + +(DEFUN PS-WORSE-CAVES (MOVE) + (DECLARE (SPECIAL MOVE WAW-ROUTE WAW-GIVEN-ROUTE LWA-GOOD-MOVES XX-BEST-MOVES)) + (PROG (DIST FRINGE-CAVES) + (SETQ DIST (LENGTH (WAW-FIND-ROUTE MOVE 0.)) + DIST (+ DIST DIST -3. (- (LENGTH WAW-ROUTE)))) + (COND ((GC-MEMBER LWA-GOOD-MOVES MOVE) (RETURN NIL)) + ;;; If the player asked for a route to this cave, + ;;;he is presumed to have identified all worse caves. + ((MEMBER MOVE WAW-GIVEN-ROUTE) + (RETURN (PS-WORSE-WORK MOVE XX-BEST-MOVES))) + ((< DIST 1.) (RETURN NIL))) + (SETQ FRINGE-CAVES (GP-INTERSECTION XX-BEST-MOVES + (WAD-GET-DIST DIST))) + (RETURN (PS-WORSE-WORK MOVE FRINGE-CAVES)))) + +;;; PS-WORSE-WORK actually figures out which are worse. + +(DEFUN PS-WORSE-WORK (MOVE OTHERS) + (DECLARE (SPECIAL LWA-BAD-MOVES)) + (COND ((NULL OTHERS) NIL) + ((AND (NOT (GC-MEMBER LWA-BAD-MOVES (CAR OTHERS))) + (XXR-BETTER-MOVEP MOVE (CAR OTHERS))) + (CONS (CAR OTHERS) (PS-WORSE-WORK MOVE (CDR OTHERS)))) + (T (PS-WORSE-WORK MOVE (CDR OTHERS))))) + +;;; PS-C0 marks rules as appropriate for C0. + +(DEFUN PS-C0 (WORSE-MOVES B-MOVE MARKED) + (PROG (W-MOVE W-DANGERS W-DANGER) + (COND ((NULL WORSE-MOVES) + (COND (MARKED (SKC-MARK-RULE 0.))) + (RETURN NIL))) + (SETQ W-MOVE (CAR WORSE-MOVES) + W-DANGERS (XXR-DANGERS W-MOVE) + W-DANGER (CAR W-DANGERS)) + (COND ((AND W-DANGER + (OR (CDR W-DANGERS) + (MEMBER W-DANGER MARKED))) + (PS-C0 (CDR WORSE-MOVES) B-MOVE MARKED)) + (W-DANGER (PS-TEST-MARK (CXR-BETTER B-MOVE + (CAR WORSE-MOVES) + W-DANGER) + W-MOVE + 0. + W-DANGER) + (PS-C0 (CDR WORSE-MOVES) + B-MOVE + (CONS W-DANGER MARKED)))))) + +;;; PS-C1 marks rules as appropriate for C1. + +(DEFUN PS-C1 (WORSE-MOVES B-MOVE B-DANGER MARKED) + (PROG (W-MOVE W-DANGERS NEW-RULES) + (COND ((NULL WORSE-MOVES) + (COND (MARKED (SKC-MARK-RULE 1.))) + (RETURN NIL))) + (SETQ W-MOVE (CAR WORSE-MOVES) + W-DANGERS (XXR-DANGERS W-MOVE)) + (COND ((AND (NULL (CDR W-DANGERS)) + (= (CAR W-DANGERS) B-DANGER) + (SETQ NEW-RULES + (CMR-BETTER-PROBP B-MOVE + W-MOVE + B-DANGER))) + (SETQ NEW-RULES (GP-REMOVE-LIST NEW-RULES MARKED)) + (PS-TEST-MARK NEW-RULES W-MOVE 1. B-DANGER))) + (PS-C1 (CDR WORSE-MOVES) + B-MOVE + B-DANGER + (APPEND NEW-RULES MARKED)))) + +;;; PS-C2 marks rules as appropriate for C2. + +(DEFUN PS-C2 (WORSE-MOVES B-MOVE B-DANGERS MARKED) + (PROG (W-MOVE W-DANGERS O-DANGERS O-DANGER NOT-OK) + (COND ((NULL WORSE-MOVES) + (COND (MARKED (SKC-MARK-RULE 2.))) + (RETURN NIL))) + (SETQ W-MOVE (CAR WORSE-MOVES) + W-DANGERS (XXR-DANGERS W-MOVE) + O-DANGERS (GP-REMOVE-LIST W-DANGERS B-DANGERS) + NOT-OK (GP-REMOVE-LIST B-DANGERS W-DANGERS) + O-DANGER (CAR O-DANGERS)) + (COND ((OR (CDR O-DANGERS) + NOT-OK + (MEMBER O-DANGER MARKED) + (NOT (CMR-KNOWS-SAME B-MOVE + W-MOVE + B-DANGERS))) + (PS-C2 (CDR WORSE-MOVES) + B-MOVE + B-DANGERS + MARKED)) + (T (PS-TEST-MARK (CXR-BETTER B-MOVE W-MOVE O-DANGER) + W-MOVE + 2. + O-DANGER) + (PS-C2 (CDR WORSE-MOVES) + B-MOVE + B-DANGERS + (CONS O-DANGER MARKED)))))) + +;;; PS-C3 marks rules as appropriate for C3. + +(DEFUN PS-C3 (WORSE-MOVES B-MOVE B-DANGERS MARKED DANGER-LIST + OW-MOVES) + (PROG (W-MOVE W-DANGERS NEW-RULES C-DANGER R-DANGERS) + (COND ((NOT (OR DANGER-LIST WORSE-MOVES)) + (COND (MARKED (SKC-MARK-RULE 3.))) + (RETURN NIL)) + ((NULL WORSE-MOVES) + (PS-C3 OW-MOVES + B-MOVE + B-DANGERS + (COND (MARKED '(T))) + (CDR DANGER-LIST) + OW-MOVES) + (RETURN NIL))) + (SETQ W-MOVE (CAR WORSE-MOVES) + W-DANGERS (XXR-DANGERS W-MOVE) + C-DANGER (CAR DANGER-LIST) + R-DANGERS (GP-DELETE C-DANGER B-DANGERS)) + (COND ((AND (GP-EQUIV W-DANGERS B-DANGERS) + C-DANGER + R-DANGERS + (SETQ NEW-RULES + (CMR-BETTER-PROBP B-MOVE + W-MOVE + C-DANGER)) + (CMR-KNOWS-SAME B-MOVE W-MOVE R-DANGERS)) + (SETQ NEW-RULES (GP-REMOVE-LIST NEW-RULES MARKED)) + (PS-TEST-MARK NEW-RULES W-MOVE 3. C-DANGER))) + (PS-C3 (CDR WORSE-MOVES) + B-MOVE + B-DANGERS + (APPEND NEW-RULES MARKED) + DANGER-LIST + OW-MOVES))) + +;;; PS-C5 updates if C5 has applied. + +(DEFUN PS-C5 (WORSE-CAVES H-MOVE H-DANGERS) + (COND ((NULL WORSE-CAVES)) + ((AND (NOT (XSR-MEMBER (CAR WORSE-CAVES) 2.)) + (NOT (XPR-SHOOTP H-MOVE)) + (CMR-C5-TEST (CAR WORSE-CAVES) H-MOVE '(0. 1. 2.)) + (PS-TEST-MARK (CXR-VALUE H-MOVE) + (CAR WORSE-CAVES) + 5. + 2.)) + (SKC-MARK-RULE 5.)) + (T (PS-C5 (CDR WORSE-CAVES) H-MOVE H-DANGERS)))) + +;;; PS-MARK-SHOT notes that the player wisely +;;;chose to shoot into a cave. + +(DEFUN PS-MARK-SHOT (CAVE) + (SK-MARK-RULES + (PS-EXPL-MARK-SHOT (SLR-OK-RULESP (CXR-PROB CAVE 2.) 2.) + CAVE) + 2.)) + +;;; PS-EXPL-MARK-SHOT explains that said rules were marked. + +(DEFUN PS-EXPL-MARK-SHOT (RULES CAVE) + (COND + (RULES + (G-TSAY + (APPEND '(|*** By shooting into cave|) + (LIST CAVE) + '(|, the student has indicated a knowledge of|) + (EG-TOLD-RULES RULES 2.) + '(|. ***|))))) + RULES) + +;;; PS-EXPL-MARK explains why the given rules were marked. + +(DEFUN PS-TEST-MARK (RULES W-MOVE C-RULE DANGER) + (COND + ((NULL RULES) NIL) + ((SLR-OK-RULESP RULES DANGER) + (G-TSAY (APPEND '(|*** According to combination rule|) + (LIST C-RULE) + '(|, I am marking|) + (EG-TOLD-RULES RULES DANGER) + '(|because his move is better than cave|) + (LIST W-MOVE '|. ***|))) + (SK-MARK-RULES RULES DANGER) + RULES))) + +;;; PS-DEGRADE-MODEL is responsible for degrading +;;;the knowledge model. + +(DEFUN PS-DEGRADE-MODEL (MOVE) + (DECLARE (SPECIAL MOVE PS-EXPL-SWITCH DB-COMMENT XX-BEST-MOVES)) + (PROG (BETTER-MOVES PS-EXPL-SWITCH) + (COND + ((SETQ + BETTER-MOVES + (GM-ALL-TRUE + (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL MOVE)) + (XXR-BETTER-MOVEP X MOVE))) + XX-BEST-MOVES)) + ;;; There were better moves. Note that PS-TEST-DEGRADE + ;;;sets the values of APS-RULE-ARRAY. + (PS-TEST-DEGRADE MOVE BETTER-MOVES) + (COND ((AND PS-EXPL-SWITCH DB-COMMENT) + (G-SAY '(|. ***|))) + (PS-EXPL-SWITCH (G-TSAY '(|. ***|)))) + (DO ((I 0. (1+ I))) + ((> I 2.)) + (PS-EXPL-UNMARK (APS-RULE-ARRAY I) I) + (SK-UNMARK-RULES (APS-RULE-ARRAY I) I) + (STORE (APS-RULE-ARRAY I) NIL)))))) + +;;; PS-TEST-DEGRADE determines which rules should be degraded. + +(DEFUN PS-TEST-DEGRADE (MOVE B-MOVES) + (COND ((NULL B-MOVES)) + (T (PS-TEST-DEGRADE MOVE (CDR B-MOVES)) + (PS-DEGRADE-WORK MOVE + (CAR B-MOVES) + '(0. 1. 2.) + NIL + NIL + NIL)))) + +;;; PS-DEGRADE-WORK does the actual work PS-TEST-DEGRADE. +;;; C-DANGERS are the dangers left to look at. +;;; S-DANGERS are dangers which were identifiably equivalent. +;;; B-DANGERS are dangers that were better by comparing probs. +;;; R-DANGERS are dangers that were better because they were safe. + +(DEFUN PS-DEGRADE-WORK (W-MOVE B-MOVE C-DANGERS S-DANGERS B-DANGERS R-DANGERS) + (DECLARE (SPECIAL PS-TEMP)) + (COND ((AND (NULL C-DANGERS) + (OR B-DANGERS R-DANGERS)) + (PS-EXPL-BETTER B-MOVE (APPEND B-DANGERS R-DANGERS) S-DANGERS) + (PS-STORE-DEGRADES W-MOVE B-MOVE B-DANGERS) + (PS-STORE-DEGRADES B-MOVE B-MOVE R-DANGERS) + (PS-STORE-DEGRADES W-MOVE B-MOVE S-DANGERS)) + ((NULL C-DANGERS)) + ((AND (GP-EQ 0.0 (XPR-PROB B-MOVE (CAR C-DANGERS))) + (GP-LT 0.0 (XPR-PROB W-MOVE (CAR C-DANGERS))) + (SLR-KNOWS-RULESP (CXR-PROB B-MOVE (CAR C-DANGERS)) + (CAR C-DANGERS))) + (PS-DEGRADE-WORK W-MOVE + B-MOVE + (CDR C-DANGERS) + S-DANGERS + B-DANGERS + (CONS (CAR C-DANGERS) R-DANGERS))) + ((AND (GP-LT (XPR-PROB B-MOVE (CAR C-DANGERS)) + (XPR-PROB W-MOVE (CAR C-DANGERS))) + (SLR-KNOWS-RULESP (CXR-BETTER B-MOVE + W-MOVE + (CAR C-DANGERS)) + (CAR C-DANGERS))) + (PS-DEGRADE-WORK W-MOVE + B-MOVE + (CDR C-DANGERS) + S-DANGERS + (CONS (CAR C-DANGERS) B-DANGERS) + R-DANGERS)) + ((SETQ PS-TEMP (CMR-SAME-DANGERSP B-MOVE W-MOVE (LIST (CAR C-DANGERS)))) + (PS-DEGRADE-WORK W-MOVE + B-MOVE + (CDR C-DANGERS) + (COND ((ATOM PS-TEMP) S-DANGERS) + (T (CONS (CAR C-DANGERS) S-DANGERS))) + B-DANGERS + R-DANGERS)) + (T NIL))) + +;;; PS-STORE-DEGRADES stores the applicable rules into the appropriate lists. + +(DEFUN PS-STORE-DEGRADES (W-MOVE B-MOVE DANGERS) + (DO ((M-DANGERS DANGERS (CDR M-DANGERS)) (M-DANGER)) + ((NULL M-DANGERS)) + (SETQ M-DANGER (CAR M-DANGERS)) + (STORE (APS-RULE-ARRAY M-DANGER) + (GP-UNION (COND ((GP-LT (XPR-PROB B-MOVE M-DANGER) + (XPR-PROB W-MOVE M-DANGER)) + (CXR-BETTER B-MOVE W-MOVE M-DANGER))) + (SLR-KNOWS-RULESP + (GP-UNION (CXR-PROB B-MOVE M-DANGER) + (CXR-PROB W-MOVE M-DANGER)) + M-DANGER) + (APS-RULE-ARRAY M-DANGER))))) + +;;; PS-EXPL-BETTER explains when a better move has been found. + +(DEFUN PS-EXPL-BETTER + (MOVE DANGERS S-DANGERS) + (DECLARE (SPECIAL PS-EXPL-SWITCH)) + (G-TSAY (APPEND (COND (PS-EXPL-SWITCH '(| |)) + (T (SETQ PS-EXPL-SWITCH T) + '(|*** According to my estimations, the| + |player should have identified that:/ + |))) (LIST '|cave| MOVE '|involves less risk from|) + (EG-DANGERS DANGERS) + (COND (S-DANGERS (APPEND + '(|and the same danger from|) + (EG-DANGERS S-DANGERS))))))) + +;;; PS-EXPL-UNMARK explains which rules were unmarked. + +(DEFUN PS-EXPL-UNMARK (RULES DANGER) + (COND (RULES (G-TSAY (APPEND '(|*** I am unmarking|) + (EG-TOLD-RULES RULES DANGER) + '(|. ***|))) + T)) + RULES) + +;;; PS-UNMARK-SHOT notes that the player shot when he should +;;;have known it was unnecessary. + +(DEFUN PS-UNMARK-SHOT (CAVE) + (COND ((XPR-SHOOTP CAVE) NIL) + ((GP-EQ (XPR-PROB CAVE 2.) 0.0) + (SK-UNMARK-RULES + (PS-EXPL-UNMARK-SHOT (SLR-KNOWS-RULESP (CXR-PROB CAVE 2.) 2.) + CAVE) + 2.)) + (T (SK-UNMARK-RULES + (PS-EXPL-UNMARK-SHOT + (GP-UNION (SLR-KNOWS-RULESP '(11. 15.) 2.) + (SLR-KNOWS-RULESP (CXR-PROB CAVE 2.) 2.)) + CAVE) + 2.)))) + +;;; PS-EXPL-UNMARK-SHOT comments about the above function. + +(DEFUN PS-EXPL-UNMARK-SHOT (RULES CAVE) + (COND + (RULES + (G-TSAY + (APPEND + '(|*** By shooting into cave|) + (LIST CAVE) + '(|the player has indicated that he has not really mastered|) + (EG-TOLD-RULES RULES 2.) + '(|. ***|))))) + RULES) + +;;; PS-MARK-NO-SHOT notes that the player did not shoot when he should +;;;have known it was wise to do so. + +(DEFUN PS-MARK-NO-SHOT (CAVE) + (SK-UNMARK-RULES + (PS-EXPL-MARK-NO-SHOT (SLR-KNOWS-RULESP (CXR-PROB CAVE 2.) + 2.) + CAVE) + 2.)) + +;;; PS-EXPL-MARK-NO-SHOT comments about the above function. + +(DEFUN PS-EXPL-MARK-NO-SHOT (RULES CAVE) + (COND + (RULES + (G-TSAY + (APPEND + '(|*** By not shooting into cave|) + (LIST CAVE) + '(|the player has indicated that he has not really mastered|) + (EG-TOLD-RULES RULES 2.) + '(|. ***|))))) + RULES) + +;;; **************** Student Model Functions ************* +;;; ******* Student Model Initialization Rouitnes. ******** +;;; +;;; The student knowledge array has three dimensions. +;;; They are: RULE, ITEM, and DANGER. +;;; An ITEM value of: +;;; 0 is for the number of times he has demonstrated a +;;; working knowledge of said rule (more or less). +;;; 1 is for when the player was presumed to have +;;; learned/forgotten said rule. +;;; 2 is for how often the player has been told said rule. +;;; 3 is for when the player was presumed to have heard-of +;;; said rule. +;;; SLI-FORGOT determines how large a decrement should be used. + +(DEFUN SLI-FORGOT (NOW LAST) + (DECLARE (SPECIAL SL-FORGET)) + (//$ (LOG (- NOW LAST -1.)) (LOG SL-FORGET))) + +;;; SLI-SET-VAL sets the ASK-DRULES value appropriately. + +(DEFUN SLI-SET-VAL (OLD-VALUE WHEN-VALUE INFO-TYPE DEGRADE RULE DANGER) + (DECLARE (SPECIAL WE-THIS-SESSION SL-HEARD-OF SL-REPEAT)) + (STORE (ASK-DRULES RULE INFO-TYPE DANGER) + (SLI-VALUE OLD-VALUE DEGRADE)) + (STORE (ASK-WDRULES RULE INFO-TYPE DANGER) + (COND (WHEN-VALUE) (T 0.))) + ;;; Did the player "forget" this rule. + (COND ((NULL OLD-VALUE) NIL) + ((AND (= INFO-TYPE 0.) + (SLR-KNOWS-RULEP RULE DANGER)) + (SL-TEST-PHASE DANGER)) + ((AND (= INFO-TYPE 1.) + (SLR-HEARD-OF-RULE RULE DANGER)) + NIL) + ((> OLD-VALUE + (COND ((= INFO-TYPE 0.) SL-REPEAT) + (T SL-HEARD-OF))) + ;;; Note that negative values indicate "forgot". + (STORE (ASK-WDRULES RULE INFO-TYPE DANGER) (- WE-THIS-SESSION))))) + +;;; SLI-VALUE determines what is an acceptable value to store. + +(DEFUN SLI-VALUE (VAL DEGRADE) + (COND ((NOT VAL) 0.0) ((> VAL DEGRADE) (-$ VAL DEGRADE)) (T 0.0))) + +;;; SLI-LEAST-PHASE returns the lowest phase of the student. + +(DEFUN SLI-LEAST-PHASE NIL + (DECLARE (SPECIAL SL-MODE)) + (DO ((I 0. (1+ I)) (MIN 4.)) + ((> I 2.) MIN) + (COND ((EQ SL-MODE 'SUPER) (SETQ I 3.)) + ((< (ASL-PHASE I) MIN) (SETQ MIN (ASL-PHASE I)))))) + +;;; SKI-PUT-MODEL takes its argument and initializes the +;;;student-model with it. + +(DEFUN SKI-PUT-MODEL (STUDENT-MODEL) + (DECLARE (SPECIAL DB-DATE DB-LAST-DATE DB-NUM-CRULES DB-NUM-RULES)) + (DO ((REST-OF-MODEL STUDENT-MODEL (CDR REST-OF-MODEL)) + (DEGRADE (SLI-FORGOT DB-DATE DB-LAST-DATE)) + (DANGER 0. (1+ DANGER))) + ((> DANGER 2.) + ;;; Don't degrade more than once. + (SETQ DB-LAST-DATE DB-DATE) + (DO ((I 0. (1+ I)) (VAL (CAR REST-OF-MODEL) (CDR VAL))) + ((> I DB-NUM-CRULES)) + (STORE (ASKC-RULES I 0.) + (SLI-VALUE (CAR VAL) DEGRADE)))) + ;;; First reset the phases to zero. + (SL-RESET-PHASE 0. DANGER) + (DO ((REST-OF-RULES (CAR REST-OF-MODEL) + (CDR REST-OF-RULES)) + (RULE 0. (1+ RULE))) + ((> RULE DB-NUM-RULES)) + (SLI-SET-VAL (CAAR REST-OF-RULES) + (CADAR REST-OF-RULES) + 0. + DEGRADE + RULE + DANGER) + (SLI-SET-VAL (CADDAR REST-OF-RULES) + (CADDR (CDAR REST-OF-RULES)) + 1. + DEGRADE + RULE + DANGER)))) + +;;; SKI-GET-MODEL gets the student-model from the different arrays. +;;;It works very closely with SKI-PUT-MODEL. + +(DEFUN SKI-GET-MODEL NIL + (DECLARE (SPECIAL DB-NUM-CRULES DB-NUM-RULES)) + (DO + ((DANGER 2. (1- DANGER)) + (GOTTEN-MODEL (LIST (DO ((I DB-NUM-CRULES (1- I)) (VAL NIL)) + ((< I 0.) VAL) + (SETQ VAL (CONS (ASKC-RULES I 0.) + VAL)))))) + ((< DANGER 0.) GOTTEN-MODEL) + (SETQ + GOTTEN-MODEL + (CONS (DO ((RULE DB-NUM-RULES (1- RULE)) (GOTTEN-RULES NIL)) + ((< RULE 0.) GOTTEN-RULES) + (SETQ GOTTEN-RULES + (CONS (LIST (ASK-DRULES RULE 0. DANGER) + (ASK-WDRULES RULE 0. DANGER) + (ASK-DRULES RULE 1. DANGER) + (ASK-WDRULES RULE 1. DANGER)) + GOTTEN-RULES))) + GOTTEN-MODEL)))) + +;;; *********** Wumpus Advisor Critic Routines. *********** +;;; SC-ADVISED notes that the player has been advised concerning +;;;the danger and sets ASC-INITIALIZED accordingly. +;;;ASC-INITIALIZED has four possible values. They are: +;;; 1- NIL indicating that this is a new player. +;;; 2- 'B indicating that this is a new player who +;;; is being moved back. +;;; 3- 'A indicating that the player is being advanced. +;;; 4- Number, indicating that the Critic stopped +;;; initializing on this move number. + +(DEFUN SC-ADVISED (RULES DANGER) + (COND ((FIXP (ASC-INITIALIZED DANGER)) NIL) + ((EQ (ASC-INITIALIZED DANGER) 'A) + (SC-STOP-INITIALIZING (CAR RULES) DANGER '(|needed advice on|))) + (T (STORE (ASC-INITIALIZED DANGER) 'B)))) + +;;; SC-UPDATE-RECEPTIVITY adjusts SL-RECEPTIVITY. + +(DEFUN SC-UPDATE-RECEPTIVITY (MOVE) + (DECLARE (SPECIAL LWA-GOOD-MOVES LWA-BAD-MOVES DB-NUM-CAVES SL-RECEPTIVITY)) + (PROG (VAL) + (SETQ VAL (COND ((AND (GP-NUM-TEST MOVE DB-NUM-CAVES) + (XDR-VISITEDP MOVE)) + 0.0) + ((GC-MEMBER LWA-GOOD-MOVES MOVE 2.) + (SC-EXPL-RECP MOVE + '|upgrading| + '|very recently| + '|good|) + 1.0) + ((GC-MEMBER LWA-GOOD-MOVES MOVE 5.) + (SC-EXPL-RECP MOVE + '|upgrading| + '|recently| + '|good|) + 0.5) + ((GC-MEMBER LWA-BAD-MOVES MOVE 2.) + (SC-EXPL-RECP MOVE + '|degrading| + '|very recently| + '|bad|) + -1.0) + ((GC-MEMBER LWA-BAD-MOVES MOVE 5.) + (SC-EXPL-RECP MOVE + '|degrading| + '|recently| + '|bad|) + -0.5) + (T 0.0))) + ;;; Note that low values of SL-RECEPTIVITY + ;;;allow the Advsior to speak more often. + (SETQ SL-RECEPTIVITY (-$ SL-RECEPTIVITY VAL)))) + +;;; SC-EXPL-RECP explains changes in the receptivity. + +(DEFUN SC-EXPL-RECP (MOVE CHANGE WHEN TYPE) + (G-TSAY + (APPEND (LIST '|*** I am| CHANGE) + '(|the player's receptivity because his move to cave|) + (LIST MOVE + '|is a move that I told him was| + TYPE) + (LIST WHEN '|. ***|)))) + +;;; SC-MARK-RULE analyzes the marking of the given rule. + +(DEFUN SC-MARK-RULE (RULE DANGER) + (DECLARE (SPECIAL SC-DECREASE-REPEAT SC-INCREASE-FORGET + WE-THIS-SESSION SL-REPEAT)) + (COND ((SLR-KNOWS-RULEP RULE DANGER)) + ((EQ (ASC-INITIALIZED DANGER) 'B) + (SC-STOP-INITIALIZING RULE DANGER '(|seems to be learning|))) + ((NOT (FIXP (ASC-INITIALIZED DANGER))) + (STORE (ASC-INITIALIZED DANGER) 'A) + (SC-KNOWS-RULE '|he is a new player| + RULE + DANGER)) + ;;; Note that negative values indicate that it was "forgotten". + ((< (ASK-WDRULES RULE 0. DANGER) + (MIN 0. (- 75. WE-THIS-SESSION))) + (SC-KNOWS-RULE '|he seems to have remembered it| + RULE + DANGER) + (SETQ SC-INCREASE-FORGET T)) + ((AND (> (ASK-DRULES RULE 0. DANGER) (-$ SL-REPEAT 2.0)) + (> (ASK-WDRULES RULE 0. DANGER) (ASC-INITIALIZED DANGER))) + (SETQ SC-DECREASE-REPEAT T)))) + +;;; SC-KNOWS-RULE notes that the player knows a rule. + +(DEFUN SC-KNOWS-RULE (REASON RULE DANGER) + (DECLARE (SPECIAL SL-REPEAT)) + (G-TSAY (APPEND '(|*** I am presuming that the player knows|) + (EG-TOLD-RULES (LIST RULE) DANGER) + (LIST '|since| REASON '|. ***|))) + (STORE (ASK-DRULES RULE 0. DANGER) (-$ SL-REPEAT 0.5))) + +;;; SC-UNMARK-RULE analyzes the unmarking of the given rule. + +(DEFUN SC-UNMARK-RULE (RULE DANGER) + (DECLARE (SPECIAL SC-DECREASE-FORGET SC-INCREASE-REPEAT + WE-THIS-SESSION SL-REPEAT)) + (COND + ((EQ (ASC-INITIALIZED DANGER) 'A) + (SC-STOP-INITIALIZING RULE DANGER '(|does not seem to know|))) + ((NOT (MEMBER RULE + (ASL-PHASE-RULES (ASL-PHASE DANGER) DANGER)))) + ((NOT (FIXP (ASC-INITIALIZED DANGER))) + (STORE (ASC-INITIALIZED DANGER) 'B) + (SC-UNLEARN-RULE '|he is a new player| RULE DANGER)) + ((> (ASK-DRULES RULE 0. DANGER) (+$ 2.0 SL-REPEAT))) + ((AND (> (ASK-WDRULES RULE 0. DANGER) (ASC-INITIALIZED DANGER)) + (< (ASK-WDRULES RULE 0. DANGER) WE-THIS-SESSION)) + (SC-UNLEARN-RULE + '|he seems to have forgotten it since last session| + RULE + DANGER) + (SETQ SC-DECREASE-FORGET T)) + ((> (ASK-WDRULES RULE 0. DANGER) (ASC-INITIALIZED DANGER)) + (SETQ SC-INCREASE-REPEAT T)))) + +;;; SC-UNLEARN-RULE notes that the player does not know a rule. + +(DEFUN SC-UNLEARN-RULE (REASON RULE DANGER) + (DECLARE (SPECIAL SL-REPEAT)) + (G-TSAY + (APPEND + '(|*** I am no longer presuming that the player knows|) + (EG-TOLD-RULES (LIST RULE) DANGER) + (LIST '|because| REASON '|. ***|))) + (STORE (ASK-DRULES RULE 0. DANGER) (+$ SL-REPEAT 0.5))) + +;;; SC-STOP-INITIALIZING stops the initializations. + +(DEFUN SC-STOP-INITIALIZING (RULE DANGER REASON) + (DECLARE (SPECIAL WE-MOVE-NUM)) + (STORE (ASC-INITIALIZED DANGER) WE-MOVE-NUM) + (G-TSAY (APPEND '(|*** I have stopped initializing the|) + '(|player's knowledge model for|) + (AEG-DANGER-SING DANGER) + '(|because he|) + REASON + (LIST '|rule| RULE '|. ***|)))) + +;;; SC-UPDATE-MODEL does the actual modifications of SL variables. + +(DEFUN SC-UPDATE-MODEL NIL + (DECLARE (SPECIAL I SC-UREPEAT SC-LREPEAT SC-UFORGET SC-LFORGET DB-NUM-RULES + SL-REPEAT SL-FORGET SL-HEARD-OF SL-MODE DB-DEBUG SC-NOTEST + SC-DECREASE-FORGET SC-DECREASE-REPEAT SC-INCREASE-FORGET + SC-INCREASE-REPEAT)) + (PROG (OLD-REPEAT NEW-REPEAT KNOWS-RULES FORGOT-RULES + NEW-RULES) + (SETQ OLD-REPEAT SL-REPEAT) + (COND + (SC-INCREASE-FORGET + (SETQ SL-FORGET (1+$ (*$ 1.1 (1-$ SL-FORGET)))) + (G-TSAY + '(|*** The player does not seem as forgetful| + |as I previously thought. ***|)))) + (COND + (SC-DECREASE-FORGET + (SETQ SL-FORGET (1+$ (*$ 0.9 (1-$ SL-FORGET)))) + (G-TSAY + '(|*** The player seems more forgetful| + |than I previously thought. ***|)))) + (COND + (SC-INCREASE-REPEAT + (SETQ SL-REPEAT (+$ SL-REPEAT 0.34)) + (G-TSAY + '(|*** My previous repetition factor for the| + |student seems to have been too low. ***|)))) + (COND + (SC-DECREASE-REPEAT + (SETQ SL-REPEAT (-$ SL-REPEAT 0.17)) + (G-TSAY + '(|*** My previous repetition factor for the| + |student seems to have been too high. ***|)))) + (SC-RESET-SWITCHES) + (COND + ((NOT (= SL-REPEAT OLD-REPEAT)) + (SETQ NEW-REPEAT SL-REPEAT + SL-HEARD-OF (1-$ SL-REPEAT)) + (G-TSAY + (APPEND + '(|*** I am giving the player a new repetition factor of|) + (LIST NEW-REPEAT '|. ***|))) + (DO + ((I 0. (1+ I))) + ((> I 2.)) + (SETQ + SL-REPEAT + OLD-REPEAT + KNOWS-RULES + (GM-ALL-TRUE (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL I)) + (SLR-KNOWS-RULEP X + I))) + (GP-ORDLST DB-NUM-RULES)) + SL-REPEAT + NEW-REPEAT + FORGOT-RULES + (GM-ALL-TRUE + (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL I)) + (NOT (SLR-KNOWS-RULEP X I)))) + KNOWS-RULES) + NEW-RULES + (GM-ALL-TRUE (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL I)) + (SLR-KNOWS-RULEP X + I))) + (GP-REMOVE-LIST (GP-ORDLST DB-NUM-RULES) + KNOWS-RULES))) + (COND + ((OR FORGOT-RULES NEW-RULES) + (G-TSAY + (APPEND + '(|*** Because of the new repetition factor I am|) + (COND (FORGOT-RULES '(|no longer|)) + (T '(|now|))) + '(|presuming that he knows|) + (EG-TOLD-RULES (APPEND FORGOT-RULES NEW-RULES) I) + '(|. ***|))) + (MAPC (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL I)) + (SL-LEARNED-RULE X I))) + NEW-RULES) + (MAPC (FUNCTION (LAMBDA (X) (DECLARE (SPECIAL I)) + (SL-UNLEARN-RULE X I))) + FORGOT-RULES)))))) + (COND ((OR SL-MODE DB-DEBUG SC-NOTEST) NIL) + ((OR (< SL-REPEAT SC-LREPEAT) + (> SL-REPEAT SC-UREPEAT) + (< SL-FORGET SC-LFORGET) + (> SL-FORGET SC-UFORGET)) + (SC-HELP '|learning model|))))) + +;;; SC-RESET-SWITCHES resets the switches to NIL. + +(DEFUN SC-RESET-SWITCHES NIL + (DECLARE (SPECIAL SC-DECREASE-FORGET SC-DECREASE-REPEAT SC-INCREASE-FORGET + SC-INCREASE-REPEAT)) + (SETQ SC-INCREASE-FORGET NIL + SC-DECREASE-FORGET NIL + SC-INCREASE-REPEAT NIL + SC-DECREASE-REPEAT NIL)) + +;;; ********** Student Learning Model Routines. ********* +;;; SL-LEARNED-RULE marks that the player knows the specified RULE. + +(DEFUN SL-LEARNED-RULE (RULE DANGER) + (DECLARE (SPECIAL SL-LAST-LEARNED WE-MOVE-NUM WA-CAN-BACKTRACK SL-REPEAT)) + (COND ((OR (NOT (FIXP (ASC-INITIALIZED DANGER))) + (< (ASK-WDRULES RULE 0. DANGER) (ASC-INITIALIZED DANGER))) + (SETQ SL-LAST-LEARNED WE-MOVE-NUM))) + (COND ((= RULE 1.) (SETQ WA-CAN-BACKTRACK (+$ SL-REPEAT 0.5)))) + (STORE (ASK-WDRULES RULE 0. DANGER) WE-MOVE-NUM) + (SL-TEST-PHASE DANGER) + (COND ((= DANGER 0.) (SL-TRANS-TEST 0. 1. RULE)) + ((= DANGER 1.) (SL-TRANS-TEST 1. 0. RULE)))) + +;;; SL-TEST-PHASE tests to see if the player has learned +;;;the rules necessary to advance to the next phase. + +(DEFUN SL-TEST-PHASE (DANGER) + (COND + ((= (ASL-PHASE DANGER) 4.)) + ((SLR-KNOWS-RULESP (ASL-NEXT-RULES (ASL-PHASE DANGER) DANGER) + DANGER) + (STORE (ASL-PHASE DANGER) (1+ (ASL-PHASE DANGER))) + (G-TSAY + (APPEND + '(|*** I am advancing the student to phase|) + (LIST (ASL-PHASE DANGER)) + '(|for|) + (AEG-DANGER-PLUR DANGER) + '(|as he has mastered|) + (EG-INSERT-AND '|rule| + (ASL-NEXT-RULES (1- (ASL-PHASE DANGER)) + DANGER)) + '(|. ***|))) + (STORE (ASL-WORK-ON-RULES DANGER) + (GP-UNION (ASL-WORK-ON-RULES DANGER) + (ASL-PHASE-RULES (ASL-PHASE DANGER) + DANGER))) + (SL-TEST-PHASE DANGER)))) + +;;; SL-TRANS-TEST transfers knowledge if appropriate. + +(DEFUN SL-TRANS-TEST (L-DANGER O-DANGER RULE) + (COND + ((AND (> (ASL-PHASE L-DANGER) 1.) + (> (ASL-PHASE O-DANGER) 1.) + (NOT (SLR-KNOWS-RULEP RULE O-DANGER))) + (G-TSAY + (APPEND '(|*** I am presuming a transfer of knowledge of|) + (EG-TOLD-RULES (LIST RULE) L-DANGER) + '(|to|) + (AEG-DANGER-PLUR O-DANGER) + '(|. ***|))) + (STORE (ASK-DRULES RULE 0. O-DANGER) + (ASK-DRULES RULE 0. L-DANGER)) + (SL-LEARNED-RULE RULE O-DANGER)))) + +;;; SL-UNLEARN-RULE notes that the player no longer knows a rule. + +(DEFUN SL-UNLEARN-RULE (RULE DANGER) + (DECLARE (SPECIAL WE-MOVE-NUM)) + (PROG (NEW-PHASE) + (STORE (ASK-WDRULES RULE 0. DANGER) WE-MOVE-NUM) + (DO ((I 0. (1+ I)) (DONE)) + (DONE) + (COND ((MEMBER RULE (ASL-NEXT-RULES I DANGER)) + (SETQ NEW-PHASE I DONE T)) + ((> I 4.) (SETQ NEW-PHASE 4. DONE T)))) + (COND + ((< NEW-PHASE (ASL-PHASE DANGER)) + (G-TSAY + (APPEND '(|*** I am moving the student back to phase|) + (EG-NUMBER NEW-PHASE) + '(|for|) + (AEG-DANGER-PLUR DANGER) + '(|as he doesn't seem to know rule|) + (LIST RULE '|. ***|))) + (SL-RESET-PHASE NEW-PHASE DANGER))))) + +;;; SL-RESET-PHASE sets the phase back to the appropriate phase. + +(DEFUN SL-RESET-PHASE (PHASE DANGER) + (STORE (ASL-PHASE DANGER) PHASE) + (STORE (ASL-WORK-ON-RULES DANGER) + (DO ((I 0. (1+ I)) (VAL)) + ((> I PHASE) VAL) + (SETQ VAL (GP-UNION (ASL-PHASE-RULES I DANGER) + VAL))))) + +;;; SL-ADVISEP returns NIL if it is acceptable to advise now. + +(DEFUN SL-ADVISEP (MOVE) + (DECLARE (SPECIAL SL-MODE LWA-GOOD-MOVES LWA-BAD-MOVES + LWA-MOVE-NUMS WE-MOVE-NUM SL-RECEPTIVITY)) + (AND (NOT SL-MODE) + (OR (> SL-RECEPTIVITY + (-$ (FLOAT WE-MOVE-NUM) + (GC-AVERAGE LWA-MOVE-NUMS))) + (GC-MEMBER LWA-GOOD-MOVES MOVE 3.) + (GC-MEMBER LWA-BAD-MOVES MOVE 3.)))) + +;;; SLR-KNOWS-RULESP returns RULES if the player is +;;;thought to know these rules. + +(DEFUN SLR-KNOWS-RULESP (RULES DANGER) + (COND ((NULL RULES) T) + ((AND (SLR-KNOWS-RULEP (CAR RULES) DANGER) + (SLR-KNOWS-RULESP (CDR RULES) DANGER)) + RULES) + (T NIL))) + +;;; SLR-KNOWS-RULEP returns the given rule if the player knows it. + +(DEFUN SLR-KNOWS-RULEP (RULE DANGER) + (DECLARE (SPECIAL SL-REPEAT)) + (> (ASK-DRULES RULE 0. DANGER) SL-REPEAT)) + +;;; SLR-OK-RULESP returns T if it is OK to teach these rules. + +(DEFUN SLR-OK-RULESP (RULES DANGER) + (COND ((NULL RULES) T) + ((AND (MEMBER (CAR RULES) (ASL-WORK-ON-RULES DANGER)) + (SLR-OK-RULESP (CDR RULES) DANGER)) + RULES) + (T NIL))) + +;;; SLR-HEARD-OF-RULE returns T if the player is familiar +;;;with the move. + +(DEFUN SLR-HEARD-OF-RULE (RULE DANGER) + (DECLARE (SPECIAL SL-HEARD-OF)) + (> (ASK-DRULES RULE 1. DANGER) SL-HEARD-OF)) + +;;; ********* Student Knowledge Model Routines. ********** +;;; SK-MARK-RULES marks that the student has applied RULES. + +(DEFUN SK-MARK-RULES (RULES DANGER) + (COND (RULES (SK-MARK-RULE (CAR RULES) DANGER) + (SK-MARK-RULES (CDR RULES) DANGER) + RULES))) + +;;; SK-MARK-RULE marks that the player has applied RULE. + +(DEFUN SK-MARK-RULE (RULE DANGER) + (SC-MARK-RULE RULE DANGER) + (SK-INCR-RULE RULE DANGER)) + +;;; SK-INCR-RULE does the actual incrementing of a rule. + +(DEFUN SK-INCR-RULE (RULE DANGER) + (DECLARE (SPECIAL SL-REPEAT)) + (STORE (ASK-DRULES RULE 0. DANGER) + (1+$ (ASK-DRULES RULE 0. DANGER))) + (COND ((AND (> (ASK-DRULES RULE 0. DANGER) SL-REPEAT) + (< (ASK-DRULES RULE 0. DANGER) (1+$ SL-REPEAT))) + (SL-LEARNED-RULE RULE DANGER)) + ((= DANGER 0.) (SK-TRANS-TEST 0. 1. RULE)) + ((= DANGER 1.) (SK-TRANS-TEST 1. 0. RULE)))) + +;;; SK-TRANS-TEST transfer knowledge if appropriate. + +(DEFUN SK-TRANS-TEST (L-DANGER O-DANGER RULE) + (COND ((> RULE 15.)) + ((SLR-KNOWS-RULEP O-DANGER RULE)) + ((AND (> (ASL-PHASE L-DANGER) 1.) + (> (ASL-PHASE O-DANGER) 1.)) + (STORE (ASK-DRULES RULE 0. O-DANGER) + (1+$ (ASK-DRULES RULE 0. O-DANGER)))))) + +;;; SK-TOLD-RULE marks that a student has been told an application +;;;of a rule. + +(DEFUN SK-TOLD-RULE (RULE DANGER) + (DECLARE (SPECIAL WE-MOVE-NUM SL-HEARD-OF)) + (COND ((NOT (SLR-HEARD-OF-RULE RULE DANGER)) + (SK-INCR-RULE RULE DANGER))) + (STORE (ASK-DRULES RULE 1. DANGER) + (1+$ (ASK-DRULES RULE 1. DANGER))) + (COND ((AND (> (ASK-DRULES RULE 1. DANGER) SL-HEARD-OF) + (< (ASK-DRULES RULE 1. DANGER) (1+$ SL-HEARD-OF))) + (STORE (ASK-WDRULES RULE 1. DANGER) WE-MOVE-NUM)))) + +;;; SK-UNMARK-RULES decrements the appropriate rules by one. + +(DEFUN SK-UNMARK-RULES (RULES DANGER) + (COND ((NULL RULES)) + (T (SK-UNMARK-RULES (CDR RULES) DANGER) + (SK-UNMARK-RULE (CAR RULES) DANGER) + RULES))) + +;;; SK-UNMARK-RULE decrements rule by one. + +(DEFUN SK-UNMARK-RULE (RULE DANGER) + (DECLARE (SPECIAL SL-MODE)) + (COND ((EQ SL-MODE 'SUPER)) + ((SLR-KNOWS-RULEP RULE DANGER) + (SC-UNMARK-RULE RULE DANGER) + (STORE (ASK-DRULES RULE 0. DANGER) + (1-$ (ASK-DRULES RULE 0. DANGER))) + (COND ((NOT (SLR-KNOWS-RULEP RULE DANGER)) + (SL-UNLEARN-RULE RULE DANGER)))) + (T (STORE (ASK-DRULES RULE 0. DANGER) + (1-$ (ASK-DRULES RULE 0. DANGER)))))) + +;;; ******** Student Model (Combination Rules). ********** +;;; SLC-KNOWS-RULEP returns T if the student knows the rule. + +(DEFUN SLC-KNOWS-RULEP (RULE) + (DECLARE (SPECIAL SL-REPEAT)) + (> (ASKC-RULES RULE 0.) SL-REPEAT)) + +;;; SKC-MARK-RULE marks that the student has applied this rule. + +(DEFUN SKC-MARK-RULE (RULE) + (STORE (ASKC-RULES RULE 0.) (1+$ (ASKC-RULES RULE 0.)))) + +;;; SKC-TOLD-RULE marks that the student has been told RULE. + +(DEFUN SKC-TOLD-RULE (RULE) + (DECLARE (SPECIAL SL-HEARD-OF)) + (COND ((< (ASKC-RULES RULE 0.) SL-HEARD-OF) (SKC-MARK-RULE RULE)))) + +;;; *********** Disc File Handling Routines. *********** +;;; SF-GET-DISC-FILE gets the file on the user off of disc. +;;;It then stores the values in the database and +;;;returns the file (if there was any). + +(DEFUN SF-GET-DISC-FILE (USER-NAME) + (SF-STORE-USER-FILE (SF-READ-DISC-FILE USER-NAME))) + +;;; SF-TELL-MODEL types out the current user model. + +(DEFUN SF-TELL-MODEL NIL + (DECLARE (SPECIAL DB-NUM-RULES)) + (G-RSAY '(|The following are the student model values. |)) + (G-RSAY '(|Rule Bats Pits Wumpus|)) + (DO ((I 0. (1+ I))) + ((> I DB-NUM-RULES)) + (G-RSAY (LIST '| | I)) + (DO ((J 0. (1+ J)) (C-POS 7. (+ 16. C-POS))) + ((> J 2.)) + (G-PSAY (LIST (GP-MAKN (ASK-DRULES I 0. J) + (SF-SUFFIX I J))) + C-POS))) + (G-RSAY + '(|An "*" indicates that the student is presumed| + |to have learned the rule in question, and a "-"| + |indicates that this rule is deemed acceptable| + |for teaching at this time. A "+" indicates that| + |the player is deemed to have "heard of" the rule| + |in question. |))) + +;;; SF-SUFFIX constructs the suffix that is appropriate. + +(DEFUN SF-SUFFIX (I J) + (GP-MAKN (COND ((SLR-KNOWS-RULEP I J) '*) + ((SLR-OK-RULESP (LIST I) J) '-) + (T '| |)) + (COND ((SLR-HEARD-OF-RULE I J) '+) + (T '| |)))) + +;;; SF-TELL-VARS tells about important variables of the student file. + +(DEFUN SF-TELL-VARS NIL + (DECLARE (SPECIAL SF-VAR-LIST DB-NUM-CRULES)) + (G-RSAY + (APPEND + '(|The student is thought to know|) + (EG-INSERT-AND '|combination rule| + (GM-ALL-TRUE 'SLC-KNOWS-RULEP + (GP-ORDLST DB-NUM-CRULES))) + '(|. |))) + (G-TERPRI) + (G-RSAY '(|Student variable values are:|)) + (MAPC (FUNCTION (LAMBDA (X) (G-RISAY (LIST X)) + (G-PSAY (LIST (EVAL X)) 26.))) + SF-VAR-LIST)) + +;;; SF-LOAD-DEMO loads in the appropriate demo if desired. + +(DEFUN SF-LOAD-DEMO NIL + (G-RSAY '(|Please enter the demo that you would like. |)) + (SF-GET-DEMO)) + +;;; SF-GET-DEMO does most of the actual work of getting the demo. + +(DEFUN SF-GET-DEMO NIL + (DECLARE (SPECIAL SL-MODE DB-NAME DB-UNAME)) + (G-RISAY '(|BEGINNER, for novices who are quick learners. |)) + (G-RISAY '(|NOVICE, if you have played a couple of games. |)) + (G-RISAY '(|AMATEUR, for players who are fairly good. |)) + (G-RISAY '(|MODERATE, if you are a moderately good player. |)) + (G-RISAY '(|ADVANCED, for skilled Wumpii hunters. |)) + (G-RISAY '(|EXPERT, for excellent players. |)) + (G-RISAY + '(|SUPER, an interesting mode for experienced Wumpus hunters. |)) + (G-RISAY + '(|NONE, for people who just realized they don't want a demo at all. |)) + (SETQ SL-MODE (G-READ 'MODE) DB-UNAME SL-MODE) + (COND ((EQ SL-MODE 'NONE) (SETQ SL-MODE NIL) NIL) + ((MEMBER SL-MODE + '(BEGINNER NOVICE AMATEUR MODERATE ADVANCED EXPERT SUPER)) + (SF-GET-DISC-FILE DB-UNAME) + (G-RSAY '(|Please enter your first name. |)) + (SETQ DB-NAME (G-LOWER-CASE (G-READ 'SYNDI) T)) + T) + (T (G-RSAY '(|Please enter one of:|)) + (SF-GET-DEMO)))) + +;;; SF-STORE-USER-FILE stores the file it is sent into the database. + +(DEFUN SF-STORE-USER-FILE (USER-FILE) + (DECLARE (SPECIAL USER-MODEL SC-INITIALIZED WEV-RECREATE DB-DATE + WE-LAST-SESSION WE-THIS-SESSION SF-VAR-LIST + DB-LAST-DATE SL-MODE WE-MOVE-NUM)) + (PROG (USER-MODEL) + (MAPC 'SET + (CONS 'USER-MODEL SF-VAR-LIST) + USER-FILE) + (MAPC + (FUNCTION (LAMBDA (X Y) (STORE (ASC-INITIALIZED X) Y))) + '(2. 1. 0.) + SC-INITIALIZED) + (COND ((OR WEV-RECREATE SL-MODE) + (SETQ DB-LAST-DATE DB-DATE)) + ((> DB-LAST-DATE DB-DATE) + (SETQ DB-LAST-DATE (- DB-LAST-DATE 360.)))) + ;;; This is to zero out any old values. + (SKI-PUT-MODEL NIL) + (SKI-PUT-MODEL USER-MODEL) + (COND ((EQ SL-MODE 'SUPER) + (DO ((I 0. (1+ I))) + ((> I 2.)) + (SL-RESET-PHASE 4. I)))) + (SETQ WE-LAST-SESSION WE-MOVE-NUM + WE-THIS-SESSION (1+ WE-MOVE-NUM) + WE-MOVE-NUM (1+ WE-THIS-SESSION)) + (RETURN USER-FILE))) + +;;; SF-READ-DISC-FILE reads the user file as indicated by +;;;the user-name which it is sent as an argument. +;;;If it does not find any such file it returns NIL. + +(DEFUN SF-READ-DISC-FILE (THE-NAME) + (PROG (ALL-FILES) + (UREAD wa plyrs8 dsk games) + (SETQ ^Q T + ALL-FILES (READ)) + (RETURN (DO ((A-FILE (CAR ALL-FILES) (CAR ALL-FILES)) + (A-NAME (CADAR ALL-FILES) + (CADAR ALL-FILES))) + ((NULL A-FILE)) + (SETQ ALL-FILES (CDR ALL-FILES)) + (COND ((EQUAL A-NAME THE-NAME) + (RETURN A-FILE))))))) + +;;; SF-SAVE-USER-FILE saves the user's file onto disc as updated +;;;by the current session. + +(DEFUN SF-SAVE-USER-FILE NIL + (DECLARE (SPECIAL DB-UNAME)) + (DO ((FILES (SF-READ-FILES) (CDR FILES)) + (RESULT)) + ((NULL FILES) + (SF-WRITE-FILES (CONS (SF-GET-USER-FILE) RESULT))) + (COND ((EQUAL DB-UNAME (CADAR FILES)) + (SETQ RESULT (APPEND RESULT (CDR FILES)) + FILES NIL)) + (T (SETQ RESULT (CONS (CAR FILES) RESULT)))))) + +;;; SF-GET-USER-FILE returns a list of all the +;;;information which composes the user file. + +(DEFUN SF-GET-USER-FILE NIL + (DECLARE (SPECIAL SC-INITIALIZED SF-VAR-LIST)) + (SETQ SC-INITIALIZED (MAPCAR 'ASC-INITIALIZED + '(0. 1. 2.))) + (MAPCAR 'EVAL + (CONS '(SKI-GET-MODEL) SF-VAR-LIST))) + +;;; SF-READ-FILES returns the list of all user files. + +(DEFUN SF-READ-FILES NIL + (UREAD wa plyrs8 dsk games) + (SETQ ^Q T) + (READ)) + +;;; SF-WRITE-FILES writes out the files, which it is sent +;;;sent as an argument. + +(DEFUN SF-WRITE-FILES (ALL-FILES) + (SETQ ^R T ^W T) + (PRIN1 ALL-FILES) + (UFILE wa plyrs8 dsk games) + (SETQ ^W NIL ^R NIL)) + +;;;******** English Generation Routines ************ +;;;******* English Routines which compare probs. ******* +;;; EC-EXPL-PROBS makes comparisons of two probabilities. + +(DEFUN EC-EXPL-PROBS (BETTER WHY-BETTER WORSE WHY-WORSE T-DANGER) + (COND ((GP-EQ (XPR-PROB WORSE T-DANGER) 1.0) + (EC-EXPL-CERTAIN WORSE T-DANGER)) + ((= WHY-BETTER 12.) + (EC-EXPL-PROB-12-ANY BETTER WORSE WHY-WORSE T-DANGER)) + ((= WHY-BETTER 14.) + (EC-EXPL-PROB-14-ANY BETTER WORSE T-DANGER)) + ((AND (= WHY-WORSE 13.) (NOT (= WHY-BETTER 13.))) + (EC-EXPL-PROB-ANY-13 BETTER WORSE T-DANGER)) + ((AND (= WHY-BETTER 11.) (= WHY-WORSE 11.)) + (EC-EXPL-PROB-11-11 BETTER WORSE T-DANGER)) + ((= WHY-BETTER 15.) + (EC-EXPL-PROB-15-ANY BETTER WORSE T-DANGER)) + (T (EC-EXPL-PROB-ANY-ANY BETTER WORSE T-DANGER)))) + +;;; EC-EXPL-PROB-ANY-ANY makes comparison of any two rules. + +(DEFUN EC-EXPL-PROB-ANY-ANY (BETTER WORSE T-DANGER) + (APPEND '(|it is true that|) + (EXR-PROB BETTER T-DANGER NIL) + (EG-HOWEVER) + (EXR-PROB WORSE T-DANGER 'UNSAFE))) + +;;; EC-EXPL-CERTAIN explains that the worse cave is +;;;certain to contain the danger. + +(DEFUN EC-EXPL-CERTAIN (WORSE T-DANGER) + (EXR-PROB WORSE T-DANGER NIL)) + +;;; EC-EXPL-PROB-11-11 compares two probs of P11. + +(DEFUN EC-EXPL-PROB-11-11 (BETTER WORSE T-DANGER) + (WA-TOLD-RULE 11. T-DANGER) + ;;; The COND is necessary because of the way + ;;;incomplete cave sets are explained. + (APPEND + (COND ((AND (XSR-COMPLETE-CAVE-SETP (XPR-WHY-P11 BETTER + T-DANGER) + T-DANGER) + (XSR-COMPLETE-CAVE-SETP (XPR-WHY-P11 WORSE + T-DANGER) + T-DANGER)) + (APPEND '(|It is true that|) + (EXT-CAVE-SET (XPR-WHY-P11 BETTER T-DANGER) + T-DANGER T 0.) + (EG-HOWEVER) + (EXT-CAVE-SET (XPR-WHY-P11 WORSE T-DANGER) + T-DANGER T 0.))) + (T (APPEND (EXT-CAVE-SET WORSE T-DANGER T 0.) + (EG-CONVERSELY) + (EXT-CAVE-SET BETTER T-DANGER T 0.)))) + (LIST '|. This makes it less likely that cave| + BETTER + '|contains|) + (AEG-DANGER-SING T-DANGER))) + +;;; EC-EXPL-PROB-15-ANY compares P15 with any rule. + +(DEFUN EC-EXPL-PROB-15-ANY (BETTER WORSE T-DANGER) + (APPEND (EXR-PROB15 BETTER T-DANGER 'SAFE) + (COND ((GP-EQ 0.0 (XPR-PROB BETTER T-DANGER)) NIL) + (T (APPEND '(|than if we visited cave|) + (LIST WORSE)))))) + +;;; EC-EXPL-PROB-ANY-13 compares P11 probs with P13 probs. + +(DEFUN EC-EXPL-PROB-ANY-13 (BETTER WORSE T-DANGER) + (APPEND (EXR-PROB13 WORSE T-DANGER NIL) + '(|. |) + (EXR-CAVE-PROB BETTER T-DANGER 'SAFE))) + +;;; EC-EXPL-PROB-14-ANY compares P14 to another prob. + +(DEFUN EC-EXPL-PROB-14-ANY (BETTER WORSE T-DANGER) + (APPEND (EXR-PROB14 BETTER T-DANGER NIL) + '(|. |) + (EXR-CAVE-PROB WORSE T-DANGER 'UNSAFE))) + +;;; EC-EXPL-PROB-12-ANY compares P12 with another prob. + +(DEFUN EC-EXPL-PROB-12-ANY (BETTER WORSE WHY-WORSE T-DANGER) + (COND ((= WHY-WORSE 12.) + (WE-ERROR 'EC-EXPL-PROB-12-ANY))) + (APPEND (EXR-PROB12 BETTER T-DANGER NIL) + '(|. There is evidence of|) + (AEG-DANGER-SING T-DANGER) + (LIST '|in cave| WORSE) + '(|which makes it a more dangerous cave|))) + +;;;****** English Routines Interfacing With the Expert ****** +;;; EXR-SAFE-CAVE explains why a cave is safe from DANGERS. + +(DEFUN EXR-SAFE-CAVE (CAVE DANGERS) + (COND + ((NULL DANGERS) NIL) + (T + (APPEND (EXR-MORE-THAN CAVE 0. (CAR DANGERS)) + (COND ((> (ASK-WDRULES 18. 0. (CAR DANGERS)) 2.) + (EGT-ALSO DANGERS)) + (T (APPEND '(|. |) + (EG-TELL-AVOID (LIST (CAR DANGERS))) + (COND ((GP-TEST DANGERS) + '(|. |)))))) + (EXR-SAFE-CAVE CAVE (CDR DANGERS)))))) + +;;; EXT-LIST-MORE-THAN explains why the list is more than +;;;the given DIST away from DANGER. Note that it return NIL +;;;if the student already knows all teh rules concerned, +;;;AND the GO-AHEAD switch is off. + +(DEFUN EXT-LIST-MORE-THAN (CAVE-LIST DIST DANGER GO-AHEAD) + (DECLARE (SPECIAL DIST DANGER VALUE)) + (PROG (KNOWS-CAVES VISITED-CAVES VALUE) + (COND + ;;; By definition a cave is more than -1. + ((= DIST -1.) (RETURN NIL)) + ((SETQ + KNOWS-CAVES + (GM-ALL-TRUE + (FUNCTION + (LAMBDA (X) + (DECLARE (SPECIAL DIST DANGER)) + (AND (> (1+ (XDR-MORE-THAN X DANGER)) DIST) + (SLR-KNOWS-RULESP (CXR-MORE-THAN (LIST X) + DIST + DANGER + NIL) + DANGER)))) + CAVE-LIST)) + (SETQ CAVE-LIST (GP-REMOVE-LIST CAVE-LIST KNOWS-CAVES)) + (SETQ VALUE (APPEND (EGT-ALL-OF DIST KNOWS-CAVES) + (EG-INSERT-AND '|cave| + KNOWS-CAVES) + (EGT-MORE-THAN DIST + DANGER + KNOWS-CAVES))))) + (COND + ((NOT (OR GO-AHEAD CAVE-LIST)) (RETURN NIL)) + ((AND (= DIST 0.) + (SETQ VISITED-CAVES + (GM-ALL-TRUE 'XDR-VISITEDP + CAVE-LIST))) + (WA-TOLD-RULE 1. DANGER) + (SETQ CAVE-LIST (GP-REMOVE-LIST CAVE-LIST + VISITED-CAVES)) + (SETQ VALUE + (APPEND (COND (VALUE (APPEND VALUE + (EGT-ALSO T)))) + '(|we have safely visited|) + (EG-INSERT-AND '|cave| + VISITED-CAVES))))) + (COND ((NULL CAVE-LIST) (RETURN VALUE))) + (RETURN + (APPEND + VALUE + (GM-MAPCAN + (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL DIST DANGER + VALUE)) + (APPEND (COND (VALUE (EGT-ALSO T)) + (T (SETQ VALUE T) + NIL)) + (EXR-MORE-THAN X + DIST + DANGER)))) + CAVE-LIST))))) + +;;; EXR-MORE-THAN returns the explanation for why CAVE +;;;is more than DIST away from DANGER. + +(DEFUN EXR-MORE-THAN (CAVE DIST DANGER) + (DECLARE (SPECIAL CAVE)) + (PROG (R-DIST REASON TEMP) + (SETQ R-DIST (XDR-MORE-THAN CAVE DANGER) + REASON (XXR-WHY-MORE-THAN CAVE DIST DANGER)) + (COND ((< R-DIST DIST) + (RETURN (WE-ERROR (LIST 'EXR-MORE-THAN + CAVE + DIST + DANGER)))) + ((= DIST -1.) (RETURN NIL))) + (WA-TOLD-RULE REASON DANGER) + (RETURN + (APPEND (LIST '|cave| CAVE) + (EGT-MORE-THAN DIST DANGER NIL) + '(|because|) + (COND ((= REASON 1.) + '(|we have safely visited it|)) + ((= REASON 2.) (EX-L2 DANGER)) + ((= REASON 3.) + (APPEND '(|we have been there|) + '(|and we did not|) + (AEG-WARNING-PRES DANGER))) + ((= REASON 5.) + (EX-L5 (LIST CAVE) DIST DIST DANGER)) + ((= REASON 6.) + (EX-L6 CAVE DIST DANGER TEMP)) + ((= REASON 9.) (EX-L9 CAVE DANGER TEMP)) + ((= REASON 10.) (EX-L10 CAVE DANGER))))))) + +;;; EX-L2 finishes an explanation of L2. + +(DEFUN EX-L2 (DANGER) + (APPEND '(|you shot an arrow there and you did not kill|) + (AEG-DANGER-SING DANGER))) + +;;; EX-L5 finishes explanations for L5. + +(DEFUN EX-L5 (HAVE-CAVES DIST O-DIST DANGER) + (COND ((= (XXR-WHY-MORE-THAN (CAR HAVE-CAVES) DIST DANGER) 5.) + (EX-L5 (CONS (CADR (XDR-WHY-MORE-THAN (CAR HAVE-CAVES) + DANGER)) + HAVE-CAVES) + (1+ DIST) + O-DIST + DANGER)) + ((MEMBER DANGER (WGR-WARNINGS (CAR HAVE-CAVES))) + (WE-ERROR (LIST 'EX-L5 (CAR HAVE-CAVES) DANGER))) + (T (WA-TOLD-RULE 3. DANGER) + (COND ((AND (= O-DIST 0.) + (> (ADB-WARNING-DIST DANGER) 1.)) + (SK-TOLD-RULE 19. DANGER))) + (APPEND '(|, if|) + (AEG-DANGER-SING DANGER) + '(|were|) + (COND ((< O-DIST 1.) '(|there|)) + ((= O-DIST 1.) '(|next to it|)) + (T (APPEND '(|within|) + (EG-NUMBER DIST) + '(|caves of it|)))) + '(|, we would have|) + (AEG-WARNING-PAST DANGER) + (LIST '|in cave| (CAR HAVE-CAVES)) + (COND ((< (ADB-WARNING-DIST DANGER) 2.) NIL) + ((SLR-HEARD-OF-RULE 5. DANGER) NIL) + (T (EG-WITHIN (LIST (CAR HAVE-CAVES)) + (LAST HAVE-CAVES) + DANGER))))))) + +;;; EX-L6 finishes the explanations for L6. + +(DEFUN EX-L6 (CAVE DIST DANGER TEMP) + (APPEND + (EGT-ALL-OF (1- DIST) (WGR-NEIGHBORS CAVE)) + '(|its|) + (EGT-PLURAL '(|neighbors|) (WGR-NEIGHBORS CAVE)) + (EGT-MORE-THAN (1- DIST) DANGER T) + ;;; Don't say anymore if the player knows all. + (COND ((SETQ TEMP + (EXT-LIST-MORE-THAN (WGR-NEIGHBORS CAVE) + (1- DIST) + DANGER + NIL)) + (APPEND '(|. |) + TEMP + (EG-THEREFORE) + '(|cave|) + (LIST CAVE) + (EGT-MORE-THAN DIST DANGER NIL)))))) + +;;; EX-L9 finishes the explanation for L9. + +(DEFUN EX-L9 (CAVE DANGER TEMP) + (DECLARE (SPECIAL CAVE)) + (APPEND + '(|if|) + (AEG-DANGER-SING DANGER) + '(|were there we|) + (EG-SPECULATIVE (AEG-ENCOUNTER DANGER)) + (AEG-DANGER-SING DANGER) + '(|before we|) + (AEG-ENCOUNTER + (SETQ TEMP + (GM-FIRST-TRUE (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL CAVE)) + (WGR-DANGERP CAVE X))) + '(2. 1. 0.)))) + (AEG-DANGER-SING TEMP))) + +;;; EX-L10 finishes explanations for L10. + +(DEFUN EX-L10 (CAVE DANGER) + (APPEND '(|we have isolated|) + (COND ((= (ADB-NUM-DANGERS DANGER) 2.) + '(|both of the|)) + ((GP-TEST (ADB-NUM-DANGERS DANGER)) + (APPEND '(|all|) + (EG-NUMBER (ADB-NUM-DANGERS DANGER)) + '(|of the|)))) + (AEG-DANGER-PLUR DANGER) + '(|. |) + ;;; Note that a limit of -1. flags L10. + (EXT-LIST-CAVE-SET (CADR (XDR-WHY-MORE-THAN CAVE + DANGER)) + DANGER + -1.) + (EG-THEREFORE) + (LIST '|cave| CAVE) + '(|can not contain|) + (AEG-DANGER-SING DANGER))) + +;;; EXT-EXACTLY returns an explanation. It is self pruning, +;;;and will return Nil when appropriate if GO-AHEAD is NIL. +;;; Note that EXT-CAVE-SET explains rule L0. + +(DEFUN EXT-EXACTLY (CAVE DANGER GO-AHEAD) + (PROG (VALUE MORE-THAN EXACTLY) + (WA-TOLD-RULE 7. DANGER) + (COND ((AND (NOT GO-AHEAD) + (SLR-KNOWS-RULESP (CXR-EXACTLY CAVE + DANGER + NIL) + DANGER)) + (RETURN NIL)) + ((NOT (XDR-WHY-EXACTLY CAVE DANGER)) + (RETURN (WE-ERROR (LIST 'EXT-EXACTLY + CAVE + DANGER))))) + (SETQ MORE-THAN (XDR-MORE-THAN CAVE DANGER) + EXACTLY (XDR-EXACTLY CAVE DANGER)) + (SETQ VALUE (COND ((SLR-KNOWS-RULEP 4. DANGER) NIL) + (T (EXR-LESS-THAN CAVE DANGER)))) + (SETQ + VALUE + (COND ((= EXACTLY 1.) VALUE) + (VALUE (APPEND VALUE + '(|. We also know that|) + (EXT-LIST-MORE-THAN (LIST CAVE) + MORE-THAN + DANGER + T) + (EG-THEREFORE) + (LIST '|cave| + CAVE + '|is|) + (EG-N-AWAY EXACTLY) + (AEG-DANGER-SING DANGER))) + ((SLR-KNOWS-RULESP (CXR-MORE-THAN (LIST CAVE) + MORE-THAN + DANGER + NIL) + DANGER) + NIL) + (T (APPEND '(|. This follows from the fact that|) + (EXT-LIST-MORE-THAN (LIST CAVE) + MORE-THAN + DANGER + T))))) + (RETURN (APPEND (LIST '|cave| CAVE) + '(|must be|) + (EG-N-AWAY EXACTLY) + (AEG-DANGER-SING DANGER) + VALUE)))) + +;;; EXR-LESS-THAN returns that a cave is "less-than". + +(DEFUN EXR-LESS-THAN (CAVE DANGER) + (WA-TOLD-RULE 4. DANGER) + (APPEND '(|because we|) + (AEG-WARNING-PAST DANGER) + (LIST '|in cave| CAVE) + (COND ((SLR-HEARD-OF-RULE 4. DANGER) NIL) + ((> (ADB-WARNING-DIST DANGER) 1.) + (APPEND '(|. This means that cave|) + (LIST CAVE '|is within|) + (EG-NUMBER (ADB-WARNING-DIST DANGER)) + '(|caves of|) + (AEG-DANGER-SING DANGER)))))) + +;;; EXT-LIST-CAVE-SET puts together explanations for CAVE-SETS. + +(DEFUN EXT-LIST-CAVE-SET (O-CAVES DANGER LIMIT) + (COND ((NULL O-CAVES) NIL) + (T (APPEND (EXT-CAVE-SET (CAR O-CAVES) DANGER T LIMIT) + (EGT-ALSO O-CAVES) + (EXT-LIST-CAVE-SET (CDR O-CAVES) + DANGER + LIMIT))))) + +;;; EXT-CAVE-SET returns an explanation for the specified cave-set +;;;depending on the student's knowledge and on GO-AHEAD. + +(DEFUN EXT-CAVE-SET (O-CAVE DANGER GO-AHEAD LIMIT) + (PROG (VALUE EXPLAIN-SET TOTAL-SET NODIST-SET OTHER-CAVES + PROB DIST TEMP REASONS L10-SW) + (COND ((< (SETQ DIST (XDR-EXACTLY O-CAVE DANGER)) 0.) + (RETURN (WE-ERROR (LIST 'EXT-CAVE-SET + O-CAVE + DANGER))))) + (COND ((= LIMIT -1.) (SETQ LIMIT 0. L10-SW T))) + (SETQ NODIST-SET + (XXT-GET-NODIST-SET O-CAVE LIMIT DANGER L10-SW) + TOTAL-SET + (XSR-TOTAL-DIST-SET O-CAVE LIMIT DANGER) + EXPLAIN-SET + (GP-REMOVE-LIST TOTAL-SET NODIST-SET) + TEMP + (XSR-OTHER-CAVES O-CAVE LIMIT EXPLAIN-SET DANGER) + OTHER-CAVES + (CAR TEMP) + PROB + (CADR TEMP) + VALUE + (EG-DIST-SET EXPLAIN-SET + OTHER-CAVES + PROB + NIL + LIMIT + DANGER) + REASONS + (CXR-CAVE-SET (LIST O-CAVE) DANGER NIL)) + (*SS-IMPLIED-RULES REASONS DANGER) + (COND ((SLR-KNOWS-RULESP REASONS DANGER) + (COND (GO-AHEAD (RETURN VALUE)) (T (RETURN NIL)))) + ((= DIST 0.) + (WA-TOLD-RULE 0. DANGER) + (RETURN (APPEND VALUE + '(|because we|) + (AEG-ENCOUNTER DANGER) + (AEG-DANGER-SING DANGER) + '(|when we visited it before|)))) + ((AND (= (ADB-WARNING-DIST DANGER) 1.) + (SLR-KNOWS-RULESP (GP-REMOVE-LIST REASONS '(7. 4.)) DANGER)) + (WA-TOLD-RULE 4. DANGER) + (WA-TOLD-RULE 7. DANGER) + (RETURN (APPEND VALUE + '(|because we|) + (AEG-WARNING-PAST DANGER) + (LIST '|in cave| O-CAVE))))) + (RETURN (APPEND VALUE + '(|. |) + (EXT-EXACTLY O-CAVE DANGER T) + (EX-DIST-SET O-CAVE + DANGER + (1- DIST) + LIMIT + L10-SW))))) + +;;; EX-DIST-SET explains each given dist set. + +(DEFUN EX-DIST-SET (ORIGIN DANGER DIST LIMIT L10-SW) + (PROG (REDUCED-SET TOTAL-SET NODIST-SET OTHER-CAVES PROB + TEMP) + (RETURN + (COND ((< DIST LIMIT) NIL) + (T (SETQ NODIST-SET + (XXT-GET-NODIST-SET ORIGIN + DIST + DANGER + L10-SW) + TOTAL-SET + (XSR-TOTAL-DIST-SET ORIGIN DIST DANGER) + REDUCED-SET + (GP-REMOVE-LIST TOTAL-SET NODIST-SET) + TEMP + (XSR-OTHER-CAVES ORIGIN + DIST + REDUCED-SET + DANGER) + OTHER-CAVES + (CAR TEMP) + PROB + (CADR TEMP)) + (COND ((AND NODIST-SET (> DIST 0.)) + (WA-TOLD-RULE 8. DANGER))) + (APPEND (EG-DIST-SET TOTAL-SET + OTHER-CAVES + PROB + (EG-THEREFORE) + DIST + DANGER) + (EG-HOWEVER) + (EXT-LIST-MORE-THAN NODIST-SET + DIST + DANGER + T) + (EG-DIST-SET REDUCED-SET + NIL + PROB + '(|. This means that|) + DIST + DANGER) + (EX-DIST-SET ORIGIN + DANGER + (1- DIST) + LIMIT + L10-SW))))))) + +;;; EXR-PROB returns an explanation for PROB with BIAS. + +(DEFUN EXR-PROB (CAVE DANGER BIAS) + ((GP-MAKN 'EXR-PROB (CAR (XPR-WHY-PROB CAVE DANGER))) + CAVE + DANGER + BIAS)) + +;;; EXR-PROBNIL returns the explanation for PROBNIL + +(DEFUN EXR-PROBNIL (CAVE DANGER BIAS) + BIAS + (EXT-LIST-MORE-THAN (LIST CAVE) 0. DANGER T)) + +;;; EXR-PROB11 returns an explanation of PROB11. + +(DEFUN EXR-PROB11 (CAVE DANGER BIAS) + (APPEND (EXT-CAVE-SET (XPR-WHY-P11 CAVE DANGER) DANGER T 0.) + ;;; Cave-sets of one are self-explanatory. + (COND ((GP-EQ (XPR-GET-P11 CAVE DANGER) 1.0) NIL) + (T (WA-TOLD-RULE 11. DANGER) + (APPEND (EG-THEREFORE) + (EXR-CAVE-PROB CAVE DANGER BIAS)))))) + +;;; EXR-PROB12 returns an explanation for PROB12. + +(DEFUN EXR-PROB12 (CAVE DANGER BIAS) + (COND + ((XPR-WHY-P12 CAVE DANGER) + (WA-TOLD-RULE 12. DANGER) + (APPEND + '(|it is true that|) + (EXT-CAVE-SET (CADAR (XPR-WHY-P12 CAVE DANGER)) DANGER T 0.) + (EG-HOWEVER) + (EXT-CAVE-SET (CAAR (XPR-WHY-P12 CAVE DANGER)) DANGER T 0.) + '(|. This explains all the evidence for|) + (AEG-DANGER-SING DANGER) + (EG-INSERT-AND + '|in cave| + (XSR-GET-CAVE-SET (CADAR (XPR-WHY-P12 CAVE DANGER)) + DANGER)) + (COND + ((CDR (XPR-WHY-P12 CAVE DANGER)) + (APPEND + '(|. Likewise, we can explain away all the other evidence of|) + (AEG-DANGER-SING DANGER) + (LIST '|in cave| CAVE '|. |))) + (T '(|. |))) + (EXR-UNSAFE CAVE DANGER BIAS))) + (T (EXR-UNSAFE CAVE DANGER BIAS)))) + +;;; EXR-UNSAFE simply returns that a cave is unsafe. + +(DEFUN EXR-UNSAFE (CAVE DANGER BIAS) + (APPEND '(|as we do not have any evidence of cave|) + (LIST CAVE '|containing|) + (AEG-DANGER-SING DANGER) + '(|, we can presume that|) + (EXR-CAVE-PROB CAVE DANGER BIAS))) + +;;; EXR-PROB13 returns an expalnation for PROB13. + +(DEFUN EXR-PROB13 (CAVE DANGER BIAS) + (WA-TOLD-RULE 13. DANGER) + (APPEND (EXT-LIST-CAVE-SET (XPR-GOOD-MEMBER-SETS CAVE DANGER) + DANGER + 0.) + '(|. This is multiple evidence of|) + (AEG-DANGER-SING DANGER) + (LIST '|in cave| CAVE '|which makes it|) + (EG-PROBABLE (XPR-PROB CAVE DANGER) BIAS) + (LIST '|that cave| CAVE '|contains|) + (AEG-DANGER-SING DANGER))) + +;;; EXR-PROB14 returns an explanation for PROB14. + +(DEFUN EXR-PROB14 (CAVE DANGER BIAS) + (DECLARE (SPECIAL DANGER)) + (PROG (MEMBER-SETS CHANGED-CAVES) + (WA-TOLD-RULE 14. DANGER) + (SETQ + MEMBER-SETS + (XPR-GOOD-MEMBER-SETS CAVE DANGER) + CHANGED-CAVES + (GP-UNION + (GM-MAPCAN (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL DANGER)) + (XPR-P13-CHANGED X + DANGER))) + MEMBER-SETS))) + (RETURN (APPEND (EXT-LIST-CAVE-SET MEMBER-SETS DANGER 0.) + (EG-HOWEVER) + '(|we have multiple evidence for|) + (EG-INSERT-AND '|cave| + CHANGED-CAVES) + (EG-THEREFORE) + (EXR-CAVE-PROB CAVE DANGER BIAS))))) + +;;; EXR-PROB15 returns an explanation for PROB15. + +(DEFUN EXR-PROB15 (CAVE DANGER BIAS) + (COND + ((EQ BIAS 'UNSAFE) + ((GP-MAKN 'EXR-PROB (CADR (XPR-WHY-PROB CAVE DANGER))) + CAVE + DANGER + BIAS)) + (T + (WA-TOLD-RULE 15. DANGER) + (APPEND + '(|we know that it is|) + (EG-PROBABLE (XPR-GET-P14 CAVE DANGER) NIL) + (LIST '|that cave| CAVE '|contains|) + (AEG-DANGER-SING DANGER) + (EG-THEREFORE) + '(|if we first shoot an arrow into cave|) + (LIST CAVE '|before visiting it, it is|) + (EG-PROBABLE (XPR-PROB CAVE DANGER) BIAS) + '(|that we will be killed by the arrow| + |(if it misses) or by|) + (AEG-DANGER-SING DANGER))))) + +;;; EXR-CAVE-PROB returns a caves PROB in words. + +(DEFUN EXR-CAVE-PROB (CAVE DANGER BIAS) + (APPEND '(|it is|) + (EG-PROBABLE (XPR-PROB CAVE DANGER) BIAS) + (LIST '|that cave| CAVE '|contains|) + (AEG-DANGER-SING DANGER))) + +;;;******** General Purpose English Routines. ******* +;;; EG-INSERT-AND takes a list, inserts commas, inserts "and", +;;;and adds the PRED (it omits additions as appropriate). + +(DEFUN EG-INSERT-AND (PRED CAVE-LIST) + (COND ((NULL CAVE-LIST) (LIST '|no| (EG-PLURAL PRED))) + ((= (LENGTH CAVE-LIST) 1.) (GP-CONS PRED CAVE-LIST)) + ((= (LENGTH CAVE-LIST) 2.) + (GP-CONS (EG-PLURAL PRED) + (LIST (CAR CAVE-LIST) + '|and| + (CADR CAVE-LIST)))) + (T (APPEND (GP-CONS (EG-PLURAL PRED) + (EG-INSERT-COMMAS CAVE-LIST)) + '(|and|) + (LAST CAVE-LIST))))) + +;;; EG-INSERT-COMMAS inserts commas into any list it is sent. + +(DEFUN EG-INSERT-COMMAS (LIST) + (COND ((CDR LIST) + (APPEND (LIST (CAR LIST) '|,|) + (EG-INSERT-COMMAS (CDR LIST)))))) + +;;; EG-NUMBER converts a decimal number to its word equivalent. + +(DEFUN EG-NUMBER (NUMBER) + (COND ((< NUMBER 1.) '(|no|)) + ((< NUMBER 11.) (AEG-NUMBER (1- NUMBER))) + (T (LIST NUMBER)))) + +;;; EG-DANGERS converts a list of dangers into words. + +(DEFUN EG-DANGERS (DANGERS) + (EG-INSERT-AND + NIL + (MAPCAR (FUNCTION (LAMBDA (X) (CAR (AEG-DANGER-PLUR X)))) + DANGERS))) + +;;; EG-PROBABLE is a function that receives a probability and returns a +;;;list of words that have about the same meaning. + +(DEFUN EG-PROBABLE (NUMBER BIAS) + (COND ((GP-EQ NUMBER 0.0) '(|not possible|)) + ((EQ BIAS 'SAFE) '(|less likely|)) + ((EQ BIAS 'UNSAFE) '(|more likely|)) + ((< NUMBER 0.1) '(|very unlikely|)) + ((< NUMBER 0.25) '(|unlikely|)) + ((< NUMBER 0.4) '(|possible|)) + ((< NUMBER 0.55) '(|quite possible|)) + ((< NUMBER 0.7) '(|probable|)) + ((< NUMBER 0.85) '(|very likely|)) + ((< NUMBER 1.0) '(|almost certain|)) + (T '(|certain|)))) + +;;; EG-THEREFORE has an unlimited supply of "therefore"s. + +(DEFUN EG-THEREFORE NIL + (DECLARE (SPECIAL LEG-THEREFORE)) + (GC-NEXT LEG-THEREFORE)) + +;;; EGT-ALSO has a never ending supply of "also"s. + +(DEFUN EGT-ALSO (TEST) + (DECLARE (SPECIAL LEG-ALSO)) + (COND ((GP-TEST TEST) (GC-NEXT LEG-ALSO)))) + +;;; EG-CONVERSELY has an unlimited supply of "conversely"s. + +(DEFUN EG-CONVERSELY NIL + (DECLARE (SPECIAL LEG-CONVERSELY)) + (GC-NEXT LEG-CONVERSELY)) + +;;; EG-HOWEVER has an unlimited supply of "however"s. + +(DEFUN EG-HOWEVER NIL + (DECLARE (SPECIAL LEG-HOWEVER)) + (GC-NEXT LEG-HOWEVER)) + +;;; EG-BECAUSE has an unlimited supply of "because"s. + +(DEFUN EG-BECAUSE NIL + (DECLARE (SPECIAL EGV-BECAUSE)) + EGV-BECAUSE) + +;;; EG-PLURAL returns the plural of ITEM. + +(DEFUN EG-PLURAL (ITEM) + (DECLARE (SPECIAL EGV-PLURAL)) + ;;; The plural of NIL is NIL? + (COND ((NOT ITEM) NIL) + ((GET EGV-PLURAL ITEM)) + (T (GP-MAKN ITEM '/s)))) + +;;; EGT-PLURAL returns the plural if TEST was a list or T. + +(DEFUN EGT-PLURAL (LIST TEST) + (COND ((GP-TEST TEST) (CONS (EG-PLURAL (CAR LIST)) (CDR LIST))) + (T LIST))) + +;;; EG-SPECULATIVE converts its argument into the speculative. + +(DEFUN EG-SPECULATIVE (LIST) + (DECLARE (SPECIAL EG-SPEC)) + (CONS (GET EG-SPEC (CAR LIST)) (CDR LIST))) + +;;; EGT-TELL-AVOID returns an explanation why +;;;the player should avoid the DANGERS. (sometimes) + +(DEFUN EGT-TELL-AVOID (DANGERS) + (EG-TELL-AVOID + (GM-ALL-TRUE (FUNCTION (LAMBDA (X) (< (ASK-WDRULES 18. 0. X) 3.))) + DANGERS))) + +;;; EG-TELL-AVOID produces the actual English. + +(DEFUN EG-TELL-AVOID (DANGERS) + (COND + ((NULL DANGERS) NIL) + (T + (STORE (ASK-WDRULES 18. 0. (CAR DANGERS)) + (1+ (ASK-WDRULES 18. 0. (CAR DANGERS)))) + (APPEND (EVAL (AEG-TELL-AVOID (1- (ASK-WDRULES 18. 0. (CAR DANGERS))) + (CAR DANGERS))) + (EGT-ALSO DANGERS) + (EG-TELL-AVOID (CDR DANGERS)))))) + +;;; EG-TOLD-RULES returns rules for a danger. + +(DEFUN EG-TOLD-RULES (RULES DANGER) + (APPEND (EG-INSERT-AND '|rule| RULES) + '(|for|) + (AEG-DANGER-PLUR DANGER))) + +;;; EGT-MORE-THAN returns a list saying more than DIST. + +(DEFUN EGT-MORE-THAN (DIST DANGER TEST) + (APPEND (COND ((< DIST 0.) + (WE-ERROR (LIST 'EGT-MORE-THAN + DIST + DANGER))) + ((AND (= DIST 0.) (GP-TEST TEST)) + '(|can contain|)) + ((= DIST 0.) '(|can not contain|)) + ((AND (= DIST 1.) (GP-TEST TEST)) + '(|are next to|)) + ((= DIST 1.) '(|is not next to|)) + (T (APPEND '(|is more than|) + (EG-NUMBER DIST) + '(|caves away from|)))) + (AEG-DANGER-SING DANGER))) + +;;; EGT-ALL-OF returns "all of" in conjunction with EGT-MORE-THAN. + +(DEFUN EGT-ALL-OF (DIST LIST) + (COND ((NOT (CDR LIST)) NIL) + ((AND (CDDR LIST) (< DIST 2.)) '(|none of|)) + ((< DIST 2.) '(|neither of|)) + ((CDDR LIST) '(|all of|)) + (T '(|both of|)))) + +;;; EG-WITHIN returns an explanation of the propagation of warnings. + +(DEFUN EG-WITHIN (T-ORIGIN EXPLAIN DANGER) + (APPEND '(|as cave|) + EXPLAIN + (COND ((= (ADB-WARNING-DIST DANGER) 1.) + '(|is next to cave|)) + (T (APPEND '(|is within|) + (EG-NUMBER (ADB-WARNING-DIST DANGER)) + '(|caves of cave|)))) + T-ORIGIN)) + +;;; EG-N-AWAY retrurs a list saying DIST away. + +(DEFUN EG-N-AWAY (DIST) + (COND ((< DIST 1.) '(|contains|)) + ((= DIST 1.) '(|next to|)) + (T (APPEND '(|exactly|) + (EG-NUMBER DIST) + '(|caves away from|))))) + +;;; EG-DIST-SET puts together English for a DIST-SET. + +(DEFUN EG-DIST-SET (NEW-CAVES OTHER-CAVES PROB PRED DIST DANGER) + (APPEND + (COND + (OTHER-CAVES (APPEND (COND (PRED '(|. |))) + '(|we do not know the neighbors of|) + (EG-INSERT-AND '|cave| + OTHER-CAVES) + (EG-HOWEVER) + '(|it is|) + (EG-PROBABLE PROB NIL) + '(|that|))) + ((GP-EQ PROB 1.0) PRED) + (T (APPEND PRED + '(|it is|) + (EG-PROBABLE PROB NIL) + '(|that|)))) + (COND ((GP-TEST NEW-CAVES) '(|one of|))) + (EG-INSERT-AND '|cave| NEW-CAVES) + (COND ((GP-TEST (1+ DIST)) + (APPEND '(|must be|) (EG-N-AWAY DIST))) + (T '(|contains|))) + (AEG-DANGER-SING DANGER))) + +;;;;**************** The Wumpus Game Routines. **************** +;;;WG-MOVETO ACCEPTS THE NUMBER OF THE CAVE TO WHICH THE +;;;PLAYER IS MOVING, CHECKS OUT THE MOVE, AND PERFORMS IT + +(DEFUN WG-MOVETO (CAVE) + (DECLARE (SPECIAL WE-NORESTART WG-HERE WE-DONE WE-MOVE DB-NUM-CAVES)) + (COND ((WGR-DANGERP CAVE 2.) + (COND (WE-MOVE (SETQ WE-NORESTART T))) + (WE-NOTE-DANGER 2.) + (SETQ WE-DONE T)) + ((WGR-DANGERP CAVE 1.) + (WE-NOTE-DANGER 1.) + (SETQ WE-DONE T)) + ((WGR-DANGERP CAVE 0.) + (WE-NOTE-DANGER 0.) + ;;;BATS CAN GO ANYWHERE- + (WG-MOVETO (RANDOM DB-NUM-CAVES))) + (T (SETQ WG-HERE CAVE)))) + +;;; WG-SHOOT is the Wumpus function to shoot an arrow. + +(DEFUN WG-SHOOT (CAVE) + (DECLARE (SPECIAL WG-ARROWS WE-DONE)) + (COND + ((WGR-EXTRA-ARROWS) + (SETQ WG-ARROWS (1- WG-ARROWS)) + (WG-SHOOT1 CAVE (1+ (RANDOM 4.)))) + (T (COND ((WG-SHOOT1 CAVE (1+ (RANDOM 4.))) T) + (T (G-RSAY '(|You are out of arrows, you lose! |)) + (SETQ WE-DONE T)))))) + +;;; WG-SHOOT1 does the actual work of shooting. + +(DEFUN WG-SHOOT1 (CAVE DIST-LEFT) + (DECLARE (SPECIAL WE-SHOT WE-DONE WE-RETURN WG-HERE DB-NAME)) + (COND ((< DIST-LEFT 1.) NIL) + ((WGR-DANGERP CAVE 2.) + (G-RSAY (LIST '|Congratulations,| + DB-NAME + '|, you have shot the Wumpus. |)) + (SETQ WE-RETURN T) + (SETQ WE-DONE T) + T) + ((= CAVE WG-HERE) + (G-RSAY '(|You have just shot yourself. |)) + (SETQ WE-DONE T) + NIL) + (T (G-RSAY '(|Poing|)) + (COND (WE-SHOT (*SXD-MARK-SHOT WE-SHOT) + (XD-MARK-SHOT WE-SHOT))) + (WG-SHOOT1 (GP-RANDEL (WGR-NEIGHBORS CAVE)) + (1- DIST-LEFT))))) + +;;;*********** Routines to Change the Warren. ************** +;;; WGM-TRANSPOSE does the actual transposition of two caves. + +(DEFUN WGM-TRANSPOSE (CAVE-1 CAVE-2) + (PROG (TEMP TEMP-1 TEMP-2) + (SETQ TEMP (WGR-WARNINGS CAVE-1)) + (WGI-MARK-WARNINGS CAVE-1 (WGR-WARNINGS CAVE-2)) + (WGI-MARK-WARNINGS CAVE-2 TEMP) + (DO ((DANGER 0. (1+ DANGER))) + ((> DANGER 2.)) + (SETQ TEMP (WGR-DANGERP CAVE-1 DANGER)) + (COND ((WGR-DANGERP CAVE-2 DANGER) + (WGI-STORE-DANGER CAVE-1 T DANGER)) + (T (WGI-STORE-DANGER CAVE-1 NIL DANGER))) + (COND (TEMP (WGI-STORE-DANGER CAVE-2 T DANGER)) + (T (WGI-STORE-DANGER CAVE-2 NIL DANGER)))) + (SETQ TEMP-1 (WGR-NEIGHBORS CAVE-1) + TEMP-2 (WGR-NEIGHBORS CAVE-2)) + (WGM-FIX-NEI CAVE-1 TEMP-1 (SUBST CAVE-2 CAVE-1 TEMP-2)) + (WGM-FIX-NEI CAVE-2 TEMP-2 (SUBST CAVE-1 CAVE-2 TEMP-1)))) + +;;; WGM-FIX-NEI changes the neighbors of a cave. + +(DEFUN WGM-FIX-NEI (CAVE O-NEI N-NEI) + (COND (O-NEI (WGM-UNMAKE-NEI CAVE (CAR O-NEI)) + (WGM-FIX-NEI CAVE (CDR O-NEI) N-NEI)) + (N-NEI (WGI-MAKNEI CAVE (CAR N-NEI)) + (WGM-FIX-NEI CAVE NIL (CDR N-NEI))))) + +;;; WGM-UNMAKE-NEI unmakes neighbors. + +(DEFUN WGM-UNMAKE-NEI (CAVE-1 CAVE-2) + (WGI-PUT-NEI CAVE-1 (GP-DELETE CAVE-2 (WGR-NEIGHBORS CAVE-1))) + (WGI-PUT-NEI CAVE-2 (GP-DELETE CAVE-1 (WGR-NEIGHBORS CAVE-2)))) + +;;;*********** Wumpus Game Initiaialization Routines. *********** +;;;WGI-INIT SETS UP FOR A NEW GAME + +(DEFUN WGI-INIT NIL + (DECLARE (SPECIAL WG-HERE DB-NUM-CAVES)) + (WGI-MAZE) + (MAPC + (FUNCTION + (LAMBDA (X) + (DECLARE (SPECIAL DB-NUM-CAVES)) + (WGI-PUT-DANGER (WGI-NOREPRAN (ADB-NUM-DANGERS X) + DB-NUM-CAVES) + X))) + '(2. 1. 0.)) + (DO ((START (RANDOM DB-NUM-CAVES) (RANDOM DB-NUM-CAVES))) + ((WGR-SAFEP START) (SETQ WG-HERE START)))) + +;;; WGI-MAZE CREATES A RANDOM NETWORK OF +;;;DB-NUM-CAVES CAVES. ....IT ALSO REMOVES THE OLD MAZE + +(DEFUN WGI-MAZE NIL + (DECLARE (SPECIAL DB-NUM-CAVES)) + (DO ((N 0. (1+ N)) (TP)) + ((= N 2.)) + (SETQ TP (WGI-REORDER (GP-ORDLST DB-NUM-CAVES))) + (WGI-MAKNEI (CAR TP) (WGI-LISNEI TP)))) + +;;; WGI-PUT-DANGER marks the caves it is sent as containing +;;;said DANGER, and then marks the warnings as appropriate. + +(DEFUN WGI-PUT-DANGER (CAVE-LIST DANGER) + (COND (CAVE-LIST (WGI-STORE-DANGER (CAR CAVE-LIST) T DANGER) + (WGI-PUT-WARNING (CAR CAVE-LIST) + (ADB-WARNING-DIST DANGER) + DANGER) + (WGI-PUT-DANGER (CDR CAVE-LIST) DANGER)))) + +;;; WGI-PUT-WARNING puts the warnings onto the necessary caves. + +(DEFUN WGI-PUT-WARNING (CAVE DIST DANGER) + (DECLARE (SPECIAL DANGER)) + (MAPC + (FUNCTION + (LAMBDA (X) (DECLARE (SPECIAL DANGER)) + (WGI-MARK-WARNINGS X + (GP-CONS DANGER + (WGR-WARNINGS X))))) + (GP-DIST-AREA (LIST CAVE) DIST))) + +;;; WGI-NEI PUTS N2 ON CAVE N1'S NEIGHBOR PROPERTY LIST + +(DEFUN WGI-NEI (N1 N2) + (PROG (NLST) + (SETQ NLST (WGR-NEIGHBORS N2)) + (OR (MEMBER N1 NLST) (WGI-PUT-NEI N2 (CONS N1 NLST))))) + +;;; WGI-LISNEI MAKES NEIGHBORS OUT OF NEIGHBORING ELEMENTS +;;;OF ITS INPUT. IT RETURNS THE LAST ELEMENT OF THE LIST. + +(DEFUN WGI-LISNEI (LIS) + (COND ((NULL (CADR LIS)) (CAR LIS)) + (T (WGI-MAKNEI (CAR LIS) (CADR LIS)) + (WGI-LISNEI (CDR LIS))))) + +;;;WGI-MAKNEI MAKES N1 AND N2 NEIGHBORS OF EACH OTHER + +(DEFUN WGI-MAKNEI (N1 N2) (PROG2 (WGI-NEI N1 N2) (WGI-NEI N2 N1))) + +;;; WGI-NTHEL RETURNS A LIST WITH THE NTH ELEMENT AT THE FRONT + +(DEFUN WGI-NTHEL (LST N) + (COND ((< N 2.) LST) + (T (WGI-INSERT2 (CAR LST) + (WGI-NTHEL (CDR LST) (1- N)))))) + +;;; WGI-INSERT2 PLACES EL SECOND IN THE LIST LST + +(DEFUN WGI-INSERT2 (EL LST) (CONS (CAR LST) (CONS EL (CDR LST)))) + +;;; WGI-NOREPRAN OUTPUTS NUM UNIQUE RANDOM NUMBERS FROM THE +;;;RANGE 0 TO RANGE -1 + +(DEFUN WGI-NOREPRAN (NUM RANGE) + (COND ((= NUM 1.) (LIST (RANDOM RANGE))) + (T (SETQ NUM (WGI-NOREPRAN (1- NUM) RANGE)) + (DO ((RNUM (RANDOM RANGE) (RANDOM RANGE))) + ((NOT (MEMBER RNUM NUM)) (CONS RNUM NUM)))))) + +;;; WGI-REORDER RETURNS ITS ARGUMENT LIST IN RANDOM ORDER + +(DEFUN WGI-REORDER (LST) + (PROG (N) + (COND ((NULL LST) NIL) + (T (SETQ N + (WGI-NTHEL LST + (1+ (RANDOM (LENGTH LST))))) + (RETURN (CONS (CAR N) + (WGI-REORDER (CDR N)))))))) + +;;;*********** Wumpus Game Routines to supply info. ********** +;;; WGR-NEIGHBORS returns a list of the cave's neighbors. + +(DEFUN WGR-NEIGHBORS (CAVE) (ADB-CAVE CAVE 0.)) + +;;; WGI-PUT-NEI stores the NEIGHBORS into the arrays. + +(DEFUN WGI-PUT-NEI (CAVE VALUE) (STORE (ADB-CAVE CAVE 0.) VALUE)) + +;;; WGR-DANGERP is a predicate that return T if the given +;;;DANGER is located in the given CAVE. + +(DEFUN WGR-DANGERP (CAVE DANGER) (ADB-DCAVE CAVE 0. DANGER)) + +;;; WGR-SAFEP returns T if the given cave is safe. + +(DEFUN WGR-SAFEP (CAVE) + (NOT (OR (WGR-DANGERP CAVE 0.) + (WGR-DANGERP CAVE 1.) + (WGR-DANGERP CAVE 2.)))) + +;;; WGI-STORE-DANGER marks the danger in the arrays. + +(DEFUN WGI-STORE-DANGER (CAVE VALUE DANGER) + (STORE (ADB-DCAVE CAVE 0. DANGER) VALUE)) + +;;; WGR-WARNINGS returns those dangers causing warnings at CAVE. + +(DEFUN WGR-WARNINGS (CAVE) (ADB-CAVE CAVE 1.)) + +;;; WGI-MARK-WARNINGS puts the WARNINGS into the arrays. + +(DEFUN WGI-MARK-WARNINGS (CAVE VALUE) + (STORE (ADB-CAVE CAVE 1.) VALUE)) + +;;; WGR-EXTRA-ARROWS returns T if the player has extra arrows. + +(DEFUN WGR-EXTRA-ARROWS NIL + (DECLARE (SPECIAL WG-ARROWS)) + (> WG-ARROWS 1.)) + +;;; ************************ Data Base Routines **************** +;;; This is the beginning of the routines that update the standard +;;;database for the program. They have a prefix of "D_". +;;; "DI" routines do the very first initializations. They initialize +;;;all the vital "inter-game" variables, finding about the player, etc. +;;; DI-DATABASE is called once for each new LISP. It fills the arrays, etc.. +;;; It is executed as part of the initializations. (Not compiled). + (DEFUN DI-DATABASE NIL + (DECLARE (SPECIAL TYO CX-WHY-BETTER CX-WHY-WORSE G-READ-NUM G-SILENT + G-LAST G-BLAST G-BBLAST DB-NUMLOSSES GV-CURSORPOS + DB-NUM-PROP WE-GAME-HIST SC-UREPEAT SC-LREPEAT DB-DATE + SC-LFORGET SC-UFORGET EGV-PLURAL EGV-BECAUSE DB-LAST-DATE + EG-SPEC LWAW-TELL-WANDER LWA-TELL-C4 LEG-HOWEVER + LEG-CONVERSELY LEG-ALSO LEG-THEREFORE WAV-TOLD-RULE + SC-DECREASE-FORGET SC-DECREASE-REPEAT SC-INCREASE-FORGET + SC-INCREASE-REPEAT *SS-VERSION *SS-ACTIVE + WEV-RECREATE WE-VERSION XP-P12-CHANGED G-DOUBLESPACE + SF-VAR-LIST DB-NUM-CRULES DB-NUM-RULES DB-NUM-DPROP)) + (ENDPAGEFN TYO NIL) + (SETSYNTAX 46. 128. NIL) + (SETQ IBASE 10. + BASE 10. + *NOPOINT T + *SS-ACTIVE NIL + *SS-VERSION NIL + WE-VERSION '|eight| + WEV-RECREATE NIL + WE-GAME-HIST NIL + DB-NUM-CRULES 6. + DB-NUM-RULES 19. + DB-NUM-PROP 7. + DB-NUM-DPROP 18. + DB-DATE (DI-DATE) + WAV-TOLD-RULE NIL + CX-WHY-BETTER NIL + CX-WHY-WORSE NIL + EGV-PLURAL 'EGV-PLURAL + EGV-BECAUSE '(|, because|) + EG-SPEC 'EG-SPEC + SC-LREPEAT 0.0 + SC-UREPEAT 5.0 + SC-LFORGET 2.0 + SC-UFORGET 30.0 + LEG-THEREFORE (GCI-CREATE 3. + '((|, and so|) + (|. Therefore|) + (|. Hence|))) + LEG-ALSO (GCI-CREATE 3. + '((|. Also,|) + (|, and|) + (|. Likewise,|))) + LEG-CONVERSELY (GCI-CREATE 2. + '((|. Conversely,|) + (|. In contrast,|))) + LEG-HOWEVER (GCI-CREATE 2. + '((|. However|) (|, but|))) + LWA-TELL-C4 (GCI-CREATE 3. + '((LIST '|I don't know,| + DB-NAME + '|, but|) + (LIST '|Well,| + DB-NAME + '|, I think that|) + (LIST '|You know,| + DB-NAME + '|,|))) + LWAW-TELL-WANDER (GCI-CREATE 3. + '((LIST DB-NAME + '|, we seem to be going in circles|) + (LIST '|I seem to remember just| + '|coming from that cave,| + DB-NAME) + (LIST '|We seem to be wandering aimlessly,| + DB-NAME))) + G-DOUBLESPACE NIL + G-LAST 32. + G-BLAST 32. + G-BBLAST 46. + G-SILENT NIL + G-READ-NUM 1. + GV-CURSORPOS 0. + XP-P12-CHANGED NIL + SC-INCREASE-FORGET NIL + SC-DECREASE-FORGET NIL + SC-INCREASE-REPEAT NIL + SC-DECREASE-REPEAT NIL + SF-VAR-LIST '(DB-UNAME DB-NAME DB-LAST-DATE DB-NUMWINS DB-NUMLOSSES + DB-MOVES DB-DEBUG DB-COMMENT SL-REPEAT SL-FORGET + SL-RECEPTIVITY SL-HEARD-OF WA-CAN-BACKTRACK + WA-TOLD-BACKTRACK WE-MOVE-NUM SL-LAST-LEARNED + SC-INITIALIZED SL-TUTOR DB-GAME-NUM DB-HISTORY)) + (ARRAY ADB-CAVE T 1. DB-NUM-PROP) + (ARRAY ADB-DCAVE T 1. DB-NUM-DPROP 1.) + (ARRAY AEG-TELL-AVOID T 3. 3.) + (ARRAY ADB-TELL-WARNING T 3. 3.) + (ARRAY ADB-TELL-DANGER T 3. 3.) + (ARRAY ASK-WDRULES FIXNUM (1+ DB-NUM-RULES) 2. 3.) + (ARRAY ASK-DRULES FLONUM (1+ DB-NUM-RULES) 2. 3.) + (ARRAY AWE-EXPL-RULES T 16.) + (ARRAY ASL-PHASE-RULES T 5. 3.) + (ARRAY ASL-NEXT-RULES T 5. 3.) + (ARRAY ASL-PNUM-DANGERS T 5. 3.) + (ARRAY ASKC-RULES T 7. 3.) + (ARRAY AEG-NUMBER T 10.) + (MAPC (FUNCTION (LAMBDA (X) (*ARRAY X T 3.))) + '(AXS-CHANGED-SETS AEG-DANGER-SING AEG-DANGER-PLUR + ASL-WORK-ON-RULES AXR-FOUND-N AXS-EXACT-CAVES + AXS-PARTIAL-SETS AXS-COMPLETE-SETS + APS-RULE-ARRAY AEG-WARNING-PRES AEG-WARNING-PAST + ASC-INITIALIZED AEG-ENCOUNTER AWA-TOLD-RULES)) + (MAPC (FUNCTION (LAMBDA (X) (*ARRAY X 'FIXNUM 3.))) + '(ADB-NUM-DANGERS ADB-WARNING-DIST AXR-NUM-IDENTIFIED + ASL-PHASE ADB-DIST-START)) + (MAPC (FUNCTION (LAMBDA (X) (*ARRAY X 'FLONUM 3.))) + '(AXX-EST-NUM-DANGERS AXP-PROB12)) + (MAPC (FUNCTION (LAMBDA (X Y) + (DECLARE (SPECIAL EGV-PLURAL)) + (PUTPROP EGV-PLURAL Y X))) + '(|is cave| |is| |can| |could| |is rule|) + '(|are caves| |are| |can| |could| |are rules|)) + (MAPC (FUNCTION (LAMBDA (X Y) + (DECLARE (SPECIAL EG-SPEC)) + (PUTPROP EG-SPEC Y X))) + '(|were| |fell|) + '(|would have been| |would have fallen|)) + (MAPC (FUNCTION (LAMBDA (X Y) (STORE (ASKC-RULES X 1.) Y))) + (GP-ORDLST 7.) + '(2. 1. 2. 0. 0. 0. 0.)) + (MAPC (FUNCTION (LAMBDA (X A B C D E F G H I) + (STORE (ASL-PHASE-RULES X 0.) A) + (STORE (ASL-PHASE-RULES X 1.) B) + (STORE (ASL-PHASE-RULES X 2.) C) + (STORE (ASL-NEXT-RULES X 0.) D) + (STORE (ASL-NEXT-RULES X 1.) E) + (STORE (ASL-NEXT-RULES X 2.) F) + (STORE (ASL-PNUM-DANGERS X 0.) G) + (STORE (ASL-PNUM-DANGERS X 1.) H) + (STORE (ASL-PNUM-DANGERS X 2.) I))) + (GP-ORDLST 5.) + '((14.) (6. 10. 12. 13.) (4. 7. 11.) (0. 3. 5.) (1.)) + '((14.) (6. 9. 10. 12. 13.) (4. 7. 11.) (0. 3. 5.) + (1.)) + '((12. 13.) (6. 8. 9. 10. 11. 15.) (4. 7.) + (0. 2. 3. 5. 19.) (1.)) + '((14.) (12. 13.) (4. 7. 11.) (3. 5.) (1.)) + '((14.) (12. 13.) (4. 7. 11.) (3. 5.) (1.)) + '((12. 13.) (11.) (4. 7.) (3. 5. 19.) (1.)) + '(4. 3. 3. 2. 1.) + '(2. 3. 3. 2. 1.) + '(2. 1. 1. 1. 1.)) + (MAPC (FUNCTION (LAMBDA (W A B C D E) + (STORE (ASL-PHASE W) 0.) + (STORE (ASL-WORK-ON-RULES W) + (ASL-PHASE-RULES 0. W)) + (STORE (AEG-ENCOUNTER W) A) + (STORE (AEG-WARNING-PRES W) B) + (STORE (AEG-WARNING-PAST W) C) + (STORE (AEG-DANGER-SING W) D) + (STORE (AEG-DANGER-PLUR W) E))) + '(0. 1. 2.) + '((|were| |picked up by|) (|fell| |into|) + (|were| |eaten by|)) + '((|hear squeaking|) (|feel a breeze|) + (|smell the Wumpus|)) + '((|heard squeaking|) (|felt a breeze|) + (|smelled the Wumpus|)) + '((|bats|) (|a pit|) (|the Wumpus|)) + '((|bats|) (|pits|) (|the Wumpus|))) + (MAPC (FUNCTION (LAMBDA (X Y) (STORE (AEG-NUMBER X) Y))) + (GP-ORDLST 10.) + '((|ten|) (|nine|) (|eight|) (|seven|) (|six|) + (|five|) (|four|) (|three|) (|two|) (|one|))) + (MAPC (FUNCTION (LAMBDA (X Y) (STORE (AWE-EXPL-RULES X) Y))) + (GP-ORDLST 16.) + '((|P15, Shooting Principle, Whenever the probability of| + |the Wumpus being in a cave exceeds 0.25, it is safer to| + |shoot into the cave before visitng it. Hence, the more| + |likely it is that the Wumpus is in the cave, the less| + |likely it is that the player will be killed.|) + (|P14, Adjust For Multiple Evidence Principle, In cases| + |where P13 is applied, the other members of said| + |cave-set are less likely to contain the danger.|) + (|P13, Multiple Evidence Principle, if there is multiple| + |evidence that a given cave contains a danger (i.e. it| + |is a member of two cave-sets), then it is more likely| + |that the given cave contains the danger.|) + (|P12, Explain Away Evidence Principle, When it is noted| + |that there are two cave-sets, one of which is a subset| + |of the other, there is no evidence that those caves| + |in the superset and not in the subset whether or| + |not said caves contain a danger (as the caves in the| + |subset completely explain the warning) so the| + |probability is reduced to some consistent value.|) + (|P11, Equal Likelihood Principle, An estimation of| + |the probability for a given cave is 1N, where N| + |is the number of caves in the smallest cave-set| + |of which said cave is a member.|) + (|L10, Certain caves can be marked as "more than zero| + |away" based on consideration of the different| + |complete cave-sets and the number of dangers. |) + (|L9, If the player encountered a danger in a cave,| + |then the cave does not contain a danger of higher| + |priority, i.e. the Wumpus eats the player before| + |he can fall into a pit, and he will fall into a| + |pit before he is picked up by bats.|) + (|L8, When the algorithm is creating cave-sets and| + |it encounters a cave which would be N caves away| + |but which is also "more than N away", then that cave| + |can not have any contributions to the cave-set. |) + (|L7, If a cave is "more than (N-1) away" and| + |"less than (N+1) away", then it is "N away". |) + (|L6, If all of a caves neighbors are "more than| + |(N-1) away", then it can be marked "more than N away". |) + (|L5, If a cave is marked "more than N away" then all| + |of its neighbors can be marked as "more than (N-1) away". |) + (|L4, If a cave is visited and there is a warning,| + |then that cave is "less than (N+1) away". |) + (|L3, If a cave is visited and there is not a warning,| + |then that cave is "more than N away" where N| + |is the distance that the warning propagates. |) + (|L2, If the player shoots an arrow into a cave| + |and does not kill the Wumpus, then that cave can| + |be marked as "more than zero away" (Wumpus). |) + (|L1, A cave can be marked as "more than zero| + |away" if it was safely visited. |) + (|L0, A cave can be marked as "zero away" if it| + |was visited and found to contain a danger. |))) +;;; The other dangers are set when it is known how many there are. + (MAPC (FUNCTION (LAMBDA (W A X Y Z) + (STORE (AEG-TELL-AVOID W Z) A) + (STORE (ADB-TELL-WARNING W Z) X) + (STORE (ADB-TELL-DANGER W Z) Y))) + '(0. 1. 2. 0. 1. 2. 0. 1. 2.) + '((APPEND '(|it is not wise to visit caves with bats| + |because while THEY will not harm us| + |they will carry us to another cave which| + |could contain|) (AEG-DANGER-SING 1.) '(|or|) (AEG-DANGER-SING 2.)) + (APPEND + '(|we should avoid bats because they| + |could drop us in a cave with|) + (AEG-DANGER-SING 1.) + '(|or|) + (AEG-DANGER-SING 2.)) + '(|it is best to avoid bats as they could carry us to a fatal cave|) + (APPEND '(|we should try not to stumble into|) + (AEG-DANGER-SING 1.) + '(|as it would be fatal|)) + '(|we should avoid pits as they are fatal|) + '(|pits are dangerous as falling into one is fatal|) + (APPEND '(|it is best to avoid|) + (AEG-DANGER-PLUR 2.) + '(|as|) + (AEG-DANGER-PLUR 2.) + '(|eats unwary players who stumble into his lair|)) + '(|we should avoid Wumpii as they eat unwary players|) + '(|Wumpii are dangerous as they have insatiable| + |appetites for bumbling players|)) + '((|Squeak. I hear bats, they must be in one of the neighboring caves. |) + (|Squeak. I hear bats. |) (|Squeak. |) + (|Brrrr. I feel a breeze! We must be next to a pit. |) + (|Brrrr. I feel a breeze. |) (|Brrrr. |) + (|Whew, what a stench! That is the smell of the Wumpus. | + |It means that we are within two caves of the Wumpus. |) + (|What a stench! The Wumpus is near. |) + (|What a stench! |)) + '((|Bon Voyage! We have been picked up by bats! |) + (|Bon Voyage! Bats have picked us up. |) + (|Bon Voyage! |) + (|So Loonnngggggggg. We have fallen into a pit. |) + (|So Loonnngggggggg. We have fallen in a pit. |) + (|So Loonnngggggggg. |) + (|Oh no, the Wumpus is in here! Chomp Chomp Chomp. |) + (|Oh no, it's the Wumpus! Chomp Chomp Chomp. |) + (|Chomp Chomp Chomp. |)) + '(0. 0. 0. 1. 1. 1. 2. 2. 2.))) + +;;; DI-INITIALIZE is called for each new session. Loads the new user-file, etc.. + +(DEFUN DI-INITIALIZE NIL + (DECLARE (SPECIAL LINEL G-WRITE-NUM DB-NUMWINS DB-NUMLOSSES DB-LAST-DATE SL-REPEAT + SC-NOTEST SC-INITIALIZED DB-COMMENT DB-USER-ID DB-DEBUG SL-TUTOR + *SS-VERSION *SS-ACTIVE G-SILENT WE-LAST-SESSION LWA-CRULES + WE-THIS-SESSION WAM-NEXT-MOVE WAW-GIVEN-ROUTE DB-DATE SL-FORGET + WA-CAN-BACKTRACK WA-TOLD-BACKTRACK SL-LAST-LEARNED SL-HEARD-OF + LWA-MOVE-NUMS SL-MODE WE-MOVE-NUM DB-MOVES SL-RECEPTIVITY + DB-GAME-NUM DB-HISTORY)) + (SETQ LINEL 60. + WE-MOVE-NUM 2. + WE-LAST-SESSION 0. + WE-THIS-SESSION 1. + WA-CAN-BACKTRACK 0.0 + WA-TOLD-BACKTRACK NIL + WAW-GIVEN-ROUTE NIL + WAM-NEXT-MOVE NIL + ;;; Set switch for interaction numbers to T iff + ;;;this is a printing terminal. + G-WRITE-NUM (COND ((= TTY 0.))) + DB-DEBUG NIL + DB-COMMENT *SS-ACTIVE + DB-NUMWINS 0. + DB-NUMLOSSES 0. + DB-MOVES 0. + ;;; Don't set DB-DATE if the Synthetic Student did. + DB-DATE (COND (*SS-ACTIVE DB-DATE) (T (DI-DATE))) + DB-LAST-DATE DB-DATE + SL-MODE NIL + SL-REPEAT 1.34 + SL-FORGET 4.9 + SL-RECEPTIVITY 6.0 + SL-HEARD-OF (1-$ SL-REPEAT) + SL-LAST-LEARNED 0. + SC-NOTEST NIL + SC-INITIALIZED '(NIL NIL NIL) + SL-TUTOR T + DB-GAME-NUM NIL + DB-HISTORY NIL) + (MAPC (FUNCTION (LAMBDA (X) (STORE (ASC-INITIALIZED X) NIL))) + (GP-ORDLST 3.)) + (DI-NEWS) + (G-RSAY '(|Please enter your login name so that my| + |programmer can reach you if he wishes. |)) + (SETQ DB-USER-ID (G-READ *SS-VERSION)) + (G-RISAY + '(|Would you like to run in demo mode? (Please| + |follow all reponses with a space.)|)) + (COND + ((AND (GQ-EVAL (G-READ 'WANT-DEMO)) (SF-LOAD-DEMO))) + (T + (COND ((NOT G-SILENT) + (CURSORPOS 'C) + (CURSORPOS 0. 0.))) + (G-RSAY + '(|Hello, my name is Wusor VIII. What is your name? | + |(Please type in your first and last name. | + |Follow all responses with a space.) |)) + (COND + ((DI-GET-NAME) + (G-RSAY + '(|I believe that we have hunted Wumpii| + |together before. Is that right? |)) + (COND + ((GQ-EVAL (G-READ 'PLAYED-BEFORE))) + (T + (G-RSAY + '(|This is very unusual. I have met another person| + |with the exact same name. Please enter a different| + |last name and remember to use it as your name in| + |all future games. |)) + (DI-REREAD-LAST-NAME)))) + (T (DIQ-INIT-FILE (DIQ-INTRO)))))) + (SETQ + LWA-MOVE-NUMS + (GCI-CREATE + 5. + (MAPCAR (FUNCTION (LAMBDA (X) + (DECLARE (SPECIAL WE-MOVE-NUM SL-RECEPTIVITY)) + (- WE-MOVE-NUM + (FIX (*$ SL-RECEPTIVITY + (FLOAT (1+ X))))))) + (GP-ORDLST 5.))) + LWA-CRULES + (GCI-CREATE 5.))) + +;;; DI-GET-NAME reads in the user's name and loads his file from +;;;disc if there is such a file. It returns T if there was a +;;;file on the user, and it returns NIL if there was no such file. + +(DEFUN DI-GET-NAME NIL + (DECLARE (SPECIAL DB-UNAME DB-NAME)) + (SETQ DB-UNAME (LIST (G-READ 'SYNDI) + (G-SREAD 'LAST-NAME))) + (SETQ DB-NAME (G-LOWER-CASE (CAR DB-UNAME) T)) + (G-RSAY (LIST '|Do I have your name right,| + DB-NAME + (G-LOWER-CASE (CADR DB-UNAME) T) + '|? |)) + (COND + ((GQ-EVAL (G-READ 'YES)) (SF-GET-DISC-FILE DB-UNAME)) + (T + (G-RSAY + '(|Then let's try to get it right. | + |Please retype your name. |)) + (DI-GET-NAME)))) + +;;; DI-REREAD-LAST-NAME rereads the user's last name to assign +;;;a unique user-name to everyone. + +(DEFUN DI-REREAD-LAST-NAME NIL + (DECLARE (SPECIAL DB-NAME DB-UNAME)) + (SETQ DB-UNAME (LIST (CAR DB-UNAME) (G-READ 'LAST-NAME))) + (COND + ((NULL (SF-GET-DISC-FILE DB-UNAME)) + (G-RSAY (LIST '|Now we've got it straight. Before we start,| + DB-NAME + '|I would like to ask you some questions. |)) + (DIQ-INIT-FILE NIL)) + (T + (G-RSAY + '(|Humm! This is very unusual. | + |Please try another last name. |)) + (DI-REREAD-LAST-NAME)))) + +;;; DI-DATE returns the date. + +(DEFUN DI-DATE NIL + (PROG (DATE DAY MONTH) + (SETQ DATE (STATUS DATE) + DAY (CADDR DATE) + MONTH (CADR DATE) + DATE (+ DAY (* MONTH 30.))) + (RETURN DATE))) + +;;; DI-NEWS is a place where the programmer can put things +;;;of relevance to the user. Later there will also be a +;;;function which gives the user a synopsis of the rules +;;;which the advisor thinks the player may have forgotten. + +(DEFUN DI-NEWS NIL + (DECLARE (SPECIAL G-SILENT G-DOUBLESPACE)) + (COND ((NOT G-SILENT) (CURSORPOS 'C) (CURSORPOS 0. 0.))) + (G-RSAY '(|Good Morning! My, but today is a beautiful day. |)) + (G-RSAY '(|It should be a lovely day for hunting Wumpii. |)) + (G-TERPRI) + (G-TERPRI) + (G-RSAY + '(|NOTES FROM THE PROGRAMMER: This is WUSOR VIII. | + |Please use Wusor only when system usage is low| + |as Wusor can eat up a lot of CPU time. | + |If you run into any problems please save the game| + |by typing "(SAVE)". If you would like to see the| + |pedagogical comments, try the *COMMENT and *NOCOMMENT| + |commands. For other such commands, do "*? ". |)) + (G-TERPRI)) + +;;; DI-INSTRUCTIONS gives the player instructions. + +(DEFUN DI-INSTRUCTIONS NIL + (DECLARE (SPECIAL G-SILENT G-DOUBLESPACE)) + (COND ((NOT G-SILENT) (CURSORPOS 'C) (CURSORPOS 0. 0.))) + (setq doublespace nil) + (G-RISAY + '(|You are a world-renowned hunter descending down| + |into the caves of darkness, lair of the infamous| + |man-eating Wumpus. To win the game,| + |you must first kill the Wumpus by shooting one of| + |your five arrows into his lair from a neighboring| + |cave. If you go into the cave of the Wumpus he| + |will eat you. Within the warren there are two| + |other kinds of dangers, bats and pits. The pits| + |are bottomless and fatal if you fall into one of them. If| + |you visit the home cave of bats they will pick you| + |up and carry you to another cave which might| + |contain the Wumpus or a pit (either of which is fatal). |)) + (G-RESET) + (G-RISAY + '(|You can gain information about the warren through| + |exploration. Anytime you visit a safe cave, you| + |will be told the number of the cave you are in and| + |the numbers of the caves connected to it. If bats| + |are in one of the neighboring caves you will hear| + |their high pitched squeaking. Likewise, if you are| + |next to a cave with a pit you will feel a chilling| + |breeze. If you are within two caves of the Wumpus,| + |you will smell his horrible stench. |)) + (G-RESET) + (G-RISAY + '(|As you explore, you should try| + |to keep a map showing everything you learn about the| + |warren. Your life depends on this map. |)) + (G-RESET) + (G-RISAY + '(|Before you shoot an arrow, you should consider the| + |fact that if the Wumpus is not in the cave, the| + |arrow will start ricocheting and may kill either| + |the Wumpus or yourself (and it is an agonizing| + |death). If it does start ricocheting, there is roughly| + |a one third chance that it will kill you. |)) + (G-RESET) + (G-RISAY + '(|Your only companion on the endeavor is the wise| + |old sage, Wusor. He will ask you "What now?" to| + |which you can reply with a neighboring cave that you| + |would like to visit, or "SHOOT",| + |indicating that you would like to shoot one of| + |your arrows into a neighboring cave. If you make a| + |hasty move, Wusor may stop you and give you| + |advice, but the final decision rests with you. |)) + (SETQ G-DOUBLESPACE NIL)) + +;;; ****** Initialization Questionaire Routines. ********** +;;; DIQ-INIT-FILE is the executive routine of the questionaire. +;;;It insures that the disc file and studentmodel are initialized +;;;appropriately. + +(DEFUN DIQ-INIT-FILE (BEFORE) + (DECLARE (SPECIAL SL-FORGET SL-HEARD-OF SL-REPEAT)) + (PROG (EDUCATION MATH-BIAS AGE TOTAL EXPERIENCE + FILE-NAME READ-FILE) + (SETQ EDUCATION (DIQ-EDUCATION) + MATH-BIAS (DIQ-MATH-BIAS) + AGE (DIQ-GET-AGE) + TOTAL (+$ (FLOAT AGE) (*$ MATH-BIAS + (FLOAT EDUCATION))) + SL-REPEAT (//$ (LOG 85.) (LOG TOTAL)) + SL-HEARD-OF (1-$ SL-REPEAT) + SL-FORGET (*$ 2.0 (LOG TOTAL)) + EXPERIENCE (DIQ-EXPERIENCE BEFORE) + FILE-NAME (DIQ-EVALUATE (//$ (FLOAT EXPERIENCE) SL-REPEAT)) + READ-FILE (SF-READ-DISC-FILE FILE-NAME)) + (SKI-PUT-MODEL (CAR READ-FILE)) + (SF-SAVE-USER-FILE))) + +;;; DIQ-EDUCATION reads in the player's education. + +(DEFUN DIQ-EDUCATION NIL + (PROG (RESPONSE) + (G-TERPRI) + (G-RSAY '(|I need to know how many years of education| + |have you completed? For example:|)) + (G-RISAY '(|If you are in the 8th grade, enter 7.|)) + (G-RISAY '(|If you are a Junior in college, enter 14.|)) + (G-RISAY '(|If you are a 2nd year grad student, enter 17.|)) + (G-RISAY '(|If you are a college grad, enter 16.|)) + (SETQ RESPONSE (G-READ 0.)) + (COND ((FLOATP RESPONSE) + (SETQ RESPONSE (FIX RESPONSE)))) + (COND ((AND (FIXP RESPONSE) + (> RESPONSE -1.)) + (RETURN (MIN RESPONSE 20.))) + (T (RETURN (DIQ-EDUCATION)))))) + +;;; DIQ-MATH-BIAS reads in the player's math bias and returns +;;;an appropriate value. + +(DEFUN DIQ-MATH-BIAS NIL + (PROG (RESPONSE RET-VAL) + (G-TERPRI) + (G-RSAY '(|What do think of the Math//Sciences? | + |(Please enter 1, 2, or 3). |)) + (G-RISAY '(|1) I hate it! |)) + (G-RISAY '(|2) I guess it is OK. |)) + (G-RISAY '(|3) I love it! |)) + (SETQ RESPONSE (G-READ 1.)) + (COND ((FLOATP RESPONSE) + (SETQ RESPONSE (1+ (FIX RESPONSE))))) + (COND ((AND (FIXP RESPONSE) + (> RESPONSE 0.) + (< RESPONSE 4.)) + (COND ((= RESPONSE 3.) + (SETQ RET-VAL 3.5)) + ((= RESPONSE 2.) + (SETQ RET-VAL 2.2)) + (T (SETQ RET-VAL 1.0))) + (RETURN RET-VAL)) + (T (RETURN (DIQ-MATH-BIAS)))))) + +;;; DIQ-GET-AGE gets and returns the player's age. + +(DEFUN DIQ-GET-AGE NIL + (PROG (RESPONSE) + (G-TERPRI) + (G-RISAY '(|Please enter your age (in years). |)) + (SETQ RESPONSE (G-READ 7.)) + (COND ((FLOATP RESPONSE) + (SETQ RESPONSE (FIX RESPONSE)))) + (COND ((AND (FIXP RESPONSE) + (> RESPONSE -1.)) + (RETURN (MAX 7. (MIN RESPONSE 25.)))) + (T (RETURN (DIQ-GET-AGE)))))) + +;;; DIQ-EXPERIENCE returns the player's game experience considering +;;;whether or not he read the rules. BEFORE is set to T only if +;;;the player has claimed to have played with the WA before. + +(DEFUN DIQ-EXPERIENCE (BEFORE) + (PROG (RET-VAL NEW-BEFORE) + (G-TERPRI) + (COND ((NOT BEFORE) + (G-RSAY + '(|Have you ever played the game of Wumpus before? |)) + (SETQ NEW-BEFORE (GQ-EVAL (G-READ 'NO))))) + (COND (BEFORE (SETQ RET-VAL (DIQ-NUM-GAMES))) + ((NOT NEW-BEFORE) + (G-RSAY '(|Would you like to read the instructions? |)) + (SETQ RET-VAL 0.)) + (T (SETQ RET-VAL (DIQ-NUM-GAMES)) + (G-RISAY + '(|The rules of the hunt are a little different| + |here than in many Wumpus games. Would you| + |like to scan through the rules? |)))) + (COND (BEFORE) + ((GQ-EVAL (G-READ 'NO)) + (SETQ RET-VAL (+ 2. RET-VAL)) + (DI-INSTRUCTIONS))) + (RETURN RET-VAL))) + +;;; DIQ-NUM-GAMES returns how many games the player has played. + +(DEFUN DIQ-NUM-GAMES NIL + (PROG (RESPONSE) + (G-TERPRI) + (G-RISAY '(|Please enter the number of Wumpus hunts| + |you have been on (approximately). |)) + (SETQ RESPONSE (G-READ 0.)) + (COND ((FLOATP RESPONSE) + (SETQ RESPONSE (FIX RESPONSE)))) + (COND ((AND (FIXP RESPONSE) + (> RESPONSE -1.)) + (RETURN (MIN RESPONSE 20.))) + (T (RETURN (DIQ-NUM-GAMES)))))) + +;;; DIQ-EVALUATE converts factor into an initialization value. + +(DEFUN DIQ-EVALUATE (FACTOR) + (DECLARE (SPECIAL WA-CAN-BACKTRACK SL-REPEAT)) + (COND ((< FACTOR 1.0) NIL) + ((< FACTOR 3.0) (SETQ WA-CAN-BACKTRACK (-$ SL-REPEAT 0.5)) NIL) + ((< FACTOR 6.0) (SETQ WA-CAN-BACKTRACK (+$ SL-REPEAT 0.5)) 'NOVICE) + ((< FACTOR 10.0) (SETQ WA-CAN-BACKTRACK (+$ SL-REPEAT 0.5)) 'AMATEUR) + ((< FACTOR 15.0) (SETQ WA-CAN-BACKTRACK (+$ SL-REPEAT 0.5)) 'MODERATE) + (T (SETQ WA-CAN-BACKTRACK (+$ SL-REPEAT 0.5)) 'ADVANCED))) + +;;; DIQ-INTRO gives a preface for all this question and +;;;determines if the player has ever played with the WA before. + +(DEFUN DIQ-INTRO NIL + (DECLARE (SPECIAL DB-NAME)) + (G-TERPRI) + (G-RISAY '(|I don't believe that we have met before.| + |Have we ever hunted Wumpii together? |)) + (COND ((NOT (GQ-EVAL (G-READ 'NO))) + (G-RSAY + (LIST '|Well,| + DB-NAME + '|, before we start I would like to| + '|ask you some questions. |)) + NIL) + (T (G-RSAY + (LIST '|I am really sorry,| + DB-NAME + '|, but I seem to have misplaced my| + '|records of our previous games. I| + '|need to ask you some questions before| + '|we can start.|)) + T))) + +;;; ****** Standard Data Base Routines. *********** +;;;DB-END-SESSION saves whatever is needed. + +(DEFUN DB-END-SESSION NIL + (DECLARE (SPECIAL DB-NAME)) + (G-RISAY + (APPEND + (LIST '|Well,| DB-NAME) + '(|, have a nice day. Please look me up next| + |time you want to go on a Wumpii hunt. |)))) + +;;; DB-END-GAME saves whatever is necessary. + +(DEFUN DB-END-GAME NIL + (DECLARE (SPECIAL SL-MODE)) + (COND ((NOT SL-MODE) (SF-SAVE-USER-FILE)))) + +;;; DB-INIT-NEWGAME initializes the global variables for the +;;;WUMPUS-ADVISOR and its sub-modules. + +(DEFUN DB-INIT-NEWGAME NIL + (DECLARE (SPECIAL CX-COMPARE G-READ-NUM DB-TIME G-SILENT SL-MODE + DB-NUM-PROP SC-NOTEST WE-NORESTART DB-DEBUG WE-MOVE + DB-COMMENT WA-TOLD-C6 WEV-RECREATE LWA-GOOD-MOVES + XD-VISITED-CAVES WEV-ERROR XX-CHANGED DB-NUM-DPROP + DB-OLD-USER-FILE WG-ARROWS WE-LAST-MOVE WG-HERE + DB-TOTAL-DIST SL-LAST-LEARNED LWA-BAD-MOVES + WE-MOVE-NUM WAD-FRINGE DB-NUM-CAVES DB-GAME-NUM)) + (G-RSAY '(|Just a second while I erase my blackboard.|)) + ;;; These calls insure that the cave arrays are the + ;;;correct size and have the correct starting values. + (*REARRAY 'ADB-CAVE T DB-NUM-CAVES DB-NUM-PROP) + ;;; This to insure that the array is initialized to NIL. + (*REARRAY 'ADB-DCAVE T 1. 1. 1.) + (*REARRAY 'ADB-DCAVE + T + DB-NUM-CAVES + (+ DB-NUM-DPROP (* 3. DB-TOTAL-DIST)) + 3.) + (DO ((I 0. (1+ I))) + ((= I DB-NUM-CAVES)) + (DO ((J 0. (1+ J)) + (VALUES '(NIL NIL NIL -1.0 -1.0 -1.0 NIL) + (CDR VALUES))) + ((> J (1- DB-NUM-PROP))) + (STORE (ADB-CAVE I J) (CAR VALUES))) + (DO ((J 0. (1+ J)) + (VALUES '(NIL -1. (-1.) 100. (-1.) -1. (-1.) NIL + NIL NIL NIL -1.0 NIL -1.0 -1.0 NIL 0. + (-1. NIL)) + (CDR VALUES))) + ((> J (1- DB-NUM-DPROP))) + (DO ((K 0. (1+ K))) + ((= K 3.)) + (STORE (ADB-DCAVE I J K) (CAR VALUES))))) + (COND (WEV-RECREATE NIL) + ((DB-RAND-READ) NIL) + (DB-GAME-NUM + (SETQ DB-TIME DB-GAME-NUM DB-GAME-NUM (1+ DB-GAME-NUM))) + (T (SETQ DB-TIME (REMAINDER (FIX (TIME)) 300.)))) + (SETQ DB-OLD-USER-FILE (SF-GET-USER-FILE)) + (G-TERPRI) + (COND ((NOT DB-COMMENT) (SETQ G-SILENT T))) + (SF-TELL-MODEL) + (SF-TELL-VARS) + (COND ((NOT DB-COMMENT) (SETQ G-SILENT NIL))) + (G-TSAY (LIST '|*** Time is| DB-TIME '|. ***|)) + (G-RSAY '(|O.K., now I will draw up a new warren. |)) + (DB-RAND-LOOP DB-TIME) + (COND ((OR SL-MODE DB-DEBUG SC-NOTEST) NIL) + ((> WE-MOVE-NUM (+ SL-LAST-LEARNED 100.)) + (SC-HELP '|not advancing|))) + (WGI-INIT) + (WAM-MODIFY-GAME) + (SETQ WE-MOVE NIL + WE-LAST-MOVE NIL + WE-NORESTART NIL + WAD-FRINGE (LIST WG-HERE) + WA-TOLD-C6 NIL + LWA-GOOD-MOVES (GCI-CREATE 5. + '(-1. -1. -1. -1. -1.)) + LWA-BAD-MOVES (GCI-CREATE 5. + '(-1. -1. -1. -1. -1.)) + WEV-ERROR NIL + XX-CHANGED T + XD-VISITED-CAVES NIL + CX-COMPARE NIL + WG-ARROWS 5. + G-READ-NUM 1.) + (DO ((I 0. (1+ I))) + ((> I 2.)) + (STORE (AXR-NUM-IDENTIFIED I) 0.) + (STORE (AXR-FOUND-N I) NIL) + (STORE (AXS-EXACT-CAVES I) NIL) + (STORE (AXS-CHANGED-SETS I) NIL) + (STORE (AXS-PARTIAL-SETS I) NIL) + (STORE (AXS-COMPLETE-SETS I) NIL) + (XP-P12-CALC I)) + (COND ((> (ADB-NUM-DANGERS 1.) 1.) + (STORE (AEG-DANGER-SING 0.) '(|bats|)) + (STORE (AEG-DANGER-PLUR 0.) '(|bats|))) + (T (STORE (AEG-DANGER-SING 0.) '(|the bats|)) + (STORE (AEG-DANGER-PLUR 0.) '(|the bats|)))) + (COND ((> (ADB-NUM-DANGERS 1.) 1.) + (STORE (AEG-DANGER-SING 1.) '(|a pit|)) + (STORE (AEG-DANGER-PLUR 1.) '(|pits|))) + (T (STORE (AEG-DANGER-SING 1.) '(|the pit|)) + (STORE (AEG-DANGER-PLUR 1.) '(|the pit|)))) + (COND ((> (ADB-NUM-DANGERS 2.) 1.) + (STORE (AEG-DANGER-SING 2.) '(|a Wumpus|)) + (STORE (AEG-DANGER-PLUR 2.) '(|Wumpii|))) + (T (STORE (AEG-DANGER-SING 2.) '(|the Wumpus|)) + (STORE (AEG-DANGER-PLUR 2.) '(|the Wumpus|)))) + (XX-INIT-DANGER-EST) + (*SDB-INIT-NEW-GAME)) + +;;; DB-DEFINE-GAME asks the user sufficient questions to +;;;define the game. It returns true after a successful +;;;read, false if it was unsuccessful. + +(DEFUN DB-DEFINE-GAME NIL + (DECLARE (SPECIAL WE-GAME-HIST SL-MODE DB-DEBUG DB-NUM-CAVES DB-GAME-NUM + DB-NUMLOSSES DB-PHASE DB-TOTAL-DIST DB-NAME)) + ;;; This is where recreations start, so the HIST is + ;;;cleared here. + (SETQ WE-GAME-HIST NIL + DB-PHASE + (COND ((NOT DB-GAME-NUM) (SLI-LEAST-PHASE)) + ((> DB-GAME-NUM 16.) 4.) + ((> DB-GAME-NUM 7.) 3.) + ((> DB-GAME-NUM 3.) 2.) + ((> DB-GAME-NUM 1.) 1.) + (T 0.))) + (COND + (DB-DEBUG (G-RSAY '(|Would you like to define the game? |)))) + (COND + ((OR (AND DB-DEBUG (GQ-EVAL (G-READ 'NO))) + (EQ SL-MODE 'SUPER)) + (STORE (ADB-WARNING-DIST 0.) (DB-READ-DIST '|bats'|)) + (STORE (ADB-WARNING-DIST 1.) (DB-READ-DIST '|pits'|)) + (STORE (ADB-WARNING-DIST 2.) + (DB-READ-DIST '|Wumpii's|)) + (SETQ DB-NUM-CAVES (DB-NUM-READ '|caves|)) + (STORE (ADB-NUM-DANGERS 2.) (DB-NUM-READ '|Wumpii|)) + (STORE (ADB-NUM-DANGERS 0.) (DB-NUM-READ '|bats|)) + (STORE (ADB-NUM-DANGERS 1.) (DB-NUM-READ '|pits|))) + (T + (STORE (ADB-NUM-DANGERS 2.) 1.) + (STORE (ADB-NUM-DANGERS 0.) (ASL-PNUM-DANGERS DB-PHASE 0.)) + (STORE (ADB-NUM-DANGERS 1.) (ASL-PNUM-DANGERS DB-PHASE 1.)) + (STORE (ADB-NUM-DANGERS 2.) (ASL-PNUM-DANGERS DB-PHASE 2.)) + (SETQ DB-NUM-CAVES + (COND ((> (ADB-NUM-DANGERS 2.) 1.) 25.) (T 20.))) + (STORE (ADB-WARNING-DIST 0.) 1.) + (STORE (ADB-WARNING-DIST 1.) 1.) + (STORE (ADB-WARNING-DIST 2.) 2.) + (G-RISAY (APPEND (LIST '|In this game,| DB-NAME) + '(|, there will be|) + (EG-NUMBER DB-NUM-CAVES) + (EGT-PLURAL '(|cave|) DB-NUM-CAVES) + '(|all total,|) + (EG-NUMBER (ADB-NUM-DANGERS 1.)) + (EGT-PLURAL '(|pit|) + (ADB-NUM-DANGERS 1.)) + '(|, and|) + (EG-NUMBER (ADB-NUM-DANGERS 0.)) + (EGT-PLURAL '(|cave|) + (ADB-NUM-DANGERS 0.)) + '(|with bats. |))) + (G-TERPRI) + (COND + ((> (ADB-NUM-DANGERS 2.) 1.) + (G-RISAY (APPEND '(|NOTE THAT in this game there will be|) + (EG-NUMBER (ADB-NUM-DANGERS 2.)) + '(|Wumpii. You only need to kill|) + '(|one of them to win the game. |))))) + T)) + (DO ((I 0. (1+ I)) (VAL 0. (+ VAL (1+ (ADB-WARNING-DIST I))))) + ((> I 2.) (SETQ DB-TOTAL-DIST VAL)) + (STORE (ADB-DIST-START I) VAL)) + (COND + ((< DB-NUM-CAVES + (+ (ADB-NUM-DANGERS 0.) + (ADB-NUM-DANGERS 1.) + (ADB-NUM-DANGERS 2.) + 1.)) + (G-RSAY + '(|You lose this game as there were no| + |safe caves for you to start at. |)) + (SETQ DB-NUMLOSSES (1+ DB-NUMLOSSES)) + NIL) + (T T))) + +;;; DB-NUM-READ this functions reads how many "TYPES" that +;;;the player wants. + +(DEFUN DB-NUM-READ (TYPES) + (PROG (RESPONSE) + (G-RSAY (LIST '|How many| + TYPES + '|would you like in this game. |)) + (SETQ RESPONSE (G-READ 1.)) + (COND ((OR (NOT (FIXP RESPONSE)) (< RESPONSE 0.)) + (RETURN (DB-NUM-READ TYPES))) + (T (RETURN RESPONSE))))) + +;;; DB-READ-DIST reads in the warning dist. + +(DEFUN DB-READ-DIST (T-DANGER) + (PROG (RESPONSE) + (G-RSAY (LIST '|How far would you like for| + T-DANGER + '|warnings to propagate? |)) + (COND ((AND (FIXP (SETQ RESPONSE (G-READ 1.))) + (> RESPONSE -1.)) + (RETURN RESPONSE)) + (T (RETURN (DB-READ-DIST T-DANGER)))))) + +;;; DB-RAND-READ reads the initailization for the +;;;random number generator if appropriate. + +(DEFUN DB-RAND-READ NIL + (DECLARE (SPECIAL SL-MODE DB-DEBUG DB-TIME)) + (PROG (RESPONSE) + (COND ((NOT (OR SL-MODE DB-DEBUG)) (RETURN NIL))) + (G-RSAY + '(|Would you like to initialize| + |the random number generator? |)) + (COND ((GP-NUM-TEST (SETQ RESPONSE (G-READ 'NO)) + 300.) + (GO GOT-IT)) + ((NOT (GQ-EVAL RESPONSE)) (RETURN NIL))) + TRY (G-RSAY + '(|Please enter a non-negative integer| + |(not too large). |)) + (COND ((NOT (GP-NUM-TEST (SETQ RESPONSE (G-READ 1.)) + 300.)) + (GO TRY))) + GOT-IT + (SETQ DB-TIME RESPONSE) + (RETURN T))) + +;;; DB-RAND-LOOP is a function to initialize the random +;;;number generator. + +(DEFUN DB-RAND-LOOP (NUMBER) + (RANDOM NIL) + (DO ((COUNTER NUMBER (1- COUNTER))) + ((< COUNTER 0.) T) + (RANDOM 10.))) + +;;;*****************UTILITY FUNCTIONS********************** +;;; GP-MAKN concatenates its two arguments and returns +;;;the resulting string. + +(DEFUN GP-MAKN (FIRST SECOND) + (IMPLODE (APPEND (EXPLODEN FIRST) (EXPLODEN SECOND)))) + +;;; GP-EG expects two floating point args and +;;;returns T if they are approximately equal. + +(DEFUN GP-EQ (X Y) (AND (> (+$ X 1.0E-4) Y) (> (+$ Y 1.0E-4) X))) + +;;; GP-LT expects two floating point args and returns +;;;T if the first is sufficiently less than the second. + +(DEFUN GP-LT (LESS MORE) (< (+$ LESS 1.0E-4) MORE)) + +;;; GP-UNION returns the set-theoretic union of N arguments. + +(DEFUN GP-UNION NARGS + (DO ((I 1. (1+ I)) (VAL)) + ((> I (ARG NIL)) (REVERSE VAL)) + (DO ((LIST (ARG I) (CDR LIST))) + ((NULL LIST)) + (COND ((NOT (MEMBER (CAR LIST) VAL)) + (SETQ VAL (CONS (CAR LIST) VAL))))))) + +;;; GP-INTERSECTION returns the set intersection of the two lists. + +(DEFUN GP-INTERSECTION (LIST1 LIST2) + (COND ((NOT LIST1) NIL) + ((MEMBER (CAR LIST1) LIST2) + (CONS (CAR LIST1) (GP-INTERSECTION (CDR LIST1) LIST2))) + (T (GP-INTERSECTION (CDR LIST1) LIST2)))) + +;;; GP-DELETE does the same thing as a regular delete except +;;;that it doesn't have any bad side effects. + +(DEFUN GP-DELETE (ITEM LIST) + (COND ((NULL LIST) NIL) + ((EQUAL ITEM (CAR LIST)) (GP-DELETE ITEM (CDR LIST))) + (T (CONS (CAR LIST) (GP-DELETE ITEM (CDR LIST)))))) + +;;; GP-REMOVE-LIST returns the set of B minus those members +;;;who are also members of A. + +(DEFUN GP-REMOVE-LIST (B A) + (COND ((NULL B) NIL) + ((NULL A) B) + (T (GP-REMOVE-LIST (GP-DELETE (CAR A) B) (CDR A))))) + +;;; GP-CONS does a CONS after first insuring that ATOM +;;;is not already a member of LIST. + +(DEFUN GP-CONS (ATOM LIST) + (COND ((MEMBER ATOM LIST) LIST) + (ATOM (CONS ATOM LIST)) + (T LIST))) + +;;; GP-EQUIV determines if two lists are eqivalent. + +(DEFUN GP-EQUIV (LIST1 LIST2) + (NOT (OR (GP-REMOVE-LIST LIST1 LIST2) + (GP-REMOVE-LIST LIST1 LIST2)))) + +;;; GP-NUM-TEST tests if NUM is a non-negative integer less than LIMIT. + +(DEFUN GP-NUM-TEST (NUM LIMIT) + (AND (FIXP NUM) (> NUM -1.) (< NUM LIMIT))) + +;;; GP-RANDEL chooses a random element from its input list. + +(DEFUN GP-RANDEL (LIS) + (CAR (WGI-NTHEL LIS (RANDOM (1+ (LENGTH LIS)))))) + +;;; GP-CAVE-CHECK insures that there is a cave to match its arg. +;;;It returns T if there is no such cave. + +(DEFUN GP-CAVE-CHECK (T-CAVE) + (DECLARE (SPECIAL DB-NUM-CAVES)) + (COND ((AND (FIXP T-CAVE) (GP-NUM-TEST T-CAVE DB-NUM-CAVES)) NIL) + (T (G-RSAY (LIST '|There is no cave| + T-CAVE + '|. |)) + T))) + +;;; GP-TEST returns T if its argument is a list, T, or > 1. + +(DEFUN GP-TEST (TEST) + (OR (EQ TEST T) + (AND (NOT (ATOM TEST)) (CDR TEST)) + (AND (FIXP TEST) (> TEST 1.)))) + +;;; GP-DIST-AREA returns all the caves which are within +;;;DIST caves of any cave in CAVE-LIST. + +(DEFUN GP-DIST-AREA (CAVE-LIST DIST) + (COND ((< DIST 1.) CAVE-LIST) + (T (DO ((LIST CAVE-LIST (CDR LIST)) + (T-CAVE (CAR CAVE-LIST) (CAR LIST)) + (RESULT CAVE-LIST + (GP-UNION RESULT (WGR-NEIGHBORS T-CAVE)))) + ((NOT T-CAVE) (GP-DIST-AREA RESULT (1- DIST))))))) + +;;; GP-ORDLST JUST PRODUCES A LIST OF THE FIRST N NUMBERS +;;;IN REVERSE ORDER + +(DEFUN GP-ORDLST (N) + (COND ((< N 1.) NIL) (T (CONS (1- N) (GP-ORDLST (1- N)))))) + +;;; GP-INSERT inserts ITEM into the list (globally). + +(DEFUN GP-INSERT (AFTER ITEM) (RPLACD AFTER (CONS ITEM (CDR AFTER)))) + +;;; ****** General Purpose Routines For Circular Lists. ***** +;;; GCI-CREATE creates a circular list (with header) of +;;;the given length (first argument). If a second argument +;;;is supplied, it is the intial values. +;;; These functions are part of each LISPs initialization. +(DEFUN GCI-CREATE NARGS + (CONS (ARG 1.) + (GCI-WCREATE (ARG 1.) + NIL + (COND ((> (ARG NIL) 1.) (ARG 2.)))))) + +;;; GCI-WCREATE does the actual work of WGI-CREAT. + +(DEFUN GCI-WCREATE (NUM LIST VALS) + (COND ((< NUM 1.) (RPLACD (LAST LIST) LIST)) + (T (GCI-WCREATE (1- NUM) + (CONS (GCI-VAL VALS) LIST) + (CDR VALS))))) + +;;; GCI-VAL returns the appropriate value. + +(DEFUN GCI-VAL (VALS) (COND ((ATOM VALS) NIL) (T (CAR VALS)))) + +;;; GC-PUT inserts a new value into the circular list, +;;;deleting the oldest previous value. + +(DEFUN GC-PUT (CLIST VAL) (RPLACD CLIST (RPLACA (CDDR CLIST) VAL))) + +;;; GC-NEXT returns the next value while advancing the pointer. + +(DEFUN GC-NEXT (CLIST) (RPLACD CLIST (CDDR CLIST)) (CADR CLIST)) + +;;; GC-WNEXT is an internal routine to do GC-NEXT. + +(DEFUN GC-WNEXT (NAME) (SET NAME (CDR (EVAL NAME))) (CAR (EVAL NAME))) + +;;; GC-MEMBER determines if the second argument is a member +;;;of the first argument. The third argument is optional; +;;;it must be an integer (N) and tells the routine to skip +;;;the last N elements. + +(DEFUN GC-MEMBER NARGS + (COND ((AND (> (ARG NIL) 2.) + (= (ARG 3.) 0.)) + NIL) + (T (GC-WMEMBER (CDR (ARG 1.)) + (CDR (ARG 1.)) + (ARG 2.) + (COND ((> (ARG NIL) 2.) + (- (CAR (ARG 1.)) (ARG 3.))) + (T 0.)))))) + +;;; GC-WMEMBER does the actual work of GC-MEMEBR. + +(DEFUN GC-WMEMBER (C-CLIST O-CLIST VALUE SKIP) + (DECLARE (SPECIAL C-CLIST)) + (COND ((NOT (< SKIP 1.)) + (GC-WMEMBER (CDR C-CLIST) O-CLIST VALUE (1- SKIP))) + ((EQUAL (GC-WNEXT 'C-CLIST) VALUE) C-CLIST) + ((EQ C-CLIST O-CLIST) NIL) + (T (GC-WMEMBER C-CLIST O-CLIST VALUE SKIP)))) + +;;; GC-AVERAGE computes the average of the elements of the +;;;first argument. It will skip the last N elements if the +;;;second argument is specified (N). + +(DEFUN GC-AVERAGE NARGS + (GC-WAVERAGE (CDR (ARG 1.)) + (CDR (ARG 1.)) + 0.0 + 0. + (COND ((> (ARG NIL) 1.) + (- (CAR (ARG 1.)) (ARG 2.))) + (T 0.)))) + +;;; GC-WAVERAGE does the actual work of GC-AVERAGE. + +(DEFUN GC-WAVERAGE (C-CLIST O-CLIST TOTAL NUM SKIP) + (DECLARE (SPECIAL C-CLIST)) + (SETQ TOTAL (PLUS TOTAL (GC-WNEXT 'C-CLIST))) + (SETQ NUM (1+ NUM)) + (COND ((NOT (< SKIP 1.)) + (GC-WAVERAGE C-CLIST O-CLIST 0.0 0. (1- SKIP))) + ((EQ C-CLIST O-CLIST) (//$ TOTAL (FLOAT NUM))) + (T (GC-WAVERAGE C-CLIST O-CLIST TOTAL NUM SKIP)))) + +;;;******* General Purpose Mapping Functions. ******** +;;; GM-MAPCAN does a non-destructive MAPCAN. + +(DEFUN GM-MAPCAN (PRED LIST) + (COND ((NULL LIST) NIL) + (T (APPEND (PRED (CAR LIST)) + (GM-MAPCAN PRED (CDR LIST)))))) + +;;;DOES A MAPCAR OF A PREDICATE, RETURNS THE FIRST LIST VALUE +;;;FOR WHICH THE PREDICATE IS TRUE + +(DEFUN GM-FIRST-TRUE (PRED LST) + (COND ((NOT LST) NIL) + ((PRED (CAR LST)) (CAR LST)) + (T (GM-FIRST-TRUE PRED (CDR LST))))) + +;;;GIVES A LIST OF ALL ELEMENTS OF A LIST FOR WHICH +;;;A GIVEN PREDICATE IS TRUE + +(DEFUN GM-ALL-TRUE (PRED LST) + (COND ((NOT LST) NIL) + ((NOT (PRED (CAR LST))) (GM-ALL-TRUE PRED (CDR LST))) + (T (CONS (CAR LST) (GM-ALL-TRUE PRED (CDR LST)))))) + +;;;********* I/O Related General Purpose Functions. ******** +;;; G-AFFIRMATIVE evaluates the response and if it is yes +;;;or an equivalent it returns T. + +(DEFUN G-AFFIRMATIVE (REPLY) + (MEMBER REPLY + '(Y T YES UH-HUH OK YEA OKAY SURE YEAH DEFINITELY + POSITIVELY INDEED PLEASE RIGHT YUP))) + +;;; G-NEGATIVE is a function to check for the various ways of saying no. + +(DEFUN G-NEGATIVE (REPLY) + (MEMBER REPLY '(N NIL NO NOPE UHN-HUH NAH NAW))) + +;;; G-LOWER-CASE converts the character string it is sent into lower case. +;;;If the flag is true, it also capitalizes the first character. + +(DEFUN G-LOWER-CASE (STRING FLAG) + (DO ((CHARS (REVERSE (EXPLODEN STRING)) (CDR CHARS)) + (RESULT NIL)) + ((NULL (CDR CHARS)) + (IMPLODE (COND (FLAG (CONS (BOOLE 1. 95. (CAR CHARS)) + RESULT)) + (T (CONS (BOOLE 7. 32. (CAR CHARS)) + RESULT))))) + (SETQ RESULT (CONS (BOOLE 7. 32. (CAR CHARS)) RESULT)))) + +;;; G-WRITE is a function originally written by Dave MacDonald +;;;that recieves a string of numbers(ASCII) and prints them out. + +(DEFUN G-WRITE (LIST) + (DECLARE (SPECIAL LINEL GV-CURSORPOS G-SILENT G-DOUBLESPACE)) + (PROG (LIST-LENGTH ROOM-ON-LINE STARTING-POINT) + (COND ((NULL LIST) (RETURN T))) + (SSTATUS TERPRI T) + (SETQ LIST-LENGTH (LENGTH LIST)) + (SETQ STARTING-POINT GV-CURSORPOS + ;;; I think that this is one less that actual room. + ROOM-ON-LINE (- LINEL STARTING-POINT)) + (COND + ((OR (= LIST-LENGTH ROOM-ON-LINE) + (< LIST-LENGTH ROOM-ON-LINE)) + ;;; i.e. is the list going to fit + ;;; on this line? + (COND (G-SILENT (SETQ ^W T))) + (G-WRITE-WORK LIST LIST-LENGTH) + (COND (G-SILENT (SETQ ^W NIL)))) + (T + ;;; first find the word break + (PROG (L SAID-SO-FAR LAST-SP THIS-SP) + (SETQ L LIST + SAID-SO-FAR 0. + LAST-SP 0. + THIS-SP 0.) + FIND-WORD + (SETQ LAST-SP THIS-SP) + (SETQ THIS-SP + (DO ((I 1. (1+ I)) (C (CAR L) (CAR L))) + ((OR (NULL L) (= C 32.) (= C 13.)) + (SETQ L (CDR L)) + (COND ((NULL C)) + ((= C 13.) + (SETQ SAID-SO-FAR -1.))) + (+ LAST-SP I)) + (SETQ L (CDR L)) + (SETQ SAID-SO-FAR (1+ SAID-SO-FAR)))) + (COND ((AND (= LAST-SP 0.) + (= STARTING-POINT 0.) + (> SAID-SO-FAR ROOM-ON-LINE)) + (SETQ LAST-SP THIS-SP) + (GO DO-IT)) + ((> SAID-SO-FAR ROOM-ON-LINE) (GO DO-IT)) + (T (SETQ SAID-SO-FAR (1+ SAID-SO-FAR)) + ;;; include the passed space + (GO FIND-WORD))) + DO-IT(COND (G-SILENT (SETQ ^W T))) + (SETQ LIST (G-WRITE-WORK LIST LAST-SP)) + (G-TERPRI) + (COND (G-DOUBLESPACE (G-TERPRI))) + (COND (G-SILENT (SETQ ^W NIL))) + (G-WRITE LIST)))))) + +;;; G-WRITE-WORK does the actual writing for G-WRITE. + +(DEFUN G-WRITE-WORK (LIST LAST-SP) + (DECLARE (SPECIAL GV-CURSORPOS G-LAST G-BLAST G-BBLAST)) + (DO ((I LAST-SP (1- I)) + ;;; C is the character that is being worked on. + (C (CAR LIST) (CAR LIST)) + ;;; N is the next character to be worked on. + (N (CADR LIST) (CADR LIST))) + ((< I 1.)) + (SETQ LIST (CDR LIST)) + (COND ((NOT LIST) (SETQ I 0.)) + ;;;check for spaces preceding commas, periods, + ;;;and question marks. If so, then omit the space. + ((AND (= C 32.) (OR (= N 46.) (= N 44.) (= N 63.))) + (COND ((= I 1.) (SETQ I 2.)))) + ;;; If this is a new sentence, as indicated by + ;;;the punctuation, then insure that the first + ;;;letter is capitalized. + ((AND (= G-LAST 32.) + (= G-BLAST 32.) + (OR (= G-BBLAST 46.) + (= G-BBLAST 63.) + (= G-BBLAST 33.)) + (> C 96.) + (< C 123.)) + (TYO (- C 32.))) + (T (TYO C))) + ;;; G-BBLAST is the character before the character before last. + (SETQ G-BBLAST G-BLAST) + ;;; G-BLAST is the character before last. + (SETQ G-BLAST G-LAST) + ;;; G-LAST is the last character that was worked on. + (SETQ G-LAST C) + (SETQ GV-CURSORPOS (1+ GV-CURSORPOS))) + ;;; Do not output spaces at the start of a new line. + (COND ((AND (FIXP (CAR LIST)) (= (CAR LIST) 32.)) + (G-WRITE-WORK LIST 1.)) + (T LIST))) + +;;; G-TERPRI does a terpri if it appropriate according to G-SILENT. + +(DEFUN G-TERPRI NIL + (DECLARE (SPECIAL GV-CURSORPOS G-SILENT *SS-ACTIVE)) + (SETQ GV-CURSORPOS 0.) + (COND ((AND G-SILENT + (OR *SS-ACTIVE + (NOT (CURSORPOS)) + (= (CDR (CURSORPOS)) 0.))) + (SETQ ^W T) + (TYO 13.) + (SETQ ^W NIL)) + (T (TYO 13.)))) + +;;; G-SAY is a modification of the standard SAY function as it fills +;;;lines before causing a carriage return. + +(DEFUN G-SAY (LIST) + (DECLARE (SPECIAL GV-CURSORPOS)) + (PROG (NEW-LIST) + (SETQ NEW-LIST (EXPLODEN LIST)) + ;;;This statement removes the preceding open + ;;;paren. G-WRITE does not print the last character + ;;;which is a close paren. + (SETQ NEW-LIST (CDR NEW-LIST)) + ;;; Insert a space between sentences. + (COND ((> GV-CURSORPOS 0.) + (SETQ NEW-LIST (CONS 32. NEW-LIST)))) + (G-WRITE NEW-LIST))) + +;;; G-RSAY is a function to do a SAY after doing a carriage RETURN. + +(DEFUN G-RSAY (LIST) + (DECLARE (SPECIAL G-LAST G-BLAST G-BBLAST G-DOUBLESPACE)) + (G-TERPRI) + (COND (G-DOUBLESPACE (G-TERPRI))) + ;;; These two SETQs insure new sentence is capitalized. + (SETQ G-LAST 32.) + (SETQ G-BLAST 32.) + (SETQ G-BBLAST 46.) + (G-SAY LIST)) + +;;; G-TSAY does a say of pedagogical comments. G-SILENT is the +;;;switch to restrict output to the terminal. + +(DEFUN G-TSAY (LIST) + (DECLARE (SPECIAL DB-COMMENT G-SILENT GV-CURSORPOS)) + (COND ((NOT DB-COMMENT) + (SETQ G-SILENT (CURSORPOS)) + (G-TERPRI))) + (G-RSAY LIST) + (COND ((NOT DB-COMMENT) + (CURSORPOS (CAR G-SILENT) (CDR G-SILENT)) + (SETQ GV-CURSORPOS (CDR G-SILENT) G-SILENT NIL)))) + +;;; G-PSAY positions the cursor before doing a SAY. + +(DEFUN G-PSAY (LIST POSITION) + (DECLARE (SPECIAL GV-CURSORPOS)) + (DO ((SPACES (- POSITION GV-CURSORPOS) (1- SPACES))) + ((< SPACES 1.) (SETQ GV-CURSORPOS POSITION)) + (G-WRITE '(32. 32.))) + (G-SAY LIST)) + +;;; G-RESET clears the screen when the player is ready. + +(DEFUN G-RESET NIL + (DECLARE (SPECIAL G-SILENT)) + (G-RSAY '(|Enter any character for more. |)) + (G-READ 'A) + (COND ((NOT G-SILENT) + (CURSORPOS 'C) + (CURSORPOS 0. 0.)))) + +;;; G-RISAY is a function to do a SAY after doing a carriage +;;;return and then indenting six spaces. + +(DEFUN G-RISAY (LIST) + (DECLARE (SPECIAL G-LAST G-BLAST G-DOUBLESPACE)) + (G-TERPRI) + (COND (G-DOUBLESPACE (G-TERPRI))) + (G-WRITE '(32. 32. 32. 32. 32. 32.)) + ;;; This SETQ insures that new sentence is capitalized. + (SETQ G-LAST 32.) + (SETQ G-BLAST 46.) + (G-SAY LIST)) + +;;; G-READ is a function that reads after sending a TERPRI. + +(DEFUN G-READ (REQUEST) + (DECLARE (SPECIAL G-READ-NUM G-WRITE-NUM)) + (PROG (CURSOR) + (COND (G-WRITE-NUM (G-SAY (LIST (GP-MAKN G-READ-NUM + '>))))) + (G-WRITE '(32. 32.)) + ;;; Only do cursorpos if this is not a printing terminal. + (COND ((> TTY 0.) + (SETQ CURSOR (CURSORPOS)) + (G-TERPRI) + (G-TERPRI) + (CURSORPOS (CAR CURSOR) (CDR CURSOR)))) + (SETQ G-READ-NUM (1+ G-READ-NUM)) + (RETURN (G-SREAD REQUEST)))) + +;;; G-SREAD does a read without the linefeeds and such. + +(DEFUN G-SREAD (REQUEST) + (DECLARE (SPECIAL WEV-RECREATE *SS-ACTIVE WE-GAME-HIST + G-WRITE-NUM DB-DEBUG DB-COMMENT GV-CURSORPOS + XX-BEST-MOVES SL-TUTOR DB-GAME-NUM)) + (PROG (RESPONSE) + ;;; Unless this is a syntheitic student, this is a regular read. + (SETQ RESPONSE (*SS-READ REQUEST)) + ;;; If this is a recreation, then don't necessarily read. + (COND ((AND WEV-RECREATE (EQ RESPONSE T)) + (SETQ RESPONSE (CAR WEV-RECREATE)) + (SETQ WEV-RECREATE (CDR WEV-RECREATE)) + (G-RSAY (LIST '|Her input was| + RESPONSE + '|. |))) + (*SS-ACTIVE (G-SAY (LIST RESPONSE))) + (T (SETQ GV-CURSORPOS + (+ 1. + (LENGTH (EXPLODEN RESPONSE)) + GV-CURSORPOS)))) + + (SETQ WE-GAME-HIST (CONS RESPONSE WE-GAME-HIST)) + (COND ((EQ RESPONSE '*?) (WE-*COMMANDS)) + ((EQ RESPONSE '*INDEX) + (WE-WRITE-INDEX XX-BEST-MOVES)) + ((EQ RESPONSE '*EXEC) (WE-EXECUTE)) + ((EQ RESPONSE '*MODEL) (SF-TELL-MODEL)) + ((EQ RESPONSE '*VARIABLE) (SF-TELL-VARS)) + ((EQ RESPONSE '*TUTOR) (SETQ SL-TUTOR T)) + ((EQ RESPONSE '*NOTUTOR) (SETQ SL-TUTOR NIL)) + ((EQ RESPONSE '*SEQUENCE) + (COND ((NOT DB-GAME-NUM) (SETQ DB-GAME-NUM 0.)))) + ((EQ RESPONSE '*PROB) (WE-PROB)) + ((EQ RESPONSE '*RULES) (WE-RULES)) + ((EQ RESPONSE '*EXPL-RULES) (WE-EXPL-RULES)) + ((EQ RESPONSE '*EXPLAIN) (WE-EXPLAIN)) + ((EQUAL RESPONSE '(SAVE)) (SAVE)) + ((EQ RESPONSE '*DEBUG) (SETQ DB-DEBUG T)) + ((EQ RESPONSE '*NODEBUG) + (SETQ DB-DEBUG NIL)) + ((EQ RESPONSE '*COMMENT) + (SETQ DB-COMMENT T)) + ((EQ RESPONSE '*NOCOMMENT) + (SETQ DB-COMMENT NIL)) + ((EQ RESPONSE '*NUMB) (SETQ G-WRITE-NUM T)) + ((EQ RESPONSE '*NONUMB) + (SETQ G-WRITE-NUM NIL)) + ((EQ RESPONSE '*CHEAT) (WE-CHEAT)) + (T (RETURN RESPONSE))) + (G-RSAY + '(|Please answer my original question now. | + |(Enter "**" for a cue to your response.)|)) + (RETURN (G-SREAD REQUEST)))) + +;;; G-READ-RESPONSE reads in a response by the student +;;;terminated with two semicolons. + +(DEFUN G-READ-RESPONSE NIL + (DO ((VAL NIL) (THIS (TYI) (TYI)) (LAST NIL THIS)) + ((AND (= THIS 59.) (= LAST 59.)) + (SETQ VAL (IMPLODE (REVERSE VAL))) + (RETURN VAL)) + (COND ((EQUAL THIS '127.) + (CURSORPOS 'X) + (SETQ VAL (CDR VAL))) + (T (SETQ VAL (CONS THIS VAL)))))) + +;;; G-APPEND-FILE sets up for writing to a file. + +(defun g-append-file (filename) + (cond ((apply 'uprobe filename) + (setq filename (g-*ugreat filename)) + (g-*uwrite filename 'append filename)) + (t (apply 'uwrite (cddr filename))))) + +;;; G-*UGREAT is a variant of a routine of JONL, as is above. + +(defun g-*ugreat (name) + (mergef (mergef name + (cond ((status feature dec10) + '(* . lsp)) + ((status feature its) + '(* . >)))) + nil)) + +;;; G-*UWRITE is also such a variaint. + +(defun g-*uwrite (name mode newdefault) + (DECLARE (SPECIAL UWRITE OUTFILES)) + (cond (uwrite + (setq outfiles (delq uwrite outfiles)) + (close uwrite) + (setq uwrite nil))) + ((lambda (file) + (setq outfiles + (cons (setq uwrite file) + outfiles)) + (car (defaultf newdefault))) + (open name mode))) + +;;; GQ-GO-AHEAD asks the player if he would like to go +;;;ahead with MOVE. + +(DEFUN GQ-GO-AHEAD (MOVE) + (G-RSAY (LIST '|Would you like to go to cave| + MOVE + '|anyway? |)) + (COND ((GQ-EVAL (G-READ 'DECIDE-YES)) NIL) (T))) + +;;; GQ-SHOOT-ANYWAY asks the player if he would like to +;;;shoot into CAVE anyway. + +(DEFUN GQ-SHOOT-ANYWAY (CAVE) + (G-RSAY (LIST '|Would you like to shoot into cave| + CAVE + '|anyway? |)) + (COND ((GQ-EVAL (G-READ 'DECIDE-YES)) NIL) (T))) + +;;; GQ-EVAL expects a response that is either yes or no and +;;;converts it to T or NIL. If the response is not correct it +;;;asks for a yes or no response. + +(DEFUN GQ-EVAL (RESPONSE) + (COND ((G-AFFIRMATIVE RESPONSE) T) + ((G-NEGATIVE RESPONSE) NIL) + (T (GQ-YES-OR-NO)))) + +;;; GQ-YES-OR-NO is a function that asks the player to answer +;;;yes or no, reads his response, and returns his response. + +(DEFUN GQ-YES-OR-NO NIL + (G-RSAY '(|Please answer yes or no. |)) + (GQ-EVAL (G-READ 'NO))) + +;;; ********* Synthetic Student Student Non-Functions. ********** + +(DEFUN *SXD-MARK-DANGER (CAVE DANGER) CAVE DANGER) + +(DEFUN *SXD-MARK-NOWARNING (CAVE DANGER) CAVE DANGER) + +(DEFUN *SXD-MARK-VISITED (CAVE DANGERS) CAVE DANGERS) + +(DEFUN *SXD-MARK-WARNING (CAVE DANGER) CAVE DANGER) + +(DEFUN *SXD-MARK-SHOT (CAVE) CAVE) + +(DEFUN *SS-READ (REQUEST) REQUEST (READ)) + +(DEFUN *SSK-TOLD-RULE (RULE DANGER) RULE DANGER) + +(DEFUN *SS-TOLD-MOVE (G-MOVE B-MOVE C-RULE) G-MOVE B-MOVE C-RULE) + +(DEFUN *SS-INITIALIZE NIL NIL) + +(DEFUN *SDB-INIT-NEW-GAME NIL NIL) + +(DEFUN *SS-IMPLIED-RULES (REASONS DANGER) REASONS DANGER) diff --git a/src/games/wa.plyrs8 b/src/games/wa.plyrs8 new file mode 100644 index 00000000..cb220108 --- /dev/null +++ b/src/games/wa.plyrs8 @@ -0,0 +1,703 @@ +(((((0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.84 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0)) (0.0 0.0 0.0 0.0 0.0 0.0 0.0)) (DARTH VADER) +|Darth| 138 0 0 0 NIL NIL 1.13680507 7.81603 6.0 0.136805072 +1.63680507 NIL 4 0 (NIL NIL NIL) T NIL NIL) ((((0.0 0 0.0 0) +(3.56623667 5 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (3.56623667 5 0.0 0) (0.0 0 +0.0 0) (1.0 0 3.0 5) (0.0 0 0.0 0) (1.0 0 3.0 5) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 3 0.0 0) (0.0 0 0.0 0)) ((0.0 0 +0.0 0) (3.56623667 5 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 7) (0.0 0 +0.0 0) (1.0 0 1.0 7) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 1 0.0 0) (1.0 0 1.0 7)) (1.0 0.0 0.0 0.0 0.0 0.0 0.0)) (ERIC SWENSON) +|Eric| 127 0 1 10 NIL NIL 1.06623666 8.3333305 6.0 0.06623666 +4.5662367 NIL 8 5 (A 5 7) T NIL (0)) ((((0.0 0 0.0 0) (27.5895429 5 +0.0 0) (0.0 0 0.0 0) (5.58954275 5 1.0 15) (1.0 0 0.0 0) (5.58954275 5 +1.0 15) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (1.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 1 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (15.5895427 5 0.0 0) (0.0 0 0.0 0) +(5.58954275 6 0.0 0) (1.0 0 0.0 0) (5.58954275 6 0.0 0) (0.0 0 +0.0 0) (1.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (14.5895427 5 0.0 0) (0.0 0 0.0 0) (1.58954272 8 +0.0 0) (1.0 0 1.0 10) (1.58954272 8 0.0 0) (0.0 0 0.0 0) (1.0 0 +1.0 10) (1.0 0 1.0 10) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.58954272 8 0.0 0)) (4.0 +1.0 1.0 0.0 1.0 1.0 0.0)) (HOWARD CANNON) |Howard| 59 1 2 34 NIL NIL +1.08954272 8.155075 4.0 0.089542717 10.5895427 NIL 25 8 (15 21 10) T NIL (0 0 +1)) ((((0.0 0 0.0 0) (11.0 0 11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (11.0 0 11.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (11.0 0 11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0)) (2.0 0.0 0.0 0.0 0.0 0.0 0.0)) (JOHN FIX) |John| +315 0 0 0 NIL NIL 1.08507021 8.1886891 6.0 0.085070208 1.58507021 NIL 4 0 +(NIL NIL NIL) T NIL NIL) ((((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) (0.0 0.0 0.0 +0.0 0.0 0.0 0.0)) (ROGER SLYK) |Roger| 300 0 0 0 NIL T 1.08954272 +8.155075 6.0 0.089542717 0.58954272 NIL 4 0 (NIL NIL NIL) T NIL NIL) +((((1.0 0 1.0 0) (34.0 0 34.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((1.0 0 1.0 0) (34.0 0 34.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) +(1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (34.0 0 34.0 0) (0.0 0 0.0 0) (5.0 0 5.0 0) (4.0 0 +4.0 0) (5.0 0 5.0 0) (0.0 0 0.0 0) (4.0 0 4.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 2 0.0 0) (3.0 0 3.0 0)) (2.0 1.0 1.0 0.0 0.0 4.0 0.0)) (FOO BAR) |Foo| +275 0 3 0 NIL NIL 1.01096886 8.7888983 6.0 0.010968864 1.51096886 NIL 8 0 +(NIL NIL NIL) T NIL (0 0 0)) ((((0.0 0 0.0 0) (12.0 0 11.0 0) +(0.0 0 0.0 0) (1.0 0 2.0 0) (0.0 0 0.0 0) (1.0 0 2.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (12.0 0 11.0 0) (0.0 0 0.0 0) (0.65710546 10 2.0 0) +(0.0 0 0.0 0) (0.65710546 10 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (12.0 0 +11.0 0) (0.0 0 0.0 0) (1.0 0 2.0 0) (0.0 0 0.0 0) (1.0 0 2.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.0 0 1.0 6) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (1.0 0 +2.0 0)) (3.0 0.0 0.0 0.0 1.0 0.0 0.0)) (DAVID P) |David| 227 0 1 8 NIL NIL +1.15710546 7.67890465 9.0 0.15710546 2.65710548 NIL 14 5 (B 10 B) T NIL (0)) +((((1.0 0 1.0 0) (35.0 0 34.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((1.0 0 1.0 0) (35.0 0 34.0 0) +(0.0 0 0.0 0) (1.0 0 3.0 0) (2.0 0 2.0 0) (1.0 0 3.0 0) (0.0 0 +0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) +(1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 3 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (35.0 0 34.0 0) (0.0 0 0.0 0) (6.0 0 5.0 0) (5.0 0 +4.0 0) (6.0 0 5.0 0) (0.0 0 0.0 0) (5.0 0 4.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 2 0.0 0) (3.0 0 3.0 0)) (2.0 1.0 1.0 0.0 0.0 5.0 0.0)) (ROBERT KERNS) +|Robert| 185 0 1 7 NIL NIL 1.02740864 8.6482654 8.0 0.0274086446 +2.52740866 NIL 10 0 (NIL B NIL) T NIL (0)) ((((2.0 59 1.0 0) +(169.0 0 34.0 0) (0.0 0 0.0 0) (3.0 22 2.0 0) (2.0 0 2.0 0) +(5.0 22 2.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (2.0 0 2.0 0) (1.0 55 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 +0.0 0) (0.0 0 0.0 0)) ((1.0 59 1.0 0) (153.0 0 34.0 0) (0.0 0 +0.0 0) (0.53058654 103 3.0 0) (0.36058645 102 3.0 0) (0.53058654 103 +3.0 0) (0.0 0 0.0 0) (1.0 0 3.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.0 0 2.0 0) (1.0 101 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (155.0 0 34.0 0) (0.0 0 0.0 0) +(1.0 0 6.0 0) (8.0 0 4.0 0) (1.0 0 6.0 0) (0.0 0 0.0 0) (8.0 0 +10.0 0) (3.0 30 6.0 9) (0.0 0 0.0 0) (2.0 30 2.0 26) (2.0 81 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 81 0.0 0) +(0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) (0.0 101 4.0 0)) (9.0 +3.0 3.0 1.0 0.0 6.0 0.0)) (BOB KERNS) |Bob| 173 5 17 204 T T +0.69058645 7.8594385 15.0 -0.30941355 41.530587 NIL 119 81 (22 60 30) T NIL +(0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1)) ((((2.5623142 40 +1.0 0) (163.0 0 34.0 0) (0.0 0 0.0 0) (21.5623143 19 1.0 0) +(20.0 0 2.0 0) (21.5623143 19 1.0 0) (0.0 0 0.0 0) (18.0 0 2.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (15.5623143 29 1.0 0) +(4.5623142 71 0.0 0) (7.5623142 35 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) +((2.5623142 40 1.0 0) (134.0 0 34.0 0) (0.0 0 0.0 0) (10.5623143 20 +1.0 0) (4.0 0 2.0 0) (10.5623143 20 1.0 0) (0.0 0 0.0 0) (20.0 0 +2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (17.5623143 29 +1.0 0) (1.5623142 71 0.0 0) (2.5623142 35 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (141.0 0 34.0 0) (0.0 0 0.0 0) (21.0 0 +6.0 0) (17.0 0 4.0 0) (21.0 0 6.0 0) (0.0 0 0.0 0) (17.0 0 5.0 0) +(11.0 13 1.0 9) (0.0 0 0.0 0) (1.0 0 0.0 0) (8.0 17 0.0 0) (0.0 0 +0.0 0) (2.0 87 0.0 0) (0.0 0 0.0 0) (10.0 17 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 3 0.0 0) (8.0 0 4.0 0)) (15.0 17.0 11.0 1.0 +0.0 7.0 0.0)) (MARK STILES) |Mark| 156 10 6 199 NIL T 1.0623142 +8.3641003 5.0 0.062314197 55.5623145 NIL 121 87 (13 A A) NIL NIL (1 0 1 1 1 0 +1 1 1 0 0 1 0 0 1 1)) ((((0.0 0 0.0 0) (22.0 0 11.0 0) (0.0 0 +0.0 0) (1.55659358 7 1.0 0) (0.0 0 0.0 0) (1.55659358 7 1.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (22.0 0 11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (22.0 0 11.0 0) +(0.0 0 0.0 0) (1.55659358 11 1.0 0) (0.0 0 0.0 0) (1.55659358 11 +1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.0 0 1.0 0)) (4.0 0.0 0.0 0.0 1.0 0.0 0.0)) (DAVE ANDERSON) |Dave| 155 1 0 +25 NIL T 1.05659358 8.4093853 5.0 0.056593582 4.5565936 NIL 18 11 (A NIL A) +T NIL (1)) ((((7.5338274 41 0.0 0) (107.0 0 11.0 0) (0.0 0 0.0 0) +(31.5338275 5 1.0 0) (12.5338274 37 0.0 0) (31.5338275 5 1.0 0) +(0.0 0 0.0 0) (10.5338274 37 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(5.5338274 66 0.0 0) (6.5338274 37 0.0 0) (0.0 0 0.0 0) (1.53382736 78 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0)) ((2.53382736 41 0.0 0) (86.0 0 11.0 0) +(0.0 0 0.0 0) (12.5338274 12 1.0 0) (3.53382736 37 0.0 0) (12.5338274 12 +1.0 0) (0.0 0 0.0 0) (12.5338274 37 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (6.5338274 66 0.0 0) (7.5338274 37 0.0 0) (0.0 0 0.0 0) +(1.53382736 78 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (83.0 0 +11.0 0) (0.0 0 0.0 0) (4.5338274 12 1.0 0) (1.0 0 1.0 50) (4.5338274 12 +1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 50) (1.0 0 1.0 50) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(2.53382736 31 1.0 0)) (25.0 6.0 11.0 0.0 0.0 1.0 0.0)) (LARRY ALLEN) |Larry| +153 10 6 161 NIL T 1.03382736 8.5945709 6.0 0.033827364 40.533828 NIL 108 78 +(A A 50) T NIL (1 0 1 0 0 1 0 1 0 1 1 0 1 1 1 1)) ((((0.0 0 0.0 0) +(3.5702502 7 0.0 0) (0.0 0 0.0 0) (1.0 0 2.0 7) (0.0 0 0.0 0) +(1.0 0 2.0 7) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (3.5702502 7 0.0 0) (0.0 0 +0.0 0) (1.0 0 1.0 15) (0.0 0 0.0 0) (1.0 0 1.0 15) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0)) ((0.0 0 +0.0 0) (3.5702502 7 0.0 0) (0.0 0 0.0 0) (1.0 0 2.0 9) (0.0 0 +0.0 0) (1.0 0 2.0 9) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (1.0 0 2.0 9)) (1.0 0.0 0.0 0.0 0.0 0.0 0.0)) (DAN TAPPAN) +|Dan| 170 1 2 15 NIL NIL 1.07025018 8.30208 5.0 0.070250183 4.5702502 NIL 20 +7 (7 15 9) T NIL (1 0 0)) ((((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) (0.0 0.0 0.0 +0.0 0.0 0.0 0.0)) (RICK MILLER) |Rick| 164 0 0 0 NIL NIL 1.0850702 +8.188689 6.0 0.085070205 0.58507021 NIL 4 0 (NIL NIL NIL) T NIL NIL) +((((0.0 0 0.0 0) (3.5807073 5 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (3.5807073 5 +0.0 0) (0.0 0 0.0 0) (1.58070727 5 0.0 0) (0.0 0 0.0 0) (1.58070727 5 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (3.5807073 5 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) (1.0 0.0 0.0 +0.0 0.0 0.0 0.0)) (ROB FRYE) |Rob| 158 1 1 14 NIL T 1.08070727 +8.2217478 6.0 0.080707266 3.5807073 NIL 16 5 (A A A) T NIL (0 1)) +((((1.0 0 1.0 0) (108.0 0 34.0 0) (0.0 0 0.0 0) (6.5305865 7 +1.0 0) (5.0 0 2.0 0) (6.5305865 7 1.0 0) (0.0 0 0.0 0) (4.0 0 +2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (2.5305865 9 +1.0 0) (0.0 0 0.0 0) (1.53058647 34 1.0 18) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) +((1.0 0 1.0 0) (72.0 0 34.0 0) (0.0 0 0.0 0) (3.5305865 7 1.0 0) +(3.0 0 2.0 0) (3.5305865 7 1.0 0) (0.0 0 0.0 0) (5.0 0 2.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (3.5305865 9 1.0 0) +(0.0 0 0.0 0) (1.53058647 34 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((0.0 0 +0.0 0) (75.0 0 34.0 0) (3.0 24 1.0 24) (10.0 0 5.0 0) (8.0 0 +4.0 0) (10.0 0 5.0 0) (0.0 0 0.0 0) (8.0 0 6.0 0) (5.0 12 2.0 8) +(0.0 0 0.0 0) (2.0 32 1.0 24) (4.0 25 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (4.0 25 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 2 0.0 0) (4.0 0 3.0 0)) (7.0 3.0 2.0 0.0 0.0 4.0 0.0)) (DAVE RED) |Dave| +156 4 0 71 NIL NIL 1.03058647 8.6215984 6.0 0.030586466 18.5305865 NIL 43 34 +(18 A 12) T NIL (1 1 1 1)) ((((0.0 0 0.0 0) (11.0 0 11.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (11.0 0 11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (11.0 0 11.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0)) +(2.0 0.0 0.0 0.0 0.0 0.0 0.0)) (AL WEGER) A/l 310 0 0 0 NIL NIL +1.28187819 6.9314718 6.0 0.28187819 1.78187819 NIL 4 0 (NIL NIL NIL) T NIL +NIL) ((((1.0 0 1.0 0) (35.0 0 34.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((1.0 0 1.0 0) (35.0 0 34.0 0) +(0.0 0 0.0 0) (1.0 0 3.0 0) (2.0 0 2.0 0) (1.0 0 3.0 0) (0.0 0 +0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) +(1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 3 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (35.0 0 34.0 0) (0.0 0 0.0 0) (4.0 0 6.0 0) (4.0 0 +4.0 0) (4.0 0 6.0 0) (0.0 0 0.0 0) (4.0 0 4.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 3 0.0 0) (2.0 0 4.0 0)) (2.0 1.0 1.0 0.0 0.0 4.0 0.0)) (STEPHEN WRIGHT) +|Stephen| 299 1 0 8 NIL NIL 1.11373001 7.97796816 6.0 0.113730013 +2.61373 NIL 9 0 (NIL B B) T NIL (1)) ((((0.0 0 0.0 0) (41.0 0 +11.0 0) (0.0 0 0.0 0) (1.11711437 6 4.0 0) (1.84 0 0.0 0) (0.84 6 +4.0 0) (0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (38.0 0 11.0 0) (0.0 0 0.0 0) +(3.0 0 1.0 0) (2.84 0 0.0 0) (3.0 0 1.0 0) (0.0 0 0.0 0) (2.84 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.84 0 0.0 0) (0.84 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) +(36.0 0 11.0 0) (0.0 0 0.0 0) (2.0 0 1.0 0) (0.84 0 0.0 0) (2.0 0 +1.0 0) (0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.0 0 1.0 0)) (5.0 1.0 0.0 1.0 0.0 1.0 0.0)) (SAM LEWIS) |Sam| 241 1 0 13 +NIL NIL 1.61711437 5.4945418 7.0 0.617114365 4.11711437 NIL 12 0 (B NIL NIL) +T NIL (1)) ((((0.0 0 0.0 0) (13.0 0 11.0 0) (0.0 0 0.0 0) (1.0 0 +1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (13.0 0 +11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (13.0 0 11.0 0) (1.0 0 1.0 9) (1.0 0 1.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 9) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0)) (2.0 0.0 0.0 0.0 1.0 0.0 +0.0)) (ROBERT ABRAMSON) |Robert| 227 1 0 7 NIL NIL 1.15710546 +7.67890465 6.0 0.15710546 3.65710548 NIL 11 0 (NIL NIL B) T NIL (1)) +((((0.0 0 0.0 0) (2.4922531 7 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (2.4922531 7 +0.0 0) (0.0 0 0.0 0) (1.4922531 7 0.0 0) (0.0 0 0.0 0) (1.4922531 7 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (2.4922531 7 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) (1.0 0.0 0.0 +0.0 0.0 0.0 0.0)) (DAVID SPEAR) |David| 176 1 0 7 NIL T 0.99225309 +8.9546736 6.0 -7.74691254E-3 1.4922531 NIL 10 7 (A A A) T NIL (1)) +((((6.0 709 0.0 0) (922.88124 6 0.0 0) (0.0 0 0.0 0) (89.88124 6 +1.0 720) (37.63674 290 0.0 0) (89.88124 6 1.0 720) (0.0 0 0.0 0) +(19.636739 290 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.91229226 795 +1.0 795) (31.6367395 290 1.0 660) (1.0 0 0.0 0) (18.6367393 364 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 3 0.0 0) (0.0 0 0.0 0)) ((1.0 720 0.0 0) (495.88123 6 0.0 0) +(0.0 0 0.0 0) (88.30895 119 0.0 -1) (37.549032 337 0.0 0) (88.30895 119 +0.0 -1) (0.0 0 0.0 0) (37.549032 337 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (1.91229226 720 0.0 0) (32.549032 337 0.0 0) (0.0 0 0.0 0) +(7.6367392 364 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 2 0.0 0) (0.0 3 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (553.88123 6 +0.0 0) (17.308948 247 0.0 0) (110.30894 69 3.3089479 623) (106.30894 75 +0.0 0) (110.30894 69 3.3089479 623) (8.308948 254 0.0 0) (106.30894 75 +0.0 0) (68.30895 112 0.0 0) (0.0 -1 0.0 0) (3.0 753 0.0 0) (53.3089485 88 +0.0 0) (0.0 0 0.0 0) (10.308948 254 0.0 0) (0.0 0 0.0 0) (70.30895 88 +1.0 796) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) (29.308948 225 +4.3089479 23)) (84.30895 35.63674 13.308948 1.11411278 0.0 32.3089485 +0.114112772)) (BRADFORD MILLER) |Bradford| 164 85 48 1179 NIL T +1.41229226 6.3116903 -4.0 0.41229226 278.0 NIL 841 753 (408 119 443) T 12 (1 +1 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0)) ((((0.0 0 0.0 0) +(437.78307 5 0.0 0) (0.0 0 0.0 0) (27.7830713 30 0.0 0) (1.0 0 +1.0 0) (27.7830713 30 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (235.78307 5 +0.0 0) (0.0 0 0.0 0) (33.7830715 5 0.0 0) (1.0 0 0.0 0) (33.7830715 5 +0.0 0) (0.0 0 0.0 0) (1.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (1.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (235.78307 5 0.0 0) (0.0 0 0.0 0) +(8.7830713 9 0.0 0) (3.78307113 174 0.0 0) (8.7830713 9 0.0 0) +(0.0 0 0.0 0) (3.78307113 174 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(2.78307113 133 0.0 0)) (26.0 1.0 3.0 0.0 0.0 2.0 0.0)) (SYNDI 2PHASE) +|Syndi| 0 4 17 412 NIL T 2.28307113 3.8918203 14.0 1.28307113 +55.0 NIL 207 174 (A A 176) T NIL (0)) ((((2.78307113 77 0.0 0) +(130.78307 5 0.0 0) (0.0 0 0.0 0) (21.7830713 14 0.0 0) (8.7830713 70 +0.0 0) (21.7830713 14 0.0 0) (0.0 0 0.0 0) (3.78307113 70 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (3.78307113 77 0.0 0) (6.7830712 70 +0.0 0) (1.0 0 0.0 0) (4.7830712 97 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((2.78307113 77 0.0 0) (92.78307 5 0.0 0) (0.0 0 0.0 0) (24.7830713 5 +0.0 0) (8.7830713 70 0.0 0) (24.7830713 5 0.0 0) (0.0 0 0.0 0) +(8.7830713 70 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (3.78307113 77 +0.0 0) (6.7830712 70 0.0 0) (1.0 0 1.0 0) (4.7830712 97 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (95.78307 5 0.0 0) (4.7830712 106 +0.0 0) (21.7830713 10 0.0 0) (15.7830713 38 0.0 0) (21.7830713 10 +0.0 0) (4.7830712 106 0.0 0) (15.7830713 38 0.0 0) (8.7830713 45 +0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (8.7830713 45 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (8.7830713 45 0.0 0) (0.0 2 +0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (8.7830713 35 0.0 0)) (17.0 +5.0 3.0 0.0 0.0 7.0 0.0)) (SYNDI 3PHASE) |Syndi| 0 17 9 177 NIL T +2.28307113 3.8918203 13.0 1.28307113 37.0 NIL 153 138 (82 149 A) T NIL (0)) +((((0.0 0 0.0 0) (79.0 0 79.0 0) (0.0 0 0.0 0) (7.0 0 7.0 0) +(3.0 0 3.0 0) (7.0 0 7.0 0) (0.0 0 0.0 0) (3.0 0 3.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (3.0 0 3.0 0) (1.0 0 1.0 0) +(1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((1.0 0 1.0 0) (79.0 0 79.0 0) +(0.0 0 0.0 0) (7.0 0 7.0 0) (3.0 0 3.0 0) (7.0 0 7.0 0) (0.0 0 +0.0 0) (3.0 0 3.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(3.0 0 3.0 0) (1.0 0 1.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (79.0 0 79.0 0) (0.0 0 0.0 0) (10.0 0 10.0 0) +(8.0 0 8.0 0) (10.0 0 10.0 0) (0.0 0 0.0 0) (8.0 0 8.0 0) (2.0 0 +2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (3.0 0 3.0 0)) (11.0 3.0 1.0 0.0 1.0 6.0 +1.0)) EXPERT NIL 0 0 0 0 NIL NIL 0.34 5000.0 4.0 0.0 1.0 T 1 1 (NIL NIL +NIL)) ((((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0)) (0.0 0.0 0.0 0.0 0.0 0.0 0.0)) SUPER NIL 0 0 0 0 +NIL NIL 0.34 5000.0 2.0 0.0 1.0 T 1 1 (NIL NIL NIL)) ((((5.7830713 0 +0.0 0) (352.78307 0 0.0 0) (0.0 0 0.0 0) (57.7830715 0 5.0 233) +(3.7830713 0 0.0 0) (57.7830715 0 5.0 233) (0.0 0 0.0 0) (1.78307128 427 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.7830712 427 1.0 0) (5.7830713 0 +8.0 265) (1.61307114 424 1.0 0) (1.78307113 423 5.0 229) (1.61307114 423 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) +(0.0 0 0.0 0)) ((2.78307113 0 0.0 0) (350.78307 0 0.0 0) (0.0 0 +0.0 0) (70.78307 0 0.0 0) (23.7830713 0 0.0 0) (70.78307 0 0.0 0) +(0.0 0 0.0 0) (23.7830713 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(2.7830712 264 0.0 0) (24.7830713 0 0.0 0) (2.78307113 0 0.0 0) +(2.78307113 0 0.0 0) (2.78307113 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) +(361.78307 0 0.0 0) (0.0 0 0.0 0) (51.7830715 0 0.0 0) (30.7830715 0 +0.0 0) (51.7830715 0 0.0 0) (7.7830712 0 0.0 0) (30.7830715 0 +0.0 0) (3.78307113 378 0.0 0) (0.0 0 0.0 0) (1.78307113 184 0.0 0) +(1.7830713 431 0.0 0) (1.0 0 0.0 0) (6.7830712 0 0.0 0) (0.0 0 +0.0 0) (6.7830713 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (30.7830715 0 0.0 0)) (65.0 28.0 11.0 1.0 0.0 21.0 0.0)) (SYNDI +BACK1) |Syndi| 0 24 22 723 NIL T 2.11307114 2.8973233 8.0 1.11307114 +154.0 NIL 435 398 (257 NIL 359)) ((((17.0 149 1.0 109) (829.0 3 +1.0 3) (0.0 0 0.0 0) (212.0 12 0.0 0) (90.0 73 1.0 59) (212.0 12 +0.0 0) (0.0 0 0.0 0) (58.0 73 2.0 59) (0.0 0 0.0 0) (0.0 0 0.0 0) +(23.0 163 1.0 109) (67.0 73 1.0 59) (1.0 0 0.0 0) (17.0 150 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 1 +0.0 0) (0.0 0 0.0 0)) ((7.0 149 0.0 0) (708.0 3 1.0 3) (0.0 0 +0.0 0) (214.0 12 1.0 9) (91.0 73 0.0 0) (214.0 12 1.0 9) (0.0 0 +0.0 0) (91.0 73 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (23.0 163 +0.0 0) (68.0 73 0.0 0) (0.0 0 0.0 0) (7.0 150 1.0 136) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (762.0 3 1.0 3) (13.0 134 1.0 134) +(149.0 15 2.0 4) (118.0 91 1.0 36) (149.0 15 2.0 4) (7.0 319 +0.0 0) (118.0 91 6.0 36) (86.0 99 6.0 36) (0.0 0 0.0 0) (13.0 227 +3.0 215) (76.0 110 4.0 295) (0.0 0 0.0 0) (5.0 290 0.0 0) (0.0 0 +0.0 0) (81.0 110 1.0 686) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 1 +0.0 0) (42.0 33 2.0 4)) (168.0 49.0 52.0 5.0 0.0 33.0 1.0)) (SYNDI LEARN) +|Syndi| 0 91 42 1557 NIL T 1.17 5.0 -16.0 0.17 343.84 0.0 1083 319 (3 3 3) T +NIL (1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 0 +1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 +1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0)) ((((1.0 0 1.0 0) (34.0 0 +34.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 +2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0)) ((1.0 0 1.0 0) (34.0 0 34.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (34.0 0 34.0 0) +(0.0 0 0.0 0) (5.0 0 5.0 0) (4.0 0 4.0 0) (5.0 0 5.0 0) (0.0 0 +0.0 0) (4.0 0 4.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (3.0 0 3.0 0)) +(2.0 1.0 1.0 0.0 0.0 4.0 0.0)) ADVANCED NIL 0 0 0 0 NIL NIL 0.34 +5000.0 4.0 0.0 1.0 T 1 1 (NIL NIL NIL)) ((((0.0 0 0.0 0) (35.0 0 +11.0 0) (0.0 0 0.0 0) (1.84 0 2.0 0) (1.84 0 0.0 0) (1.84 0 2.0 0) +(0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (33.0 0 11.0 0) (0.0 0 0.0 0) (3.0 0 1.0 0) +(2.84 0 0.0 0) (3.0 0 1.0 0) (0.0 0 0.0 0) (2.84 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (1.84 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (31.0 0 11.0 0) +(0.0 0 0.0 0) (2.0 0 1.0 0) (0.84 0 0.0 0) (2.0 0 1.0 0) (0.0 0 +0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0)) +(4.0 1.0 0.0 1.0 0.0 1.0 0.0)) MODERATE NIL 0 0 0 0 NIL NIL 0.34 +5000.0 4.0 0.0 1.0 T 1 1 (NIL NIL NIL)) ((((0.0 0 0.0 0) (11.0 0 +11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (11.0 0 11.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (11.0 0 11.0 0) +(0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0)) +(2.0 0.0 0.0 0.0 0.0 0.0 0.0)) AMATEUR NIL 0 0 0 0 NIL NIL 0.34 +5000.0 4.0 0.0 1.0 T 1 1 (NIL NIL NIL)) ((((0.0 0 0.0 0) (0.84 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.84 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +(0.0 0.0 0.0 0.0 0.0 0.0 0.0)) NOVICE NIL 0 0 0 0 NIL NIL 0.34 +5000.0 4.0 0.0 0.0 NIL 0 0 (NIL NIL NIL)) ((((0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +(0.0 0.0 0.0 0.0 0.0 0.0 0.0)) BEGINNER NIL 0 0 0 0 NIL NIL 0.34 +5000.0 4.0 0.0 0.0 NIL 1 1 (NIL NIL NIL)) ((((6.7830712 137 0.0 0) +(386.78307 5 0.0 0) (0.0 0 0.0 0) (79.78307 10 0.0 0) (27.7830713 88 +0.0 0) (79.78307 10 0.0 0) (0.0 0 0.0 0) (22.7830713 88 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (8.7830713 190 0.0 0) (18.7830713 88 +0.0 0) (3.78307113 93 0.0 0) (5.7830712 88 0.0 0) (2.78307113 290 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0)) ((2.78307113 137 0.0 0) (278.78307 5 0.0 0) (0.0 0 +0.0 0) (80.78307 5 0.0 0) (27.7830713 88 0.0 0) (80.78307 5 0.0 0) +(0.0 0 0.0 0) (27.7830713 88 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(8.7830713 190 0.0 0) (18.7830713 88 0.0 0) (2.78307113 93 0.0 0) +(3.78307113 88 0.0 0) (2.78307113 290 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) +(305.78307 5 0.0 0) (4.7830712 178 0.0 0) (100.78307 8 0.0 0) +(62.7830715 21 0.0 0) (100.78307 8 0.0 0) (9.7830712 22 0.0 0) +(62.7830715 21 0.0 0) (31.7830713 31 0.0 0) (0.0 0 0.0 0) (4.7830712 31 +0.0 0) (24.7830713 22 0.0 0) (0.0 0 0.0 0) (7.7830712 172 0.0 0) +(0.0 0 0.0 0) (25.7830713 22 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (29.7830713 11 0.0 0)) (84.0 22.0 12.0 0.0 0.0 +30.0 0.0)) (SYNDI SUPER2) |Syndi| 0 26 12 587 NIL T 2.28307113 +3.8918203 6.0 1.28307113 144.0 NIL 372 324 (A A A) T NIL (0)) +((((8.7830713 137 0.0 0) (437.78307 5 0.0 0) (0.0 0 0.0 0) (93.78307 10 +1.0 67) (27.7830713 88 0.0 0) (93.78307 10 1.0 67) (0.0 0 0.0 0) +(22.7830713 88 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (8.7830713 190 +0.0 0) (18.7830713 88 0.0 0) (2.78307113 93 0.0 0) (6.7830712 88 +0.0 0) (1.34 72 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 1 0.0 0) (0.0 0 0.0 0)) ((2.78307113 137 0.0 0) (328.78307 5 +0.0 0) (0.0 0 0.0 0) (95.78307 5 0.0 0) (28.7830713 88 0.0 0) +(95.78307 5 0.0 0) (0.0 0 0.0 0) (28.7830713 88 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (7.7830713 190 0.0 0) (20.7830713 88 0.0 0) +(2.78307113 93 0.0 0) (3.78307113 88 0.0 0) (2.78307113 290 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (359.78307 5 0.0 0) (4.7830712 178 0.0 0) +(112.78307 8 0.0 0) (65.78307 21 0.0 0) (112.78307 8 0.0 0) +(9.7830712 22 0.0 0) (65.78307 21 0.0 0) (34.7830715 31 0.0 0) +(0.0 0 0.0 0) (4.7830712 31 0.0 0) (24.7830713 22 0.0 0) (0.0 0 +0.0 0) (9.7830713 172 1.0 72) (0.0 0 0.0 0) (26.7830713 22 0.0 0) +(0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (34.7830715 11 0.0 0)) +(98.0 24.0 16.0 0.0 0.0 30.0 0.0)) (SYNDI BACK3) |Syndi| 0 6 1 121 NIL T +1.84 5.0 0.0 0.84 40.34 0.0 75 0 (B NIL B) T NIL (0 1 1 1 1 1 1)) +((((3.0 15 1.0 0) (136.0 0 34.0 0) (0.0 0 0.0 0) (19.663026 8 +2.0 0) (5.0 0 3.0 0) (23.663026 8 2.0 0) (0.0 0 0.0 0) (3.0 113 +3.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 3.0 0) (4.0 113 1.0 0) +(0.0 0 0.0 0) (1.0 130 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) (0.0 0 0.0 0)) ((2.0 15 1.0 0) +(132.0 0 34.0 0) (0.0 0 0.0 0) (14.0 7 2.0 0) (5.0 0 2.0 0) +(14.0 7 2.0 0) (0.0 0 0.0 0) (8.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (3.0 0 3.0 0) (6.0 13 1.0 0) (0.0 0 0.0 0) (1.0 130 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 +0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (136.0 0 34.0 0) (2.0 116 +0.0 0) (13.0 0 6.0 0) (11.0 0 4.0 0) (13.0 0 6.0 0) (1.0 113 +0.0 0) (11.0 0 6.0 0) (8.0 24 2.0 10) (0.0 0 0.0 0) (1.0 113 +0.0 0) (7.0 24 1.0 19) (0.0 0 0.0 0) (1.0 113 1.0 0) (0.0 0 0.0 0) +(8.0 42 3.0 48) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (4.0 113 +4.0 0)) (24.0 6.0 6.0 0.0 1.0 4.0 1.0)) (THADDEUS BEIER) |Thaddeus| 172 12 11 +234 NIL T 0.9930258 7.6398154 -6.0 -6.9742054E-3 56.663026 NIL 160 130 (37 7 +24) T NIL (0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 1)) +((((0.84 0 0.0 0) (120.0 0 79.0 0) (0.0 0 0.0 0) (3.0 0 11.0 0) +(3.0 0 3.0 0) (3.0 0 11.0 0) (0.0 0 0.0 0) (3.0 0 3.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 0) (3.0 0 3.0 0) (1.0 0 1.0 0) +(1.0 0 1.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 +0.0 0) (0.0 3 0.0 0) (0.0 0 0.0 0)) ((1.0 0 1.0 0) (112.0 0 79.0 0) +(0.0 0 0.0 0) (0.34 128 16.0 0) (2.0 0 3.0 0) (0.0 128 16.0 0) +(0.0 0 0.0 0) (2.0 0 3.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 +1.0 0) (2.0 0 3.0 0) (1.0 0 1.0 0) (0.0 67 1.0 0) (0.34 67 1.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 3 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (113.0 0 79.0 0) (0.0 0 0.0 0) (0.34 13 +24.0 0) (3.0 0 3.0 0) (0.34 13 24.0 0) (0.0 0 0.0 0) (3.0 0 3.0 0) +(2.0 0 2.0 0) (1.0 0 0.0 0) (0.0 0 0.0 0) (0.0 80 2.0 0) (0.0 80 +1.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 80 2.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 13 17.0 0)) (11.0 3.0 2.0 0.0 +1.0 6.0 1.0)) (SYNDI BACK2) |Syndi| 0 16 15 104 NIL T 0.84 5.0 +-4.5 0.0 1.34 5.5 178 168 (B B B) T NIL (0)) ((((2.0 67 1.0 0) +(131.0 0 34.0 0) (0.0 0 0.0 0) (17.5850704 9 2.0 0) (6.0 0 2.0 0) +(17.5850704 9 2.0 0) (0.0 0 0.0 0) (5.0 0 2.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (2.0 0 2.0 0) (4.0 64 1.0 0) (1.0 0 0.0 0) (1.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 3 0.0 0) (0.0 0 0.0 0)) ((5.0 67 1.0 0) (98.0 0 34.0 0) +(0.0 0 0.0 0) (11.5850703 13 1.0 0) (3.0 0 2.0 0) (11.5850703 13 +1.0 0) (0.0 0 0.0 0) (6.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(2.0 0 2.0 0) (5.0 64 1.0 0) (1.0 0 1.0 107) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(0.0 0 0.0 0)) ((0.0 0 0.0 0) (107.0 0 34.0 0) (2.5850702 18 +0.0 0) (15.0 0 5.0 0) (15.0 0 4.0 0) (15.0 0 5.0 0) (0.0 0 0.0 0) +(15.0 0 4.0 0) (10.5850703 17 0.0 0) (0.0 0 0.0 0) (1.0 0 0.0 0) +(8.5850703 17 0.0 0) (0.0 0 0.0 0) (2.0 120 0.0 0) (0.0 0 0.0 0) +(10.5850703 17 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) +(7.0 0 3.0 0)) (21.0 4.0 3.0 0.0 0.0 5.0 1.0)) (DAN DOAN) |Dan| 150 10 10 177 +NIL T 1.0850702 8.188689 3.0 0.085070204 41.585071 NIL 128 120 (25 107 25) T +NIL (0 1 1 0 0 1 1 0 1 0 1)) ((((1.62004 22 1.0 0) (65.0 0 34.0 0) +(0.0 0 0.0 0) (7.62004 11 2.0 0) (2.0 0 2.0 0) (7.62004 11 2.0 0) +(0.0 0 0.0 0) (2.0 0 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 +2.0 0) (1.0 0 1.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 3 0.0 0) (0.0 0 +0.0 0)) ((2.62004 22 1.0 0) (61.0 0 34.0 0) (0.0 0 0.0 0) (5.62004 13 +1.0 0) (2.0 0 2.0 0) (5.62004 13 1.0 0) (0.0 0 0.0 0) (2.0 0 +2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (2.0 0 2.0 0) (1.0 0 1.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 +0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) +(66.0 0 34.0 0) (1.0 0 1.0 72) (15.0 0 6.0 0) (10.0 0 4.0 0) +(15.0 0 6.0 0) (1.62004 33 0.0 0) (10.0 0 5.0 0) (6.0 16 1.0 11) +(0.0 0 0.0 0) (1.62004 33 0.0 0) (3.62004 33 0.0 0) (0.0 0 0.0 0) +(1.0 0 0.0 0) (0.0 0 0.0 0) (4.62004 33 0.0 0) (0.0 2 0.0 0) +(0.0 1 0.0 0) (0.0 3 0.0 0) (9.0 0 4.0 0)) (11.0 2.0 4.0 1.0 +0.0 5.0 0.0)) (MIKE PATTON) |Mike| 152 5 4 86 NIL T 1.12004 7.9330224 +5.0 0.120040014 16.62004 NIL 74 33 (37 A 16) T NIL (1 1 0 1 0 1 0 0 1)) +((((0.0 0 0.0 0) (124.0 0 11.0 0) (0.0 0 0.0 0) (19.5850704 16 +2.0 0) (1.5850702 72 1.0 21) (19.5850704 16 2.0 0) (0.0 0 0.0 0) +(1.5850702 72 1.0 21) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.5850702 72 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (70.0 0 11.0 0) (0.0 0 0.0 0) (10.5850703 7 +1.0 0) (1.5850702 72 0.0 0) (10.5850703 7 1.0 0) (0.0 0 0.0 0) +(1.5850702 72 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(1.5850702 72 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (69.0 0 11.0 0) (0.0 0 0.0 0) (3.0 56 +2.0 0) (0.0 0 0.0 0) (3.0 56 2.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 1 0.0 0) (0.0 0 0.0 0) (1.0 0 2.0 0)) (21.0 1.0 1.0 0.0 +0.0 0.0 0.0)) (CHRIS HIBBERT) |Chris| 314 7 2 138 NIL T 1.0850702 +8.188689 6.0 0.085070204 31.5850704 NIL 91 72 (B A 21) T NIL (1 1 1 1 1 0 1 0 +1)) ((((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +((0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0)) (0.0 0.0 0.0 0.0 0.0 0.0 0.0)) (RON SPAINHOUR) +|Ron| 328 0 0 0 NIL NIL 1.14516084 7.75899965 6.0 0.145160839 +0.0 NIL 4 0 (NIL NIL NIL) T NIL NIL) ((((0.0 0 0.0 0) (0.84 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (0.84 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (0.84 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0)) +(0.0 0.0 0.0 0.0 0.0 0.0 0.0)) (KENT PITMAN) |Kent| 115 0 0 0 NIL NIL +1.06623666 8.3333305 6.0 0.06623666 1.56623666 NIL 4 0 (NIL NIL NIL) T NIL +NIL) ((((0.0 0 0.0 0) (8.6299207 5 0.0 0) (0.0 0 0.0 0) (1.0 0 +1.0 16) (0.0 0 0.0 0) (1.0 0 1.0 16) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 2 0.0 0) +(0.0 2 0.0 0) (0.0 1 0.0 0) (0.0 0 0.0 0)) ((0.0 0 0.0 0) (8.6299207 5 +0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 12) (0.0 0 0.0 0) (1.0 0 1.0 12) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 2 0.0 0) (0.0 0 0.0 0) (0.0 1 0.0 0) (0.0 0 +0.0 0)) ((0.0 0 0.0 0) (8.6299207 5 0.0 0) (0.0 0 0.0 0) (1.0 0 +2.0 18) (0.0 0 0.0 0) (1.0 0 2.0 18) (0.0 0 0.0 0) (0.0 0 0.0 0) +(0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (0.0 0 +0.0 0) (0.0 0 0.0 0) (0.0 0 0.0 0) (1.0 0 1.0 18) (0.0 2 0.0 0) +(0.0 0 0.0 0) (0.0 1 0.0 0) (1.0 0 2.0 18)) (1.0 0.0 0.0 0.0 +1.0 0.0 0.0)) (JOHN HENGEVELD) |John| 129 3 1 27 NIL T 1.12992072 +7.8636513 6.0 0.129920721 8.6299207 NIL 31 5 (16 12 18) T NIL (1 1 0 1))) \ No newline at end of file diff --git a/src/games/word.3 b/src/games/word.3 new file mode 100644 index 00000000..c279e466 --- /dev/null +++ b/src/games/word.3 @@ -0,0 +1,151 @@ +;;; -*- LISP -*- +;;; +;;; Library WRDLIB +;;; +;;; This file contains useful functions for manipulating atoms +;;; conceptually as text ('letters' and 'words') in MacLISP. +;;; +;;; Functions defined are: +;;; +;;; Ascii/Numeric Conversions +;;; +;;; CVTN - Convert to Numeric +;;; CVTA - Convert to Ascii +;;; +;;; Upper/Lower Case Conversions +;;; +;;; Name Input Output +;;; ---- ----- ------ +;;; CAPS Generic Same as input, Capitalized +;;; SMALLS Generic Same as input, Lowercasified +;;; CAPS-A2A Ascii Capitalized Ascii +;;; SMALLS-A2A Ascii Lowercasified Ascii +;;; CAPS-A2N Ascii Capitalized Numeric +;;; SMALLS-A2N Ascii Lowercasified Numeric +;;; CAPS-N2A Numeric Capitalized Ascii +;;; SMALLS-N2A Numeric Lowercasified Ascii +;;; CAPS-N2N Numeric Capitalized Numeric +;;; SMALLS-N2N Numeric Lowercasified Numeric +;;; +;;; Typing Predicates +;;; +;;; CONTROL? - Returns T if arg is control char +;;; ALPHABETIC? - Returns T if arg is an alphabetic char +;;; DIGIT? - Returns T if arg is a digital char +;;; +;;; Word Operations +;;; +;;; UPPERCASIFY - Convert a word to all upper case +;;; LOWERCASIFY - Convert a word to all lower case +;;; CAPITALIZE - Convert a word to all lower case except first char +;;; +;;; BUILD - Merge several atoms into a single atom +;;; + +;;;;;;;;;;;;;;;;;;;;;;;;; Numeric/Ascii Conversion ;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; CVTN: Convert to Numeric (from Ascii) + +(DEFUN CVTN (X) (GETCHARN X 1.)) + +;;; CVTA: Convert to Ascii (from Numeric) + +(DEFUN CVTA (X) (ASCII X)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Case Conversion ;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Generic Functions + +(DEFUN SMALLS (X) + (COND ((NUMBERP X) (SMALLS-N2N X)) + (T (SMALLS-A2A X)))) + +(DEFUN CAPS (X) + (COND ((NUMBERP X) (CAPS-N2N X)) + (T (CAPS-A2A X)))) + +;;; Specialized Functions + +(DEFUN CAPS-A2A (X) (CVTA (CAPS-N2N (CVTN X)))) + +(DEFUN SMALLS-A2A (X) (CVTA (SMALLS-N2N (CVTN X)))) + +(DEFUN CAPS-A2N (X) (CAPS-N2N (CVTN X))) + +(DEFUN SMALLS-A2N (X) (SMALLS-N2N (CVTN X))) + +(DEFUN CAPS-N2A (X) (CVTA (CAPS-N2N X))) + +(DEFUN SMALLS-N2A (X) (CVTA (SMALLS-N2N X))) + +(DEFUN CAPS-N2N (X) + (COND ((AND (> X 96.) (< X 123.)) (- X 32.)) + (T X))) + +(DEFUN SMALLS-N2N (X) + (COND ((AND (> X 64.) (< X 91.)) (+ X 32.)) + (T X))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Character Type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; CONTROL? +;;; Predicate returns T if arg represents a control-character. Accepts +;;; string or numeric arg. Control-chars are defined here as any char +;;; with an ascii value lower than a SPACE. + +(DEFUN CONTROL? (C) + (COND ((NUMBERP C) (< C 32.)) + (T (CONTROL? (GETCHARN C 1.))))) + +;;; ALPHABETIC? +;;; Predicate returns T if arg represents an alpha character. Accepts +;;; string or numeric arg. + +(DEFUN ALPHABETIC? (C) + (COND ((NUMBERP C) + (OR + (AND (> C 64.) (< C 91.)) ; A <= C <= Z + (AND (> C 96.) (< C 123.)))) + (T (ALPHABETIC? (GETCHARN C 1.))))) + +;;; DIGIT? +;;; Predicate returns T if arg represents a digital character. Accepts +;;; string or numeric arg. + +(DEFUN DIGIT? (N) + (COND ((NUMBERP N) (AND (> N 47.) (< N 58.))) ; 0 <= N <= 9 + (T (DIGIT? (GETCHARN N 1.))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Word Commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; UPPERCASIFY +;;; Uppercasify a word. (put all letters in upper case) + +(DEFUN UPPERCASIFY (X) (IMPLODE (MAPCAR 'CAPS (EXPLODEC X)))) + +;;; LOWERCASIFY +;;; Lowercasify a word. (put all letters in lower case) + +(DEFUN LOWERCASIFY (X) (IMPLODE (MAPCAR 'SMALLS (EXPLODEC X)))) + +;;; CAPITALIZE +;;; Capitalize a word. (put first char in upper case, all others +;;; in lower case) + +(DEFUN CAPITALIZE (X) + ((LAMBDA (CHARS) + (IMPLODE (CONS (CAPS (CAR CHARS)) + (MAPCAR 'SMALLS (CDR CHARS))))) + (EXPLODEC X))) + +;;; BUILD +;;; Takes an arbitrary number of arguments. Returns an atom that has +;;; the same printname as all of the args pushed together. + +(DEFUN BUILD N (IMPLODE (APPLY 'APPEND (MAPCAR 'EXPLODEN (LISTIFY N))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Tag the library as having been loaded once successfully + +(PUTPROP 'WRDLIB T 'LOADED) diff --git a/src/games/words.50 b/src/games/words.50 new file mode 100644 index 00000000..f2635b9a --- /dev/null +++ b/src/games/words.50 @@ -0,0 +1,1463 @@ +;;; -*- LISP -*- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; ;;;;; +;;;;; THIS FILE CONTAINS A DICTIONARY OF WORDS ;;;;; +;;;;; FOR USE IN KMP'S NATURAL LANGUAGE HACKS. ;;;;; +;;;;; ;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ALLOC '(LIST 130000.)) +(ALLOC '(SYMBOL 40000.)) + +;;; The following functions can be used to access the data +;;; defined in this file. Note that in most cases the same +;;; function names without a "?" on the end are used for +;;; defining the response that the ?'d verb should return +;;; in most cases. + +(DEFUN EXPLODED (X) + (OR (GET X 'EXPLODED) (PUTPROP X (EXPLODEC X) 'EXPLODED))) + +(DEFUN VERB-PLURAL? (X) + (OR (CAR (GET X 'VERB-FORMS)) X)) + +(DEFUN VERB-SING? (X) + (OR (CADR (GET X 'VERB-FORMS)) + (VERB-SING NIL X))) + +(DEFUN VERB-PAST? (X) + (OR (CADDR (GET X 'VERB-FORMS)) + (VERB-PAST NIL X))) + +(DEFUN VERB-PP? (X) + (OR (CADDDR (GET X 'VERB-FORMS)) + (VERB-PP NIL X))) + +(DEFUN VERB-PROG? (X) + (OR (CAR (CDDDDR (GET X 'VERB-FORMS))) + (VERB-PROG NIL X))) + +;;; These two functions are nice for drawing inferences about nouns +;;; since singular nouns have roughly the same formation rules as +;;; plural verbs and vice versa. + +(DEFUN NOUN-PLURAL? (X) (VERB-SING? X)) + +(DEFUN NOUN-SING? (X) (VERB-PLURAL? X)) + + +(DEFUN IS-A? (TYPE WORD) (AND (MEMQ TYPE (GET WORD 'PART-OF-SPEECH)) T)) + +(DEFUN PART-OF-SPEECH (WORD TYPE) + (COND ((NOT (IS-A? WORD TYPE)) + (PUTPROP WORD + (CONS TYPE (GET WORD 'PART-OF-SPEECH)) + 'PART-OF-SPEECH))) + TYPE) + +(DEFUN PART-OF-SPEECH? (X) (OR (GET X 'PART-OF-SPEECH) '*NOUN*)) + +;;; Letters + +(DEFUN VOWEL? (X) (MEMQ X '(A E I O U))) +(DEFUN CONSONANT? (X) (NOT (VOWEL? X))) + +;;; Names + +(DEFUN FEMALE-NAME? (X) (IS-A? 'FEMALE-NAME X)) +(DEFUN MALE-NAME? (X) (IS-A? 'MALE-NAME X)) +(DEFUN PERSON-NAME? (X) (OR (MALE-NAME? X) + (FEMALE-NAME? X) + (IS-A? 'PERSON-NAME X))) + +;;; Note: for compatibility, +;;; these should get updated for dictionary lookup + +(DEFUN FEMALE-PRONOUN? (X) (MEMQ X '(SHE HER))) +(DEFUN MALE-PRONOUN? (X) (MEMQ X '(HE HIM))) +(DEFUN PLURAL-PRONOUN? (X) (MEMQ X '(THEY THEM))) +(DEFUN 1ST-PERSON-PLURAL-PRONOUN? (X) (MEMQ X '(WE US))) +(DEFUN 3RD-PERSON-PLURAL-PRONOUN? (X) (MEMQ X '(THEY THEM))) + +;;; +;;; Software for inferring what 'he', 'she', etc. mean +;;; + +(DEFUN CLEAR-DEFAULT-NAMES () (SETPLIST 'DEFAULT-NAMES NIL)) + +(CLEAR-DEFAULT-NAMES) + +(DEFUN DEFAULT-NAME (TYPE) (GET 'DEFAULT-NAMES TYPE)) + +(DEFUN SET-DEFAULT-NAME (NAME TYPE) + (COND ((EQ TYPE 'PLURAL) + (PUTPROP 'DEFAULT-NAMES + ((LAMBDA (DEFAULT) + (COND ((MEMQ NAME DEFAULT) DEFAULT) + (T (APPEND DEFAULT (LIST NAME))))) + (GET 'DEFAULT-NAMES 'PLURAL)) + 'PLURAL)) + (T + (PUTPROP 'DEFAULT-NAMES NAME TYPE) + (SET-DEFAULT-NAME NAME 'PLURAL))) + NAME) + + + +(DEFUN DETERMINER? (WORD) (IS-A? 'DETERMINER WORD)) +(DEFUN ADJECTIVE? (WORD) + (OR (IS-A? 'ADJECTIVE WORD) + (POSSESSIVE? WORD))) +(DEFUN COMPARATIVE-ADJECTIVE? (WORD) (IS-A? 'COMPARATIVE-ADJECTIVE WORD)) +(DEFUN MODAL? (WORD) (IS-A? 'MODAL WORD)) +(DEFUN HELPING-VERB? (WORD) (IS-A? 'HELPING-VERB WORD)) +(DEFUN AUXILIARY-VERB? (WORD) (HELPING-VERB? WORD)) +(DEFUN VERB? (WORD) + (OR (IS-A? 'MODAL WORD) + (IS-A? 'HELPING-VERB WORD) + (IS-A? 'ACTION-VERB WORD))) +(DEFUN COMMON-NOUN? (WORD) (IS-A? 'COMMON-NOUN WORD)) +(DEFUN PREPOSITION? (WORD) (IS-A? 'PREPOSITION WORD)) +(DEFUN PRONOUN? (WORD) (IS-A? 'PRONOUN WORD)) +(DEFUN CONJUNCTION? (WORD) (IS-A? 'CONJUNCTION WORD)) +(DEFUN INTERJECTION? (WORD) (IS-A? 'INTERJECTION WORD)) +(DEFUN ADVERB? (WORD) (IS-A? 'ADVERB WORD)) +(DEFUN COMPARATOR? (WORD) (IS-A? 'COMPARATOR WORD)) +(DEFUN MODIFIER? (WORD) + (OR (ADVERB? WORD) (ADJECTIVE? WORD) (DETERMINER? WORD))) +(DEFUN MATCH? (WORD) (IS-A? 'MATCH WORD)) +(DEFUN NOUN? (WORD) + (OR (COMMON-NOUN? WORD) + (PRONOUN? WORD) + (PERSON-NAME? WORD) + (NULL (GET WORD 'PART-OF-SPEECH)))) + +;;; MATCHFIX? +;;; If the arg has a MATCHFIX property, returns it, else returns NIL. + +(DEFUN MATCHFIX? (X) (GET X 'MATCHFIX)) + +;;; MATCHDECLARE +;;; Assigns a set of possible matches to a matchfix operators. + +(DEFUN MATCHDECLARE (LEFT MATCHES) + (PUTPROP LEFT MATCHES 'MATCHFIX) + (DEFINE 'MATCH (NCONS LEFT)) + (DEFINE 'MATCH MATCHES)) + + +;;; DEFINE +;;; Defines a list of words to be a particular part of speech +;;; by pushing the type onto the front of its PART-OF-SPEECH +;;; property. + +(DEFUN DEFINE (PART WORD-LIST) + (MAPC + (FUNCTION (LAMBDA (WORD) (PART-OF-SPEECH WORD PART))) + WORD-LIST) + PART) + +;;; VERB-DEFINE +;;; Takes an arg of a single verb and its variations. If the +;;; variations are regular, they may be omitted. Certain common +;;; exception rules are also known. Puts a verb definition on +;;; a verb and its forms and properties pointing back to the main +;;; verb form. +;;; +;;; Syntax: (VERB-DEFINE ) +;;; +;;; :: ( +;;; +;;; +;;; +;;; ) +;;; +;;; Example: +;;; (VERB-DEFINE '(EAT EATS ATE EATEN EATING)) +;;; + +(DEFUN VERB-DEFINE (X) + (PROG () + (COND ((ATOM X) (BREAK BAD-ARG-TO-"VERB-DEFINE"))) + (COND ((GET (CAR X) 'VERB-FORMS) (RETURN T))) + (SETQ X + (DO ((V (CDR X) (CDR V)) + (V$ (CAR X)) + (I 1 (1+ I)) + (L (NCONS (CAR X))) + (A NIL NIL)) + ((> I 4.) (NREVERSE L)) + (SETQ A (CAR V)) + (COND ((= I 1.) (SETQ L (CONS (VERB-SING A V$) L))) + ((= I 2.) (SETQ L (CONS (VERB-PAST A V$) L))) + ((= I 3.) (SETQ L (CONS (VERB-PP A V$) L))) + ((= I 4.) (SETQ L (CONS (VERB-PROG A V$) L)))))) + (MAPCAR (FUNCTION (LAMBDA (A) + (PART-OF-SPEECH A 'ACTION-VERB) + (PUTPROP A X 'VERB-FORMS))) + X) + (RETURN (CAR X)))) + +;;; VERB-FORM +;;; For more convenience of syntax in defining large numbers of verb +;;; forms simultaneouly without quoting them. + +(DEFUN VERB-FORM FEXPR (VERBS) + (MAPC 'VERB-DEFINE VERBS) + '-*-VERB-FORMS-*-) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;; DICTIONARY/INFERENCING ;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; VERB-SING +;;; Define the singular form of an infinitive verb X. If the first arg +;;; is non-null, it will be used. If the first arg is null, this routine +;;; will infer a probable singular form. +;;; +;;; The following rules are used: +;;; +;;; [1] If the word ends in +Y then change the Y +;;; to I and add ES. +;;; [2] If the word ends in <[C,S,T]>+H or X then add ES. +;;; [3] Else add an S. + +(DEFUN VERB-SING (A X) + (PROG (TEMP) + (COND (A (RETURN A))) + (SETQ TEMP (NREVERSE (EXPLODEC X))) + (COND ((AND (EQ (CAR TEMP) 'Y) + (NOT (VOWEL? (CADR TEMP)))) + (RETURN + (IMPLODE + (NREVERSE (CONS 'S (CONS 'E (CONS 'I (CDR TEMP)))))))) + ((OR (AND (EQ (CAR TEMP) 'H) (MEMQ (CADR TEMP) '(T S C))) + (EQ (CAR TEMP) 'X)) + (RETURN (IMPLODE (NREVERSE (CONS 'S (CONS 'E TEMP)))))) + (T (RETURN (IMPLODE (NREVERSE (CONS 'S TEMP)))))))) + +;;; VERB-PAST +;;; Return the past tense form of an infinitive verb X. If the first arg +;;; is non-null, it will be used. If the first arg is null, this routine +;;; will infer a probable past tense form. +;;; +;;; The following rules are used: +;;; +;;; [1] If the word ends in E, add a D. +;;; [2] If the word ends in +Y, change Y to I and add ED. +;;; [3] If the word ends in [W,X,Y], add ED. +;;; [4] If the word ends in some other consonant preceded by +;;; a single vowel, double final consonant and add ED. +;;; [4] Else add ED. + +(DEFUN VERB-PAST (A X) + (PROG (TEMP) + (COND (A (RETURN A))) + (SETQ TEMP (NREVERSE (EXPLODEC X))) + (COND ((EQ (CAR TEMP) 'E) + (RETURN + (IMPLODE + (NREVERSE (CONS 'D TEMP))))) + ((AND (EQ (CAR TEMP) 'Y) + (NOT (VOWEL? (CADR TEMP)))) + (RETURN + (IMPLODE + (NREVERSE (CONS 'D (CONS 'E (CONS 'I (CDR TEMP)))))))) + ((MEMQ (CAR TEMP) '(X Y W)) + (RETURN + (IMPLODE + (NREVERSE (CONS 'D (CONS 'E TEMP)))))) + ((AND (CONSONANT? (CAR TEMP)) + (VOWEL? (CADR TEMP)) + (CONSONANT? (CADDR TEMP))) + (RETURN + (IMPLODE + (NREVERSE (CONS 'D (CONS 'E (CONS (CAR TEMP) TEMP))))))) + (T (RETURN + (IMPLODE + (NREVERSE (CONS 'D (CONS 'E TEMP))))))))) + +;;; VERB-PP +;;; This function returns the past-participle for a verb. Currently it uses +;;; the same rules as the past tense inferencing function above. + +(DEFUN VERB-PP (A X) (VERB-PAST A X)) + + +;;; VERB-PROG +;;; Return the present progressive form of an infinitive verb X. +;;; If the first arg is non-null, it will be used. If the first +;;; arg is null, this routine will infer a probable past tense form. +;;; +;;; The following rules are used: +;;; +;;; [1] If the last letter is an E, drop it and add ING. +;;; [2] If the last letter is [W,X,Y] add an ING. +;;; [3] If the word ends in a consonant preceded by +;;; a single vowel, double the final consonant and +;;; add ING. +;;; [4] Else add ING. + +(DEFUN VERB-PROG (A X) + (PROG (TEMP) + (COND (A (RETURN A))) + (SETQ TEMP (NREVERSE (EXPLODEC X))) + (COND ((EQ (CAR TEMP) 'E) + (RETURN + (IMPLODE + (NREVERSE (CONS 'G (CONS 'N (CONS 'I (CDR TEMP)))))))) + ((MEMQ (CAR TEMP) '(W X Y)) + (RETURN + (IMPLODE + (NREVERSE + (CONS 'G (CONS 'N (CONS 'I TEMP))))))) + ((AND (CONSONANT? (CAR TEMP)) + (VOWEL? (CADR TEMP)) + (CONSONANT? (CADDR TEMP))) + (RETURN + (IMPLODE + (NREVERSE + (CONS 'G (CONS 'N (CONS 'I (CONS (CAR TEMP) TEMP)))))))) + (T (RETURN + (IMPLODE + (NREVERSE (CONS 'G (CONS 'N (CONS 'I TEMP)))))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adjectives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(DEFINE 'ADJECTIVE '(ONE TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE TEN + TWENTY THIRTY FORTY FIFTY HUNDRED THOUSAND MILLION + EACH EVERY ALL SOME + BIG SMALL TINY HUGE ENORMOUS LARGE + HEAVY DARK LIGHT COLORED SHINY DULL + RED ORANGE YELLOW GREEN BLUE INDIGO VIOLET PURPLE + BLACK BROWN GOLD SILVER WHITE GREY GRAY + STRIPED SPOTTED HORNED WINGED + SMOOTH ROUGH HARD SOFT + WET DRY OILY + LOUD QUIET STRONG WEAK + LINKED RELATED SIMILAR SIMILAR ASSOCIATED + GOOD TAME DOCILE DOMESTIC + ANGRY MAD SAD HAPPY PARANOID DEPRESSED + UPSET GLAD UNFORTUNATE FORTUNATE + HUNGRY + SMART STUPID DUMB + CRAZY STRANGE + FAST SLOW + OLD NEW + BAD EVIL MEAN CRUEL DANGEROUS + UGLY PRETTY BEAUTIFUL + REAL LIVE DEAD)) + +(DEFINE 'COMPARATIVE-ADJECTIVE + '(BETTER + BIGGER SMALLER TINIER LARGER + HEAVIER DARKER LIGHTER SHINIER DULLER + SMOOTHER ROUGHER HARDER SOFTER + WETTER DRIER OILIER + LOUDER QUIETER STRONGER WEAKER + TAMER ANGRIER MADDER SADDER HAPPIER + HUNGRIER SMARTER CRAZIER STRANGER + FASTER SLOWER OLDER NEWER + WORSE UGLIER PRETTIER)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adverbs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(DEFINE 'ADVERB + '(NEVER HARDLY NOT + SLOWLY QUICKLY + SOMETIMES OFTEN SEVERAL + VERY NEARLY PRACTICALLY ALMOST ABOUT APPROXIMATELY + ALWAYS PRECISELY REALLY EXACTLY IDENTICALLY + MUCH GREATLY MORE MOST + LESS LEAST + ADDITIONALLY ALSO TOO)) + + +;;; Common Nouns +;;; Note: NOUNs are inferred by this scheme usually by the fact that they +;;; do not fall into another category. This list is provided for +;;; any exceptions to the rule that may be nouns or another part of +;;; speech simultaneously. + +(DEFINE 'COMMON-NOUN + '(ADDRESS ADVOCATE AID AIM ANSWER APPEAL + BALANCE BOX BREAK LOVE + CALL CAMPAIGN CHAIN CROWD + DELEGATE + ENGINEER + FAKE FIGURE FIRE FOIL FOOL FORCE FORM + GRADE GRANT + HELP + INTERVIEW + JAIL + LOCK + MATCH + NAME NET + OFFER + PACE PHOTOGRAPH PLAN PRESENT PROGRAM PROJECT PROTEST + QUERY QUESTION + REPORT REQUEST RULE + SCHEDULE SIP SLUMP SKATE STORE SURVEY SWARM + TEST TIE TRACE TRICK TURN)) + +;;; Names +;;; Used among other things for finding pronoun antecedents + +(DEFINE 'MALE-NAME + '(ADAM AL ALAN ALLAN ALDEN ALEX ALEXANDER + ALF ALFRED ALLEN ALVIN ANDREW + ANDY ANTHONY ARNOLD ARTHUR + BARRY BART BILL BOB BUD BOBBY BRAD + CARROLL CARL CHARLES CHARLIE CHONG CHRIS CHRISTOPHER CHUCK + CLARK CLEM CLEMENT CLINT CLINTON CRAIG CURT + DAN DANIEL DARRELL DARRYL DAVE DAVID + DENNIS DERYL DEVON + DICK + DONALD DON DONNY DOUG DOUGLAS + DUGALD + EDGAR ELIOT ELLIOT EMERY ERIC ERIK + FRANCIS FRANK FREDRICK FRED + GARY GEOFF GEOFFREY GEORGE GERALD GERARD GERROLD GREG GREGORY + GERHARD + HAROLD HARRY HAL HARVEY HANK HOWARD HOWIE + IRVING ISAAC IVAN + JACK JACOB JAMES + JEREMIAH JERRY JEFF JEFFREY JEFFRY + JIM JIMMY + JOE JOHN JOHNNY JON JONATHAN JOSE JOSEPH + JUAN JULIAN + KARIM KEN KENNY KENNEY KENNETH KENT KURT + LARRY LAUREN LAURENCE LAWRENCE + LEO LEON LEONARD LEONARDO LESLIE + MAN MANNY MANUEL MARC MARK MARTIN MARTY MARVIN MATT MATTHEW MAURICE + MICHAEL MIKE MORRIS MYRON + NED NORMAN NORM + ODED OSCAR + PATRICK PAUL PETER PETE PHILLIP PHILIP + RALPH RICHARD ROB ROBERT ROGER RON RONALD RUSS RUSSEL RUSSELL + SCOT SCOTT SETH STEPHEN STEVE STEWART STUART + TED TERRENCE TERRY THEO THEODORE THOMAS TOM TOMMY + WENG WILLIAM +;unames: + JPG LPH MRG STEVER KMP DUFFEY RWK HIC)) + +(DEFINE 'FEMALE-NAME + '(ALICE AMY ANNE ANNETTE ANN ARLENE + BARB BARBARA BARBRA BARBI BARBIE BETTY BERNICE + CANDACE CANDY CAROL CAROLA CAROLE CATHERINE CATHI CATHY + CHERYL CINDY CINDI CYNTHIA + DEBBIE DEBBY DENISE + DIANA DIANNA DIANE DIANNE DORIS DOLORES DONNA DOROTHY + ELAINE ELENA ELLEN EMELIA EUNICE EVA EVE EVELYN + FARRAH FRANCES FRANCESCA + GAIL GINGER GRACE + JANE JANICE JO JOAN JOSIE JOSEPHINE JUANA JUANITA JULIA + KAREN KARIN KARI KATY KATHERINA KATHERINE KATHI KATHY KATRINA KERI + LAUREN LAUREEN LESLIE LISA LORRAINE LYNN LYNNE + MARGARET MARILYN MARILYNN MARLENA MARLENE MARY MARSHA + MEG MELISSA MICHELLE + NANCY NORA + PATRICIA PATTY PATTI PAULA PAULETTE PAULINE + PEG PEGGY POLLY + ROSE ROSILYN + SALLY SANDRA SANDY SOPHIE STACEY STELLA SUE SUSAN + TERESA TERRY TINA + VICCI VICKY VICKI VICTORIA VIRGINIA +;unames: + BKERNS VP)) + + + +;;; Define Matches + +(MATCHDECLARE 'IF '(THEN)) +(MATCHDECLARE 'IFF '(THEN)) +(MATCHDECLARE 'NOT-ONLY '(BUT BUT-ALSO)) +(MATCHDECLARE 'EITHER '(OR)) +(MATCHDECLARE 'NEITHER '(NOR)) + +;;; Comparators are pseudo-parst of speech used +;;; in conjunction with comparative adjectives. + +(DEFINE 'COMPARATOR '(AS THAN)) + +;;; Conjunctions + +(DEFINE 'CONJUNCTION '(AND OR BUT BECAUSE HOWEVER ALTHOUGH)) + +;;; Determiners + +(DEFINE 'DETERMINER '(THE A AN EVERY SOME ANY MANY ALL ONE)) + +;;; Interjections + +(DEFINE 'INTERJECTION '(OK FINE SURE GREAT GOOD NO YES OKAY SIGH FOO + HI HELLO GREETINGS WOW OH AH AHH AHHH AHHHH + HUHUH UHHUH HMMM GEE HMM HMMMM FOOBAR FROWN SI + TOO ALSO ADDITIONALLY WELL)) + +;;; Modals [special class of verbs] + +(DEFINE 'MODAL '(CAN COULD MAY MIGHT MUST SHALL SHOULD WILL WOULD)) + +;;; Prepositions + +(DEFINE 'PREPOSITION + '(OF IN ON WITH FROM FOR TO AT SAME AS LIKE ABOUT + BY BESIDE AROUND UNDER ABOVE THROUGH BENEATH AMIDST + ONTO VIA INSIDE OUTSIDE BEHIND OVER)) + +;;; Special classes of verbs + +(DEFINE 'BEING-VERB '(BE AM IS ARE WAS WERE)) + +(DEFINE 'HELPING-VERB '(AM IS ARE WAS WERE HAVE HAS HAD DO DOES DID)) + + +(DEFINE 'PRONOUN '(I ME YOU HE HIM SHE HER IT + WE US THEY THEM + THAT THOSE THIS THESE + THING THINGS ANYTHING SOMETHING EVERYTHING + ;Possessives + MINE YOURS HIS HERS ITS OURS THEIRS + ;Reflexives + MYSELF YOURSELF HIMSELF HERSELF ITSELF)) + +(DEFINE 'ADJECTIVE '(MY YOUR HIS HER ITS OUR THEIR)) + +(DEFUN ROOT-PRONOUN (X) (EQ (GET X 'PRONOUN-TYPE) 'SUBJECT)) + +(DEFUN PRONOUN-VARIATIONS-DECLARE (PRONOUN VARIATIONS) + (PUTPROP PRONOUN 'SUBJECT 'PRONOUN-TYPE) + (COND (VARIATIONS + (MAPC (FUNCTION + (LAMBDA (X) (PUTPROP X PRONOUN 'ROOT-PRONOUN))) + VARIATIONS) + (PUTPROP (CAR VARIATIONS) 'OBJECT 'PRONOUN-TYPE) + (PUTPROP (CADR VARIATIONS) 'ADJECTIVE 'PRONOUN-TYPE) + (PUTPROP (CADDR VARIATIONS) 'POSSESSIVE 'PRONOUN-TYPE) + (PUTPROP (CADDDR VARIATIONS) 'REFLEXIVE 'PRONOUN-TYPE)))) + +(DEFUN PRONOUN-DEFINE FEXPR (X) + (MAPC (FUNCTION + (LAMBDA (X) + (PUTPROP (CAR X) (CADR X) 'PERSON) + (PUTPROP (CAR X) (CADDR X) 'GENDER) + (PUTPROP (CAR X) (CADDDR X) 'NUMBER) + (PRONOUN-VARIATIONS-DECLARE (CAR X) + (CAR (CDDDDR X))))) + X)) + +;;; + +(PRONOUN-DEFINE (I FIRST () (SINGULAR) (ME MY MINE MYSELF)) + (YOU SECOND () (SINGULAR PLURAL) (YOU YOUR YOURS + YOURSELF)) + (HE THIRD (MALE) (SINGULAR) (HIM HIS HIS HIMSELF)) + (SHE THIRD (FEMALE) (SINGULAR) (HER HER HERS HERSELF)) + (IT THIRD (NONE) (SINGULAR) (IT ITS ITS ITSELF)) + (THAT THIRD (NONE) (SINGULAR) ()) + (THIS THIRD (NONE) (SINGULAR) ()) + (WE FIRST () (PLURAL) (US OUR OURS + OURSELVES)) + (THEY THIRD () (PLURAL) (THEM THEIR THEIRS + THEMSELVES)) + (THESE THIRD () (PLURAL) ()) + (THOSE THIRD () (PLURAL) ())) + +(DEFUN POSSESSIVE-PRONOUN? (X) + (EQ (GET X 'PRONOUN-TYPE) 'POSSESSIVE)) + +(DEFUN POSSESSIVE? (X) + (COND ((POSSESSIVE-PRONOUN? X) (ROOT-PRONOUN X)) + ((EQUAL (MEMQ '/' (SETQ X (EXPLODED X))) '(/' S)) + (IMPLODE (NREVERSE (CDDR (REVERSE X))))) + (T NIL))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Verbs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(VERB-FORM + (ABANDON ABANDONS ABANDONED ABANDONED ABANDONING) + (ACCOMODATE) + (ACCOUNT) + (ACCUSE) + (ACQUIRE) + (ACT) + (ACTUATE) + (ADD) + (ADDRESS) + (ADVERTISE) + (ADVOCATE) + (AGREE AGREES AGREED AGREED AGREEING) + (AID) + (AIM) + (ALLEVIATE) + (ALLOW) + (ALTER) + (ANNOUNCE) + (ANNOY) + (ANSWER ANSWERS ANSWERED ANSWERED ANSWERING) + (APOLOGIZE) + (APPEAL) + (APPEAR) + (APPEND) + (APPLY) + (APPOINT) + (APPRAISE) + (APPRECIATE) + (APPROACH) + (APPROVE) + (ARISE ARISES AROSE ARISEN) + (ARREST) + (ARRIVE) + (ASK) + (ASSIGN) + (ASSOCIATE) + (ASSUME) + (ATTACK) + (ATTEMPT) + (ATTRACT) + (AWAKEN) + (BALANCE) + (BAN) + (BAKE) + (BARK) + (BEAT) + (BECOME BECOMES BECAME BECOME) + (BEGIN BEGINS BEGAN BEGUN) + (BELIEVE) + (BET BETS BET BET) + (BETRAY) + (BID BIDS BID BID BIDDING) + (BITE BITES BIT BITTEN) + (BLAST) + (BLEEP) + (BLOCK) + (BLOW BLOWS BLEW BLOWN BLOWING) + (BORROW) + (BOTHER BOTHERS BOTHERED BOTHERED BOTHERING) + (BOX) + (BREAK BREAKS BROKE BROKEN) + (BRING BRINGS BROUGHT BROUGHT) + (BUILD BUILDS BUILT BUILT BUILDING) + (BUMP) + (BURN) + (BURP) + (BUS BUSES BUSED BUSED BUSING) + (BUY BUYS BOUGHT BOUGHT) + (CALCULATE) + (CALL) + (CAMPAIGN) + (CANCEL) + (CAPTURE) + (CARE) + (CARRY) + (CAST CASTS CAST CAST CASTING) + (CATCH CATCHES CAUGHT CAUGHT) + (CAUSE) + (CHAIN) + (CHALLENGE) + (CHANGE) + (CHARGE) + (CHASE) + (CHECK) + (CHOOSE CHOOSES CHOSE CHOSEN) + (CHUCKLE) + (CIRCULATE) + (CLARIFY) + (CLOBBER) + (COLLECT) + (COME COMES CAME COME) + (COMPETE) + (COMPLAIN) + (COMPLETE) + (COMPLICATE) + (COMPROMISE) + (CONCLUDE) + (CONDUCT) + (CONFIDE) + (CONFIRM) + (CONFUSE) + (CONSENT) + (CONSIDER CONSIDERS CONSIDERED CONSIDERED CONSIDERING) + (CONSTRAIN) + (CONTINUE) + (CONTROL) + (CONVICT) + (COOK) + (COPY) + (CORRECT) + (COUNT) + (COVER) + (CREATE) + (CRITICIZE) + (CROWD) + (CRUSH CRUSHES CRUSHED CRUSHED) + (CRY) + (CUT) + (DANCE) + (DEBATE) + (DECLARE) + (DECREASE) + (DEDICATE) + (DEFEND) + (DEFINE) + (DELAY) + (DELEGATE) + (DELETE) + (DENY) + (DEREGULATE) + (DESIRE) + (DESTROY) + (DETECT) + (DIE) + (DISAGREE) + (DISAPPROVE) + (DISBAND) + (DISCARD) + (DISCIPLINE) + (DISCUSS) + (DISLIKE) + (DISMISS) + (DISPLAY) + (DIVEST) + (DO DOES DID DONE DOING) + (DRAMATIZE) + (DRAW) + (DRINK DRINKS DRANK DRUNK) + (DRIVE DRIVES DROVE DRIVEN) + (EASE) + (EAT EATS ATE EATEN EATING) + (EDIT) + (ELECT) + (ELIMINATE) + (ENFORCE) + (ENGINEER) + (ENTER) + (ESTABLISH) + (EXCEL) + (EXHIBIT) + (EXIT) + (EXPECT) + (EXPERIENCE) + (EXPERIMENT) + (EXPLAIN) + (EXPORT) + (EXTEND) + (FAIL) + (FAKE) + (FALL FALLS FELL FALLEN FALLING) + (FEAR) + (FEEL FEELS FELT FELT FEELING) + (FIGHT FIGHTS FOUGHT FOUGHT) + (FIGURE) + (FILE) + (FILL) + (FIND FINDS FOUND FOUND) + (FIRE) + (FIX) + (FLY) + (FOCUS) + (FOIL) + (FOLLOW) + (FOOL) + (FORCE) + (FORESHADOW FORESHADOWS FORESHADOWED FORESHADOWED FORESHADOWING) + (FORM) + (FULFILL) + (GARGLE) + + (GET GETS GOT GOTTEN) + (GIGGLE) + (GLOW) + (GO GOES WENT GONE GOING) + (GRADE) + (GRANT) + (GROW) + (GUIDE) + (HAVE HAS HAD HAD HAVING) + (HANG HANGS HUNG HUNG) + (HAPPEN HAPPENS HAPPENED HAPPENED HAPPENING) + (HATE) + (HEAR) + (HEIGHTEN HEIGHTENS HEIGHTENED HEIGHTENED HEIGHTENING) + (HELP) + (HESITATE) + (HIDE HIDES HID HIDDEN) + (HIRE) + (HIT HITS HIT HIT) + (HOLD HOLDS HELD HELD) + (HOPE) + (HOVER HOVERS HOVERED HOVERED HOVERING) + (HUNT) + (HURT HURTS HURT HURT) + (ILLUMINATE) + (IMPEACH) + (IMPLEMENT) + (IMPLY) + (IMPRESS) + (IMPROVE) + (INCREASE) + (INDICT) + (INFORM) + (INITIALIZE) + (INJUR) + (INSTALL) + (INSURE) + (INTERVIEW) + (INTIMIDATE) + (INTRODUCE) + (INVADE) + (INVESTIGATE) + (INVOLVE) + (IRRITATE) + (JAIL) + (JERK) + (JOIN) + (JUDGE) + (JUMP) + (KILL) + (KISS) + (KNOW) + (LACK) + (LAY) + (LAUGH) + (LEAD) + (LEARN) + (LEAVE) + (LECTURE) + (LEGISLATE) + (LEVEL) + (LIE) + (LIKE) + (LIMIT) + (LINK) + (LIST) + (LISTEN LISTENS LISTENED LISTENED LISTENING) + (LIVE) + (LOAD) + (LOCK) + (LOOK) + (LOOSEN) + (LOSE) + (LOVE) + (LOWER) + (MAKE MAKES MADE MADE) + (MARCH) + (MARK) + (MATCH) + (MATERIALIZE) + (MEAN MEANS MEANT MEANT) + (MEET) + (MISLAY) + (MOVE) + (MUNCH) + (MUNG) + (MURDER) + (NAME) + (NEED) + (NET) + (NIX) + (NOMINATE) + (OBJECT) + (OBSERVE) + (OFFER) + (OPEN OPENS OPENED OPENED OPENING) + (ORGANIZE) + (OUGHT OUGHT OUGHT OUGHT OUGHT) + (OVERSHADOW OVERSHADOWS OVERSHADOWED OVERSHADOWED OVERSHADOWING) + (PACE) + (PACK) + (PARK) + (PASS) + (PASTE) + (PAUSE) + (PAVE) + (PAY) + + (PERFORM) + (PERPETRATE) + (PHOTOGRAPH) + (PICK) + (PLAGIARIZE) + (PLAN) + (PLANT) + (PLAY) + (PLEDGE) + (POP) + (PREDICT) + (PREFER) + (PREPARE) + (PRESENT) + (PRESSURE) + (PRESUME) + (PREY) + (PRAY) + (PROCLAIM) + (PRODUCE) + (PROFIT) + (PROGRAM) + (PROJECT) + (PROMISE) + (PROPOSE) + (PROTECT) + (PROTEST) + (PROVE) + (PROVIDE) + (PRY) + (PUBLISH) + (PUSH) + (PUT PUTS PUT PUT) + (QUERY) + (QUESTION) + (QUIET) + (QUIT QUITS QUIT QUIT) + (RAISE) + (RAP) + (RAPE) + (REALIZE) + (RECALL) + (RECAP) + (RECOMMEND) + (RECOUNT) + (RECOVER) + (RECYCLE) + (REFER) + (REFEREE) + (REFUND) + (REFUTE) + (REGULATE) + (REHEARSE) + (REITERATE) + (REJECT) + (RELATE) + (RELAY) + (REMIND) + (REMOVE) + (RENEW) + (RENOUNCE) + (RENOVATE) + (RENT) + (REPLACE) + (REPLAY) + (REPORT) + (REPRESENT) + (REQUEST) + (RESEARCH) + (RESIGN) + (RESOLVE) + (REST) + (RESTORE) + (RETAIN) + (RETURN) + (REVEAL) + (REVIEW) + (REVISE) + (REVISIT) + (REVITALIZE) + (REVIVE) + (RESSURECT) + (REWARD) + (RIDE RIDES RODE RIDDEN) + (RISE RISES ROSE RISEN) + (ROLE) + (RUIN) + (RULE) + (RUN RUNS RAN RUN) + (RUSH) + (SACRIFICE) + (SAVE) + (SAY SAYS SAID SAID) + (SCHEDULE) + (SEARCH) + (SEE SEES SAW SEEN SEEING) + (SEEK SEEKS SOUGHT SOUGHT) + (SEEM) + (SEIZE) + (SELECT) + (SELL SELLS SOLD SOLD) + (SEND) + (SERVE) + (SET SETS SET SET SETTING) + (SEW SEWS SEWED SEWED SEWING) + (SHIFT) + (SHOOT) + (SHOUT) + (SHOW SHOWS SHOWED SHOWED SHOWING) + (SHRUG) + (SHUN) + (SHUT) + (SIGNAL) + (SING SINGS SANG SUNG) + (SINK SINKS SANK SUNK) + (SIP) + (SIT SITS SAT SAT) + (SKATE) + (SKI SKIS SKIED SKIED SKIING) + (SLANDER) + (SLASH) + (SLAY SLAYS SLEW SLAIN) + (SLEEP SLEEPS SLEPT SLEPT) + (SLIDE SLIDES SLID SLID) + (SLIP) + (SLOW) + (SLUMP) + (SLUR) + (SOAR) + (SOLVE) + (SOW SOWS SOWED SOWED SOWING) + (SPAN) + (SPIN) + (SPLIT) + (SPIKE) + (SPEAK) + (SPONSOR) + (SQUEEZE) + (SQUINT) + (SQUIRT) + (STALL) + (STAND STANDS STOOD STOOD) + (STARE) + (START) + (STARVE) + (STATE) + (STAY) + (STEAL) + (STEER STEERS STEERED STEERED STEERING) + (STIR) + (STOP) + (STORE) + (STRAIGHTEN) + (STRIP) + (STUDY) + (SUBMERGE) + (SUBMIT) + (SUCCEED) + (SUGGEST) + (SUPPOSE) + (SURPRISE) + (SURVEY) + (SWARM) + (SWIM SWIMS SWAM SWUM) + (SYNTHESIZE) + (TAKE TAKES TOOK TAKEN) + (TALK) + (TEACH) + (TERMINATE) + (TESTIFY) + (THANK) + + (THINK THINKS THOUGHT THOUGHT) + (THROW THROWS THREW THROWN THROWING) + (TIE) + (TIGHTEN TIGHTENS TIGHTENED TIGHTENED TIGHTENING) + (TICK) + (TIP) + (TOP) + (TRACE) + (TRACK) + (TRANSFER TRANSFERS TRANSFERED TRANSFERED TRANSFERING) + (TRESPASS) + (TRICK) + (TURN) + (UNDERSTAND UNDERSTANDS UNDERSTOOD UNDERSTOOD) + (UNDO UNDOES UNDID UNDONE UNDOING) + (UNLOCK) + (UPHOLD UPHOLDS UPHELD UPHELD) + (URGE) + (USE USES USED USED USING) + (VACATE) + (VALUE) + (VETO) + (VIEW) + (VIOLATE) + (VISIT VISITS VISITED VISITED VISITING) + (VOTE) + (WAKE) + (WALK) + (WANT) + (WATCH) + (WEAR WEARS WORE WORN WEARING) + (WILL WILLS WILLED WILLED WILLING) + (WIN WINS WON WON) + (WINK) + (WISH) + (WONDER WONDERS WONDERED WONDERED WONDERING) + (WORRY) + (WORK) + (WRITE WRITES WROTE WRITTEN) + (YANK) + (YELL) +) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Contractions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(DEFUN CONTRACTION (X) + (COND ((NUMBERP (CADR X)) + (PUTPROP (CAR X) + (CDR + (ASSOC (CADR X) + '((1. . (FORGOT USE AN APOSTROPHE)) + (2. . (FORGOT TO CAPITALIZE YOUR APOSTROPHE)) + (3. . (MIS-SPELLED SOMETHING)) + (4. . (FORGOT TO TYPE A SPACE)) + (5. . (TYPED |"0"| INSTEAD OF |"O"|)) + (6. . (GOT THE |"I"| AND |"E"| BACKWARDS))))) + 'TYPO) + (PUTPROP (CAR X) (CDDR X) 'CONTRACTION)) + (T + (PUTPROP (CAR X) (CDR X) 'CONTRACTION)))) + +(DEFUN TYPO? (X) (GET X 'TYPO)) + +(DEFUN STRING-PRINC (X) + (COND ((ATOM X) + (PRINC '/" TYO) + (PRINC X TYO) + (PRINC '/" TYO)) + (T + (PRINC '/" TYO) + (PRINC (CAR X) TYO) + (MAPC (FUNCTION (LAMBDA (X) (PRINC '| | TYO) (PRINC X TYO))) + (CDR X)) + (PRINC '/" TYO)))) + +(COND ((NOT (BOUNDP 'VERBOSE-TYPO-CORRECTION-FLAG)) + (SETQ VERBOSE-TYPO-CORRECTION-FLAG T))) + +(DEFUN CONTRACTION? (X) + (DECLARE (SPECIAL VERBOSE-TYPO-CORRECTION-FLAG)) + (COND ((AND (GET X 'TYPO) VERBOSE-TYPO-CORRECTION-FLAG) + (CURSORPOS 'A TYO) + (PRINC '|Using | TYO) + (STRING-PRINC (GET X 'CONTRACTION)) + (PRINC '| for | TYO) + (STRING-PRINC X) + (PRINC '/. TYO) + (TERPRI TYO))) + (OR (GET X 'CONTRACTION) + (NCONS X))) + +(DEFUN EXPAND-CONTRACTIONS (X) + (APPLY 'APPEND (MAPCAR 'CONTRACTION? X))) + +(MAPC 'CONTRACTION + '(( |AIN'T| . ( IS NOT)) + ( |AINT| . (1. IS NOT)) + ( |AIN7T| . (2. IS NOT)) + + ( DUNNO . (DO NOT KNOW)) + + ( GONNA . (GOING TO)) + + ( GOTTA . (HAVE TO)) + + ( MUSTA . (MUST HAVE)) + + ( OUGHTA . (OUGHT TO)) + + ( CUDA . (COULD HAVE)) + ( COULDA . (COULD HAVE)) + ( CUDNA . (COULD NOT HAVE)) + ( COULDNA . (COULD NOT HAVE)) + + ( SHUDA . (SHOULD HAVE)) + ( SHOULDA . (SHOULD HAVE)) + ( SHUDNA . (SHOULD NOT HAVE)) + ( SHOULDNA. (SHOULD NOT HAVE)) + + ( WUDA . (WOULD HAVE)) + ( WOULDA . (WOULD HAVE)) + ( WUDNA . (WOULD NOT HAVE)) + ( WOULDNA . (WOULD NOT HAVE)) + + ( MIGHTA . (MIGHT HAVE)) + + ( WANNA . (WANT TO)) + ( WANTA . (WANT TO)) + + ( WUDA . (WOULD HAVE)) + ( WUDNA . (WOULD NOT HAVE)) + + ( |DIDN'T| . ( DID NOT)) + ( |DIDNT| . (1. DID NOT)) + ( |DIDN7T| . (2. DID NOT)) + ( |DIN'T| . (3. DID NOT)) + + ( |AREN'T| . (ARE NOT)) + + ( |CAN'T| . ( CAN NOT)) + ( |CANT| . (1. CAN NOT)) + ( |CAN7T| . (2. CAN NOT)) + + ( |COULDN'T| . ( COULD NOT)) + ( |COULDNT| . (1. COULD NOT)) + ( |COULDN7T| . (2. COULD NOT)) + + ( |DOESN'T| . ( DOES NOT)) + ( |DOESNT| . (1. DOES NOT)) + ( |DOESN7T| . (2. DOES NOT)) + + ( |DON'T| . ( DO NOT)) + ( |DONT| . (1. DO NOT)) + ( |DON7T| . (2. DO NOT)) + + ( |HASN'T| . ( HAS NOT)) + ( |HASNT| . (1. HAS NOT)) + ( |HASN7T| . (2. HAS NOT)) + + ( |HAVEN'T| . ( HAVE NOT)) + ( |HAVENT| . (1. HAVE NOT)) + ( |HAVEN7T| . (2. HAVE NOT)) + + ( |HE'D| . ( HE WOULD)) + ( |HED| . (1. HE WOULD)) + ( |HE7D| . (2. HE WOULD)) + + ( |HE'S| . ( HE IS)) + ( |HES| . (1. HE IS)) + ( |HE7S| . (2. HE IS)) + + ( |HERE'S| . ( HERE IS)) + ( |HERES| . (1. HERE IS)) + ( |HERE7S| . (2. HERE IS)) + + ( |I'D| . ( I WOULD)) + ( |I7D| . (2. I WOULD)) + + ( |I'LL| . ( I SHALL)) + ( |I7LL| . (2. I SHALL)) + + ( |I'M| . ( I AM)) + ( |IM| . (1. I AM)) + ( |I7M| . (2. I AM)) + + ( |I'VE| . ( I HAVE)) + ( |IVE| . (1. I HAVE)) + ( |I7VE| . (2. I HAVE)) + + ( |ISN'T| . ( IS NOT)) + ( |ISNT| . (1. IS NOT)) + ( |ISN7T| . (2. IS NOT)) + + ( |IT'D| . ( IT WOULD)) + ( |ITD| . (1. IT WOULD)) + ( |IT7D| . (2. IT WOULD)) + + ( |IT'S| . ( IT IS)) + ( |IT7S| . (2. IT IS)) + + ( |MUST'VE| . ( MUST HAVE)) + ( |MUSTVE| . (1. MUST HAVE)) + ( |MUST7VE| . (2. MUST HAVE)) + + ( |SHE'D| . ( SHE WOULD)) + ( |SHE7D| . (2. SHE WOULD)) + + ( |SHE'S| . ( SHE IS)) + ( |SHES| . (1. SHE IS)) + ( |SHE7S| . (2. SHE IS)) + + ( |SHOULD'VE| . ( SHOULD HAVE)) + ( |SHOULDVE| . (1. SHOULD HAVE)) + ( |SHOULD7VE| . (2. SHOULD HAVE)) + + ( |SHOULDN'T| . ( SHOULD NOT)) + ( |SHOULDNT| . (1. SHOULD NOT)) + ( |SHOULDN7T| . (2. SHOULD NOT)) + + ( |THAT'S| . ( THAT IS)) + ( |THATS| . (1. THAT IS)) + ( |THAT7S| . (2. THAT IS)) + + ( |THERE'D| . ( THERE WOULD)) + ( |THERED| . (1. THERE WOULD)) + ( |THERE7D| . (2. THERE WOULD)) + + ( |THERE'S| . ( THERE IS)) + ( |THERES| . (1. THERE IS)) + ( |THERE7S| . (2. THERE IS)) + + ( |WHAT'S| . ( WHAT IS)) + ( |WHATS| . (1. WHAT IS)) + ( |WHAT7S| . (2. WHAT IS)) + + ( |WHEN'S| . ( WHEN IS)) + ( |WHENS| . (1. WHEN IS)) + ( |WHEN7S| . (2. WHEN IS)) + + ( |WHERE'S| . ( WHERE IS)) + ( |WHERES| . (1. WHERE IS)) + ( |WHERE7S| . (2. WHERE IS)) + + ( |WHO'S| . ( WHO IS)) + ( |WHOS| . (1. WHO IS)) + ( |WHO7S| . (2. WHO IS)) + + ( |WON'T| . ( WILL NOT)) + ( |WONT| . (1. WILL NOT)) + ( |WON7T| . (2. WILL NOT)) + + ( |WOULDN'T| . ( WOULD NOT)) + ( |WOULDNT| . (1. WOULD NOT)) + ( |WOULDN7T| . (2. WOULD NOT)) + + ( |WOULD'VE| . ( WOULD HAVE)) + ( |WOULDVE| . (1. WOULD HAVE)) + ( |WOULD7VE| . (2. WOULD HAVE)) + + ( |YOU'D| . ( YOU WOULD)) + ( |YOUD| . (1. YOU WOULD)) + ( |YOU7D| . (2. YOU WOULD)) + + ( |YOU'LL| . ( YOU WILL)) + ( |YOULL| . (1. YOU WILL)) + ( |YOU7LL| . (2. YOU WILL)) + + ( |YOU'RE| . ( YOU ARE)) + ( |YOURE| . (1. YOU ARE)) + ( |YOU7RE| . (2. YOU ARE)) + + ( |YOU'VE| . ( YOU HAVE)) + ( |YOUVE| . (1. YOU HAVE)) + ( |YOU7VE| . (2. YOU HAVE)) + + ( |W//| . (WITH)) + ( |W//O| . (WITHOUT)) + + ( CU . (BYE)) + ( CUL . (BYE)) + ( BCNU . (BYE)) + ( S'LONG . (BYE)) + + ( B4 . (BEFORE)) + + ( FO . (3. OF)) + + ( FRO . (3. FOR)) + + ( CNA . (3. CAN)) + ( CNA'T . (3. CAN NOT)) + + ( BECUZ . (BECAUSE)) + + ( FREIND . (6. FRIEND)) + ( THIER . (6. THEIR)) + ( THEIF . (6. THIEF)) + + ( YYES . (3. YES)) + ( YSE . (3. YES)) + ( YEES . (3. YES)) + ( YESS . (3. YES)) + ( YEAH . (3. YES)) + ( YEA . (3. YES)) + + ( NOO . (3. NO)) + ( NNO . (3. NO)) + + ( THRU . (THROUGH)) + + ( TE . (3. THE)) + ( TH . (3. THE)) + ( EHT . (3. THE)) + ( ETH . (3. THE)) + ( TEH . (3. THE)) + ( HET . (3. THE)) + ( HTE . (3. THE)) + + ( ADN . (3. AND)) + ( NAD . (3. AND)) + ( NDA . (3. AND)) + + ( HTAT . (3. THAT)) + ( TAHT . (3. THAT)) + ( THTA . (3. THAT)) + + ( HTIS . (3. THIS)) + ( HTSI . (3. THIS)) + ( THSI . (3. THIS)) + + ( OEN . (3. ONE)) + + ( HWEN . (3. WHEN)) + ( WEHN . (3. WHEN)) + + ( HWERE . (3. WHERE)) + ( WEHRE . (3. WHERE)) + + ( TEHN . (3. THEN)) + + ( ISA . (4. IS A)) + ( HASA . (4. HAS A)) + + ( N0 . (5. NO)) + ( N0T . (5. NOT)) + + )) + +(DEFUN EQS (XX YY) + (DO ((X XX (CDR X)) + (Y YY (CDR Y))) + ((NULL X) (CONS XX Y)) + (COND ((NOT (EQ (CAR X) (CAR Y))) + (RETURN NIL))))) + +(DEFUN EXPAND-ABBREVS (X) + (DO ((L X) + (R NIL)) + ((NULL L) (NREVERSE R)) + ((LAMBDA (EXPANSION) + (SETQ R (APPEND (CAR EXPANSION) R)) + (SETQ L (CDR EXPANSION))) + (GET-ABBREV-EXPANSION L)))) + +(DEFUN GET-ABBREV-EXPANSION (WORDS) + (DO ((PA (POTENTIAL-ABBREVS (CAR WORDS)) (CDR PA)) + (TEMP)) + ((NULL PA) (CONS (NCONS (CAR WORDS)) (CDR WORDS))) + (COND ((SETQ TEMP (EQS (CAAR PA) WORDS)) + (RETURN (CONS (CDAR PA) (CDR TEMP))))))) + +(DEFUN POTENTIAL-ABBREVS (X) + (GET X 'POTENTIAL-ABBREVS)) + +(DEFUN DEFINE-ABBREV (X) + (PUTPROP (CAAR X) + (SORT (CONS X (GET (CAAR X) 'POTENTIAL-ABBREVS)) 'LONGERCARP) + 'POTENTIAL-ABBREVS)) + +(DEFUN LONGERCARP (X Y) (> (LENGTH (CAR X)) (LENGTH (CAR Y)))) + +(MAPC 'DEFINE-ABBREV + '(((MR |.|) MR) + ((MISTER) MR) + ((MRS |.|) MRS) + + ((DR |.|) DOCTOR) + + ((U |.| S |.| A |.|) UNITED-STATES) + ((U |.| S |.|) UNITED-STATES) + ((UNITED STATES) UNITED-STATES) + + ((NOT ONLY) NOT-ONLY) + ((BUT ALSO) BUT-ALSO) + + ((IF AND ONLY IF) IFF) + + ((ATOMIC NUMBER) ATOMIC-NUMBER) + ((ATOMIC WEIGHT) ATOMIC-WEIGHT) + ((ATOMIC MASS) ATOMIC-MASS) + + ((GAMMA RAY) GAMMA-RAY) + ((GAMMA RAYS) GAMMA-RAYS) + ((ALPHA PARTICLE) ALPHA-PARTICLE) + ((ALPHA PARTICLES) ALPHA-PARTICLES) + ((BETA PARTICLE) BETA-PARTICLE) + ((BETA PARTICLES) BETA-PARTICLES) + + )) \ No newline at end of file diff --git a/src/games/yahtze.(init) b/src/games/yahtze.(init) new file mode 100644 index 00000000..ccbc7c4f --- /dev/null +++ b/src/games/yahtze.(init) @@ -0,0 +1,11 @@ +(comment) +(progn + (setq ^W t) + (load '((dsk games) yahtze fasl)) + (setq errlist '((gc) + (yahtze))) + (setsyntax '/ +'/ '/ ) + (setq ^W nil) + (cursorpos 'c) + (yahtze)) diff --git a/src/games/yahtze.27 b/src/games/yahtze.27 new file mode 100644 index 00000000..f71c4b82 --- /dev/null +++ b/src/games/yahtze.27 @@ -0,0 +1,241 @@ +;-*-lisp-*- + +(declare (eval (read))) +(load '((sca) mode)) + +(scachar) + +(declare (mapex t) + (special *nbonus*) + (fixnum i j k *nbonus* top-half bottom-half nroll)) + +(defun yahtze () + (bind ((^w <- t)) + (sort (list 1) (function <))) ;to load SORT package early + (terpri) + (terpri) + (princ '|Rules? |) + (cond ((memq (read) '(y yes sure ok)) + (cursorpos 'c) + (princ '|/ +This is the game of Yahtze./ +/ +It is a game played with 5 dice. You get thirteen turns. Each turn you roll/ +all 5 dice, then pick up and roll any or all of them again, and then pick up/ +and roll any or all of them a third time. You then score your roll in one of/ +the thirteen scoring slots - one slot for each turn. Slots may be used only/ +once per game. The slots are:/ +/ + 1 - Aces (Ones)/ + 2 - Twos/ + 3 - Threes/ + 4 - Fours/ + 5 - Fives/ + 6 - Sixes/ +/ + T - Three of a Kind/ + F - Four of a Kind/ + H - Full House [Three of one kind, and two of another]/ + S - Small Straight [Four numbers in a row]/ + L - Large Straight [Five numbers in a row]/ + Y - Yahtze [Five of a Kind]/ + C - Chance/ +/ +The first 6 slots form the top half, and the last 7 make up the bottom half./ +In the top half, a score is the sum of the dice of the appropriate number./ +Thus (2 3 4 4 4) would score 2 if scored in the 2 slot, 3 if scored in the 3/ +slot, 12 if scored in the 4 slot, and 0 if scored in any of the 1, 5, or 6/ +slots. Also, if at the end of the game you have at least 63 points in the top/ +half [for example, 3 of everything gives you exactly 63], you get a 35 point/ +bonus. Scoring in T is the total of all the dice, provided there is a three/ +of a kind [the score is 0 otherwise]. Scoring in F is similar. H scores 25,/ +S 30, L 40, and Y 50, provided of course that your roll meets the appropriate/ +prerequisite. If you have 50 in Y already, you get 100 bonus points for each/ +additional yahtze rolled. Any yahtze may be used as a "joker" and scored/ +anywhere in the lower half. C scores the total of all the dice, for any roll./ +/ +Note: when a roll is printed out, enter the numbers of the dice you wish to/ +KEEP, followed by a space. [If you wish to roll them all again, type 0.]/ +When "Score?" is printed, type the character corresponding to the slot you/ +wish to score the roll in, followed by a space./ +/ +P.S.: If you are on a display console and this output gets lost [in which/ +case you probably won't have time to read this], try :print drb;yahtze >, at/ +least for the first page or two./ +|) + (sleep 10.0))) + + (do ((scorecard (array nil t 13) (array nil t 13)) (roll) (*nbonus* 0 0) + (top-half) (bottom-half) (base 10.) (ibase 10.) (*nopoint t) (ans)) + (nil) + (sstatus random (fix (time))) + (terpri) + (terpri) + (repeat i 13 + (cursorpos 'c) + (princ '|Scorecard:|) + (print-scorecard scorecard) + (setq roll (fill-roll nil)) + (repeat i 2 + loop (print roll) + (princ '| |) + (setq ans (list-nums (read))) + (if (subset? ans roll) + (setq roll (fill-roll ans)) + (go loop))) + (print roll) + (score roll scorecard) + (terpri)) + (terpri) + (terpri) + (princ '|Final Scorecard:|) + (print-scorecard scorecard) + (setq top-half (sum-array scorecard 0 5)) + (terpri) + (princ '|Top Half: |) + (princ top-half) + (cond ((> top-half 62) + (terpri) + (princ '|Plus a Bonus of 35|) + (setq top-half (+ top-half 35)))) + (setq bottom-half (sum-array scorecard 6 12)) + (terpri) + (princ '|Bottom Half: |) + (princ bottom-half) + (cond ((= *nbonus* 1) + (terpri) + (princ '|Plus 1 Bonus Yahtze, for 100 Points|)) + ((> *nbonus* 1) + (terpri) + (princ '|Plus |) + (princ *nbonus*) + (princ '| Bonus Yahtzes, for |) + (princ (* *nbonus* 100)) + (princ '| Points|))) + (terpri) + (princ '|Total Score: |) + (princ (+ top-half bottom-half (* 100 *nbonus*))) + (terpri) + (terpri) + (princ '|Again? |) + (cond ((not (memq (read) '(y yes sure ok))) + (terpri) + (quit))))) + +(defun score (roll scorecard) + (prog (ans nroll) + (setq nroll (num-kind roll)) + (cond ((and (= nroll 5) (equal (arraycall t scorecard 11) 50)) + (setq *nbonus* (1+ *nbonus*)) + (terpri) + (princ '|A|) + (if (> *nbonus* 1) (princ '|nother|)) + (princ '| Bonus Yahtze !!!|))) + loop (terpri) + (princ '|Score? |) + (setq ans (read)) + (cond ((numberp ans) + (if (or (not (fixp ans)) (< ans 1) (> ans 6) + (arraycall t scorecard (1- ans))) + (go loop) + (store (arraycall t scorecard (1- ans)) + (sum-num ans roll)))) + ((eq ans 't) + (if (arraycall t scorecard 6) (go loop) + (store (arraycall t scorecard 6) + (if (> nroll 2) (sum-roll roll) 0)))) + ((eq ans 'f) + (if (arraycall t scorecard 7) (go loop) + (store (arraycall t scorecard 7) + (if (> nroll 3) (sum-roll roll) 0)))) + ((eq ans 'h) + (if (arraycall t scorecard 8) (go loop) + (store (arraycall t scorecard 8) + (if (full-house? roll) 25 0)))) + ((eq ans 's) + (if (arraycall t scorecard 9) (go loop) + (store (arraycall t scorecard 9) + (if (or (= nroll 5) (> (nrow roll) 3)) 30 0)))) + ((eq ans 'l) + (if (arraycall t scorecard 10) (go loop) + (store (arraycall t scorecard 10) + (if (or (= nroll 5) (> (nrow roll) 4)) 40 0)))) + ((eq ans 'y) + (if (arraycall t scorecard 11) (go loop) + (store (arraycall t scorecard 11) + (if (= nroll 5) 50 0)))) + ((eq ans 'c) + (if (arraycall t scorecard 12) (go loop) + (store (arraycall t scorecard 12) + (sum-roll roll)))) + (t (go loop))))) + +(defun fill-roll (roll) + (do ((roll roll (cons (1+ (random 6)) roll))) + ((= (length roll) 5) roll))) + +(defun list-nums (x) + (if (not (eq (typep x) 'fixnum)) (list 0) + (do ((out nil (cons (\ i 10) out)) + (i x (// (- i (\ i 10)) 10))) + ((= i 0) out)))) + +(defun subset? (s1 s2) + (setq s1 (sort (lcopy1 s1) (function <)) + s2 (sort (lcopy1 s2) (function <))) + (do () + (nil) + (cond ((null s1) (return t)) + ((null s2) (return nil)) + ((= (car s1) (car s2)) (setq s1 (cdr s1)))) + (setq s2 (cdr s2)))) + +(defun sum-array (arr i j) + (do ((k 0 (+ k (arraycall t arr i))) + (i i (1+ i))) + ((> i j) k))) + +(defun print-scorecard (scorecard) + (terpri) + (terpri) + (princ '| 1 2 3 4 5 6 T F H S L Y C|) + (terpri) + (repeat i 6 (princ-/. (arraycall t scorecard i))) + (princ '| |) + (do i 6 (1+ i) (= i 13) (princ-/. (arraycall t scorecard i))) + (terpri)) + +(defun princ-/. (frob) + (cond ((null frob) (princ '| .|)) + ((< frob 10) (princ '| |) (princ frob)) + (t (princ '| |) (princ frob)))) + +(defun sum-num (i roll) (* i (number-of i roll))) + +(defun num-kind (roll) + (do ((i 1 (1+ i)) + (j 0 (max (number-of i roll) j))) + ((> i 6) j))) + +(defun number-of (i roll) + (bind ((j <- 0)) + (mapc (fn (k) (if (= i k) (setq j (1+ j)))) roll) + j)) + +(defun nrow (roll) + (prog (i j k) + (setq i 1 j 0 k 0) + loop (setq j (if (= (number-of i roll) 0) 0 (1+ j))) + (setq k (max j k)) + (setq i (1+ i)) + (if (> i 6) (return k) (go loop)))) + +(defun sum-roll (roll) (apply (function +) roll)) + +(defun full-house? (roll) ;returns T for a YAHTZE. + (prog (i j) + (setq i 1 j 0) + loop (if (= (number-of i roll) 1) (return nil)) + (if (> (number-of i roll) 0) (setq j (1+ j))) + (setq i (1+ i)) + (if (> i 6) (return (< j 3)) (go loop))))