Back to... GLOBE_3D

Source file : gl-io.adb


--
-- Input:
--   Uses GID, the Generic Image Decoder ( http://gen-img-dec.sourceforge.net/ )
--
-- Output:
--   BMP : from http://wiki.delphigl.com/index.php/Screenshot (Delphi)
--   AVI : from specification, plus re-using the raw bitmap output from BMP

with GID;

with Ada.Calendar;
with Ada.Exceptions;                    use Ada.Exceptions;
with Ada.Unchecked_Conversion;
with System;

package body GL.IO is

  use Ada.Streams.Stream_IO;

  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;

  not_yet_implemented : exception;

  function To_greyscale_pixels (the_Image : in Image) return Byte_grid
  is
     the_Grid : Byte_grid (1 .. the_Image.Height, 1 .. the_Image.Width);
  begin
     case the_Image.tex_pixel_Format is
        when GL.LUMINANCE =>

           for Row in the_Grid'Range (1) loop
              for Col in the_Grid'Range (2) loop
                 the_Grid (Row, Col) := the_Image.Data (the_Image.Width * (Row - 1) + Col - 1);
              end loop;
           end loop;

        when others =>
           raise not_yet_implemented;       -- tbd: do these
     end case;
     return the_Grid;
  end To_greyscale_pixels;

  procedure Insert_into_GL(
              id             : Integer;
              size           : Integer;
              width          : Integer;
              height         : Integer;
              texFormat      : TexFormatEnm;
              texPixelFormat : TexPixelFormatEnm;
              image_p        : Byte_array_ptr
            )
  is
    pragma Unreferenced (size);
    ptr: constant GL.pointer:= image_p(0)'Access;
  begin
    BindTexture ( TEXTURE_2D, Uint(id) );
    PixelStore ( UNPACK_ALIGNMENT, 1 );
    TexParameter ( TEXTURE_2D, TEXTURE_WRAP_S, REPEAT );
    TexParameter ( TEXTURE_2D, TEXTURE_WRAP_T, REPEAT );
    -- TexParameter (TEXTURE_2D, TEXTURE_MAG_FILTER, NEAREST);
    TexParameter ( TEXTURE_2D, TEXTURE_MAG_FILTER, LINEAR);
    -- TexParameter (TEXTURE_2D, TEXTURE_MIN_FILTER, NEAREST);
    TexParameter ( TEXTURE_2D, TEXTURE_MIN_FILTER, LINEAR);
    TexEnv ( TEXTURE_ENV, TEXTURE_ENV_MODE, MODULATE );
    TexImage2D ( TEXTURE_2D, 0, texFormat, Sizei( width ),
                 Sizei( height ), 0, texPixelFormat, GL_UNSIGNED_BYTE,
                 ptr);
  end Insert_into_GL;

  -- 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.
  --
  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;
  --

  procedure Fill_Buffer(b: in out Input_buffer);
  -- ^ Spec here to avoid in Get_Byte below (GNAT 2009):
  -- warning: call to subprogram with no separate spec prevents inlining

  procedure Fill_Buffer(b: in out Input_buffer)
  is
    --
    procedure BlockRead(
      buffer       :    out Byte_array;
      actually_read:    out Natural
    )
    is
      use Ada.Streams;
      Last_Read: Stream_Element_Offset;
    begin
      if workaround_possible then
        declare
          SE_Buffer: Stream_Element_Array (1 .. buffer'Length);
          -- direct mapping: buffer = SE_Buffer
          for SE_Buffer'Address use buffer'Address;
          pragma Import (Ada, SE_Buffer);
        begin
          Read(b.stm.all, SE_Buffer, Last_Read);
        end;
      else
        declare
          SE_Buffer: Stream_Element_Array (1 .. buffer'Length);
          -- need to copy array
        begin
          Read(b.stm.all, SE_Buffer, Last_Read);
          for i in buffer'Range loop
            buffer(i):= Ubyte(SE_Buffer(Stream_Element_Offset(i-buffer'First)+SE_Buffer'First));
          end loop;
        end;
      end if;
      actually_read:= Natural(Last_Read);
    end BlockRead;
    --
  begin
    BlockRead(
      buffer        => b.data,
      actually_read => b.MaxInBufIdx
    );
    b.InputEoF:= b.MaxInBufIdx = 0;
    b.InBufIdx := 1;
  end Fill_Buffer;

  procedure Attach_Stream(
    b   : out Input_buffer;
    stm : in Ada.Streams.Stream_IO.Stream_Access
  )
  is
  begin
    b.stm:= stm;
    Fill_Buffer(b);
  end Attach_Stream;

  procedure Get_Byte(b: in out Input_buffer; byte: out Ubyte) is
  begin
    if b.InBufIdx > b.MaxInBufIdx then
      Fill_Buffer(b);
      if b.InputEoF then
        raise End_Error;
      end if;
    end if;
    byte:= b.data(b.InBufIdx);
    b.InBufIdx:= b.InBufIdx + 1;
  end Get_Byte;

  function Load (S : in  Ada.Streams.Stream_IO.Stream_Access) return Image
  is
    the_Image : Image;
    idx: Natural;
    im_desc: GID.Image_descriptor;

    --  Generic parameter: bit depth (outside of GID)
    --  We don't want to test the bit depth at each pixel!
    generic
      bit_depth: Positive;
    procedure GID_with_generic_bit_depth(image: in out GID.Image_descriptor);

    procedure GID_with_generic_bit_depth(image: in out GID.Image_descriptor) is

      next_frame: Ada.Calendar.Day_Duration;  --  animation time, unused

      --  Generic parameters for GID's Load_Image

      subtype Primary_color_range is GL.Ubyte;

      procedure Set_X_Y (x, y: Natural) is
      begin
        idx:= (bit_depth / 8) * (x + the_Image.Width * y);
      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
      begin
        case bit_depth is  --  This test happens actually at compile time :-)
          when 32 =>
            the_Image.Data(idx..idx+3):= (red, green, blue, alpha);
            idx:= idx + 4;  -- Index on next pixel on the right, for next time.
          when 24 =>
            the_Image.Data(idx..idx+2):= (red, green, blue);
            idx:= idx + 3;  -- Index on next pixel on the right, for next time.
          when  8 =>
            the_Image.Data(idx):= red;  --  = green = blue
            idx:= idx + 1;  -- Index on next pixel on the right, for next time.
          when others =>
            null;
        end case;
      end Put_Pixel;

      procedure Feedback(percents: Natural) is null;

      procedure GID_Load_image_instanciated is
        new GID.Load_image_contents(
          Primary_color_range, Set_X_Y,
          Put_Pixel, Feedback, GID.fast
        );

    begin
      GID_Load_image_instanciated(image, next_frame);
    end GID_with_generic_bit_depth;

    procedure GID_32bpp is new GID_with_generic_bit_depth(32);
    procedure GID_24bpp is new GID_with_generic_bit_depth(24);
    procedure GID_8bpp  is new GID_with_generic_bit_depth(8);

    imageBits, dest_bits: Integer;

  begin
    --  TGA files are headerless, so, "know your data!"
    GID.Load_image_header(im_desc, S.all, try_tga => True);
    the_Image.Width:=  GID.Pixel_width(im_desc);
    the_Image.Height:= GID.Pixel_height(im_desc);
    imageBits   := GID.Bits_per_pixel(im_desc);
    the_Image.size := the_Image.Width * the_Image.Height;
    --
    --  Now a little headache.
    --
    case GID.Format(im_desc) is
      when GID.TGA =>
        case imageBits is
          when 32 | 24 | 8 =>
            --  For 8 bits, we take alpha := grey value (Rod special setting:-) )
            dest_bits:= imageBits;
          when others =>
            raise Constraint_Error with "Tricky TGA BPP not supported" & Integer'Image(imageBits);
        end case;
      when others =>
        case imageBits is
          when 32 =>
            dest_bits:= 32;
          when others =>
            dest_bits:= 24;  -- 8 or 4 is actually a RGB with palette
        end case;
    end case;

    -- Allocation
    the_Image.Data:= new Byte_array(0..(dest_bits/8)*the_Image.size-1);
    case dest_bits is
      when 32 =>
        GID_32bpp(im_desc);
        the_Image.blending_hint:= True;
        the_Image.tex_Format      := GL.RGBA;
        the_Image.tex_pixel_Format:= GL.RGBA;
      when 24 =>
        GID_24bpp(im_desc);
        the_Image.blending_hint:= False;
        the_Image.tex_Format      := GL.RGB;
        the_Image.tex_pixel_Format:= GL.RGB;
      when 4 | 8  =>
        GID_8bpp(im_desc);
        the_Image.blending_hint:= True;
        the_Image.tex_Format      := GL.LUMINANCE; -- ALPHA
        the_Image.tex_pixel_Format:= GL.LUMINANCE;
      when others =>
        raise Constraint_Error with "BPP not supported" & Integer'Image(imageBits);
    end case;
    return the_Image;
  end Load;

  function Load (file_name : in  String) return Image is
    f: File_Type;
    the_Image : Image;
  begin
    begin
      Open(f,In_File,file_name);
    exception
      when Name_Error => raise File_Not_Found with "file name:" & file_name;
    end;
    the_Image := Load ( Stream(f) );
    Close(f);
    return the_Image;
  exception
    when e: others =>
      Close(f);
      Raise_Exception(Exception_Identity(e), "file name:" & file_name);
      return the_Image;
  end Load;

  procedure Load (
    file_name    :     String;
    ID           :     Integer;  --  ID is the GL texture identifier to bind to
    blending_hint: out Boolean   --  might have blending / transparency / alpha ?
  )
  is
    f: File_Type;
  begin
    begin
      Open(f,In_File, file_name);
    exception
      when Name_Error => raise File_Not_Found with "file name:" & file_name;
    end;
    Load ( Stream(f), ID, blending_hint );
    Close(f);
  exception
    when e: others =>
      Close(f);
      Raise_Exception(Exception_Identity(e), "file name:" & file_name);
  end Load;

  procedure Load (
    s            :     Ada.Streams.Stream_IO.Stream_Access;  -- input data stream
    ID           :     Integer;  --  ID is the GL texture identifier to bind to
    blending_hint: out Boolean   --  might have blending / transparency / alpha ?
  )
  is
    the_Image : Image := Load (s);
  begin
    Insert_into_GL(
              id             => ID,
              size           => the_Image.size,
              width          => the_Image.Width,
              height         => the_Image.Height,
              texFormat      => the_Image.tex_Format,
              texPixelFormat => the_Image.tex_pixel_Format,
              image_p        => the_Image.Data
    );
    --  Release our data, its been uploaded to the GL system
    Free( the_Image.Data );
    blending_hint := the_Image.blending_hint;
  end Load;

  -------------
  -- Outputs --
  -------------

  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;

  procedure Write_raw_BGR_frame(s: Stream_Access; width, height: Natural) is
    -- 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:=
      4 * Integer(Float'Ceiling(Float(width) * 3.0 / 4.0));
    -- (in bytes)
    --
    type Temp_bitmap_type is array(Natural range <>) of aliased GL.Ubyte;
    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.pointer;
    function Cvt 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;
  begin
    pPicData:= Cvt(PicData(0)'Address);
    GL.ReadPixels(
      0, 0,
      GL.Sizei(width), GL.Sizei(height),
      GL.BGR,
      GL.GL_UNSIGNED_BYTE,
      GL.pointer(pPicData)
    );
    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(s.all, SE_Buffer(0..Stream_Element_Offset(data_max)));
      end;
    else
      Temp_bitmap_type'Write(s, PicData(0..data_max) );
    end if;
  end Write_raw_BGR_frame;

  -------------------------------------------------------
  -- BMP RGB(A) output of the current, active viewport --
  -------------------------------------------------------

  procedure Screenshot( name: in String ) is
    -- Translated by (New) P2Ada v. 15-Nov-2006
    -- http://wiki.delphigl.com/index.php/Screenshot
    f: Ada.Streams.Stream_IO.File_Type;

    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;

    FileInfo  : BITMAPINFOHEADER;
    FileHeader: BITMAPFILEHEADER;
    type intPtr is new GL.intPointer;
    Viewport  : array (0 .. 3) of aliased GL.Int;
    function Cvt is new Ada.Unchecked_Conversion(System.Address,intPtr);
    -- This method is functionally identical as GNAT's Unrestricted_Access
    -- but has no type safety (cf GNAT Docs)
    pragma No_Strict_Aliasing(intPtr); -- recommended by GNAT 2005+
  begin
    --  Größe des Viewports abfragen --> Spätere Bildgrößenangaben
    GL.GetIntegerv(GL.VIEWPORT, GL.intPointer(Cvt(Viewport(0)'Address)) );

    --  Initialisieren der Daten des Headers
    FileHeader.bfType := 16#4D42#; -- 'BM'
    FileHeader.bfOffBits :=
      BITMAPINFOHEADER'Size / 8 +
      BITMAPFILEHEADER'Size / 8;

    --  Schreiben der Bitmap-Informationen
    FileInfo.biSize       := BITMAPINFOHEADER'Size / 8;
    FileInfo.biWidth      := I32(Viewport(2));
    FileInfo.biHeight     := I32(Viewport(3));
    FileInfo.biPlanes     := 1;
    FileInfo.biBitCount   := 24;
    FileInfo.biCompression:= 0;
    FileInfo.biSizeImage  :=
      U32(
        -- 4-byte padding for .bmp/.avi formats
        4 * Integer(Float'Ceiling(Float(FileInfo.biWidth) * 3.0 / 4.0)) *
        Integer(FileInfo.biHeight)
      );

    --  Größenangabe auch in den Header übernehmen
    FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.biSizeImage;

    --  Und den ganzen Müll in die Datei schieben ;-)
    --  Moderne Leute nehmen dafür auch Streams ...
    Create(f, Out_File, name);
    declare
      procedure Write_Intel is new Write_Intel_x86_number( U16, Stream(f) );
      procedure Write_Intel is new Write_Intel_x86_number( U32, Stream(f) );
      function Cvt is new Ada.Unchecked_Conversion( I32, U32 );
    begin
      -- ** Only for Intel endianess: ** --
      --  BITMAPFILEHEADER'Write(Stream(F), FileHeader);
      --  BITMAPINFOHEADER'Write(Stream(F), FileInfo);
      --
      -- ** 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.biSize);
      Write_Intel(Cvt(FileInfo.biWidth));
      Write_Intel(Cvt(FileInfo.biHeight));
      Write_Intel(FileInfo.biPlanes);
      Write_Intel(FileInfo.biBitCount);
      Write_Intel(FileInfo.biCompression);
      Write_Intel(FileInfo.biSizeImage);
      Write_Intel(Cvt(FileInfo.biXPelsPerMeter));
      Write_Intel(Cvt(FileInfo.biYPelsPerMeter));
      Write_Intel(FileInfo.biClrUsed);
      Write_Intel(FileInfo.biClrImportant);
      --
      Write_raw_BGR_frame(Stream(f),Integer(Viewport(2)), Integer(Viewport(3)));
      Close(f);
    exception
      when others =>
        Close(f);
        raise;
    end;
  end Screenshot;

  -------------------
  -- Video capture --
  -------------------

  -- Exceptionally 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.
    --
    padded_row_size: constant Positive:=
      4 * Integer(Float'Ceiling(Float(width) * 3.0 / 4.0));
    calc_bmp_size: constant U32:= U32(padded_row_size * height);
    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);
    s: constant Stream_Access:= Stream(avi);
    procedure Write_Intel is new Write_Intel_x86_number( U16, s );
    procedure Write_Intel is new Write_Intel_x86_number( U32, s );
    microseconds_per_frame: constant U32:= U32( 1_000_000.0 / Long_Float(rate) );
  begin
    bmp_size:= calc_bmp_size;
    String'Write(s, "RIFF");
    U32'Write(s, file_size);
    String'Write(s, "AVI ");
    String'Write(s, "LIST");
    Write_Intel(first_list_size);
    String'Write(s, "hdrl");
    String'Write(s, "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(s, "LIST");
    Write_Intel(second_list_size);
    String'Write(s, "strl");
    -- Begin of Str
    String'Write(s, "strh");
    Write_Intel(U32'(56));
    String'Write(s, "vids");
    String'Write(s, "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(s, "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(s, "LIST");
    Write_Intel(movie_size);
    String'Write(s, "movi");
  end Write_RIFF_headers;

  procedure Start_capture( AVI_name: String; frame_rate: Positive ) is
    type intPtr is new GL.intPointer;
    Viewport  : array (0 .. 3) of aliased GL.Int;
    function Cvt is new Ada.Unchecked_Conversion(System.Address,intPtr);
    -- This method is functionally identical as GNAT's Unrestricted_Access
    -- but has no type safety (cf GNAT Docs)
    pragma No_Strict_Aliasing(intPtr); -- recommended by GNAT 2005+
  begin
    Create(avi, Out_File, AVI_name);
    frames:= 0;
    rate:= frame_rate;
    GL.GetIntegerv(GL.VIEWPORT, GL.intPointer(Cvt(Viewport(0)'Address)) );
    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_BGR_frame(s,width,height);
    frames:= frames + 1;
  end Capture_frame;

  procedure Stop_capture is
    index_size: constant U32:= U32(frames)*16;
    s: constant Stream_Access:= Stream(avi);
    procedure Write_Intel is new Write_Intel_x86_number( U32, s );
    ChunkOffset: U32:= 4;
  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;
    -- Go back to file beginning...
    Set_Index(avi, 1);
    Write_RIFF_headers; -- rewrite headers with correct data
    Close(avi);
  end Stop_capture;

end GL.IO;

GLOBE_3D: Ada library for real-time 3D rendering. Ada programming.