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;