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

⟦decb88279⟧ TextFile

    Length: 37638 (0x9306)
    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 Button;  
use Button;  
with Draw;  
use Draw;  
with Main;  
use Main;  
with Ran1_Package;  
use Ran1_Package;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;

with Xlbp_Graphics;  
use Xlbp_Graphics;  
with Xlbp_Keyboard_Control;  
use Xlbp_Keyboard_Control;

package body Board is
------------------------------------------------------------------------------
-- Dragon - a version of Mah-Jongg for X Windows
--
-- Author: Gary E. Barnes        March 1989
--
-- Board - Deals with the Mah-Jongg board.  Setup and execution.
------------------------------------------------------------------------------
-- 05/30/90 GEB  - Translate to Ada
------------------------------------------------------------------------------

    Ran_Data : Ran1_Data;

--\f

    procedure Write_Game (File : Text_Io.File_Type) is
------------------------------------------------------------------------------
--   file    - Specifies a file open for write
--
-- Called to write out the current game context for later rereading.
------------------------------------------------------------------------------
        Bp : Board_Position;  
    begin

        S_Long_Io.Put (File, Score, Width => 0);  
        Text_Io.New_Line (File);  
        for Row in Board_Tiles'Range (1) loop  
            for Col in Board_Tiles'Range (2) loop  
                Bp := Board_Tiles (Row, Col);  
                for I in Bp.Tiles'Range loop  
                    S_Long_Io.Put (File, S_Long (Bp.Tiles (0)), Width => 0);  
                    Text_Io.Put (File, ' ');  
                end loop;  
                S_Long_Io.Put (File, S_Long (Bp.Level), Width => 0);  
                Text_Io.Put (File, ' ');  
                S_Long_Io.Put (File, S_Long (Bp.X), Width => 0);  
                Text_Io.Put (File, ' ');  
                S_Long_Io.Put (File, S_Long (Bp.Y), Width => 0);  
                Text_Io.New_Line (File);  
            end loop;  
        end loop;

    end Write_Game;

--\f

    procedure Read_Game (File : Text_Io.File_Type) is
------------------------------------------------------------------------------
--   file    - Specifies a file open for reading
--
-- Called to read in a new current game context.
------------------------------------------------------------------------------
        Bp : Board_Position;  
    begin

        Click1 := null;  
        Click2 := null;  
        S_Long_Io.Get (File, Score);  
        Text_Io.Skip_Line (File);  
        for Row in Board_Tiles'Range (1) loop  
            for Col in Board_Tiles'Range (2) loop  
                Bp := Board_Tiles (Row, Col);  
                for I in Bp.Tiles'Range loop  
                    S_Long_Io.Get (File, S_Long (Bp.Tiles (0)), Width => 0);  
                end loop;  
                Bp.Draw := True;  
                S_Long_Io.Get (File, S_Long (Bp.Level), Width => 0);  
                S_Long_Io.Get (File, S_Long (Bp.X), Width => 0);  
                S_Long_Io.Get (File, S_Long (Bp.Y), Width => 0);  
                Text_Io.Skip_Line (File);  
            end loop;  
        end loop;

    end Read_Game;

--\f

    procedure Pick_Tile (Avail : in out U_Char_Array; Pick : out U_Char) is
------------------------------------------------------------------------------
--   Avail       - Specifies an [NTILES] array of available tiles.  Unavailable
--                 slots contain NO_TILE.
--
-- Called to pick a random tile from the Available tiles.
------------------------------------------------------------------------------

        T : U_Char;  
        K : S_Long;

    begin

----Pick a random starting place.

        K := S_Long (Ran1 (Ran_Data) * Float (S_Long'Last / 2)) rem N_Tiles;

----Search until we find a non-NO_TILE slot.

        while (Avail (K) = No_Tile) loop  
            K := K + 1;  
            if K = N_Tiles then  
                K := 0;  
            end if;  
        end loop;

----Return the tile we found and zap the slot.

        T         := Avail (K);  
        Avail (K) := No_Tile;  
        Pick      := T;

    end Pick_Tile;

--\f

    procedure Set_Tile_Controls is
------------------------------------------------------------------------------
-- Called whenever the board has been reset or resized.  We recalculate all of
-- the drawing controls for the tiles.
------------------------------------------------------------------------------
    begin

----Now set up the control information for all of the tiles.  The special
--  tiles are easy.

        if Board_Tiles (Spec4_Row, Spec4_Col).Level > 0 then  
            Board_Tiles (Spec4_Row, Spec4_Col).X :=  
               Board_Tile0_X + 6 * (Tile_Width + 1) +  
                  (Tile_Width + 1) / 2 + 4 * Side_X;  
            Board_Tiles (Spec4_Row, Spec4_Col).Y :=  
               Board_Tile0_Y + 3 * (Tile_Height + 1) +  
                  (Tile_Height + 1) / 2 - 3 * Side_Y;  
        end if;

        if Board_Tiles (Spec3_Row, Spec3_Col).Level > 0 then  
            Board_Tiles (Spec3_Row, Spec3_Col).X :=  
               Board_Tile0_X + 0 * (Tile_Width + 1);  
            Board_Tiles (Spec3_Row, Spec3_Col).Y :=  
               Board_Tile0_Y + 3 * (Tile_Height + 1) + (Tile_Height + 1) / 2;  
        end if;

        if Board_Tiles (Spec2_Row, Spec2_Col).Level > 0 then  
            Board_Tiles (Spec2_Row, Spec2_Col).X :=  
               Board_Tile0_X + 13 * (Tile_Width + 1);  
            Board_Tiles (Spec2_Row, Spec2_Col).Y :=  
               Board_Tile0_Y + 3 * (Tile_Height + 1) + (Tile_Height + 1) / 2;  
        end if;

        if Board_Tiles (Spec1_Row, Spec1_Col).Level > 0 then  
            Board_Tiles (Spec1_Row, Spec1_Col).X :=  
               Board_Tile0_X + 14 * (Tile_Width + 1);  
            Board_Tiles (Spec1_Row, Spec1_Col).Y :=  
               Board_Tile0_Y + 3 * (Tile_Height + 1) + (Tile_Height + 1) / 2;  
        end if;

----Do the more regular tiles.

        for Row in S_Short range 0 .. 7 loop  
            for Col in reverse S_Short range 1 .. 12 loop  
                declare  
                    Bp : Board_Position renames Board_Tiles (Row, Col);  
                begin

----Skip any tiles that don't exist.

                    if Bp.Level /= 0 then

----Set up the face x/y coordinates.

                        Bp.X := Board_Tile0_X + Col * (Tile_Width + 1);  
                        Bp.Y := Board_Tile0_Y + Row * (Tile_Height + 1);  
                    end if;  
                end;  
            end loop;  
        end loop;

    end Set_Tile_Controls;

--\f

    procedure Pick1 (Bp    :        Board_Position;  
                     Avail : in out U_Char_Array) is  
    begin  
        Pick_Tile (Avail, Bp.Tiles (0));  
        Bp.Level := 1;  
    end Pick1;

    procedure Pick2 (Bp    :        Board_Position;  
                     Avail : in out U_Char_Array) is  
    begin  
        Pick_Tile (Avail, Bp.Tiles (0));  
        Pick_Tile (Avail, Bp.Tiles (1));  
        Bp.Level := 2;  
    end Pick2;

    procedure Pick3 (Bp    :        Board_Position;  
                     Avail : in out U_Char_Array) is  
    begin  
        Pick_Tile (Avail, Bp.Tiles (0));  
        Pick_Tile (Avail, Bp.Tiles (1));  
        Pick_Tile (Avail, Bp.Tiles (2));  
        Bp.Level := 3;  
    end Pick3;

    procedure Pick4 (Bp    :        Board_Position;  
                     Avail : in out U_Char_Array) is  
    begin  
        Pick_Tile (Avail, Bp.Tiles (0));  
        Pick_Tile (Avail, Bp.Tiles (1));  
        Pick_Tile (Avail, Bp.Tiles (2));  
        Pick_Tile (Avail, Bp.Tiles (3));  
        Bp.Level := 4;  
    end Pick4;

--\f

    procedure Setup_New_Game is
------------------------------------------------------------------------------
-- Called to generate an all-new game.
------------------------------------------------------------------------------
        Avail : U_Char_Array (0 .. N_Tiles - 1);  
        I     : S_Long;  
    begin

----Clear the board.

        for Row in S_Short range 0 .. N_Rows - 1 loop  
            for Col in S_Short range 0 .. N_Cols - 1 loop  
                declare  
                    Bp : Board_Position renames Board_Tiles (Row, Col);  
                begin  
                    Bp.Tiles (0) := No_Tile;  
                    Bp.Tiles (1) := No_Tile;  
                    Bp.Tiles (2) := No_Tile;  
                    Bp.Tiles (3) := No_Tile;  
                    Bp.Level     := 0;  
                end;  
            end loop;  
        end loop;

----Mark all tiles as available.

        I := 0;  
        for Row in S_Short range 0 .. 3 loop  
            Avail (I) := U_Char (Row + 1);  
            I         := I + 1;  
            Avail (I) := U_Char (Row + 5);  
            I         := I + 1;  
            for Col in S_Short range 8 .. N_Faces - 1 loop  
                Avail (I) := U_Char (1 + Col rem N_Faces);  
                I         := I + 1;  
            end loop;  
        end loop;  
        if I /= N_Tiles then  
            Text_Io.Put_Line ("NTILES gak!");  
        end if;

----Fill in the "odd" tile slots.

        Pick1 (Board_Tiles (Spec1_Row, Spec1_Col), Avail);  
        Pick1 (Board_Tiles (Spec2_Row, Spec2_Col), Avail);  
        Pick1 (Board_Tiles (Spec3_Row, Spec3_Col), Avail);  
        Pick1 (Board_Tiles (Spec4_Row, Spec4_Col), Avail);

        for Col in S_Short range 1 .. 12 loop  
            Pick1 (Board_Tiles (0, Col), Avail);  
            Pick1 (Board_Tiles (7, Col), Avail);  
        end loop;  
        for Row in S_Short range 1 .. 6 loop  
            Pick1 (Board_Tiles (Row, 3), Avail);  
            Pick1 (Board_Tiles (Row, 10), Avail);  
        end loop;  
        for Row in S_Short range 2 .. 5 loop  
            Pick1 (Board_Tiles (Row, 2), Avail);  
            Pick1 (Board_Tiles (Row, 11), Avail);  
        end loop;  
        for Row in S_Short range 3 .. 4 loop  
            Pick1 (Board_Tiles (Row, 1), Avail);  
            Pick1 (Board_Tiles (Row, 12), Avail);  
        end loop;

----Now do the next square at level 2.

        for Col in S_Short range 4 .. 9 loop  
            Pick2 (Board_Tiles (1, Col), Avail);  
            Pick2 (Board_Tiles (6, Col), Avail);  
        end loop;  
        for Row in S_Short range 2 .. 5 loop  
            Pick2 (Board_Tiles (Row, 4), Avail);  
            Pick2 (Board_Tiles (Row, 9), Avail);  
        end loop;

----Now do the next square at level 3.

        for Col in S_Short range 5 .. 8 loop  
            Pick3 (Board_Tiles (2, Col), Avail);  
            Pick3 (Board_Tiles (5, Col), Avail);  
        end loop;  
        for Row in S_Short range 3 .. 4 loop  
            Pick3 (Board_Tiles (Row, 5), Avail);  
            Pick3 (Board_Tiles (Row, 8), Avail);  
        end loop;

----Now do the final square at level 4.

        for Row in S_Short range 3 .. 4 loop  
            for Col in S_Short range 6 .. 7 loop  
                Pick4 (Board_Tiles (Row, Col), Avail);  
            end loop;  
        end loop;

----Now set up the control information for all of the tiles.

        Set_Tile_Controls;  
        Score := N_Tiles;

    end Setup_New_Game;

--\f

    procedure Restart_Game (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when the RESTART button is pressed.  Restart the game.
------------------------------------------------------------------------------
    begin

----Reset levels and remove hilites.

        Click1 := null;  
        Click2 := null;  
        Score  := N_Tiles;  
        for Row in S_Short range 0 .. N_Rows - 1 loop  
            for Col in S_Short range 0 .. N_Cols - 1 loop  
                declare  
                    Bp : Board_Position renames Board_Tiles (Row, Col);  
                begin  
                    if Bp.Tiles (3) /= No_Tile then  
                        Bp.Level := 4;  
                    elsif Bp.Tiles (2) /= No_Tile then  
                        Bp.Level := 3;  
                    elsif Bp.Tiles (1) /= No_Tile then  
                        Bp.Level := 2;  
                    else  
                        if Bp.Tiles (0) /= No_Tile then  
                            Bp.Level := 1;  
                        else  
                            Bp.Level := 0;  
                        end if;  
                    end if;  
                end;  
            end loop;  
        end loop;

----Finish setting up and then redraw everything.

        Set_Tile_Controls;  
        X_Clear_Area (Dpy, Main.Board, 0, 0, 0, 0, True);

    end Restart_Game;

--\f

    procedure Set_Tile_Draw (Row : S_Short;  
                             Col : S_Short) is
------------------------------------------------------------------------------
--   row - Specifies the row of the tile
--   col - Specifies the column of the tile
--
-- Called to set the "draw" flag on a tile.  We also recursively set the
-- draw flag on anyone that needs to be redrawn because we are being redrawn.
------------------------------------------------------------------------------
        Bp : Board_Position renames Board_Tiles (Row, Col);  
    begin

---If we don't exist or if we are already being redrawn then stop.

        if Bp.Level = 0 or else Bp.Draw then  
            return;  
        end if;

----Redraw us.  Redraw anyone to our left that has a height greater than ours
--  ecause their shadow/tile-face overlaps us.

        Bp.Draw := True;  
        if Col > 0 and then  
           Board_Tiles (Row, Col - 1).Level > Bp.Level then  
            Set_Tile_Draw (Row, Col - 1);  
        end if;

----Redraw anyone below us that has a level greater than ours because their
--  hadow/tile-face overlaps us.

        if Row < 7 and then  
           Board_Tiles (Row + 1, Col).Level > Bp.Level then  
            Set_Tile_Draw (Row + 1, Col);  
        end if;

----Redraw anyone below-to-the-left of us.

        if Row < 7 and then  
           Col > 0 and then  
           Board_Tiles (Row + 1, Col - 1).Level > 0 then  
            Set_Tile_Draw (Row + 1, Col - 1);  
        end if;

----Redraw anyone above-to-the-left of us that has a level greater than ours
--  ecause their tile-face overlaps our tile-edge.

        if Row > 0 and then  
           Col > 0 and then  
           Board_Tiles (Row - 1, Col - 1).Level /= Bp.Level then  
            Set_Tile_Draw (Row - 1, Col - 1);  
        end if;

----If we are certain specific tiles then we may need to set specific other
--  tiles.

        if Row = 3 or else Row = 4 then  
            if Col = 6 or else Col = 7 then  
                Set_Tile_Draw (Spec4_Row, Spec4_Col);  
            elsif Col = 1 then  
                Set_Tile_Draw (Spec3_Row, Spec3_Col);  
            end if;  
        end if;

    end Set_Tile_Draw;

--\f

    procedure Remove_Tile (Bp  : Board_Position;  
                           Row : S_Short;  
                           Col : S_Short) is
------------------------------------------------------------------------------
-- Called to remove the top tile of the indicated Board_Position.
------------------------------------------------------------------------------
    begin

----If the tile just went away then clear the area and allow the window
--  ackground to shine through.

        if Bp.Level = 1 then  
            if (Tile_Control and Shadow) /= 0 then  
                X_Clear_Area (Dpy, Main.Board, Bp.X, Bp.Y - Side_Y - Shadow_Y,  
                              U_Short (Tile_Width + Side_X + 2 + Shadow_X),  
                              U_Short (Tile_Height + Side_Y + 2 + Shadow_Y),  
                              False);  
            else  
                X_Clear_Area (Dpy, Main.Board, Bp.X, Bp.Y - Side_Y,  
                              U_Short (Tile_Width + Side_X + 2),  
                              U_Short (Tile_Height + Side_Y + 2),  
                              False);  
            end if;  
        else  
            declare  
                Sidex : S_Short := Side_X * Bp.Level;  
                Sidey : S_Short := Side_Y * Bp.Level;  
            begin  
                if (Tile_Control and Shadow) /= 0 then  
                    X_Clear_Area  
                       (Dpy, Main.Board, Bp.X + Sidex, Bp.Y - Sidey - Shadow_Y,  
                        U_Short (Tile_Width + 2 + Shadow_X),  
                        U_Short (Tile_Height + 2 + Shadow_Y),  
                        False);  
                else  
                    X_Clear_Area  
                       (Dpy, Main.Board,  
                        Bp.X + Sidex, Bp.Y - Sidey,  
                        U_Short (Tile_Width + 2), U_Short (Tile_Height + 2),  
                        False);  
                end if;  
                Set_Tile_Draw (Row, Col);  
            end;  
        end if;  
        Bp.Level := Bp.Level - 1;

----Schedule the surrounding tiles for redrawing.

        if Col = Spec1_Col then  
            if Row = Spec4_Row then  
                Set_Tile_Draw (3, 6);  
                Set_Tile_Draw (3, 7);  
                Set_Tile_Draw (4, 6);  
                Set_Tile_Draw (4, 7);  
                return;  
            elsif Row = Spec3_Row then  
                Set_Tile_Draw (3, 1);  
                Set_Tile_Draw (4, 1);  
                return;  
            elsif Row = Spec2_Row then  
                Set_Tile_Draw (Spec1_Row, Spec1_Col);  
                Set_Tile_Draw (3, 12);  
                Set_Tile_Draw (4, 12);  
                return;  
            else  
                Set_Tile_Draw (Spec2_Row, Spec2_Col);  
                Set_Tile_Draw (3, 12);  
                Set_Tile_Draw (4, 12);  
                return;  
            end if;  
        end if;  
        if Col = 1 and then (Row = 3 or else Row = 4) then  
            Set_Tile_Draw (Spec3_Row, Spec3_Col);  
        end if;  
        if Col = 12 and then (Row = 3 or else Row = 4) then  
            Set_Tile_Draw (Spec2_Row, Spec2_Col);  
        end if;  
        if Row > 0 then  
            Set_Tile_Draw (Row - 1, Col + 1);  
            Set_Tile_Draw (Row - 1, Col);  
            if Col > 0 and then  
               Board_Tiles (Row - 1, Col).Level = 0 then  
                Set_Tile_Draw (Row - 1, Col - 1);  
            end if;  
        end if;  
        Set_Tile_Draw (Row, Col + 1);  
        if Col > 0 then  
            Set_Tile_Draw (Row, Col - 1);  
        end if;  
        if Row < 7 then  
            Set_Tile_Draw (Row + 1, Col);  
            if Col > 0 then  
                Set_Tile_Draw (Row + 1, Col - 1);  
            end if;  
        end if;

    end Remove_Tile;

--\f

    procedure Touch_Tile (Bp    : Board_Position;  
                          Row   : S_Short;  
                          Col   : S_Short;  
                          Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when we click on a specific tile.  We decide what to do.  For a
-- single click we hilite the tile unless we already have two tiles hilited.
-- For a "double" click with two tiles hilited we will remove both of the
-- tiles.
------------------------------------------------------------------------------
    begin

----If there is no Click1 then this guy becomes it.

        if Click1 = null then  
            Click1     := Bp;  
            Click1_Row := Row;  
            Click1_Col := Col;  
            Hilite_Tile (Row, Col);  
            return;  
        end if;

----If there is no Click2 then this guy becomes it unless he is already Click1.

        if Click1 /= Bp then  
            if Click2_Row = Row and then  
               Click2_Col = Col and then  
               Click2_Time + Dragon_Resources.Double_Click >=  
                  Event.Button.Time then  
                Click2 := Bp;  
            end if;  
            if Click2 = null then  
                Click2      := Bp;  
                Click2_Row  := Row;  
                Click2_Col  := Col;  
                Click2_Time := Event.Button.Time;  
                Hilite_Tile (Row, Col);  
                return;  
            end if;

----If this guy is not one Click1 and not Click2 then we have an error.

            if Click2 /= Bp then  
                X_Bell (Dpy, 0);  
                return;  
            end if;  
        end if;

----If he double-clicks then remove both tiles.

        if Click2 /= null and then  
           Click2_Time + Dragon_Resources.Double_Click >= Event.Button.Time then  
            One_Button_Hint := False;  
            Remove_Tile (Click1, Click1_Row, Click1_Col);  
            Click1 := null;  
            Remove_Tile (Click2, Click2_Row, Click2_Col);  
            Click2 := null;  
            Score  := Score - 2;  
            Draw_All_Tiles;  
            return;  
        end if;

----2nd click on any tile means turn-it-off.

        if Click1 = Bp then  
            declare  
                S : S_Short;  
            begin  
                Hilite_Tile (Click1_Row, Click1_Col);  
                Click1     := Click2;  
                S          := Click1_Row;  
                Click1_Row := Click2_Row;  
                Click2_Row := S;  
                S          := Click1_Col;  
                Click1_Col := Click2_Col;  
                Click2_Col := S;  
                Click2     := null;  
            end;  
        else  
            Click2 := null;  
            Hilite_Tile (Click2_Row, Click2_Col);  
        end if;  
        Click2_Time := Event.Button.Time;

    end Touch_Tile;

--\f

    procedure Tile_Remove (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when the remove-selected-tile-pair mouse button is pressed.
------------------------------------------------------------------------------
    begin

        if Click1 /= null and then  
           Click2 /= null then  
            Click2_Time := Event.Button.Time;  
            Touch_Tile (Click2, Click2_Row, Click2_Col, Event);  
        end if;

    end Tile_Remove;

--\f

    function Touch (Bp    : Board_Position;  
                    Event : X_Button_Press_Event) return Boolean is
------------------------------------------------------------------------------
-- Return TRUE if this XButtonEvent touched this Board_Position.
------------------------------------------------------------------------------
        Face_X : S_Short := Bp.X + Bp.Level * Side_X;  
        Face_Y : S_Short := Bp.Y - Bp.Level * Side_Y;  
    begin

----Does this tile exist?

        if Bp.Level = 0 then  
            return False;  
        end if;

----Did we touch the face?

        if Event.Button.X >= Face_X and then  
           Event.Button.X <= Face_X + Tile_Width + 1 and then  
           Event.Button.Y >= Face_Y and then  
           Event.Button.Y <= Face_Y + Tile_Height + 1 then  
            return True;  
        end if;

----Did we touch the side?

        if Event.Button.X >= Bp.X and then  
           Event.Button.X <= Bp.X + Tile_Width + 1 and then  
           Event.Button.Y >= Bp.Y and then  
           Event.Button.Y <= Bp.Y + Tile_Height + 1 then  
            return True;  
        end if;

----Guess not.

        return False;

    end Touch;

--\f

    procedure Tile_Press (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when the Board receives a BtnDown event.
------------------------------------------------------------------------------
        X   : S_Short;  
        Y   : S_Short;  
        Row : S_Short;  
        Col : S_Short;  
    begin

----Figure out a rough row/col coordinate for the click.

        Y := Event.Button.Y - Board_Tile0_Y;  
        if Y < 0 then  
            return;  
        end if;  
        Row := Y / (Tile_Height + 1);  
        if Row > 7 then  
            return;  
        end if;  
        X := Event.Button.X - Board_Tile0_X;  
        if X < 0 then  
            return;  
        end if;  
        Col := X / (Tile_Width + 1);  
        if Col < 0 or else Row > 14 then  
            goto Touched;  
        end if;

----See if we are a special tile.

        if Col = 0 then  
            if Touch (Board_Tiles (Spec3_Row, Spec3_Col), Event) then  
                Touch_Tile (Board_Tiles (Spec3_Row, Spec3_Col),  
                            Spec3_Row, Spec3_Col, Event);  
                goto Touched;  
            end if;  
            goto Touched;  
        elsif Col = 13 then  
            if Touch (Board_Tiles (Spec2_Row, Spec2_Col), Event) then  
                Touch_Tile (Board_Tiles (Spec2_Row, Spec2_Col),  
                            Spec2_Row, Spec2_Col, Event);  
                goto Touched;  
            end if;  
            if Touch (Board_Tiles (4, 12), Event) then  
                Touch_Tile (Board_Tiles (4, 12), 4, 12, Event);  
                goto Touched;  
            end if;  
            if Touch (Board_Tiles (3, 12), Event) then  
                Touch_Tile (Board_Tiles (3, 12), 3, 12, Event);  
                goto Touched;  
            end if;  
            goto Touched;  
        elsif Col = Spec1_Col then  
            if Touch (Board_Tiles (Spec1_Row, Spec1_Col), Event) then  
                Touch_Tile (Board_Tiles (Spec1_Row, Spec1_Col),  
                            Spec1_Row, Spec1_Col, Event);  
                goto Touched;  
            end if;  
            if Touch (Board_Tiles (Spec2_Row, Spec2_Col), Event) then  
                Touch_Tile (Board_Tiles (Spec2_Row, Spec2_Col),  
                            Spec2_Row, Spec2_Col, Event);  
                goto Touched;  
            end if;  
            goto Touched;  
        elsif (Row = 3 or else Row = 4) and then (Col = 6 or else Col = 7) then  
            if Touch (Board_Tiles (Spec4_Row, Spec4_Col), Event) then  
                Touch_Tile (Board_Tiles (Spec4_Row, Spec4_Col),  
                            Spec4_Row, Spec4_Col, Event);  
                goto Touched;  
            end if;  
        end if;

----See if the x/y falls exactly into somebody else's tile face.

        if Col > 0 and then Row < 7 then  
            if Touch (Board_Tiles (Row + 1, Col - 1), Event) then  
                Touch_Tile (Board_Tiles (Row + 1, Col - 1),  
                            Row + 1, Col - 1, Event);  
                goto Touched;  
            end if;  
        end if;  
        if Row < 7 then  
            if Touch (Board_Tiles (Row + 1, Col), Event) then  
                Touch_Tile (Board_Tiles (Row + 1, Col), Row + 1, Col, Event);  
                goto Touched;  
            end if;  
        end if;  
        if Col > 0 then  
            if Touch (Board_Tiles (Row, Col - 1), Event) then  
                Touch_Tile (Board_Tiles (Row, Col - 1), Row, Col - 1, Event);  
                goto Touched;  
            end if;  
        end if;

----We don't have a touch on a neighbor so it must be us.

        if Touch (Board_Tiles (Row, Col), Event) then  
            Touch_Tile (Board_Tiles (Row, Col), Row, Col, Event);  
            goto Touched;  
        end if;

        <<Touched>> null;

    end Tile_Press;

--\f

    function Tile_Not_Free (Row : S_Short;  
                            Col : S_Short) return Boolean is
------------------------------------------------------------------------------
-- Returns TRUE if the tile has neither a left nor a right side free.
------------------------------------------------------------------------------
    begin

-- -- --The 4 in the center can be covered by SPEC4.

        if Row = 3 or else Row = 4 then  
            if (Col = 6 or else Col = 7) and then  
               Board_Tiles (Spec4_Row, Spec4_Col).Level > 0 then  
                return True;  
            elsif Col = 1 and then  
                  Board_Tiles (Spec3_Row, Spec3_Col).Level > 0 and then  
                  Board_Tiles (Row, Col + 1).Level > 0 then  
                return True;  
            elsif Col = 12 and then  
                  Board_Tiles (Spec2_Row, Spec2_Col).Level > 0 and then  
                  Board_Tiles (Row, Col - 1).Level > 0 then  
                return True;  
            end if;  
        end if;

----If a tile has a neighbor then he isn't free.

        if Board_Tiles (Row, Col - 1).Level >=  
           Board_Tiles (Row, Col).Level and then  
           Board_Tiles (Row, Col + 1).Level >= Board_Tiles (Row, Col).Level then  
            return True;  
        end if;

----Check the special tiles.

        if Col = Spec1_Col then

----Tiles 1, 3, and 4 are always free.

            if Row /= Spec2_Row then  
                return False;  
            end if;

----Tile 2 is free if tile 1 is gone or if its two normal neighbors are gone.

            if Board_Tiles (Spec1_Row, Spec1_Col).Level > 0 and then  
               (Board_Tiles (3, 12).Level > 0 or else  
                Board_Tiles (4, 12).Level > 0) then  
                return True;  
            end if;  
        end if;  
        return False;

    end Tile_Not_Free;

--\f

    procedure Tile_Release (Event : X_Button_Release_Event) is
------------------------------------------------------------------------------
-- Called when the Board receives a BtnUp event.
------------------------------------------------------------------------------
        Tile1 : U_Char;  
        Tile2 : U_Char;  
    begin

----If there is a Click2 and if the tile type does not match with Click1 then
----nhilite Click2.

        if not Cheating and then  
           Click1 /= null and then  
           Click2 /= null then  
            Tile1 := Click1.Tiles (S_Long (Click1.Level - 1));  
            Tile2 := Click2.Tiles (S_Long (Click2.Level - 1));  
            if -- Do tile faces match for those types that must match exactly?
               ((Tile1 > 8 or else Tile2 > 8) and then  
                  Tile1 /= Tile2) or else
               -- Are both tiles seasons?
               (Tile1 <= 4 and then Tile2 > 4) or else
               -- Are both tiles flowers?
               (Tile1 >= 5 and then  
                Tile1 <= 8 and then  
                (Tile2 < 5 or else Tile2 > 8)) then
                -- They don't match.
                if Dragon_Resources.Sticky_Tile then
                    -- Simply remove tile 2 from selected tiles.
                    Hilite_Tile (Click2_Row, Click2_Col);  
                else
                    -- Remove tile 1 from selection and make tile 2 => tile 1.
                    Hilite_Tile (Click1_Row, Click1_Col);  
                    Click1     := Click2;  
                    Click1_Row := Click2_Row;  
                    Click1_Col := Click2_Col;  
                    Click2_Col := 0;        -- Prevent dbl-clk removing 1 tile.
                end if;  
                Click2      := null;  
                Click2_Time := 0;  
            end if;  
        end if;

----If this tile has a left or a right neighbor then he isn't allowed.

        if not Cheating then  
            if Click2 /= null and then  
               Tile_Not_Free (Click2_Row, Click2_Col) then  
                Hilite_Tile (Click2_Row, Click2_Col);  
                Click2      := null;  
                Click2_Time := 0;  
            end if;  
            if Click1 /= null and then  
               Tile_Not_Free (Click1_Row, Click1_Col) then  
                Hilite_Tile (Click1_Row, Click1_Col);  
                Click1 := null;  
            end if;  
        end if;

    end Tile_Release;

--\f

    procedure Next_Tile (Click :        U_Char;  
                         Row   : in out S_Short;  
                         Col   : in out S_Short) is
------------------------------------------------------------------------------
-- Returns the "next" tile past row/col that exists and is "free".  Returns 0,0
-- when we run out of tiles.
------------------------------------------------------------------------------
        Tile1 : U_Char;  
        Tile2 : U_Char;  
    begin

----Loop until we give up.  Advance the column.  Advance the row on column
--  verflow.  Give up on row overflow.

        <<Continue>> null;  
        Col := Col + 1;  
        if Col > 14 then  
            Col := 1;  
            Row := Row + 1;  
            if Row > 7 then  
                Row := 0;  
                Col := 0;  
                return;  
            end if;  
        end if;

----Check this tile.  If it doesn't exist or isn't free then ignore it.

        if Board_Tiles (Row, Col).Level = 0 then  
            goto Continue;  
        end if;  
        if Tile_Not_Free (Row, Col) then  
            goto Continue;  
        end if;

----If moving Click1 then return now.

        if Click = 1 then  
            return;  
        end if;

----Continue the search if this tile does not match Click1.

        Tile1 := Click1.Tiles (S_Long (Click1.Level - 1));  
        Tile2 := Board_Tiles (Row, Col).Tiles  
                    (S_Long (Board_Tiles (Row, Col).Level - 1));  
        if -- Do tile faces match for those types that must match exactly?
           ((Tile1 > 8 or else Tile2 > 8) and then Tile1 /= Tile2) or else
           -- Are both tiles seasons?
           (Tile1 <= 4 and then Tile2 > 4) or else
           -- Are both tiles flowers?
           (Tile1 >= 5 and then Tile1 <= 8 and then  
            (Tile2 < 5 or else Tile2 > 8)) then
            -- They don't match.
            goto Continue;  
        end if;

    end Next_Tile;

--\f

    procedure Hints (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- If Click1 not present then search for the "first" remaining tile otherwise
-- use Click1 as our current "base" tile.
-- If Click1 present but not Click2 then search for any match for Click1.
-- If Click2 not present either then search for the first remaining tile past
-- Click1 otherwise search for the first remaining tile past Click2.
-- Keep searching for a new Click2 until we hit a matching tile or until we
-- run out.  Exit on match with new tile as Click2.
-- Advance Click1 and start a new search for Click2.  If we run out on Click1
-- then remove Click1.
------------------------------------------------------------------------------
    begin

----If we have a Click1 but no Click2 then search for a Click2.

        if Click1 /= null and then  
           Click2 = null then  
            One_Button_Hint := True;  
            Click2_Row      := 0;  
            Click2_Col      := 0;  
            loop  
                Next_Tile (2, Click2_Row, Click2_Col);  
                if Click2_Col = 0 then  
                    One_Button_Hint := False;  
                    Hilite_Tile (Click1_Row, Click1_Col);  
                    Click1 := null;  
                    return;  
                end if;  
                if Click2_Row /= Click1_Row or else  
                   Click2_Col /= Click1_Col then  
                    Click2 := Board_Tiles (Click2_Row, Click2_Col);  
                    Hilite_Tile (Click2_Row, Click2_Col);  
                    return;  
                end if;  
            end loop;  
        end if;

----Find a Click1 to work with if we don't already have one.

        if Click1 = null then  
            Click1_Row := 0;  
            Click1_Col := 0;  
            Next_Tile (1, Click1_Row, Click1_Col);  
            if Click1_Col = 0 then  
                return;  
            end if;  
            Hilite_Tile (Click1_Row, Click1_Col);  
            Click1 := Board_Tiles (Click1_Row, Click1_Col);  
        end if;

----Find our starting position for Click2 if we don't have one.

        if Click2 = null then  
            Click2_Row := Click1_Row;  
            Click2_Col := Click1_Col;  
        else  
            Hilite_Tile (Click2_Row, Click2_Col);  
            Click2 := null;  
        end if;

----Loop until we get something.

        loop  
            Next_Tile (2, Click2_Row, Click2_Col);  
            if Click2_Col /= 0 then  
                if Click2_Row /= Click1_Row or else  
                   Click2_Col /= Click1_Col then  
                    Click2 := Board_Tiles (Click2_Row, Click2_Col);  
                    Hilite_Tile (Click2_Row, Click2_Col);  
                    return;  
                end if;  
            else  
                Hilite_Tile (Click1_Row, Click1_Col);  
                Click1 := null;  
                if One_Button_Hint then  
                    One_Button_Hint := False;  
                    return;  
                end if;  
                Next_Tile (1, Click1_Row, Click1_Col);  
                if Click1_Col = 0 then  
                    return;  
                end if;  
                Hilite_Tile (Click1_Row, Click1_Col);  
                Click1     := Board_Tiles (Click1_Row, Click1_Col);  
                Click2_Row := Click1_Row;  
                Click2_Col := Click1_Col;  
            end if;  
        end loop;

    end Hints;

--\f

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 Board;