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
 11with Ada.Unchecked_Deallocation;
 12
 13package 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
225end ZLib.Streams;