(* Program Name: chatterbot4
   Description: the goal of the current version of this program is to extend the previous chatterbot,
   actualy to make it more flexible in the way it treats the inputs from the different users.
   Also this version will try controling repetions that are made by the user.

   Author: Gonzales Cenelia
   Date: 4 july 2009
*)


program Chatterbot4;

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, sPrevInput, 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
           (*there has been some improvements made in
             here in order to make the matching process
             a littlebit more flexible
           *)
          if  Pos(KnowledgeBase[i][1], input) > 0 then
          begin
               CopyArray(KnowledgeBase[i], match, 2);
               break;
          end;
     end;

     FindMatch:= match;
end;

(* Main Procedure *)
begin
     randomize();

     sPrevInput:= '';
     sResponse:= '';

     while true do
     begin
          write('>');
          sPrevResponse:= sResponse;
          sPrevInput:= sInput;

          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 ((sInput = sPrevInput) and (length(sInput) > 0)) then
          begin
               (* controling repetitions made by the user *)
               writeln('YOU ARE REPEATING YOURSELF.');
          end
          else if length(responses[1]) = 0 then
          begin
               (* handles the case when the program doesn't understand what the user is talking about *)
               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.