DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦5af3a1149⟧ TextFile

    Length: 31382 (0x7a96)
    Types: TextFile
    Names: »B«

Derivation

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦306851c02⟧ 
                └─⟦this⟧ 

TextFile

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;