home *** CD-ROM | disk | FTP | other *** search
/ Cracking 1 / Cracking I..iso / Tools / Ostatní / aPLib v0.26b / examples / ada / apacdemo.adb next >
Encoding:
Text File  |  2001-12-15  |  4.4 KB  |  140 lines
  1. ------------------------------------------------------------------------------
  2. --  File:            apackdemo
  3. --  Description:     aPLib binding demo (Q&D!)
  4. --  Date/version:    9.III.1999
  5. --  Author:          Gautier.deMontmollin@Maths.UniNe.CH
  6. ------------------------------------------------------------------------------
  7.  
  8. with APLib;
  9. with Ada.Command_Line;                  use Ada.Command_Line;
  10. with Ada.Text_IO;                       use Ada.Text_IO;
  11. with Ada.Direct_IO;
  12.  
  13. procedure APack_Demo is
  14.   package IIO is new Integer_IO(integer); use IIO;
  15.  
  16.   type byte is mod 2 ** 8; for byte'size use 8; -- could be any basic data
  17.  
  18.   type t_data_array is array(integer range <>) of byte;
  19.   type p_data_array is access t_data_array;
  20.   
  21.   -- NB: File management is simpler with Ada95 Stream_IO - it's to test...
  22.   
  23.   package DBIO is new Ada.Direct_IO(byte); use DBIO;
  24.   subtype file_of_byte is DBIO.File_type;
  25.  
  26.   procedure Read_file(n: String; d: out p_data_array) is
  27.   f : file_of_byte; b: byte;
  28.   begin
  29.     d:= null;
  30.     Open(f, in_file, n);
  31.     d:= New t_data_array(1..integer(size(f)));
  32.     for i in d'range loop Read(f,b); d(i):= b; end loop;
  33.     Close(f);
  34.   exception
  35.     when DBIO.Name_Error => Put_Line("File " & n & " not found !");
  36.   end;
  37.   
  38.   procedure Write_file(n: String; d: t_data_array) is
  39.   f : file_of_byte;
  40.   begin
  41.     Create(f, out_file, n);
  42.     for i in d'range loop Write(f,d(i)); end loop;
  43.     Close(f);
  44.   end;
  45.  
  46.   procedure Test_pack_unpack(name: string; id: natural) is
  47.     ext1: constant string:= integer'image(id+1000);
  48.     ext:  constant string:= ext1(ext1'last-2..ext1'last); -- 000 001 002 etc.
  49.     name_p:  constant string:= "packed." & ext;
  50.     name_pu: constant string:= "pack_unp." & ext;
  51.   
  52.     frog, frog2, frog3: p_data_array;
  53.     pl, ul: integer; -- packed / unpacked sizes in _bytes_
  54.  
  55.     pack_occur: natural:= 0;
  56.  
  57.     procedure Packometer(u,p: integer; continue: out boolean) is
  58.       li: constant:= 50;
  59.       pli: constant integer:= (p*li)/ul;
  60.       uli: constant integer:= (u*li)/ul;
  61.       fancy_1: constant string:=" .oO";
  62.       fancy_2: constant string:="|/-\";
  63.       fancy: string renames fancy_2; -- choose one...
  64.       begin
  65.         Put("   [");
  66.         for i in 0..pli-1 loop put('='); end loop;
  67.         put(fancy(fancy'first+pack_occur mod fancy'length));
  68.         pack_occur:= pack_occur + 1;
  69.         for i in pli+1..uli loop put('.'); end loop;
  70.         for i in uli+1..li loop put(' '); end loop;
  71.         Put("] " & integer'image((100*p)/u)); Put("%     " & ASCII.CR);
  72.         continue:= true;
  73.       end;
  74.  
  75.     procedure Pack(u: t_data_array; p: out t_data_array; pl: out integer) is
  76.       subtype tu is t_data_array(u'range);
  77.       subtype tp is t_data_array(p'range);
  78.       package aplb is new APLib(tp, tu, Packometer);
  79.   
  80.     begin
  81.       aplb.Pack(u,p,pl);
  82.     end;
  83.   
  84.     procedure Depack(p: t_data_array; u: out t_data_array) is
  85.       subtype tu is t_data_array(u'range);
  86.       subtype tp is t_data_array(p'range);
  87.       package aplb is new APLib(tp, tu, Packometer);
  88.   
  89.     begin
  90.       aplb.Depack(p,u);
  91.     end;
  92.  
  93.   bytes_per_element: constant integer:= byte'size/8;
  94.  
  95.   begin
  96.     New_Line; 
  97.  
  98.     Read_file(name, frog);
  99.  
  100.     if frog /= null then
  101.       ul:= frog.all'size / 8;  -- frog.all is the array; ul= size in bytes
  102.   
  103.       frog2:= New t_data_array(1..(((ul * 9) / 8) + 16) / bytes_per_element);
  104.         -- recommended length
  105.   
  106.       Put_Line("File name: " & name);
  107.       New_Line; 
  108.       Pack(frog.all, frog2.all, pl);
  109.   
  110.       New_Line; 
  111.       Put("Unpacked size:     "); Put(ul); New_Line;
  112.       Put("Packed size:       "); Put(pl); New_Line;
  113.       Put("Compression ratio: "); Put((100*pl)/ul,0); Put_Line("%");
  114.   
  115.       Put_Line("Packed file name: " & name_p);
  116.       Write_file(name_p, frog2(1..pl));
  117.   
  118.       frog3:= New t_data_array(frog'range); -- MUST be the same data!
  119.       Depack(frog2(1..pl), frog3.all);
  120.   
  121.       Put_Line("Packed & unpacked file name: " & name_pu);
  122.       Write_file(name_pu, frog3.all);
  123.     end if;
  124.  
  125.   end Test_pack_unpack;
  126.  
  127. begin
  128.   Put_Line("APack_Demo");
  129.   Put_Line("Command: apacdemo file1 file2 file3 ...");
  130.   Put_Line("When no file, frog.bmp is loaded");
  131.  
  132.   if Argument_count=0 then
  133.     Test_pack_unpack("frog.bmp",0);
  134.   else
  135.     for i in 1..Argument_count loop
  136.       Test_pack_unpack(Argument(i),i);
  137.     end loop;
  138.   end if;
  139. end APack_Demo;
  140.