common/dist/zlib/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.10 2004/05/31 10:53:40 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          Stream.Rest_Last  := Stream.Buffer'Last;
  94       end if;
  95    end Create;
  96
  97    -----------
  98    -- Flush --
  99    -----------
 100
 101    procedure Flush
 102      (Stream : in out Stream_Type;
 103       Mode   : in     Flush_Mode := Sync_Flush)
 104    is
 105       Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
 106       Last   : Stream_Element_Offset;
 107    begin
 108       loop
 109          Flush (Stream.Writer, Buffer, Last, Mode);
 110
 111          Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
 112
 113          exit when Last < Buffer'Last;
 114       end loop;
 115    end Flush;
 116
 117    -------------
 118    -- Is_Open --
 119    -------------
 120
 121    function Is_Open (Stream : Stream_Type) return Boolean is
 122    begin
 123       return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
 124    end Is_Open;
 125
 126    ----------
 127    -- Read --
 128    ----------
 129
 130    procedure Read
 131      (Stream : in out Stream_Type;
 132       Item   :    out Stream_Element_Array;
 133       Last   :    out Stream_Element_Offset)
 134    is
 135
 136       procedure Read
 137         (Item : out Stream_Element_Array;
 138          Last : out Stream_Element_Offset);
 139
 140       ----------
 141       -- Read --
 142       ----------
 143
 144       procedure Read
 145         (Item : out Stream_Element_Array;
 146          Last : out Stream_Element_Offset) is
 147       begin
 148          Ada.Streams.Read (Stream.Back.all, Item, Last);
 149       end Read;
 150
 151       procedure Read is new ZLib.Read
 152          (Read       => Read,
 153           Buffer     => Stream.Buffer.all,
 154           Rest_First => Stream.Rest_First,
 155           Rest_Last  => Stream.Rest_Last);
 156
 157    begin
 158       Read (Stream.Reader, Item, Last);
 159    end Read;
 160
 161    -------------------
 162    -- Read_Total_In --
 163    -------------------
 164
 165    function Read_Total_In (Stream : in Stream_Type) return Count is
 166    begin
 167       return Total_In (Stream.Reader);
 168    end Read_Total_In;
 169
 170    --------------------
 171    -- Read_Total_Out --
 172    --------------------
 173
 174    function Read_Total_Out (Stream : in Stream_Type) return Count is
 175    begin
 176       return Total_Out (Stream.Reader);
 177    end Read_Total_Out;
 178
 179    -----------
 180    -- Write --
 181    -----------
 182
 183    procedure Write
 184      (Stream : in out Stream_Type;
 185       Item   : in     Stream_Element_Array)
 186    is
 187
 188       procedure Write (Item : in Stream_Element_Array);
 189
 190       -----------
 191       -- Write --
 192       -----------
 193
 194       procedure Write (Item : in Stream_Element_Array) is
 195       begin
 196          Ada.Streams.Write (Stream.Back.all, Item);
 197       end Write;
 198
 199       procedure Write is new ZLib.Write
 200          (Write       => Write,
 201           Buffer_Size => Stream.Buffer_Size);
 202
 203    begin
 204       Write (Stream.Writer, Item, No_Flush);
 205    end Write;
 206
 207    --------------------
 208    -- Write_Total_In --
 209    --------------------
 210
 211    function Write_Total_In (Stream : in Stream_Type) return Count is
 212    begin
 213       return Total_In (Stream.Writer);
 214    end Write_Total_In;
 215
 216    ---------------------
 217    -- Write_Total_Out --
 218    ---------------------
 219
 220    function Write_Total_Out (Stream : in Stream_Type) return Count is
 221    begin
 222       return Total_Out (Stream.Writer);
 223    end Write_Total_Out;
 224
 225 end ZLib.Streams;