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

⟦253dece19⟧ TextFile

    Length: 9284 (0x2444)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

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;