Unit U_MeasuringCups;
{Copyright 2001, 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
 }

interface

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

type
TCup=class(TObject)
    visited, checked:boolean;
    path:TStringlist;
constructor create;
destructor destroy;  override;
end;

  TState1=array of TCup;

  TForm1 = class(TForm)
    Label1: TLabel;
    Cup1Edt: TEdit;
    Cup1UD: TUpDown;
    Label2: TLabel;
    Cup2Edt: TEdit;
    Cup2UD: TUpDown;
    GoBtn: TButton;
    ListBox1: TListBox;
    Target: TLabel;
    Memo1: TMemo;
    TargetBox: TListBox;
    BFSearchBtn: TCheckBox;
    AboutBtn: TButton;
procedure GoBtnClick(Sender: TObject);
procedure TargetBoxClick(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
procedure AboutBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
State: array of TState1;
    possibles:array of TstringList;
    C1,C2:integer;
function makemove(i,j:integer):boolean;
function FindShortest(var i,j:integer):boolean;
end;

var
Form1: TForm1;

implementation

uses math, U_About;

{$R *.DFM}
{************ TCup.create **********}
constructor TCup.create;
begin
inherited;
   path:=TStringlist.create;
end;

{************** TCup.Destroy ***********}
destructor TCup.destroy;
begin
path.free;
inherited;
end;

{********************* MakeMove *****************}
function TForm1.makemove(i,j:integer):boolean;

procedure checkmove(a,b:integer;msg:string);
begin
if not state[a,b].visited then
begin
state[a,b].visited:=true;
       state[a,b].path.assign(state[i,j].path);
       state[a,b].path.add('Step '+inttostr(state[a,b].path.count+1)+': '+msg+
'  ('+inttostr(a)+','+inttostr(b)+')');
       result:=true;
end;
end;

begin
result:=false;
if not state[i,j].visited then exit;
{empty j}  checkmove(i,0,'Empty B');
{empty i}  checkmove(0,j,'Empty A');
{fill i}   checkmove(c1,j,'Fill A from faucet');
{fill j}   checkmove(i,c2,'Fill B from faucet');

{pour j into i}
if (i+j<=c1) then checkmove(i+j,0,'Pour B into A');
if (j>=i) and (c1<=j+i) then checkmove(c1,J+i-c1,'Fill A from B');

{pour i into j}
if (i+j<=c2) then checkmove(0,i+j,'Pour A into B');
if (i>=j) and (c2<=j+i) then checkmove(i+j-c2,c2,'Fill B from A');
end;

{******************* FindShortest ******************}
function TForm1.FindShortest(var i,j:integer):boolean;
{find the shortest unchecked path and return coordinates }
{return false if no more unchecked}
var
ii,jj:integer;
   imin,jmin:integer;
   minpath:integer;

begin
result:=false;
  ii:=-1;
  minpath:=999;
while (ii<c1) do
begin
inc(ii);
    jj:=-1;
while (jj<C2) do
begin
inc(jj);
with state[ii,jj] do
If (visited) and (not checked) and (state[ii,jj].path.count<=minpath) then
begin
minpath:=state[ii,jj].path.count;
        imin:=ii;
        jmin:=jj;
end;
end;
end;
if minpath<999 then
begin
i:=imin;
    j:=jmin;
    result:=true;
end;
end;

{********************* GoBtnClick ******************}
procedure TForm1.GoBtnClick(Sender: TObject);
var
i,j:integer;
  newvisit:boolean;
begin
{free up old entries}
if length(state)>0 then
for i:= low(state) to high(state) do
for j:=low(state[i]) to high(state[i]) do state[i,j].free;
if length(possibles)>0 then
for i:= low(possibles) to high(possibles) do possibles[i].free;

{set up new case}
C1:=Cup1UD.position;
  C2:=Cup2UD.position;
  setlength(State,C1+1);
for i:=0 to C1 do setlength(State[i],C2+1);
  setlength(possibles,C1+C2+1);
for i:= 0 to C1+C2 do possibles[i]:=TStringlist.create;
for i:=0 to C1 do for j:=0 to c2 do state[i,j]:=TCup.create;
  state[0,0].visited:=true;
If not bfsearchbtn.checked then
repeat
newvisit:=false;
for i:=0 to C1 do for j:=0 to c2 do
if makemove(i,j) then
begin
newvisit:=true;
      break;
end;
until not newvisit
else {breadth first}
while Findshortest(i,j) do
begin
makemove(i,j);
    state[i,j].checked:=true;
end;

for i:= 0 to c1 do
if (state[i,0].visited) then
begin
if (possibles[i].count=0) then possibles[i].assign(state[i,0].path);
end;
for j:= 0 to c2 do
if (state[0,j].visited) then
begin
if (possibles[j].count=0) or (possibles[j].count>State[0,j].path.count)
then possibles[j].assign(state[0,j].path);
end;
for i:= 0 to c1 do for j:= 0 to c2 do
if (i+j>max(c1,c2)) and (state[i,j].visited) then
begin
if (possibles[i+j].count=0) or (possibles[i+j].count>State[i,j].path.count)
then possibles[i+j].assign(state[i,j].path);
end;
  TargetBox.clear;
for i:=1 to c1+c2 do if possibles[i].count>0
then TargetBox.items.addobject(inttostr(i),possibles[i]);
  TargetBox.itemindex:=0;
  TargetBoxclick(sender);
end;

(****************** TargetBoxClick ****************)
procedure TForm1.TargetBoxClick(Sender: TObject);
begin
with listbox1 do
begin
clear;
    items.assign(tstringlist(TargetBox.items.objects[TargetBox.itemindex]));
    items.insert(0,''); {header info}
items.insert(0,'To Measure '+ TargetBox.items[TargetBox.itemindex]+' ...');
end;
end;

(********************** ListBox1DrawItem **********************)
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
h,w,n,base,offset:integer;
  s:string;
  i,j:integer;
begin
with control as TListbox, canvas do
begin
{decide where to place stuff}
s:=items[index];
    h:=textheight('Iy');
    offset:=(itemheight-h) div 2;
    base:=itemheight-offset;
    textout(rect.left+5,rect.top+offset,s); {write the text}
if index>1 then {we're into the moves}
begin
w:=200 {textwidth(s)+10};
{extract the liquid volumes (i and j) from the text}
n:=pos('(',s);
      delete(s,1,n);
      n:=pos(',',s);
      i:=strtoint(copy(s,1,n-1));
      delete(s,1,n);
      n:=pos(')',s);
      j:=strtoint(copy(s,1,n-1));
with rect do
begin
{draw the first cup}
polyline([point(left+w-1,top+base-c1-1),point(left+w,top+base-c1),point(left+w,top+base),
                  point(left+w+10,top+base),point(left+w+10,top+base-c1),
                  point(left+w+12,top+base-c1-1)]);
        moveto(left+w,top+base-i); lineto(left+w+10,top+base-i);
        brush.color:=clblue;
if i>1 then floodfill(left+w+1,top+base-1,clblack,fsborder);
        w:=w+20; {move over}
{draw the second cup}
polyline([point(left+w-1,top+base-c2-1),point(left+w,top+base-c2),point(left+w,top+base),
                  point(left+w+10,top+base),point(left+w+10,top+base-c2),
                  point(left+w+12,top+base-c2-1)]);
        moveto(left+w,top+base-j); lineto(left+w+10,top+base-j);
        brush.color:=clblue;
if j>1 then floodfill(left+w+1,top+base-1,clblack,fsborder);
end;
end;
end;
end;

procedure TForm1.AboutBtnClick(Sender: TObject);
begin
Aboutbox.showmodal;
end;

end.