Back to...

   1  --  Huffman.Encoding
   2  --------------------
   3  --
   4  --  Legal licensing note:
   5  --
   6  --  Copyright (c) 2024 Gautier de Montmollin (maintainer of the Ada version)
   7  --  SWITZERLAND
   8  --
   9  --  Permission is hereby granted, free of charge, to any person obtaining a copy
  10  --  of this software and associated documentation files (the "Software"), to deal
  11  --  in the Software without restriction, including without limitation the rights
  12  --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  13  --  copies of the Software, and to permit persons to whom the Software is
  14  --  furnished to do so, subject to the following conditions:
  15  --
  16  --  The above copyright notice and this permission notice shall be included in
  17  --  all copies or substantial portions of the Software.
  18  --
  19  --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  20  --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  21  --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  22  --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  23  --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  24  --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  25  --  THE SOFTWARE.
  26  --
  27  --  NB: this is the MIT License, as found 03-Nov-2024 on the site
  28  --  http://www.opensource.org/licenses/mit-license.php
  29  
  30  package body Huffman.Encoding is
  31  
  32    use Interfaces;
  33  
  34    procedure Invert (lc : in out Length_Code_Pair) is
  35      a : Code_Range := lc.code;
  36      b : Code_Range := 0;
  37    begin
  38      for i in 1 .. lc.bit_length loop
  39        b := b * 2 + a mod 2;
  40        a := a / 2;
  41      end loop;
  42      lc.code := b;
  43    end Invert;
  44  
  45    procedure Prepare_Codes
  46      (hd               : in out Descriptor;
  47       max_huffman_bits : in     Positive;
  48       invert_bit_order : in     Boolean)
  49    is
  50      bl_count, next_code : array (0 .. max_huffman_bits) of Code_Range := (others => 0);
  51      code : Code_Range := 0;
  52      bl : Natural;
  53    begin
  54      --  Algorithm from RFC 1951, section 3.2.2.
  55      --  Step 1)
  56      for i in hd'Range loop
  57        bl := hd (i).bit_length;
  58        bl_count (bl) := bl_count (bl) + 1;  --  One more code to be defined with bit length bl
  59      end loop;
  60      --  Step 2)
  61      for bits in 1 .. max_huffman_bits loop
  62        code := (code + bl_count (bits - 1)) * 2;
  63        next_code (bits) := code;  --  This will be the first code for bit length "bits"
  64      end loop;
  65      --  Step 3)
  66      for n in hd'Range loop
  67        bl := hd (n).bit_length;
  68        if bl > 0 then
  69          hd (n).code := next_code (bl);
  70          next_code (bl) := next_code (bl) + 1;
  71        else
  72          hd (n).code := 0;
  73        end if;
  74      end loop;
  75      if invert_bit_order then
  76        for i in hd'Range loop
  77          Invert (hd (i));
  78        end loop;
  79      end if;
  80    end Prepare_Codes;
  81  
  82  end Huffman.Encoding;