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

⟦4519df3fc⟧ TextFile

    Length: 20630 (0x5096)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Geometry;  
use Xlbt_Geometry;  
with Xlbt_String;  
use Xlbt_String;

with Xlbp_Display;  
use Xlbp_Display;

package body Xlbp_Geometry is
------------------------------------------------------------------------------
-- X Library Window Geometries
--
-- Xlbp_Geometry - Used to parse string representations of window geometries
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1985 - 1989 by the Massachusetts Institute of Technology
--
--                  All Rights Reserved.
--
-- 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(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the names of MIT or Rational not be
-- used in advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- MIT and Rational disclaim all warranties with regard to this software,
-- including all implied warranties of merchantability and fitness, in no
-- event shall MIT or Rational be liable for any special, indirect or
-- consequential damages or any damages whatsoever resulting from loss of use,
-- data or profits, whether in an action of contract, negligence or other
-- tortious action, arising out of or in connection with the use or performance
-- of this software.
------------------------------------------------------------------------------

--\f

    procedure Read_Integer (Str    :     X_String;  
                            Next   : out S_Natural;  
                            Result : out S_Long) is  
        Res  : S_Long  := 0;  
        Nxt  : S_Natural;  
        Sign : Boolean := False;  
    begin

        Nxt := Str'First;  
        if Nxt <= Str'Last then  
            if Str (Nxt) = '+' then  
                Nxt := Nxt + 1;  
            elsif Str (Nxt) = '-' then  
                Sign := True;  
                Nxt  := Nxt + 1;  
            end if;  
        end if;  
        while Nxt <= Str'Last and then  
                 Str (Nxt) in '0' .. '9' loop  
            Res := (Res * 10) + (X_Character'Pos (Str (Nxt)) -  
                                 X_Character'Pos ('0'));  
            Nxt := Nxt + 1;  
        end loop;  
        if Sign then  
            Result := -Res;  
        else  
            Result := Res;  
        end if;  
        Next := Nxt;

    end Read_Integer;

--\f

    procedure X_Parse_Geometry  
                 (Geometry :        X_String;  
                  X        : in out S_Short;  
                  Y        : in out S_Short;  
                  Width    : in out U_Short;  
                  Height   : in out U_Short;  
                  Flags    : out    X_Parse_Geometry_Flags) is
------------------------------------------------------------------------------
--    X_Parse_Geometry parses strings of the form
--   "=<width>x<height>{+-}<x_offset>{+-}<y_offset>", where
--   width, height, x_offset, and y_offset are u_integers.
--   Example:  "=80x24+300-49"
--   The equal sign is optional.
--   It returns a bitmask that indicates which of the four values
--   were actually found in the str.  For each value found,
--   the corresponding argument is updated;  for each value
--   not found, the corresponding argument is left unchanged.
------------------------------------------------------------------------------
        Mask : X_Parse_Geometry_Flags := None_X_Parse_Geometry_Flags;

        Strind                  : S_Natural;  
        Q                       : S_Long;  
        Temp_Width, Temp_Height : U_Short;  
        Temp_X, Temp_Y          : S_Short;  
        Next_Character          : S_Natural;  
        Cur_Char                : S_Natural := Geometry'First;  
    begin

        Flags := None_X_Parse_Geometry_Flags;  
        if Geometry = "" or else Geometry (Geometry'First) = Nul then  
            goto All_Done;  
        end if;  
        if Geometry (Cur_Char) = '=' then  
            Cur_Char := Cur_Char + 1;
            -- ignore possible '=' at beg of geometry spec
        end if;

        Strind := Cur_Char;  
        if Geometry (Strind) /= '+' and then  
           Geometry (Strind) /= '-' and then  
           Geometry (Strind) /= 'x' and then  
           Geometry (Strind) /= 'X' then  
            Read_Integer (Geometry (Strind .. Geometry'Last),  
                          Next_Character, Q);  
            Temp_Width         := U_Short (Q);  
            Mask (Width_Value) := True;  
            if Next_Character > Geometry'Last then  
                goto All_Done;  
            end if;  
            Strind := Next_Character;  
        end if;

        if Geometry (Strind) = 'x' or else  
           Geometry (Strind) = 'X' then  
            Strind := Strind + 1;  
            Read_Integer (Geometry (Strind .. Geometry'Last),  
                          Next_Character, Q);  
            Temp_Height         := U_Short (Q);  
            Mask (Height_Value) := True;  
            if Next_Character > Geometry'Last then  
                goto All_Done;  
            end if;  
            Strind := Next_Character;  
        end if;

        if Geometry (Strind) = '+' or else Geometry (Strind) = '-' then  
            if Geometry (Strind) = '-' then  
                Strind := Strind + 1;  
                Read_Integer (Geometry (Strind .. Geometry'Last),  
                              Next_Character, Q);  
                Temp_X            := S_Short (-Q);  
                Mask (X_Negative) := True;  
                Mask (X_Value)    := True;  
                if Next_Character > Geometry'Last then  
                    goto All_Done;  
                end if;  
                Strind := Next_Character;

            else  
                Strind := Strind + 1;  
                Read_Integer (Geometry (Strind .. Geometry'Last),  
                              Next_Character, Q);  
                Temp_X         := S_Short (Q);  
                Mask (X_Value) := True;  
                if Next_Character > Geometry'Last then  
                    goto All_Done;  
                end if;  
                Strind := Next_Character;  
            end if;  
            if Geometry (Strind) = '+' or else Geometry (Strind) = '-' then  
                if Geometry (Strind) = '-' then  
                    Strind := Strind + 1;  
                    Read_Integer (Geometry (Strind .. Geometry'Last),  
                                  Next_Character, Q);  
                    Temp_Y            := S_Short (-Q);  
                    Mask (Y_Negative) := True;  
                    Mask (Y_Value)    := True;  
                    if Next_Character > Geometry'Last then  
                        goto All_Done;  
                    end if;  
                    Strind := Next_Character;

                else  
                    Strind := Strind + 1;  
                    Read_Integer (Geometry (Strind .. Geometry'Last),  
                                  Next_Character, Q);  
                    Temp_Y         := S_Short (Q);  
                    Mask (Y_Value) := True;  
                    if Next_Character > Geometry'Last then  
                        goto All_Done;  
                    end if;  
                    Strind := Next_Character;  
                end if;  
            end if;  
        end if;

        <<All_Done>> null;  
        if Mask (X_Value) then  
            X := S_Short (Temp_X);  
        end if;  
        if Mask (Y_Value) then  
            Y := S_Short (Temp_Y);  
        end if;  
        if Mask (Width_Value) then  
            Width := U_Short (Temp_Width);  
        end if;  
        if Mask (Height_Value) then  
            Height := U_Short (Temp_Height);  
        end if;  
        Flags := Mask;  
        return;

    exception  
        when Constraint_Error =>
            ----Presumably he tried to specify a much too small/large X/Y or
            --  width/height in the string; this equates to a failure of the
            --  parse.
            return;  
    end X_Parse_Geometry;

--\f

    procedure X_Geometry (Display      :     X_Display;  
                          Screen       :     X_Screen_Number;  
                          Geometry     :     X_String;  
                          Default      :     X_String;  
                          Border_Width :     U_Short;  
                          Font_Width   :     U_Short;  
                          Font_Height  :     U_Short;  
                          X_Additional :     S_Short;  
                          Y_Additional :     S_Short;  
                          X            : out S_Short;  
                          Y            : out S_Short;  
                          Width        : out U_Short;  
                          Height       : out U_Short;  
                          Flags        : out X_Parse_Geometry_Flags) is
------------------------------------------------------------------------------
-- This routine given a user supplied positional argument and a default
-- argument (fully qualified) will return the the_position the wind should take
-- returns 0 if there was some problem, else the the_position bitmask.
------------------------------------------------------------------------------

        Px : S_Short; -- returned values from parse

        Py : S_Short; -- returned values from parse

        Pwidth : U_Short; -- returned values from parse

        Pheight : U_Short; -- returned values from parse

        Dx : S_Short; -- default values from parse

        Dy : S_Short; -- default values from parse

        Dwidth : U_Short; -- default values from parse

        Dheight : U_Short; -- default values from parse

        Pmask : X_Parse_Geometry_Flags; -- values back from parse

        Dmask : X_Parse_Geometry_Flags; -- values back from parse

    begin

        X_Parse_Geometry (Geometry, Px, Py, Pwidth, Pheight, Pmask);  
        X_Parse_Geometry (Default, Dx, Dy, Dwidth, Dheight, Dmask);

        -- set default values
        if Dmask (X_Negative) then  
            X := S_Short (X_Display_Width (Display, Screen)) +  
                    Dx - S_Short (Dwidth * Font_Width) -  
                    S_Short (2 * Border_Width) - X_Additional;  
        else  
            X := Dx;  
        end if;  
        if Dmask (Y_Negative) then  
            Y := S_Short (X_Display_Height (Display, Screen)) +  
                    Dy - S_Short (Dheight * Font_Height) -  
                    S_Short (2 * Border_Width) - Y_Additional;  
        else  
            Y := Dy;  
        end if;  
        Width  := Dwidth;  
        Height := Dheight;

        if Pmask (Width_Value) then  
            Width := Pwidth;  
        end if;  
        if Pmask (Height_Value) then  
            Height := Pheight;  
        end if;

        if Pmask (X_Value) then  
            if Pmask (X_Negative) then  
                X := S_Short (X_Display_Width (Display, Screen)) +  
                        Px - S_Short (Dwidth * Font_Width) -  
                        S_Short (2 * Border_Width) - X_Additional;  
            else  
                X := Px;  
            end if;  
        end if;  
        if Pmask (Y_Value) then  
            if Pmask (Y_Negative) then  
                Y := S_Short (X_Display_Height (Display, Screen)) +  
                        Py - S_Short (Dheight * Font_Height) -  
                        S_Short (2 * Border_Width) - Y_Additional;  
            else  
                Y := Py;  
            end if;  
        end if;  
        Flags := Pmask;

    end X_Geometry;

--\f

    function Private_Geometry_Mask_To_Gravity  
                (Mask : X_Parse_Geometry_Flags) return X_Window_Gravity is  
    begin

        if Mask (X_Negative) then  
            if Mask (Y_Negative) then  
                return South_East_Gravity;  
            else  
                return North_East_Gravity;  
            end if;  
        else  
            if Mask (Y_Negative) then  
                return South_West_Gravity;  
            else  
                return North_West_Gravity;  
            end if;  
        end if;

    end Private_Geometry_Mask_To_Gravity;

--\f

    procedure X_Wm_Geometry (Display          :     X_Display;  
                             Screen           :     X_Screen_Number;  
                             User_Geometry    :     X_String;  
                             Default_Geometry :     X_String;  
                             Border_Width     :     U_Short;  
                             Hints            :     X_Size_Hints;  
                             X                : out S_Short;  
                             Y                : out S_Short;  
                             Width            : out U_Short;  
                             Height           : out U_Short;  
                             Gravity          : out X_Window_Gravity;  
                             Flags            : out X_Parse_Geometry_Flags) is
------------------------------------------------------------------------------
--  Display     - Specifies the display to use.
--  Screen      - Specifies the screen to use.
--  User_Geom   - Specifies the user-specified geometry or "".
--  Def_Geom    - Specifies the application's default geometry or "".
--  Bwidth      - Specifies the border width.
--  Hints       - Specifies the size hints for the window in the normal state.
--  X           - Receives the X offset.
--  Y           - Receives the Y offset.
--  Width       - Receives the width.
--  Height      - Receives the height.
--  Gravity     - Receives the window gravity.
--  Flags       - Receives the output flags.
--
-- Combines any geometry information specified by the user and by the
-- application with the size hints (usually the ones that were stored into
-- the application shell's Xa_Wm_Size_Hints) and returns the position, size,
-- gravity that describe the window.
--
-- If the base size is not set in the X_Size_Hints then the minimum size is
-- used if set.  Otherwise a base size of 0 is assumed.
--
-- A mask that describes which values came from the user specification and
-- whether or not the position coordinates are relative to the right and bottom
-- edges is returned.  The X/Y values returned have already been adjusted
-- to account for edge-relativity.
--
-- Note that an invalid geometry specification can cause a width or height of
-- 0 to be returned.
------------------------------------------------------------------------------
        Ux, Uy          : S_Short;  
        Uwidth, Uheight : U_Short;  
        Umask           : X_Parse_Geometry_Flags;  
        Dx, Dy          : S_Short;  
        Dwidth, Dheight : U_Short;  
        Dmask           : X_Parse_Geometry_Flags;  
        Base_Width      : U_Short;  
        Base_Height     : U_Short;  
        Min_Width       : U_Short;  
        Min_Height      : U_Short;  
        Width_Inc       : U_Short;  
        Height_Inc      : U_Short;  
        Rx, Ry          : S_Short;  
        Rwidth, Rheight : U_Short;  
        Rmask           : X_Parse_Geometry_Flags;

    begin

----Get the base sizes and increments.  Section 4.1.2.3 of the ICCCM
--  states that the base and minimum sizes are defaults for each other.
--  If neither is given, then the base sizes should be 0.  These parameters
--  control the sets of sizes that window managers should allow for the
--  window according to the following formulae:
--
--          width = base_width  + (i * width_inc)
--         height = base_height + (j * height_inc)

        if Hints.Flags (P_Base_Size) then  
            Base_Width  := U_Short (Hints.Base_Width);  
            Base_Height := U_Short (Hints.Base_Height);  
        elsif Hints.Flags (P_Min_Size) then  
            Base_Width  := U_Short (Hints.Min_Width);  
            Base_Height := U_Short (Hints.Min_Height);  
        else  
            Base_Width  := 0;  
            Base_Height := 0;  
        end if;

        if Hints.Flags (P_Min_Size) then  
            Min_Width  := U_Short (Hints.Min_Width);  
            Min_Height := U_Short (Hints.Min_Height);  
        else  
            Min_Width  := Base_Width;  
            Min_Height := Base_Height;  
        end if;

        if Hints.Flags (P_Resize_Inc) then  
            Width_Inc  := U_Short (Hints.Width_Inc);  
            Height_Inc := U_Short (Hints.Height_Inc);  
        else  
            Width_Inc  := 1;  
            Height_Inc := 1;  
        end if;

----Parse the two geometry masks.

        X_Parse_Geometry (User_Geometry, Ux, Uy, Uwidth, Uheight, Umask);  
        Rmask := Umask;  
        X_Parse_Geometry (Default_Geometry, Dx, Dy, Dwidth, Dheight, Dmask);

----Get the width and height:
--     1.  if user-specified, then take that value
--     2.  else, if program-specified, then take that value
--     3.  else, take 1
--     4.  multiply by the size increment
--     5.  and add to the base size

        if Umask (Width_Value) then  
            Rwidth := Uwidth;  
        elsif Dmask (Width_Value) then  
            Rwidth := Dwidth;  
        else  
            Rwidth := 1;  
        end if;  
        Rwidth := Rwidth * Width_Inc + Base_Width;

        if Umask (Height_Value) then  
            Rheight := Uheight;  
        elsif Dmask (Height_Value) then  
            Rheight := Dheight;  
        else  
            Rheight := 1;  
        end if;  
        Rheight := Rheight * Height_Inc + Base_Height;

----Make sure computed size is within limits.  Note that we always do the
--  lower bounds check since the base size (which defaults to 0) should
--  be used if a minimum size isn't specified.

        if Rwidth < Min_Width then  
            Rwidth := Min_Width;  
        end if;  
        if Rheight < Min_Height then  
            Rheight := Min_Height;  
        end if;

        if Hints.Flags (P_Max_Size) then  
            if Rwidth > U_Short (Hints.Max_Width) then  
                Rwidth := U_Short (Hints.Max_Width);  
            end if;  
            if Rheight > U_Short (Hints.Max_Height) then  
                Rheight := U_Short (Hints.Max_Height);  
            end if;  
        end if;

----Compute the location.  Set the negative flags in the return mask
--  (and watch out for borders), if necessary.

        if Umask (X_Value) then  
            if Umask (X_Negative) then  
                Rx := S_Short (S_Long (X_Display_Width (Display, Screen)) +  
                               S_Long (Ux) - S_Long (Rwidth) -  
                               2 * S_Long (Border_Width));  
            else  
                Rx := Ux;  
            end if;  
        elsif Dmask (X_Value) then  
            if Dmask (X_Negative) then  
                Rx := S_Short (S_Long (X_Display_Width (Display, Screen)) +  
                               S_Long (Dx) - S_Long (Rwidth) -  
                               2 * S_Long (Border_Width));  
                Rmask (X_Negative) := True;  
            else  
                Rx := Dx;  
            end if;  
        else  
            Rx := 0;                             -- gotta choose something...
        end if;

        if Umask (Y_Value) then  
            if Umask (Y_Negative) then  
                Ry := S_Short (S_Long (X_Display_Height (Display, Screen)) +  
                               S_Long (Uy) - S_Long (Rheight) -  
                               2 * S_Long (Border_Width));  
            else  
                Ry := Uy;  
            end if;  
        elsif Dmask (Y_Value) then  
            if Dmask (Y_Negative) then  
                Ry := S_Short (S_Long (X_Display_Height (Display, Screen)) +  
                               S_Long (Dy) - S_Long (Rheight) -  
                               2 * S_Long (Border_Width));  
                Rmask (Y_Negative) := True;  
            else  
                Ry := Dy;  
            end if;  
        else  
            Ry := 0;                             -- gotta choose something...
        end if;

----All finished, so set the return variables.

        X       := Rx;  
        Y       := Ry;  
        Width   := Rwidth;  
        Height  := Rheight;  
        Gravity := Private_Geometry_Mask_To_Gravity (Rmask);  
        Flags   := Rmask;

    end X_Wm_Geometry;

--\f

end Xlbp_Geometry;