DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

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

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦7c66d5f0e⟧ Ada Source

    Length: 45056 (0xb000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Worm_Main, seg_0053a3

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Calendar;  
with Text_Io;  
with Unchecked_Deallocation;

with Ran1_Package;  
use Ran1_Package;  
with Trig;  
use Trig;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Color;  
use Xlbt_Color;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Event2;  
use Xlbt_Event2;  
with Xlbt_Hint;  
use Xlbt_Hint;  
with Xlbt_Gc;  
use Xlbt_Gc;  
with Xlbt_Geometry;  
use Xlbt_Geometry;  
with Xlbt_Misc;  
use Xlbt_Misc;  
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_Atom;  
use Xlbp_Atom;  
with Xlbp_Color;  
use Xlbp_Color;  
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_Hint;  se Xlbp_Hint;  
with Xlbp_Key;  
use Xlbp_Key;  
with Xlbp_Sync;  
use Xlbp_Sync;  
with Xlbp_Visual;  
use Xlbp_Visual;  
with Xlbp_Window;  
use Xlbp_Window;

with Xlbmp_Environment;  
use Xlbmp_Environment;

package body Worm_Main is
--
-- worm.c: draw wiggly worms.
--
-- Adapted from a concept in the Dec 87 issue of Scientific American.
-- Makes a nice lockscreen via "lockscreen nice worm".
--
-- compile: cc worm.c -o worm -lm -lsuntool -lsunwindow -lpixrect
--
-- usage: worm [-l length] [-s size] [-n number]
--      where "length" is length of each worm in segments (default 50)
--            "size" is size of each segment (default 2)
--            "number" is number of worms to draw (default 64)
--
-- This program looks best on a color monitor. Try these options:
-- worm -n 1       Just one really fast worm
-- worm -l 2       Paramecia
-- worm -s 500     Mondrian painting (actually enormous worms)
-- worm -l -1      Jackson Pollack painting (actually infinite length worms)
--
-- -- Thu Dec 17 09:58:48 PST 1987
-- -- Brad Taylor (brad@sun)


--
-- hacked to use X11 by Dave Lemke (lemke@sun.com)
-- Wed Dec 23 09:57:32 PST 1987
--
-- additional options:
--      -S -R -C [-g geometry] [-d display]
--
--      -S      screen saver mode - covers screen
--      -R      rotate colormap while running
--      -C      chromocolor worms - colors change as they crawl


-- ***********************************************************
-- Copyright 1988 by Sun Microsystems, Inc. Mountain View, CA.
--
-- 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 Sun or MIT not be
-- used in advertising or publicity pertaining to distribution of the
-- software without specific prior written permission. Sun and M.I.T.
-- make no representations about the suitability of this software for
-- any purpose. It is provided "as is" without any express or implied warranty.
--
-- SUN DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
-- ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-- PURPOSE. IN NO EVENT SHALL SUN 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.
-- **********************************************************

    Num_Colors : constant := 256;  
    Min_Colors : constant := 16;  
    Segments   : constant := 36;  
    Pi         : constant := 3.14159265358979323844;

    Ran_Data : Ran1_Data;

    type Worm_Stuff_Rec is  
        record  
            X_Circ : S_Long_List;  
            Y_Circ : S_Long_List;  
            Dir    : S_Long;  
            Tail   : S_Long;  
            X      : S_Long;  
            Y      : S_Long;  
        end record;

    type Worm_Stuff       is access Worm_Stuff_Rec;  
    type Worm_Stuff_Array is array (S_Natural range <>) of Worm_Stuff;  
    type Worm_Stuff_List  is access Worm_Stuff_Array;

    procedure Free_Worm_Stuff is new Unchecked_Deallocation (Worm_Stuff_Rec,  
                                                             Worm_Stuff);

    function Worm_Init (Xsize       : S_Long;  
                        Ysize       : S_Long;  
                        Worm_Length : S_Long) return Worm_Stuff;

    Worm_Length : S_Long := 50;  
    Circ_Size   : S_Long := 2;  
    Nworms      : S_Long := 64;

    Sin_Tab : S_Long_Array (0 .. Segments - 1);  
    Cos_Tab : S_Long_Array (0 .. Segments - 1);  
    Ncolors : S_Long;

    Xwmh : X_Wm_Hints := ((Input_Hint | State_Hint => True, others => False),  
                          True, Normal_State, None_X_Pixmap, None_X_Window,  
                          0, 0, None_X_Pixmap, None_X_Window);

    Dpy          : X_Display;  
    W            : X_Window;  
    Screen       : X_Screen_Number;  
    Gc           : X_Gc;  
    Wgc          : X_Gc;  
    Cmap         : X_Colormap;  
    Is_Color     : Boolean := True;  
    Is_Dynamic   : Boolean := False;  
    Screen_Saver : Boolean := False;  
    Rotate       : Boolean := False;  
    Chromo_Color : Boolean := False;  
    Colors       : X_Color_Array (0 .. Num_Colors - 1);  
    Worm         : Worm_Stuff_List;

    Def_Geo       : constant X_String := "500x500+10+10";  
    Visual        : X_Visual;  
    Depth         : U_Char            := 1;  
    Backpixel     : X_Pixel;  
    Protocol_Atom : X_Atom;  
    Kill_Atom     : X_Atom;

--\x0c
    function Ran2 return S_Long is  
        I : S_Long;  
        F : Float;  
    begin

        F := Ran1 (Ran_Data);  
        if Float'Mantissa < 32 then  
            I := S_Long ((2.0 ** (Float'Mantissa - 1) - 1.0) * F);  
        else  
            I := S_Long (Float (S_Long'Last / 2) * F);  
        end if;  
        return I;  
        if Float'Mantissa < 32 then  
            return S_Long ((2.0 ** (Float'Mantissa - 1) - 1.0) *  
                           Ran1 (Ran_Data));  
        else  
            return S_Long (Float (S_Long'Last / 2) * Ran1 (Ran_Data));  
        end if;

    end Ran2;

--\x0c
    procedure Do_Rotate_Colors is  
        Temp : X_Pixel;  
    begin

        Temp := Colors (1).Pixel;         -- start at 1 - don't want the black
        for I in 1 .. Ncolors - 2 loop  
            Colors (I).Pixel := Colors (I + 1).Pixel;  
        end loop;  
        Colors (Ncolors - 1).Pixel := Temp;  
        X_Store_Colors (Dpy, Cmap, Colors);

    end Do_Rotate_Colors;

--\x0c
    function Worm_Init (Xsize       : S_Long;  
                        Ysize       : S_Long;  
                        Worm_Length : S_Long) return Worm_Stuff is

        Ws : Worm_Stuff := new Worm_Stuff_Rec;  
    begin

        if Worm_Length > 0 then  
            Ws.X_Circ := new S_Long_Array (0 .. Worm_Length - 1);  
            Ws.Y_Circ := new S_Long_Array (0 .. Worm_Length - 1);  
            for I in Ws.X_Circ'Range loop  
                Ws.X_Circ (I) := Xsize / 2;  
                Ws.Y_Circ (I) := Ysize / 2;  
            end loop;  
        end if;  
        Ws.Dir  := Ran2 rem Segments;  
        Ws.Tail := 0;  
        Ws.X    := Xsize / 2;  
        Ws.Y    := Ysize / 2;  
        return Ws;

    end Worm_Init;

--\x0c
    procedure Draw_Seg (X : S_Long;  
                        Y : S_Long;  
                        C : X_Pixel) is  
    begin

        X_Set_Foreground (Dpy, Gc, C);  
        X_Fill_Rectangle (Dpy, W.Drawable, Gc, S_Short (X), S_Short (Y),  
                          U_Short (Circ_Size), U_Short (Circ_Size));

    end Draw_Seg;

--\x0c
    procedure Worm_Doit (Ws    : Worm_Stuff;  
                         Xsize : S_Long;  
                         Ysize : S_Long;  
                         Color : X_Pixel) is

        X : S_Long;  
        Y : S_Long;  
    begin

        if Worm_Length > 0 then  
            Ws.Tail := (Ws.Tail + 1) rem Worm_Length;  
            X       := Ws.X_Circ (Ws.Tail);  
            Y       := Ws.Y_Circ (Ws.Tail);  
            X_Clear_Area (Dpy, W, S_Short (X), S_Short (Y),  
                          U_Short (Circ_Size), U_Short (Circ_Size), False);  
        end if;  
        if Ran2 rem 2 /= 0 then  
            Ws.Dir := (Ws.Dir + 1) rem Segments;  
        else  
            Ws.Dir := (Ws.Dir + Segments - 1) rem Segments;  
        end if;  
        X := (Ws.X + Cos_Tab (Ws.Dir) + Xsize) rem Xsize;  
        Y := (Ws.Y + Sin_Tab (Ws.Dir) + Ysize) rem Ysize;  
        if Worm_Length > 0 then  
            Ws.X_Circ (Ws.Tail) := X;  
            Ws.Y_Circ (Ws.Tail) := Y;  
        end if;  
        if Is_Color then  
            Draw_Seg (X, Y, Color);  
        else  
            X_Fill_Rectangle (Dpy, W.Drawable, Wgc, S_Short (X), S_Short (Y),  
                              U_Short (Circ_Size), U_Short (Circ_Size));  
        end if;  
        Ws.X := X;  
        Ws.Y := Y;

    end Worm_Doit;

--\x0c
    function Floor (X : Float) return S_Long is  
        I : S_Long := S_Long (X);  
    begin  
        if Float (I) > X then  
            return I - 1;  
        else  
            return I;  
        end if;  
    end Floor;

--\x0c
    procedure Hsb2_Rgb (Hp :        Float;  
                        S  :        Float;  
                        I  :        Float;  
                        R  : in out Float;  
                        G  : in out Float;  
                        B  : in out Float) is

        H : Float := Hp;  
        F : Float;  
        P : Float;  
        Q : Float;  
        T : Float;  
        J : S_Long;  
    begin

        if S = 0.0 then  
            R := I;  
            G := I;  
            B := I;  
        else  
            H := H - Float (Floor (H));  -- remove anything over 1
            H := H * 6.0;  
            J := Floor (H);  
            F := H - Float (J);  
            P := I * (1.0 - S);  
            Q := I * (1.0 - S * F);  
            T := I * (1.0 - (S * (1.0 - F)));

            case J is  
                when 0 =>  
                    R := I;  
                    G := T;  
                    B := P;

                when 1 =>  
                    R := Q;  
                    G := I;  
                    B := P;

                when 2 =>  
                    R := P;  
                    G := I;  
                    B := T;

                when 3 =>  
                    R := P;  
                    G := Q;  
                    B := I;

                when 4 =>  
                    R := T;  
                    G := P;  
                    B := I;

                when 5 =>  
                    R := I;  
                    G := P;  
                    B := Q;

                when others =>  
                    raise Constraint_Error;  
            end case;  
        end if;

    end Hsb2_Rgb;

--\x0c
    procedure Cmap_Init (Win : X_Window) is

        Pixels      : X_Pixel_Array (0 .. Num_Colors - 1);  
        Pmask       : X_Plane_Mask_Array (1 .. 0);  
        Vinfo       : X_Visual_Info;  
        Num_Vis     : S_Long;  
        Vmask       : S_Long;  
        Stat_Colors : X_Color_Array (0 .. Num_Colors - 1);  
        Planes      : U_Char;  
        Status      : X_Status;

        Defvalues : constant         := 256;  
        Defrandom : constant Boolean := False; -- use an random colormap - messy
        Hsb       : constant Boolean :=  
           True; -- use an HSB colormap - makes colorwheel look neat

    begin

        Planes := X_Display_Planes (Dpy, Screen);
        -- see what kind of visual we're dealing with
        X_Match_Visual_Info (Dpy, Screen, Planes, Pseudo_Color, Vinfo, Status);  
        if Status = Successful then  
            goto Read_Write_Map;  
        end if;  
        X_Match_Visual_Info (Dpy, Screen, Planes, Grayscale, Vinfo, Status);  
        if Status = Successful then  
            goto Read_Write_Map;  
        end if;  
        X_Match_Visual_Info (Dpy, Screen, Planes, Direct_Color, Vinfo, Status);  
        if Status = Successful then  
            goto Read_Write_Map;  
        else  
            goto Read_Only_Map;  
        end if;

        <<Read_Write_Map>> null;

        Visual  := Vinfo.Visual;  
        Depth   := Vinfo.Depth;  
        Cmap    := X_Create_Colormap  
                      (Dpy, X_Root_Window (Dpy, Screen), Visual, Alloc_None);  
        Ncolors := S_Long (Vinfo.Colormap_Size);
        -- grab as many color cells as we can
        for I in reverse Min_Colors .. Ncolors loop  
            X_Alloc_Color_Cells (Dpy, Cmap, False, Pmask,  
                                 Pixels (0 .. I - 1), Status);  
            if Status = Successful then  
                Ncolors := I;  
                exit;  
            end if;  
        end loop;  
        if Ncolors = Min_Colors then  
            Text_Io.Put_Line ("Couldn't allocate even" &  
                              S_Long'Image (Min_Colors) & " colors - exiting");  
            raise Program_Error;  
        end if;

        if Defrandom then
            -- make the black for background
            Backpixel        := Pixels (0);  
            Colors (0).Pixel := Pixels (0);  
            Colors (0).Red   := 0;  
            Colors (0).Green := 0;  
            Colors (0).Blue  := 0;  
            Colors (0).Flags :=  
               X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                              others                      => False);  
            for I in 1 .. Ncolors - 1 loop  
                Colors (I).Pixel := Pixels (I);  
                Colors (I).Red   := U_Short (Ran2 rem Defvalues * 2 ** 8);  
                Colors (I).Green := U_Short (Ran2 rem Defvalues * 2 ** 8);  
                Colors (I).Blue  := U_Short (Ran2 rem Defvalues * 2 ** 8);  
                Colors (I).Flags :=  
                   X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                  others                      => False);  
            end loop;  
            X_Store_Colors (Dpy, Cmap, Colors);

        elsif Hsb then
-- this colormap makes things look a lot nicer when worms goes
-- into freeze mode.

            declare  
                Hue    : Float;  
                Sat    : Float;  
                Bright : Float;  
                R      : Float;  
                G      : Float;  
                B      : Float;  
            begin

                Sat    := 0.9;  
                Bright := 1.0;

                -- make the black for background
                Backpixel        := Pixels (0);  
                Colors (0).Pixel := Pixels (0);  
                Colors (0).Red   := 0;  
                Colors (0).Green := 0;  
                Colors (0).Blue  := 0;  
                Colors (0).Flags :=  
                   X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                  others                      => False);  
                for I in 1 .. Ncolors - 1 loop  
                    Hue := Float (I) / Float (Ncolors);  
                    Hsb2_Rgb (Hue, Sat, Bright, R, G, B);  
                    Colors (I).Pixel := Pixels (I);  
                    Colors (I).Red   := U_Short (S_Long (R * 255.0) * 2 ** 8);  
                    Colors (I).Green := U_Short (S_Long (G * 255.0) * 2 ** 8);  
                    Colors (I).Blue  := U_Short (S_Long (B * 255.0) * 2 ** 8);  
                    Colors (I).Flags :=  
                       X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                      others                      => False);  
                end loop;  
                X_Store_Colors (Dpy, Cmap, Colors);  
            end;

        else  
            for I in Stat_Colors'Range loop  
                Stat_Colors (I).Pixel := X_Pixel (I);  
            end loop;  
            X_Query_Colors (Dpy, X_Default_Colormap (Dpy, Screen), Stat_Colors);  
            X_Store_Colors (Dpy, Cmap, Stat_Colors);  
            Colors := Stat_Colors;  
        end if;

        Is_Dynamic := True;

        return;

        <<Read_Only_Map>> null;

        Is_Dynamic := False;  
        Visual     := Vinfo.Visual;  
        Depth      := Vinfo.Depth;
        -- for a Static colormap, just make each worm a random pixel
        for I in Colors'Range loop  
            Colors (I).Pixel := X_Pixel (Ran2);  
        end loop;

    end Cmap_Init;

--\x0c
    procedure Main (Display       : X_String   := "";  
                    Geometry      : X_String   := "";  
                    Length        : S_Natural  := 50;  
                    Size          : S_Positive := 2;  
                    Number        : S_Positive := 64;  
                    Screen_Saver  : Boolean    := False;  
                    Rotate_Colors : Boolean    := False;  
                    Chromo_Colors : Boolean    := False) is

        Disp       : X_String_Pointer;  
        Geo        : X_String_Pointer;  
        Xsize      : S_Long            := 500;  
        Ysize      : S_Long            := 500;  
        X          : S_Long            := 0;  
        Y          : S_Long            := 0;  
        Status     : X_Status;  
        Xsh        : X_Size_Hints;  
        Xwa        : X_Window_Attributes;  
        Vmask      : X_New_Window_Attributes;  
        Values     : X_Set_Window_Attributes;  
        Freeze     : Boolean           := False;  
        Is_Visible : Boolean           := False;  
        Error      : X_Error_String;  
        Env        : constant X_String :=  
           X_Display_Name (Display);  
        E          : X_Event;  
        Wcolor     : S_Long;  
        Chromo     : S_Long            := 0;  -- chromo looks best with HSB
    begin

        Worm_Length            := Length;  
        Nworms                 := Number;  
        Circ_Size              := Size;  
        Disp                   := new X_String'(Display);  
        Geo                    := new X_String'(Geometry);  
        Worm_Main.Screen_Saver := Screen_Saver;  
        Rotate                 := Rotate_Colors;  
        Chromo_Color           := Chromo_Colors;

        for I in Sin_Tab'Range loop  
            Sin_Tab (I) := S_Long (Float (Circ_Size) *  
                                   Sin (Float (I) * 2.0 * Pi /  
                                        Float (Sin_Tab'Length)));  
            Cos_Tab (I) := S_Long (Float (Circ_Size) *  
                                   Cos (Float (I) * 2.0 * Pi /  
                                        Float (Sin_Tab'Length)));  
        end loop;  
        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;  
        Screen  := X_Default_Screen (Dpy);  
        Ncolors := Num_Colors;

        if Screen_Saver then  
            Xsize := S_Long (X_Display_Width (Dpy, Screen));  
            Ysize := S_Long (X_Display_Height (Dpy, Screen));  
            X     := 0;  
            Y     := 0;

        else  
            declare  
                Flags : X_Parse_Geometry_Flags;  
            begin  
                if Geo = null then  
                    Geo := new X_String'(Def_Geo);  
                end if;  
                X_Parse_Geometry (Geo.all, S_Short (X), S_Short (Y),  
                                  U_Short (Xsize), U_Short (Ysize), Flags);  
                if (Flags (X_Value) and then Flags (X_Negative)) then  
                    X := X + S_Long (X_Display_Width (Dpy, Screen)) - Xsize;  
                end if;  
                if Flags (Y_Value) and then Flags (Y_Negative) then  
                    Y := Y + S_Long (X_Display_Height (Dpy, Screen)) - Ysize;  
                end if;  
            end;  
        end if;

        Visual := X_Default_Visual (Dpy, Screen);  
        Depth  := X_Default_Depth (Dpy, Screen);  
        Cmap   := X_Default_Colormap (Dpy, Screen);

        -- set up the color map
        if X_Display_Cells (Dpy, Screen) > 2 then  
            Cmap_Init (W);  
        else  
            Is_Color  := False;  
            Backpixel := X_Black_Pixel (Dpy, Screen);  
        end if;

        Vmask := X_New_Window_Attributes'  
                    (Cw_Background_Pixel | Cw_Colormap => True,  
                     others => False);  
        Values.Background_Pixel := Backpixel;  
        Values.Colormap := Cmap;

        W := X_Create_Window (Dpy, X_Root_Window (Dpy, Screen), S_Short (X),  
                              S_Short (Y), U_Short (Xsize), U_Short (Ysize),  
                              0, Depth, Input_Output, Visual, Vmask, Values);

        Xsh.Flags  := X_Size_Hints_Flags'(P_Position | P_Size => True,  
                                          others              => False);  
        Xsh.X      := X;  
        Xsh.Y      := Y;  
        Xsh.Width  := Xsize;  
        Xsh.Height := Ysize;  
        X_Set_Wm_Properties (Dpy, W, "Worms", "Worms",  
                             (1 .. 0 => None_X_String_Pointer), Xsh, Xwmh,  
                             None_X_Class_Hint, Status);

        Protocol_Atom := X_Intern_Atom (Dpy, "WM_PROTOCOLS", False);  
        Kill_Atom     := X_Intern_Atom (Dpy, "WM_DELETE_WINDOW", False);  
        X_Set_Wm_Protocols (Dpy, W, (1 => Kill_Atom), Status);

        X_Map_Raised (Dpy, W);  
        X_Select_Input  
           (Dpy, W,  
            (Exposure_Mask | Structure_Notify_Mask |
-- #ifdef DUMB_WM
--             Enter_Window_Mask  or  Leave_Window_Mask  or
-- #endif
             Button_Press_Mask | Key_Press_Mask | Visibility_Change_Mask =>  
                True,  
             others => False));  
        Gc  := X_Create_Gc (Dpy, W.Drawable, None_X_Gc_Components,  
                            None_X_Gc_Values);  
        Wgc := X_Create_Gc  
                  (Dpy, W.Drawable, None_X_Gc_Components, None_X_Gc_Values);  
        X_Set_Foreground (Dpy, Wgc, X_White_Pixel (Dpy, Screen));

        Worm := new Worm_Stuff_Array (0 .. Nworms - 1);  
        for I in Worm'Range loop  
            Worm (I) := Worm_Init (Xsize, Ysize, Worm_Length);  
        end loop;

        loop

            if X_Pending (Dpy) /= 0 or else  
               Freeze or else  
               not Is_Visible then  
                X_Next_Event (Dpy, E);

                if E.Kind = Visibility_Notify then  
                    if E.Visibility.State = Visibility_Fully_Obscured then  
                        Is_Visible := False;  
                    else  
                        Is_Visible := True;  
                    end if;

                elsif E.Kind = Button_Press then  
                    if E.Button.Button = Button_2 then  
                        return;
                    end if;

                elsif E.Kind = Key_Press then  
                    if not X_Is_Modifier_Key  
                              (X_Key_Code_To_Key_Sym (Dpy,  
                                                      E.Key.Key_Code,  
                                                      0)) then  
                        Freeze := not Freeze;  
                    end if;

                elsif E.Kind = Configure_Notify then  
                    Xsize := S_Long (E.Configure.Width);  
                    Ysize := S_Long (E.Configure.Height);  
                    for I in Worm'Range loop  
                        Free_S_Long_List (Worm (I).X_Circ);  
                        Free_S_Long_List (Worm (I).Y_Circ);  
                        Free_Worm_Stuff (Worm (I));  
                        Worm (I) := Worm_Init (Xsize, Ysize, Worm_Length);  
                    end loop;  
                    X_Clear_Window (Dpy, W);
-- really want to remove all the pending graphics requests - can't figure out
-- how...
-- attempted to use GraphicsExposure, but it put so much crap into the
-- queue that the configure was never found...
                    X_Flush (Dpy);

                elsif E.Kind = Client_Message then  
                    if E.Client.Message_Type = Protocol_Atom and then  
                       X_Client_Message_S_Long (E.Client.Data, 0) =  
                          Kill_Atom.Number then  
                        return;
                    end if;

                elsif E.Kind = Enter_Notify then  
                    X_Install_Colormap (Dpy, Cmap);  
                elsif E.Kind = Leave_Notify then  
                    X_Uninstall_Colormap (Dpy, Cmap);

                    -- since visibility notify doesn't allow for
                    -- the totally obscured -> partially obscured
                    -- case, we have to depend on exposure instead.

                elsif E.Kind = Expose then  
                    Is_Visible := True;  
                end if;  
            end if;

            if Rotate and then  
               Is_Color and then  
               Is_Dynamic then  
                Do_Rotate_Colors;  
            end if;  
            for I in Worm'Range loop  
                Wcolor := (((I * Ncolors) / Nworms) + Chromo) rem Ncolors;  
                Worm_Doit (Worm (I), Xsize, Ysize, Colors (Wcolor).Pixel);  
            end loop;
            -- note that there is a little jump in the worms
            -- if they are frozen and no rotation exists.
            -- doesn't seem to be possible to (easily) get away
            -- from this
            if Chromo_Color then  
                if Chromo = S_Long'Last then  
                    Chromo := 0;  
                else  
                    Chromo := Chromo + 1;  
                end if;  
            end if;  
        end loop;

    end Main;

--\x0c
begin

    declare  
        Clk : Calendar.Day_Duration := Calendar.Seconds (Calendar.Clock);  
        I   : Natural;  
    begin  
        I   := Natural (Clk / Duration (100.0));  
        Clk := Calendar.Day_Duration  
                  (Clk - Duration (Duration (I) * Duration (100.00)));
        ----Clk is now in the 0..99.9999 range.
        Ran_Data := Ran1_Initialize (S_Natural  
                                        (Clk * Duration (Natural'Last / 101)));  
    end;

end Worm_Main;  

E3 Meta Data

    nblk1=2b
    nid=2a
    hdr6=54
        [0x00] rec0=35 rec1=00 rec2=01 rec3=002
        [0x01] rec0=1f rec1=00 rec2=02 rec3=04e
        [0x02] rec0=1c rec1=00 rec2=03 rec3=036
        [0x03] rec0=13 rec1=00 rec2=04 rec3=022
        [0x04] rec0=1c rec1=00 rec2=2b rec3=050
        [0x05] rec0=03 rec1=00 rec2=05 rec3=002
        [0x06] rec0=1a rec1=00 rec2=06 rec3=046
        [0x07] rec0=06 rec1=00 rec2=29 rec3=026
        [0x08] rec0=1f rec1=00 rec2=07 rec3=054
        [0x09] rec0=1e rec1=00 rec2=08 rec3=074
        [0x0a] rec0=00 rec1=00 rec2=28 rec3=00e
        [0x0b] rec0=1d rec1=00 rec2=09 rec3=02e
        [0x0c] rec0=00 rec1=00 rec2=27 rec3=018
        [0x0d] rec0=23 rec1=00 rec2=0a rec3=016
        [0x0e] rec0=26 rec1=00 rec2=0b rec3=010
        [0x0f] rec0=21 rec1=00 rec2=0c rec3=04a
        [0x10] rec0=01 rec1=00 rec2=26 rec3=058
        [0x11] rec0=1b rec1=00 rec2=0d rec3=048
        [0x12] rec0=18 rec1=00 rec2=23 rec3=066
        [0x13] rec0=00 rec1=00 rec2=0e rec3=022
        [0x14] rec0=17 rec1=00 rec2=0f rec3=022
        [0x15] rec0=01 rec1=00 rec2=25 rec3=00a
        [0x16] rec0=14 rec1=00 rec2=10 rec3=072
        [0x17] rec0=00 rec1=00 rec2=24 rec3=020
        [0x18] rec0=1c rec1=00 rec2=11 rec3=042
        [0x19] rec0=00 rec1=00 rec2=22 rec3=012
        [0x1a] rec0=19 rec1=00 rec2=12 rec3=02c
        [0x1b] rec0=01 rec1=00 rec2=1e rec3=020
        [0x1c] rec0=16 rec1=00 rec2=21 rec3=06a
        [0x1d] rec0=02 rec1=00 rec2=13 rec3=070
        [0x1e] rec0=1a rec1=00 rec2=20 rec3=03e
        [0x1f] rec0=01 rec1=00 rec2=14 rec3=07c
        [0x20] rec0=1b rec1=00 rec2=1f rec3=018
        [0x21] rec0=00 rec1=00 rec2=15 rec3=00a
        [0x22] rec0=15 rec1=00 rec2=16 rec3=012
        [0x23] rec0=00 rec1=00 rec2=1d rec3=022
        [0x24] rec0=1a rec1=00 rec2=17 rec3=02c
        [0x25] rec0=00 rec1=00 rec2=1c rec3=004
        [0x26] rec0=17 rec1=00 rec2=18 rec3=012
        [0x27] rec0=14 rec1=00 rec2=19 rec3=06a
        [0x28] rec0=18 rec1=00 rec2=1a rec3=04c
        [0x29] rec0=1d rec1=00 rec2=1b rec3=000
        [0x2a] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21500a0aa8197897708e3 0x42a00088462063203
Free Block Chain:
  0x2a: 0000  00 00 00 11 80 07 53 5f 4c 6f 6e 67 3b 07 00 00  ┆      S_Long;   ┆