Back to...

   1  with Ada.Command_Line;                  use Ada.Command_Line;
   2  with Ada.Calendar;                      use Ada.Calendar;
   3  with Ada.Text_IO;                       use Ada.Text_IO;
   4  with Ada.Direct_IO;
   5  
   6  with Interfaces;                        use Interfaces;
   7  
   8  with LZH;
   9  
  10  procedure LZHuf is
  11  
  12    package Byte_IO is new Ada.Direct_IO (Unsigned_8);
  13    use Byte_IO;
  14    package CIO is new Integer_IO (Byte_IO.Count);
  15    package FIO is new Float_IO (Float);
  16  
  17    Infile  : Byte_IO.File_Type;
  18    Outfile : Byte_IO.File_Type;
  19  
  20    Isize, Osize : Byte_IO.Count;
  21  
  22    Dots : constant := 16;
  23    Done_Dots : Natural := 0;
  24    Idot : Byte_IO.Count;
  25  
  26    procedure Display_Progress (Done : Float) is
  27      New_Done_Dots : constant Natural :=
  28        Natural (Float (Dots) * Done);
  29    begin
  30      for I in Done_Dots + 1 .. New_Done_Dots loop
  31        Put ('.');
  32      end loop;
  33      Done_Dots := New_Done_Dots;
  34    end Display_Progress;
  35  
  36    function Read_IO_Byte return Unsigned_8 is
  37    pragma Inline (Read_IO_Byte);
  38      B : Unsigned_8;
  39      I : constant Byte_IO.Count := Index (Infile);
  40    begin
  41      Read (Infile, B);
  42      if I = 1 then
  43        Display_Progress (0.0);
  44      elsif I = Isize then
  45        Display_Progress (1.0);
  46      elsif Idot = 0 or else I mod Idot = 0 then
  47        Display_Progress (Float (I) / Float (Isize));
  48      end if;
  49      return B;
  50    end Read_IO_Byte;
  51  
  52    function File_More_bytes return Boolean is
  53    begin
  54      return not End_Of_File (Infile);
  55    end File_More_bytes;
  56  
  57    procedure Write_IO_Byte (B : Unsigned_8) is
  58    pragma Inline (Write_IO_Byte);
  59    begin
  60      Write (Outfile, B);
  61    end Write_IO_Byte;
  62  
  63    package File_LZH is
  64      new LZH (
  65        Read_byte  => Read_IO_Byte,
  66        More_bytes => File_More_bytes,
  67        Write_byte => Write_IO_Byte
  68      );
  69    use File_LZH;
  70  
  71    type T_Action is (Do_Encode, Do_Decode);
  72    Action : T_Action;
  73  
  74    T0, T1 : Time;
  75    seconds_elapsed : Duration;
  76  
  77  begin
  78    if Argument_Count /= 3 then
  79      Put_Line (
  80        "Usage: lzhuf e(ncode-compress)|d(ecode-decompress) infile outfile");
  81      return;
  82    end if;
  83    declare
  84      S : constant String := Argument (1);
  85    begin
  86      case S (1) is
  87        when 'e' | 'E' => Action := Do_Encode;
  88        when 'd' | 'D' => Action := Do_Decode;
  89        when others =>
  90          Put_Line (
  91            "! Use [d] for decoding-decompression or" &
  92            " [e] for encoding-compression"
  93          );
  94          return;
  95      end case;
  96    end;
  97    Byte_IO.Open (Infile, Byte_IO.In_File, Argument (2));
  98    Isize := Byte_IO.Size (Infile);
  99    Idot := Isize / Dots;
 100    Byte_IO.Create (Outfile, Name => Argument (3));
 101    Put (" In:"); CIO.Put (Isize); Put ("  [");
 102    T0 := Clock;
 103    --
 104    case Action is
 105      when Do_Encode => Encode;
 106      when Do_Decode => Decode;
 107    end case;
 108    --
 109    T1 := Clock;
 110    Byte_IO.Close (Infile);
 111    Osize := Byte_IO.Size (Outfile);
 112    Byte_IO.Close (Outfile);
 113    Put ("] Out:"); CIO.Put (Osize);
 114    if Isize /= 0 and Osize /= 0 then
 115      Put ("  ");
 116      case Action is
 117        when Do_Encode => CIO.Put ((100 * Osize) / Isize, 0);
 118        when Do_Decode => CIO.Put ((100 * Isize) / Osize, 0);
 119      end case;
 120      Put ("%,");
 121    end if;
 122    seconds_elapsed := T1 - T0;
 123    FIO.Put (Float (seconds_elapsed), 4, 2, 0);
 124    Put_Line (" seconds.");
 125  end LZHuf;