contrib/ada/zlib-streams.adb

   1 ----------------------------------------------------------------
   2 --  ZLib for Ada thick binding.                               --
   3 --                                                            --
   4 --  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
   5 --                                                            --
   6 --  Open source license information is in the zlib.ads file.  --
   7 ----------------------------------------------------------------
   8
   9 --  $Id: zlib-streams.adb,v 1.9 2003/08/12 13:15:31 vagul Exp $
  10
  11 with Ada.Unchecked_Deallocation;
  12
  13 package body ZLib.Streams is
  14
  15    -----------
  16    -- Close --
  17    -----------
  18
  19    procedure Close (Stream : in out Stream_Type) is
  20       procedure Free is new Ada.Unchecked_Deallocation
  21          (Stream_Element_Array, Buffer_Access);
  22    begin
  23       if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
  24          --  We should flush the data written by the writer.
  25
  26          Flush (Stream, Finish);
  27
  28          Close (Stream.Writer);
  29       end if;
  30
  31       if Stream.Mode = In_Stream or Stream.Mode = Duplex then
  32          Close (Stream.Reader);
  33          Free (Stream.Buffer);
  34       end if;
  35    end Close;
  36
  37    ------------
  38    -- Create --
  39    ------------
  40
  41    procedure Create
  42      (Stream            :    out Stream_Type;
  43       Mode              : in     Stream_Mode;
  44       Back              : in     Stream_Access;
  45       Back_Compressed   : in     Boolean;
  46       Level             : in     Compression_Level := Default_Compression;
  47       Strategy          : in     Strategy_Type     := Default_Strategy;
  48       Header            : in     Header_Type       := Default;
  49       Read_Buffer_Size  : in     Ada.Streams.Stream_Element_Offset
  50                                     := Default_Buffer_Size;
  51       Write_Buffer_Size : in     Ada.Streams.Stream_Element_Offset
  52                                     := Default_Buffer_Size)
  53    is
  54
  55       subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
  56
  57       procedure Init_Filter
  58          (Filter   : in out Filter_Type;
  59           Compress : in     Boolean);
  60
  61       -----------------
  62       -- Init_Filter --
  63       -----------------
  64
  65       procedure Init_Filter
  66          (Filter   : in out Filter_Type;
  67           Compress : in     Boolean) is
  68       begin
  69          if Compress then
  70             Deflate_Init
  71               (Filter, Level, Strategy, Header => Header);
  72          else
  73             Inflate_Init (Filter, Header => Header);
  74          end if;
  75       end Init_Filter;
  76
  77    begin
  78       Stream.Back := Back;
  79       Stream.Mode := Mode;
  80
  81       if Mode = Out_Stream or Mode = Duplex then
  82          Init_Filter (Stream.Writer, Back_Compressed);
  83          Stream.Buffer_Size := Write_Buffer_Size;
  84       else
  85          Stream.Buffer_Size := 0;
  86       end if;
  87
  88       if Mode = In_Stream or Mode = Duplex then
  89          Init_Filter (Stream.Reader, not Back_Compressed);
  90
  91          Stream.Buffer     := new Buffer_Subtype;
  92          Stream.Rest_First := Stream.Buffer'Last + 1;
  93       end if;
  94    end Create;
  95
  96    -----------
  97    -- Flush --
  98    -----------
  99
 100    procedure Flush
 101      (Stream : in out Stream_Type;
 102       Mode   : in     Flush_Mode := Sync_Flush)
 103    is
 104       Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
 105       Last   : Stream_Element_Offset;
 106    begin
 107       loop
 108          Flush (Stream.Writer, Buffer, Last, Mode);
 109
 110          Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
 111
 112          exit when Last < Buffer'Last;
 113       end loop;
 114    end Flush;
 115
 116    ----------
 117    -- Read --
 118    ----------
 119
 120    procedure Read
 121      (Stream : in out Stream_Type;
 122       Item   :    out Stream_Element_Array;
 123       Last   :    out Stream_Element_Offset)
 124    is
 125
 126       procedure Read
 127         (Item : out Stream_Element_Array;
 128          Last : out Stream_Element_Offset);
 129
 130       ----------
 131       -- Read --
 132       ----------
 133
 134       procedure Read
 135         (Item : out Stream_Element_Array;
 136          Last : out Stream_Element_Offset) is
 137       begin
 138          Ada.Streams.Read (Stream.Back.all, Item, Last);
 139       end Read;
 140
 141       procedure Read is new ZLib.Read
 142          (Read       => Read,
 143           Buffer     => Stream.Buffer.all,
 144           Rest_First => Stream.Rest_First,
 145           Rest_Last  => Stream.Rest_Last);
 146
 147    begin
 148       Read (Stream.Reader, Item, Last);
 149    end Read;
 150
 151    -------------------
 152    -- Read_Total_In --
 153    -------------------
 154
 155    function Read_Total_In (Stream : in Stream_Type) return Count is
 156    begin
 157       return Total_In (Stream.Reader);
 158    end Read_Total_In;
 159
 160    --------------------
 161    -- Read_Total_Out --
 162    --------------------
 163
 164    function Read_Total_Out (Stream : in Stream_Type) return Count is
 165    begin
 166       return Total_Out (Stream.Reader);
 167    end Read_Total_Out;
 168
 169    -----------
 170    -- Write --
 171    -----------
 172
 173    procedure Write
 174      (Stream : in out Stream_Type;
 175       Item   : in     Stream_Element_Array)
 176    is
 177
 178       procedure Write (Item : in Stream_Element_Array);
 179
 180       -----------
 181       -- Write --
 182       -----------
 183
 184       procedure Write (Item : in Stream_Element_Array) is
 185       begin
 186          Ada.Streams.Write (Stream.Back.all, Item);
 187       end Write;
 188
 189       procedure Write is new ZLib.Write
 190          (Write       => Write,
 191           Buffer_Size => Stream.Buffer_Size);
 192
 193    begin
 194       Write (Stream.Writer, Item, No_Flush);
 195    end Write;
 196
 197    --------------------
 198    -- Write_Total_In --
 199    --------------------
 200
 201    function Write_Total_In (Stream : in Stream_Type) return Count is
 202    begin
 203       return Total_In (Stream.Writer);
 204    end Write_Total_In;
 205
 206    ---------------------
 207    -- Write_Total_Out --
 208    ---------------------
 209
 210    function Write_Total_Out (Stream : in Stream_Type) return Count is
 211    begin
 212       return Total_Out (Stream.Writer);
 213    end Write_Total_Out;
 214
 215 end ZLib.Streams;