|
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: 9291 (0x244b)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦306851c02⟧
└─⟦this⟧
with Text_Io;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Atom_Defs;
use Xlbt_Atom_Defs;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Event;
use Xlbt_Event;
with Xlbt_Gc;
use Xlbt_Gc;
with Xlbt_Geometry;
use Xlbt_Geometry;
with Xlbt_Graphics;
use Xlbt_Graphics;
with Xlbt_Key;
use Xlbt_Key;
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_Gc;
use Xlbp_Gc;
with Xlbp_Geometry;
use Xlbp_Geometry;
with Xlbp_Graphics;
use Xlbp_Graphics;
with Xlbp_Sync;
use Xlbp_Sync;
with Xlbp_Window;
use Xlbp_Window;
with Xlbp_Window_Information;
use Xlbp_Window_Information;
with Xlbp_Window_Property;
use Xlbp_Window_Property;
package body Pld_Main is
------------------------------------------------------------------------------
-- Originally: plaid.c - X demo program
------------------------------------------------------------------------------
-- static char *rcsid = "$Header: plaid.c,v 1.5 88/02/14 20:27:13 rws Exp $";
------------------------------------------------------------------------------
-- Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
-- and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
--
-- 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 appear in all copies and that
-- both that copyright notice and this permission notice appear in
-- supporting documentation, and that the names of Digital or MIT not be
-- used in advertising or publicity pertaining to distribution of the
-- software without specific, written prior permission.
--
-- DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
-- ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
-- DIGITAL 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
My_Win : X_Window;
Dpy : X_Display;
Num_Rects : constant := 10;
Rects : X_Rectangle_Array (0 .. Num_Rects - 1);
Gc : X_G_Context;
--\f
procedure Main (Display : X_String := "";
Geometry : X_String := "";
Use_Backing_Store : Boolean := False;
Verbose : Boolean := False) is
I : S_Natural;
J : S_Natural;
Amount : S_Natural;
Winx : S_Short;
Winy : S_Short;
Winw : U_Short;
Winh : U_Short;
Xdir : S_Short;
Ydir : S_Short;
Xoff : S_Short;
Yoff : S_Short;
Centerx : S_Short;
Centery : S_Short;
Xgcv : X_Gc_Values;
Gc : X_Gc;
Xswa : X_Set_Window_Attributes;
Pe : X_Event;
Root : X_Window;
X : S_Short;
Y : S_Short;
W : U_Short;
H : U_Short;
Error : X_Error_String;
Env : constant X_String :=
X_Display_Name (Display);
begin
X_Open_Display (Env, Dpy, Error);
if "=" (Dpy, None_X_Display) then
Text_Io.Put_Line ("Cannot open display: " &
To_String (Err (Error)));
raise Program_Error;
end if;
Winx := 0;
Winy := 0;
Winw := 501;
Winh := 303;
if Geometry /= "" then
declare
Flags : X_Parse_Geometry_Flags;
begin
X_Parse_Geometry (Geometry, Winx, Winy, Winw, Winh, Flags);
if Flags (X_Negative) then
Winx :=
S_Short (X_Display_Width (Dpy, X_Default_Screen (Dpy))) -
Winx - S_Short (Winw);
end if;
if Flags (Y_Negative) then
Winy :=
S_Short
(X_Display_Height (Dpy, X_Default_Screen (Dpy))) -
Winy - S_Short (Winh);
end if;
end;
end if;
if Use_Backing_Store then
Xswa.Backing_Store := Not_Useful;
else
Xswa.Backing_Store := Always;
end if;
Xswa.Event_Mask :=
X_Event_Mask'
(Button_Press_Mask | Exposure_Mask | Structure_Notify_Mask =>
True,
others => False);
Xswa.Background_Pixel := X_Black_Pixel (Dpy, X_Default_Screen (Dpy));
Xswa.Border_Pixel := X_White_Pixel (Dpy, X_Default_Screen (Dpy));
My_Win :=
X_Create_Window (Dpy,
X_Root_Window (Dpy, X_Default_Screen (Dpy)),
Winx,
Winy,
Winw,
Winh,
1,
X_Default_Depth (Dpy, X_Default_Screen (Dpy)),
Input_Output,
Copy_From_Parent_Visual,
(Cw_Event_Mask | Cw_Backing_Store |
Cw_Border_Pixel | Cw_Back_Pixel => True,
others => False),
Xswa);
X_Set_Text_Property (Dpy, My_Win, "Plaid", Xa_Wm_Name);
X_Map_Window (Dpy, My_Win);
Xgcv.Funct := Gx_Invert;
Xgcv.Plane_Mask := X_Plane_Mask
("xor" (X_Black_Pixel
(Dpy, X_Default_Screen (Dpy)),
X_White_Pixel (Dpy,
X_Default_Screen (Dpy))));
Xgcv.Fill_Style := Fill_Solid;
Gc := X_Create_Gc (Dpy,
My_Win.Drawable,
(Gc_Function | Gc_Plane_Mask | Gc_Fill_Style => True,
others => False),
Xgcv);
J := 0;
loop
X_Next_Event (Dpy, Pe);-- this should get first exposure event
if Pe.Kind = Expose then
while Pe.Expose.Count /= 0 loop
X_Next_Event (Dpy, Pe);
end loop;
elsif Pe.Kind = Configure_Notify then
Winx := Pe.Configure.X;
Winy := Pe.Configure.Y;
Winw := Pe.Configure.Width;
Winh := Pe.Configure.Height;
elsif Pe.Kind = Map_Notify or else
Pe.Kind = Reparent_Notify then
null;
elsif Pe.Kind = Button_Press then
if Pe.Button.Button = Button_2 then
exit;
end if;
else
Text_Io.Put_Line ("Unexpected event type: " &
X_Event_Code'Image (Pe.Kind));
end if;
if Verbose then
Text_Io.Put_Line ("PLAID: Dealing with exposures");
end if;
X_Clear_Area (Dpy, My_Win, 0, 0, Winw, Winh, False);
if Verbose then
Text_Io.Put_Line ("PLAID: drawing rects");
end if;
Centerx := S_Short (Winw / 2);
Centery := S_Short (Winh / 2);
Xdir := -1;
Ydir := -2;
Xoff := 2;
Yoff := 2;
I := 0;
while X_Pending (Dpy) = 0 loop
Rects (I).X := Centerx - Xoff;
Rects (I).Y := Centery - Yoff;
Rects (I).Width := 2 * U_Short (Xoff);
Rects (I).Height := 2 * U_Short (Yoff);
Xoff := Xoff + Xdir;
Yoff := Yoff + Ydir;
if Xoff <= 0 or else Xoff >= Centerx then
Xoff := Xoff - 2 * Xdir;
Xdir := -Xdir;
end if;
if Yoff <= 0 or else Yoff >= Centery then
Yoff := Yoff - 2 * Ydir;
Ydir := -Ydir;
end if;
if I = Num_Rects - 1 then
X_Fill_Rectangles (Dpy, My_Win.Drawable, Gc, Rects);
X_Flush (Dpy);
I := 0;
else
I := I + 1;
end if;
end loop;
end loop;
end Main;
end Pld_Main;