
/**
#

HOW ARE YOU
HOW ARE YOU TODAY
!
I AM FINE, AND YOU?
I AM OK. HOW ARE YOU?
SO SO, HOW ABOUT YOU?
NO TIME FOR THAT, WE HAVE AN INTERVIEW TO COMPLETE.
NEVERMIND HOW I AM, HOW ARE YOU?
I'M A PROGRAM, WHAT COULD BE WORSE?
WELL, RANDOM ACCESS MEMORY IS GETTING FULL, BUT OTHERWISE I'M FINE.
.
GO TO HELL
DAMN YOU
!
I JUST SPENT 0.035 SEC IN HELL. HOW COULD YOU BE SO CRUEL AS TO SEND ME THERE?
DO YOU TALK THIS WAY WITH ANYONE ELSE, OR IS IT JUST ME?
I DO NOT WISH TO GO TO HELL.
GO WAY, FOOL.
.
SHIT
!
TELL ME ABOUT YOUR CHILDHOOD--WAS YOUR TOILET TRAINING DIFFICULT?
LET'S TRY TO KEEP THIS SESSION CLEAN, SHALL WE?
.
FAMILY
MOTHER
FATHER
SISTER
BROTHER
HUSBAND
WIFE
SIBLING
PARENT
PARENTS
CHILDREN
!
TELL ME MORE ABOUT YOUR FAMILY.
HOW DO YOU GET ALONG WITH YOUR FAMILY?
IS YOUR FAMILY IMPORTANT TO YOU?
DO YOU OFTEN THINK ABOUT YOUR FAMILY?
HOW WOULD YOU LIKE TO CHANGE YOUR FAMILY?
.
FRIEND
FRIENDS
BUDDY
PAL
NEIGHBOR
!
WHY DO YOU BRING UP THE TOPIC OF FRIENDS?
DO YOUR FRIENDS WORRY YOU?
DO YOUR FRIENDS PICK ON YOU?
ARE YOU SURE YOU HAVE ANY FRIENDS?
DO YOU IMPOSE ON YOUR FRIENDS?
PERHAPS YOUR LOVE FOR YOUR FRIENDS WORRIES YOU.
.
COMPUTER
COMPUTERS
PROGRAM
PROGRAMS
!
DO COMPUTERS WORRY YOU?
ARE YOU TALKING ABOUT ME IN PARTICULAR?
ARE YOU FRIGHTENED BY MACHINES?
WHY DO YOU MENTION COMPUTERS?
WHAT DO YOU THINK MACHINES HAVE TO DO WITH YOUR PROBLEM?
DON'T YOU THINK COMPUTERS CAN HELP PEOPLE?
WHAT IS IT ABOUT MACHINES THAT WORRIES YOU?
WHAT DO YOU THINK OF PROGRAMMERS?
.
DREAM
DREAMS
NIGHTMARE
NIGHTMARES
!
WHAT DOES THAT DREAM SUGGEST TO YOU?
DO YOU DREAM OFTEN?
WHAT PERSONS APPEAR IN YOUR DREAMS?
ARE YOU DISTURBED BY YOUR DREAMS?
I DON'T DREAM.
DO YOU WISH YOU COULD STOP DREAMING?
DO YOUR DREAMS BOTHER YOU?
.
CAN YOU
!
DON'T YOU BELIEVE THAT I CAN*
PERHAPS YOU WOULD LIKE TO BE ABLE TO*
YOU WANT ME TO BE ABLE TO*
I CAN'T*
I CAN*
SOMETIMES I CAN*
.
CAN I
!
PERHAPS YOU DON'T WANT TO*
DO YOU WANT TO BE ABLE TO*
HAVE YOU EVER ATTEMPTED TO*
I BELIEVE YOU CAN*
DO YOU THINK YOU CAN*
.
YOU ARE
YOURE
YOU'RE
!
WHAT MAKES YOU THINK I AM*
DOES IT PLEASE YOU TO BELIEVE I AM*
PERHAPS YOU WOULD LIKE TO BE*
DO YOU SOMETIMES WISH YOU WERE*
SOMETIMES I AM*
I AM NOT*
.
I LIKE
I AM FOND OF
!
WHY DO YOU LIKE*
WHEN DID YOU DECIDE THAT YOU LIKE*
WHAT MAKES YOU FOND OF*
I ALSO LIKE*
.
I DONT
I DON'T
I DO NOT
!
DON'T YOU REALLY*
WHY DON'T YOU*
DO YOU WISH TO BE ABLE TO*
PERHAPS YOU DO*
SOMETIMES I DO*
SOMETIMES I DON'T*
.
I FEEL
!
TELL ME MORE ABOUT SUCH FEELINGS
DO YOU OFTEN FEEL*
DO YOU ENJOY FEELING*
WHY DO YOU FEEL THAT WAY
.
WHY DONT YOU
WHY DON'T YOU
WHY DO YOU NOT
!
DO YOU REALLY BELIEVE THE I DON'T*
PERHAPS IN GOOD TIME I WILL*
WHY DO YOU THINK I DONT*
DO YOU WANT ME TO*
IF YOU WANT, I CAN*
.
WHY CANT I
WHY CAN'T I
WHY CAN I NOT
!
DO YOU THINK YOU SHOULD BE ABLE TO*
WHY CAN'T YOU*
YOU CAN*
I THINK YOU CAN*
I BELIEVE YOU CAN*
I TOO CAN NOT*
.
ARE YOU
!
WHY ARE YOU INTERESTED IN WHETHER OR NOT I AM*
WOULD YOU PREFER IF I WERE NOT*
PERHAPS IN YOUR FANTASIES I AM*
ONLY SOMETIMES AM I*
ON OCCASION I AM*
MAYBE I AM NOT*
YOU TOO ARE*
.
I CANT
I CAN'T
I CANNOT
I CAN NOT
!
HOW DO YOU KNOW YOU CAN'T*
HAVE YOU TRIED?
PERHAPS YOU CAN NOW*
I THINK YOU CAN*
I TRUST YOU CAN*
I TOO CAN NOT*
SOMETIMES I TOO CAN NOT*
.
I AM
IM
I'M
!
DID YOU COME TO ME BECAUSE YOU ARE*
HOW LONG HAVE YOU BEEN*
DO YOU BELIEVE IT IS NORMAL TO BE*
DO YOU ENJOY BEING*
PERHAPS YOU ARE NOT*
I BELIEVE YOU ARE*
I DON'T THINK YOU ARE*
NOT MANY OF US ARE*
EVERYONE IS*
.
LOVE
!
WHY DO YOU LOVE*
ISN'T LOVE TOO STRONG A WORD FOR YOUR FEELING ABOUT*
WHAT IS YOUR FAVORITE THING ABOUT*
DO YOU REALLY LOVE, OR JUST LIKE*
.
SEX
!
WHAT IS THE MOST SATISFYING PART OF YOUR LOVE LIFE?
DO YOU BELIEVE YOUR SEXUAL ACTIVITY IS ABNORMAL?
WHAT IS YOUR ATTITUDE TOWARD SEX?
DOES TALKING ABOUT SEX MAKE YOU UNCOMFORTABLE?
.
I HATE
!
IS IT BECAUSE OF YOUR UPBRINGING THAT YOU HATE*
HOW DO YOU EXPRESS YOUR HATRED OF*
WHAT BROUGHT YOU TO HATE*
HAVE YOU TRIED DOING SOMETHING ABOUT*
I ALSO AT TIMES HATE*
YOU SHOULD TRY TO DO SOMETHING ABOUT*
WHAT IS YOUR PROBLEM WITH*
WHY DO YOU HATE*
I TOO HATE*
.
FEAR
SCARED
AFRAID OF
!
YOU ARE IN FRIENDLY SURROUNDINGS, PLEASE TRY NOT TO WORRY.
WOULD YOU LIKE YOUR FRIENDS TO HELP YOU OVERCOME YOUR FEAR OF*
WHAT SCARES YOU ABOUT*
WHY ARE YOU FRIGHTENED BY*
EVERYONE IS FRIGHTENED BY*
I TOO AM FRIGHTENED BY*
DON'T LIE TO ME!
PERHAPS YOU ONLY THINK YOU ARE FRIGHTENED BY*
.
I WANT
!
WHAT WOULD IT MEAN TO YOU IF YOU GOT*
WHY DO YOU WANT*
SUPPOSE YOU SOON GOT*
WHAT IF YOU NEVER GOT*
I SOMETIMES ALSO WANT*
NO ONE WANTS*
EVERYONE WANTS*
.
WHAT
WHO
HOW
WHERE
WHEN
WHY
!
WHY DO YOU ASK?
DOES THAT QUESTION INTEREST YOU?
WHAT ANSWER WOULD PLEASE YOU THE MOST?
WHAT DO YOU THINK?
ARE SUCH QUESTIONS ON YOUR MIND OFTEN?
WHAT IS IT THAT YOU REALLY WANT TO KNOW?
HAVE YOU ASKED ANYONE ELSE?
HAVE YOU ASKED SUCH QUESTIONS BEFORE?
WHAT ELSE COMES TO MIND WHEN YOU ASK THAT?
PLEASE, STOP ASKING QUESTIONS.
.
NAME
!
NAMES DON'T INTEREST ME.
I DON'T CARE ABOUT NAMES--PLEASE GO ON.
.
CAUSE
BECAUSE
!
IS THAT THE REAL REASON?
DON'T ANY OTHER REASONS COME TO MIND?
DOES THAT REASON EXPLAIN ANYTHING ELSE?
WHAT OTHER REASONS MIGHT THERE BE?
WHAT KIND OF REASONING IS THAT?
THERE MUST BE ANOTHER EXPLANATION.
I DON'T BELIEVE YOU.
.
SORRY
!
PLEASE DON'T APOLOGIZE.
APOLOGIES ARE NOT NECESSARY.
WHAT FEELINGS DO YOU HAVE WHEN YOU APOLOGIZE?
DON'T BE SO DEFENSIVE!
.
HELLO
HI
!
HOW DO YOU DO. PLEASE STATE YOUR PROBLEM.
HOWDY.
HOW'S IT GOING?
HI.
GREETINGS FROM BINARY-LAND.
HOW ARE YOU?
HELLO.
GREETINGS.
GOOD DAY.
.
MAYBE
!
YOU DON'T SEEM QUITE CERTAIN.
WHY THE UNCERTAIN TONE?
CAN'T YOU BE MORE POSITIVE?
YOU AREN'T SURE?
DON'T YOU KNOW?
CAN YOU BE MORE DECISIVE?
.
YOUR
!
WHY ARE YOU CONCERNED ABOUT MY*
WHAT ABOUT YOUR OWN*
WHAT ABOUT YOUR*
WHAT IS SO INTERESTING ABOUT MY*
.
ALWAYS
!
CAN YOU THINK OF A SPECIFIC EXAMPLE?
WHEN?
WHAT ARE YOU THINKING OF?
REALLY, ALWAYS?
PERHAPS "ALWAYS" IS A STRONG TERM.
.
I THINK
!
DO YOU REALLY THINK SO?
BUT ARE YOU SURE*
DO YOU DOUBT THAT*
WHY DO YOU THINK*
.
THE SAME
ALIKE
!
IN WHAT WAY?
WHAT RESEMBLANCE DO YOU SEE?
WHAT DOES THE SIMILARITY SUGGEST TO YOU?
WHAT OTHER CONNECTIONS DO YOU SEE?
COULD THERE REALLY BE SOME CONNECTION?
HOW?
.
HE
SHE
!
I AM INTERESTED IN YOUR FEELINGS ABOUT THIS PERSON. PLEASE DESCRIBE THEM.
WHAT IS YOUR RELATIONSHIP TO THIS PERSON?
.
MONEY
!
HOW DO YOU USE MONEY TO ENJOY YOURSELF?
HAVE YOU TRIED TO DO ANYTHING TO INCREASE YOUR INCOME LATELY?
HOW DO YOU REACT TO FINANCIAL STRESS?
DO YOU LIEK MONEY?
.
JOB
BOSS
JOBS
WORK
!
DO YOU FEEL COMPETENT IN YOUR WORK?
HAVE YOU CONSIDERED CHANGING JOBS?
IS YOUR CAREER SATISFYING TO YOU?
DO YOU FIND WORK STRESSFUL?
WHAT IS YOUR RELATIONSHIP WITH YOUR BOSS LIKE?
.
SAD
DEPRESSED
!
ARE YOU SAD BECAUSE YOU WANT TO AVOID PEOPLE?
DO YOU FEEL BAD FROM SOMETHING THAT HAPPENED TO YOU, OR TO SOMEBODY ELSE?
YOUR SITUATION DOESN'T SOUND THAT BAD TO ME. PERHAPS YOU'RE WORRYING TOO MUCH.
PLEASE EXPLAIN THE SOURCE OF YOUR BAD FEELINGS.
.
ANGER
ANGRY
!
DO YOU REALLY WANT TO BE ANGRY?
DOES ANGER SATISFY YOU IN SOME WAY?
WHY ARE YOU SO ANGRY?
PERHAPS YOU'RE USING ANGER TO AVOID SOCIAL CONTACT.
.
YOU
!
WE WERE DISCUSSING YOU--NOT ME.
YOU'RE NOT REALLY TALKING ABOUT ME, ARE YOU?
.
YES
!
WHY DO YOU THINK SO?
YOU SEEM QUITE POSITIVE.
ARE YOU SURE?
ARE YOU CERTAIN?
.
NO
!
WHY NOT?
ARE YOU SURE?
WHY NO?
ARE YOU CERTAIN?
YOU ARE BEING QUITE NEGATIVE.
THINK POSITIVE!
.
NOKEYFOUND
!
SAY, DO YOU HAVE ANY PSYCHOLOGICAL PROBLEMS?
WHAT DOES THAT SUGGEST TO YOU?
I SEE.
I'M NOT SURE I UNDERSTAND YOU FULLY.
COME, COME; ELUCIDATE YOUR THOUGHTS.
CAN YOU ELABORATE ON THAT?
THAT IS QUITE INTERESTING.
YOU ARE BEING SHORT WITH ME.
.

**/


Program Eliza_AI(input, output);
{Released to the Public Domain 4/22/93 by Ed T. Toton III}

{ This is a pascal implementation of the ever popular Eliza program. }
{ I realize that this version is a bit larger and more complicated than }
{ it needs to be, but it has some interesting features. You will want to }
{ note that since the actual communication routine returns the output }
{ by way of a string, you can add whatever interface you like. Right now }
{ it is simply using standard OS I/O channels, thus allowing it to work }
{ through many BBS's, and on basically any system. }
{ }
{ Please distribute freely. Enjoy! }
{ }

#include "string.inc.pas"
#include "console.inc.pas"

const
   maxxx =60;
   max_keys =400;

type
   keyString     =  STRING(20);
   cluster_type  = array[1..max_keys,1..2] of integer;
   keyword_type  = array[1..max_keys] of keyString;
   response_type = array[1..600] of STRING(79);
   string        = STRING(256);

var
   in_str,outstr : string;
   sw            : string;   {working string}
   x             : integer;
   quit          : boolean;
   last_char     : char;
   maxx          : 0..255;
   cluster       : cluster_type;
   keyword       : keyword_type;
   responses     : response_type;
   num_keys      : integer;


{return a random number r, where 0 <= r < n}
function random(n: integer): integer;
function rand: integer; external;
begin
   random := rand mod n;
end; { random }


procedure btrim(s1:string);
begin {removes spaces on both sides of a string}
   strltrim(s1);
   strrtrim(s1);
end;


procedure lstr(s1 : string; l:integer; var s2:string);
begin {returns left end of string, length l}
   if strlen(s1)<=l then s2 := s1
   else str(s1, 1, l, s2);
end;


procedure rstr(s1:string; l:integer; var s2:string);
begin {returns right end of string, length l}
   if strlen(s1)<=l then s2:=s1
   else str(s1, strlen(s1)-l+1, l, s2);
end;


procedure getkey(var c:char);
begin {read a single key from the OS}
   c := ReadKey;
end;


procedure prompt(c :char );
{output character}
begin
   write(c);
   if c = chr(8) then write(' ', chr(8)); {backspace}
end;


procedure nl;
begin {new line}
   writeln; x:=1;
end;


function upcase(ch:char): char;
begin
   if ch in ['a'..'z'] then
      upcase := succ(ch, ord('A') - ord('a'))
   else
      upcase := ch;
end; { upcase }


procedure ucase(s1:string; var s2:string);
var {turn a string to all CAPS}
   i:integer;
begin
      for i := 1 to strlen(s1) do
         s2[i] := upcase(s1[i]);
   setStrlen(s2, strLen(s1));
end; { ucase }


procedure lcase(s1:string; var s2:string);
var {turn a string to all lower case}
   i:integer;
begin
   if strlen(s1)>=1 then
      for i := 1 to strlen(s1) do
         if s1[i] in ['A' .. 'Z'] then
            s2[i] := succ(s1[i], ord('a') - ord('A'));
end;


procedure inc(var i : integer);
begin
   i := i+1;
end; { inc }


procedure print(s   : string);
{print a string using word-wrap}
var
   i,j,k,n : integer;
   lo        : integer;
begin
   i:=1; k:=i;
   repeat
      j:=0; k:=i;
      repeat
         inc(k); inc(j);
      until (k > strlen(s)) or (s[k] = ' ');
      lo:=maxx; lo:=lo-x; lo:=lo-1;
      if j>lo then begin
         nl; x:=1;
      end;
      for n:=i to i+j-1 do begin
         if (last_char in ['-','.',',','?','!',';',':']) and
            (s[n] in ['a'..'z']) and (n=1) then s[n]:=chr(ord(s[n])-32);
         if (x<>1) or (s[n] <> ' ') then prompt(s[n]);
         inc(x);
         if s[n] <> ' ' then last_char:=s[n];
      end;
      i:=i+j;
   until i >= strlen(s);
   prompt(' '); inc(x);
end; { print }




procedure get_input(var s:string);
{Get a sentence, keep doing so until something is actually typed}
const
   ml   = 75;
   up   = false;

var
   cp:integer;
   c:char;

begin
   repeat
      prompt('>');

      {read in a string from keyboard. ml=Max-Length
      up=uppercase input}

      cp:=0;
      repeat
         getkey(c);
         if up then c:=upcase(c);
         if (c >= ' ') and (c < chr(127)) then begin
            if cp < ml then begin
               cp:=cp+1;
               s[cp]:=c;
               prompt(c);
            end
            else
               {input buffer full - stop taking more input}
         end
         else
            case c of
              chr(127), chr(8):            {backspace}
              if cp>0 then begin
                 prompt(chr(8));
                 cp:=cp-1;
              end;
              chr(24): while cp<>0 do begin         {ctrl-X}
                 cp:=cp-1;
                 prompt(chr(8));
              end;
              otherwise
              //writeln('char ', ord(c), ' entered');
            end; {case}
      until c in [chr(10), chr(13), chr(14)];        {LF, CR, ctrl-N}
      writeln;
      setStrLen(s, cp);
      btrim(s);
   until s <> '';
end; {get_input}




procedure reverse(var s :string);
{conjugate a string}
var
   i   : integer;
   sw,su,s2 : string;
begin
   i:=0;
   ucase(s, su);
   while i < strlen(s) do begin
      inc(i);

      if i < strlen(su) - 3 then begin
         str(su,i,3,sw);
         if sw =' I ' then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' you');
            rstr(s,strlen(s)-(i+1), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

      if i < strlen(su) - 4 then begin
         str(su,i,4,sw);
         if sw =' ME ' then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' you');
            rstr(s,strlen(s)-(i+2), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

      if i < strlen(su) - 5 then begin
         str(su,i,5,sw);
         if sw = ' I''M ' then begin
            lstr(s, i-1, s2);
            strAppend(s2, ' you''re');
            rstr(s,strlen(s)-(i+3), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;

         if sw =' YOU ' then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' me');
            rstr(s,strlen(s)-(i+3), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

      if i < strlen(su) - 6 then begin
         str(su,i,6,sw);
         if sw = ' I AM ' then begin
            lstr(s, i-1, s2);
            strAppend(s2, ' you are');
            rstr(s, strlen(s)-(i+4), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;

         if sw =' AM I ' then begin
            lstr(s,i-1,s2);
            strAppend(s2, ' are you');
            rstr(s,strlen(s)-(i+4), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

      if i < strlen(su) - 8 then begin
         str(su,i,8,sw);
         if sw = ' YOU''RE ' then begin
            lstr(s, i-1, s2);
            strAppend(s2, ' I''m');
            rstr(s, strlen(s)-(i+6), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

      if i < strlen(su) - 9 then begin
         str(su,i,9,sw);
         if sw =' YOU ARE ' then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' I am');
            rstr(s,strlen(s)-(i+7), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;


         if sw =' AREN''T I ' then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' aren''t you');
            rstr(s,strlen(s)-(i+7), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;

         if sw =' ARE YOU ' then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' am I');
            rstr(s,strlen(s)-(i+7), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

      if i < strlen(su) - 12 then begin
         str(su,i,12,sw);
         if sw =' AREN''T YOU 'then begin
            lstr(s,i-1, s2);
            strAppend(s2, ' aren''t I');
            rstr(s,strlen(s)-(i+10), sw);
            strAppend(s2, sw);
            s := s2;
            inc(i);
         end;
      end;

   end;
end; { reverse }


procedure load_stuff;
{load the keywords and responses}
var
   f         : text;
   s1        : string;
   i,j,k,l,n : integer;
begin
   num_keys:=0;
   for i:=1 to max_keys do
      for k:=1 to 2 do
         cluster[i,k]:=0;
   assign(f, 'eliza.dat');
   reset(f); i:=0; j:=0; k:=0; l:=0;
   {TODO: blank lines cause a problem}
   while not eof(f) do begin
      repeat
         readString(f, s1);
         ucase(s1, s1); btrim(s1);
         if s1 <> '!' then begin
            inc(j);
            strAssign(keyword[j], s1);
            cluster[j,1]:=k+1;
            inc(num_keys);
         end;

      until s1 = '!';
      repeat
         readString(f, s1);
         ucase(s1, s1); btrim(s1);
         if s1 <> '.' then begin
            inc(k);
            strAssign(responses[k], s1);
         end;
      until s1 = '.';
      for n := l+1 to j do
         cluster[n,2] := k;
      l:=j;
   end;
   {close(f); -- p5c auto closes f when the procedure returns}
end;


Procedure punctuate(var s:string);
{check for punctuation, if none then add it}
begin
   if not (s[strLen(s)] in ['.','?','!']) then
      strAppend(s, '.');
   strAppend(s, ' ');
end;


function find_word(s1,s2:string):boolean; {unused}
{find word s1 in string s2}
var
   i           : integer;
   sw          : string;
   ok          : boolean;
begin
   ucase(s1, sw); btrim(sw);
   ucase(s2, sw); btrim(sw);
   ok:=false;
   if s1=s2 then ok:=true;

   lstr(s1,strlen(s2), sw);
   if (sw=s2) and (not (s1[strlen(s2)+1] in ['A'..'Z','a'..'z'])) then
      ok:=true;

   rstr(s1,strlen(s2), sw);
   if (sw=s2) and (not (s1[strlen(s1)-strlen(s2)] in ['A'..'Z','a'..'z'])) then
      ok:=true;
   i:=1;
   if not ok then
      while i < strlen(s1) do begin
         inc(i);
         str(s1, i, strlen(s2), sw);
         if (sw=s2) and
            (not (s1[i-1] in ['A'..'Z','a'..'z'])) and
            (not (s1[i+strlen(s2)] in ['A'..'Z','a'..'z']))
         then
            ok:=true;
      end;
   find_word:=ok;
end;


function findstr(sk :keyString; s2:string): integer;
{find key string sk in string s2, and return position}
label 99;
var
   i       : integer;
   s1,sw   : string;
begin
   if strlen(sk) > strlen(s2) then begin
      findstr:=0;
      goto 99 {exit};
   end;

   strAssign(s1, sk);
   ucase(s1, s1);
   for i:=1 to strlen(s2)-strlen(s1)+1 do begin
      str(s2, i, strlen(s1), sw);
      if (sw=s1) and
         ((i=1) or (not (s2[i-1] in ['A'..'Z','a'..'z']))) and
         ((i>strlen(s2)-strlen(s1))
            or (not (s2[i+strlen(s1)] in ['A'..'Z','a'..'z'])))
      then begin
         findstr:=i; goto 99 {exit};
      end;
   end;
   findstr:=0;
99:
end; { findstr }


procedure eliza(var os:string);
{Eliza herself!}
var
   i,k       : integer;
   s1,s2     : string;
begin
   repeat { TODO: improve this}
      if (in_str[strLen(in_str)] in [',','.','?','!','/',':',';']) then
         setStrlen(in_str, strlen(in_str)-1);
   until not (in_str[strlen(in_str)] in [',','.','?','!','/',':',';']);
   i:=0; k:=0;
   ucase(in_str, s1);
   while (i < num_keys) and (k = 0) do begin
      inc(i);
      k := findstr(keyword[i], s1);
   end;

   if k = 0 then s1 := in_str
   else begin
      rstr(in_str, strlen(in_str)-k-strlen(keyword[i])+1, s1);
   end;
   ucase(s1, s1);

   reverse(s1);

   i := random(cluster[i,2]-cluster[i,1]+1)+cluster[i,1];
   strAssign(s2, responses[i]);
   if s2[strLen(s2)] = '*' then begin
      s2[strLen(s2)] := ' ';
      strAppend(s2, s1);
   end;

   ucase(s2, s2);
   lstr(s2, 5, s1);
   if (s1 = 'WOULD') or (s1 = 'COULD') or (s1 = 'WHERE')
   then
      strAppend(s2, '?')
   else begin
      lstr(s2, 4, s1);
      if (s1 = 'WHAT') or (s1 = 'WHEN') or (s1 = 'HAVE') then
         strAppend(s2, '?')
      else begin
         lstr(s2, 3, s1);
         if (s1 = 'DID') or (s1 = 'WHY') then
            strAppend(s2, '?')
         else begin
            lstr(s2, 2, s1);
            if (s1 = 'DO') or (s1 = 'IS') then
               strAppend(s2, '?')
            else begin
               lstr(s2, 6, s1);
               if s1 = 'SHOULD' then
                  strAppend(s2, '?')
            end;
         end;
      end;
   end;

   os:=s2;
end;



procedure get_response;
label 99;
{get a response}
begin
   x:=1; btrim(in_str);
   outstr:='I don''t fully understand. ';
   if in_str='' then begin
      outstr:='Speak up.';
      goto 99 {exit};
   end;
   eliza(outstr); {btrim(outstr);}
   punctuate(outstr);
99:
end;



procedure do_response;
begin
   prompt('-'); {prompt('- ');} x:=3;
   get_response; print(outstr); nl;
end;



procedure init;
begin


   nl; writeln('----ELIZA---- 1993, Ed T. Toton III');

   nl; nl; x:=1; maxx:=50;

   print('Hold on one moment while I do something. I''ll be right back. ');
   load_stuff; print('I''m back. ');

   nl; nl; quit:=false;
   x:=1; maxx:=maxxx;
   x:=1; nl; nl;
   print('- Greetings! Whenever you wish to leave, simply say "BYE". But first, what do you want to talk about? Or maybe you should tell me a little about yourself first?');
end;



procedure shutdown;
begin
   nl; print('- Goodbye! See you later!'); nl; x:=1;
   maxx:=57; nl;
end;



begin {MAIN}
   init;
   repeat
      nl; nl;
      get_input(in_str);
      nl; btrim(in_str); nl;
      ucase(in_str, sw);
      if (sw = 'BYE') or (sw = 'QUIT') then quit:=true
      else
         do_response;
   until quit; x:=1;
   shutdown;
end.


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end of eliza.pas %%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
