contrib/ada/zlib-streams.adb

----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $

with Ada.Unchecked_Deallocation;

package body ZLib.Streams is

   -----------
   -- Close --
   -----------

   procedure Close (Stream : in out Stream_Type) is
      procedure Free is new Ada.Unchecked_Deallocation
         (Stream_Element_Array, Buffer_Access);
   begin
      if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
         --  We should flush the data written by the writer.

         Flush (Stream, Finish);

         Close (Stream.Writer);
      end if;

      if Stream.Mode = In_Stream or Stream.Mode = Duplex then
         Close (Stream.Reader);
         Free (Stream.Buffer);
      end if;
   end Close;

   ------------
   -- Create --
   ------------

   procedure Create
     (Stream            :    out Stream_Type;
      Mode              : in     Stream_Mode;
      Back              : in     Stream_Access;
      Back_Compressed   : in     Boolean;
      Level             : in     Compression_Level := Default_Compression;
      Strategy          : in     Strategy_Type     := Default_Strategy;
      Header            : in     Header_Type       := Default;
      Read_Buffer_Size  : in     Ada.Streams.Stream_Element_Offset
                                    := Default_Buffer_Size;
      Write_Buffer_Size : in     Ada.Streams.Stream_Element_Offset
                                    := Default_Buffer_Size)
   is

      subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);

      procedure Init_Filter
         (Filter   : in out Filter_Type;
          Compress : in     Boolean);

      -----------------
      -- Init_Filter --
      -----------------

      procedure Init_Filter
         (Filter   : in out Filter_Type;
          Compress : in     Boolean) is
      begin
         if Compress then
            Deflate_Init
              (Filter, Level, Strategy, Header => Header);
         else
            Inflate_Init (Filter, Header => Header);
         end if;
      end Init_Filter;

   begin
      Stream.Back := Back;
      Stream.Mode := Mode;

      if Mode = Out_Stream or Mode = Duplex then
         Init_Filter (Stream.Writer, Back_Compressed);
         Stream.Buffer_Size := Write_Buffer_Size;
      else
         Stream.Buffer_Size := 0;
      end if;

      if Mode = In_Stream or Mode = Duplex then
         Init_Filter (Stream.Reader, not Back_Compressed);

         Stream.Buffer     := new Buffer_Subtype;
         Stream.Rest_First := Stream.Buffer'Last + 1;
         Stream.Rest_Last  := Stream.Buffer'Last;
      end if;
   end Create;

   -----------
   -- Flush --
   -----------

   procedure Flush
     (Stream : in out Stream_Type;
      Mode   : in     Flush_Mode := Sync_Flush)
   is
      Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
      Last   : Stream_Element_Offset;
   begin
      loop
         Flush (Stream.Writer, Buffer, Last, Mode);

         Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));

         exit when Last < Buffer'Last;
      end loop;
   end Flush;

   -------------
   -- Is_Open --
   -------------

   function Is_Open (Stream : Stream_Type) return Boolean is
   begin
      return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
   end Is_Open;

   ----------
   -- Read --
   ----------

   procedure Read
     (Stream : in out Stream_Type;
      Item   :    out Stream_Element_Array;
      Last   :    out Stream_Element_Offset)
   is

      procedure Read
        (Item : out Stream_Element_Array;
         Last : out Stream_Element_Offset);

      ----------
      -- Read --
      ----------

      procedure Read
        (Item : out Stream_Element_Array;
         Last : out Stream_Element_Offset) is
      begin
         Ada.Streams.Read (Stream.Back.all, Item, Last);
      end Read;

      procedure Read is new ZLib.Read
         (Read       => Read,
          Buffer     => Stream.Buffer.all,
          Rest_First => Stream.Rest_First,
          Rest_Last  => Stream.Rest_Last);

   begin
      Read (Stream.Reader, Item, Last);
   end Read;

   -------------------
   -- Read_Total_In --
   -------------------

   function Read_Total_In (Stream : in Stream_Type) return Count is
   begin
      return Total_In (Stream.Reader);
   end Read_Total_In;

   --------------------
   -- Read_Total_Out --
   --------------------

   function Read_Total_Out (Stream : in Stream_Type) return Count is
   begin
      return Total_Out (Stream.Reader);
   end Read_Total_Out;

   -----------
   -- Write --
   -----------

   procedure Write
     (Stream : in out Stream_Type;
      Item   : in     Stream_Element_Array)
   is

      procedure Write (Item : in Stream_Element_Array);

      -----------
      -- Write --
      -----------

      procedure Write (Item : in Stream_Element_Array) is
      begin
         Ada.Streams.Write (Stream.Back.all, Item);
      end Write;

      procedure Write is new ZLib.Write
         (Write       => Write,
          Buffer_Size => Stream.Buffer_Size);

   begin
      Write (Stream.Writer, Item, No_Flush);
   end Write;

   --------------------
   -- Write_Total_In --
   --------------------

   function Write_Total_In (Stream : in Stream_Type) return Count is
   begin
      return Total_In (Stream.Writer);
   end Write_Total_In;

   ---------------------
   -- Write_Total_Out --
   ---------------------

   function Write_Total_Out (Stream : in Stream_Type) return Count is
   begin
      return Total_Out (Stream.Writer);
   end Write_Total_Out;

end ZLib.Streams;
Revision:	1096
Committed:	Sat Dec 30 14:40:33 2017 UTC (7 years, 9 months ago) by s10k
File size:	5996 byte(s)
Log Message:	Added zlib, quazip, basicxmlsyntaxhighlighter, conditionalsemaphore and linenumberdisplay libraries. zlib and quazip are pre-compiled, but you can compile them yourself, just delete the dll files (or equivalent binary files to your OS)
#	Content
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;