read.adb revision 1.1 1 1.1 christos ----------------------------------------------------------------
2 1.1 christos -- ZLib for Ada thick binding. --
3 1.1 christos -- --
4 1.1 christos -- Copyright (C) 2002-2003 Dmitriy Anisimkov --
5 1.1 christos -- --
6 1.1 christos -- Open source license information is in the zlib.ads file. --
7 1.1 christos ----------------------------------------------------------------
8 1.1 christos
9 1.1 christos -- Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp
10 1.1 christos
11 1.1 christos -- Test/demo program for the generic read interface.
12 1.1 christos
13 1.1 christos with Ada.Numerics.Discrete_Random;
14 1.1 christos with Ada.Streams;
15 1.1 christos with Ada.Text_IO;
16 1.1 christos
17 1.1 christos with ZLib;
18 1.1 christos
19 1.1 christos procedure Read is
20 1.1 christos
21 1.1 christos use Ada.Streams;
22 1.1 christos
23 1.1 christos ------------------------------------
24 1.1 christos -- Test configuration parameters --
25 1.1 christos ------------------------------------
26 1.1 christos
27 1.1 christos File_Size : Stream_Element_Offset := 100_000;
28 1.1 christos
29 1.1 christos Continuous : constant Boolean := False;
30 1.1 christos -- If this constant is True, the test would be repeated again and again,
31 1.1 christos -- with increment File_Size for every iteration.
32 1.1 christos
33 1.1 christos Header : constant ZLib.Header_Type := ZLib.Default;
34 1.1 christos -- Do not use Header other than Default in ZLib versions 1.1.4 and older.
35 1.1 christos
36 1.1 christos Init_Random : constant := 8;
37 1.1 christos -- We are using the same random sequence, in case of we catch bug,
38 1.1 christos -- so we would be able to reproduce it.
39 1.1 christos
40 1.1 christos -- End --
41 1.1 christos
42 1.1 christos Pack_Size : Stream_Element_Offset;
43 1.1 christos Offset : Stream_Element_Offset;
44 1.1 christos
45 1.1 christos Filter : ZLib.Filter_Type;
46 1.1 christos
47 1.1 christos subtype Visible_Symbols
48 1.1 christos is Stream_Element range 16#20# .. 16#7E#;
49 1.1 christos
50 1.1 christos package Random_Elements is new
51 1.1 christos Ada.Numerics.Discrete_Random (Visible_Symbols);
52 1.1 christos
53 1.1 christos Gen : Random_Elements.Generator;
54 1.1 christos Period : constant Stream_Element_Offset := 200;
55 1.1 christos -- Period constant variable for random generator not to be very random.
56 1.1 christos -- Bigger period, harder random.
57 1.1 christos
58 1.1 christos Read_Buffer : Stream_Element_Array (1 .. 2048);
59 1.1 christos Read_First : Stream_Element_Offset;
60 1.1 christos Read_Last : Stream_Element_Offset;
61 1.1 christos
62 1.1 christos procedure Reset;
63 1.1 christos
64 1.1 christos procedure Read
65 1.1 christos (Item : out Stream_Element_Array;
66 1.1 christos Last : out Stream_Element_Offset);
67 1.1 christos -- this procedure is for generic instantiation of
68 1.1 christos -- ZLib.Read
69 1.1 christos -- reading data from the File_In.
70 1.1 christos
71 1.1 christos procedure Read is new ZLib.Read
72 1.1 christos (Read,
73 1.1 christos Read_Buffer,
74 1.1 christos Rest_First => Read_First,
75 1.1 christos Rest_Last => Read_Last);
76 1.1 christos
77 1.1 christos ----------
78 1.1 christos -- Read --
79 1.1 christos ----------
80 1.1 christos
81 1.1 christos procedure Read
82 1.1 christos (Item : out Stream_Element_Array;
83 1.1 christos Last : out Stream_Element_Offset) is
84 1.1 christos begin
85 1.1 christos Last := Stream_Element_Offset'Min
86 1.1 christos (Item'Last,
87 1.1 christos Item'First + File_Size - Offset);
88 1.1 christos
89 1.1 christos for J in Item'First .. Last loop
90 1.1 christos if J < Item'First + Period then
91 1.1 christos Item (J) := Random_Elements.Random (Gen);
92 1.1 christos else
93 1.1 christos Item (J) := Item (J - Period);
94 1.1 christos end if;
95 1.1 christos
96 1.1 christos Offset := Offset + 1;
97 1.1 christos end loop;
98 1.1 christos end Read;
99 1.1 christos
100 1.1 christos -----------
101 1.1 christos -- Reset --
102 1.1 christos -----------
103 1.1 christos
104 1.1 christos procedure Reset is
105 1.1 christos begin
106 1.1 christos Random_Elements.Reset (Gen, Init_Random);
107 1.1 christos Pack_Size := 0;
108 1.1 christos Offset := 1;
109 1.1 christos Read_First := Read_Buffer'Last + 1;
110 1.1 christos Read_Last := Read_Buffer'Last;
111 1.1 christos end Reset;
112 1.1 christos
113 1.1 christos begin
114 1.1 christos Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
115 1.1 christos
116 1.1 christos loop
117 1.1 christos for Level in ZLib.Compression_Level'Range loop
118 1.1 christos
119 1.1 christos Ada.Text_IO.Put ("Level ="
120 1.1 christos & ZLib.Compression_Level'Image (Level));
121 1.1 christos
122 1.1 christos -- Deflate using generic instantiation.
123 1.1 christos
124 1.1 christos ZLib.Deflate_Init
125 1.1 christos (Filter,
126 1.1 christos Level,
127 1.1 christos Header => Header);
128 1.1 christos
129 1.1 christos Reset;
130 1.1 christos
131 1.1 christos Ada.Text_IO.Put
132 1.1 christos (Stream_Element_Offset'Image (File_Size) & " ->");
133 1.1 christos
134 1.1 christos loop
135 1.1 christos declare
136 1.1 christos Buffer : Stream_Element_Array (1 .. 1024);
137 1.1 christos Last : Stream_Element_Offset;
138 1.1 christos begin
139 1.1 christos Read (Filter, Buffer, Last);
140 1.1 christos
141 1.1 christos Pack_Size := Pack_Size + Last - Buffer'First + 1;
142 1.1 christos
143 1.1 christos exit when Last < Buffer'Last;
144 1.1 christos end;
145 1.1 christos end loop;
146 1.1 christos
147 1.1 christos Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
148 1.1 christos
149 1.1 christos ZLib.Close (Filter);
150 1.1 christos end loop;
151 1.1 christos
152 1.1 christos exit when not Continuous;
153 1.1 christos
154 1.1 christos File_Size := File_Size + 1;
155 1.1 christos end loop;
156 1.1 christos end Read;
157