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

⟦f3ec222fb⟧ TextFile

    Length: 43711 (0xaabf)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Text_Io;

with Board;  
use Board;  
with Draw;  
use Draw;  
with Main;  
use Main;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Graphics;  
use Xlbt_Graphics;  
with Xlbt_String;  
use Xlbt_String;

with Xlbp_Event;  
use Xlbp_Event;  
with Xlbp_Graphics;  
use Xlbp_Graphics;  
with Xlbp_Keyboard_Control;  
use Xlbp_Keyboard_Control;  
with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;  
with Xlbp_Sync;  
use Xlbp_Sync;

with Xlbmp_Environment;  
use Xlbmp_Environment;

package body Button is
-----------------------------------------------------------------------------
-- Dragon - a version of Mah-Jongg for X Windows
--
-- Author: Gary E. Barnes        March 1989
--
-- Button - Deals with the command buttons on the board
------------------------------------------------------------------------------
-- 04/24/89 GEB  - When "Other" pressed, if "Samples" is on then turn it off
--               -  before changing button menus.
-- 05/30/90 GEB  - Translate to Ada
------------------------------------------------------------------------------

    type Action_Enum is (Call_Null, Call_New_Game, Call_Restart_Game,  
                         Call_Save_Game, Call_Other, Call_Hints,  
                         Call_Restore_Game, Call_Game_Exit,  
                         Call_Redraw_All, Call_Sides,  
                         Call_Show_Samples, Call_Cheat, Call_Sync_All);

    type Button_Rec is  
        record  
            Text   : X_String_Pointer;  
            Action : Action_Enum;  
            Toggle : Boolean;  
            Hilite : Boolean;  
            X      : S_Short;  
            Y      : S_Short;  
            Text_X : S_Short;  
            Text_Y : S_Short;  
            Border : X_Point_Array (0 .. 6 * 4 + 4 + 1);  
        end record;

    type Button is access Button_Rec;

    N_Buttons : constant := 8;

    type Button_Array is array (S_Natural range 0 .. N_Buttons - 1) of Button;  
    type Button_2d_Array is array (S_Natural range 1 .. 2) of Button_Array;

    Other_Button   : constant := 3;  
    Samples_Button : constant := 2;

    All_Buttons_Array : Button_2d_Array :=  
       ((new Button_Rec'(new X_String'("New Game"), Call_New_Game,  
                         False, False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Restart"), Call_Restart_Game,  
                         False, False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Save"), Call_Save_Game, False,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Other"), Call_Other, True,  
                         False, 0, 0, 0, 0, (others => (0, 0))),

         new Button_Rec'(new X_String'("Hint"), Call_Hints, False,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'(""), Call_Null, False,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Restore"), Call_Restore_Game,  
                         False, False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Quit"), Call_Game_Exit, False,  
                         False, 0, 0, 0, 0, (others => (0, 0)))),

        (new Button_Rec'(new X_String'("Redraw"), Call_Redraw_All,  
                         False, False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Sides"), Call_Sides, False,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Samples"), Call_Show_Samples,  
                         True, False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Other"), Call_Other, True,  
                         False, 0, 0, 0, 0, (others => (0, 0))),

         new Button_Rec'(new X_String'("Cheat"), Call_Cheat, True,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'("Sync"), Call_Sync_All, True,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'(""), Call_Null, False,  
                         False, 0, 0, 0, 0, (others => (0, 0))),  
         new Button_Rec'(new X_String'(""), Call_Null, False,  
                         False, 0, 0, 0, 0, (others => (0, 0)))));

    All_Buttons : S_Long := 1;  
    Buttons1    : Button_Array renames All_Buttons_Array (1);  
    Buttons2    : Button_Array renames All_Buttons_Array (2);

    Button_Width  : S_Short := 0;  
    Button_Height : S_Short := 0;

    Letter_Indent : S_Short := 0;  
    Letter_Height : S_Short := 0;  
    Letter_Width  : S_Short := 0;

    Onoff : Boolean := False;

    procedure New_Game     (Event : X_Button_Press_Event);  
    procedure Restore_Game (Event : X_Button_Press_Event);

--\f

    procedure Call (What  : Action_Enum;  
                    Event : X_Button_Press_Event) is  
    begin

        case What is  
            when Call_Null =>  
                raise Program_Error;  
            when Call_New_Game =>  
                New_Game (Event);  
            when Call_Restart_Game =>  
                Restart_Game (Event);  
            when Call_Save_Game =>  
                Save_Game (Event);  
            when Call_Other =>  
                Other (Event);  
            when Call_Hints =>  
                Hints (Event);  
            when Call_Restore_Game =>  
                Restore_Game (Event);  
            when Call_Game_Exit =>  
                Game_Exit (Event);  
            when Call_Redraw_All =>  
                Redraw_All (Event);  
            when Call_Sides =>  
                Sides (Event);  
            when Call_Show_Samples =>  
                Show_Samples (Event);  
            when Call_Cheat =>  
                Cheat (Event);  
            when Call_Sync_All =>  
                Sync_All (Event);  
        end case;

    end Call;
--\f

    procedure Cheat (Event : X_Button_Press_Event) is  
    begin

        Cheating := not Cheating;

    end Cheat;

--\f

    procedure Game_Exit (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when we want to exit.
------------------------------------------------------------------------------
        Event2 : X_Event;  
    begin

        loop  
            X_Next_Event (Dpy, Event2);  
            if Event2.Kind = Xlbt_Event.Button_Release then  
                exit;  
            end if;  
        end loop;  
        raise Quit;  
    end Game_Exit;

--\f

    procedure New_Game (Event : X_Button_Press_Event) is  
    begin

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

    end New_Game;

--\f

    procedure Other (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called to change button menus.
------------------------------------------------------------------------------
        Expose : X_Expose_Event;  
    begin

        if All_Buttons = 1 then  
            All_Buttons := 2;  
        else
            -- --Turn off Samples mode if we are changing menus.
            if Buttons2 (Samples_Button).Hilite then  
                Call ((Buttons2 (Samples_Button).Action), Event);  
                Buttons2 (Samples_Button).Hilite := False;  
            end if;  
            All_Buttons := 1;  
        end if;  
        All_Buttons_Array (All_Buttons) (Other_Button).Hilite :=  
           not All_Buttons_Array (All_Buttons) (Other_Button).Hilite;  
        X_Clear_Area (Dpy, Main.Board, 0, 0, 0,  
                      U_Short (2 * Tile_Height - Side_Y - Shadow_Y - 1),  
                      False);  
        Button_Expose;

    end Other;

--\f

    procedure Redraw_All (Event : X_Button_Press_Event) is  
    begin

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

    end Redraw_All;

--\f

    procedure Restore_Game (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called to restore a previous game.
------------------------------------------------------------------------------
--/ if R1000 then
        Name : constant X_String := X_Env_Concat_Dir_File  
                                       (X_Env_Get_Home_Dir, "dragon_save");
--/ else
--//         Name : constant X_String :=
--//            X_Env_Concat_Dir_File (X_Env_Get_Home_Dir, ".dragon-save");
--/ end if;
        File : Text_Io.File_Type;  
    begin

        begin  
            Text_Io.Open (File, Text_Io.In_File, To_String (Name));  
        exception  
            when others =>  
                Text_Io.Put_Line ("Cannot open the " & To_String (Name) &  
                                  " file for reading.");  
                X_Bell (Dpy, 100);  
                return;  
        end;  
        Read_Game (File);  
        Text_Io.Close (File);  
        Redraw_All (Event);

    end Restore_Game;

--\f

    procedure Save_Game (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called to save the current game.
------------------------------------------------------------------------------
--/ if R1000 then
        Name : constant X_String := X_Env_Concat_Dir_File  
                                       (X_Env_Get_Home_Dir, "dragon_save");
--/ else
--//         Name : constant X_String :=
--//            X_Env_Concat_Dir_File (X_Env_Get_Home_Dir, ".dragon-save");
--/ end if;
        File : Text_Io.File_Type;  
    begin

        begin  
            Text_Io.Open (File, Text_Io.Out_File, To_String (Name));  
        exception  
            when others =>  
                begin  
                    Text_Io.Create (File, Text_Io.Out_File, To_String (Name));  
                exception  
                    when others =>  
                        Text_Io.Put_Line ("Cannot open the " &  
                                          To_String (Name) &  
                                          " file for writing.");  
                        X_Bell (Dpy, 100);  
                        return;  
                end;  
        end;  
        Write_Game (File);  
        Text_Io.Close (File);

    end Save_Game;

--\f

    procedure Sides (Event : X_Button_Press_Event) is  
    begin

        if (Tile_Control and Shadow) /= 0 then  
            if (Tile_Control and Blackside) /= 0 then  
                if (Tile_Control and Grayside) /= 0 then  
                    Tile_Control :=  
                       Tile_Control and not (Shadow or Blackside or Grayside);  
                else  
                    Tile_Control := Tile_Control and not Shadow;  
                    Tile_Control := Tile_Control or Grayside;  
                end if;  
            else  
                Tile_Control := Tile_Control and not Shadow;  
                Tile_Control := Tile_Control or Blackside;  
            end if;  
        else  
            Tile_Control := Tile_Control or Shadow;  
        end if;  
        X_Clear_Area (Dpy, Main.Board, 0, 0, 0, 0, True);

    end Sides;

-- \f

    procedure Sync_All (Event : X_Button_Press_Event) is  
        Void : Proc_Var_X_Synchandler.Pv;  
    begin

        Onoff                  := not Onoff;  
        Dragon_Resources.Debug := Onoff;  
        Void                   := X_Synchronize (Dpy, Onoff);

    end Sync_All;

--\f

    procedure Do_Button_Configuration is
------------------------------------------------------------------------------
-- Called when the Board changes Tile sizes.
------------------------------------------------------------------------------
        Buttons_Per_Line : constant := 4;  
        Indent           : S_Short;  
        X, Dx            : S_Short;  
        Y, Dy            : S_Short;  
        I, J             : S_Short;  
        F, S, T          : S_Short;  
        L                : S_Short;  
        Pnti             : S_Natural;  
        But              : Button;

        procedure Pnt (X, Y : S_Short) is  
        begin  
            But.Border (Pnti).X := X;  
            But.Border (Pnti).Y := Y;  
            Pnti                := Pnti + 1;  
        end Pnt;  
    begin

----Buttons will be three tiles wide and 2/3'rd of a tile high.

        Button_Width  := 3 * Tile_Width;  
        Dx            := Button_Width + Tile_Width / 2;  
        Button_Height := 5 * Tile_Height / 9;  
        Dy            := Tile_Height * 8 / 10;

----Letters are as large as can fit within the buttons.

        Indent        := Button_Height / 5;  
        Letter_Indent := Indent + 2;  
        S             := Letter_Indent * 3 / 4;  
        T             := S / 2;  
        F             := Indent - S + T;  
        Letter_Height := Button_Height - (2 * Indent) - 2;  
        if (Letter_Height rem 2) = 0 then  
            Letter_Height := Letter_Height - 1;  
        end if;  
        Letter_Width := (Button_Width - (2 * Indent) - 2) / 8 - 2;  
        if (Letter_Width rem 2) = 0 then  
            Letter_Width := Letter_Width - 1;  
        end if;

----Now place the buttons.

        for J in S_Natural range 1 .. 2 loop  
            X := Indent + 12;  
            Y := Indent + 4;  
            for I in All_Buttons_Array (J)'Range loop  
                But := All_Buttons_Array (J) (I);  
                if But.Text.all = "" then  
                    goto Next_Button;  
                end if;  
                L := But.Text'Length;  
                if L > 8 then  
                    Text_Io.Put_Line ("Button name too long: " &  
                                      To_String (But.Text.all));  
                    L := 8;  
                end if;  
                But.X      := X;  
                But.Y      := Y;  
                But.Text_X := (Button_Width - L * (Letter_Width + 2) + 2) / 2;  
                But.Text_Y := Indent + 1;

                Pnti := 0;  
                Pnt (X, Y + Indent);  
                Pnt (F, 0);  
                Pnt (0, -S);  
                Pnt (-T, 0);  
                Pnt (0, T);  
                Pnt (S, 0);  
                Pnt (0, -F);  
                Pnt (Button_Width - 2 * Indent, 0);  
                Pnt (0, F);  
                Pnt (S, 0);  
                Pnt (0, -T);  
                Pnt (-T, 0);  
                Pnt (0, S);  
                Pnt (F, 0);  
                Pnt (0, Button_Height - 2 * Indent);  
                Pnt (-F, 0);  
                Pnt (0, S);  
                Pnt (T, 0);  
                Pnt (0, -T);  
                Pnt (-S, 0);  
                Pnt (0, F);  
                Pnt (-(Button_Width - 2 * Indent), 0);  
                Pnt (0, -F);  
                Pnt (-S, 0);  
                Pnt (0, T);  
                Pnt (T, 0);  
                Pnt (0, -S);  
                Pnt (-F, 0);  
                Pnt (0, -Button_Height + 2 * Indent);

                <<Next_Button>> null;  
                if I rem Buttons_Per_Line + 1 = Buttons_Per_Line then  
                    X := Indent + 12;  
                    Y := Y + Dy;  
                else  
                    X := X + Dx;  
                end if;  
            end loop;  
        end loop;

    end Do_Button_Configuration;

--\f

    procedure Draw_Text (Str : X_String;  
                         Px  : S_Short;  
                         Py  : S_Short) is
------------------------------------------------------------------------------
-- Called to draw the vector text in some button.
------------------------------------------------------------------------------
        X    : S_Short := Px;  
        Y    : S_Short := Py;  
        Pnts : X_Point_Array (0 .. 49);  
        Pnti : S_Long;  
        H1   : S_Short;  
        W1   : S_Short;

        procedure Pnt (X, Y : S_Short) is  
        begin  
            Pnts (Pnti).X := X;  
            Pnts (Pnti).Y := Y;  
            Pnti          := Pnti + 1;  
        end Pnt;

    begin

----Position ourselves for the first letter.

        H1 := Letter_Height - 1;  
        W1 := Letter_Width - 1;

----Loop over all letters in the text.

        for Stri in Str'Range loop  
            Pnti := 0;  
            case Str (Stri) is

----The letters we have.

                when '0' =>  
                    declare  
                        W6, H6, H26 : S_Short;  
                    begin

                        H6  := H1 / 6;  
                        H26 := H1 - 4 * H6;  
                        W6  := W1 / 6;

                        Pnt (X, Y + H6 + H6);  
                        Pnt (0, H26);  
                        Pnt (W6, H6);  
                        Pnt (W6, H6);  
                        Pnt (W1 - 4 * W6, 0);  
                        Pnt (W6, -H6);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H26);  
                        Pnt (-W6, -H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-(W1 - 4 * W6), 0);  
                        Pnt (-W6, H6);  
                        Pnt (-W6, H6);  
                    end;

                when '1' =>  
                    Pnt (X + (W1 + 1) / 2, Y);  
                    Pnt (0, H1);

                when '2' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X, Y + H6);  
                        Pnt (W6, -H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (-W6, H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H1 - 5 * H6 - H6r);  
                        Pnt (0, H6);  
                        Pnt (W1, 0);  
                    end;

                when '3' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X, Y + H6);  
                        Pnt (W6, -H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (-W6, H6);  
                        Pnt (-W46 / 2, 0);  
                        Pnt (W46 / 2, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H1 - 5 * H6 - H6r);  
                        Pnt (-W6, H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, -H6);  
                    end;

                when '4' =>  
                    declare  
                        W23, H23 : S_Short;  
                    begin

                        W23 := W1 * 2 / 3;  
                        H23 := H1 * 2 / 3;

                        Pnt (X + W1, Y + H23);  
                        Pnt (-W1, 0);  
                        Pnt (W23, -H23);  
                        Pnt (0, H1);  
                    end;

                when '5' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X + W1, Y);  
                        Pnt (-W1, 0);  
                        Pnt (0, H1 - 3 * H6 - H6r);  
                        Pnt (W1 - W6, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (-W6, H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, -H6);  
                    end;

                when '6' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        if ((H6 - W6) rem 2) = 1 then  
                            H6 := H6 - 1;  
                        end if;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H1 - 2 * H6);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H6 - H6r);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                    end;

                when '7' =>  
                    Pnt (X, Y);  
                    Pnt (W1, 0);  
                    Pnt (-W1, H1);

                when '8' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        if ((H6 - W6) rem 2) = 1 then  
                            H6 := H6 - 1;  
                        end if;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H1 - 5 * H6 - H6r);  
                        Pnt (-W6, H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, -H6);  
                        Pnt (0, -H1 + 5 * H6 + H6r);  
                        Pnt (W6, -H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H6 - H6r);  
                    end;

                when '9' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X, Y + H1 - H6);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H1 + 2 * H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                    end;

                when 'a' | 'A' =>  
                    declare  
                        H2, W2, W5l, W5r : S_Short;  
                    begin

                        H2  := H1 * 12 / 20;  
                        W2  := (W1 + 1) / 2;  
                        W5l := W1 / 5;  
                        W5r := W1 - W5l;

                        Pnt (X, Y + H1);  
                        Pnt (W5l, -(H1 - H2));  
                        Pnt (W5r - W5l, 0);  
                        Pnt (W2 - W5r, -H2);  
                        Pnt (W5l - W2, H2);  
                        Pnt (W5r - W5l, 0);  
                        Pnt (W5l, H1 - H2);  
                    end;

                when 'b' | 'B' =>  
                    declare  
                        W6, H6 : S_Short;  
                        H2     : S_Short;  
                    begin

                        H2 := (H1 + 1) / 2;  
                        W6 := W1 / 6;  
                        H6 := H1 / 6;

                        Pnt (X, Y + H1);  
                        Pnt (0, -H1);  
                        Pnt (W1 - W6, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H2 - H6 - H6);  
                        Pnt (-W6, H6);  
                        Pnt (-(W1 - W6), 0);  
                        Pnt (W1 - W6, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H1 - H2 - H6 - H6);  
                        Pnt (-W6, H6);  
                        Pnt (-(W1 - W6), 0);  
                    end;

                when 'c' | 'C' =>  
                    declare  
                        W6, W46, H6, H46 : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H46 := H1 - H6 - H6;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H46);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                    end;

                when 'd' | 'D' =>  
                    declare  
                        W6, W56, H6, H46 : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W56 := W1 - W6;  
                        H6  := H1 / 6;  
                        H46 := H1 - H6 - H6;

                        Pnt (X, Y);  
                        Pnt (W56, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H46);  
                        Pnt (-W6, H6);  
                        Pnt (-W56, 0);  
                        Pnt (0, -H1);  
                    end;

                when 'e' | 'E' =>  
                    declare  
                        H2, W2 : S_Short;  
                    begin

                        H2 := (H1 + 1) / 2;  
                        W2 := (W1 + 1) / 2;

                        Pnt (X + W1, Y);  
                        Pnt (-W1, 0);  
                        Pnt (0, H2);  
                        Pnt (W2, 0);  
                        Pnt (-W2, 0);  
                        Pnt (0, H1 - H2);  
                        Pnt (W1, 0);  
                    end;

                when 'f' | 'F' =>  
                    declare  
                        H2, W2 : S_Short;  
                    begin

                        H2 := (H1 + 1) / 2;  
                        W2 := (W1 + 1) / 2;

                        Pnt (X + W1, Y);  
                        Pnt (-W1, 0);  
                        Pnt (0, H2);  
                        Pnt (W2, 0);  
                        Pnt (-W2, 0);  
                        Pnt (0, H1 - H2);  
                    end;

                when 'g' | 'G' =>  
                    declare  
                        W6, W46, H6, H46 : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H46 := H1 - H6 - H6;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H46);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                        Pnt (0, H6 - (H1 + 1) / 2);  
                        Pnt (-(W1 + 1) / 2, 0);  
                    end;

                when 'h' | 'H' =>  
                    declare  
                        H2 : S_Short := (H1 + 1) / 2;  
                    begin

                        Pnt (X, Y);  
                        Pnt (0, H1);  
                        Pnt (0, -H2);  
                        Pnt (W1, 0);  
                        Pnt (0, H2);  
                        Pnt (0, -H1);  
                    end;

                when 'i' | 'I' =>  
                    declare  
                        W2 : S_Short := (W1 + 1) / 2;  
                    begin

                        Pnt (X, Y);  
                        Pnt (W1, 0);  
                        Pnt (-W2, 0);  
                        Pnt (0, H1);  
                        Pnt (-W2, 0);  
                        Pnt (W1, 0);  
                    end;

                when 'k' | 'K' =>  
                    declare  
                        H2 : S_Short := (H1 + 1) / 2;  
                    begin

                        Pnt (X, Y);  
                        Pnt (0, H1);  
                        Pnt (0, -H2);  
                        Pnt (W1, -(H1 - H2));  
                        Pnt (-W1, H1 - H2);  
                        Pnt (W1, H2);  
                    end;

                when 'l' | 'L' =>  
                    Pnt (X, Y);  
                    Pnt (0, H1);  
                    Pnt (W1, 0);

                when 'm' | 'M' =>  
                    declare  
                        W2 : S_Short := (W1 + 1) / 2;  
                    begin

                        Pnt (X, Y + H1);  
                        Pnt (0, -H1);  
                        Pnt (W2, H1);  
                        Pnt (W1 - W2, -H1);  
                        Pnt (0, H1);  
                    end;

                when 'n' | 'N' =>  
                    Pnt (X, Y + H1);  
                    Pnt (0, -H1);  
                    Pnt (W1, H1);  
                    Pnt (0, -H1);

                when 'o' | 'O' =>  
                    declare  
                        W6, W46, H6, H46 : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H46 := H1 - H6 - H6;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H46);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H46);  
                    end;

                when 'p' | 'P' =>  
                    declare  
                        W6, H6 : S_Short;  
                        H2     : S_Short;  
                    begin

                        H2 := (H1 + 1) / 2;  
                        W6 := W1 / 6;  
                        H6 := H1 / 6;

                        Pnt (X, Y + H1);  
                        Pnt (0, -H1);  
                        Pnt (W1 - W6, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H2 - H6 - H6);  
                        Pnt (-W6, H6);  
                        Pnt (-(W1 - W6), 0);  
                    end;

                when 'q' | 'Q' =>  
                    declare  
                        W6, W46, H6, H46 : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H46 := H1 - H6 - H6;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H46);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (-W6 - W6, -H6);  
                        Pnt (W6 + W6, H6);  
                        Pnt (W6, H6);  
                        Pnt (-W6, -H6);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H46);  
                    end;

                when 'r' | 'R' =>  
                    declare  
                        W6, H6 : S_Short;  
                        H2     : S_Short;  
                    begin

                        H2 := (H1 + 1) / 2;  
                        W6 := W1 / 6;  
                        H6 := H1 / 6;

                        Pnt (X, Y + H1);  
                        Pnt (0, -H1);  
                        Pnt (W1 - W6, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H2 - H6 - H6);  
                        Pnt (-W6, H6);  
                        Pnt (-(W1 - W6), 0);  
                        Pnt (W1 - W6, 0);  
                        Pnt (W6, H2);  
                    end;

                when 's' | 'S' =>  
                    declare  
                        W6, W46, H6, H6r : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        W46 := W1 - W6 - W6;  
                        H6  := H1 / 6;  
                        H6r := (H1 - H6 * 6) / 2;

                        Pnt (X + W1, Y + H6);  
                        Pnt (-W6, -H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (W6, H6);  
                        Pnt (W46, 0);  
                        Pnt (W6, H6);  
                        Pnt (0, H6 + H6r);  
                        Pnt (-W6, H6);  
                        Pnt (-W46, 0);  
                        Pnt (-W6, -H6);  
                    end;

                when 't' | 'T' =>  
                    declare  
                        W2 : S_Short := (W1 + 1) / 2;  
                    begin

                        Pnt (X, Y);  
                        Pnt (W1, 0);  
                        Pnt (-W2, 0);  
                        Pnt (0, H1);  
                    end;

                when 'u' | 'U' =>  
                    declare  
                        W6, H6, H56 : S_Short;  
                    begin

                        W6  := W1 / 6;  
                        H6  := H1 / 6;  
                        H56 := H1 - H6;

                        Pnt (X, Y);  
                        Pnt (0, H56);  
                        Pnt (W6, H6);  
                        Pnt (W1 - W6 - W6, 0);  
                        Pnt (W6, -H6);  
                        Pnt (0, -H56);  
                    end;

                when 'v' | 'V' =>  
                    declare  
                        W2 : S_Short;  
                    begin

                        W2 := (W1 + 1) / 2;

                        Pnt (X, Y);  
                        Pnt (W2, H1);  
                        Pnt (W1 - W2, -H1);  
                    end;

                when 'w' | 'W' =>  
                    declare  
                        W4, W2 : S_Short;  
                    begin

                        W4 := W1 / 4;  
                        W2 := (W1 + 1) / 2;

                        Pnt (X, Y);  
                        Pnt (W4, H1);  
                        Pnt (W2 - W4, -H1);  
                        Pnt (W1 - W2 - W4, H1);  
                        Pnt (W4, -H1);  
                    end;

                when 'y' | 'Y' =>  
                    declare  
                        H2, W2 : S_Short;  
                    begin

                        H2 := (H1 + 1) / 2;  
                        W2 := (W1 + 1) / 2;

                        Pnt (X, Y);  
                        Pnt (W2, H2);  
                        Pnt (W1 - W2, -H2);  
                        Pnt (-(W1 - W2), H2);  
                        Pnt (-W2, H1 - H2);  
                    end;

----Letters we don't have, and also blank.

                when others =>  
                    null; -- do nothing
            end case;

----Draw the letter.

            if Pnti > 0 then  
                X_Draw_Lines (Dpy, Main.Board.Drawable, Normal_Gc,  
                              Pnts (0 .. Pnti - 1), Coord_Mode_Previous);  
            end if;  
            X := X + Letter_Width + 2;  
        end loop;

    end Draw_Text;

--\f

    procedure Draw_Score (Score : S_Long;  
                          Px    : S_Short;  
                          Py    : S_Short) is
------------------------------------------------------------------------------
-- Called to draw the score at x/y.
------------------------------------------------------------------------------
        X         : S_Short := Px;  
        Y         : S_Short := Py;  
        Scr       : X_String (1 .. 4);  
        W         : S_Short := (Letter_Width + 2) * 3 + 4;  
        H         : S_Short := Letter_Height + 6;  
        I, Lx, Ly : S_Short;  
    begin

        if Score = 0 then  
            Letter_Height := Letter_Height * 3;  
            Letter_Width  := Letter_Width * 3;  
            Lx            := Board_Width / 6;  
            Ly            := Board_Height / 2 - 2 * Letter_Height;  
            for I in reverse 1 .. 5 loop  
                Draw_Text ("You Win", Lx, Ly);  
                Lx := Lx + 2 * Letter_Width + 2;  
                Ly := Ly + Letter_Height + 5;  
            end loop;  
            Letter_Height := Letter_Height / 3;  
            Letter_Width  := Letter_Width / 3;  
        end if;

        Y := Y - H + 2;  
        X_Fill_Rectangle (Dpy, Main.Board.Drawable, Reverse_Gc,  
                          X, Y, U_Short (W), U_Short (H));  
        X_Draw_Rectangle (Dpy, Main.Board.Drawable, Normal_Gc, X - 2,  
                          Y - 2, U_Short (W + 4), U_Short (H + 4));  
        X_Draw_Rectangle (Dpy, Main.Board.Drawable, Normal_Gc, X - 1,  
                          Y - 1, U_Short (W + 2), U_Short (H + 2));  
        X_Draw_Rectangle (Dpy, Main.Board.Drawable, Normal_Gc,  
                          X, Y, U_Short (W), U_Short (H));  
        if Score > 99 then  
            Scr (1) := X_Character'Val (X_Character'Pos ('0') + Score / 100);  
        else  
            Scr (1) := ' ';  
        end if;  
        if Score > 9 then  
            Scr (2) := X_Character'Val  
                          (X_Character'Pos ('0') + Score / 10 rem 10);  
        else  
            Scr (2) := ' ';  
        end if;  
        Scr (3) := X_Character'Val (X_Character'Pos ('0') + Score rem 10);  
        Scr (4) := X_Character'Val (8#000#);  
        Draw_Text (Scr, X + 3, Y + 3);

    end Draw_Score;

--\f

    procedure Hilite (But : Button) is
------------------------------------------------------------------------------
-- Xor the hilite pattern on the button indicated.
------------------------------------------------------------------------------
    begin

        X_Fill_Rectangle (Dpy, Main.Board.Drawable, Xor_Gc, But.X + 1,  
                          But.Y + 1, U_Short (Button_Width - 1),  
                          U_Short (Button_Height - 1));

    end Hilite;

--\f

    procedure Button_Expose is
------------------------------------------------------------------------------
-- Called when the Board receives an Expose event.
------------------------------------------------------------------------------
    begin

----Loop over all buttons and display all "real" buttons.

        for I in All_Buttons_Array (All_Buttons)'Range loop  
            if All_Buttons_Array (All_Buttons) (I).Text.all = "" then  
                goto Continue;  
            end if;

----Clear the space for the button and then draw the outline.

            X_Fill_Rectangle (Dpy, Main.Board.Drawable, Reverse_Gc,  
                              All_Buttons_Array (All_Buttons) (I).X,  
                              All_Buttons_Array (All_Buttons) (I).Y,  
                              U_Short (Button_Width + 1),  
                              U_Short (Button_Height + 1));  
            X_Draw_Lines (Dpy, Main.Board.Drawable, Normal_Gc,  
                          All_Buttons_Array (All_Buttons) (I).Border,  
                          Coord_Mode_Previous);

----Draw the text of the button and then do hiliting if we need it.

            Draw_Text (All_Buttons_Array (All_Buttons) (I).Text.all,  
                       All_Buttons_Array (All_Buttons) (I).X +  
                          All_Buttons_Array (All_Buttons) (I).Text_X,  
                       All_Buttons_Array (All_Buttons) (I).Y +  
                          All_Buttons_Array (All_Buttons) (I).Text_Y);  
            if All_Buttons_Array (All_Buttons) (I).Hilite then  
                Hilite (All_Buttons_Array (All_Buttons) (I));  
            end if;  
            <<Continue>> null;  
        end loop;

    end Button_Expose;

--\f

    procedure De_Hilite_All is
------------------------------------------------------------------------------
-- Called to take the hilite off of any and all buttons everywhere.
------------------------------------------------------------------------------
    begin

        for I in All_Buttons_Array (All_Buttons)'Range loop  
            if All_Buttons_Array (All_Buttons) (I).Text.all = "" then  
                goto Continue;  
            end if;  
            if All_Buttons_Array (All_Buttons) (I).Hilite and then  
               not All_Buttons_Array (All_Buttons) (I).Toggle then  
                All_Buttons_Array (All_Buttons) (I).Hilite := False;  
                Hilite (All_Buttons_Array (All_Buttons) (I));  
                X_Flush (Dpy);  
            end if;  
            <<Continue>> null;  
        end loop;

    end De_Hilite_All;

--\f

    procedure Button_Press (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when the Board receives a BtnDown event.
------------------------------------------------------------------------------
    begin

----First we make sure that nobody is hilited.

        De_Hilite_All;

----See if some button just got clicked.

        for I in All_Buttons_Array (All_Buttons)'Range loop  
            if All_Buttons_Array (All_Buttons) (I).Text.all = "" then  
                goto Continue;  
            end if;  
            if Event.Button.X >= All_Buttons_Array (All_Buttons) (I).X and then  
               Event.Button.X <= All_Buttons_Array (All_Buttons) (I).X +  
                                    Button_Width and then  
               Event.Button.Y >= All_Buttons_Array (All_Buttons) (I).Y and then  
               Event.Button.Y <= All_Buttons_Array (All_Buttons) (I).Y +  
                                    Button_Height then

----Hilite this button and then do whatever it is supposed to do.

                All_Buttons_Array (All_Buttons) (I).Hilite :=  
                   not All_Buttons_Array (All_Buttons) (I).Hilite;  
                Hilite (All_Buttons_Array (All_Buttons) (I));  
                X_Flush (Dpy);  
                Call (All_Buttons_Array (All_Buttons) (I).Action, Event);  
                exit;  
            end if;  
            <<Continue>> null;  
        end loop;

    end Button_Press;

--\f

    procedure Button_Release (Event : X_Button_Release_Event) is
------------------------------------------------------------------------------
-- Called when the Board receives a BtnUp event.
------------------------------------------------------------------------------
    begin

----Turn off any and all button hilites.

        De_Hilite_All;

    end Button_Release;

--\f

end Button;