DataMuseum.dk

top - metrics - download

    Length: 6751 (0x1a5f)
    Types: TextFile
    Names: »B«

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

TextFile

with Test_Io;
use Test_Io;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Font;
use Xlbt_Font;
with Xlbt_Gc;
use Xlbt_Gc;
with Xlbt_Graphics;  
use Xlbt_Graphics;  
with Xlbt_Hint;  
use Xlbt_Hint;  
with Xlbt_Pointer;
use Xlbt_Pointer;
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_Font;
use Xlbp_Font;
with Xlbp_Gc;
use Xlbp_Gc;
with Xlbp_Graphics;  
use Xlbp_Graphics;  
with Xlbp_Hint;  
use Xlbp_Hint;  
with Xlbp_Text;
use Xlbp_Text;
with Xlbp_Window;
use Xlbp_Window;

procedure Gr_State_Test 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;
    Gc         : X_Gc;
    Font       : X_Font_Struct;
    State      : Natural                 := 1;

    Width  : constant := 300;
    Height : constant := 300;

    function Redraw return Boolean is
------------------------------------------------------------------------------
-- Clear the window, draw our current state number, do the graphics.  If
-- the graphics returns with State=0 then we are done and we exit.
------------------------------------------------------------------------------
    begin

        X_Clear_Window (Dpy, Window);
        X_Draw_String (Dpy, Window.Drawable, Gc,  
                       4, 4 + Font.Max_Bounds.Ascent,  
                       "State" & To_X_String (Natural'Image (State)) &
                          " - Click button 1");
        Do_Graphics (Dpy    => Dpy,  
                     State  => State,  
                     Window => Window,
                     Gc     => Gc,  
                     Font   => Font,  
                     Width  => Width,  
                     Height => Height);
        return State = 0;

    end Redraw;

begin

----Open the display connection.  Use the Environment DISPLAY variable.

    X_Open_Display (X_Display_Name (""), Dpy, Error);  
    if Dpy = null then  
        Put_Line (To_String (Err (Error)));  
        raise Program_Error;  
    end if;

----Set up the Hints for our window.  We demand a certain size.

    Screen := X_Default_Screen (Dpy);

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

    Size_Hints.X := S_Long (X_Display_Width (Dpy, Screen) / 2 - Width / 2);
    Size_Hints.Y := S_Long (X_Display_Height (Dpy, Screen) / 2 - Height / 2);

----Set up our window attributes.  We want Button and Exposure events.

    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;

----Create the window, set the properties.

    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);

----Set up a graphics context:

    Gc := X_Create_Gc (Dpy, Window.Drawable, None_X_Gc_Components,  
                       None_X_Gc_Values);  
    X_Set_Foreground (Dpy, Gc, X_White_Pixel (Dpy, Screen) xor  
                                  X_Black_Pixel (Dpy, Screen));  
    X_Set_Function (Dpy, Gc, Gx_Xor);

----Get the font that we need.

    Font := X_Load_Query_Font (Dpy, "fixed");  
    if Font = None_X_Font_Struct then  
        Put_Line ("Could not open font 'fixed'?");  
        raise Program_Error;  
    end if;

----Map the window and then loop handling events.

    X_Map_Window (Dpy, Window);

    Put_Line ("State is now 1");
    loop

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

----Button2 says go away.  Any other button says change state.

            when Button_Press =>  
                if Event.Kind = Button_Press and then  
                   Event.Button.Button = Button_2 then  
                    exit;  
                end if;  
                State := State + 1;
                Put ("State is now ");
                Put (State);
                New_Line;
                if Redraw then
                    exit;
                end if;

----These things cause us to redraw according to the current state.

            when Expose | Visibility_Notify =>  
                if Redraw then
                    exit;
                end if;

----Others are ignored.


            when others =>  
                null;

        end case;  
    end loop;
    X_Close_Display (Dpy);

end Gr_State_Test;