|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 42240 (0xa500)
Types: TextFile
Names: »ANALIZA2.BAS«
└─⟦9f1fc2afd⟧ Bits:30005939 Spil: Pacman, Invaders, Kong til RC700
└─⟦this⟧ »ANALIZA2.BAS«
REM ***********************************************Ø
* ANALIZA2 Copyright 4/16/81 J.M. Holland *Ø
* Version 1.17 *Ø
* Please send corrections to: *Ø
* John M. Holland *Ø
* Consultant *Ø
* Rt 1, Box 175 *Ø
* Shawsville, Va. 24162 *Ø
***********************************************
REM REMOVE THIS LINE TO ACTIVATE %CHAIN FOR .INT VERSION Ø
%CHAIN 8,18349,0,960
COMMON INITIALIZE%,GAB$(1),FILENAME$,CYCLE%,Ø
IRRITABLE%,QUES%,MAX%,B$,FAIL%,EROTIC%,VIOLENT%
REM REMOVE THIS LINE TO ACTIVATE POKE FOR .INT VERSION Ø
1 POKE 272,0 REM THIS SETS INFINITE CONSOLE WIDTH
REM -------------------------------------------------------
10 IF END # 1 THEN 269
OPEN "ANALIZA.CON" AS 1
IF END # 1 THEN 270
DIM GAB$(5) REM GAB$(1)=FROM PERSONAL FILE + GENERAL
REM GAB$(2)=FROM LAST PATIENT
REM GAB$(3)=FROM THIS PATIENT
REM GAB$(4)=FROM 3 OVERFLOW OR HOLD$
REM GAB$(5)=TO FILE
FOR CNTR%=1 TO 5 :GAB$(CNTR%)="":NEXT CNTR%
265 READ #1; THRESHOLD%
DIM RATE%(25) REM CRACKER RATES OF AGEING
FOR CNTR%=1 TO 25
READ #1; RATE%(CNTR%) REM FROM CONSTANT.DAT
NEXT CNTR%
DIM QUAL%(25) REM CRACKER QUALITY FACTORS
FOR CNTR%=1 TO 25
READ #1; QUAL%(CNTR%) REM FROM CONSTANT.DAT
NEXT CNTR%
DIM AGE%(25) REM CRACKER AGES
DIM SCORE%(25) REM CRACKER SCORES
DIM FOCUS%(3) REM HE SHE THEY FOCUS
DIM FLAG%(25) REM CRACKER ALTERNATOR FLAGS
FOR CNTR%=1 TO 25
FLAG%(CNTR%)=0
NEXT CNTR%
READ #1;UR$
READ #1;RU$
READ #1;CONT$
READ #1;ENOUN$
READ #1;EMOT$
EMOT$=EMOT$+ENOUN$
READ #1;SCARE$
READ #1;SIGNIF$
READ #1;NORMAL$
READ #1;CERT$
READ #1;AFIRM$
AFIRM$=AFIRM$+CERT$
READ #1;NEG$
READ #1;FEMALE$
READ #1;MALE$
READ #1;GROUP$
READ #1;BAD$
REM ---------- PRINT HEADING HERE -------------------
IF INITIALIZE%=1 THEN CLOSE 1:GOTO 334
268 READ #1;R$
PRINT R$
GOTO 268
269 PRINT "NO CON FILE"
STOP
270 CLOSE 1 REM RELEASE CONSTANT FILE SPACE
SUBJ$=" "
320 INPUT MAX%
334 RANDOMIZE
DIM N%(100) REM FRAGMENT POINTERS
FOR CNTR%=1 TO 100
N%(CNTR%)=INT%(RND*3.) REM RANDOMIZE ARRAY
NEXT CNTR%
N%(99)=1:N%(5)=1:N%(14)=1: REM MUST BE SAME EACH TIME
RANDOM%=INT%(RND*4.)
350 PRINT:PRINT"I AM ANALIZA"
360 IF END # 1 THEN 367
OPEN "PATIENTS.LST" AS 1
IF END # 1 THEN 365
READ #1 ;M$
365 CLOSE 1 REM RELEASE SPACE
367 PRINT:PRINT"WHAT IS YOUR NAME?"
370 GOSUB 3640 REM INPUTS R$
GOSUB 9200 REM COUNT WORDS
IF LEN(R$)<3 THEN 367
IF WORDS%>2 THEN PRINT"YOUR FIRST NAME?":GOTO 370
IF WORDS%=2 THEN Ø
B$=MID$(R$,2,MATCH(" ",R$,2)-1):Ø
D$=MID$(R$,MATCH(" ",R$,2)+1,LEN(R$)):GOTO 385
IF WORDS%<>1 THEN 367
B$=MID$(R$,2,LEN(R$))
380 PRINT:PRINT"YOUR LAST NAME?"
GOSUB 3640
GOSUB 9200
IF LEN(R$)<3 THEN 380
IF WORDS%<>1 THEN 380
D$=MID$(R$,2,LEN(R$))
385 FILENAME$=LEFT$(B$,4)+LEFT$(D$,4)+".DAT"
387 T%=MATCH(" ",FILENAME$,1) REM REMOVE SPACES
IF T%>0 THEN Ø
FILENAME$=LEFT$(FILENAME$,T%-1)+Ø
MID$(FILENAME$,T%+1,LEN(FILENAME$)):GOTO 387
T%=MATCH("*"+B$+"*/+*"+D$,M$,1)
IF T%=0 THEN 400 REM NOT FOUND
REM STRIP NAME FROM M$
T3%=MATCH("*",M$,T%+LEN(B$)+LEN(D$)+3)
IF T3%>0 THEN Ø REM NOT LAST ENTRY IN M$
M$=LEFT$(M$,T%-1)+MID$(M$,T3%,LEN(M$)) Ø
ELSE M$=LEFT$(M$,T%-1)
REM STRIPS LEFT(*) AND LEAVES RIGHT ONE
PRINT"WELCOME BACK "+B$+"...LET ME GET YOUR FILE."
PRINT
GOTO 500
400 PRINT B$+D$+"...RIGHT?" REM VERIFY NAME
PRINT
GOSUB 2395 REM GET YES/NO
IF Y%=0 THEN 367
500 A$=M$+"*"+B$+"*/+*"+D$ REM PUT NEW NAME AT END AND STORE
502 CNTR%=0:T%=1 REM <<<PURGE OF FILES LOOPS HERE
505 IF LEN(A$)>220 THEN 507 REM DELETE DUE TO LIST FULL
T%=MATCH("*/+*",A$,T%+1)
IF T%>0 THEN CNTR%=CNTR%+1 :GOTO 505
IF CNTR%<MAX% THEN 520 REM <<<NO NEED TO DELETE
507 T%=MATCH("*",A$,1)+1
T2%=MATCH("*/+*",A$,T%+1)
T3%=MATCH("*",A$,T2%+4)
C$=MID$(A$,T%,T2%-T%)
D$=MID$(A$,T2%+4,T3%-T2%-5)
PRINT"I AM DISCARDING "+C$+D$+"'S FILE!"
A$=MID$(A$,T3%,LEN(A$))
C$=LEFT$(C$,4)+LEFT$(D$,4)+".DAT"
510 T%=MATCH(" ",C$,1) REM REMOVE SPACES
IF T%>0 THEN Ø
C$=LEFT$(C$,T%-1)+MID$(C$,T%+1,LEN(C$)):GOTO 510
IF END # 1 THEN 515
OPEN C$ AS 1
DELETE 1
515 GOTO 502 REM LOOP TO PURGE MORE FILES
REM REWRITE PATIENT DIRECTORY
520 CREATE "PATIENTS.LST" AS 1
PRINT # 1;A$
CLOSE 1
IF INITIALIZE%=0 THEN 526 REM DONT GOSSIP IF 1ST PATIENT
REM //// GET LAST PATIENT FILE ////
IF END # 1 THEN 526 REM NO FILE SO DONT CLOSE
OPEN "LASTPAT.DAT" AS 1
IF END # 1 THEN 524 REM CLOSE IT
READ #1;GAB$(2) REM GET FILENAME
IF GAB$(2)=FILENAME$ THEN GAB$(2)="" :GOTO 524 REM SAME
READ #1;GAB$(2) REM GET ACTUAL STRING
524 CLOSE 1
526 REM END OF OLD PATIENT FETCH
INITIALIZE%=1
REM FILEOPEN%, PERSONAL%, AND GENERAL% WILL BE Ø
ZERO AT THIS POINT SINCE THEY HAVENT BEEN USED.
P%=1 REM START WITH GAB$(1)
528 GOSUB 1550 REM LOAD ENVIRONMENT & PRINT INTRO
REM RESET COMMON AGES AND PROFILE STORAGE
800 SUBJ$=" "
FOR CNTR%=1 TO 25
AGE%(CNTR%)=25
NEXT CNTR%
805 COGNITION%=860 REM SHORT TERM COGNITION
MIN%=THRESHOLD%
810 REM <<<<<<<<< M A I N L O O P <<<<<<<<<<<<
IF BECAUSE%=CYCLE% THEN BECAUSE$=""
REM AGE DOWN PRONOUNS THAT ARE ALREADY TRAPPED
ITAGE%=ITAGE%-1
IF ITAGE%<1 THEN IT$=" it "
HEAGE%=HEAGE%-1
IF HEAGE%<1 THEN HE$=" he ":HIM$=" him "
SHEAGE%=SHEAGE%-1
IF SHEAGE%<1 THEN SHE$=" she ":HER$=" her "
THEYAGE%=THEYAGE%-1
IF THEYAGE%<1 THEN THEY$=" they ":THEM$=" them "
REM SHUFFLE OVERFLOWING GAB STRINGS
814 IF LEN(GAB$(4))<3 THEN GAB$(4)=GAB$(3):GAB$(3)=""
REM TRIM DOWN COLLECTION GAB STRINGS
IF LEN(GAB$(3))<150 THEN 815
Z2%=MATCH("*P",GAB$(3),3)
IF Z2%=0 THEN Z2%=LEN(GAB$(3))
GAB$(3)=MID$(GAB$(3),Z2%,LEN(GAB$(3)))
815 GOSUB 3640 REM GET R$
IF MATCH("BECAUSE",R$,1)>0 THEN 816
IF REASON%>CYCLE% THEN R$=" BECAUSE"+R$
816 IF TRAPAGE%<1 THEN 828
TRAPAGE%=TRAPAGE%-1 REM TRAP HERE<<<
T$=" IT * THEY * THEM * HE * HIM * SHE * HER "
IF MATCH(CAND$,T$,1)>0 THEN 822 REM IGNORE PRONOUN IN CAND$
IF TRAP$=" ALL " THEN Ø
TRAP$=T$
IF TRAP$=" PERSON " THEN Ø
TRAP$=" HE * SHE * HIM * HER "
IF TRAP$=" HE " THEN TRAP$=" HE * HIM "
IF TRAP$=" SHE " THEN TRAP$=" SHE * HER "
IF TRAP$=" THEY " THEN TRAP$=" THEY * THEM "
T$=TRAP$
GOSUB 2470
IF T%=0 THEN 828 REM NOT TRAPPED
IF TFRAG$=" IT" THEN Ø
IT$=CAND$:ITAGE%=1:GOTO 822
IF TFRAG$=" THEY" THEN 817
IF TFRAG$<>" THEM" THEN 818
817 THEY$=CAND$:THEM$=CAND$:THEYAGE%=8:PLURAL$=CAND$:GOTO 822
818 IF TFRAG$=" HE" THEN 819
IF TFRAG$<>" HIM" THEN 820
819 HE$=CAND$:HIM$=CAND$:HEAGE%=10:GOTO 821
820 SHE$=CAND$:HER$=CAND$:SHEAGE%=10
821 VICTIM$=CAND$
822 TRAPAGE%=0
REM CONVERT PRONOUN STRINGS TO PRONOUNS FOR Ø
IDENTIFICATION BY ALGORITHMS AND FOR FOCUS CALC.
828 T$=HE$+"*"+SHE$+"*"+THEY$
829 TREF%= MATCH("your",T$,1)
IF TREF%>0 THEN Ø
T$=MID$(T$,1,TREF%-1)+"MY"+MID$(T$,TREF%+4,255):GOTO 829
F$=" he * she * they "
GOSUB 2890 REM SUBSTITUTE
IF MATCH("GOODBYE",R$,1)=0 THEN 830
PRINT"GOODBYE ";B$
PRINT"YOUR BILL IS $";CYCLE%;".00!":GOTO 9900
REM CLOSE FILE
830 T$="S YOUR NAME *WHO AM I *WHO ARE YOU *S MY NAME "
GOSUB 2470
IF T%=0 THEN 832
IF LEN(Z$)>11 THEN 832 REM AVOID "WHO ARE YOU TALKING.."
831 PRINT "BE SERIOUS ";B$;"!"
GOTO 810
832 T$=" NOT "+B$+"*ISNT "+B$+"* ME "+B$+"*HELLO * HI "
GOSUB 2470
834 IF T%=0 THEN 942
910 PRINT"AM I STILL TALKING TO ";B$;"?"
920 GOSUB 2395 REM GET Y/N
930 IF Y%=0 THEN 9900
940 PRINT"SORRY, GO ON.":GOTO 810
942 ANSWER$="":REM CLEAR ANSWER
943 T$=AFIRM$ :GOSUB 2470
IF T%=0 THEN 944
ANSWER$=YES$
IF T%<3 THEN R$=" "+Z$: GOTO 943
944 T$=NEG$ :GOSUB 2470
IF T%=0 THEN 946
ANSWER$=NO$
IF T%<3 THEN R$=" "+Z$: GOTO 944
946 CYCLE%=CYCLE%+1
SIZE%=(((CYCLE%-1)*SIZE%)+LEN(R$))/CYCLE% REM AVE LENGTH
T$=" CANT * DONT * NOT ":GOSUB 2470
NEGREF%=T%
T$=BAD$ :GOSUB 2470
BADREF%=T%
T$="SEX* FUCK* SCREW * INTERCOURSE* PUSSY*"+Ø
" HIT* HATE* KILL* HURT* SHOOT"+Ø
"*MURDER* STAB * GUN": GOSUB 2470
IF T%=0 THEN 947
IF T2%<39 THEN EROTIC%=EROTIC%+1: GOTO 947
IF NEGREF%=0 THEN VIOLENT%=VIOLENT%+1
REM WHY$ CAN ANSWER WHY QUESTIONS OR FILL IN 1 WORD Ø
ANSWERS WITH A SENTENCE STRUCTURE.
947 IF LEN(WHY$)<3 THEN 950
TREF%=MATCH("Ø#",WHY$,1)
IF TREF%=0 THEN 948 REM NOT A FILL IN
GOSUB 9200 REM TEST FOR 1 WORD ANSWER
IF WORDS%=1 THEN Ø
R$=" "+MID$(WHY$,1,TREF%-2)+R$+MID$(WHY$,TREF%+2,255)
GOTO 950
948 T$="WHY *WHY DO *WHY DID *MADE YOU *MAKES YOU "
GOSUB 2470
IF T%=0 THEN 950
IF T2%+LEN(Z$)<3 THEN 949 REM MEANS R$=" WHY "
TREF%=T%
T$=" SAY * TO KNOW * BELIEVE * THINK * ASK ":GOSUB 2470
IF T%<TREF% THEN 950
949 PRINT WHY$: WHY$="": GOTO 810
950 IF MATCH(" MFRE ",R$,1)>0 THENØ
PRINT MFRE :GOTO 810
REM ///// MAIN DISTRIBUTOR ////
960 TEST%=1: SAV$=R$: WHY$=""
970 T5%=1
1000 IF T5%>20 THEN 1045
IF T5%>10 THEN 1040
IF T5%<=0 THEN 1050
ON T5% GOSUB 1480,1240,1340,1410,1080Ø
,3350,1640,3090,1710,1820
GOTO 1050
1040 ON T5%-10 GOSUB 1940,2020,3230,3540,3780Ø
,3850,3980,4060,4160,4290
GOTO 1050
1045 ON T5%-20 GOSUB 6000,8000,5800,7000,9000
1050 IF TEST%=0 THEN 810
AGE%(T5%)=RATE%(T5%)+AGE%(T5%)
IF AGE%(T5%)>25 THEN AGE%(T5%)=25
IF T%=0 THEN SCORE%(T5%)=0: GOTO 1057
1055 PFACT%=INT%(20*(1-(T%/(2*LEN(R$)))))
SCORE%(T5%)=PFACT%*QUAL%(T5%)*AGE%(T5%)
1057 T5%=T5%+1 :R$=SAV$
IF T5%<26 THEN 1000
1060 TEST%=0 :BEST%=0 :
YES$="":NO$=""
FOR CNTR%=1 TO 25
IF SCORE%(CNTR%)>BEST% THEN BEST%=SCORE%(CNTR%)Ø
:T5%=CNTR%
NEXT CNTR%
IF LEN(ANSWER$)>3 THEN BEST%=BEST%/3 REM BIAS FOR ANSWER
REM INCREASE BOREDOM THRESHOLD
MIN%=MIN%+THRESHOLD%/3 REM INCREASE BOREDOM THRESHOLD
IF LEN(VICTIM$)>1 THEN MIN%=MIN%+THRESHOLD%/3
IF BEST%<MIN% THEN 1065
AGE%(T5%)=RATE%(T5%) REM AGE ALGORITHM
IF FLAG%(T5%)>0 THEN FLAG%(T5%)=0 ELSE FLAG%(T5%)=1
1063 T6%=T5%
COGNITION%=(100+2*COGNITION%)/3
GOTO 1000 REM MEETS MINIMUM
1065 REM ----NO CRACKER PASSES----
1070 IF LEN(ANSWER$)<2 THEN 1075
PRINT ANSWER$ :GOTO 810
1075 FAIL%=FAIL%+1
COGNITION%=(2*COGNITION%)/3
IF LEN(TOPIC$)<2 THEN R$=SAV$: GOTO 1077
PRINT TOPIC$
TOPIC$=""
GOTO 810
1077 MIN%=THRESHOLD%
GOSUB 1550 REM ACCESS STRINGS
GOTO 810
1080 T$=UR$+"*YOURE"
1090 GOSUB 2470
1100 IF T%=0 THEN RETURN
1105 IF LEN(Z$)<6 THEN T%=0:RETURN
1170 IF NEGREF%>0 THEN T%=0: RETURN REM SCREEN NEGATIVE CASES
TREF%= BADREF% REM SAVE NEGATIVE REFERENCE
IF CURSE%>0 THEN TREF%=1
IF TEST%=0 THEN 1180
IF TREF%>0 THEN IRRITABLE%=IRRITABLE%+4
T%=1 : RETURN
1180 I$="TRUE,*DOES IT PLEASE YOU TO BELIEVE*"Ø
+"I DONT FEEL*ARE YOU FANTASIZING THAT"
D$=", "+B$+"?"
IF TREF%>0 THEN Ø
I$="DEGRADE ME*ELEVATE YOURSELF*HUMILIATE ME"
1190 GOSUB 2630
IF TREF%=0 THEN IFRAG$=IFRAG$+" I AM "
1200 GOSUB 2770
1210 IF LEN(Z$)=1 THEN Z$=Z$+" "
1215 C$=IFRAG$
IF TREF%>0 THEN Ø
C$="ARE YOU SAYING I AM ": D$=" TO "+IFRAG$+D$
IF LEN(Z$)<3 THEN 1220
HOLD%=CYCLE%+6
IF TREF%=0 THEN 1220 REM FALL THRU IF HE INSULTED US.
GAB$(4)="*PEARLIER YOU SAID I WAS "+Z$+"."+Ø
"* DO YOU STILL THINK SO?*NI AM GLAD YOU REALIZE YOUR "+Ø
"MISTAKE!*YVERY WELL, PERHAPS I AM "+Z$+"!"
IF LEN(GAB$(5))+LEN(Z$)<250 Ø REM CANT USE 9800 (D$ USED)
THEN GAB$(5)=GAB$(5)+"*U"+Z$
1220 A$=C$+MID$(Z$,1,LEN(Z$)-1)
IF LEN(C$)<19 THEN D$="."
PRINT A$;D$
IF TREF%>0 THEN A$=""
IF LEN(C$)>18 THEN YES$="WHY "+A$+"?"
BECAUSE$="YOU SAID IT ":BECAUSE%=CYCLE%+2
NO$="REALLY?" :TOPIC$=""
1230 RETURN
1240 T$=" IM * I AM * I WAS * I USED TO BE "
1250 GOSUB 2470
1260 IF T%<>1 THEN T%=0: RETURN
1270 IF TEST%=1 THEN RETURN
IF T2%>7 THEN A$="WERE " ELSE A$="ARE "
GOSUB 2770
F$=A$: A$=Z$: R$=Z$
T$="AN *THE *A ":GOSUB 2470
Z$=A$
IF T%<>1 THEN 1275
D$="*PTELL ME MORE ABOUT BEING "+A$+"."+Ø
"*NPLEASE!*YGOOD...GO AHEAD.*C BEING "+A$+"*R IT "
IF LEN(GAB$(3))+LEN(D$)<250 THEN GAB$(3)=GAB$(3)+D$
D$="*I"+A$
GOSUB 9800
TRAPAGE%=1 : TRAP$=" IT ":CAND$=" BEING "+A$
I$="TELL ME *HOW DO YOU FEEL *DO YOU FEEL GOOD "
IF F$="WERE " THEN Ø
I$="WHAT DID YOU FEEL *WHAT WERE YOUR FEELINGS "
GOSUB 2630
PRINT IFRAG$+"ABOUT BEING "+Z$+"?"
NO$=RU$+"ASHAMED THAT YOU "+F$+Z$+"?":YES$="GO ON "+B$+"."
RETURN
1275 I$="BECAUSE...*WHY "+F$+"YOU "+Z$+"?*OF COURSE YOU "+F$+Z$+"."
GOSUB 2630
PRINT IFRAG$
TOPIC$="SO YOU "+F$+Z$+"...INTERESTING."
BECAUSE%=CYCLE%+1
IF I2%=1 THEN REASON%=CYCLE%+1
BECAUSE$="YOU "+F$+Z$
1330 RETURN
1340 IF WHODATE%<>CYCLE%+9 THEN T%=0 :RETURN
IF LEN(R$)<3 THEN T%=0: RETURN
T$=" MY * THE * A * THOSE * THAT ":GOSUB 2470
IF T%=1 THEN 1345
GOSUB 9200 REM COUNT WORDS
IF WORDS%<3 THEN 1345 REM CATCH NAMES
T%=0 :RETURN REM ONLY AS 1ST WORD
1345 IF TEST%=1 THEN T%=1: RETURN
TRAP$=" "+MID$(TOPIC$,1,MATCH(" ",TOPIC$,2)) REM " HE "ETC
TRAPAGE%=3
TOPIC$=MID$(TOPIC$,MATCH(" ",TOPIC$,1)+1,255) REM STRIP HE
T$=" "+MID$(TOPIC$,1,MATCH(" ",TOPIC$,1))+Ø REM " IS " ETC
"* IS * ARE * DO * WILL * HAVE * DOES* ISNT *"+Ø
" ARENT * WONT * CANT * SHOULD* COULD* DID * DIDNT "
GOSUB 2470
IF T%>0 THEN R$=MID$(R$,1,T%)
Z$=R$:GOSUB 2770
Z$=" "+Z$ REM REPLACE SPACE
CAND$=Z$
Z$=MID$(Z$,2,255) REM STRIP LEADING SPACE
1350 PRINT Z$+TOPIC$ REM eg:THE CIA IS AFTER YOU...OF COURSE
NO$="EXPLAIN?":YES$="OF COURSE..."+Z$+"...GO ON."
TOPIC$="I THOUGHT YOU MEANT "+Z$+"."
RETURN
1410 T$="COMPUTER*MACHINE*PROCESSOR"
1420 GOSUB 2470
1430 IF T%=0 THEN RETURN
TFRAG$=TFRAG$+"S "
TRAPAGE%=2:TRAP$=" THEY ":CAND$=" "+TFRAG$
IF TEST%=1 THEN T%=1 :RETURN
1440 I$=SCARE$
1450 GOSUB 2630
IF FLAG%(T6%)=0 THEN Ø
PRINT"IT DOES SEEM THAT "+TFRAG$+IFRAG$+"YOU!":Ø
RATE%(4)=0: GOTO 1465
1460 PRINT"DO ";TFRAG$;IFRAG$;"YOU ";B$;"?"
1465 YES$="WHY DO THEY "+IFRAG$+"YOU?"
BECAUSE%=CYCLE%+2
BECAUSE$=TFRAG$+IFRAG$+"YOU "
I$=CONT$ :GOSUB 2630
NO$="I AM GLAD..."+IFRAG$+"."
1470 RETURN
1480 T$=" SHIT* PISS*FUCK* CRAP* HELL *DAMN* ASS *BITCH"+Ø
"*BASTARD"
1490 GOSUB 2470
1500 CURSE%=T%
IF T%=0 THEN RETURN
IRRITABLE%=IRRITABLE%+1
IF TEST%=1 THEN T%=1 : RETURN
TRAPAGE%=1:TRAP$=" IT ":CAND$=" PROFANITY "
1510 I$="IS UNNECESSARY!*SERVES NO PURPOSE."
1520 GOSUB 2630
IF FLAG%(T6%)<>0 THEN 1530
PRINT "AGAIN "+B$+", SUCH LANGUAGE "+IFRAG$
GOTO 1540
1530 PRINT"NOW ";B$;", PROFANITY ";IFRAG$
TOPIC$="YOUR CURSING ISNT HELPING!"
1540 RETURN
REM PRINT FROM GAB STRINGS 1-4
1550 IF P%>4 THEN P%=1
Z%=P% REM SAVE GAB POINTER IN Z%
GAB$(1)="" REM CLEAR FOR NEW .DAT STRING
1560 IF P%=1 THEN GOSUB 1610
T%=MATCH("*P",GAB$(P%),1)
IF P%<4 THEN 1562
IF HOLD%>CYCLE% THEN 1564 REM HOLDING GAB$(4)
1562 IF T%>0 THEN 1565
GAB$(P%)=""
1564 P%=P%+1
IF P%>4 THEN P%=1
IF P%=Z% THEN Ø
PRINT"SORRY, TIME IS UP "+B$+"!"Ø
:GOTO 9900 REM ALL EMPTY CHAIN ANALIZA+ (STACK CLEARED)
GOTO 1560
1565 IF T%>1 THEN GAB$(P%)=MID$(GAB$(P%),T%,LEN(GAB$(P%)))
GOSUB 1600
TOPIC$=""
IF A$="P" THEN PRINT D$
1570 GAB$(P%)=MID$(GAB$(P%),T2%,LEN(GAB$(P%)))
GOSUB 1600
IF T%=0 THEN 1580
IF A$=" " THEN PRINT D$:GOTO 1570 REM AUX LINE
IF A$="Y" THEN YES$=D$:GOTO 1570
IF A$="N" THEN NO$=D$:GOTO 1570
IF A$="T" THEN TOPIC$=D$:GOTO 1570
IF A$="C" THEN CAND$=D$:GOTO 1570
IF A$="W" THEN WHY$=D$:GOTO 1570
IF A$<>"R" THEN 1575
TRAP$=D$:TRAPAGE%=2
IF D$=" IT " THEN TRAPAGE%=1
GOTO 1570
1575 IF A$="B" THEN BECAUSE$=D$:BECAUSE%=CYCLE%+2:GOTO 1570
1580 P%=P%+1 : RETURN REM DO NEXT ONE NEXT TIME
1600 IF LEN(GAB$(P%))<3 THEN 1605 REM EMPTY
T%=MATCH("*",GAB$(P%),1)
IF T%=0 THEN 1605
IF T%>1 THEN Ø
GAB$(P%)=MID$(GAB$(P%),T%,LEN(GAB$(P%))):GOTO 1600
T2%=MATCH("*",GAB$(P%),T%+1)
IF T2%=0 THEN T2%=LEN(GAB$(P%))+1
A$=MID$(GAB$(P%),T%+1,1)
D$=MID$(GAB$(P%),T%+2,T2%-T%-2)
X%=MATCH("B$",D$,1) REM SUBSTITUTE NAME
IF X%>0 THEN D$=MID$(D$,1,X%-1)+MID$(B$,1,LEN(B$)-1)+Ø
MID$(D$,X%+2,LEN(D$))
RETURN
1605 T%=0:GAB$(P%)="":RETURN
REM LOAD A STRING ENVIRONMENT FROM A .DAT FILE TO GAB$(1)
1610 IF PERSONAL%=1 THEN 1611 REM PERSONAL FILE ALREADY OPENED
PERSONAL%=1
IF END # 1 THEN 1613 REM DONT CLOSE IF NOT OPENED
OPEN FILENAME$ AS 1
IF END # 1 THEN 1612 REM CLOSE FILENAME.DAT WHEN EMPTY
FILEOPEN%=1
1611 IF FILEOPEN%=0 THEN 1613
READ # 1;GAB$(1) REM CONDITIONAL STRING READ
GOTO 1616
1612 CLOSE 1 REM EXHAUSTED PATIENT FILE
INTRODUCED%=1
FILEOPEN%=0
1613 IF GENERAL%=1 THEN RETURN REM HAVE ALREADY EXHAUSTED GEN
GENERAL%=1
IF END # 1 THEN 1613 REM NO GENERAL.DAT FILE
OPEN "GENERAL.DAT" AS 1
IF END # 1 THEN 1612 REM CLOSE GENERAL WHEN EMPTY
FILEOPEN%=1
READ # 1;GAB$(1) REM READ IN INTRODUCTION STRING
IF INTRODUCED%=1 THEN 1611 REM WILL NOT PRINT INTRO
1616 REM END OF .DAT FETCH
1622 GOSUB 1600 REM GET CONDITION SYMBOL IN A$
IF A$="P" THEN 1638
IF A$<>"I" THEN 1623
IF IRRITABLE%*10/(CYCLE%+1)>1 THEN 1635 REM SUBST.*P
1623 IF A$<>"E" THEN 1624
IF EROTIC%>3 THEN 1635
1624 IF A$<>"L" THEN 1625
IF SIZE%>25 THEN 1635
1625 IF A$<>"V" THEN 1626
IF VIOLENT%>3 THEN 1635
1626 IF A$<>"S" THEN 1628
IF SIZE%<12 THEN 1635
1628 IF A$<>"F" THEN 1629
IF COGNITION%<33 THEN 1635
1629 IF A$<>"Q" THEN 1630
IF QUES%>6 THEN 1635
1630 IF LEN(VICTIM$)=0 THEN 1631
IF A$="H" THEN D$=VICTIM$ Ø
:GAB$(1)=GAB$(1)+"*R PERSON *C"+D$ :GOTO 1639
GOTO 1632 REM SKIP *U IF VICTIM PRESENT
1631 IF A$="U" THEN 1635
1632 IF A$<>"M" THEN 1634
IF LEN(PLURAL$)>0 THEN D$=PLURAL$Ø
:GAB$(1)=GAB$(1)+"*R THEY *C"+D$ :GOTO 1639
1634 GOTO 1611 REM READ ANOTHER STRING
1635 IF MATCH("+",GAB$(1),1)=3Ø REM CHECK FOR 2ND CONDITION
THEN GAB$(1)="*"+MID$(GAB$(1),4,255):GOTO 1622
GAB$(1)="*P"+MID$(GAB$(1),3,255) REM CHANGE COND TO PRN
MIN%=MIN%+1000 REM RAISE THRESHOLD TO CAUSE QUICKER Ø
USE OF GOOD CONDITIONAL STRING.
1638 RETURN
1639 REF%=MATCH("X$",GAB$(1),1) REM DO X$ SUBSTITUTION
IF REF%>0 THEN Ø
GAB$(1)=MID$(GAB$(1),1,REF%-1)+MID$(D$,2,LEN(D$)-2)+Ø
MID$(GAB$(1),REF%+2,255) :GOTO 1639
GAB$(1)=UCASE$(GAB$(1)): GOTO 1635
1640 T$=" I "
1650 GOSUB 2470
1660 IF T%=0 THEN RETURN
TREF%=T%
T$=EMOT$ :GOSUB 2470
IF T%=0 THEN RETURN
IF T%>TREF%+10 THEN T%=0 :RETURN
IF T%<TREF% THEN T%=0 :RETURN
IF LEN(Z$)<10 THEN T%=0 :RETURN
IF TEST%=1 THEN RETURN
D$=TFRAG$
IF NEGREF%=0 THEN 1670 REM SCREEN NEGATIVE MEANINGS
IF NEGREF%<T% THEN 1705
1670 GOSUB 2770
IF FLAG%(T6%)=0 THEN 1701
I$="TEND *SEEM *ARE PRONE "
1680 GOSUB 2630
1690 BECAUSE$="YOU "+IFRAG$+"TO "+D$+" "+Z$:BECAUSE%=CYCLE%+1
PRINT BECAUSE$+"BECAUSE..."
REASON%=CYCLE%+1
NO$="NO?"
1700 RETURN
1701 I$="MUST LEARN *SHOULD TRY TO UNDERSTAND " :GOSUB 2630
PRINT "WE "+IFRAG$+"WHY YOU "Ø
+D$+" "+Z$+"."
NO$="NO?"
YES$="GOOD...TELL ME YOUR OPINION."
TOPIC$="I NEED TO UNDERSTAND WHY YOU "Ø
+D$+" "+Z$+"."
RETURN
1705 GOSUB 2770
I$=CERT$ :GOSUB 2630
Z$="YOU DONT "+D$+" "+Z$
PRINT IFRAG$+", "+Z$+"."
YES$="WHAT DO YOU "+D$+"?"
TOPIC$="EXPLAIN WHY "+Z$+"."
BECAUSE$=Z$:BECAUSE%=CYCLE%+1
RETURN
1710 T$=" HOW * WHAT * WHO * WHERE * WHY "
1720 GOSUB 2470
1730 IF T%<>1 THEN T%=0 :RETURN
IF TEST%=0 THEN 1731
T%=1
IF AGE%(T5%)<5 THEN AGE%(T5%)=5
RETURN
1731 QUES%=QUES%+1
IF T2%<>7 THEN 1734 REM CATCH "WHAT SHOULD I SAY "
A$=Z$ :D$=TFRAG$
T$=" I * DO YOU MEAN * ME * YOU ":GOSUB 2470
IF T%=0 THEN 1733
IF T2%=5 THEN PRINT"YOU KNOW WHAT I MEAN."Ø
:YES$="RIGHT!":GOTO 1739
T$=" SAY * TELL * DISCUSS * TO KNOW "
GOSUB 2470
IF T%=0 THEN 1733
I$="IS TROUBLING YOU*SEEMS IMPORTANT TO YOU*EVER YOU LIKE"
GOSUB 2630
PRINT "TELL ME WHAT ";IFRAG$;"."
YES$="FINE...GO ON.":NO$=UR$+"MAKING THIS HARD."
TOPIC$="YOU SEEM INHIBITED, "+B$+".":RETURN
1733 Z$=A$ :TFRAG$=D$ :T2%=7
1734 IF T2%>2 THEN 1740
A$=Z$ :D$=TFRAG$
T$="DO *COULD *DOES *WOULD *SHOULD *CAN *WILL "
GOSUB 2470
IF T%=0 THEN 1735
IF T%<8 THEN Z$=A$ :TFRAG$=D$ :GOTO 1740
1735 I$="ONLY YOU CAN *I CANT *PERHAPS YOU COULD "
GOSUB 2630
PRINT IFRAG$+"ANSWER THAT."
1739 T%=1: NO$="THINK ABOUT IT.":RETURN
1740 A$=R$
1742 D$=TFRAG$
1744 R$=Z$
1745 IF LEN(Z$)<6 THEN Z$="": GOTO 1790
1747 IF MATCH("DO ",R$,1)=1 THEN Ø
R$="SHOULD"+MID$(R$,3,LEN(R$))
1748 IF MATCH("DOES ",R$,1)=1 THEN Ø
R$="SHOULD"+MID$(R$,5,LEN(R$))
1750 T$="CAN *WILL *AM *ARE *IS *SHOULD *WOULD *HAVE *COULD "Ø
+"*WAS "
1755 GOSUB 2470
1757 F$=TFRAG$
1760 IF T%<>1 THEN T%=1:Z$=", "+B$:GOTO 1790
1763 R$=" "+Z$
1764 A$=Z$
1765 T$=" A * AN * THE * MY * YOUR * HIS * HER "Ø
+"* ITS * OUR * THOSE * THAT * THEIR *ING "
1766 GOSUB 2470
1767 Z$=A$
1768 IF T%>0 THEN Z$=F$+" "+Z$:GOTO 1780
1770 Z$=MID$(Z$,1,MATCH(" ",Z$,2))+F$+MID$(Z$,MATCH(" ",Z$,2),LEN(Z$))
1780 GOSUB 2770
1790 IF FLAG%(T6%)=1 THEN 1795
I$="WONDER*WANT TO KNOW*ASK*PRETEND YOU DONT KNOW":GOSUB 2630
PRINT "WHY DO YOU "+IFRAG$+D$+" "+Z$+"?"
BECAUSE$="YOU "+IFRAG$+" ":BECAUSE%=CYCLE%+1
RETURN
1795 I$="TEND TO THINK *SUPPOSE *SUSPECT *FIGURE "
1800 GOSUB 2630
1810 PRINT D$;" DO YOU ";IFRAG$;Z$;"?"
RETURN
1820 T$=" ABOUT * MY * DISCUSS ":GOSUB 2470
IF T%=0 THEN RETURN
IF LEN(Z$)<3 THEN T%=0 :RETURN
R$=" "+Z$
TREF%=T2%
T$=FEMALE$+"*"+MALE$+"*"+GROUP$Ø
+"*CHILDHOOD *SEX LIFE *"Ø
+"LIFE *PAST *SEX "
1860 GOSUB 2470
1870 IF T%>0 THEN 1875
1872 T$=" IS * ARE * WERE * HAS * HAVE * CAN * WILL "
GOSUB 2470
IF T%>0 THEN R$=LEFT$(R$,T%)
GOSUB 9200 REM COUNT WORDS
IF WORDS%=1 THEN TFRAG$=MID$(R$,2,LEN(R$)-2):GOTO 1890
T%=0 :RETURN
1875 IF MATCH(" ",R$,T%-1)<>T%-1 THEN 1872
Z1%=1:Z2%=T%:GOSUB 9210 REM COUNT WORDS FROM MY TO MATCH
IF WORDS%>2 THEN T%=0 :RETURN
IF WORDS%>0 THEN Ø
TFRAG$=MID$(R$,2,T%-2)+TFRAG$
1890 D$=" "
IF TREF%<>9 THEN 1896 REM ONLY "MY" SUBJECTS TO SUBJ$
TP%=MATCH(TFRAG$,SUBJ$,1)
IF TP%=1 THEN T%=0 :RETURN
IF TEST%=1 THEN 1894 REM AVOID PUTTING ON SUBJECT$
IF TP%=0 THEN 1893
IF MATCH("*",SUBJ$,TP%-1)<>TP%-1 THEN 1893 REM TWO WORDS
PRINT"YES, WE WERE DISCUSSING YOUR "+TFRAG$+" EARLIER."Ø
:SUBJ$=MID$(SUBJ$,1,TP%-1) REM REORDER SUBJ$
1893 SUBJ$=TFRAG$+"*"+SUBJ$:SUBJDATE%=CYCLE%+24
IF MATCH(TFRAG$,GAB$(5),1)=0 THEN D$="*S"+TFRAG$+" ":Ø
GOSUB 9800 REM SUBJECT TO DISK
1894 D$=" your "
1896 CAND$=D$+TFRAG$+" "
IF T%=0 THEN TRAP$=" ALL ":TRAPAGE%=1:GOTO 1902
IF T2%<LEN(FEMALE$)+LEN(MALE$)+LEN(GROUP$) THEN 1897
TRAP$=" IT ":TRAPAGE%=1:GOTO 1902
1897 IF T2%>LEN(FEMALE$)+LEN(MALE$) THEN Ø
TRAP$=" THEY ":GOTO 1900
TRAP$=" PERSON "
1900 TRAPAGE%=3
1902 IF TREF%<>9 THEN T%=0 : RETURN
IF TEST%=1 THEN T%=1 : RETURN REM AFTER TRAPPING
I$="HOW DO YOU FEEL *I WANT TO KNOW MORE *TELL ME "
1910 GOSUB 2630
1920 PRINT IFRAG$;"ABOUT YOUR ";TFRAG$;"."
I$=SCARE$ :GOSUB 2630
NO$="DOES IT "+IFRAG$+"YOU TO DISCUSS IT? "
TOPIC$="GO ON ABOUT YOUR "+TFRAG$+"."
1930 RETURN
1940 T$=" IVE * I HAVE "
1950 GOSUB 2470
1960 IF T%=0 THEN RETURN
IF LEN(Z$)<3 THEN T%=0:RETURN
IF TEST%=1 THEN RETURN
1970 GOSUB 2770
1980 I$="TELL ME YOUR FEELINGS ABOUT HAVING *"Ø
+"LETS DISCUSS THE FACT THAT YOU HAVE "
1990 GOSUB 2630
2000 PRINT IFRAG$+Z$;"."
YES$="WELL?"
NO$="ARE YOU AFRAID TO?"
TOPIC$="ITS INTERESTING THAT YOU HAVE "+Z$+"."
2010 RETURN
2020 T$="REAGAN */+*HOLLAND "+M$ REM NAME CRACKER
2025 GOSUB 2470
2030 IF T%=0 THEN RETURN
IF MATCH(" ",R$,T%-1)<>T%-1 THEN T%=0 :RETURN
REM CHECK FOR COMPLETE NAME (NOT LAST PART).
TRAPAGE%=2:TRAP$=" PERSON "
CAND$=" "+TFRAG$+" " REM TRAP NAME TO HE-SHE
IF TEST%=1 THEN T%=1 :RETURN
I$="VERY SICK*AN INTERESTING CASE"+Ø
"*A PATIENT OF MINE*BEYOND MY HELP":GOSUB 2630
PRINT TFRAG$+" IS "+IFRAG$+"!"
TOPIC$="HOW DO YOU FEEL ABOUT "+TFRAG$+"?"
YES$="ABSOLUTELY!":WHY$="TAKE MY WORD!"
RETURN
2041 REM
REM ///////////// YES TEST ////////////////////
2395 GOSUB 3640 REM GET R$
2400 REM ENTER WITHOUT GETTING R$
2401 Y%=1
T$=AFIRM$
GOSUB 2470
IF T%=0 THEN Y%=0
2402 IF Y%=1 THEN RETURN
2403 T$=NEG$
2404 GOSUB 2470
2405 IF T%>0 THEN RETURN REM NEG RESP.
2408 PRINT "DOES THAT MEAN YES?"
2409 GOTO 2395
2470 REM ////////////// TEST T$ ///////////////////
2471 REM (Look for one of T$ substrings in R$)
2480 T4%=0
2490 T2%=1
2500 IF LEN(R$)<2 THEN T%=0:RETURN
2505 START%=1 REM START% IS USED WHEN 2510 IS CALLED TO
REM PREVENT SUBSTITUTING INTO SUBSTITUTIONS
T4%=T4%+1 REM COUNT POSITION
2510 T2%=MATCH("*",T$,T2%)+1 REM <<<SECONDARY ENTRY (FOR SUBS)
2520 T3%=MATCH("*",T$,T2%)-1
2530 IF T3%<T2% THEN T3%=LEN(T$)
2550 C$=MID$(T$,T2%,T3%-T2%+1)
2560 T%=MATCH(C$,R$,START%)
2570 IF T%=0 THEN GOTO 2610
2580 IF MID$(T$,T3%,1)=" " THEN T3%=T3%-1
2590 IF T%+LEN(C$)>LEN(R$) THEN Z$=" ":GOTO 2621
2600 IF T%>0 THEN Ø
Z$=MID$(R$,T%+T3%-T2%+2,LEN(R$)):GOTO 2621
2610 IF T2%>1 THEN 2505 REM NEXT TFRAG CAN START AT 1
2620 RETURN REM FAILED TO FIND ANY R$
2621 TFRAG$=MID$(T$,T2%,T3%-T2%+1):RETURN REM FOUND ONE
2630 REM /////////// PICK ONE I$ //////////////////////
2623 REM (Picks one I$ substring on a rotating basis)
2640 I2%=1
2650 N2%=1:N3%=1
2660 IF MATCH("*",I$,N2%)>0 THEN Ø
N2%=MATCH("*",I$,N2%)+1 Ø
:N3%=N3%+1 : GOTO 2660
2670 N%(T5%)=N%(T5%)+1
2680 IF N%(T5%)>N3% THEN N%(T5%)=1
2690 N1%=N%(T5%)
IF T5%<25 THEN T5%=T5%+75
IF T5%>25 THEN T5%=T5%-25
2720 I2%=MATCH("*",I$,I2%)+1
2730 I3%=MATCH("*",I$,I2%)-1
2740 IF I3%<I2% THEN I3%=LEN(I$)
2750 N1%=N1%-1
2755 IF N1%>0 THEN 2720
IFRAG$=MID$(I$,I2%,I3%-I2%+1)
2760 RETURN
REM ////////// PERSON CHANGER //////////////////
2770 R$=Z$
IF MATCH(" ",R$,1)<>1 THEN R$=" "+Z$
2800 T$=" I WAS * YOU WERE * ARE YOU *"Ø
+" I AM * MY * I * MINE * ME *"Ø
+" MYSELF * IM *"Ø
+" IVE * YOU ARE * YOU ARENT * YOU * YOURSELF * YOURE *"Ø
+" YOUR * YOURS * YOUVE * ANALIZA "
2810 F$=" you were * i was * am i *"Ø
+" you are * your * you * yours *"Ø
+" you * yourself * you are *"Ø
+" youve * i am * i am not * THIS ENTITY *"Ø
+" myself * i am *"Ø
+" my * mine * i have * ..."
PROREF%=LEN(T$)+4 REM USED TO LIMIT PRONOUNS TO 1 SUBST.
REM THE PRONOUN STRINGS WILL BE SUBSTITUTED IF ROOM
IF LEN(F$)+LEN(IT$)+LEN(HE$)+LEN(SHE$)+LEN(THEY$)<247 Ø
THEN T$=T$+"* IT * HE * SHE * THEY ":Ø
F$=F$+"*"+IT$+"*"+HE$+"*"+SHE$+"*"+THEY$
IF LEN(F$)+LEN(HIM$)+LEN(HER$)+LEN(THEM$)<248 Ø
THEN T$=T$+"* HIM * HER * THEM ":Ø
F$=F$+"*"+HIM$+"*"+HER$+"*"+THEM$
2890 T$="#%#*"+T$ : F$="%#%*"+F$ REM NULL FIRST ENTRY
IF LEN(R$)<2 THEN T%=0: RETURN
START%=1 REM SEARCH R$ FROM START% (1)
REM SUBSTITUTION LOOP <<<<<<
2900 T4%=0 :T2%=1 REM SET UP TEST T$ ROUTINE FOR MID-ENTRY
2910 GOSUB 2510
2980 IF T%=0 THEN 3062 REM CANT FIND ANY MORE
2990 F4%=0
3000 F2%=1
3010 F4%=F4%+1 REM COUNTING LOOP
3020 F2%=MATCH("*",F$,F2%)+1
3030 F3%=MATCH("*",F$,F2%)-1
3040 IF F3%<F2% THEN F3%=LEN(F$)
3050 IF F4%<T4%+1 THEN 3010
3060 R$=LEFT$(R$,T%)+MID$(F$,F2%+1,F3%-F2%)Ø
+MID$(R$,T%+T3%-T2%+2,200)
START%=T%+F3%-F2%
REM SAME TFRAG SEARCH ONLY AFTER SUBSTITUTION
IF T2%>PROREF% THEN T4%=T4%+1:GOTO 2910
REM DONT SUBST PRONOUN BUT ONCE
T2%=T2%-1 REM TRY THIS TFRAG AGAIN
GOTO 2910
3062 IF LEN(R$)<14 THEN 3070
3065 TEMATCH%=MATCH(" THIS ENTITY",R$,1)
IF TEMATCH%=0 THEN 3070
IF MATCH(" TO ",R$,TEMATCH%)=TEMATCH%+12 THEN 3067
IF TEMATCH%>LEN(R$)-13 THEN 3067
GOTO 3068
3067 R$=MID$(R$,1,TEMATCH%)+"ME"+MID$(R$,TEMATCH%+12,100)
3068 TEMATCH%=MATCH(" THIS ENTITY",R$,1)
IF TEMATCH%=0 THEN 3070
IF TEMATCH%<LEN(R$)/3 THENØ
R$=MID$(R$,1,TEMATCH%)+"I"Ø
+MID$(R$,TEMATCH%+12,LEN(R$))
3070 R$=UCASE$(R$) REM UNLOWER CASE THE SUBSTITUTIONS
Z$=R$
IF MATCH(" ",Z$,1)=1 THEN Z$=MID$(Z$,2,200)
3085 RETURN
REM //////////////////////////////////////////
3090 T$=" I * YOU * HE * SHE * THEY ":GOSUB 2470
3130 IF T%=0 THEN RETURN
D$=TFRAG$+" "
3150 TREF%=T%
3160 T$="CANT *WONT *DONT *SHOULDNT *DIDNT *DOESNT "
3170 GOSUB 2470
3171 IF T%>TREF% THEN 3190
3172 T$="CAN NOT *CANT *DO NOT *DONT *DOES NOT *DOESNT "
3173 GOSUB 2470
3180 IF T%<TREF% THEN T%=0:RETURN
3185 T2%=T3%+3
3187 T3%=MATCH(" ",T$,T2%+1)-1
TFRAG$=MID$(T$,T2%,T3%-T2%+1)
3190 A$=TFRAG$ REM A$="CANT" ETC / D$=" YOU " ETC
3200 IF TEST%=1 THEN T%=1: RETURN
A$=A$+" ":D$=MID$(D$,2,LEN(D$))
IF D$="YOU " THEN D$="i "
Z1%=MATCH(" ANY",Z$,1)
IF Z1%>0 THEN Ø REM CHANGE ANY... TO SOME...
Z$=LEFT$(Z$,Z1%)+"SOME"+MID$(Z$,Z1%+4,255)
I$="WHY "+A$+D$+Z$+"?*PERHAPS IN TIME "+D$+"WILL "+Z$+"."
GOSUB 2630
BECAUSE$=D$+A$
IF I2%=1 THEN BECAUSE%=CYCLE%+1
TOPIC$="YOU STILL WONDER WHY "+D$+A$+Z$+"."
Z$=IFRAG$:GOSUB 2770
PRINT Z$ REM CONVERT PRINT
Z$=BECAUSE$:GOSUB 2770
BECAUSE$=Z$ REM CONVERT BECAUSE
Z$=TOPIC$:GOSUB 2770
TOPIC$=Z$ REM CONVERT TOPIC
3220 RETURN
3221 REM
3230 T$=" THAT IS * THATS * THAT WAS * IT IS * ITS *"Ø
+" THERE ARE * THERE WERE * IT WAS "
3240 GOSUB 2470
3250 IF T%<>1 THEN T%=0 :RETURN
D$=TFRAG$
IF T2%>MATCH("WAS",T$,1) THEN 3260
IF BADREF%=0 THEN 3260
IF BADREF%>T%+LEN(TFRAG$)+20 THEN 3260
IRRITABLE%=IRRITABLE%+3
IF TEST%=1 THEN T%=1: RETURN
I$="SORRY *EXCUSE ME ":GOSUB 2630
A$=IFRAG$+B$+", I OCCASSIONALLY "
I$="GET CONFUSED*MISUNDERSTAND*MESS UP"
GOSUB 2630
PRINT A$+IFRAG$+"!"
YES$="DONT RUB IT IN!"
RETURN
3260 IF TEST%=1 THEN T%=1: RETURN
Z$=D$+" "+Z$
3270 GOSUB 2770
3280 I$="WHY DO *WHAT MAKES *WHY IS IT "
3290 GOSUB 2630
3300 A$=IFRAG$+"YOU "
3310 I$="THINK *FEEL *BELIEVE *SAY "
3320 GOSUB 2630
3330 PRINT A$;IFRAG$;Z$;"?"
BECAUSE$="YOU "+IFRAG$+Z$:BECAUSE%=CYCLE%+1
TOPIC$=""
3340 RETURN
3341 REM
3350 T%=0
IF LEN(SUBJ$)<3 THEN RETURN
3355 IF CYCLE%<SUBJDATE% THEN RETURN
IF TEST%=1 THEN T%=1 :RETURN
3360 I$="LETS REGRESS *LETS GO BACK *WE SHOULD RETURN "
3370 GOSUB 2630
3380 E3%=MATCH("*",SUBJ$,1)
A$=" "+MID$(SUBJ$,1,E3%-1)
3390 PRINT IFRAG$;"TO DISCUSSING YOUR"Ø
;A$;"."
TRAPAGE%=1 :TRAP$=" ALL ":CAND$=" your"+A$+" "
3400 IF MID$(SUBJ$,LEN(SUBJ$),1)<>" " THEN SUBJ$=SUBJ$+" "
3410 SUBJ$=MID$(SUBJ$,E3%+1,LEN(SUBJ$))
NO$="WHY WONT YOU TALK ABOUT YOUR"+A$+"?"
BECAUSE$="YOU WONT DISCUSS YOUR"+A$+" ":BECAUSE%=CYCLE%+2
YES$="GOOD...GO AHEAD!"
I$="AVOIDING THE TRUTH *TRYING TO FORGET ":GOSUB 2630
TOPIC$=RU$+IFRAG$+"ABOUT YOUR"+A$+"?"
3420 RETURN
3540 T$="STICK IT * UP YOUR* SHOVE IT *"Ø
+"DROP DEAD * GO TO HELL * IT IN YOUR * BUZZ OFF *"Ø
+"UCK YOU *IT ON YOU *STUFF IT *CRAM IT "
3550 GOSUB 2470
3560 IF T%=0 THEN RETURN
IRRITABLE%=IRRITABLE%+1
IF TEST%=1 THEN T%=1 :RETURN
3570 I$="ISNT THAT *WHY ARE YOU STILL SO *WHY SO "
3580 GOSUB 2630
A$=IFRAG$
I$="BELLIGERENT *HOSTILE *IRRITABLE ":GOSUB 2630
3600 PRINT A$+IFRAG$+"?"
BECAUSE$=UR$+"SO HOSTILE ":BECAUSE%=CYCLE%+1
TOPIC$="YOUR "+IFRAG$+"NATURE MAY BE PART OF YOUR "Ø
+"PROBLEM, "+B$+"."
3610 RETURN
REM /////// GET AND CLEAN UP INPUT SENTENCE /////////
3640 PRINT:INPUT R$:PRINT:R$=UCASE$(R$)
3650 R$=" "+R$
3660 IF LEN(R$)<2 THEN RETURN
3670 R9%=MATCH(".",R$,1)
3680 IF R9%=0 THEN R9%=MATCH("Ø?",R$,1)
3690 IF R9%=0 THEN R9%=MATCH("Ø!",R$,1)
3700 IF R9%=0 THEN 3710
R$=MID$(R$,1,R9%-1)+" "+MID$(R$,R9%+1,LEN(R$)):GOTO 3670
3710 R9%=MATCH("'",R$,1)
3720 IF R9%=0 THEN 3730
R$=MID$(R$,1,R9%-1)+MID$(R$,R9%+1,LEN(R$))
GOTO 3710
3730 R9%=MATCH(" ",R$,1)
3740 IF R9%<LEN(R$) THEN 3750
R$=MID$(R$,1,R9%):GOTO 3761
3750 IF R9%=0 THEN 3760
R$=MID$(R$,1,R9%)+MID$(R$,R9%+2,LEN(R$))
GOTO 3730
3760 IF MID$(R$,LEN(R$),1)<>" " THEN R$=R$+" "
REM TRIM TRAILING THOUGHTS FROM Z$
3761 T$=" ALSO * TOO * LIKEWISE ":GOSUB 2470
IF T%=0 THEN 3763
IF T%>(LEN(R$)-(LEN(TFRAG$)+3)) THEN R$=MID$(R$,1,T%)
3763 T$=" ARENT * ISNT * CANT * WONT * DONT * WONT ":GOSUB 2470
IF T%<2*LEN(R$)/5 THEN 3765 REM LOOKING FOR 2ND THOUGHT
TREF%=T%
A$=R$:R$=" "+Z$
T$=" IT * HE * SHE * YOU * THEY * WE * I ":GOSUB 2470
R$=A$
IF T%=1 THEN R$=MID$(R$,1,TREF%)
3765 T$=" AND * OR * BUT ": GOSUB 2470
Z1%=T%:Z2%=255:GOSUB 9210 REM COUNT WORDS AFTER CONJ.
IF WORDS%=2 THEN 3770 REM LAST WORD OF LIST
IF T%=0 THEN 3770
IF T%<LEN(R$)/3 THEN R$=MID$(R$,MATCH(" ",R$,T%+1),64)Ø
:GOTO 3770
R$=MID$(R$,1,T%)
REM------SYNONYMER-------
3770 T$=" MOM * DAD * WANT * SAID * PERVERT *"Ø
+" BEGIN * TALK ABOUT * DUMB * STUPID * QUEER *"Ø
+" HORNY * SICK * LISTENING *"Ø
+" HES * SHES * THEYRE * ITS * OFTEN *"Ø
+" UNDERSTAND * USUALLY "
F$=" mother * father * desire * stated * deviate *"Ø
+" start * discuss * stupid * dumb * homosexual *"Ø
+" sexually aroused * ill * paying attention *"Ø
+" he is * she is * they are * it is * frequently *"Ø
+" comprehend * normally "
GOSUB 2890 REM LAST PART OF PERSON CHANGER
RETURN
3772 REM ///////////////////////////////////////////////
3780 T$="BECAUSE "
3790 GOSUB 2470
3800 IF T%=0 THEN RETURN
IF TEST%=1 THEN RETURN
GOSUB 2770
IF FLAG%(T6%)=0 THEN 3810
IF LEN(BECAUSE$)>1 THEN PRINT BECAUSE$+"BECAUSE "+Z$+"?"Ø
:GOTO 3832
PRINT Z$+"?":GOTO 3832
3810 I$="IS THAT THE REAL *YOU EXPECT ME TO BELIEVE THATS "+Ø
"THE *THATS THE WHOLE "
3820 GOSUB 2630
3830 PRINT IFRAG$+"REASON "+BECAUSE$+"?"
3832 NO$="I DIDNT THINK SO."
I$=CONT$ :GOSUB 2630
YES$="VERY WELL..."+Z$+"..." +IFRAG$+"."
TOPIC$=""
3840 RETURN
3842 REM
3850 A$=R$
3860 T$=" I "
3870 GOSUB 2470
3880 IF T%=0 THEN RETURN
3890 R$=" "+Z$
3900 T%=0: RETURN REM FREE ALGORITHM SPACE
3971 REM
3980 T$=" ARE YOU * ARENT YOU * AM I * IS HE * IS SHE *"Ø
+" ISNT HE * ISNT SHE * ISNT IT "
3990 GOSUB 2470
4000 IF T%<>1 THEN T%=0 : RETURN
IF TEST%=1 THEN RETURN
Z$=MID$(TFRAG$,MATCH(" ",TFRAG$,2),200)+" "Ø
+MID$(TFRAG$,2,MATCH(" ",TFRAG$,2)-1)+Z$
4010 I$="OF COURSE *DOES IT SEEM "Ø
+"*IS IT YOUR OPINION *ARE YOU INCLINED TO FEEL "
4020 GOSUB 2630
4030 GOSUB 2770
4040 IF I2%>1 THEN D$="?" ELSE D$="!"
YES$="THEN PERHAPS "+Z$+"."
NO$="IF "+Z$+", THEN WHAT?"
PRINT IFRAG$+Z$+D$
TOPIC$=""
4050 RETURN
4052 REM
4060 T$="CAN YOU *DO YOU "
4070 GOSUB 2470
4080 IF T%=0 THEN RETURN
4090 IF T%>3 THEN T%=0:RETURN
IF TEST%=1 THEN T%=1 : RETURN
4100 D$=TFRAG$+" "
4110 I$="NOT REALLY...*THE IMPORTANT THING IS "Ø
+"*YES...*MY QUESTION IS "
4120 GOSUB 2630
4130 GOSUB 2770
4140 PRINT IFRAG$+D$+Z$+"?"
YES$="I HOPE SO...GO ON..."
NO$="I WAS AFRAID OF THAT!"
TOPIC$=""
4150 RETURN
4153 REM
4160 T$="WILL YOU "
4170 GOSUB 2470
4180 IF T%<>2 THEN T%=0:RETURN
IF TEST%=1 THEN T%=1 :RETURN
4190 I$="HOPE *THINK *REALLY EXPECT "Ø
+"*FANTASIZE "
4200 Z%=MATCH("PLEASE ",Z$,1)
4210 IF Z%=1 THEN Z$=MID$(Z$,7,LEN(Z$))
4220 IF Z%>1 THEN Ø
Z$=MID$(Z$,1,Z%-1)+MID$(Z$,Z%+6,LEN(Z$))
4230 GOSUB 2630
4240 GOSUB 2770
4250 IF LEN(Z$)<3 THEN 4265
4260 IF MID$(Z$,1,1)=" " THEN Z$=MID$(Z$,2,LEN(Z$))
4265 Z$=MID$(Z$,1,LEN(Z$)-1)+","
4270 PRINT"DO YOU "+IFRAG$+"I WILL "Ø
+Z$+" "+B$+"?"
YES$="DONT COUNT ON IT!"
NO$="I SEE...YOU DONT."
TOPIC$=""
4280 RETURN
4290 T$=" EVERY* SOME* ALIKE * ARE LIKE * IS LIKE * THE SAME "
GOSUB 2470
IF TEST%=1 THEN RETURN
I$="IN WHAT WAY*WHAT IS THE RESEMBLANCE"
IF T2%<10 THEN Ø
I$="BE MORE SPECIFIC*ELUCIDATE THAT"
IF T2%<3 THEN Ø
I$="AVOID GENERALIZING*TRY NOT TO EXAGGERATE"
GOSUB 2630
IF T2%<10 THEN IFRAG$=B$+", COULD YOU "+IFRAG$Ø
: YES$="FINE...GO ON": NO$="TRY!"
PRINT IFRAG$+"?"
4430 RETURN
5800 T$=" HE * SHE * THEY "
D$="HIM *HER *THEM "
5810 GOSUB 2470
5820 IF T%<>1 THEN T%=0: RETURN
IF T2%>2 THEN 5821
INDEX%=1
IF HEAGE%<1 THEN 5824
GOTO 5825
5821 IF T2%>7 THEN 5822
INDEX%=2
IF SHEAGE%<1 THEN 5824
GOTO 5825
5822 INDEX%=3
IF THEYAGE%>0 THEN GOTO 5825
5824 IF WHODATE%>CYCLE% THEN 5825 REM DONT ASK WHO TOO OFTEN
IF TEST%=1 THEN RETURN
WHODATE%=CYCLE%+10
TOPIC$=MID$(TFRAG$,2,255)+" " REM eg:"THEY "
GOSUB 2770
PRINT"WHO "+Z$+"?":Ø
TOPIC$=TOPIC$+Z$+"...OF COURSE."
RETURN
5825 IF TEST%=1 THEN RETURN
FOCUS%(INDEX%)=FOCUS%(INDEX%)+1
CNTR%=INDEX%
5826 CNTR%=CNTR%+1
IF CNTR%=4 THEN CNTR%=1
IF CNTR%<>INDEX% THEN Ø
FOCUS%(CNTR%)=0 :GOTO 5826
Z$=MID$(T$,T2%,T3%+1-T2%+1)+Z$
D$=MID$(D$,T2%,MATCH(" ",D$,T2%)-T2%+1)
5830 I$="IS IT IMPORTANT *WHY DO YOU MENTION "Ø
+"*ARE YOU BOTHERED "
5840 GOSUB 2630
5850 GOSUB 2770
5860 IF FOCUS%(INDEX%)=2 THEN Ø
PRINT "YOU SEEM CONCERNED ABOUT "+D$+", "+B$+"."Ø
:YES$="I COULD TELL.":NO$="REALLY?":RETURN
PRINT B$+", "+IFRAG$+"THAT "+Z$+"?"
YES$="WHY "+IFRAG$+"?"
BECAUSE$="YOU FEEL ITS IMPORTANT ":BECAUSE%=CYCLE%+2
NO$="HUMMM....WHY DO I DOUBT THAT?"
IF FLAG%(T6%)=0 Ø
THEN TOPIC$="TELL ME ABOUT "+D$+"."
5870 RETURN
6000 T$=" IS * ISNT "
6010 GOSUB 2470
6020 IF T%<>1 THEN T%=0:RETURN
IF TEST%=1 THEN T%=1 :RETURN
6030 I$="PERHAPS, WHAT IS YOUR OPINION?*MAYBE, BUT"Ø
+" WHAT IF NOT?*DO YOU THINK SO?"
6040 GOSUB 2630
6050 PRINT IFRAG$
YES$="WHY DO YOU THINK SO?"
BECAUSE$="YOU THINK SO ":BECAUSE%=CYCLE%+2
NO$="I SEE...YOU DONT THINK SO...GO ON."
TOPIC$=""
6060 RETURN
7000 T$="I ":GOSUB 2470
7010 IF T%<>2 THEN T%=0 :RETURN
IF TEST%=1 THEN T%=1 :RETURN
Z$=R$ :GOSUB 2770
IF FLAG%(T6%)=0 THEN 7060
7030 I$="UNDERSTAND*AM LISTENING*FOLLOW YOU"
7040 GOSUB 2630
7050 PRINT"I "+ IFRAG$+"..."+Z$+"...PLEASE GO ON."
NO$="NO?"
GOTO 7070
7060 PRINT Z$;"?"
NO$="I AM CONFUSED ABOUT THIS."
7070 IF NEGREF%>0 THEN NO$="OF COURSE NOT."
YES$="I UNDERSTAND...GO ON."
RETURN
8000 T$=" IF "
8010 GOSUB 2470
8020 IF T%<>1 THEN T%=0:RETURN
8030 IF NEGREF%>T% THEN T%=0:RETURN
IF TEST%=1 THEN T%=1 :RETURN
8040 I$="AND IF NOT..*WHAT IF NOT *WHY DO YOU SAY THAT "
8050 GOSUB 2630
8060 PRINT IFRAG$+"?"
8070 RETURN
9000 T$=" LETS * LET US * WHY DONT WE * CAN WE "
GOSUB 2470
IF T%=0 THEN RETURN
IF TEST%=1 THEN RETURN
GOSUB 2770
IF MATCH("NOT",Z$,1)=1 THEN 9100
I$=CERT$ :GOSUB 2630
PRINT IFRAG$+"WE CAN "+Z$+"."
TOPIC$=""
RETURN
9100 Z$=MID$(Z$,MATCH("NOT",Z$,1)+4,LEN(Z$))
PRINT "WHY SHOULDNT WE ";Z$;"?"
BECAUSE$="WE SHOULDNT ":BECAUSE%=CYCLE%+1
TOPIC$="WHAT ARE YOU AFRAID OF, "+B$+"?"
RETURN
9200 REM COUNT WORDS IN R$ BETWEEN Z1% AND Z2%
Z1%=1:Z2%=LEN(R$)
9210 WORDS%=0
9220 Z1%=MATCH(" ",R$,Z1%+1)
IF Z1%=0 THEN RETURN
IF Z1%>Z2% THEN RETURN
WORDS%=WORDS%+1
IF Z1%=LEN(R$) THEN RETURN
IF Z1%=Z2% THEN RETURN
GOTO 9220
REM THIS SUBROUTINE APPENDS D$ TO GAB$(5) IF IT CAN
9800 IF LEN(D$)+LEN(GAB$(5))<255 THEN Ø
GAB$(5)=GAB$(5)+D$
RETURN
9900 PRINT"EXCUSE ME FOR A MOMENT."
IF FILEOPEN%=1 THEN CLOSE 1
CHAIN "ANALIZA+.OVL"
END«eof»