source: s10k/CommonLibs/zlib-1.2.8/contrib/ada/zlib-streams.adb@ 1154

Last change on this file since 1154 was 1096, checked in by s10k, 7 years ago

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)

File size: 5.9 KB
RevLine 
[1096]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;
Note: See TracBrowser for help on using the repository browser.