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.1.3 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