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

⟦3a8e3d79d⟧ TextFile

    Length: 43935 (0xab9f)
    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 Ico_Objcube;  
use Ico_Objcube;  
with Ico_Objico;  
use Ico_Objico;  
with Ico_Objtetra;  
use Ico_Objtetra;  
with Ico_Polyinfo;  
use Ico_Polyinfo;  
with Ran1_Package;  
use Ran1_Package;  
with Trig;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Atom_Defs;  
use Xlbt_Atom_Defs;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Color;  
use Xlbt_Color;  
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_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_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 Ico_Main is
------------------------------------------------------------------------------
-- Derived from: ico.c
------------------------------------------------------------------------------
-- $Header: ico.c,v 1.4 88/02/09 13:15:08 jim 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.
--
------------------------------------------------------------------------------
--
-- Description
--  Display a wire-frame rotating icosahedron, with hidden lines removed
--
-- Arguments:
--  -r      display on root window instead of creating a new one
--  =wxh+x+y    X geometry for new window (default 600x600 centered)
--  host:display    X display on which to run
-- (plus a host of others, try -help)
------------------------------------------------------------------------------
-- Additions by jimmc@sci:
--  faces and colors
--  double buffering on the display
--  additional polyhedra
--  sleep switch
------------------------------------------------------------------------------

    Ico_Fatal_Error : exception;

    Ran_Data : Ran1_Data;

    type Transform_3d is array (0 .. 3, 0 .. 3) of Float;

----Now include all the files which define the actual polyhedra

    type Poly_Info_Pointer is access Poly_Info;

    type Poly_Info_Array is array (Natural range <>) of Poly_Info_Pointer;

    Polys : constant Poly_Info_Array := (1 => new Poly_Info'(Obj_Cube),  
                                         2 => new Poly_Info'(Obj_Ico),  
                                         3 => new Poly_Info'(Obj_Tetra));


    type Xx_Color_List          is access X_Color_Array;  
    type Xx_Pixel_List          is access X_Pixel_Array;  
    type Xx_Plane_Mask_List     is access X_Plane_Mask_Array;  
    type Xx_String_Pointer_List is access X_String_Pointer_Array;

    type Dbuf_Info is  
        record  
            Prev_X        : S_Short;  
            Prev_Y        : S_Short;  
            Plane_Masks   : S_Natural;       -- points into dbpain.plane_masks
            En_Plane_Mask : X_Plane_Mask;    -- what we enable for drawing
            Colors        : Xx_Color_List;   -- size = 2 ** totalplanes
            Pixels        : Xx_Pixel_List;   -- size = 2 ** planesperbuf
        end record;

    type Dbuf_Info_Array is array (S_Natural range <>) of Dbuf_Info;

    type Dbuf_Pair is  
        record  
            Planes_Per_Buf : S_Natural;  
            Pixels_Per_Buf : S_Natural;             -- = 1<<planesperbuf
            Total_Planes   : S_Natural;             -- = 2*planesperbuf
            Total_Pixels   : S_Natural;             -- = 1<<totalplanes
            Plane_Masks    : Xx_Plane_Mask_List;    -- size = totalplanes
            Pixels         : X_Pixel_Array (0 .. 0);  
            Dbuf_Num       : S_Natural;  
            Bufs           : Dbuf_Info_Array (0 .. 1);  
            Draw_Buf       : S_Natural;  
            Dpy_Buf        : S_Natural;  
        end record;


    Dbpair : Dbuf_Pair;

    type S_Char_Array_2d is  
       array (S_Natural range <>, S_Natural range <>) of S_Char;

    Drawn : S_Char_Array_2d (0 .. Max_Nv - 1, 0 .. Max_Nv - 1);  
    Zero  : constant S_Char_Array_2d (0 .. Max_Nv - 1, 0 .. Max_Nv - 1) :=  
       (others => (others => 0));

    Bg_Color : X_Color;  
    Fg_Color : X_Color;

    Dpy        : X_Display;  
    Win        : X_Window;  
    Win_Width  : U_Short;  
    Win_Height : U_Short;  
    Cmap       : X_Colormap;  
    Gc         : X_Gc;


    Initialized : Boolean   := False;  
    Dsync       : Boolean   := False;-- call X_Sync to keep things debuggable
    Dblbuf      : Boolean   := False;-- do double buffering
    Sleepcount  : Duration;          -- how long to sleep between draws
    Isleepcount : Duration  := 5.0;  -- heuristic sleep period
    Numcolors   : S_Natural := 0;    -- Number of colors user asked for
    Colornames  : Xx_String_Pointer_List;  
    Dofaces     : Boolean   := False;-- draw faces on screen?
    Doedges     : Boolean   := True; -- draw edges on screen?

    Xform  : Transform_3d;  
    Xv     : Point_3d_Array_2d;  
    Buffer : Boolean;  
    Wo2    : Float;  
    Ho2    : Float;

--\f

------------------------------------------------------------------------------
-- Forward Declarations
------------------------------------------------------------------------------

    procedure Concat_Mat (L :        Transform_3d;  
                          R :        Transform_3d;  
                          M : in out Transform_3d);  
    procedure Draw_Poly (Poly  : Poly_Info_Pointer;  
                         Win   : X_Window;  
                         Gc    : X_Gc;  
                         Icox  : S_Short;  
                         Icoy  : S_Short;  
                         Icow  : U_Short;  
                         Icoh  : U_Short;  
                         Prevx : S_Short;  
                         Prevy : S_Short);  
    function  Find_Poly (Name : String) return Poly_Info_Pointer;  
    procedure Format_Rotate_Mat (Axis  :        Character;  
                                 Angle :        Float;  
                                 M     : in out Transform_3d);  
    procedure Give_Obj_Help;  
    procedure Ico_Fatal (Fmt : String);  
    procedure Ident_Mat (M : in out Transform_3d);  
    procedure Init_Dbufs (Fg             : X_Pixel;  
                          Bg             : X_Pixel;  
                          Planes_Per_Buf : Natural);  
    procedure Partial_Non_Hom_Transform (N    :        S_Natural;  
                                         M    :        Transform_3d;  
                                         Inn  :        Point_3d_Array;  
                                         Outt : in out Point_3d_Array);  
    procedure Set_Buf_Color (N     : S_Natural;             -- color index
                             Color : X_Color);  -- color to set
    procedure Set_Buf_Colname (N       : S_Natural;  
                               Colname : X_String);  
    procedure Set_Display_Buf (N : S_Natural);  
    procedure Set_Draw_Buf (N : S_Natural);

-- static char *help_message() = {
-- "where options include:",
-- "    -display host:dpy                X server to use",
-- "    -geometry geom                   geometry of window to use",
-- "    -r                               draw in the root window",
-- "    -d number                        dashed line pattern for wire frames",
-- "    -colors color ...                codes to use on sides",
-- "    -dbl                             use double buffering",
-- "    -noedges                         don't draw wire frame edges",
-- "    -faces                           draw faces",
-- "    -i                               invert",
-- "    -sleep number                    seconds to sleep in between draws",
-- "    -obj objname                     type of polyhedral object to draw",
-- "    -objhelp                         list polyhedral objects available",
-- NULL};

--\f

-- /******************************************************************************
--  * Description
--  *  Main routine.  Process command-line arguments, then bounce a bounding
--  *  box inside the window.  Call DrawIco() to redraw the icosahedron.
--  *****************************************************************************/

    procedure Main  
                 (Display       : X_String  := "";       -- host:display
                  Object        : String    := "ICO";    -- object to draw
                  Edges         : Boolean   := True;     -- draw obj edges
                  Faces         : Boolean   := False;    -- draw obj faces
                  Geometry      : X_String  := "";       -- geometry to use
                  Invert        : Boolean   := False;    -- invert video
                  Colors        : X_String  := "";       -- "red,blue,green"
                  Dashes        : S_Natural := 0;        -- dash geometry
                  Sleep         : Duration  := 0.0;      -- pause between draws
                  Double_Buffer : Boolean   := False;    -- double buffer
                  Use_Root      : Boolean   := False;    -- draw upon root
                  Help_Printout : Boolean   := False) is -- print obj names

        Fg        : X_Pixel;  
        Bg        : X_Pixel;  
        Winx      : S_Short;  
        Winy      : S_Short;  
        Winw      : U_Short;  
        Winh      : U_Short;  
        Xswa      : X_Set_Window_Attributes;  
        Xwa       : X_Window_Attributes;  
        Poly      : Poly_Info_Pointer; -- the poly to draw
        Icox      : S_Short;  
        Icoy      : S_Short;  
        Icodeltax : S_Short;  
        Icodeltay : S_Short;  
        Icow      : U_Short;  
        Icoh      : U_Short;  
        Xev       : X_Event;  
        Xgcv      : X_Gc_Values;  
        Error     : X_Error_String;  
        Succ      : X_Status;  
        Env       : constant X_String := X_Display_Name (Display);

    begin

----Process arguments:

        declare  
            K : S_Natural;  
        begin  
            Numcolors := 0;  
            for I in Colors'Range loop  
                if Colors (I) = ',' then  
                    Numcolors := Numcolors + 1;  
                end if;  
            end loop;  
            if Colors'Length > 0 then  
                Colornames := new X_String_Pointer_Array (0 .. Numcolors);  
                Numcolors  := 0;  
                K          := Colors'First;  
                for I in Colors'Range loop  
                    if Colors (I) = ',' then  
                        Colornames (Numcolors) :=  
                           new X_String'(Colors (K .. I - 1));  
                        K                      := I + 1;  
                        Numcolors              := Numcolors + 1;  
                    elsif I = Colors'Last then  
                        Colornames (Numcolors) := new  
                                                     X_String'(Colors (K .. I));  
                        Numcolors              := Numcolors + 1;  
                    end if;  
                end loop;  
            end if;  
        end;

        Dblbuf     := Double_Buffer;  
        Doedges    := Edges;  
        Dofaces    := Faces;  
        Sleepcount := Sleep;  
        Poly       := Find_Poly (Object);  
        if Help_Printout then  
            Give_Obj_Help;  
            return;  
        end if;

        if not Dofaces and then not Doedges then  
            Ico_Fatal ("nothing to draw");  
        end if;

        X_Open_Display (Env, Dpy, Error);  
        if "=" (Dpy, None_X_Display) then  
            Ico_Fatal ("Cannot open display:" & To_String (Err (Error)));  
        end if;

        if Invert then  
            Fg := X_Black_Pixel (Dpy, X_Default_Screen (Dpy));  
            Bg := X_White_Pixel (Dpy, X_Default_Screen (Dpy));  
        else  
            Fg := X_White_Pixel (Dpy, X_Default_Screen (Dpy));  
            Bg := X_Black_Pixel (Dpy, X_Default_Screen (Dpy));  
        end if;

----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 := 700;  
            Winh := 500;  
            Winx :=  
               S_Short (X_Display_Width (Dpy, X_Default_Screen (Dpy)) - Winw) /  
                  2;  
            Winy :=  
               S_Short (X_Display_Height (Dpy, X_Default_Screen (Dpy)) - 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 => True, others => False);  
            Xswa.Background_Pixel := Bg;  
            Xswa.Border_Pixel := Fg;  
            Win := X_Create_Window  
                      (Dpy,  
                       X_Default_Root_Window (Dpy),  
                       Winx,  
                       Winy,  
                       Winw,  
                       Winh,  
                       0,  
                       X_Default_Depth (Dpy, X_Default_Screen (Dpy)),  
                       Input_Output,  
                       X_Default_Visual (Dpy, X_Default_Screen (Dpy)),  
                       (Cw_Event_Mask | Cw_Back_Pixel | Cw_Border_Pixel => True,  
                        others => False),  
                       Xswa);  
            X_Set_Text_Property (Dpy, Win, "Ico", Xa_Wm_Name);  
            X_Map_Window (Dpy, Win);  
            X_Get_Window_Attributes (Dpy, Win, Xwa, Succ);  
            if Succ = Failed then  
                Ico_Fatal ("cant get window attributes (size)");  
            end if;  
            Win_Width  := Xwa.Width;  
            Win_Height := Xwa.Height;  
        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, Fg);  
        X_Set_Background (Dpy, Gc, Bg);

        if Dashes /= 0 then  
            Xgcv.Line_Style := Line_Double_Dash;  
            Xgcv.Dashes     := U_Char (Dashes);  
            X_Change_Gc  
               (Dpy,  
                Gc,  
                (Gc_Line_Style | Gc_Dash_List => True, others => False),  
                Xgcv);  
        end if;

        if Dofaces and then Numcolors >= 1 then  
            declare  
                T    : S_Natural;  
                Bits : Natural;  
            begin  
                Bits := 0;  
                T    := Numcolors;  
                while T /= 0 loop  
                    Bits := Bits + 1;  
                    T    := T / 2;  
                end loop;  
                Init_Dbufs (Fg, Bg, Bits);  
            end;
            -- don't set the background color
            for I in Colornames'Range loop  
                Set_Buf_Colname (I + 1, Colornames (I).all);  
            end loop;  
            if Dblbuf then -- insert new colors
                Set_Display_Buf (1);  
            else  
                Set_Display_Buf (0);  
            end if;

        elsif Dblbuf or else Dofaces then  
            Init_Dbufs (Fg, Bg, 1);  
        end if;  
        if Numcolors = 0 then  
            Numcolors := 1;  
        end if;

        if Dsync then  
            X_Sync (Dpy, False);  
        end if;

----Get the initial position, size, and speed of the bounding-box:

        Icow := 150;  
        Icoh := 150;
--     srandom((int) time(0) % 231);
--     icoX := ((winW - icoW) * (random() and 0xFF)) >> 8;
--     icoY := ((winH - icoH) * (random() and 0xFF)) >> 8;
        Icox      := S_Short ((S_Long (Winw - Icow) *  
                               S_Long (255.0 * Ran1 (Ran_Data))) / 256);  
        Icoy      := S_Short ((S_Long (Winh - Icoh) *  
                               S_Long (255.0 * Ran1 (Ran_Data))) / 256);  
        Icodeltax := 13;  
        Icodeltay := 9;

----Bounce the box in the window:

        declare  
            Prevx : S_Short;  
            Prevy : S_Short;  
        begin  
            loop

                if X_Pending (Dpy) /= 0 then  
                    X_Next_Event (Dpy, Xev);  
                    if "=" (Xev.Kind, Button_Press) and then  
                       "=" (Xev.Button.Button, Button_2) then  
                        exit;  
                    end if;  
                end if;  
                Prevx := Icox;  
                Prevy := Icoy;

                Icox := Icox + Icodeltax;  
                if Icox < 0 or else U_Short (Icox) + Icow > Winw then  
                    Icox      := Icox - (Icodeltax * 2);  
                    Icodeltax := -Icodeltax;  
                end if;  
                Icoy := Icoy + Icodeltay;  
                if Icoy < 0 or else U_Short (Icoy) + Icoh > Winh then  
                    Icoy      := Icoy - (Icodeltay * 2);  
                    Icodeltay := -Icodeltay;  
                end if;

                Draw_Poly (Poly, Win, Gc, Icox, Icoy, Icow, Icoh, Prevx, Prevy);  
            end loop;  
            X_Close_Display (Dpy);  
        end;

    exception  
        when Ico_Fatal_Error =>  
            null;  
    end Main;

--\f

    function Tl (S : String; L : Natural) return String is  
        R : String (1 .. L) := (others => ' ');  
    begin  
        if S'Length < L then  
            R (1 .. S'Length) := S;  
        else  
            R := S (S'First .. S'First - 1 + L);  
        end if;  
        return R;  
    end Tl;

--\f

    procedure Give_Obj_Help is  
    begin  
        Text_Io.Put_Line  
           ("Name            Short Name    #Vert.  #Edges  #Faces  Dual");  
        for I in Polys'Range loop  
            Text_Io.Put (Tl (Polys (I).Long_Name.all, 16));  
            Text_Io.Put (Tl (Polys (I).Short_Name.all, 12));  
            S_Long_Io.Put (S_Long (Polys (I).Num_Verts), 6);  
            S_Long_Io.Put (S_Long (Polys (I).Num_Edges), 8);  
            S_Long_Io.Put (S_Long (Polys (I).Num_Faces), 8);  
            Text_Io.Put_Line (Polys (I).Dual.all);  
        end loop;  
    end Give_Obj_Help;

--\f

    function Find_Poly (Name : String) return Poly_Info_Pointer is

        function Equal (A, B : String) return Boolean is  
            Ac : Character;  
            Bc : Character;  
        begin  
            if A'Length /= B'Length then  
                return False;  
            end if;  
            for I in Natural range 0 .. A'Length - 1 loop  
                Ac := A (A'First + I);  
                Bc := B (B'First + I);  
                if Ac /= Bc then  
                    if Ac in 'a' .. 'z' then  
                        Ac := Character'Val (Character'Pos (Ac) -  
                                             (Character'Pos ('a') -  
                                              Character'Pos ('A')));  
                    end if;  
                    if Bc in 'a' .. 'z' then  
                        Bc := Character'Val (Character'Pos (Bc) -  
                                             (Character'Pos ('a') -  
                                              Character'Pos ('A')));  
                    end if;  
                    if Ac /= Bc then  
                        return False;  
                    end if;  
                end if;  
            end loop;  
            return True;  
        end Equal;  
    begin  
        for I in Polys'Range loop  
            if Equal (Polys (I).Long_Name.all,  
                      Name) or else  
               Equal (Polys (I).Short_Name.all,  
                      Name) then  
                return Polys (I);  
            end if;  
        end loop;  
        Ico_Fatal ("can't find object " & Name);  
    end Find_Poly;

--\f

    procedure Ico_Clear_Area (X : S_Short;  
                              Y : S_Short;  
                              W : U_Short;  
                              H : U_Short) is  
    begin  
        if Dblbuf or else Dofaces then  
            X_Set_Foreground (Dpy, Gc,  
                              Dbpair.Bufs (Dbpair.Draw_Buf).Pixels (0));
            -- use background as foreground color for fill
            X_Fill_Rectangle (Dpy, Win.Drawable, Gc, X, Y, W, H);  
        else  
            X_Clear_Area (Dpy, Win, X, Y, W, H, False);  
        end if;  
    end Ico_Clear_Area;

--\f

------------------------------------------------------------------------------
-- Description
--  Undraw previous polyhedron (by erasing its bounding box).
--  Rotate and draw the new polyhedron.
--
-- Input
--  poly        the polyhedron to draw
--  win     window on which to draw
--  gc      X11 graphics context to be used for drawing
--  icoX, icoY  position of upper left of bounding-box
--  icoW, icoH  size of bounding-box
--  prevX, prevY    position of previous bounding-box
------------------------------------------------------------------------------

    procedure Draw_Poly (Poly  : Poly_Info_Pointer;  
                         Win   : X_Window;  
                         Gc    : X_Gc;  
                         Icox  : S_Short;  
                         Icoy  : S_Short;  
                         Icow  : U_Short;  
                         Icoh  : U_Short;  
                         Prevx : S_Short;  
                         Prevy : S_Short) is

        V     : Point_3d_List  := Poly.V;  
        Nv    : S_Natural      := Poly.Num_Verts;  
        F     : S_Natural_List := Poly.F;  
        Nf    : S_Natural      := Poly.Num_Faces;  
        P0    : S_Natural;  
        P1    : S_Natural;  
        Pv2   : S_Natural;  
        Pe    : S_Natural;  
        Pxv   : S_Natural;  
        V2    : X_Point_Array (0 .. Max_Nv - 1);  
        Edges : X_Segment_Array (0 .. Max_Edges - 1);

        Pf        : S_Natural;  
        Facecolor : S_Natural;  
        K         : S_Natural;

        Pcount : S_Natural;  
        Pxvz   : Float;  
        Ppts   : X_Point_Array (0 .. Max_Edges_Per_Poly - 1);

    begin
----Set up points, transforms, etc.:

        if not Initialized then  
            declare  
                R1 : Transform_3d;  
                R2 : Transform_3d;  
            begin  
                Format_Rotate_Mat ('x', 5.0 * 3.1416 / 180.0, R1);  
                Format_Rotate_Mat ('y', 5.0 * 3.1416 / 180.0, R2);  
                Concat_Mat (R1, R2, Xform);

                Xv (False) (0 .. Nv - 1) := V.all;  
                Buffer                   := False;

                Wo2 := Float (Icow) / 2.0;  
                Ho2 := Float (Icoh) / 2.0;

                Initialized := True;  
            end;  
        end if;

----Switch double-buffer and rotate vertices:

        Buffer := not Buffer;  
        Partial_Non_Hom_Transform (Nv, Xform, Xv (not Buffer), Xv (Buffer));

----Convert 3D coordinates to 2D window coordinates:

        Pxv := Xv (Buffer)'First;  
        Pv2 := V2'First;  
        for I in reverse 0 .. Nv - 1 loop  
            V2 (Pv2).X := S_Short ((Xv (Buffer) (Pxv).X + 1.0) * Wo2) + Icox;  
            V2 (Pv2).Y := S_Short ((Xv (Buffer) (Pxv).Y + 1.0) * Ho2) + Icoy;  
            Pxv        := Pxv + 1;  
            Pv2        := Pv2 + 1;  
        end loop;

----Accumulate edges to be drawn, eliminating duplicates for speed:

        Pxv := Xv (Buffer)'First;  
        Pv2 := V2'First;  
        Pf  := F'First;  
        Pe  := Edges'First;
--geb This is unbelieveably slow.  R1000 compiler is stupid. Drawn := (others => (others => 0));
        Drawn := Zero;

        if Dblbuf then  
            Set_Draw_Buf (Dbpair.Dbuf_Num);
            -- switch drawing buffers if double buffered
        end if;  
        if Dofaces then -- for faces, need to clear before FillPoly
            if Dblbuf then  
                Ico_Clear_Area (Dbpair.Bufs (Dbpair.Draw_Buf).Prev_X,  
                                Dbpair.Bufs (Dbpair.Draw_Buf).Prev_Y,  
                                Icow + 1,  
                                Icoh + 1);  
            end if;  
            Ico_Clear_Area (Prevx, Prevy, Icow + 1, Icoh + 1);  
        end if;

        if Dsync then  
            X_Sync (Dpy, False);  
        end if;

        for I in reverse 0 .. Nf - 1 loop

            Pcount := F (Pf); -- number of edges for this face
            Pf     := Pf + 1;  
            Pxvz   := 0.0;  
            for J in 0 .. Pcount - 1 loop  
                P0   := F (Pf + J);  
                Pxvz := Pxvz + Xv (Buffer) (Pxv + P0).Z;  
            end loop;

            -- If facet faces away from viewer, don't consider it:
            if Pxvz < 0.0 then  
                goto Continue;  
            end if;

            if Dofaces then  
                if Numcolors /= 0 then  
                    Facecolor := I rem Numcolors + 1;  
                else  
                    Facecolor := 1;  
                end if;  
                X_Set_Foreground  
                   (Dpy, Gc, Dbpair.Bufs (Dbpair.Draw_Buf).Pixels (Facecolor));  
                for J in 0 .. Pcount - 1 loop  
                    P0         := F (Pf + J);  
                    Ppts (J).X := V2 (Pv2 + P0).X;  
                    Ppts (J).Y := V2 (Pv2 + P0).Y;  
                end loop;  
                X_Fill_Polygon (Dpy, Win.Drawable, Gc, Ppts (0 .. Pcount - 1),  
                                Convex, Coord_Mode_Origin);  
            end if;

            if Doedges then  
                for J in 0 .. Pcount - 1 loop  
                    if J < Pcount - 1 then  
                        K := J + 1;  
                    else  
                        K := 0;  
                    end if;  
                    P0 := F (Pf + J);  
                    P1 := F (Pf + K);  
                    if (Drawn (P0, P1) = 0) then  
                        Drawn (P0, P1) := 1;  
                        Drawn (P1, P0) := 1;  
                        Edges (Pe).X1  := V2 (Pv2 + P0).X;  
                        Edges (Pe).Y1  := V2 (Pv2 + P0).Y;  
                        Edges (Pe).X2  := V2 (Pv2 + P1).X;  
                        Edges (Pe).Y2  := V2 (Pv2 + P1).Y;  
                        Pe             := Pe + 1;  
                    end if;  
                end loop;  
            end if;  
            <<Continue>> null;  
            Pf := Pf + Pcount;  
        end loop;

----Erase previous, draw current icosahedrons; sync for smoothness.

        if Doedges then  
            if Dofaces then  
                X_Set_Foreground (Dpy, Gc,  
                                  Dbpair.Bufs (Dbpair.Draw_Buf).Pixels (0));
                -- use background as foreground color
            else  
                if Dblbuf then  
                    Ico_Clear_Area (Dbpair.Bufs (Dbpair.Draw_Buf).Prev_X,  
                                    Dbpair.Bufs (Dbpair.Draw_Buf).Prev_Y,  
                                    Icow + 1, Icoh + 1);  
                end if;  
                Ico_Clear_Area (Prevx, Prevy, Icow + 1, Icoh + 1);  
                if Dblbuf or else Dofaces then  
                    X_Set_Foreground (Dpy, Gc,  
                                      Dbpair.Bufs (Dbpair.Draw_Buf).Pixels  
                                         (Dbpair.Pixels_Per_Buf - 1));  
                end if;  
            end if;  
            X_Draw_Segments (Dpy, Win.Drawable, Gc, Edges (0 .. Pe - 1));  
        end if;

        if Dsync then  
            X_Sync (Dpy, False);  
        end if;

        if Dblbuf then  
            Dbpair.Bufs (Dbpair.Draw_Buf).Prev_X := Icox;  
            Dbpair.Bufs (Dbpair.Draw_Buf).Prev_Y := Icoy;  
            Set_Display_Buf (Dbpair.Dbuf_Num);  
        end if;
        -- X_Sync (Dpy, False);
        if Dblbuf then  
            Dbpair.Dbuf_Num := 1 - Dbpair.Dbuf_Num;  
        end if;  
        if Sleepcount /= 0.0 then  
            delay Sleepcount;  
        end if;

    end Draw_Poly;

--\f

    procedure Init_Dbufs (Fg             : X_Pixel;  
                          Bg             : X_Pixel;  
                          Planes_Per_Buf : Natural) is  
        K    : S_Natural;  
        M    : S_Natural;  
        Q    : S_Natural;  
        Succ : X_Status;  
    begin  
        Dbpair.Planes_Per_Buf := S_Natural (Planes_Per_Buf);  
        Dbpair.Pixels_Per_Buf := 2 ** Planes_Per_Buf;  
        if Dblbuf then  
            Dbpair.Total_Planes := S_Long (2 * Planes_Per_Buf);  
        else  
            Dbpair.Total_Planes := S_Long (Planes_Per_Buf);  
        end if;  
        Dbpair.Total_Pixels := 2 ** Natural (Dbpair.Total_Planes);  
        Dbpair.Plane_Masks  :=  
           new X_Plane_Mask_Array (0 .. Dbpair.Total_Planes - 1);  
        Dbpair.Dbuf_Num     := 0;  
        if Dblbuf then  
            Q := 2;  
        else  
            Q := 1;  
        end if;  
        for I in 0 .. Q - 1 loop  
            declare  
                B : Dbuf_Info renames Dbpair.Bufs (I);  
            begin  
                B.Plane_Masks := Dbpair.Plane_Masks'First +  
                                    (I * S_Long (Planes_Per_Buf));  
                B.Colors := new X_Color_Array (0 .. Dbpair.Total_Pixels - 1);  
                B.Pixels := new X_Pixel_Array (0 .. Dbpair.Pixels_Per_Buf - 1);  
            end;  
        end loop;

        Cmap := X_Default_Colormap (Dpy, X_Default_Screen (Dpy));  
        if "=" (Cmap, None_X_Colormap) then  
            Ico_Fatal ("can't get default colormap");  
        end if;  
        X_Alloc_Color_Cells (Dpy, Cmap, False, Dbpair.Plane_Masks.all,  
                             Dbpair.Pixels (Dbpair.Pixels'First ..  
                                               Dbpair.Pixels'First), Succ);
        -- allocate color planes */
        if Succ = Failed then  
            Ico_Fatal ("can't allocate color planes");  
        end if;

        Fg_Color.Pixel := Fg;  
        Bg_Color.Pixel := Bg;  
        X_Query_Color (Dpy, Cmap, Fg_Color);  
        X_Query_Color (Dpy, Cmap, Bg_Color);

        Set_Buf_Color (0, Bg_Color);  
        Set_Buf_Color (1, Fg_Color);  
        for I in 0 .. Q - 1 loop  
            declare  
                B  : Dbuf_Info renames Dbpair.Bufs (I);  
                J  : S_Natural;  
                Jj : S_Natural;  
            begin
                --if dblbuf then
                --    otherb := dbpair.bufs+(1-i);
                --end if;
                if Dblbuf then  
                    Q := Dbpair.Pixels_Per_Buf;  
                else  
                    Q := 1;  
                end if;  
                for J0 in 0 .. Q - 1 loop  
                    for J1 in 0 .. Dbpair.Pixels_Per_Buf - 1 loop  
                        J := S_Natural (J0 *  
                                        2 ** Natural (Dbpair.Planes_Per_Buf)) or  
                             S_Natural (J1);  
                        if I = 0 then  
                            Jj := J;  
                        else  
                            Jj := S_Natural  
                                     (J1 * 2 ** Natural  
                                                   (Dbpair.Planes_Per_Buf)) or  
                                  S_Natural (J0);  
                        end if;  
                        B.Colors (Jj).Pixel := Dbpair.Pixels (0);  
                        K                   := 0;  
                        M                   := J;  
                        while M /= 0 loop  
                            if M rem 2 /= 0 then  
                                B.Colors (Jj).Pixel :=  
                                   "or" (B.Colors (Jj).Pixel,  
                                         X_Pixel (Dbpair.Plane_Masks (K)));  
                            end if;  
                            K := K + 1;  
                            M := M / 2;  
                        end loop;  
                        B.Colors (Jj).Flags :=  
                           X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                          others                      => False);  
                    end loop;  
                end loop;  
                B.Prev_X        := 0;  
                B.Prev_Y        := 0;  
                B.En_Plane_Mask := 0;  
                for J in 0 .. Planes_Per_Buf - 1 loop  
                    B.En_Plane_Mask :=  
                       "or" (B.En_Plane_Mask,  
                             Dbpair.Plane_Masks (B.Plane_Masks + S_Long (J)));  
                end loop;  
                for J in 0 .. Dbpair.Pixels_Per_Buf - 1 loop  
                    B.Pixels (J) := Dbpair.Pixels (0);  
                    K            := 0;  
                    M            := J;  
                    while M /= 0 loop  
                        if M rem 2 /= 0 then  
                            B.Pixels (J) :=  
                               "or" (B.Pixels (J),  
                                     X_Pixel (Dbpair.Plane_Masks  
                                                 (B.Plane_Masks + K)));  
                        end if;  
                        K := K + 1;  
                        M := M / 2;  
                    end loop;  
                end loop;  
            end;  
        end loop;

        Set_Draw_Buf (0);

        X_Set_Background (Dpy, Gc, Dbpair.Bufs (0).Pixels (0));  
        X_Set_Plane_Mask (Dpy, Gc, All_Planes);  
        Ico_Clear_Area (0, 0, Win_Width, Win_Height); -- clear entire window
        delay Isleepcount; -- geb? /*** doesn't work without this!!! */
        X_Sync (Dpy, False);

        if Dblbuf then  
            Set_Display_Buf (1);  
        else  
            Set_Display_Buf (0);  
        end if;

    end Init_Dbufs;

--\f

    procedure Set_Buf_Colname (N       : S_Natural;  
                               Colname : X_String) is  
        Succ   : X_Status;  
        Dcolor : X_Color;  
        Color  : X_Color;  
    begin

        X_Lookup_Color (Dpy, Cmap, Colname, Dcolor, Color, Succ);  
        if Succ = Failed then -- no such color
            Ico_Fatal ("no such color " & To_String (Colname));  
        end if;  
        Set_Buf_Color (N, Color);

    end Set_Buf_Colname;

--\f

    procedure Set_Buf_Color (N     : S_Natural;    -- color index
                             Color : X_Color) is   -- color to set
        Cx  : S_Natural;  
        Pix : X_Pixel;  
        Q   : S_Natural;  
    begin

        if Dblbuf then  
            Q := 2;  
        else  
            Q := 1;  
        end if;  
        for I in 0 .. Q - 1 loop  
            declare  
                B : Dbuf_Info renames Dbpair.Bufs (I);  
            begin  
                if Dblbuf then  
                    Q := Dbpair.Pixels_Per_Buf;  
                else  
                    Q := 1;  
                end if;  
                for J in 0 .. Q - 1 loop  
                    Cx                  := N + J * Dbpair.Pixels_Per_Buf;  
                    Pix                 := B.Colors (Cx).Pixel;  
                    B.Colors (Cx)       := Color;  
                    B.Colors (Cx).Pixel := Pix;  
                    B.Colors (Cx).Flags :=  
                       X_Color_Flags'(Do_Red | Do_Green | Do_Blue => True,  
                                      others                      => False);  
                end loop;  
            end;  
        end loop;

    end Set_Buf_Color;

--\f

    procedure Set_Draw_Buf (N : S_Natural) is  
        Xgcv : X_Gc_Values;  
        Mask : X_Gc_Components;  
    begin

        Dbpair.Draw_Buf := Dbpair.Bufs'First + N;  
        Xgcv.Plane_Mask := Dbpair.Bufs (Dbpair.Draw_Buf).En_Plane_Mask;  
        Xgcv.Foreground := Dbpair.Bufs (Dbpair.Draw_Buf).Pixels  
                              (Dbpair.Pixels_Per_Buf - 1);  
        Xgcv.Background := Dbpair.Bufs (Dbpair.Draw_Buf).Pixels (0);  
        Mask            := X_Gc_Components'  
                              (Gc_Foreground | Gc_Background => True,  
                               others                        => False);  
        if Dblbuf then  
            Mask (Gc_Plane_Mask) := True;  
        end if;  
        X_Change_Gc (Dpy, Gc, Mask, Xgcv);

    end Set_Draw_Buf;

--\f

    procedure Set_Display_Buf (N : S_Natural) is  
    begin  
        Dbpair.Dpy_Buf := Dbpair.Bufs'First + N;  
        X_Store_Colors (Dpy, Cmap, Dbpair.Bufs (Dbpair.Dpy_Buf).Colors.all);  
    end Set_Display_Buf;

--\f

    procedure Ico_Fatal (Fmt : String) is  
    begin  
        Text_Io.Put_Line ("ico: " & Fmt);  
        raise Ico_Fatal_Error;  
    end Ico_Fatal;

--\f

------------------------------------------------------------------------------
-- Description
--  Concatenate two 4-by-4 transformation matrices.
--
-- Input
--  l       multiplicand (left operand)
--  r       multiplier (right operand)
--
-- Output
--  *m      Result matrix
------------------------------------------------------------------------------

    procedure Concat_Mat (L :        Transform_3d;  
                          R :        Transform_3d;  
                          M : in out Transform_3d) is  
    begin

        for I in 0 .. 3 loop  
            for J in 0 .. 3 loop  
                M (I, J) := L (I, 0) * R (0, J)  
                                + L (I, 1) * R (1, J)  
                                + L (I, 2) * R (2, J)  
                                + L (I, 3) * R (3, J);  
            end loop;  
        end loop;

    end Concat_Mat;

--\f

------------------------------------------------------------------------------
-- Description
--  Format a matrix that will perform a rotation transformation
--  about the specified axis.  The rotation angle is measured
--  counterclockwise about the specified axis when looking
--  at the origin from the positive axis.
--
-- Input
--  axis        Axis ('x', 'y', 'z') about which to perform rotation
--  angle       Angle (in radians) of rotation
--  A       Pointer to rotation matrix
--
-- Output
--  *m      Formatted rotation matrix
------------------------------------------------------------------------------

    procedure Format_Rotate_Mat (Axis  :        Character;  
                                 Angle :        Float;  
                                 M     : in out Transform_3d) is  
        S : Float;  
        C : Float;  
    begin

        Ident_Mat (M);

        S := Trig.Sin (Angle);  
        C := Trig.Cos (Angle);

        case Axis is  
            when 'x' =>  
                M (1, 1) := C;  
                M (2, 2) := C;  
                M (1, 2) := S;  
                M (2, 1) := -S;

            when 'y' =>  
                M (0, 0) := C;  
                M (2, 2) := C;  
                M (2, 0) := S;  
                M (0, 2) := -S;

            when 'z' =>  
                M (0, 0) := C;  
                M (1, 1) := C;  
                M (0, 1) := S;  
                M (1, 0) := -S;  
            when others =>  
                raise Program_Error;  
        end case;

    end Format_Rotate_Mat;

--\f

------------------------------------------------------------------------------
-- Description
--  Format a 4x4 identity matrix.
--
-- Output
--  *m      Formatted identity matrix
------------------------------------------------------------------------------

    procedure Ident_Mat (M : in out Transform_3d) is  
    begin

        for I in reverse 0 .. 3 loop

            for J in reverse 0 .. 3 loop  
                M (I, J) := 0.0;  
            end loop;  
            M (I, I) := 1.0;  
        end loop;

    end Ident_Mat;

--\f

------------------------------------------------------------------------------
-- Description
--  Perform a partial transform on non-homogeneous points.
--  Given an array of non-homogeneous (3-coordinate) input points,
--  this routine multiplies them by the 3-by-3 upper left submatrix
--  of a standard 4-by-4 transform matrix.  The resulting non-homogeneous
--  points are returned.
--
-- Input
--  n       number of points to transform
--  m       4-by-4 transform matrix
--  in      array of non-homogeneous input points
--
-- Output
--  *out        array of transformed non-homogeneous output points
------------------------------------------------------------------------------

    procedure Partial_Non_Hom_Transform (N    :        S_Natural;  
                                         M    :        Transform_3d;  
                                         Inn  :        Point_3d_Array;  
                                         Outt : in out Point_3d_Array) is  
        Ini  : S_Natural := Inn'First;  
        Outi : S_Natural := Outt'First;  
    begin  
        for I in 1 .. N loop  
            Outt (Outi).X := Inn (Ini).X * M (0, 0)  
                                 + Inn (Ini).Y * M (1, 0)  
                                 + Inn (Ini).Z * M (2, 0);  
            Outt (Outi).Y := Inn (Ini).X * M (0, 1)  
                                 + Inn (Ini).Y * M (1, 1)  
                                 + Inn (Ini).Z * M (2, 1);  
            Outt (Outi).Z := Inn (Ini).X * M (0, 2)  
                                 + Inn (Ini).Y * M (1, 2)  
                                 + Inn (Ini).Z * M (2, 2);  
            Ini           := Ini + 1;  
            Outi          := Outi + 1;  
        end loop;  
    end Partial_Non_Hom_Transform;

--\f

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 (Float (Clk) * Float (Natural'Last / 101)));  
    end;

end Ico_Main;