100 REMark ELIZA - THE COMPUTERIZED PSYCHIATRIST
110 REMark ORIGINAL BY JEFF WEIZENBAUM
120 REMark CONVERTED FOR SINCLAIR QL BY GALE HENSLEE; 74030,3403
130 REMark VERSION JANUARY 9,1988.
140 CLS
150 PRINT
160 CLEAR : REMark OPEN UP SOME SPACE
170 REMark  -----INITIALIZATION-----
180 DIM S(36),R(38),N(36)
190 N1=36:N2=14:N3=112:T=0:F$="":L=0
200 RESTORE : FOR X=1 TO N1+N2+N3:READ Z$:NEXT X
210 FOR X=1 TO N1
220 READ S(X),L:R(X)=S(X):N(X)=S(X)+L-1
230 NEXT X
240 X$="HI!  I'M YOUR COMPUTERIZED PSYCHIATRIST.  WHAT'S YOUR PROBLEM?":P$=""
250 GO SUB 2180
260 REMark    -----USER INPUT SECTION-----
270 A$="":INPUT#1,A$
280 PRINT: I$=A$: I$=" "&I$&" "
290 REMark  GET RID OF APOSTROPHES
300 FOR L=1 TO LEN(I$)
310 IF MID$(I$,L,1)<>"'" THEN GO TO 330
320 I$=LEFT$(I$,L-1)&RIGHT$(I$,LEN(I$)-L) : GO TO 310
330 IF L+4<=LEN(I$) THEN IF MID$(I$,L,4)="SHUT" THEN STOP
340 NEXT L
350 IF I$=P$ THEN X$="PLEASE DON'T REPEAT YOURSELF!":GO TO 250
360 REMark
370 REMark    -----FIND KEYWORD IN I$----
380 REMark
390 RESTORE
400 SS=0
410 FOR K=1 TO N1
420 READ K$
430 IF SS>0 THEN GO TO 470
440 FOR L=1 TO LEN(I$)-LEN(K$)+1
450 IF MID$(I$,L,LEN(K$))=K$ THEN SS=K:T=L:F$=K$
460 NEXT L
470 NEXT K
480 IF SS>0 THEN K=SS:L=T:GO TO 510
490 K=36:GO TO 720:REMark  WE DIDN'T FIND ANY KEYWORDS
500 REMark
510 REMark     TAKE PART OF THE STRING AND CONJUGATE IT
520 REMark     USING THE LIST OF STRINGS TO BE SWAPPED
530 REMark
540 RESTORE :FOR X=1 TO N1:READ Z$:NEXT X:REMark SKIP OVER KEYWORDS
550 C$=" "&RIGHT$(I$,LEN(I$)-LEN(F$)-L+1)
560 FOR X=1 TO N2/2
570 READ S$,R$
580 FOR L= 1 TO LEN(C$)
590 IF L+LEN(S$)>LEN(C$) THEN GO TO 640
600 IF MID$(C$,L,LEN(S$))<>S$ THEN GO TO 640
610 C$=LEFT$(C$,L-1)&R$&RIGHT$(C$,LEN(C$)-L-LEN(S$)+1)
620 L=L+LEN(R$)
630 GO TO 680
640 IF L+LEN(R$)>LEN(C$)THEN GO TO 680
650 IF MID$(C$,L,LEN(R$))<>R$ THEN GO TO 680
660 C$=LEFT$(C$,L-1)&S$&RIGHT$(C$,LEN(C$)-L-LEN(R$)+1)
670 L=L+LEN(S$)
680 NEXT L
690 NEXT X
700  IF MID$(C$,2,1)=" " THEN C$=RIGHT$(C$,LEN(C$)-1): REMark ONLY ONE SPACE
710 REMark
720 REMark     NOW USING THE KEYWORD NUMBER (K) GET REPLY
730 REMark
740 RESTORE :FOR X= 1 TO N1+N2:READ Z$:NEXT X
750 FOR X=1 TO R(K):READ F$:NEXT X:REMark   READ RIGHT REPLY
760 R(K)=R(K)+1: IF R(K)>N(K) THEN R(K)=S(K)
770 IF RIGHT$(F$,1)<>"*"THEN X$=F$: P$=I$: GO SUB 2180: GO TO 270
780 X$=LEFT$(F$,LEN(F$)-1)&C$: GO SUB 2180
790 P$=I$:GO TO 270
800 REMark
810 REMark   ====   PROGRAM DATA FOLLOWS   =====
820 REMark
830 REMark   KEYWORDS
840 REMark
850 DATA "CAN YOU","CAN I","YOU ARE","YOURE","I DONT","I FEEL"
860 DATA "WHY DONT YOU","WHY CANT I","ARE YOU","I CANT","I AM","IM"
870 DATA "YOU","I WANT","WHAT","HOW","WHO","WHERE","WHEN","WHY"
880 DATA "NAME","CAUSE","SORRY","DREAM","HELLO","HI","MAYBE"
890 DATA "NO","YOUR","ALWAYS","THINK","ALIKE","YES","FRIEND"
900 DATA "COMPUTER","NOKEYFOUND"
910 REMark
920 REMark    STRING DATA FOR CONJUGATIONS
930 REMark
940  DATA "ARE","AM","WERE","WAS","I","ME","YOUR","MY"
950 DATA "I'VE","YOU'VE","I'M","YOU'RE","I","YOU"
960 REMark
970 REMark   REPLIES
980 REMark
990 DATA "DON'T YOU BELIEVE THAT I CAN*"
1000 DATA "PERHAPS YOU WOULD LIKE TO BE ABLE TO*"
1010 DATA "YOU WANT ME TO BE ABLE TO*"
1020 DATA "PERHAPS YOU DON'T WANT TO*"
1030 DATA "DO YOU WANT TO BE ABLE TO*"
1040 DATA "WHAT MAKES YOU THINK I AM*"
1050 DATA "DOES IT PLEASE YOU TO BELIEVE I AM*"
1060 DATA "PERHAPS YOU WOULD LIKE TO BE*"
1070 DATA "DO YOU SOMETIMES WISH YOU WERE*"
1080 DATA "DON'T YOU REALLY*"
1090 DATA "WHY DON'T YOU*"
1100 DATA "DO YOU WISH TO BE ABLE TO*"
1110 DATA "DOES THAT TROUBLE YOU?"
1120 DATA "TELL ME MORE ABOUT SUCH FEELINGS."
1130 DATA "DO YOU OFTEN FEEL*"
1140 DATA "DO ENJOY FEELING*"
1150 DATA "DO YOU REALLY BELIEVE I DON'T*"
1160 DATA "PERHAPS IN GOOD TIME I WILL*"
1170 DATA "DO YOU WANT ME TO*"
1180 DATA "DO  YOU THINK YOU SHOULD BE ABLE TO*"
1190 DATA "WHY CAN'T YOU*"
1200 DATA "WHY ARE YOU INTERESTED IN WHETHER OR NOT I AM*"
1210 DATA "WOULD YOU PREFER IF I WERE NOT*"
1220 DATA "PERHAPS IN YOUR FANTASIES I AM*"
1230 DATA "HOW DO YOU KNOW YOU CAN'T*"
1240 DATA "HAVE YOU TRIED?"
1250 DATA "PERHAPS YOU CAN NOW?"
1260 DATA "DID YOU COME TO ME BECAUSE YOU ARE*"
1270 DATA "HOW LONG HAVE YOU BEEN*"
1280 DATA "DO YOU BELIEVE IT IS NORMAL TO BE*"
1290 DATA "DO YOU ENJOY BEING*"
1300 DATA "WE WERE DISCUSSING YOU -- NOT ME."
1310 DATA "OH, I*"
1320 DATA "YOU'RE NOT REALLY TALKING ABOUT ME, ARE YOU?"
1330 DATA "WHAT WOULD IT MEAN TO YOU IF YOU GOT*"
1340 DATA "WHY DO YOU WANT*"
1350 DATA "SUPPOSE YOU SOON GOT*"
1360 DATA "WHAT IF YOU NEVER GOT*"
1370 DATA "I SOMETIMES ALSO WANT*"
1380 DATA "WHY DO YOU ASK?"
1390 DATA "DOES THAT QUESTION INTEREST YOU?"
1400 DATA "WHAT ANSWER WOULD YOU PLEASE YOU THE MOST?"
1410 DATA "WHAT DO YOU THINK?"
1420 DATA "ARE SUCH QUESTIONS ON YOUR MIND OFTEN?"
1430 DATA "WHAT IS IT THAT YOU REALLY WANT TO KNOW?"
1440 DATA "HAVE YOU ASKED ANYONE ELSE?"
1450 DATA "HAVE YOU ASKED SUCH QUESTIONS BEFORE?"
1460 DATA "WHAT ELSE COMES TO MIND WHEN YOU ASK THAT?"
1470 DATA "NAMES DON'T INTEREST ME."
1480 DATA "I DON'T CARE ABOUT NAMES -- PLEASE GO ON."
1490 DATA "WHAT IS THE REAL REASON?"
1500 DATA "DON'T ANY OTHER REASONS COME TO MIND?"
1510 DATA "DOES THAT REASON EXPLAIN ANYTHING ELSE?"
1520 DATA "WHAT OTHER REASONS MIGHT THERE BE?"
1530 DATA "PLEASE DON'T APOLOGIZE!"
1540 DATA "APOLOGIES ARE NOT NECESSARY."
1550 DATA "WHAT FEELINGS DO YOU HAVE WHEN YOU APOLOGIZE."
1560 DATA "DON'T BE SO DEFENSIVE!"
1570 DATA "WHAT DOES THAT DREAM SUGGEST TO YOU?"
1580 DATA "DO YOU DREAM OFTEN?"
1590 DATA "WHAT PERSONS APPEAR IN YOUR DREAMS?"
1600 DATA "ARE YOU DISTURBED BY YOUR DREAMS?"
1610 DATA "HOW DO YOU DO... PLEASE STATE YOUR PROBLEM."
1620 DATA "YOU DON'T SEEM QUITE CERTAIN."
1630 DATA "WHY THE UNCERTAIN TONE?"
1640 DATA "CAN'T YOU BE MORE POSITIVE?"
1650 DATA "YOU AREN'T SURE?"
1660 DATA "DON'T YOU KNOW?"
1670 DATA "ARE YOU SAYING NO JUST TO BE NEGATIVE?"
1680 DATA "YOU ARE BEING A BIT NEGATIVE."
1690 DATA "WHY NOT?"
1700 DATA "ARE YOU SURE?"
1710 DATA "WHY NO?"
1720 DATA "WHY ARE YOU CONCERNED ABOUT MY*"
1730 DATA "WHAT ABOUT YOUR OWN*"
1740 DATA "CAN YOU THINK OF A SPECIFIC EXAMPLE?"
1750 DATA "WHEN?"
1760 DATA "WHAT ARE YOU THINKING OF?"
1770 DATA "REALLY, ALWAYS?"
1780 DATA "DO YOU REALLY THINK SO?"
1790 DATA "BUT YOU ARE NOT SURE YOU*"
1800 DATA "DO YOU DOUBT YOU*"
1810 DATA "IN WHAT WAY?"
1820 DATA "WHAT RESEMBLANCE DO YOU SEE?"
1830 DATA "WHAT DOES THE SIMILARITY SUGGEST TO YOU?"
1840 DATA "WHAT OTHER CONNECTIONS DO YOU SEE?"
1850 DATA "COULD THERE REALLY BE SOME CONNECTION?"
1860 DATA "HOW?"
1870 DATA "YOU SEEM QUITE POSITIVE."
1880 DATA "ARE YOU SURE?"
1890 DATA "I SEE."
1900 DATA "I UNDERSTAND."
1910 DATA "WHY DO YOU BRING UP THE TOPIC OF FRIENDS?"
1920 DATA "DO YOUR FRIENDS WORRY YOU?"
1930 DATA "DO YOUR FRIENDS PICK ON YOU?"
1940 DATA "ARE YOU SURE YOU HAVE ANY FRIENDS"
1950 DATA "DO YOU IMPOSE ON YOUR FRIENDS?"
1960 DATA "PERHAPS YOUR LOVE FOR FRIENDS WORRIES YOU."
1970 DATA "DO COMPUTERS WORRY YOU?"
1980 DATA "ARE YOU TALKING ABOUT ME IN PARTICULAR?"
1990 DATA "ARE YOU FRIGHTENED BY MACHINES?"
2000 DATA "WHY DO YOU MENTION COMPUTERS?"
2010 DATA "WHAT DO YOU THINK MACHINES HAVE TO DO WITH YOUR PROBLEM?"
2020 DATA "DON'T YOU THINK THAT COMPUTERS HELP PEOPLE?"
2030 DATA "WHAT IS IT ABOUT MACHINES THAT WORRIES YOU?"
2040 DATA "SAY, DO YOU HAVE ANY PSYCHOLOGICAL PROBLEMS?"
2050 DATA "WHAT DOES THAT SUGGEST TO YOU?"
2060 DATA "I SEE."
2070 DATA "I'M NOT SURE I UNDERSTAND YOU FULLY."
2080 DATA "COME, COME, ELUCIDATE YOUR THOUGHTS."
2090 DATA "CAN YOU ELABORATE ON THAT"
2100 DATA "THAT IS QUITE INTERESTING."
2110 REMark
2120 REMark     DATA FOR FINDING RIGHT REPLIES
2130 REMark
2140 DATA 1,3,4,2,6,4,6,4,10,4,14,3,17,3,20,2,22,3,25,3
2150 DATA 28,4,28,4,32,3,35,5,40,9,40,9,40,9,40,9,40,9,40,9
2160 DATA 49,2,51,4,55,4,59,4,63,1,63,1,64,5,69,5,74,2,76,4
2170 DATA 80,3,83,7,90,3,93,6,99,7,106,6
2180 REMark  PRINT THE REPLY
2190 REMark 'IF PEEK(16416)+PEEK(16417)*256=16256 THEN CLS
2200 PRINT :FOR X=1 TO LEN(X$):PRINT MID$(X$,X,1);
2210 REMark SLOWDOWN LOOP
2220 FOR TM=1 TO 20: NEXT TM:NEXT X:PRINT : RETurn
2230 DEFine FuNction LEFT$(NAME$,LL)
2240 ANS$=NAME$(1 TO LL)
2250 RETurn ANS$
2260 END DEFine
2270 DEFine FuNction RIGHT$(NAME$,LL)
2280 START=LEN(NAME$)-LL+1
2290 IF START=0 THEN RETurn ANS$=""
2300 ANS$=NAME$(START TO LEN(NAME$))
2310 RETurn ANS$
2320 END DEFine
2330 DEFine FuNction MID$(NAME$,ST,LL)
2340 ANS$=NAME$(ST TO ST+LL-1)
2350 RETurn ANS$
2360 END DEFine
2370 DEFine PROCedure SAVEIT
2380 DELETE MDV2_ELIZA_BAS:SAVE MDV2_ELIZA_BAS
2390 END DEFine