unit U_FoxDuckCorn;
{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
 }

{Fox, duck and bag of corn must cross the river meeting certain conditions.
  This graphic version allows user play as well as computer solution.}

interface

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

type

Tmode=(autosolve, playing, stopping, gameover);

  TForm1 = class(TForm)
    SolveBtn: TButton;
    Memo1: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    Image2: TImage;
    RightFox: TImage;
    LeftDuck: TImage;
    LeftCorn: TImage;
    LeftFox: TImage;
    RightDuck: TImage;
    RightCorn: TImage;
    LeftBoat: TImage;
    RightBoat: TImage;
    TextInfo: TStaticText;
    ResetBtn: TButton;
    AboutBtn: TButton;
procedure SolveBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure LeftsideClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure Rightsideclick(Sender: TObject);
procedure AboutBtnClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
{Moves array - first index is "from" state, 2nd index is "to" state}
moves:array[0..15] of array[0..15] of boolean;
    visited:array[0..15] of boolean;
    losers:array[0..15] of boolean;
    state:byte;
    mode:TMode; {current playmode}

procedure reset;
function makemove(from:integer; var path:TStringlist):boolean;
procedure checkloser;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
Uses U_About;

procedure TForm1.FormActivate(Sender: TObject);
begin
panel1.color:=rgb(51,153,0);  {adjust background green of panel to match images}
mode:=gameover;
  reset;
end;

{******************** Reset **********************}
procedure tform1.reset;
{reinitialize  the game states}

var
i,j,k:integer;
  test,mask:byte;
begin

for i:= 0 to 15 do
begin
visited[i]:=false;
    losers[i]:=false;
for j:= 0 to 15 do moves[i,j]:=false;
end;
{mark valid moves}
for i:=0 to 15 do
begin
{the boat can always move so
     flip high order bit (the boat)  by itself  }
if i>=8 then
begin
test:=i-8;  {retain the fox, duck corn bits}
moves[i,i-8]:=true;
end
else
begin
{set compliment (invert the bits) for testing}
test:=7-i;  {for boat on left bank  test bit compliments }
moves[i,i+8]:=true; {allow boat only move (turn left bank high bit on)}
end;
{now check the other 3 bits (any one can be flipped) }
mask:=$01;
for k:= 0 to 2 do
begin
if (test and mask)>0 {bit is on}
then
begin
j:=test-mask; {turn it off in J}
If i>=8 then moves[i,j]:=true
else moves[i,15-j]:=true; {left bank, re-compliment}
end;
      mask:=mask shl 1; {shift the bit left one position}
end;
end;
{now let's disallow valid but losing states}
{8=boat, 4=fox, 2=duck, 1=corn}
{losers are binary 011x (fox & duck on right bank without the boat, 6&7)
                     0x11 (duck and corn on right bank without the boat, 3&7),
                     100x,(fox & duck on left bank without the boat, 8&9),
                     1x00 (duck and corn on left bank without the boat, 8&12),
                     00x1 {corn on the right bank  withpout the fox or boat
                          (wild birds come and eat the corn, 1&3)
                     }
{mark losers as invalid}
losers[1]:=true;
  losers[3]:=true;
  losers[6]:=true;
  losers[7]:=true;
  losers[8]:=true;
  losers[9]:=true;
  losers[12]:=true;

{make left side images visible and right side invisible}
with panel1 do for i:=0 to controlcount-1 do
if panel1.controls[i] is TImage then
with controls[i] as Timage do
begin
if uppercase(copy(name,1,4))='LEFT' then visible:=true
else if uppercase(copy(name,1,4))='RIGH' then visible:=false;
end;
  mode:=playing;
  textinfo.caption:='Click an object to move it across the river';
  state:=0; {initial play state}
end;

{********************** MakeMove ***********************}
function TForm1.makemove(from:integer; var path:TStringlist):boolean;
{Used in autosolve mode}
{recursive search for next unvisited state from "from"}
{add found states to "path" stringlist}
{return true when state 15 is reached (everbody on the right bank)}

var
j:integer;
begin
j:=-1;
  result:=false;
while (j<15) and (not result) do
begin
inc(j);
if (not visited[j]) and not(losers[j])
and  (moves[from,j]) then
begin
visited[j]:=true;
      path.add(format('%2d',[j]));
if j=15 then result:=true
else
begin
result:=makemove(j,path);
if not result then
begin
visited[j]:=false;
          path.delete(path.count-1);  {backtrack}
end;
end;
end;
end;
end;

{*************** SolvebtnClick ******************}
procedure TForm1.SolveBtnClick(Sender: TObject);
{Solve the puzzle}
var
path:tstringlist;
 i,j:integer;
 direction:string;
 prevn,n:byte;
begin
reset;
  mode:=autosolve;

{depth first search}
path:=TStringlist.create;
  path.add('00');
{make recursive call to make moves from state 0 to solve the puzzle}
if makemove(0,path) then {solution found}
with textinfo do
begin
prevn:=0;
for i:= 1 to path.count-1 do
if mode=autosolve then
begin
n:=strtoint(path[i]);
if prevn>n then direction :='left' else direction:='right';
      leftboat.visible:=not leftboat.visible;  {boat always moves}
rightboat.visible:=not rightboat.visible;
if abs(n-prevn)=8 then
begin
caption:='Move boat to '+direction+' bank';
end
else if abs(n-prevn)=12 then
begin
caption:='Move fox to '+direction+' bank';
        leftfox.visible:=not leftfox.visible;
        rightfox.visible:=not rightfox.visible;
end
else if abs(n-prevn)=10 then
begin
caption:='Move duck to '+direction+' bank';
        leftduck.visible:=not leftduck.visible;
        rightduck.visible:=not rightduck.visible;
end
else if abs(n-prevn)=9 then
begin
caption:='Move corn to '+direction+' bank';
        leftcorn.visible:=not leftcorn.visible;
        rightcorn.visible:=not rightcorn.visible;
end;
      prevn:=n;
for j:= 1 to 250 do {honor reset btn clicks while showing move}
begin
application.processmessages;
if mode<>autosolve then break;
        sleep(10);
end;
      application.processmessages;
end;

    caption:='That''s it!'
end
else caption:='No solution found';
  mode:=gameover;
end;

{*********************** CheckLoser *****************}
procedure TForm1.checkloser;
{actually checks for losing and winning moves}
begin
textinfo.caption:='';
case state of
1: Textinfo.caption:='You left the corn unguarded on the right bank and the crows ate it';
      3,12: Textinfo.caption:='Oh, oh - you left the duck alone with the corn and he ate it all!';
      6,7,8,9: Textinfo.caption:='Poor Daffy!  You left him unguarded for the fox to eat.';
end;
with textinfo do
if caption<>'' then
begin
mode:=gameover;
     caption:=caption+'  You lose!';
end
else
case state of
15:
begin
caption:='All acrossed safely.  Congratulations!';
        mode:=gameover;
end;
     11,13: caption:='That corn on the right bank has attracted the crow''s interest';
     5: caption:='The crows are still interested but too nervous with that fox around';

end;
end;


procedure TForm1.ResetBtnClick(Sender: TObject);
begin
reset;
end;

{**************** Leftsideclick ************}
procedure TForm1.LeftSideClick(Sender: TObject);
{handles clicks on left side images}
begin
if not (mode=playing) then reset;
if sender is timage then
with sender as timage do
{is boat on the left side also?}
if state<=8 then
begin
state:=state+8;
    leftboat.visible:=false;
    rightboat.visible:=not leftboat.visible;
    visible:=false;
if sender = leftfox then
begin
rightfox.visible:=true;
      state:=state or $04;
end
else if sender = leftduck then
begin
rightduck.visible:=true;
      state:=state or $02;
end
else if sender = leftcorn then
begin
rightcorn.visible:=true;
      state:=state or $01;
end;
    checkloser;
end;
end;

procedure TForm1.RightSideClick(Sender: TObject);
{handles clicks on right side images}
begin
if not (mode=playing) then reset;
if sender is timage then
with sender as timage do
{is boat on right side also?}
if state>8 then
begin
state:=state-8;  {turn off 8 bit}
leftboat.visible:=true;
    rightboat.visible:=not leftboat.visible;
    visible:=false;
if sender = rightfox then
begin
leftfox.visible:=true;
      state:=state -4 {and $0C}; {turn off 4 bit}
end
else if sender = rightduck then
begin
leftduck.visible:=true;
      state:=state -2 {and $0D}; {turn off 2 bit}
end
else if sender = rightcorn then
begin
leftcorn.visible:=true;
      state:=state -1 {and $0E}; {turn off 1 bit}
end;
    checkloser;
end;
end;

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

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
reset;
  canclose:=true;
end;

end.