|
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: 9284 (0x2444)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦306851c02⟧
└─⟦this⟧
separate (Puz_Main)
procedure Setup (Display : X_String; Geometry : X_String) is
Arrow_Cross_Cursor : X_Cursor;
Min_Width : S_Long;
Min_Height : S_Long;
Visual : X_Visual;
Xgcv : X_Gc_Values;
Size_Hints : X_Size_Hints;
Success : X_Status;
begin
-- /*******************************************/
-- /** let the puzzle code initialize itself **/
-- /*******************************************/
Initialize;
Output_Logging := True;
Fg_Pixel := X_Black_Pixel (Dpy, Screen);
Bg_Pixel := X_White_Pixel (Dpy, Screen);
Title_Win_Height := Title_Window_Height;
Boundary_Height := C_Boundary_Height;
Min_Width := Min_Tile_Width * Puzzle_Width;
Min_Height := Min_Tile_Height * Puzzle_Height +
Title_Window_Height + C_Boundary_Height;
-- /*************************************/
-- /** configure the window size hints **/
-- /*************************************/
declare
X : S_Long;
Y : S_Long;
Width : S_Long;
Height : S_Long;
Tile_Height : S_Long;
Tile_Width : S_Long;
Flags : X_Parse_Geometry_Flags;
begin
Size_Hints.Flags :=
X_Size_Hints_Flags'
(P_Min_Size | P_Position | P_Size | P_Resize_Inc => True,
others => False);
Size_Hints.Min_Width := S_Long (Min_Width);
Size_Hints.Min_Height := S_Long (Min_Height);
Size_Hints.Width := S_Long (Min_Width);
Size_Hints.Height := S_Long (Min_Height);
Size_Hints.X := 100;
Size_Hints.Y := 300;
Size_Hints.Width_Inc := S_Long (Puzzle_Width);
Size_Hints.Height_Inc := S_Long (Puzzle_Height);
if Geometry /= "" then
declare
Xx, Yy : S_Short := 0;
Ww, Hh : U_Short := 0;
begin
X_Parse_Geometry (Geometry, Xx, Yy, Ww, Hh, Flags);
X := S_Long (Xx);
Y := S_Long (Yy);
Width := S_Long (Ww);
Height := S_Long (Hh);
end;
if Flags (Width_Value) then
Size_Hints.Flags (U_S_Size) := True;
if S_Long (Width) > Size_Hints.Min_Width then
Size_Hints.Width := S_Long (Width);
end if;
end if;
if Flags (Height_Value) then
Size_Hints.Flags (U_S_Size) := True;
if S_Long (Height) > Size_Hints.Min_Height then
Size_Hints.Height := S_Long (Height);
end if;
end if;
if Flags (X_Value) then
if Flags (X_Negative) then
X := S_Long (X_Display_Width
(Dpy, X_Default_Screen (Dpy))) +
X - S_Long (Size_Hints.Width);
end if;
Size_Hints.Flags (U_S_Position) := True;
Size_Hints.X := S_Long (X);
end if;
if Flags (Y_Value) then
if Flags (Y_Negative) then
Y := S_Long (X_Display_Height
(Dpy, X_Default_Screen (Dpy))) +
Y - S_Long (Size_Hints.Height);
end if;
Size_Hints.Flags (U_S_Position) := True;
Size_Hints.Y := S_Long (Y);
end if;
Tile_Height := (S_Long (Size_Hints.Height) -
Title_Win_Height - Boundary_Height) / Puzzle_Height;
Size_Hints.Height := S_Long (Tile_Height * Puzzle_Height +
Title_Win_Height + Boundary_Height);
Tile_Width := S_Long (Size_Hints.Width) / Puzzle_Width;
Size_Hints.Width := S_Long (Tile_Width * Puzzle_Width);
end if;
end;
-- /*******************************************************************/
-- /** create the puzzle main window and set its standard properties **/
-- /*******************************************************************/
Visual := Copy_From_Parent_Visual;
if not Geb_Server_Bug then
Puzzle_Root := X_Create_Simple_Window
(Dpy, X_Root_Window (Dpy, Screen),
S_Short (Size_Hints.X), S_Short (Size_Hints.Y),
U_Short (Size_Hints.Width),
U_Short (Size_Hints.Height),
Puzzle_Border_Width, Fg_Pixel, Fg_Pixel);
else
declare
Xswa : X_Set_Window_Attributes;
begin
Xswa.Background_Pixel := Fg_Pixel;
Xswa.Border_Pixel := Fg_Pixel;
Xswa.Event_Mask :=
X_Event_Mask'(Exposure_Mask | Visibility_Change_Mask => True,
others => False);
Puzzle_Root :=
X_Create_Window
(Dpy,
X_Root_Window (Dpy, Screen),
S_Short (Size_Hints.X),
S_Short (Size_Hints.Y),
U_Short (Size_Hints.Width),
U_Short (Size_Hints.Height),
Puzzle_Border_Width,
0,
Copy_From_Parent,
Copy_From_Parent_Visual,
(Cw_Back_Pixel | Cw_Border_Pixel | Cw_Event_Mask => True,
others => False),
Xswa);
end;
end if;
X_Set_Wm_Properties (Dpy, Puzzle_Root, "puzzle", "Puzzle",
(1 .. 0 => None_X_String_Pointer), Size_Hints,
None_X_Wm_Hints, None_X_Class_Hint, Success);
Xgcv.Foreground := Fg_Pixel;
Xgcv.Background := Bg_Pixel;
Xgcv.Line_Width := 1;
Gc := X_Create_Gc (Dpy, Puzzle_Root.Drawable,
(Gc_Foreground | Gc_Background | Gc_Line_Width => True,
others => False), Xgcv);
-- /*********************************/
-- /** load the arrow-cross cursor **/
-- /*********************************/
declare
Ac_Mask : X_Pixmap;
Ac_Pixmap : X_Pixmap;
Ac_Cursor : X_Cursor;
Fg_Color : X_Color;
Bg_Color : X_Color;
begin
Fg_Color.Red := 0;
Fg_Color.Green := 0;
Fg_Color.Blue := 0;
Bg_Color.Red := 16#FFFF#;
Bg_Color.Green := 16#FFFF#;
Bg_Color.Blue := 16#FFFF#;
Ac_Pixmap := X_Create_Bitmap_From_Data
(Dpy, X_Root_Window (Dpy, Screen).Drawable,
Ac_Bits, Ac_Width, Ac_Height);
Ac_Mask := X_Create_Bitmap_From_Data
(Dpy, X_Root_Window (Dpy, Screen).Drawable,
Ac_Mask_Bits, Ac_Mask_Width, Ac_Mask_Height);
Ac_Cursor := X_Create_Pixmap_Cursor (Dpy, Ac_Pixmap, Ac_Mask, Fg_Color,
Bg_Color, Ac_X_Hot, Ac_Y_Hot);
if "=" (Ac_Cursor, None_X_Cursor) then
Text_Io.Put_Line ("Unable to store Arrow_Cross_Cursor.");
end if;
X_Define_Cursor (Dpy, Puzzle_Root, Ac_Cursor);
end;
-- /*****************************************/
-- /** allocate the fonts we will be using **/
-- /*****************************************/
Title_Font_Info := X_Load_Query_Font (Dpy, Title_Font_Name);
if "=" (Title_Font_Info, None_X_Font_Struct) then
Text_Io.Put_Line ("Could not open font " & To_String (Title_Font_Name) &
"; opening 'fixed' instead?");
Title_Font_Info := X_Load_Query_Font (Dpy, "fixed");
if "=" (Title_Font_Info, None_X_Font_Struct) then
Text_Io.Put_Line ("Could not open font " &
To_String (Title_Font_Name) &
" or font 'fixed'?");
raise Terminate_Program;
end if;
end if;
Tile_Font_Info := X_Load_Query_Font (Dpy, Tile_Font_Name);
if "=" (Tile_Font_Info, None_X_Font_Struct) then
Text_Io.Put_Line ("Could not open font " & To_String (Tile_Font_Name) &
"; opening 'fixed' instead?");
Tile_Font_Info := X_Load_Query_Font (Dpy, "fixed");
if "=" (Tile_Font_Info, None_X_Font_Struct) then
Text_Io.Put_Line ("Could not open font " &
To_String (Tile_Font_Name) & " or font 'fixed'?");
raise Terminate_Program;
end if;
end if;
if not Geb_Server_Bug then
X_Select_Input (Dpy, Puzzle_Root,
(Exposure_Mask | Visibility_Change_Mask => True,
others => False));
end if;
X_Map_Window (Dpy, Puzzle_Root);
end Setup;