|
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: 11156 (0x2b94)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦306851c02⟧
└─⟦this⟧
with Calendar;
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_Pointer;
use Xlbt_Pointer;
with Xlbt_String;
use Xlbt_String;
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_Property;
use Xlbp_Window_Property;
package body Mch_Main is
------------------------------------------------------------------------------
-- Originally: muncher.c
------------------------------------------------------------------------------
-- static char *rcsid = "$Header: muncher.c,v 1.5 88/02/09 13:16:48 jim Exp $";
------------------------------------------------------------------------------
-- Description:
-- The famous munching squares.
--
-- Brought to you by Jef Poskanzer.
--
-- Copyright (C) 1987 by UniSoft Systems. Permission to use, copy,
-- modify, and distribute this software and its documentation for any
-- purpose and without fee is hereby granted, provided that this copyright
-- notice appear in all copies and in all supporting documentation. No
-- representation is made about the suitability of this software for any
-- purpose. It is provided "as is" without express or implied warranty.
--
-- Arguments:
-- -r display on root window instead of creating a new one
-- -s seed use this for the seed
-- =wxh+x+y X geometry for new window (default 256x256 centered)
-- host:display X display on which to run
------------------------------------------------------------------------------
----Some good seeds - if the user does not specify one, one of these gets
-- chosen randomly.
Seeds : constant S_Long_Array := (0 => 16#00000001#,
1 => 16#00000002#,
2 => 16#00000101#,
3 => 16#00000666#,
4 => 16#11111111#,
5 => 16#12121212#,
6 => 16#12491249#,
7 => 16#22222222#,
8 => 16#33333333#,
9 => 16#00004001#,
10 => 16#04444444#,
11 => 16#12525252#,
12 => 16#15555555#,
13 => 16#00006666#,
14 => 16#00008001#,
15 => 16#00008010#,
16 => 54321);
Seedsi : S_Natural := 16;
procedure Main (Display : X_String := "";
Geometry : X_String := "";
Use_Root : Boolean := False;
Muncher_Seed : S_Long := 0;
Verbose_Mode : Boolean := False) is
Seed : S_Long := Muncher_Seed;
Win : X_Window;
Winx : S_Short;
Winy : S_Short;
Winw : U_Short;
Winh : U_Short;
Xswa : X_Set_Window_Attributes;
Dpy : X_Display;
Scr : X_Screen;
Gc : X_Gc;
Xev : X_Event;
Batch_Size : constant := 400;
Points : X_Point_Array (0 .. Batch_Size - 1);
Size : S_Long;
N : Natural;
Nmask : S_Long;
Acc : S_Long;
X : S_Short;
Y : S_Short;
Xoffset : S_Short;
Yoffset : S_Short;
Env : constant X_String :=
X_Display_Name (Display);
Error : X_Error_String;
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;
Scr := X_Default_Screen_Of_Display (Dpy);
----Set up window parameters, create and map window if necessary:
if Use_Root then
Win := X_Default_Root_Window (Dpy);
Winx := 0;
Winy := 0;
Winw := X_Display_Width (Dpy, X_Default_Screen (Dpy));
Winh := X_Display_Height (Dpy, X_Default_Screen (Dpy));
else
Winw := 256;
Winh := 256;
Winx := (S_Short (X_Width_Of_Screen (Scr)) - S_Short (Winw)) / 2;
Winy := (S_Short (X_Height_Of_Screen (Scr)) - S_Short (Winh)) / 2;
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;
Xswa.Event_Mask := X_Event_Mask'(Button_Press_Mask |
Exposure_Mask |
Structure_Notify_Mask => True,
others => False);
Xswa.Background_Pixel := X_Black_Pixel_Of_Screen (Scr);
Win := X_Create_Window
(Dpy,
X_Root_Window_Of_Screen (Scr),
Winx,
Winy,
Winw,
Winh,
0,
X_Default_Depth_Of_Screen (Scr),
Input_Output,
X_Default_Visual_Of_Screen (Scr),
(Cw_Event_Mask | Cw_Back_Pixel => True, others => False),
Xswa);
X_Set_Text_Property (Dpy, Win, "Muncher", Xa_Wm_Name);
X_Map_Window (Dpy, Win);
end if;
----Set up a graphics context:
Gc := X_Create_Gc (Dpy, Win.Drawable, None_X_Gc_Components,
None_X_Gc_Values);
X_Set_Foreground (Dpy, Gc, X_White_Pixel_Of_Screen (Scr) xor
X_Black_Pixel_Of_Screen (Scr));
X_Set_Function (Dpy, Gc, Gx_Xor);
-- X_Set_Foreground (Dpy, Gc, X_White_Pixel_Of_Screen (Scr));
-- X_Set_Function (Dpy, Gc, Gx_Invert);
-- X_Set_Function(dpy, gc, GX_copy);
----Initialize munch algorithm.
if Seed = 0 then
Seedsi := S_Long (Calendar.Seconds (Calendar.Clock)) rem
Seeds'Length;
Seed := Seeds (Seedsi);
end if;
<<New_Width_Height>> null;
if Winw > Winh then
Size := S_Long (Winw);
else
Size := S_Long (Winh);
end if;
if Size <= 0 then
Size := 1;
end if;
N := 30;
Nmask := 16#40000000#;
loop
if (Size and Nmask) /= 0 then
exit;
end if;
if N = 0 then
exit;
end if;
N := N - 1;
Nmask := Nmask / 2;
end loop;
Nmask := Shift (S_Long (1), N);
if Nmask < Size then
Nmask := Nmask * 2;
end if;
Size := Nmask;
Nmask := Nmask - 1;
Xoffset := (S_Short (Winw) - S_Short (Size)) / 2;
Yoffset := (S_Short (Winh) - S_Short (Size)) / 2;
if Verbose_Mode then
Text_Io.Put ("size := ");
S_Long_Io.Put (Size);
Text_Io.Put (", seed := ");
S_Long_Io.Put (Seed, Base => 16, Width => 0);
Text_Io.New_Line;
end if;
Acc := 0;
----Loop forever computing and drawing batches of points.
X_Clear_Window (Dpy, Win);
loop
if X_Pending (Dpy) /= 0 then
X_Next_Event (Dpy, Xev);
if Xev.Kind = Configure_Notify then
if Winw /= Xev.Configure.Width or else
Winh /= Xev.Configure.Height then
Winw := Xev.Configure.Width;
Winh := Xev.Configure.Height;
goto New_Width_Height;
end if;
elsif Xev.Kind = Expose then
while Xev.Expose.Count /= 0 loop
X_Next_Event (Dpy, Xev);
end loop;
X_Clear_Window (Dpy, Win);
elsif Xev.Kind = Button_Press then
if Xev.Button.Button = Button_2 then
exit;
elsif Xev.Button.Button = Button_3 then
Seedsi := (Seedsi + 1) rem Seeds'Length;
Seed := Seeds (Seedsi);
if Verbose_Mode then
Text_Io.Put ("size := ");
S_Long_Io.Put (Size);
Text_Io.Put (", seed := ");
S_Long_Io.Put (Seed, Base => 16, Width => 0);
Text_Io.New_Line;
end if;
X_Clear_Window (Dpy, Win);
end if;
end if;
end if;
for I in S_Natural range 0 .. Batch_Size - 1 loop
X := S_Short (Acc and Nmask);
Y := S_Short ((Shift (Acc, -Integer (N))
and Nmask)
xor S_Long (X));
Points (I).X := X + Xoffset;
Points (I).Y := Y + Yoffset;
Acc := (Acc + Seed) and 16#3FFFFFFF#;
end loop;
X_Draw_Points (Dpy, Win.Drawable, Gc, Points, Coord_Mode_Origin);
-- X_Sync (Dpy, Discard => False);
end loop;
X_Close_Display (Dpy);
end Main;
end Mch_Main;