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

⟦a15807396⟧ TextFile

    Length: 11156 (0x2b94)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

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;