Back to...

   1  --  Standalone, command-line, LZMA encoder (for .lzma files).
   2  
   3  with LZMA.Encoding;
   4  
   5  with Ada.Command_Line,
   6       Ada.Text_IO,
   7       Ada.Streams.Stream_IO;
   8  
   9  procedure LZMA_Enc is
  10  
  11    use LZMA, LZMA.Encoding;
  12  
  13    level                 : Compression_Level           := Level_3;
  14    literal_context_bits  : Literal_Context_Bits_Range  := 3;
  15    literal_position_bits : Literal_Position_Bits_Range := 0;
  16    position_bits         : Position_Bits_Range         := 2;
  17  
  18    procedure Encode_LZMA_Stream (s_in, s_out : Ada.Streams.Stream_IO.Stream_Access) is
  19      EOS : Boolean := False;
  20      mem_b : Byte := Character'Pos ('X');  --  delayed by 1 byte to catch the EOS (End-Of-Stream)
  21  
  22      --  NB: The Byte I/O below is not buffered, so it is very slow.
  23      --  You need to implement a circular buffer of type Stream_Element_Array for a fast I/O.
  24      --  For instance, see the BlockRead in the Zip package for how to do it.
  25  
  26      function Read_Byte return Byte is  --  One dummy call to Read_byte is needed before compression
  27        prev_b : Byte;
  28      begin
  29        prev_b := mem_b;
  30        Byte'Read (s_in, mem_b);
  31        return prev_b;
  32      exception
  33        when Ada.Streams.Stream_IO.End_Error =>
  34          EOS := True;
  35          return prev_b;
  36      end Read_Byte;
  37  
  38      function More_Bytes return Boolean is
  39      begin
  40        return not EOS;
  41      end More_Bytes;
  42  
  43      procedure Put_Byte (b : Byte) is
  44      begin
  45        Byte'Write (s_out, b);
  46      end Put_Byte;
  47  
  48      procedure LZMA_Encode is new LZMA.Encoding.Encode (Read_Byte, More_Bytes, Put_Byte);
  49  
  50      dummy : Byte := Read_Byte;  --  Consume the initial 'X'
  51  
  52    begin
  53      --  Whole processing is done here:
  54      LZMA_Encode
  55        (level,
  56         literal_context_bits,
  57         literal_position_bits,
  58         position_bits,
  59         dictionary_size => 2**20,
  60         uncompressed_size_info => True);
  61    end Encode_LZMA_Stream;
  62  
  63    use Ada.Streams.Stream_IO;
  64  
  65    f_in, f_out : File_Type;
  66  
  67    use Ada.Text_IO;
  68  
  69    procedure Print_Data_Bytes_Count (title : String; v : Data_Bytes_Count) is
  70      package CIO is new Integer_IO (Data_Bytes_Count);
  71    begin
  72      Put (title);
  73      Put (" : ");
  74      CIO.Put (v, 0);
  75      Put (" bytes");
  76      New_Line;
  77    end Print_Data_Bytes_Count;
  78  
  79    bench : Boolean := False;
  80    z : constant := Character'Pos ('0');
  81  
  82     use Ada.Command_Line;
  83  
  84  begin
  85    New_Line;
  86    Put_Line ("LZMA_Enc: a standalone LZMA encoder.");
  87    if Argument_Count = 0 then
  88      Put_Line ("Use: lzma_enc infile outfile [options]");
  89      New_Line;
  90      Put_Line ("NB: - The "".lzma"" extension is automatically added to outfile.");
  91      Put_Line ("    - The I/O is not buffered => may be slow. Use the ZipAda tool for fast I/O.");
  92      New_Line;
  93      Put_Line ("Options: -b: benchmark LZ77's and the context parameters (900 .lzma output files!)");
  94      New_Line;
  95      Put ("Press Return");
  96      Skip_Line;
  97      return;
  98    elsif Argument_Count < 2 then
  99      Put_Line ("You must specify at least two parameters");
 100      return;
 101    end if;
 102    for i in 3 .. Argument_Count loop
 103      bench := bench or Argument (i) = "-b";
 104    end loop;
 105    if bench then
 106      for lc in reverse Literal_Context_Bits_Range loop
 107        for lp in reverse Literal_Position_Bits_Range loop
 108          for pb in reverse Position_Bits_Range loop
 109            for lv in Level_0 .. Level_3 loop
 110              Open (f_in, In_File, Argument (1));
 111              Create (f_out, Out_File,
 112                Argument (2) & '_' &
 113                Character'Val (z + lc) & Character'Val (z + lp) & Character'Val (z + pb) &
 114                "_l" &
 115                Character'Val (z + Compression_Level'Pos (lv)) & ".lzma"
 116              );
 117              literal_context_bits  := lc;
 118              literal_position_bits := lp;
 119              position_bits         := pb;
 120              level                 := lv;
 121              Encode_LZMA_Stream (Stream (f_in), Stream (f_out));
 122              Close (f_in);
 123              Close (f_out);
 124            end loop;
 125          end loop;
 126        end loop;
 127      end loop;
 128    else
 129      Open (f_in, In_File, Argument (1));
 130      Create (f_out, Out_File, Argument (2) & ".lzma");
 131      Encode_LZMA_Stream (Stream (f_in), Stream (f_out));
 132      New_Line;
 133      Print_Data_Bytes_Count ("Read    ", Data_Bytes_Count (Index (f_in) - 1));
 134      Print_Data_Bytes_Count ("Written ", Data_Bytes_Count (Index (f_out) - 1));
 135      Close (f_in);
 136      Close (f_out);
 137    end if;
 138  
 139  end LZMA_Enc;