unit Conunit;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls, SysUtils;

type
  TConsult = class(TForm)
    CancelBtn: TBitBtn;
    Bevel1: TBevel;
    TypeHere: TEdit;
    Label1: TLabel;
    ElizaMemo: TMemo;
    Label2: TLabel;
    YourMemo: TMemo;
    ElizaReply: TEdit;
    BitBtn1: TBitBtn;
    procedure CancelBtnClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Consult: TConsult;

implementation

{$R *.DFM}

procedure TConsult.CancelBtnClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TConsult.BitBtn1Click(Sender: TObject);
var
  OldReply : string;

  procedure You2Me (var Answer : string);
  var
    J : integer;
  begin
    if Pos('YOU ARE', Answer) > 0 then
      begin
        J := Pos('YOU ARE', Answer);
        Delete (Answer,J,7);
        Insert ('I AM', Answer, J);
      end;

    if Pos('YOU', Answer) > 0 then
      begin
        J := Pos('YOU', Answer);
        Delete (Answer,J,3);
        Insert ('ME', Answer, J);
        Exit;
      end;

    if Pos('ME', Answer) > 0 then
      begin
        J := Pos('ME', Answer);
        Delete (Answer,J,2);
        Insert ('YOU', Answer, J);
      end;
  end;  { You2Me }

  function GetReply (Question : string) : string;
  var
    I : integer;
    TempReply : string;
  begin
    if (Pos('HOW', Question) > 0) or (Pos('WHO', Question) > 0) or
       (Pos('WHAT', Question) > 0) or (Pos('WHEN', Question) > 0) or
       (Pos('WHY', Question) > 0) or (Pos('WHERE', Question) > 0) then
      begin
        I := Trunc(Random(9));
        case I of
          0 : GetReply := 'Why do you ask?';
          1 : GetReply := 'Does that question interest you?';
          2 : GetReply := 'What answer would please you the most?';
          3 : GetReply := 'What do you think?';
          4 : GetReply := 'Are such questions on your mind often?';
          5 : GetReply := 'What is it that you really want to know?';
          6 : GetReply := 'Have you asked anyone else?';
          7 : GetReply := 'Have you asked such questions before?';
          8 : GetReply := 'What else comes to mind when you ask that?';
        end;
        Exit;
      end;

    if Pos('NAME', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : GetReply := 'I don''t care about names...please go on.';
          1 : GetReply := 'Do names mean anything to you?';
          2 : GetReply := 'Why do you mention names at all?';
        end;
        Exit;
      end;

    if Pos('THANK', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : GetReply := 'You''re welcome.';
          1 : GetReply := 'No problem.';
          2 : GetReply := 'Do you feel better now?';
        end;
        Exit;
      end;

    if (Pos('CAUSE', Question) > 0) or (Pos('BECAUSE', Question) > 0) then
      begin
        I := Trunc(Random(4));
        case I of
          0 : GetReply := 'Is that the real reason?';
          1 : GetReply := 'Don''t any other reasons come to mind?';
          2 : GetReply := 'Does that reason explain anything else?';
          3 : GetReply := 'What other reasons might there be?';
        end;
        Exit;
      end;

    if Pos('SORRY', Question) > 0 then
      begin
        I := Trunc(Random(4));
        case I of
          0 : GetReply := 'Please don''t apologize!';
          1 : GetReply := 'Apologies are not necessary.';
          2 : GetReply := 'What feelings do you have when you apologize?';
          3 : GetReply := 'Don''t be so defensive!';
        end;
        Exit;
      end;

    if Pos('DREAM', Question) > 0 then
      begin
        I := Trunc(Random(4));
        case I of
          0 : GetReply := 'What does that dream suggest to you?';
          1 : GetReply := 'Do you dream often?';
          2 : GetReply := 'What persons appear in your dreams?';
          3 : GetReply := 'Are you disturbed by your dreams?';
        end;
        Exit;
      end;

    if Pos('HELLO', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : GetReply := 'How do you do. How can I help you?';
          1 : GetReply := 'Hello, please state your problem.';
          2 : GetReply := 'Hello, what would you like to talk about?';
        end;
        Exit;
      end;

    if Pos('MAYBE', Question) > 0 then
      begin
        I := Trunc(Random(5));
        case I of
          0 : GetReply := 'You don''t seem quite certain.';
          1 : GetReply := 'Why the uncertain tone?';
          2 : GetReply := 'Can''t you be more positive?';
          3 : GetReply := 'You aren''t sure?';
          4 : GetReply := 'Don''t you know?';
        end;
        Exit;
      end;

    if Pos('ALWAYS', Question) > 0 then
      begin
        I := Trunc(Random(4));
        case I of
          0 : GetReply := 'Can you think of an example?';
          1 : GetReply := 'When?';
          2 : GetReply := 'What are you thinking of?';
          3 : GetReply := 'Really,...always?';
        end;
        Exit;
      end;

    if Pos('ALIKE', Question) > 0 then
      begin
        I := Trunc(Random(7));
        case I of
          0 : GetReply := 'In what way?';
          1 : GetReply := 'What similarity do you see?';
          2 : GetReply := 'What does the similarity suggest to you?';
          3 : GetReply := 'What other connections do you see?';
          4 : GetReply := 'Could there really be some connection?';
          5 : GetReply := 'How?';
          6 : GetReply := 'You seem quite positive.';
        end;
        Exit;
      end;

    if Pos('YES', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : GetReply := 'Are you sure?';
          1 : GetReply := 'Hmmm...I see.';
          2 : GetReply := 'I understand.';
        end;
        Exit;
      end;

    if Pos('FRIEND', Question) > 0 then
      begin
        I := Trunc(Random(6));
        case I of
          0 : GetReply := 'Do you have any friends?';
          1 : GetReply := 'Do your friends worry you?';
          2 : GetReply := 'Do they pick on you?';
          3 : GetReply := 'Are your friends a source of anxiety?';
          4 : GetReply := 'Do you impose your problems on your friends?';
          5 : GetReply := 'Perhaps your dependence on friends worries you.';
        end;
        Exit;
      end;

    if Pos('COMPUTER', Question) > 0 then
      begin
        I := Trunc(Random(6));
        case I of
          0 : GetReply := 'Do computers worry you?';
          1 : GetReply := 'Are you talking about me in particular?';
          2 : GetReply := 'Are you frightened by machines?';
          3 : GetReply := 'Why do you mention computers?';
          4 : GetReply := 'Don''t you think computers can help you?';
          5 : GetReply := 'What is it about machines that worries you?';
        end;
        Exit;
      end;

    if Pos('CAN YOU', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : TempReply := 'Don''t you believe that I can';
          1 : TempReply := 'Perhaps you would like me to be able to';
          2 : TempReply := 'You want me to be able to';
        end;
        I := Pos ('CAN YOU', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('CAN YOU', Question);
          end;
        Delete(Question,I,7);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('CAN I', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : TempReply := 'Do you want to be able to';
          1 : TempReply := 'Perhaps you don''t want to';
          2 : TempReply := 'What would it mean if you could';
        end;
        I := Pos ('CAN I', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('CAN I', Question);
          end;
        Delete(Question,I,5);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('I DON''T', Question) > 0 then
      begin
        I := Trunc(Random(4));
        case I of
          0 : TempReply := 'Don''t you really';
          1 : TempReply := 'Why don''t you';
          2 : TempReply := 'Do you wish to be able to';
          3 : TempReply := 'So you really don''t';
        end;
        I := Pos ('I DON''T', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('I DON''T', Question);
          end;
        Delete(Question,I,7);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('I FEEL', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : TempReply := 'Do you often feel';
          1 : TempReply := 'Do you enjoy feeling';
          2 : TempReply := 'How often do you feel';
        end;
        I := Pos ('I FEEL', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('I FEEL', Question);
          end;
        Delete(Question,I,6);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('ARE YOU', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : TempReply := 'Why are you interested in whether or not I am';
          1 : TempReply := 'Would you prefer if I were not';
          2 : TempReply := 'Perhaps in your fantasies I am';
        end;
        I := Pos ('ARE YOU', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('ARE YOU', Question);
          end;
        Delete(Question,I,7);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('YOU ARE', Question) > 0 then
      begin
        I := Trunc(Random(6));
        case I of
          0 : TempReply := 'Does it please you to believe I am';
          1 : TempReply := 'Perhaps you would like to be';
          2 : TempReply := 'Do you sometimes wish you were';
          3 : TempReply := 'What about your own';
          4 : TempReply := 'Why are you concerned about my';
          5 : TempReply := 'What makes you think I am';
        end;
        I := Pos ('YOU ARE', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('YOU ARE', Question);
          end;
        Delete(Question,I,7);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('DON''T YOU', Question) > 0 then
      begin
        I := Trunc(Random(6));
        case I of
          0 : TempReply := 'Do you really believe I don''t';
          1 : TempReply := 'Perhaps in good time I will';
          2 : TempReply := 'Do you want me to';
          3 : TempReply := 'Why can''t you';
          4 : TempReply := 'Should you be able to';
          5 : TempReply := 'What makes you think I am';
        end;
        I := Pos ('DON''T YOU', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('DON''T YOU', Question);
          end;
        Delete(Question,I,9);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('I CAN''T', Question) > 0 then
      begin
        I := Trunc(Random(3));
        case I of
          0 : TempReply := 'How do you know you can''t';
          1 : TempReply := 'Perhaps you can now';
          2 : TempReply := 'Why don''t you try to';
        end;
        I := Pos ('I CAN''T', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('I CAN''T', Question);
          end;
        Delete(Question,I,7);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if (Pos('I AM', Question) > 0) or (Pos('I''M', Question) > 0) then
      begin
        I := Trunc(Random(3));
        case I of
          0 : TempReply := 'Did you come to me because you are';
          1 : TempReply := 'How long have you been';
          2 : TempReply := 'Do you believe it is normal to be';
        end;
        I := Pos ('I AM', Question);
        if I = 0 then
          begin
            I := Pos ('I''M', Question);
            if I <> 1 then
              begin
                Delete(Question,1,I-1); {Strip away front words}
                I := Pos ('I''M', Question);
              end;
            Delete (Question,I,3);
          end
        else
          begin
            if I <> 1 then
              begin
                Delete(Question,1,I-1); {Strip away front words}
                I := Pos ('I AM', Question);
              end;
            Delete(Question,I,4);
          end;
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if Pos('I WANT', Question) > 0 then
      begin
        I := Trunc(Random(5));
        case I of
          0 : TempReply := 'What would it mean if you got';
          1 : TempReply := 'Why do you want';
          2 : TempReply := 'Suppose you soon got';
          3 : TempReply := 'What if you never got';
          4 : TempReply := 'I sometimes also want';
        end;
        I := Pos ('I WANT', Question);
        if I <> 1 then
          begin
            Delete(Question,1,I-1); {Strip away front words}
            I := Pos ('I WANT', Question);
          end;
        Delete(Question,I,6);
        You2Me(Question);
        Question := LowerCase (Question);
        GetReply := Concat(TempReply, Question);
        Exit;
      end;

    if (Pos('FUCK', Question) > 0) or (Pos('SHIT', Question) > 0) or
       (Pos('DAMN', Question) > 0) or (Pos('HELL', Question) > 0) then
      begin
        I := Trunc(Random(4));
        case I of
          0 : GetReply := 'Please don''t use four-letter words.';
          1 : GetReply := 'Profanity is not necessary.';
          2 : GetReply := 'Do you use such foul language often?';
          3 : GetReply := 'Do you like using obscene words?';
        end;
        Exit;
      end;

    { No keywords found }
    I := Trunc(Random(7));
    case I of
      0 : GetReply := 'Do you feel intense psychological stress?';
      1 : GetReply := 'What does that suggest to you?';
      2 : GetReply := 'I see.';
      3 : GetReply := 'I''m not sure I understand you fully.';
      4 : GetReply := 'Now, please clarify yourself.';
      5 : GetReply := 'Can you elaborate on that?';
      6 : GetReply := 'That is quite interesting.';
    end;
  end; { GetReply }

begin
  Randomize;
  OldReply := ElizaReply.Text;
  YourMemo.Lines.Add(TypeHere.Text);
  { This prevents YourMemo from getting
    too full of strings }
  if YourMemo.Lines.Count = 7 then
    YourMemo.Lines.Delete(1);

  ElizaMemo.Lines.Add(ElizaReply.Text);
  { This prevents ElizaMemo from getting
    too full of strings }
  if ElizaMemo.Lines.Count = 7 then
    ElizaMemo.Lines.Delete(1);
  { Search for an ELIZA reply }
  repeat
    ElizaReply.Text := GetReply (AnsiUpperCase(TypeHere.Text));
  until ElizaReply.Text <> OldReply;

  TypeHere.Text := ''; { Clear the text box }
  TypeHere.SetFocus;
end;

end.
