(* ==============================================================================
 *    File: WordChecker.p
 *  Purpose: Simple program to check two string to see if they are 
 *           palindromes. Also checks to see if the two strings are
 *           anagrams of each other.   
 *  Author: Jordan Kidney ( kidney@cpsc.ucalgary.ca )
 * Created on: March 12, 2006
  ============================================================================== *)
program WordChecker (input,output);

(*------------------------ isPalindrome ---------------------------------------
 * Purpose: checks to see if the string is a palindrome
 *   Param: str - the string to check 
 * returns: returns true if it is a palindrome, false otherwise
 * ---------------------------------------------------------------------------- *)
function isPalindrome(var str : string  ) : boolean;
begin
   var place1  : integer; (* used to go from the start of the string to the end  *)
   var place2  : integer; (* used to go from the end of the string to the start  *)
   var ret_val : boolean; (* used to store the value to return from the function *)
   var str_length :  integer;
  
   str_length := length(str);
   place1 := 1; place2 := str_length;
   ret_val := true;
   
   while  (place1 < str_length) do
    begin
     
      if ( UpCase(str[place1]) <> UpCase(str[place2]) ) then
       begin
	  ret_val := false;
	  break;
       end;
       
      place1 := place1 + 1;
      place2 := place2 - 1;
    end;
   
   isPalindrome := ret_val;
end; { isPalindrome }
(*------------------------ isAnagram ----------------------------------------------
 * Purpose: checks to see if the two strings  are anagrams of each other
 *   Param: str1, str2 - the two strings to compare
 * returns: returns true if they are anagrams of each other, false otherwise
 * ---------------------------------------------------------------------------- *)
function isAnagram(var str1, str2 : string   ) : boolean;
begin
   var ret_val : boolean;
   var chars1  : array[0..25] of integer;
   var chars2  : array[0..25] of integer;
   var i,tmp,tmp2  :  integer;
 
   ret_val := false;
      
   (* initalize each location in both arrays to zero *)
    for i:=0 to 25 do
       begin
         chars1[i]:=0;
         chars2[i]:=0;
       end;
   
   if( length(str1) = length(str2) ) then
     begin
      (* count the appearance of each character in the strings *)
       for i:=0 to length(str1) do
       begin
	  tmp  := ord( UpCase(str1[i]) ) - ord('A');
	  tmp2 := ord( UpCase(str2[i]) ) - ord('A');
	  
	  chars1[ tmp ]  := chars1[ tmp  ] + 1;
	  chars2[ tmp2 ] := chars2[ tmp2 ] + 1;
       end;

	ret_val := true;
       (* Now if each index in the chars arrays match then the strings are anagrams *)
	for i:=0 to 25 do
	begin
	   if ( chars1[i] <> chars2[i] ) then
	   begin
	      ret_val := false;
	      break;
	   end;
	end;
     end;

   isAnagram := ret_val;   
end; { isAnagram }
(* ========================== MAIN ============================================== *)
begin
   
   var string1 : string[100];
   var string2 : string[100];

   write("Enter string 1: "); readln(string1);
   write("Enter string 2: "); readln(string2);     

   (* check the string to see if they are palindromes *)
      
   if( isPalindrome(string1) ) then
      Writeln("the string '" ,string1,"' is a palindrome")
   else
      Writeln("the string '" ,string1,"' is not a palindrome");
      
   if( isPalindrome(string2) ) then
       Writeln("the string '" ,string2,"' is a palindrome")
   else
      Writeln("the string '" ,string2,"' is not a palindrome");
      
   (* check the strings to see if they are anagrams of each other *)   

   if( isAnagram(string1,string2) ) then
      Writeln("the strings '" ,string1,"' and '", string2,"' are anagrams of each other")
   else
      Writeln("the strings '" ,string1,"' and '", string2,"' are not anagrams of each other")
     
end.
(* ============================================================================== *)