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

{ Solitaire for Squares -
   Drag each heart card onto a different spade so that that the sum of
   values for each pair is a perfect square.  (Squares are 4,9,16,25, etc. ).

  Jack has value 11, Queen has value 12, and King has value 13.

  How hard can it be?
}

interface

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

type
TBoard=array[1..13] of integer;
  TForm1 = class(TForm)
    HintBtn: TButton;
    StatusBar1: TStatusBar;
procedure HintBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure FormActivate(Sender: TObject);
public
board:TBoard; {array of spade slots, to be filled with heart card values}
targetboard:TBoard;  {the filled solution board used to give hints}
spadeset:array[1..13] of TCard; {the 13 spades}
heartset:array[1..13] of TCard; {the 13 hearts}
heartinplace:array[1..13] of boolean;{flag saying heart card is in place}
moveincrement:integer; {pixels per step during hintmove displays}
globalhint:boolean; {true if hint was given during game}
function getnextmove(board:TBoard; n:integer):boolean;
procedure resetboard;
end;

var Form1: TForm1;

implementation

uses U_Intro;
{$R *.DFM}

{************* IsSquare ***********}
function issquare(n:integer):boolean;
{return true if n is the square of another integer}
var i:integer;
begin
i:=trunc(sqrt(n));
if i*i=n then result:=true
else result:=false;
end;


{********************** GetNetxMove ****************}
function TForm1.getnextmove(board:TBoard; n:integer):boolean;
{recursive search to fill all 13 positions of a board so that
 the sum of each entry and it's positions is a square}
var
newboard:TBoard;
  i:integer;
begin
if n>13 then
begin
targetboard:=board;
    result:=true;
    exit;
end;
  result:=false;
  newboard:=board;
for i:=1 to 13 do
begin
if (board[i]=0) and (issquare(i+n)) then
begin
newboard[i]:=n;
      result:=getnextmove(newboard,n+1);
if not result then newboard[i]:=0
else break;
end;
end;
end;

procedure TForm1.resetboard;
{Reset the board and display to initial state}
var i:integer;
begin
for i:=1 to 13 do
begin
with spadeset[i] do
if i<=7 then
begin
left:=10+(i-1)*(width+10);
      top:=10;
end
else
begin
left:=10+(i-8)*(width+10);
      top:=150;
end;
with heartset[i] do
begin
left:=5+(i-1)*50;
      top:=325;
      bringtofront;
end;
    board[i]:=0;
    heartinplace[i]:=false;
end;
  globalhint:=false;
end;

{********************** FormCreate ***************}
procedure TForm1.FormCreate(Sender: TObject);
{Initialization stuff}
var  i:integer;
     board:TBoard;
begin
{create the cards}
for i:=1 to 13 do
begin
heartinplace[i]:=false;
    spadeset[i]:=TCard.Create(self);
with spadeset[i] do
begin
parent:=self;
      setcard(i,S);
      ondragover:=FormDragover;
      ondragdrop:=FormDragDrop;
      visible:=true;
end;
    heartset[i]:=TCard.Create(self);
with heartset[i] do
begin
parent:=self;
      setcard(i,H);
      dragmode:=dmautomatic; {allow dragging}
ondragover:=FormDragover;
      ondragdrop:=FormDragDrop;
      visible:=true;
end;
    board[i]:=0;
end;
{create the solution}
getnextmove(board,1);
  doublebuffered:=true;
  moveincrement:=4; {start at 4 pixels per step for hint moves}
resetboard;
end;

{***************** FormActivate **********}
procedure TForm1.FormActivate(Sender: TObject);
{Show intro dialog}
begin  introDlg.showmodal;  end;


{******************* FormDragDrop ************}
procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
{Called when a dragged card is dropped}
var i,n:integer;
begin
If (source is tcard) then
with source as tcard do
begin  {should only be a card that is beig dropped}
if (sender is TCard) and  (Tcard(sender).suit=Spades)
then
begin {dropping it on the correct spade}
if     (board[tcard(sender).value]=0)
and (issquare(value+Tcard(sender).value)) then
begin {Trying to drop a heart on an available spade and sum is square}
top:=TCard(sender).top+20;
        left:=TCard(sender).left;
        bringtofront;
if heartinplace[value] then
{we moved from a spade, so we need to find that spot and mark it empty}
for i:=1 to 13 do if board[i]=value then
begin
board[i]:=0;
          break;
end;
        heartinplace[value]:=true;
        board[tcard(sender).value]:=value;
        n:=0;
for i:=1 to 13 do if heartinplace[i] then inc(n);
if n=13 then {all in place - we have a winner!}
begin
if globalhint
then showmessage('Nice job, now can you do it with out hints?')
else showmessage('You did it! Call Mom and let her know!');
          resetboard;
end;
end
else beep;
end
else if (sender is TForm) or (sender is TCard) then
begin {dropping on form or another heart card}
if sender is tcard then
begin  {if on a card, convert coordinates back to form based}
x:=x+Tcard(sender).left;
        y:=y+Tcard(sender).top;
end;
      left:=x;
      top:=y;
      heartinplace[value]:=false;
{we may have moved the card off of a spade,
       if so, we need to update the board array to reflect that}
for i:=1 to 13 do if board[i]=value then
begin
board[i]:=0;
        break;
end;
end;
end;
end;

{***************** HintBtnClick ***************}
procedure TForm1.HintBtnClick(Sender: TObject);
procedure movecard(c:TCard; topt:TPoint);
var incr:integer;
begin
if topt.x<c.left then {moving left} incr:=-moveincrement
else incr:=+moveincrement;
while  abs(c.left-topt.x)>abs(incr) do
begin c.left:=c.left+incr; c.update; end;
if topt.y<c.top then {moving up} incr:=-moveincrement
else incr:=+moveincrement;
while  abs(c.top-topt.y)>abs(incr)
do begin c.top:=c.top+incr; c.update; end;
{put card in exact destination, since incr may not be exact}
c.left:=topt.x; 
    c.top:=topt.y;
    c.update;
end;

procedure movehintcard(h,s:integer);
var
origpoint:Tpoint;
    time:single;
    starttime:TDateTime;
    distance:integer;
begin
with heartset[h] do
begin
origpoint:=point(left,top);
      starttime:=now;
      distance:=abs(spadeset[s].left-left)+abs(spadeset[s].top-top);
      movecard(heartset[h], point(spadeset[s].left, spadeset[s].top+20));
      time:=secsperday*(now-starttime);
if (time>0) and (distance>0)
{adjust so that cards move about 250 pixels/second}
then moveincrement:=trunc(moveincrement*time*250/distance);
if moveincrement=0 then moveincrement:=1;
      sleep(1000);  {wait a seccond}
movecard(heartset[h], origpoint);    {and move it back}
end;
end;


var
i:integer;
  hintgiven:boolean;
begin  {hintbtnclick}
hintgiven:=false;
{First, see if there is an unfilled slot with the
   heart card available}
for i:=1 to 13 do
begin
if (board[i] = 0) and (heartinplace[targetboard[i]]=false)
then
begin
movehintcard(targetboard[i],i);
      hintgiven:=true;
      break;
end;
end;
{if that didn't work, look for an open slot with the card
   already placed incorrectly and move it}
if not hintgiven then
for i:=1 to 13 do
begin
if board[i] = 0 then
begin
movehintcard(targetboard[i],i);
      break;
end;
end;
  globalhint:=hintgiven;
end;


{***************** FormDragOver ***************}
procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
{Let the user try to drop card anywhere - dragdrop may reject the drop later}
{Alternatively, we could perform drop eligibility tests here and provide
 user with visual feedback, via the dragcursor, about valid drop locations}
begin accept:=true; end;



end.