Knight's tour: Difference between revisions
no edit summary
Hendursaga (talk | contribs) m (Minor spelling fixes.) |
No edit summary |
||
Line 3,167:
d6 -> e4 -> c5 -> d3 -> e1 -> g2 -> h4 -> f5
d4 -> e2 -> f4 -> e6 -> g5 -> f3 -> g1 -> h3</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|Forms,Types,SysUtils,Graphics,ExtCtrls}}
Brute force method. Takes a long time for most solutions, so some optimization should be used. However, it has nice graphics.
<syntaxhighlight lang="Delphi">
{ These routines would normally be in a library,
but are presented here for clarity }
function PointAdd(V1,V2: TPoint): TPoint;
{Add V1 and V2}
begin
Result.X:= V1.X+V2.X;
Result.Y:= V1.Y+V2.Y;
end;
const KnightMoves: array [0..7] of TPoint = (
(X: 2; Y:1),(X: 2; Y:-1),
(X:-2; Y:1),(X:-2; Y:-1),
(X:1; Y: 2),(X:-1; Y: 2),
(X:1; Y:-2),(X:-1; Y:-2));
var Board: array [0..7,0..7] of boolean;
var Path: array of TPoint;
var CellSize,BoardSize: integer;
var CurPos: TPoint;
var BestPath: integer;
{-------------------------------------------------------------}
procedure DrawBestPath(Image: TImage);
begin
Image.Canvas.TextOut(BoardSize+5,5, IntToStr(BestPath));
end;
procedure PushPath(P: TPoint);
begin
SetLength(Path,Length(Path)+1);
Path[High(Path)]:=P;
if Length(Path)>BestPath then BestPath:=Length(Path);
end;
function PopPath: TPoint;
begin
if Length(Path)<1 then exit;
Result:=Path[High(Path)];
SetLength(Path,Length(Path)-1);
end;
procedure ClearPath;
begin
SetLength(Path,0);
end;
{-------- Routines to draw chess board and path --------------}
function GetCellCenter(P: TPoint): TPoint;
{Get pixel position of the center of cell}
begin
Result.X:=CellSize div 2 + CellSize * P.X;
Result.Y:=CellSize div 2 + CellSize * P.Y;
end;
procedure DrawPoint(Canvas: TCanvas; P: TPoint);
{Draw a point on the board}
begin
Canvas.Pen.Color:=clYellow;
Canvas.MoveTo(P.X-1,P.Y-1);
Canvas.LineTo(P.X+1,P.Y+1);
Canvas.MoveTo(P.X+1,P.Y-1);
Canvas.LineTo(P.X-1,P.Y+1);
end;
procedure DrawPathLine(Canvas: TCanvas; P1,P2: TPoint);
{Draw the path line}
var PS1,PS2: TPoint;
begin
PS1:=GetCellCenter(P1);
PS2:=GetCellCenter(P2);
Canvas.Pen.Width:=5;
Canvas.Pen.Color:=clRed;
Canvas.MoveTo(PS1.X,PS1.Y);
Canvas.LineTo(PS2.X,PS2.Y);
DrawPoint(Canvas,PS1);
DrawPoint(Canvas,PS2);
end;
procedure DrawPath(Canvas: TCanvas);
{Draw all points on the path}
var I: integer;
begin
for I:=0 to High(Path)-1 do
begin
DrawPathLine(Canvas, Path[I],Path[I+1]);
end;
end;
procedure DrawBoard(Canvas: TCanvas);
{Draw the chess board}
var R,R2: TRect;
var X,Y: integer;
var Color: TColor;
begin
Canvas.Pen.Color:=clBlack;
R:=Rect(0,0,BoardSize,BoardSize);
Canvas.Rectangle(R);
R:=Rect(0,0,CellSize,CellSize);
for Y:=0 to High(Board[0]) do
for X:=0 to High(Board) do
begin
R2:=R;
if ((X+Y) mod 2)=0 then Color:=clWhite
else Color:=clBlack;
Canvas.Brush.Color:=Color;
OffsetRect(R2,X * CellSize, Y * CellSize);
Canvas.Rectangle(R2);
end;
DrawPath(Canvas);
end;
function AllVisited: boolean;
{Test if all squares have been visit by path}
var X,Y: integer;
begin
Result:=False;
for Y:=0 to High(Board[0]) do
for X:=0 to High(Board) do
if not Board[X,Y] then exit;
Result:=True;
end;
procedure ClearBoard;
{Clear all board positions}
var X,Y: integer;
begin
for Y:=0 to High(Board[0]) do
for X:=0 to High(Board) do
Board[X,Y]:=False;
end;
function IsValidMove(Pos,Move: TPoint): boolean;
{Test if potential move is valid}
var NP: TPoint;
begin
Result:=False;
NP:=PointAdd(Pos,Move);
if (NP.X<0) or (NP.X>High(Board)) or
(NP.Y<0) or (NP.Y>High(Board[0])) then exit;
if Board[NP.X,NP.Y] then exit;
Result:=True;
end;
procedure ConfigureScreen(Image: TImage);
{Configure screen size}
begin
if Image.Width<Image.Height then BoardSize:=Image.Width
else BoardSize:=Image.Height;
CellSize:=BoardSize div 8;
end;
procedure SetPosition(Image: TImage; P: TPoint; Value: boolean);
{Set a new position by adding it to path}
{Marking position as used and redrawing board}
begin
if Value then PushPath(P)
else P:=PopPath;
Board[P.X,P.Y]:=Value;
DrawBoard(Image.Canvas);
DrawBestPath(Image);
Image.Repaint;
end;
procedure TryAllMoves(Image: TImage; Pos: TPoint);
{Recursively try all moves}
var I: integer;
var NewPos: TPoint;
begin
SetPosition(Image,Pos,True);
if AllVisited then exit;
for I:=0 to High(KnightMoves) do
begin
if AbortFlag then Exit;
if IsValidMove(Pos,KnightMoves[I]) then
begin
NewPos:=PointAdd(Pos,KnightMoves[I]);
TryAllMoves(Image,NewPos);
end;
end;
SetPosition(Image,Pos,False);
Application.ProcessMessages;
end;
procedure DoKnightsTour(Image: TImage);
{Solve Knights tour by testing all paths}
begin
BestPath:=0;
ConfigureScreen(Image);
ClearPath;
ClearBoard;
DrawBoard(Image.Canvas);
TryAllMoves(Image, Point(0,0));
end;
</syntaxhighlight>
{{out}}
<pre>
</pre>
=={{header|EchoLisp}}==
| |||