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