(* Program Name: chatterbot3
   Description: this is an improved version of the previous chatterbot program "chatterbot1"
   this one will try a littlebit more to understand what the user is trying to say and will also
   try to avoid repeating himself too much.

   Author: Gonzales Cenelia
   Date: 3 july 2009
*)


program Chatterbot3;

const
     NumOfRecords = 6;
     NumOfInput = 1;
     NumOfResponse = 3;

type
    sList = array[1..NumOfResponse] of string;
    sList2 = array[1..NumOfResponse + 1] of string;

type
    StringArray = array[1 .. NumOfRecords, 1 .. (NumOfResponse + 1)] of string;

var
   sInput, sResponse, sPrevResponse : string;
   IndexOfResp : integer;
   responses : sList;

const
     delim = '?!.;,';

const
     KnowledgeBase : StringArray = (
    ('WHAT IS YOUR NAME',
	 'MY NAME IS CHATTERBOT2.',
	 'YOU CAN CALL ME CHATTERBOT2.',
	 'WHY DO YOU WANT TO KNOW MY NAME?'
	),

	('HI',
	 'HI THERE!',
	 'HOW ARE YOU?',
	 'HI!'
	),
	
	('HOW ARE YOU',
	 'I''M DOING FINE!',
	 'I''M DOING WELL AND YOU?',
	 'WHY DO YOU WANT TO KNOW HOW AM I DOING?'
	),

	('WHO ARE YOU',
	 'I''M AN A.I PROGRAM.',
	 'I THINK THAT YOU KNOW WHO I''M.',
	 'WHY ARE YOU ASKING?'
	),

	('ARE YOU INTELLIGENT',
	 'YES,OFCORSE.',
	 'WHAT DO YOU THINK?',
	 'ACTUALY,I''M VERY INTELLIENT!'
	),

	('ARE YOU REAL',
	 'DOES THAT QUESTION REALLY MATERS TO YOU?',
	 'WHAT DO YOU MEAN BY THAT?',
	 'I''M AS REAL AS I CAN BE.'
    )
);

procedure CopyArray(Array1 : sList2; var Array2 : sList; startPos : integer);
var
   index : integer;

begin
     for index:= startPos to NumOfResponse + 1 do
       begin
         Array2[index - 1]:= Array1[index];
       end;
end;

procedure UpperCase( var str1 : string );
var
   i : integer;

begin
     for i:= 1 to length(str1) do
     begin
          str1[i]:= UpCase(str1[i]);
     end;
end;

function isPunc( str1 : string ) : boolean;
begin
     isPunc:= Pos(str1, delim) > 0;
end;

(* removes punctuation and redundant
   spaces from the user's input
*)
procedure CleanString( var str1 : string );
var
   i, len : integer;
   prevChar : char;
   currChar : string;
   temp : string;

begin
     len:= length(str1);
     prevChar:= '#';
     temp:= '';

     for i:= 1 to len do
     begin
          currChar:= string(str1[i]);
          if ((str1[i] = ' ') and (prevChar <> ' ') or not (isPunc(currChar))) then
          begin
               temp:= Concat(temp, currChar);
               prevChar:= str1[i];
          end
          else if ((i < len) and (prevChar <> ' ') and isPunc(currChar)) then
          begin
               temp:= Concat(temp, ' ');
               prevChar:= ' ';
          end;
     end;

     str1:= temp;
end;

procedure PreProcessInput( var str1 : string );
begin
     CleanString(str1);
     UpperCase(str1);
end;

function FindMatch( input : string ) : sList;
var
   match : sList;
   i : integer;

begin
     for i:= 1 to NumOfRecords do
     begin
          if KnowledgeBase[i][1] = input then
          begin
               CopyArray(KnowledgeBase[i], match, 2);
               break;
          end;
     end;

     FindMatch:= match;
end;

(* Main Procedure *)
begin
     randomize();

     sResponse:= '';

     while true do
     begin
          write('>');
          sPrevResponse:= sResponse;
          readln(sInput);
          PreProcessInput(sInput);
          responses:= FindMatch(sInput);
          if sInput = 'BYE' then
          begin
               writeln('IT WAS NICE TALKING TO YOU USER, SEE YOU NEXT TIME!');
               break;
          end
          else if length(responses[1]) = 0 then
          begin
               writeln('I''M NOT SURE IF I UNDERSTAND WHAT YOU ARE TALKING ABOUT.');
          end
          else
          begin
               IndexOfResp:= random(NumOfResponse) + 1;
               sResponse:= responses[IndexOfResp];
               (* avoids repeating the same response *)
               if sResponse = sPrevResponse then
               begin
                     IndexOfResp:= random(NumOfResponse - 1) + 2;
                    sResponse:= responses[IndexOfResp];
               end;
               writeln(sResponse);
          end;
     end;
     (* waits for the user to press enter before exiting the dos window *)
     readln;
end.