|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 31382 (0x7a96)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦306851c02⟧
└─⟦this⟧
with Calendar;
with Text_Io;
with Puz_Main;
use Puz_Main;
with Ran1_Package;
use Ran1_Package;
package body Puz_Puzzle is
------------------------------------------------------------------------------
-- $Header: puzzle.c,v 1.3 88/02/24 15:42:56 rws Exp $
------------------------------------------------------------------------------
-- Puzzle - (C) Copyright 1987, 1988 Don Bennett.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice appear in all copies and that
-- both that copyright notice and this permission notice appear in
-- supporting documentation.
------------------------------------------------------------------------------
-- static char *rcsid_puzzle_c = "$Header: puzzle.c,v 1.3 88/02/24 15:42:56 rws Exp $";
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Puzzle
--
-- Don Bennett, HP Labs
--
-- this is the code that does the real work to solve the
-- puzzle. (Commonly seen as a 4x4 grid of sliding pieces
-- numbered 1-15 with one empty space.)
--
-- The idea for the solution algorithm - solving the puzzle
-- in layers working from the outside in - comes to me
-- indirectly from John Nagle.
------------------------------------------------------------------------------
type Direction_S_Long is array (Direction) of S_Long;
Ran_Data : Ran1_Data;
Max_Plan : constant := 1000;
Other_Dir : constant Direction_Array (0 .. 3) := (Right, Left, Down, Up);
Solving_Flag : Boolean := False;
Abort_Solving_Flag : Boolean := False;
Extra_Rows : S_Natural := 0;
Extra_Columns : S_Natural := 0;
Layers : S_Natural;
Tmp_Matrix : S_Long_2d_Access;
Target : S_Long_2d_Access;
Locked : S_Long_2d_Access;
Link : Direction_List;
Solve_Env : exception;
--\f
-- layer info macros -> (innermost 4 tiles are layer zero, ordinal goes up
-- as you move out)
-- layer_depth - returns number of (rows down),(cols across) the layer starts;
-- layer_width - number of blocks wide the layer is;
function Layer_Depth (L : S_Natural) return S_Natural is
begin
return Layers - 1 - L;
end Layer_Depth;
function Layer_Width (L : S_Natural) return S_Natural is
begin
return Puzzle_Size - 2 * Layer_Depth (L);
end Layer_Width;
-- /** macros for finding the corners of each layer **/
function Ful (L : S_Natural) return S_Natural is
begin
return Layer_Depth (L) * (Puzzle_Size + 1) +
Extra_Rows * Puzzle_Width + Extra_Columns * (Layers - (L));
end Ful;
function Fur (L : S_Natural) return S_Natural is
begin
return Layer_Depth (L) * (Puzzle_Size + 1) + Layer_Width (L) - 1 +
Extra_Rows * Puzzle_Width + Extra_Columns * (Layers - (L));
end Fur;
function Fll (L : S_Natural) return S_Natural is
begin
return (Layer_Depth (L) + Layer_Width (L) - 1) * Puzzle_Size +
Layer_Depth (L) + Extra_Rows * Puzzle_Size +
Extra_Columns * (Puzzle_Height + 1 + (L) - Layers);
end Fll;
function Flr (L : S_Natural) return S_Natural is
begin
return (Layer_Depth (L) + Layer_Width (L) - 1) * (Puzzle_Size + 1) +
Extra_Rows * Puzzle_Size +
Extra_Columns * (Puzzle_Height + 1 + (L) - Layers);
end Flr;
-- /** get the x and y coordinates of a location in the matrix **/
function Get_X (Loc : S_Long) return S_Long is
begin
return S_Long (Loc) rem S_Long (Puzzle_Width);
end Get_X;
function Get_Y (Loc : S_Long) return S_Long is
begin
return S_Long (Loc) / S_Long (Puzzle_Width);
end Get_Y;
function Indx (X, Y : S_Long) return S_Long is
begin
return Y * S_Long (Puzzle_Width) + X;
end Indx;
function Next_Left (Loc : S_Long) return S_Long is
begin
return Loc - 1;
end Next_Left;
function Next_Right (Loc : S_Long) return S_Long is
begin
return Loc + 1;
end Next_Right;
function Next_Up (Loc : S_Long) return S_Long is
begin
return Loc - S_Long (Puzzle_Width);
end Next_Up;
function Next_Down (Loc : S_Long) return S_Long is
begin
return Loc + Puzzle_Width;
end Next_Down;
--\f
------------------------------------------------------------------------------
-- this piece of code needs to be fixed if you want to use it
-- for non-square matrices;
------------------------------------------------------------------------------
procedure Print_Matrix (Mat : S_Long_2d) is
begin
Text_Io.New_Line;
for I in 0 .. Puzzle_Height - 1 loop
for J in 0 .. Puzzle_Width - 1 loop
Text_Io.Put (' ');
S_Long_Io.Put (Mat (Indx (J, I)), 2);
Text_Io.Put (' ');
end loop;
Text_Io.New_Line;
end loop;
Text_Io.New_Line;
end Print_Matrix;
--\f
procedure Plan_Move (Start_Loc : S_Natural;
End_Loc : S_Natural;
Path : in out Direction_Array;
Path_End : in out S_Natural);
function Find_Piece (Piece : S_Natural) return S_Natural is
begin
for I in 0 .. S_Natural (Puzzle_Width * Puzzle_Height - 1) loop
if Position (I) = Piece then
return I;
end if;
end loop;
-- text_io.put_line("piece %d not found!\n",piece);
raise Program_Error;
end Find_Piece;
--\f
procedure Move_Space (Diri : Direction;
Disti : S_Long);
procedure Move_Space_To (Loc : S_Natural) is
Current_Dir : Direction;
Dist : S_Natural;
Plan : Direction_Array (0 .. Max_Plan - 1);
Plan_End : S_Natural := 0;
begin
Plan_Move (Indx (Space_X, Space_Y), Loc, Plan, Plan_End);
Current_Dir := Plan (1);
Dist := 0;
for I in 1 .. Plan_End loop
if Plan (I) = Current_Dir then
Dist := Dist + 1;
elsif Plan (I) = Other_Dir (Direction'Pos (Current_Dir)) then
Dist := Dist - 1;
else
Move_Space (Current_Dir, Dist);
Current_Dir := Plan (I);
Dist := 1;
end if;
end loop;
Move_Space (Current_Dir, Dist);
end Move_Space_To;
--\f
procedure Move_Piece (Loci : S_Natural;
Target : S_Natural) is
Loc : S_Natural := Loci;
Plan : Direction_Array (0 .. Max_Plan - 1);
Plan_End : S_Natural := 0;
begin
Plan_Move (Loc, Target, Plan, Plan_End);
for I in 1 .. Plan_End loop
case Plan (I) is
when Left =>
Locked (Loc) := 1;
Move_Space_To (Next_Left (Loc));
Locked (Loc) := 0;
Move_Space_To (Loc);
Loc := Next_Left (Loc);
when Right =>
Locked (Loc) := 1;
Move_Space_To (Next_Right (Loc));
Locked (Loc) := 0;
Move_Space_To (Loc);
Loc := Next_Right (Loc);
when Up =>
Locked (Loc) := 1;
Move_Space_To (Next_Up (Loc));
Locked (Loc) := 0;
Move_Space_To (Loc);
Loc := Next_Up (Loc);
when Down =>
Locked (Loc) := 1;
Move_Space_To (Next_Down (Loc));
Locked (Loc) := 0;
Move_Space_To (Loc);
Loc := Next_Down (Loc);
when None =>
raise Program_Error;
end case;
end loop;
end Move_Piece;
--\f
procedure Plan_Move (Start_Loc : S_Natural;
End_Loc : S_Natural;
Path : in out Direction_Array;
Path_End : in out S_Natural) is
Queue_Size : constant := 1000;
Next_Loc : S_Natural;
Next_Dist : S_Natural;
Chosen : S_Natural;
Found_Path : S_Natural;
Move_Num : S_Natural;
Loc_X : S_Long;
Loc_Y : S_Long;
Loc_Queue : S_Long_2d (0 .. Queue_Size - 1);
Loc_Dist : S_Long_2d (0 .. Queue_Size - 1);
Loc_Queue_Used : S_Long_2d (0 .. Queue_Size - 1);
Queue_Head : S_Natural;
Queue_Tail : S_Natural;
Candidate : Direction_S_Long;
function Dist (Loc1, Loc2 : S_Natural) return S_Natural is
begin
return S_Natural (abs (Get_X (Loc1) - Get_X (Loc2)) +
abs (Get_Y (Loc1) - Get_Y (Loc2)));
end Dist;
begin
Found_Path := 0;
for I in 0 .. Puzzle_Width * Puzzle_Height - 1 loop
Tmp_Matrix (I) := -Locked (I);
Link (I) := None;
end loop;
Loc_Queue_Used := (others => 0);
Queue_Head := 0;
Queue_Tail := 0;
Loc_Queue (0) := Start_Loc;
Loc_Dist (0) := Dist (End_Loc, Start_Loc);
Tmp_Matrix (Start_Loc) := 1;
Queue_Tail := Queue_Tail + 1;
-- if the selected element has a distance of zero, we've found it;
-- (This really isn't a queue, but rather a range of elements
-- to be searched for an element of the desired properties;
-- as we search for a path,
-- LINK array is used to indicate the direction from which
-- we moved into a location;
-- TMP_MATRIX array is used to keep track of the move number;
while Queue_Head < Queue_Tail and then Found_Path = 0 loop
-- find the entry that
-- (1) has the smallest distance and
-- (2) has the smallest move number;
Next_Loc := Loc_Queue (Queue_Head);
Next_Dist := Loc_Dist (Queue_Head);
Chosen := Queue_Head;
for I in Queue_Head + 1 .. Queue_Tail - 1 loop
if Loc_Queue_Used (I) = 0 and then
(Loc_Dist (I) < Next_Dist or else
(Loc_Dist (I) = Next_Dist and then
Tmp_Matrix (Loc_Queue (I)) < Tmp_Matrix (Next_Loc))) then
Next_Loc := Loc_Queue (I);
Next_Dist := Loc_Dist (I);
Chosen := I;
end if;
end loop;
if Next_Dist = 0 then
Found_Path := 1;
exit;
end if;
Loc_Queue_Used (Chosen) := 1;
-- /********************************/
-- /** permute the chosen element **/
-- /********************************/
Candidate (Left) := Next_Left (Next_Loc);
Candidate (Right) := Next_Right (Next_Loc);
Candidate (Up) := Next_Up (Next_Loc);
Candidate (Down) := Next_Down (Next_Loc);
Loc_X := Get_X (Next_Loc);
Loc_Y := Get_Y (Next_Loc);
if Loc_X = 0 then
Candidate (Left) := -1;
end if;
if Loc_X = Puzzle_Width - 1 then
Candidate (Right) := -1;
end if;
if Loc_Y = 0 then
Candidate (Up) := -1;
end if;
if Loc_Y = Puzzle_Height - 1 then
Candidate (Down) := -1;
end if;
Move_Num := Tmp_Matrix (Next_Loc) + 1;
for I in Left .. Down loop
if Candidate (I) /= -1 and then
Tmp_Matrix (Candidate (I)) = 0 then
Tmp_Matrix (Candidate (I)) := Move_Num;
-- the next line works because the candidate index is
-- same as the direction moved to reach the candidate;
Link (Candidate (I)) := I;
Loc_Queue (Queue_Tail) := Candidate (I);
Loc_Dist (Queue_Tail) := Dist (End_Loc, Candidate (I));
Queue_Tail := Queue_Tail + 1;
if Queue_Tail = Queue_Size then
goto Broke;
end if;
end if;
end loop;
-- /***************************************************/
-- /** delete used items from the front of the queue **/
-- /***************************************************/
while Loc_Queue_Used (Queue_Head) /= 0 and then
Queue_Head < Queue_Tail loop
Queue_Head := Queue_Head + 1;
end loop;
end loop;
if Found_Path = 0 then
Text_Io.Put_Line ("couldn't find a way to move (" &
S_Long'Image (Get_X (Start_Loc)) & "," &
S_Long'Image (Get_Y (Start_Loc)) & ") to (" &
S_Long'Image (Get_X (End_Loc)) & "," &
S_Long'Image (Get_Y (End_Loc)) & ").");
Print_Matrix (Position.all);
Text_Io.New_Line;
Print_Matrix (Locked.all);
Text_Io.New_Line;
Path_End := 0;
return;
end if;
<<Broke>> null;
if Queue_Tail = Queue_Size then
Text_Io.Put_Line ("it didn't work.");
Path_End := 0;
return;
end if;
-- /** copy the path we found into the path array;
-- ** element 0 will contain the number of moves in the path;
-- **/
--
-- /** by the time we get there, next_loc is in the final location **/
Path_End := Tmp_Matrix (Next_Loc) - 1;
for I in reverse 1 .. Path_End loop
Path (I) := Link (Next_Loc);
case Link (Next_Loc) is
when Left =>
Next_Loc := Next_Right (Next_Loc);
when Right =>
Next_Loc := Next_Left (Next_Loc);
when Up =>
Next_Loc := Next_Down (Next_Loc);
when Down =>
Next_Loc := Next_Up (Next_Loc);
when None =>
raise Program_Error;
end case;
end loop;
end Plan_Move;
--\f
procedure Move_Space (Diri : Direction;
Disti : S_Long) is
Dir : Direction := Diri;
Dist : S_Long := Disti;
Step : S_Long;
Count : S_Long;
Min_X : S_Long;
Min_Y : S_Long;
Max_X : S_Long;
Max_Y : S_Long;
First_X : S_Long;
First_Y : S_Long;
Last_X : S_Long;
Last_Y : S_Long;
Shift_Dir : Direction;
begin
----Process events if we are Solving but not if we are already processing
-- events as that may cause us to process them in incorrect order.
if Solving_Flag and then not Abort_Solving_Flag and then
Puzzle_Pending /= 0 then
Process_Events;
end if;
if Solving_Flag and then Abort_Solving_Flag then
raise Solve_Env;
end if;
if Dist = 0 then
return;
end if;
if Dir = Left then
Dir := Right;
Dist := -Dist;
end if;
if Dir = Up then
Dir := Down;
Dist := -Dist;
end if;
First_X := Space_X;
First_Y := Space_Y;
Step := 1;
Count := Dist;
if Dist < 0 then
Step := -1;
Count := -Count;
end if;
-- /** first_x,y are the location of the first piece to be shifted **/
if Dir = Right then
First_X := First_X + Step;
else
First_Y := First_Y + Step;
end if;
-- /** shift_dir is the direction the pieces need to be shifted **/
if Dist < 0 then
Shift_Dir := Dir;
else
case Dir is
when Left =>
Shift_Dir := Right;
when Right =>
Shift_Dir := Left;
when Up =>
Shift_Dir := Down;
when Down =>
Shift_Dir := Up;
when None =>
raise Program_Error;
end case;
end if;
for I in 0 .. Count - 1 loop
if Dir = Right then
Position (Indx (Space_X, Space_Y)) :=
Position (Indx (Space_X + Step, Space_Y));
Position (Indx (Space_X + Step, Space_Y)) := 0;
Space_X := Space_X + Step;
-- /** dir = DOWN **/
else
Position (Indx (Space_X, Space_Y)) :=
Position (Indx (Space_X, Space_Y + Step));
Position (Indx (Space_X, Space_Y + Step)) := 0;
Space_Y := Space_Y + Step;
end if;
end loop;
Last_X := Space_X;
Last_Y := Space_Y;
-- /** the blocks first_x,y through last_x,y need to be shifted
-- ** one block in the shift_dir direction;
-- **/
if Output_Logging then
Log_Move_Space (First_X, First_Y, Last_X, Last_Y, Shift_Dir);
end if;
end Move_Space;
--\f
procedure Initialize is
-- /** Initialize the position and
-- ** the target matrices;
-- **/
--
Sp_X : S_Long;
Sp_Y : S_Long;
begin
Layers := Puzzle_Size / 2;
Extra_Rows := Puzzle_Height - Puzzle_Size;
Extra_Columns := Puzzle_Width - Puzzle_Size;
Position := new S_Long_2d (0 .. Puzzle_Width * Puzzle_Height - 1);
Tmp_Matrix := new S_Long_2d (0 .. Puzzle_Width * Puzzle_Height - 1);
Target := new S_Long_2d (0 .. Puzzle_Width * Puzzle_Height - 1);
Locked := new S_Long_2d (0 .. Puzzle_Width * Puzzle_Height - 1);
Link :=
new Direction_Array (0 .. Puzzle_Width * Puzzle_Height - 1);
Locked.all := (Locked.all'Range => 0);
for I in 0 .. Puzzle_Width * Puzzle_Height - 1 loop
Target (I) := I + 1;
Position (I) := I + 1;
end loop;
Position (Position'Last) := 0;
Target (Target'Last) := 0;
Space_X := Puzzle_Width - 1;
Space_Y := Puzzle_Height - 1;
-- /** Move the space into the LR corner of the
-- ** innermost layer;
-- ** For each of the outer layers, move the space
-- ** left one and up one;
-- **/
Sp_X := Space_X;
Sp_Y := Space_Y;
for I in 0 .. Layers - 2 loop
-- /** move the space left one; **/
Target (Indx (Sp_X, Sp_Y)) := Target (Indx (Sp_X - 1, Sp_Y));
Target (Indx (Sp_X - 1, Sp_Y)) := 0;
Sp_X := Sp_X - 1;
-- /** move the space up one; **/
Target (Indx (Sp_X, Sp_Y)) := Target (Indx (Sp_X, Sp_Y - 1));
Target (Indx (Sp_X, Sp_Y - 1)) := 0;
Sp_Y := Sp_Y - 1;
end loop;
end Initialize;
--\f
function Random return S_Natural is
begin
return S_Natural (Ran1 (Ran_Data) * Float (S_Natural'Last - 1));
end Random;
--\f
procedure Scramble is
New_X : S_Long;
New_Y : S_Long;
Old_Output_State : Boolean;
begin
Old_Output_State := Output_Logging;
Output_Logging := False;
for I in 0 .. 10 * Puzzle_Width * Puzzle_Height - 1 loop
New_X := S_Long (Ran1 (Ran_Data) * Float (Puzzle_Width - 1));
New_Y := S_Long (Ran1 (Ran_Data) * Float (Puzzle_Height - 1));
Move_Space (Right, New_X - Space_X);
Move_Space (Down, New_Y - Space_Y);
end loop;
Output_Logging := Old_Output_State;
end Scramble;
--\f
-- /** To solve this puzzle, work from the outside in;
-- ** For each successive ring working your way in,
-- **
-- ** (1) put the corners in place;
-- ** (2) finish off the rest of the boundaries;
-- ** (3) do the next layer in;
-- **/
procedure Solve_Layer_0 is
begin
Move_Piece (Find_Piece (Target (Ful (0))), Ful (0));
Move_Space_To (Flr (0));
end Solve_Layer_0;
procedure Do_Last_Two_On_Edge (Ntlast : S_Natural;
Last : S_Natural;
Tmp : S_Natural;
Emergency : S_Natural) is
Last_Piece : S_Natural;
Ntlast_Piece : S_Natural;
begin
Last_Piece := Target (Last);
Ntlast_Piece := Target (Ntlast);
Move_Piece (Find_Piece (Ntlast_Piece), Last);
Locked (Last) := 1;
-- /** if the last piece is stuck where the next to the last
-- ** piece should go, do some magic to fix things up;
-- **/
if Find_Piece (0) = Ntlast then
Move_Space_To (Tmp);
end if;
if Find_Piece (Last_Piece) = Ntlast then
-- /** a rescue is necessary **/
Locked (Last) := 0;
Move_Piece (Find_Piece (Ntlast_Piece), Ntlast);
Locked (Ntlast) := 1;
Move_Piece (Find_Piece (Last_Piece), Emergency);
Locked (Emergency) := 1;
Locked (Ntlast) := 0;
Move_Piece (Find_Piece (Ntlast_Piece), Last);
Locked (Emergency) := 0;
Locked (Last) := 1;
end if;
Move_Piece (Find_Piece (Last_Piece), Tmp);
Locked (Tmp) := 1;
Move_Space_To (Ntlast);
Locked (Tmp) := 0;
Locked (Last) := 0;
Move_Space_To (Last);
Move_Space_To (Tmp);
Locked (Ntlast) := 1;
Locked (Last) := 1;
end Do_Last_Two_On_Edge;
--\f
procedure Solve_Layer (Layer : S_Natural) is
Tmp : S_Long;
Last : S_Long;
Ntlast : S_Long;
Emergency : S_Long;
Ul : S_Long;
Ur : S_Long;
Ll : S_Long;
Lr : S_Long;
begin
if Layer = 0 then
Solve_Layer_0;
else
-- /** find and put each of the corners into place **/
Ul := Ful (Layer);
Ur := Fur (Layer);
Ll := Fll (Layer);
Lr := Flr (Layer);
Move_Piece (Find_Piece (Target (Ul)), Ul);
Locked (Ul) := 1;
Move_Piece (Find_Piece (Target (Ur)), Ur);
Locked (Ur) := 1;
Move_Piece (Find_Piece (Target (Ll)), Ll);
Locked (Ll) := 1;
Move_Piece (Find_Piece (Target (Lr)), Lr);
Locked (Lr) := 1;
-- /** Strategy for doing the pieces between the corners:
-- ** (1) put all but the last two edge pieces in place;
-- ** (2) put the next to the last piece next to the corner;
-- ** (3) put the last piece one move in from its final position;
-- ** (4) move the space to the final position of the next
-- ** to the last piece;
-- ** (5) slide the next to the last piece over and the last
-- ** piece into the edge where it goes.
-- **/
--
-- /**************/
-- /** top edge **/
-- /**************/
for I in Ul + 1 .. Ur - 3 loop
Move_Piece (Find_Piece (Target (I)), I);
Locked (I) := 1;
end loop;
Ntlast := Ur - 2;
Last := Ur - 2 + 1;
Tmp := Fur (Layer - 1);
Emergency := Next_Down (Tmp);
Do_Last_Two_On_Edge (Ntlast, Last, Tmp, Emergency);
-- /*****************/
-- /** bottom edge **/
-- /*****************/
for I in Ll + 1 .. Lr - 3 loop
Move_Piece (Find_Piece (Target (I)), I);
Locked (I) := 1;
end loop;
Ntlast := Lr - 2;
Last := Lr - 2 + 1;
Tmp := Flr (Layer - 1);
Emergency := Next_Up (Tmp);
Do_Last_Two_On_Edge (Ntlast, Last, Tmp, Emergency);
-- /***************/
-- /** left side **/
-- /***************/
declare
I : S_Natural;
begin
I := Ul + Puzzle_Width;
while I < Ll - 2 * Puzzle_Width loop
Move_Piece (Find_Piece (Target (I)), I);
Locked (I) := 1;
I := I + Puzzle_Width;
end loop;
end;
Ntlast := Ll - 2 * Puzzle_Width;
Last := Ll - 2 * Puzzle_Width + Puzzle_Width;
Tmp := Fll (Layer - 1);
Emergency := Next_Right (Tmp);
Do_Last_Two_On_Edge (Ntlast, Last, Tmp, Emergency);
-- /****************/
-- /** right side **/
-- /****************/
declare
I : S_Natural := Ur + Puzzle_Width;
begin
while I < Lr - 2 * Puzzle_Width loop
Move_Piece (Find_Piece (Target (I)), I);
Locked (I) := 1;
I := I + Puzzle_Width;
end loop;
Ntlast := I;
Last := I + Puzzle_Width;
Tmp := Flr (Layer - 1);
Emergency := Next_Left (Tmp);
Do_Last_Two_On_Edge (Ntlast, Last, Tmp, Emergency);
end;
end if;
-- if Master_Debug then
-- Text_Io.Put_Line ("Just did layer " & s_natural'Image (Layer));
-- Print_Matrix (Position.all);
-- end if;
end Solve_Layer;
--\f
procedure Solve_Row (Row : S_Natural) is
Loc : S_Long;
Last : S_Long;
Ntlast : S_Long;
Tmp : S_Long;
Emergency : S_Long;
begin
for I in 0 .. Puzzle_Width - 3 loop
Loc := Indx (I, Row);
Move_Piece (Find_Piece (Target (Loc)), Loc);
Locked (Loc) := 1;
end loop;
Ntlast := Indx (Puzzle_Width - 2, Row);
Last := Indx (Puzzle_Width - 1, Row);
Tmp := Last + Puzzle_Width;
Emergency := Tmp + Puzzle_Width;
Do_Last_Two_On_Edge (Ntlast, Last, Tmp, Emergency);
end Solve_Row;
--\f
procedure Solve_Col (Col : S_Natural) is
Loc : S_Long;
Last : S_Long;
Ntlast : S_Long;
Tmp : S_Long;
Emergency : S_Long;
begin
for I in 0 .. Puzzle_Height - 3 loop
Loc := Indx (Col, I);
Move_Piece (Find_Piece (Target (Loc)), Loc);
Locked (Loc) := 1;
end loop;
Ntlast := Indx (Col, Puzzle_Height - 2);
Last := Indx (Col, Puzzle_Height - 1);
Tmp := Last + 1;
Emergency := Tmp + 1;
Do_Last_Two_On_Edge (Ntlast, Last, Tmp, Emergency);
end Solve_Col;
--\f
procedure Abort_Solving is
begin
if Solving_Flag then
Abort_Solving_Flag := True;
end if;
end Abort_Solving;
--\f
function Solving_Status return Boolean is
begin
return Solving_Flag;
end Solving_Status;
--\f
procedure Solve is
begin
-- /** determine the position we want to be in when
-- ** we are done; This position will have the space in
-- ** the center; Then, we'll move the space back to
-- ** the outside.
-- **/
--
if Solving_Flag then
return;
end if;
begin
Solving_Flag := True;
Locked.all := (Locked.all'Range => 0);
-- /** solve the extra rows and cols **/
for I in 0 .. Extra_Rows - 1 loop
Solve_Row (I);
end loop;
for I in 0 .. Extra_Columns - 1 loop
Solve_Col (I);
end loop;
-- /** solve each layer **/
for I in reverse 0 .. Layers - 1 loop
Solve_Layer (I);
end loop;
-- /** move the space back out to the LR corner; **/
-- /** i is the layer the space is moving into **/
for I in 1 .. Layers - 1 loop
Move_Space (Down, 1);
Move_Space (Right, 1);
end loop;
Flush_Logging;
exception
when Solve_Env =>
Flush_Logging;
Repaint_Tiles;
end;
Locked.all := (Locked.all'Range => 0);
Abort_Solving_Flag := False;
Solving_Flag := False;
end Solve;
--\f
-- procedure Main is
-- Plan : Direction_Array (0 .. 1000 - 1);
-- begin
--
-- Master_Debug := True;
-- Initialize;
--
-- Print_Matrix (Position.all);
--
-- Scramble;
--
-- Print_Matrix (Position.all);
--
-- -- #ifdef UDEFINED
-- -- locked(indx(4,3)) := 1;
-- -- locked(indx(4,2)) := 1;
-- -- locked(indx(4,1)) := 1;
-- -- locked(indx(5,2)) := 1;
-- --
-- -- plan_move(indx(space_x,space_y),indx(5,1),plan);
-- -- print_matrix(tmp_matrix);
-- -- printf("\nplan has %d moves.\n",plan(0));
-- -- for (i:=0; i<plan(0); i++) {
-- -- switch(plan(i+1)) {
-- -- case UP: printf("up\n");
-- -- break;
-- -- case DOWN: printf("down\n");
-- -- break;
-- -- case LEFT: printf("left\n");
-- -- break;
-- -- case RIGHT: printf("right\n");
-- -- break;
-- -- }
-- -- }
-- -- #endif /* UDEFINED */
--
-- Solve;
--
-- Print_Matrix (Position.all);
-- Master_Debug := False;
--
-- end Main;
begin
declare
Clk : Calendar.Day_Duration := Calendar.Seconds (Calendar.Clock);
I : Natural;
begin
I := Natural (Clk / Duration (100.0));
Clk := Calendar.Day_Duration
(Clk - Duration (Duration (I) * Duration (100.00)));
----Clk is now in the 0..99.9999 range.
Ran_Data := Ran1_Initialize
(S_Natural (Float (Clk) * Float (Natural'Last / 101)));
end;
end Puz_Puzzle;