unit U_Slurpy;
{Copyright 2002, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

 {A fairly useless program from the 1996 Mid-Atlantic Regional ACM
  programming Contest}
 {"A Slurpy is a string of  characters that has certain properties.  Your
program will read in strings of characters and output whether or not
they are Slurpys (Slurpies?) .

A Slump is a character string that has the following  properties:
1.   Its first character is either a 'D' or an 'E'.
2.   The first character is followed by a string of one or more 'F's.
3.   The string of one or more 'F's is followed by either a Slump or a
      'G'.  The Slump or 'G' that follows the F's ends the Slump.  

A Slimp is a character string that has the following  properties:
1.   Its first character is an 'A'.
2.   If it is a two character Slimp then its second  and last character is 
      an 'H'.
3.   If it is not a two character Slimp then it is in one of these two
      forms:
     a. 'A' followed by 'B' followed by a Slimp followed by a 'C'.
     b. 'A' followed by a Slump (see above)  followed by a 'C'.

A Slurpy is a character string that consists of a Slimp followed by a 
Slump."}

{Recognizing strings that obey defined rules is one of the major tasks of
a compiler.  So what we have here is the start of a "Slurpy" compiler!
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    TestBtn: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    InitialTestBtn: TButton;
    procedure TestBtnClick(Sender: TObject);
    procedure InitialTestBtnClick(Sender: TObject);
  public
    function IsaSlimp(s:string; var rest:string):boolean;
    function IsaSlump(s:string; var rest:string):boolean;
    function ISaSlurpy(s:string; var rest:string):boolean;
    function TestString(text:string):string;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

 {******************* IsASlump ***************}
 function TForm1.IsASlump(s:string; var rest:string):boolean;
 {If S is a slump - return true and set rest =  S with the slump removed}
 {Implements a recursive definition by calling itself}
 var
   i:integer;
 begin
   result:=false;
   if length(s)=0 then exit;
   If ((s[1]='D') or (s[1]='E')) then
   begin
     i:=2;
     while (i<length(s)) and (s[i]='F') do inc(i);
     if (i>2) then
     begin
       if (isaSlump(copy(s,i,length(s)-i+1),rest))
       then result:=true
       else
       if (s[i]='G') then
       begin
         rest:=copy(s,i+1,length(s)-i);
         result:=true;
       end;
     end;
   end;
 end;

 {********************* IsASlump *****************}
 function TForm1.IsASlimp(s:string; var rest:string):boolean;
 {If S is a slimp - return true and set rest =  S with the slimp removed}
 begin
   result:=false;
   If s[1]='A' then
   begin
     delete(s,1,1);
     if length(s)=0 then exit;
     if  (s[1]='H')
     then
     begin
       result:=true;
       rest:=copy(s,2,length(s)-1);
     end
     else
     if (length(s)>1) then
     if (s[1]='B') then
     begin
       s:=copy(s,2,length(s)-1);
       if IsaSlimp(s,rest) and (length(rest)>0) and (rest[1]='C') then
       begin
         delete(rest,1,1);
         result:=true;
      end;
     end
     else
     if isAslump(s,rest) and (length(rest)>0) and (rest[1]='C') then
     begin
       delete(rest,1,1);
       result:=true;
     end;
   end;
 end;

 {******************* IsASlurpy ****************}
 function TForm1.IsASlurpy(s:string; var rest:string):boolean;
{If S is a slurpy - return true and set rest =  S with the slurpy removed}
 var
   rest2:string;
 begin
   result:=false;
   if isaslimp(s,rest2)
   and IsASlump(rest2,rest)
   then result:=true;
 end;

{******************** TestString ***************}
 function TForm1.TestString(text:string):string;
 {test a string and return message saying what it is}
 var
   s,rest:string;
  begin
    if isaslump(text,rest)  and (rest='')
    then s:='Is a Slump' else s:='';
    if isaslimp(text,rest)  and (rest='')
    then s:=s+', Is a Slimp';
    if isaslurpy(text,rest) and (rest='')
    then s:=s+', Is a Slurpy';
    while (length(s)>0) and (s[1] in [',',' ']) do delete(s,1,1);
    if length(s)>0 then result:=' ('+s+')'
    else result:=' (Is not recognized)';
  end;


{********************* TestBtnClick ****************}
procedure TForm1.TestBtnClick(Sender: TObject);
{Test edit1.text to see if it is a Slimp, Slump, or Slurpy}
begin
  listbox1.items.add(edit1.text+teststring(edit1.text));
  listbox1.itemindex:=listbox1.items.count-1; {force item to scroll into view}
End;

{********************** InitialTextBtnClick *************}
procedure TForm1.InitialTestBtnClick(Sender: TObject);
{Process initial list of test strings looking for Slumps, Slimps and Slurpies}
var
  I:integer;
begin
  with listbox1 do
  for i:=0 to items.count-1 do
  if (items[i]<>'') and (items[i][1]<>'*')
  then  items[i]:=items[i]+ teststring(items[i]);
end;

end.