|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 20630 (0x5096)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
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;