unezwdos.pas

ezw的pascal源码

{
UNEZW.PAS

Unit for Embedded Zero Tree decoding.

Based on "Embedded Image Coding Using Zerotrees of Wavelet Coefficients"
by Jerome M. Shapiro, IEEE Transactions on Signal Processing, Vol.41, No.12,
December 1993, pp 3445-3462.

A fifo is used in the dominant pass which results in a so-called Morton order
scan instead of Shapiro's raster scan (see figure 2 in "Analysis Based Coding
of Image Transform and Subband Coefficients" by V. Ralph Algazi and Robert
R. Estes, Jr.).

Morton order scan:
==================

   1 | 2 |  5   6 | 17  18  21  22
  ---+---|        |
   3 | 4 |  7   8 | 19  20  23  24
  -------+--------|
   9  10 | 13  14 | 25  26  29  30
         |        |
  11  12 | 15  16 | 27  28  31  32
  ----------------+---------------
  33  34   37  38 | 49  50  53  54
                  |
  35  36   39  40 | 51  52  55  56
                  |
  41  42   45  46 | 57  58  61  62
                  |
  43  44   47  48 | 59  60  63  64


Raster scan:
============

   1 | 2 |  5   6 | 17  18  19  20
  ---+---|        |
   3 | 4 |  7   8 | 21  22  23  24
  -------+--------|
   9  10 | 13  14 | 25  26  27  28
         |        |
  11  12 | 15  16 | 29  30  31  32
  ----------------+---------------
  33  34   35  36 | 49  50  51  52
                  |
  37  38   39  40 | 53  54  55  56
                  |
  41  42   43  44 | 57  58  59  60
                  |
  45  46   47  48 | 61  62  63  64


Subband distribution:
=====================

  LL | HL | HL   HL | HL   HL   HL   HL
  ---+--- |         |
  LH | HH | HL   HL | HL   HL   HL   HL
  --------+---------|
  LH   LH | HH   HH | HL   HL   HL   HL
          |         |
  LH   LH | HH   HH | HL   HL   HL   HL
  ------------------+------------------
  LH   LH   LH   LH | HH   HH   HH   HH
                    |
  LH   LH   LH   LH | HH   HH   HH   HH
                    |
  LH   LH   LH   LH | HH   HH   HH   HH
                    |
  LH   LH   LH   LH | HH   HH   HH   HH


C. Valens

Created    : 02/05/1998
Last update: 03/05/1998
}

program unezwdos;

{$define debug}
(*{$define disk}*)

uses
{$ifdef disk}
  matrices, diskfifo, disklist;
{$else}
  matrices, fifo, list;
{$endif}

type
  ezw_file_header = record
    height, width: integer;
    threshold: element_type;
  end;

const
(* Code alphabet. *)
  zero = 0; (* binary 0 *)
  one  = 1; (* binary 1 *)
  ztr  = 2; (* binary 00 *)
  pos  = 3; (* binary 01 *)
  neg  = 4; (* binary 11 *)
  iz   = 5; (* binary 10 *)

var
  M: matrix;
  error: boolean;
  ezw_file: file;
  header: ezw_file_header;
  pixels: longint;
  zeroes, ones: longint;
  input_byte, mask: char;


procedure show_code(code: integer);
begin
  case code of
    zero: Write('0');
    one : Write('1');
    pos : Write('p');
    neg : Write('n');
    ztr : Write('t');
    iz  : Write('i');
  end;
end;

(*
* Reads a bit from the input stream.
*)
function get_bit: char;
var
  bit: char;
begin
  if Ord(mask)=0 then begin
    BlockRead(ezw_file,input_byte,1);
    mask := Chr($80);
  end;

  if (Ord(input_byte) and Ord(mask)=0) then begin
    bit := '0';
    Inc(zeroes);
  end
  else begin
    bit := '1';
    Inc(ones);
  end;

  mask := Chr(Ord(mask) shr 1);
  get_bit := bit;
end;

(*
* Reads a code from the input stream.
*)
function input_code(count: integer): integer;
begin
  case get_bit of
    '0': begin
           if count=1 then input_code := zero
           else begin
             case get_bit of
               '0': input_code := ztr;
               '1': input_code := pos;
             end;
           end;
         end;
    '1': begin
           if count=1 then input_code := one
           else begin
             case get_bit of
               '0': input_code := iz;
               '1': input_code := neg;
             end;
           end;
         end;
  end;
end;

(*
* Builds a matrix element from a dominant pass EZW-element and a threshold.
*)
procedure input_element(m: matrix; t: element_type; var s: ezw_element);
var
  d: list_type;
begin
  d.x := s.x;
  d.y := s.y;
  s.code := input_code(2);
{$ifdef debug}
  show_code(s.code);
{$endif}
  if (s.code=pos) then begin
    put_matrix_element(m,s.y,s.x,t);
    append_to_list(d);
  end
  else if (s.code=neg) then begin
    put_matrix_element(m,s.y,s.x,-t);
    append_to_list(d);
  end;
end;

(*
* Performs one dominant pass.
*)
procedure dominant_pass(m: matrix; threshold: element_type);
var
  s: ezw_element;
  d: list_type;
  min_x, max_x, min_y, max_y: integer;
  level: integer;
begin
  s.x := 0;
  s.y := 0;
  input_element(m,threshold,s);
  if (s.code=pos) or (s.code=neg) then Inc(pixels);

  s.x := 1;
  s.y := 0;
  input_element(m,threshold,s);
  put_in_fifo(s);
  s.x := 0;
  s.y := 1;
  input_element(m,threshold,s);
  put_in_fifo(s);
  s.x := 1;
  s.y := 1;
  input_element(m,threshold,s);
  put_in_fifo(s);

  get_from_fifo(s);
  if fifo_empty=FALSE then begin
    if (s.code=pos) or (s.code=neg) then Inc(pixels);
  end;

  while fifo_empty=FALSE do begin
    if s.code<>ztr then begin
      min_x := s.x shl 1;
      max_x := min_x+1;
      min_y := s.y shl 1;
      max_y := min_y+1;
      if (max_x<=m.c) and (max_y<=m.r) then begin
        for s.y:=min_y to max_y do begin
          for s.x:=min_x to max_x do begin
            input_element(m,threshold,s);
            put_in_fifo(s);
          end;
        end;
      end;
    end;
    get_from_fifo(s);
    if fifo_empty=FALSE then begin
      if (s.code=pos) or (s.code=neg) then Inc(pixels);
    end;
  end;

end;

(*
* Performs one subordinate pass.
*)
procedure subordinate_pass(m: matrix; threshold: element_type);
var
  i: Longint;
  temp: element_type;
  d: list_type;
  found: boolean;
begin
  if threshold>0 then begin
    for i:=0 to pixels-1 do begin
      get_list_element(d,i,found);
      if found=TRUE then begin
        temp := get_matrix_element(m,d.y,d.x);
        if input_code(1)=one then begin
{$ifdef debug}
          show_code(one);
{$endif}
          if temp<0 then begin
            put_matrix_element(m,d.y,d.x,temp-threshold);
          end
          else begin
            put_matrix_element(m,d.y,d.x,temp+threshold);
          end;
        end
{$ifdef debug}
        else show_code(zero);
{$endif}
      end;
    end;
  end;
end;

(*
* EZW-decodes file f into matrix m.
*)
procedure EZW_decode(m: matrix);
var
  threshold: element_type;
begin
  pixels := 0;
  threshold := header.threshold;
  while threshold<>0 do begin
    dominant_pass(m,threshold);
    subordinate_pass(m,threshold shr 1);
    threshold := threshold shr 1;
  end;
end;

(*
* Main.
*)
begin
  Writeln;

  Assign(ezw_file,'out.ezw');
  Reset(ezw_file,1);
  BlockRead(ezw_file,header,SizeOf(header));

  create_matrix(M,header.height,header.width,error);
  if error=TRUE then Exit;
  clear_matrix(M);

  zeroes := 0;
  ones := 0;
  input_byte := Chr(0);
  mask := Chr(0);
  EZW_decode(M);

{$ifdef debug}
  Writeln;
  write_matrix(m);
  Writeln(zeroes+ones,' bits: ',zeroes,' zeroes, ',ones,' ones.');
{$endif}

  Close(ezw_file);
  destroy_matrix(M);
  destroy_fifo;
  destroy_list;
end.