with
     openGL.Images,
     openGL.Viewport,
     openGL.Tasks,
     openGL.Errors,

     GID,

     GL.Binding,
     GL.safe,
     GL.Pointers,

     ada.unchecked_Conversion,
     ada.Calendar,
     ada.Characters.handling,

     System;


package body openGL.IO
is
   use ada.Characters.handling,
       ada.Streams.Stream_IO;

   use type Index_t;


   --------
   --  Face
   --

   function Vertices_of (Self : in Face) return Vertices
   is
   begin
      case Self.Kind
      is
         when Triangle =>   return Self.Tri;
         when Quad     =>   return Self.Quad;
         when Polygon  =>   return Self.Poly.all;
      end case;
   end Vertices_of;



   procedure set_Vertex_in (Self : in out Face;   Which : in long_Index_t;
                                                  To    : in Vertex)
   is
   begin
      case Self.Kind
      is
         when Triangle =>   Self.Tri  (Which) := To;
         when Quad     =>   Self.Quad (Which) := To;
         when Polygon  =>   Self.Poly (Which) := To;
      end case;
   end set_Vertex_in;



   procedure destroy (Self : in out Face)
   is
      procedure free is new ada.unchecked_Deallocation (Vertices, Vertices_view);
   begin
      if Self.Kind = Polygon
      then
         free (Self.Poly);
      end if;
   end destroy;


   -------------
   -- Operations
   --

   function current_Frame return Image
   is
      use GL,
          GL.Binding,
          GL.Pointers,
          Texture;

      Extent  : constant Extent_2d := openGL.Viewport.Extent;
      Frame   :          Image (1 .. Index_t (Extent.Width),
                                1 .. Index_t (Extent.Height));
   begin
      glReadPixels (0, 0,
                    GLsizei (Extent.Width),
                    GLsizei (Extent.Height),
                    to_GL (Format' (Texture.RGB)),
                    GL_UNSIGNED_BYTE,
                    to_GLvoid_access (Frame (1, 1).Red'Access));
      return Frame;
   end current_Frame;


   ---------
   --  Forge
   --

   function to_height_Map (image_Filename : in asset_Name;
                           Scale          : in Real  := 1.0) return height_Map_view
   is
      File    :          Ada.Streams.Stream_IO.File_Type;
      Image   :          GID.Image_Descriptor;
      up_Name : constant String              := To_Upper (to_String (image_Filename));

      next_Frame : ada.Calendar.Day_Duration := 0.0;

   begin
      open (File, in_File, to_String (image_Filename));

      GID.load_Image_Header (Image,
                             Stream (File).all,
                             try_tga =>          image_Filename'Length >= 4
                                        and then up_Name (up_Name'Last - 3 .. up_Name'Last) = ".TGA");
      declare
         image_Width  : constant Positive := GID.Pixel_Width  (Image);
         image_Height : constant Positive := GID.Pixel_Height (Image);

         the_Heights  : constant access height_Map := new height_Map' (1 .. Index_t (image_height) =>
                                                                         (1 .. Index_t (image_width) => <>));
         procedure load_raw_Image
         is
            subtype primary_Color_range is GL.GLubyte;

            Row, Col : Index_t;


            procedure set_X_Y (x, y : Natural)
            is
            begin
               Col := Index_t (X + 1);
               Row := Index_t (Y + 1);
            end Set_X_Y;


            procedure put_Pixel (Red, Green, Blue : primary_Color_range;
                                 Alpha            : primary_Color_range)
            is
               pragma Warnings (Off, alpha); -- Alpha is just ignored.
               use type GL.GLubyte, Real;
            begin
               the_Heights (Row, Col) :=   (Real (Red) + Real (Green) + Real (Blue))
                                         / (3.0 * 255.0)
                                         * Scale;

               if Col = Index_t (image_Width)
               then
                  Row := Row + 1;
                  Col := 1;
               else
                  Col := Col + 1;
               end if;

               --  ^ GID requires us to look to next pixel on the right for next time.
            end put_Pixel;


            procedure Feedback (Percents : Natural) is null;

            procedure load_Image is new GID.load_Image_contents (primary_Color_range,
                                                                 set_X_Y,
                                                                 put_Pixel,
                                                                 Feedback,
                                                                 GID.fast);
         begin
            load_Image (Image, next_Frame);
         end load_Raw_image;

      begin
         load_raw_Image;
         close (File);

         return the_Heights.all'unchecked_Access;
      end;
   end to_height_Map;



   function fetch_Image (Stream  : in ada.Streams.Stream_IO.Stream_access;
                         try_TGA : in Boolean) return Image
   is
   begin
      return Images.fetch_Image (Stream, try_TGA);
   end fetch_Image;



   function to_Image (image_Filename : in asset_Name)  return Image
   is
      File    :          ada.Streams.Stream_IO.File_type;
      up_Name : constant String := to_Upper (to_String (image_Filename));
   begin
      open (File, In_File, to_String (image_Filename));

      declare
         the_Image : constant Image
           := fetch_Image (Stream (File),
                           try_TGA =>          image_Filename'Length >= 4
                                      and then up_Name (up_Name'Last - 3 .. up_Name'Last) = ".TGA");
      begin
         close (File);
         return the_Image;
      end;
   end to_Image;



   function to_lucid_Image (image_Filename : in asset_Name) return lucid_Image
   is
      Unused : aliased Boolean;
   begin
      return to_lucid_Image (image_Filename, Unused'Access);
   end to_lucid_Image;



   function to_lucid_Image (image_Filename : in     asset_Name;
                            is_Lucid       : access Boolean) return lucid_Image
   is
      File      :          ada.Streams.Stream_IO.File_type;
      the_Image :          GID.Image_Descriptor;
      up_Name   : constant String := to_Upper (to_String (image_Filename));

      next_Frame :          ada.Calendar.Day_Duration := 0.0;

   begin
      open (File, in_File, to_String (image_Filename));

      GID.load_Image_Header (the_Image,
                             Stream (File).all,
                             try_TGA =>          image_Filename'Length >= 4
                                        and then up_Name (up_Name'Last - 3 .. up_Name'Last) = ".TGA");
      declare
         image_Width  : constant Positive := GID.Pixel_Width  (the_Image);
         image_Height : constant Positive := GID.Pixel_Height (the_Image);

         Frame : lucid_Image (1 .. Index_t (image_Height),
                              1 .. Index_t (image_Width));

         procedure load_raw_Image
         is
            subtype primary_Color_range is GL.GLubyte;

            Row, Col : Index_t;


            procedure set_X_Y (X, Y : Natural)
            is
            begin
               Col := Index_t (X + 1);
               Row := Index_t (Y + 1);
            end set_X_Y;


            procedure put_Pixel (Red, Green, Blue : primary_Color_range;
                                 Alpha            : primary_Color_range)
            is
               use type GL.GLubyte, Real;
            begin
               Frame (Row, Col) := ((Red, Green, Blue), Alpha);

               if Col = Index_t (image_Width)
               then     -- GID requires us to look to next pixel on the right for next time.
                  Row := Row + 1;
                  Col := 1;
               else
                  Col := Col + 1;
               end if;

               if Alpha /= opaque_Value
               then
                  is_Lucid.all := True;
               end if;
            end put_Pixel;


            procedure Feedback (Percents : Natural) is null;

            procedure load_Image is new GID.load_Image_contents (primary_Color_range,
                                                                 set_X_Y,
                                                                 put_Pixel,
                                                                 Feedback,
                                                                 GID.fast);
         begin
            load_Image (the_Image, next_Frame);
         end Load_raw_image;

      begin
         is_Lucid.all := False;

         load_raw_Image;
         close (File);

         return Frame;
      end;
   end to_lucid_Image;



   function to_Texture (image_Filename : in asset_Name) return Texture.Object
   is
      use Texture;

      is_Lucid        : aliased  Boolean;
      the_lucid_Image : constant lucid_Image    := to_lucid_Image (image_Filename, is_Lucid'Access);
      the_Texture     :          Texture.Object := Forge.to_Texture (Texture.Dimensions' (the_lucid_Image'Length (2),
                                                                                          the_lucid_Image'Length (1)));
   begin
      if is_Lucid
      then
         set_Image (the_Texture, the_lucid_Image);
      else
         declare
            the_opaque_Image : constant Image := to_Image (the_lucid_Image);
         begin
            set_Image (the_Texture, the_opaque_Image);
         end;
      end if;

      return the_Texture;
   end to_Texture;



   procedure destroy (Self : in out Model)
   is
      procedure free is new ada.unchecked_Deallocation (bone_Weights,       bone_Weights_view);
      procedure free is new ada.unchecked_Deallocation (bone_Weights_array, bone_Weights_array_view);
   begin
      free (Self.Sites);
      free (Self.Coords);
      free (Self.Normals);

      if Self.Weights /= null
      then
         for Each in Self.Weights'Range
         loop
            free (Self.Weights (Each));
         end loop;

         free (Self.Weights);
      end if;

      for Each in Self.Faces'Range
      loop
         destroy (Self.Faces (Each));
      end loop;

      free (Self.Faces);
   end destroy;



   --------------------
   --- Raw Image Frames
   --

   procedure write_raw_Frame (to_Stream     : in Stream_access;
                              Width, Height : in Natural;
                              with_Alpha    : in Boolean)
   is
      use GL,
          GL.Binding,
          Texture;

      -- 4-byte padding for .bmp/.avi formats is the same as GL's default
      -- padding: see glPixelStore, GL_[UN]PACK_ALIGNMENT = 4 as initial value.
      -- http://www.openGL.org/sdk/docs/man/xhtml/glPixelStore.xml
      --
      padded_row_Size : constant Positive := (if with_Alpha then 4 * Integer (Float'Ceiling (Float (Width)))
                                                            else 4 * Integer (Float'Ceiling (Float (Width) * 3.0 / 4.0)));
      -- (in bytes)

      type temp_Bitmap_type is array (Natural range <>) of aliased gl.GLUbyte;

      PicData : temp_Bitmap_type (0 .. (padded_row_size + 4) * (height + 4) - 1);
      --
      -- No dynamic allocation needed!
      -- The "+4" are there to avoid parity address problems when GL writes
      -- to the buffer.

      type Loc_pointer is new gl.safe.GLvoid_Pointer;

      function convert is new ada.unchecked_Conversion (System.Address, Loc_pointer);
      --
      -- This method is functionally identical as GNAT's Unrestricted_Access
      -- but has no type safety (cf GNAT Docs).

      pragma no_strict_Aliasing (Loc_pointer); -- Recommended by GNAT 2005+.

      pPicData :          Loc_pointer;
      data_Max : constant Integer    := padded_row_Size * Height - 1;

      -- Workaround for the severe xxx'Read xxx'Write performance
      -- problems in the GNAT and ObjectAda compilers (as in 2009)
      -- This is possible if and only if Byte = Stream_Element and
      -- arrays types are both packed the same way.
      --
      type Byte_array is array (Integer range <>) of aliased GLUByte;

      subtype Size_Test_a is Byte_Array (1..19);
      subtype Size_Test_b is ada.Streams.Stream_Element_array (1 .. 19);

      Workaround_possible: constant Boolean :=          Size_Test_a'Size      = Size_Test_b'Size
                                               and then Size_Test_a'Alignment = Size_Test_b'Alignment;
   begin
      Tasks.check;

      pPicData:= convert (PicData (0)'Address);

      GLReadPixels (0, 0,
                    GLSizei (width),
                    GLSizei (height),
                    (if with_Alpha then to_GL (openGL.Texture.BGRA)
                                   else to_GL (openGL.Texture.BGR)),
                    GL.GL_UNSIGNED_BYTE,
                    pPicData);
      Errors.log;

      if Workaround_possible
      then
         declare
            use ada.Streams;

            SE_Buffer : Stream_Element_array (0 .. Stream_Element_Offset (PicData'Last));

            for SE_Buffer'Address use PicData'Address;
            pragma Import (Ada, SE_Buffer);
         begin
            ada.Streams.write (to_Stream.all, SE_Buffer (0 .. Stream_Element_Offset (data_Max)));
         end;

      else
         temp_Bitmap_type'write (to_Stream, PicData (0 .. data_Max));
      end if;

   end write_raw_Frame;



   --------------
   -- Bitmap File
   --

   type U8  is mod 2 **  8;   for U8 'Size use  8;
   type U16 is mod 2 ** 16;   for U16'Size use 16;
   type U32 is mod 2 ** 32;   for U32'Size use 32;

   type I32 is range -2 ** 31 .. 2 ** 31 - 1;
   for  I32'Size use 32;



   generic
      type Number is mod <>;
      S : Stream_Access;
   procedure write_Intel_x86_Number (N : in Number);

   procedure write_Intel_x86_Number (N : in Number)
   is
      M     :          Number  := N;
      Bytes : constant Integer := Number'Size / 8;
   begin
      for i in 1 .. bytes
      loop
         U8'write (S, U8 (M mod 256));
         M := M / 256;
      end loop;
   end write_Intel_x86_Number;



   subtype FxPt2dot30 is U32;

   type CIExyz is
      record
         ciexyzX : FxPt2dot30;
         ciexyzY : FxPt2dot30;
         ciexyzZ : FxPt2dot30;
      end record;

   type CIExyzTriple is
      record
         ciexyzRed   : CIExyz;
         ciexyzGreen : CIExyz;
         ciexyzBlue  : CIExyz;
      end record;

   type BitMapFileHeader is
      record
         bfType      : U16;
         bfSize      : U32;
         bfReserved1 : U16 := 0;
         bfReserved2 : U16 := 0;
         bfOffBits   : U32;
      end record;
   pragma pack (BitMapFileHeader);
   for          BitMapFileHeader'Size use 8 * 14;

   type BitMapInfoHeader is
      record
         biSize          : U32;
         biWidth         : I32;
         biHeight        : I32;
         biPlanes        : U16;
         biBitCount      : U16;
         biCompression   : U32;
         biSizeImage     : U32;
         biXPelsPerMeter : I32 := 0;
         biYPelsPerMeter : I32 := 0;
         biClrUsed       : U32 := 0;
         biClrImportant  : U32 := 0;
      end record;
   pragma pack (BitMapInfoHeader);
   for          BitMapInfoHeader'Size use 8 * 40;

   type BitMapV4Header is
      record
         Core          : BitMapInfoHeader;
         bV4RedMask    : U32;
         bV4GreenMask  : U32;
         bV4BlueMask   : U32;
         bV4AlphaMask  : U32;
         bV4CSType     : U32;
         bV4Endpoints  : CIExyzTriple;
         bV4GammaRed   : U32;
         bV4GammaGreen : U32;
         bV4GammaBlue  : U32;
      end record;
   pragma pack (BitMapV4Header);
   for          BitMapV4Header'Size use 8 * 108;



   procedure write_BMP_Header (to_Stream     : in Stream_Access;
                               Width, Height : in GL.GLint;
                               with_Alpha    : in Boolean)
   is
      use GL,
          GL.Binding,
          Texture;

      FileHeader : BitMapFileHeader;
      FileInfo   : BitMapV4Header;

   begin
      FileHeader.bfType := 16#4D42#;     -- 'BM'

      FileInfo.Core.biWidth  := I32 (Width);
      FileInfo.Core.biHeight := I32 (Height);
      FileInfo.Core.biPlanes := 1;

      if with_Alpha
      then
         FileHeader.bfOffBits        :=   BitMapFileHeader'Size / 8
                                        + BitMapV4Header  'Size / 8;
         FileInfo.Core.biSize        := BitMapV4Header'Size / 8;
         FileInfo.Core.biBitCount    := 32;
         FileInfo.Core.biCompression :=  3;
         FileInfo.Core.biSizeImage   := U32 (  4     -- 4-byte padding for '.bmp/.avi' formats.
                                             * Integer (Float'Ceiling (Float (FileInfo.Core.biWidth)))
                                             * Integer (FileInfo.Core.biHeight));

         FileInfo.bV4RedMask    := 16#00FF0000#;
         FileInfo.bV4GreenMask  := 16#0000FF00#;
         FileInfo.bV4BlueMask   := 16#000000FF#;
         FileInfo.bV4AlphaMask  := 16#FF000000#;
         FileInfo.bV4CSType     := 0;
         FileInfo.bV4Endpoints  := (others => (others => 0));
         FileInfo.bV4GammaRed   := 0;
         FileInfo.bV4GammaGreen := 0;
         FileInfo.bV4GammaBlue  := 0;

      else
         FileHeader.bfOffBits        :=   BitMapFileHeader'Size / 8
                                        + BitMapInfoHeader'Size / 8;
         FileInfo.Core.biSize        := BitMapInfoHeader'Size / 8;
         FileInfo.Core.biBitCount    := 24;
         FileInfo.Core.biCompression :=  0;
         FileInfo.Core.biSizeImage   := U32 (  4     -- 4-byte padding for '.bmp/.avi' formats.
                                             * Integer (Float'Ceiling (Float (FileInfo.Core.biWidth) * 3.0 / 4.0))
                                             * Integer (FileInfo.Core.biHeight));
      end if;

      FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.Core.biSizeImage;

      declare
         procedure write_Intel is new write_Intel_x86_Number   (U16, to_Stream);
         procedure write_Intel is new write_Intel_x86_Number   (U32, to_Stream);
         function  convert     is new ada.unchecked_Conversion (I32, U32);
      begin
         -- ** Endian-safe: ** --
         write_Intel (FileHeader.bfType);
         write_Intel (FileHeader.bfSize);
         write_Intel (FileHeader.bfReserved1);
         write_Intel (FileHeader.bfReserved2);
         write_Intel (FileHeader.bfOffBits);
         --
         write_Intel (         FileInfo.Core.biSize);
         write_Intel (convert (FileInfo.Core.biWidth));
         write_Intel (convert (FileInfo.Core.biHeight));
         write_Intel (         FileInfo.Core.biPlanes);
         write_Intel (         FileInfo.Core.biBitCount);
         write_Intel (         FileInfo.Core.biCompression);
         write_Intel (         FileInfo.Core.biSizeImage);
         write_Intel (convert (FileInfo.Core.biXPelsPerMeter));
         write_Intel (convert (FileInfo.Core.biYPelsPerMeter));
         write_Intel (         FileInfo.Core.biClrUsed);
         write_Intel (         FileInfo.Core.biClrImportant);

         if with_Alpha
         then
            write_Intel (FileInfo.bV4RedMask);
            write_Intel (FileInfo.bV4GreenMask);
            write_Intel (FileInfo.bV4BlueMask);
            write_Intel (FileInfo.bV4AlphaMask);
            write_Intel (FileInfo.bV4CSType);

            write_Intel (FileInfo.bV4Endpoints.ciexyzRed.ciexyzX);
            write_Intel (FileInfo.bV4Endpoints.ciexyzRed.ciexyzY);
            write_Intel (FileInfo.bV4Endpoints.ciexyzRed.ciexyzZ);

            write_Intel (FileInfo.bV4Endpoints.ciexyzGreen.ciexyzX);
            write_Intel (FileInfo.bV4Endpoints.ciexyzGreen.ciexyzY);
            write_Intel (FileInfo.bV4Endpoints.ciexyzGreen.ciexyzZ);

            write_Intel (FileInfo.bV4Endpoints.ciexyzBlue.ciexyzX);
            write_Intel (FileInfo.bV4Endpoints.ciexyzBlue.ciexyzY);
            write_Intel (FileInfo.bV4Endpoints.ciexyzBlue.ciexyzZ);

            write_Intel (FileInfo.bV4GammaRed);
            write_Intel (FileInfo.bV4GammaGreen);
            write_Intel (FileInfo.bV4GammaBlue);
         end if;
      end;
   end write_BMP_Header;



   -------------
   -- Save Image
   --

   procedure save (image_Filename : in String;
                   the_Image      : in Image)
   is
      use GL,
          GL.Binding,
          ada.Streams.Stream_IO;

      File : ada.Streams.Stream_IO.File_type;
      S    : ada.Streams.Stream_IO.Stream_access;

      Size : Extent_2D := (Width  => the_Image'Length (2),
                           Height => the_Image'Length (1));

   begin
      create (File, out_File, image_Filename);

      S := Stream (File);

      write_BMP_Header (to_Stream  => S,
                        Width      => GLint (Size.Width),
                        Height     => GLint (Size.Height),
                        with_Alpha => True);

      for r in 1 .. Index_t (Size.Height)
      loop
         for c in 1 .. Index_t (Size.Width)
         loop
            color_Value'write (S, the_Image (r, c).Blue);
            color_Value'write (S, the_Image (r, c).Green);
            color_Value'write (S, the_Image (r, c).Red);
            color_Value'write (S, 255);
         end loop;
      end loop;

      close (File);

   exception
      when others =>
         if is_Open (File)
         then
            close (File);
         end if;

         raise;
   end Save;


   -------------
   -- Screenshot
   --

   procedure Screenshot (Filename   : in String;
                         with_Alpha : in Boolean := False)
   is
      use GL,
          GL.Binding,
          ada.Streams.Stream_IO;

      File     : ada.Streams.Stream_IO.File_type;
      S        : ada.Streams.Stream_IO.Stream_access;

      Viewport : array (0 .. 3) of aliased GLint;

   begin
      Tasks.check;

      glGetIntegerv (GL_VIEWPORT,
                     Viewport (0)'unchecked_Access);
      Errors.log;

      create (File, out_File, Filename);

      S := Stream (File);

      write_BMP_Header (to_Stream  => S,
                        Width      => Viewport (2),
                        Height     => Viewport (3),
                        with_Alpha => with_Alpha);

      write_raw_Frame  (to_Stream  => S,
                        Width      => Integer (Viewport (2)),
                        Height     => Integer (Viewport (3)),
                        with_Alpha => with_Alpha);
      close (File);

   exception
      when others =>
         if is_Open (File)
         then
            close (File);
         end if;

         raise;
   end Screenshot;



   ----------------
   -- Video Capture
   --

   --  We define global variables since it is not expected
   --  that more that one capture is taken at the same time.
   --
   avi           : ada.Streams.Stream_IO.File_type;
   frames        : Natural;
   rate          : Positive;
   width, height : Positive;
   bmp_size      : U32;

   procedure write_RIFF_Headers
   is
      --  Written 1st time to take place (but # of frames unknown)
      --  Written 2nd time for setting # of frames, sizes, etc.
      --
      calc_bmp_size    : constant U32           := U32 (((width)) * height * 3);
      --  !! stuff to multiple of 4 !!
      index_size       : constant U32           := U32 (frames) * 16;
      movie_size       : constant U32           := 4 + U32 (frames) * (calc_bmp_size + 8);
      second_list_size : constant U32           := 4 + 64 + 48;
      first_list_size  : constant U32           := (4 + 64) + (8 + second_list_size);
      file_size        : constant U32           := 8 + (8 + first_list_size) + (4 + movie_size) + (8 + index_size);
      Stream           : constant Stream_access := ada.Streams.Stream_IO.Stream (avi);

      procedure write_Intel is new write_Intel_x86_Number (U16, Stream);
      procedure write_Intel is new write_Intel_x86_Number (U32, Stream);

      microseconds_per_frame : constant U32 := U32 (1_000_000.0 / long_Float (rate));
   begin
      bmp_size := calc_bmp_size;

      String'write (Stream, "RIFF");
      U32   'write (Stream, file_size);
      String'write (Stream, "AVI ");
      String'write (Stream, "LIST");
      write_Intel  (first_list_size);
      String'write (Stream, "hdrl");
      String'write (Stream, "avih");
      write_Intel  (U32' (56));

      --  Begin of AVI Header
      write_Intel (microseconds_per_frame);
      write_Intel (U32'(0));      -- MaxBytesPerSec
      write_Intel (U32'(0));      -- Reserved1
      write_Intel (U32'(16));     -- Flags (16 = has an index)
      write_Intel (U32 (frames));
      write_Intel (U32'(0));      -- InitialFrames
      write_Intel (U32'(1));      -- Streams
      write_Intel (bmp_size);
      write_Intel (U32 (width));
      write_Intel (U32 (height));
      write_Intel (U32'(0));      -- Scale
      write_Intel (U32'(0));      -- Rate
      write_Intel (U32'(0));      -- Start
      write_Intel (U32'(0));      -- Length
      --  End of AVI Header

      String'write (Stream, "LIST");
      write_Intel  (second_list_size);
      String'write (Stream, "strl");

      --  Begin of Str
      String'write (Stream, "strh");
      write_Intel  (U32'(56));
      String'write (Stream, "vids");
      String'write (Stream, "DIB ");
      write_Intel  (U32'(0));                -- flags
      write_Intel  (U32'(0));                -- priority
      write_Intel  (U32'(0));                -- initial frames
      write_Intel  (microseconds_per_frame); -- Scale
      write_Intel  (U32'(1_000_000));        -- Rate
      write_Intel  (U32'(0));                -- Start
      write_Intel  (U32 (frames));           -- Length
      write_Intel  (bmp_size);               -- SuggestedBufferSize
      write_Intel  (U32'(0));                -- Quality
      write_Intel  (U32'(0));                -- SampleSize
      write_Intel  (U32'(0));
      write_Intel  (U16 (width));
      write_Intel  (U16 (height));
      --  End of Str

      String'write (Stream, "strf");
      write_Intel (U32'(40));

      --  Begin of BMI
      write_Intel (U32'(40));    -- BM header size (like BMP)
      write_Intel (U32 (width));
      write_Intel (U32 (height));
      write_Intel (U16'(1));     -- Planes
      write_Intel (U16'(24));    -- BitCount
      write_Intel (U32'(0));     -- Compression
      write_Intel (bmp_size);    -- SizeImage
      write_Intel (U32'(3780));  -- XPelsPerMeter
      write_Intel (U32'(3780));  -- YPelsPerMeter
      write_Intel (U32'(0));     -- ClrUsed
      write_Intel (U32'(0));     -- ClrImportant
      --  End of BMI

      String'write (Stream, "LIST");
      write_Intel  (movie_size);
      String'write (Stream, "movi");
   end Write_RIFF_headers;



   procedure start_Capture (AVI_Name   : String;
                            frame_Rate : Positive)
   is
      use GL,
          GL.Binding;
      Viewport : array (0 .. 3) of aliased GLint;
   begin
      Tasks.check;

      create (Avi, out_File, AVI_Name);

      Frames := 0;
      Rate   := frame_Rate;

      glGetIntegerv (GL_VIEWPORT,
                     Viewport (0)'unchecked_Access);
      Errors.log;

      Width  := Positive (Viewport (2));
      Height := Positive (Viewport (3));
      --  NB: GL viewport resizing should be blocked during the video capture !
      write_RIFF_Headers;
   end start_Capture;



   procedure capture_Frame
   is
      S : constant Stream_Access := Stream (Avi);
      procedure Write_Intel is new Write_Intel_x86_number (U32, s);
   begin
      String'write    (S, "00db");
      write_Intel     (bmp_Size);
      write_raw_Frame (S, Width, Height, with_Alpha => False);

      Frames := Frames + 1;
   end capture_Frame;



   procedure stop_Capture
   is
      index_Size  : constant U32           := U32 (Frames) * 16;
      S           : constant Stream_Access := Stream (Avi);
      ChunkOffset :          U32           := 4;

      procedure write_Intel is new write_Intel_x86_Number (U32, S);
   begin
      --  Write the index section
      --
      String'write (S, "idx1");
      write_Intel (index_Size);

      for f in 1 .. Frames
      loop
         String'write (S, "00db");
         write_Intel  (U32'(16));     -- Keyframe.
         write_Intel  (ChunkOffset);
         ChunkOffset := ChunkOffset + bmp_Size + 8;
         write_Intel  (bmp_Size);
      end loop;

      Set_Index (avi, 1);     -- Go back to file beginning.
      write_RIFF_Headers;     -- Rewrite headers with correct data.
      close (Avi);
   end stop_Capture;


end openGL.IO;
