DataMuseum.dk

top - download

    Length: 4383 (0x111f)
    Types: TextFile
    Names: »B«

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

TextFile

with Text_Io;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Graphics;  
use Xlbt_Graphics;  
with Xlbt_Hint;  
use Xlbt_Hint;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_Visual;  
use Xlbt_Visual;  
with Xlbt_Window;  
use Xlbt_Window;

with Xlbp_Display;  
use Xlbp_Display;  
with Xlbp_Event;  
use Xlbp_Event;  
with Xlbp_Graphics;  
use Xlbp_Graphics;  
with Xlbp_Hint;  
use Xlbp_Hint;  
with Xlbp_Window;  
use Xlbp_Window;

procedure Hello_World (Display : String := "") is
------------------------------------------------------------------------------
-- Copyright 1990 - 1991 by Rational, Santa Clara, California.
--
--                  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 name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- 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.
------------------------------------------------------------------------------

    Dpy        : X_Display;  
    Size_Hints : X_Size_Hints;  
    Wm_Hints   : X_Wm_Hints              := None_X_Wm_Hints;  
    Class_Hint : X_Class_Hint            := None_X_Class_Hint;  
    Success    : X_Status;  
    Window     : X_Window;  
    Attr       : X_Set_Window_Attributes;  
    Mask       : X_New_Window_Attributes := None_X_New_Window_Attributes;  
    Error      : X_Error_String;  
    Screen     : X_Screen_Number;  
    Event      : X_Event;

begin

    X_Open_Display (X_Display_Name (To_X_String (Display)), Dpy, Error);  
    if Dpy = null then  
        Text_Io.Put_Line (To_String (Err (Error)));  
        raise Program_Error;  
    end if;

    Size_Hints.Flags (U_S_Position) := True;  
    Size_Hints.Flags (U_S_Size)     := True;  
    Size_Hints.Width                := 300;  
    Size_Hints.Height               := 300;  
    Size_Hints.X                    := 300;  
    Size_Hints.Y                    := 300;

    Screen := X_Default_Screen (Dpy);

    Attr.Background_Pixel  := X_White_Pixel (Dpy, Screen);  
    Mask (Cw_Back_Pixel)   := True;  
    Attr.Border_Pixel      := X_Black_Pixel (Dpy, Screen);  
    Mask (Cw_Border_Pixel) := True;

    Attr.Event_Mask      :=  
       X_Event_Mask'  
          (Button_Press_Mask | Exposure_Mask | Visibility_Change_Mask => True,  
           others => False);  
    Mask (Cw_Event_Mask) := True;

    Window := 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),  
                  4, 0, Input_Output, Copy_From_Parent_Visual, Mask, Attr);

    X_Set_Wm_Properties (Dpy, Window, "Quick Test", "", (1 .. 0 => null),  
                         Size_Hints, Wm_Hints, Class_Hint, Success);

    X_Map_Window (Dpy, Window);

    loop

        Xlbp_Event.X_Next_Event (Dpy, Event);  
        case Event.Kind is

            when Button_Press =>  
                exit;

            when Expose | Visibility_Notify =>  
                X_Draw_Lines  
                   (Dpy,  
                    Window.Drawable,  
                    X_Default_Gc (Dpy, Screen),  
                    (1 => (100, 100),  
                     2 => (100, 100),  
                     3 => (0, -100),  
                     4 => (-100, 100),  
                     5 => (150, -50),  
                     6 => (-150, -50)),  
                    Coord_Mode_Previous);

            when others =>  
                null;

        end case;  
    end loop;

end Hello_World;