unit U_7Coins;
{Copyright 2000, 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
 }
{
 Place a coin on any free line of the 8 point start shown
(free line = no coins at either end) and slide it to
 one end.  Can you do this 6 more times so that 7 of the 8 star
 points are occupied?
}

interface

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

type
  TVertex=record
    x,y:integer;
    occupied:boolean;
    C1,C2:integer; {The indices of the 2 points that connect to this point}
  end;

  TCoinBoard=class(TPaintbox)
  private

  public
    {Vertex information}
    v:array[1..8] of TVertex;
    coincount:integer;
    center:TPoint;
    coin:TShape;
    movingcoin:integer;
    ShowItTime:boolean; {display coin being moved when this is true}
    constructor create(newPaintbox:TGraphicControl); reintroduce;
    procedure resize(newwidth, newheight:integer);   reintroduce;
    procedure reset;
    procedure paint(sender:Tobject);   reintroduce;
    function makemove:boolean;
    procedure movecoin(from,vnbr:integer);
    procedure XMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  end;

  TForm1 = class(TForm)
    MoveBtn: TButton;
    ResetBtn: TButton;
    Bevel1: TBevel;
    Timer1: TTimer;
    Panel1: TPanel;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure MoveBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  public
    coinboard:TCoinboard;
  end;

var
  Form1: TForm1;

implementation

uses U_msg;

{$R *.DFM}
const
  coinsize:integer=8;
  coincolor=clyellow;
{************************************************************}
{************************* TCoinBoard Methods ***************}
{************************************************************}

{*********************** Create ******************}
constructor TCoinBoard.create(newpaintbox:TGraphicControl);
var
  i:integer;
begin
  inherited create(newpaintbox.owner);
  parent:=newpaintbox.parent;
  top:=newpaintbox.top;
  left:=newpaintbox.left;
  height:=newpaintbox.height;
  width:=newpaintbox.width;
  coinsize:=width div 27;
  onmousedown:=xmousedown;
  onpaint:=paint;
  coin:=TShape.create(self);
  with coin do
  begin
    shape:=stcircle;
    parent:=self.parent;
    brush.color:=coincolor;
    visible:=false;
    width:=2*coinsize;
    height:=width;
  end;
  for i:=1 to 8 do
  begin
    v[i].C1:=(i+2) mod 8 + 1;
    v[i].C2:=(i+4) mod 8 + 1;
  end;
  resize(width,height);
  reset;
end;

{************************** Resize *****************}
procedure TCoinboard.resize(newwidth,newheight:integer);
{rescale the board to newwidth, newheight}
var
  i:integer;
  radius:integer;
  start,inc:single;

begin
  width:=newwidth;
  height:=newheight;
  coinsize:=width div 27;
  coin.width:=2*coinsize;
  coin.height:=coin.width;
  {define the vertex locations}
  center.x:=width div 2;
  center.y:=height div 2;
  radius:= (4*width) div 10;
  start:=- pi/8; {1/16 of a circle}
  inc :=2*start;
  for i:= 1 to 8 do
  with v[i] do
  begin
    x:=trunc(center.x-radius*cos(start));
    y:=trunc(center.y+radius*sin(start));
    start:=start+inc;
    occupied:=false;
  end;
  reset;
end;

{************************ Paint ******************}
procedure TCoinBoard.paint(Sender:Tobject);
{draw the coin board}
var
  i:integer;
begin
  canvas.brush.color:=clblue;
  canvas.fillrect(clientrect);
  {draw the lines}
  canvas.pen.width:=1;
  with canvas do
  for i:=1 to 8 do
  with v[i] do
  begin
    moveto(x,y);
    lineto(v[C1].x, v[C1].y);
  end;
  {draw coins/coin positions}
  canvas.Pen.width:=1;
  for i:=1 to 8 do
  with canvas, v[i] do
  begin
    if occupied
    then brush.color:=coincolor
    else brush.color:=color;

    if (i=movingcoin) and showittime then brush.color:=coincolor;
    ellipse(x-coinsize,y-coinsize,x+coinsize,y+coinsize);
    If brush.color=color then canvas.textout(x-4,y-5,inttostr(i));
  end;
end;

{********************* Reset ****************}
procedure TCoinBoard.reset;
var
  i:integer;
begin
  for i:= 1 to 8 do
  with v[i] do
  begin
    occupied:=false;
    {freelines:=2;}
  end;
  coincount:=0;
  movingcoin:=0;
  showItTime:=false;
  invalidate;  {force a redraw of the board}
end;

{********************** MoveCoin *****************}
procedure TCoinboard.movecoin(from,vnbr:integer);
{Animates moving a coin}
var
  i, steps:integer;
  xstep,ystep:single;
    coincenter:tpoint;

  begin
    with v[vnbr]  do
    begin
      coincenter.x:=v[from].x;
      coincenter.y:=v[from].y;
      steps:=40;
      xstep:=(x-coincenter.x)/steps;
      ystep:=(y-coincenter.y)/steps;
      coin.visible:=true;
      for i:= 0 to steps-1 do
      begin
        coin.left:=trunc(i*xstep)+coincenter.x-coinsize+self.left;
        coin.top:=trunc(i*ystep)+coincenter.y-coinsize+self.top;
        application.processmessages;
        sleep(5);
      end;
      coin.visible:=false;
      v[vnbr].occupied:=true;
      v[from].occupied:=false;
    end;
    invalidate;
  end;


 {***************** MakeMove ****************}
function TCoinboard.makemove:boolean;
{For computer solution, find a move to vertex with fewest
 available edges and make it}
var
  minlines,vnbr:integer;
  fromv:integer;
  start,f:integer;
begin
  result:=false;
  fromv:=0;
  begin
    if coincount=0 then minlines:=2 else minlines:=1;
   {find an unoccupied vertex with the minlines to it}
   start:=random(8)+1; {start search at a random vertex}
   vnbr:=start+1;
   while (fromv=0) and (vnbr <>start) do
   begin
     inc(vnbr);
     if vnbr>8 then vnbr:=1;
     f:=2;
     with v[vnbr] do
     if not occupied then
     begin
       if v[C1].occupied then dec(f);
       if v[C2].occupied then dec(f);
       if f=minlines
       then {we found a vertex to check}
       begin
         if (v[C1].occupied) and  (v[C2].occupied)
         then showmessage('System error #1 , Call Grandpa')
         else
         begin
           if minlines=1 then
           if v[c1].occupied then fromv:=c2
           else fromv:=c1
           else {2 to choose from}
           case random(1) of
             0: fromv:=C1;
             1: fromv:=C2;
           end;
           inc(coincount);
           movecoin(fromv, vnbr);
           result:=true;
         end;
       end;
      end;
    end;
  end;
end;

{*****************************************************}
{********************** Form Methods *****************}
{*****************************************************}

{************** FormCreate **************}
procedure TForm1.FormCreate(Sender: TObject);
begin
  randomize;
  doublebuffered:=true;
end;

{******************** FormActivate ***************}
procedure TForm1.FormActivate(Sender: TObject);
begin
  windowstate:=wsmaximized;
  coinboard:=TCoinboard.create(bevel1);

end;

{************************ FormResize ******************}
procedure TForm1.FormResize(Sender: TObject);
{FOrm is beign resized, resize the board}
begin
If assigned(coinboard)
then coinboard.resize(width-coinboard.left- width div 27,
                      height-coinboard.top- height div 27);
end;

{************************** MoveBtnClick **************}
procedure TForm1.MoveBtnClick(Sender: TObject);
{Find the best coin to move and move it}
begin
  {strategy is to move a coin to the vertex which has te fewest unoccupied
   lines running to it}
  movebtn.enabled:=false;
  with coinboard do
  begin
    movingcoin:=0; {in case there was a pending user move - ignore it}
    if makemove then
    begin
      If coincount=7 then
      with msgdlg do
      begin
        msgLbl.caption:='We have a winner! '+#13+#13+'        ME!!!';
        showmodal;
        reset;
      end;
    end
    else
    begin
      msgdlg.MsgLbl.caption:='No solution possible from here. '
       +#13+' I can''t save you from every mess you make!';
      MsgDlg.showmodal;
      reset;
    end;
  end;
  movebtn.enabled:=true;
end;

{********************** ResetBtnLick ***************}
procedure TForm1.ResetBtnClick(Sender: TObject);
begin
  coinboard.reset;
end;

{*************************** MouseDown ****************}
procedure TCoinboard.xMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,j, vnbr:integer;
  validmoves:integer;
begin
  vnbr:=0;
  for i:= 1 to 8 do
  begin
    if (abs(v[i].x - x)<coinsize)  and (abs(v[i].y-y)<coinsize) {clicked on a coin spot}
    then
    begin
      if (not v[i].occupied) then  vnbr:=i  else beep;
      break;
    end;
  end;
  if vnbr>0 then
  begin
    if movingcoin=0 then {start a new move}
    with v[vnbr] do
    begin
      if not (v[C1].occupied)
        or  not (v[C2].occupied) then
      begin
        movingcoin:=vnbr;
        showittime:=true; {force immediate display of flashing coin image}
        invalidate; {repaint}
      end
      else beep;
    end
    else
    with v[vnbr] do
    begin  {complete the move}
      if (C1 <> movingcoin) and (C2<>movingcoin) then vnbr:=0;
      if vnbr>0 then
      begin
        inc(coincount);
        movecoin(movingcoin,vnbr);
        movingcoin:=0;
        {see how many possible valid moves are left}
        validmoves:=0;
        for j:=1 to 8 do
        with v[j] do
        begin
          if (not v[j].occupied) and (not (v[C1].occupied and  v[C2].occupied))
          then
          begin
            inc(validmoves);
            break;
          end;
        end;
        if validmoves=0 then
        with msgdlg do
        begin
          if coincount=4
          then msglbl.caption:='Congratulations!'
              +#13+#13+'You just LOST in the fewest moves possible!'
          else if coincount<7
          then msglbl.caption:='You lose!'
              +#13+#13+'Might as well give up'
          else msglbl.caption:='You win!'
                         +#13+#13+'Probably just luck though'
                         +#13+#13+'Bet you can''t do it again';
          showmodal;
          reset;
        end;
      end
      else beep;
    end;
  end;
end;

{************************ Timer1Timer ***************}
procedure TForm1.Timer1Timer(Sender: TObject);
{Here's a timer that flips every half second to flash a pending coin move}
begin
  with coinboard do
  begin
    showittime:=not showittime;
    invalidate; {force coinboard repaint}
  end;
end;

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

end.