Add initial prototype.
This commit is contained in:
Rod Kay
367
3-mid/opengl/private/gid/gid-decoding_png-huffman.adb
Normal file
367
3-mid/opengl/private/gid/gid-decoding_png-huffman.adb
Normal file
@@ -0,0 +1,367 @@
|
||||
with Ada.Text_IO;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body GID.Decoding_PNG.Huffman is
|
||||
|
||||
procedure Build(t: out Huff_tree; descr: in Huff_descriptor) is
|
||||
curr, alloc: Natural;
|
||||
code, mask: Unsigned_32;
|
||||
begin
|
||||
alloc:= root;
|
||||
for i in descr'Range loop
|
||||
if descr(i).length > 0 then
|
||||
curr:= root;
|
||||
code:= Unsigned_32(descr(i).code);
|
||||
mask:= Shift_Left(Unsigned_32'(1), descr(i).length-1);
|
||||
for j in 0..descr(i).length-1 loop
|
||||
if (code and mask) /= 0 then
|
||||
if t.node(curr).one = nil then
|
||||
alloc:= alloc + 1;
|
||||
t.node(curr).one:= alloc;
|
||||
end if;
|
||||
curr:= t.node(curr).one;
|
||||
else
|
||||
if t.node(curr).zero = nil then
|
||||
alloc:= alloc + 1;
|
||||
t.node(curr).zero:= alloc;
|
||||
end if;
|
||||
curr:= t.node(curr).zero;
|
||||
end if;
|
||||
mask:= Shift_Right(mask, 1);
|
||||
end loop;
|
||||
t.node(curr).n:= i;
|
||||
end if;
|
||||
end loop;
|
||||
t.last:= alloc;
|
||||
end Build;
|
||||
|
||||
-- Free huffman tables starting with table where t points to
|
||||
|
||||
procedure HufT_free ( tl: in out p_Table_list ) is
|
||||
|
||||
procedure Dispose is new
|
||||
Ada.Unchecked_Deallocation( HufT_table, p_HufT_table );
|
||||
procedure Dispose is new
|
||||
Ada.Unchecked_Deallocation( Table_list, p_Table_list );
|
||||
|
||||
current: p_Table_list;
|
||||
tcount : Natural; -- just a stat. Idea: replace table_list with an array
|
||||
tot_length: Natural;
|
||||
|
||||
begin
|
||||
if full_trace then
|
||||
Ada.Text_IO.Put("[HufT_Free... ");
|
||||
tcount:= 0;
|
||||
tot_length:= 0;
|
||||
end if;
|
||||
while tl /= null loop
|
||||
if full_trace then
|
||||
tcount:= tcount+1;
|
||||
tot_length:= tot_length + tl.table'Length;
|
||||
end if;
|
||||
Dispose( tl.table ); -- destroy the Huffman table
|
||||
current:= tl;
|
||||
tl := tl.next;
|
||||
Dispose( current ); -- destroy the current node
|
||||
end loop;
|
||||
if full_trace then
|
||||
Ada.Text_IO.Put_Line(
|
||||
Integer'Image(tcount)& " tables, of" &
|
||||
Integer'Image(tot_length)& " tot. length]"
|
||||
);
|
||||
end if;
|
||||
end HufT_free;
|
||||
|
||||
-- Build huffman table from code lengths given by array b
|
||||
|
||||
procedure HufT_build ( b : Length_array;
|
||||
s : Integer;
|
||||
d, e : Length_array;
|
||||
tl : out p_Table_list;
|
||||
m : in out Integer;
|
||||
huft_incomplete : out Boolean)
|
||||
is
|
||||
b_max : constant:= 16;
|
||||
b_maxp1: constant:= b_max + 1;
|
||||
|
||||
-- bit length count table
|
||||
count : array( 0 .. b_maxp1 ) of Integer:= (others=> 0);
|
||||
|
||||
f : Integer; -- i repeats in table every f entries
|
||||
g : Integer; -- max. code length
|
||||
i, -- counter, current code
|
||||
j : Integer; -- counter
|
||||
kcc : Integer; -- number of bits in current code
|
||||
|
||||
c_idx, v_idx: Natural; -- array indices
|
||||
|
||||
current_table_ptr : p_HufT_table:= null;
|
||||
current_node_ptr : p_Table_list:= null; -- curr. node for the curr. table
|
||||
new_node_ptr : p_Table_list; -- new node for the new table
|
||||
|
||||
new_entry: HufT; -- table entry for structure assignment
|
||||
|
||||
u : array( 0..b_max ) of p_HufT_table; -- table stack
|
||||
|
||||
n_max : constant:= 288;
|
||||
-- values in order of bit length
|
||||
v : array( 0..n_max ) of Integer:= (others=> 0);
|
||||
el_v, el_v_m_s: Integer;
|
||||
|
||||
w : Natural:= 0; -- bits before this table
|
||||
|
||||
offset, code_stack : array( 0..b_maxp1 ) of Integer;
|
||||
|
||||
table_level : Integer:= -1;
|
||||
bits : array( Integer'(-1)..b_maxp1 ) of Integer;
|
||||
-- ^bits(table_level) = # bits in table of level table_level
|
||||
|
||||
y : Integer; -- number of dummy codes added
|
||||
z : Natural:= 0; -- number of entries in current table
|
||||
el : Integer; -- length of eob code=code 256
|
||||
|
||||
no_copy_length_array: constant Boolean:= d'Length=0 or e'Length=0;
|
||||
|
||||
begin
|
||||
if full_trace then
|
||||
Ada.Text_IO.Put("[HufT_Build...");
|
||||
end if;
|
||||
tl:= null;
|
||||
|
||||
if b'Length > 256 then -- set length of EOB code, if any
|
||||
el := b(256);
|
||||
else
|
||||
el := b_max;
|
||||
end if;
|
||||
|
||||
-- Generate counts for each bit length
|
||||
|
||||
for k in b'Range loop
|
||||
if b(k) > b_max then
|
||||
-- m := 0; -- GNAT 2005 doesn't like it (warning).
|
||||
raise huft_error;
|
||||
end if;
|
||||
count( b(k) ):= count( b(k) ) + 1;
|
||||
end loop;
|
||||
|
||||
if count(0) = b'Length then
|
||||
m := 0;
|
||||
huft_incomplete:= False; -- spotted by Tucker Taft, 19-Aug-2004
|
||||
return; -- complete
|
||||
end if;
|
||||
|
||||
-- Find minimum and maximum length, bound m by those
|
||||
|
||||
j := 1;
|
||||
while j <= b_max and then count(j) = 0 loop
|
||||
j:= j + 1;
|
||||
end loop;
|
||||
kcc := j;
|
||||
if m < j then
|
||||
m := j;
|
||||
end if;
|
||||
i := b_max;
|
||||
while i > 0 and then count(i) = 0 loop
|
||||
i:= i - 1;
|
||||
end loop;
|
||||
g := i;
|
||||
if m > i then
|
||||
m := i;
|
||||
end if;
|
||||
|
||||
-- Adjust last length count to fill out codes, if needed
|
||||
|
||||
y := Integer( Shift_Left(Unsigned_32'(1), j) ); -- y:= 2 ** j;
|
||||
while j < i loop
|
||||
y := y - count(j);
|
||||
if y < 0 then
|
||||
raise huft_error;
|
||||
end if;
|
||||
y:= y * 2;
|
||||
j:= j + 1;
|
||||
end loop;
|
||||
|
||||
y:= y - count(i);
|
||||
if y < 0 then
|
||||
raise huft_error;
|
||||
end if;
|
||||
count(i):= count(i) + y;
|
||||
|
||||
-- Generate starting offsets into the value table for each length
|
||||
|
||||
offset(1) := 0;
|
||||
j:= 0;
|
||||
for idx in 2..i loop
|
||||
j:= j + count( idx-1 );
|
||||
offset( idx ) := j;
|
||||
end loop;
|
||||
|
||||
-- Make table of values in order of bit length
|
||||
|
||||
for idx in b'Range loop
|
||||
j := b(idx);
|
||||
if j /= 0 then
|
||||
v( offset(j) ) := idx-b'First;
|
||||
offset(j):= offset(j) + 1;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Generate huffman codes and for each, make the table entries
|
||||
|
||||
code_stack(0) := 0;
|
||||
i := 0;
|
||||
v_idx:= v'First;
|
||||
bits(-1) := 0;
|
||||
|
||||
-- go through the bit lengths (kcc already is bits in shortest code)
|
||||
for k in kcc .. g loop
|
||||
|
||||
for am1 in reverse 0 .. count(k)-1 loop -- a counts codes of length k
|
||||
|
||||
-- here i is the huffman code of length k bits for value v(v_idx)
|
||||
while k > w + bits(table_level) loop
|
||||
|
||||
w:= w + bits(table_level); -- Length of tables to this position
|
||||
table_level:= table_level+ 1;
|
||||
z:= g - w; -- Compute min size table <= m bits
|
||||
if z > m then
|
||||
z := m;
|
||||
end if;
|
||||
j := k - w;
|
||||
f := Integer(Shift_Left(Unsigned_32'(1), j)); -- f:= 2 ** j;
|
||||
if f > am1 + 2 then -- Try a k-w bit table
|
||||
f:= f - (am1 + 2);
|
||||
c_idx:= k;
|
||||
loop -- Try smaller tables up to z bits
|
||||
j:= j + 1;
|
||||
exit when j >= z;
|
||||
f := f * 2;
|
||||
c_idx:= c_idx + 1;
|
||||
exit when f - count(c_idx) <= 0;
|
||||
f:= f - count(c_idx);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
if w + j > el and then w < el then
|
||||
j:= el - w; -- Make EOB code end at table
|
||||
end if;
|
||||
if w = 0 then
|
||||
j := m; -- Fix: main table always m bits!
|
||||
end if;
|
||||
z:= Integer(Shift_Left(Unsigned_32'(1), j)); -- z:= 2 ** j;
|
||||
bits(table_level) := j;
|
||||
|
||||
-- Allocate and link new table
|
||||
|
||||
begin
|
||||
current_table_ptr := new HufT_table ( 0..z );
|
||||
new_node_ptr := new Table_list'( current_table_ptr, null );
|
||||
exception
|
||||
when Storage_Error =>
|
||||
raise huft_out_of_memory;
|
||||
end;
|
||||
|
||||
if current_node_ptr = null then -- first table
|
||||
tl:= new_node_ptr;
|
||||
else
|
||||
current_node_ptr.next:= new_node_ptr; -- not my first...
|
||||
end if;
|
||||
|
||||
current_node_ptr:= new_node_ptr; -- always non-Null from there
|
||||
|
||||
u( table_level ):= current_table_ptr;
|
||||
|
||||
-- Connect to last table, if there is one
|
||||
|
||||
if table_level > 0 then
|
||||
code_stack(table_level) := i;
|
||||
new_entry.bits := bits(table_level-1);
|
||||
new_entry.extra_bits := 16 + j;
|
||||
new_entry.next_table := current_table_ptr;
|
||||
|
||||
j := Integer(
|
||||
Shift_Right( Unsigned_32(i) and
|
||||
(Shift_Left(Unsigned_32'(1), w) - 1 ),
|
||||
w - bits(table_level-1) )
|
||||
);
|
||||
|
||||
-- Test against bad input!
|
||||
|
||||
if j > u( table_level - 1 )'Last then
|
||||
raise huft_error;
|
||||
end if;
|
||||
u( table_level - 1 ) (j) := new_entry;
|
||||
end if;
|
||||
|
||||
end loop;
|
||||
|
||||
-- Set up table entry in new_entry
|
||||
|
||||
new_entry.bits := k - w;
|
||||
new_entry.next_table:= null; -- Unused
|
||||
|
||||
if v_idx >= b'Length then
|
||||
new_entry.extra_bits := invalid;
|
||||
else
|
||||
el_v:= v(v_idx);
|
||||
el_v_m_s:= el_v - s;
|
||||
if el_v_m_s < 0 then -- Simple code, raw value
|
||||
if el_v < 256 then
|
||||
new_entry.extra_bits:= 16;
|
||||
else
|
||||
new_entry.extra_bits:= 15;
|
||||
end if;
|
||||
new_entry.n := el_v;
|
||||
else -- Non-simple -> lookup in lists
|
||||
if no_copy_length_array then
|
||||
raise huft_error;
|
||||
end if;
|
||||
new_entry.extra_bits := e( el_v_m_s );
|
||||
new_entry.n := d( el_v_m_s );
|
||||
end if;
|
||||
v_idx:= v_idx + 1;
|
||||
end if;
|
||||
|
||||
-- fill code-like entries with new_entry
|
||||
f := Integer( Shift_Left( Unsigned_32'(1) , k - w ));
|
||||
-- i.e. f := 2 ** (k-w);
|
||||
j := Integer( Shift_Right( Unsigned_32(i), w ) );
|
||||
while j < z loop
|
||||
current_table_ptr(j) := new_entry;
|
||||
j:= j + f;
|
||||
end loop;
|
||||
|
||||
-- backwards increment the k-bit code i
|
||||
j := Integer( Shift_Left( Unsigned_32'(1) , k - 1 ));
|
||||
-- i.e.: j:= 2 ** (k-1)
|
||||
while ( Unsigned_32(i) and Unsigned_32(j) ) /= 0 loop
|
||||
i := Integer( Unsigned_32(i) xor Unsigned_32(j) );
|
||||
j := j / 2;
|
||||
end loop;
|
||||
i := Integer( Unsigned_32(i) xor Unsigned_32(j) );
|
||||
|
||||
-- backup over finished tables
|
||||
while
|
||||
Integer(Unsigned_32(i) and (Shift_Left(1, w)-1)) /=
|
||||
code_stack(table_level)
|
||||
loop
|
||||
table_level:= table_level - 1;
|
||||
w:= w - bits(table_level); -- Size of previous table!
|
||||
end loop;
|
||||
|
||||
end loop; -- am1
|
||||
end loop; -- k
|
||||
|
||||
if full_trace then
|
||||
Ada.Text_IO.Put_Line("finished]");
|
||||
end if;
|
||||
|
||||
huft_incomplete:= y /= 0 and g /= 1;
|
||||
|
||||
exception
|
||||
when others =>
|
||||
HufT_free( tl );
|
||||
raise;
|
||||
end HufT_build;
|
||||
|
||||
end GID.Decoding_PNG.Huffman;
|
||||
Reference in New Issue
Block a user