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

⟦595422cce⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Gr_006, seg_005535

Derivation

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

E3 Source Code



with Gr_Random;
use Gr_Random;
with Gr_State_Test;
with Test_Io;
use Test_Io;

with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Font;
use Xlbt_Font;
with Xlbt_Graphics;
use Xlbt_Graphics;

with Xlbp_Event;
use Xlbp_Event;
with Xlbp_Graphics;
use Xlbp_Graphics;

procedure Gr_006 is

    List : X_Point_List;

    procedure Generate_List (Dpy    : X_Display;  
                             Width  : S_Short;  
                             Height : S_Short) is
        Count : S_Long := Dpy.Poly_Point_Limit;
    begin

        Count := Count - Count mod 4;
        List  := new X_Point_Array (1 .. Count);
        for I in 1 .. Count loop
            List (I).X := Random_X (Width);
            List (I).Y := Random_Y (Height - 15) + 15;
        end loop;

    end Generate_List;

    procedure Draw (Dpy         : X_Display;  
                    Window      : X_Window;  
                    Gc         : X_Gc;  
                    Font        : X_Font_Struct;  
                    Width       : S_Short;  
                    Height      : S_Short;
                    Per_Message : S_Natural) is
        Flush : S_Natural := 0;
        I     : S_Natural;
        J     : S_Natural;
    begin

        I := List'First;
        while I < List'Last loop
            if List'Last - I + 1 >= Per_Message then
                J := I + Per_Message - 1;
            else
                J := List'Last;
            end if;
            if J - I + 1 < 2 then
                exit;
            end if;
            X_Fill_Polygon (Dpy, Window.Drawable, Gc, List (I .. J),
                            Complex, Coord_Mode_Origin);
            Flush := Flush + 1;
            if Flush >= Per_Message then
                X_Flush (Dpy);
                Flush := 0;
            end if;
            I := J + 1;
        end loop;

    end Draw;

    procedure Do_Graphics (Dpy    :        X_Display;  
                           State  : in out Natural;  
                           Window :        X_Window;  
                           Gc     :        X_Gc;  
                           Font   :        X_Font_Struct;  
                           Width  :        S_Short;  
                           Height :        S_Short) is
    begin
        if List = None_X_Point_List then
            Generate_List (Dpy, Width, Height);
        end if;
        case State is
            when 1 =>
                X_Fill_Polygon (Dpy, Window.Drawable, Gc,
                                List (List'First .. List'First +
                                                       List'Length / 2 - 1),  
                                Complex, Coord_Mode_Origin);
            when 2 =>
                X_Fill_Polygon (Dpy, Window.Drawable, Gc, List.all,  
                                Complex, Coord_Mode_Origin);
            when 3 =>
                Draw (Dpy, Window, Gc, Font, Width, Height, 4);
            when 4 =>
                Draw (Dpy, Window, Gc, Font, Width, Height, 8);
            when 5 =>
                Draw (Dpy, Window, Gc, Font, Width,
                      Height, Dpy.Poly_Point_Limit / 2);
            when others =>
                Free_X_Point_List (List);
                State := 0;
        end case;
    end Do_Graphics;

    procedure Test is new Gr_State_Test (Do_Graphics);

begin

    Test;

end Gr_006;

E3 Meta Data

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=2b rec1=00 rec2=01 rec3=02c
        [0x01] rec0=00 rec1=00 rec2=06 rec3=002
        [0x02] rec0=20 rec1=00 rec2=02 rec3=020
        [0x03] rec0=00 rec1=00 rec2=05 rec3=010
        [0x04] rec0=15 rec1=00 rec2=03 rec3=022
        [0x05] rec0=13 rec1=00 rec2=04 rec3=000
    tail 0x2170098ec81978b8221bb 0x42a00088462063203