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;