unit filterWavelets;
(* ***** BEGIN LICENSE BLOCK *****
 * Copyright (C) 2004 Durand Emmanuel
 * Copyright (C) 2004 Burgel Eric
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 * Contact :
 *   filters@edurand.com
 *   filters@burgel.com
 *
 * ***** END LICENSE BLOCK ***** *)

{
 eburgel (filters@burgel.com)
}

interface
uses
  filter, fparameters, image;

type
  TFilterHaar = class(TFilter)
  public
    constructor Create; override;
    procedure Run(); override;
  private
    parameterImageIn, parameterImageOut : TParameterImage;
    parameterInverse : TParameterBoolean ;
    procedure _run();
  end;

implementation

uses
  imageIO, Math;

constructor TFilterHaar.Create;
begin
  inherited;
    parameterImageIn:=addParameterImage('inImage', 'input image to invert');
    parameterImageOut:=addParameterImage('outImage', 'result image of invertion');
    parameterInverse := addParameterBoolean('invert', 'reconstruction', false) ;

end;


procedure TFilterHaar.Run();
begin
  if (parameterImageIn.Image<>nil) and (parameterImageOut.Image<>nil) then begin
    _run();
  end;
end;

	//**
	//* Perform 1 iteration of the wavelet transformation of a 1D vector
	//* using the Haar wavelet transformation.
	//* The output vector has the same size of the input vector and it
	//* contains first the low pass part of the wavelet transform and then
	//* the high pass part of the wavelet transformation.
	//*
(*
procedure split_1D(vin, vout : PColor32Array ; size : integer) ;
var
  n2, d2, x : integer ;
  red1, green1, blue1 : byte ;
  red2, green2, blue2 : byte ;
  red3, green3, blue3 : byte ;
  red4, green4, blue4 : byte ;
  color1, color2 : cardinal ;
Begin
	n2 := size div 2;
	for x:=0 to n2 do Begin
		d2 := x*2 ;
    color1 := vin[d2] ;
    color2 := vin[d2+1] ;

    red1 := (color1 shr 16) and $FF ;
    green1 := (color1 shr 8) and $FF ;
    blue1 := color1 and $FF ;

    red2 := (color2 shr 16) and $FF ;
    green2 := (color2 shr 8) and $FF ;
    blue2 := color2 and $FF ;

    red3 := (red1+red2) div 2 ;
    green3 := (green1+green2) div 2 ;
    blue3 := (blue1+blue2) div 2 ;

    red4 := (red1-red2)+127 ;
    green4 := (green1-green2)+127 ;
    blue4 := (blue1-blue2)+127 ;

		vout[x] := (red3 shl 16) + (green3 shl 8) + blue3 ;
 		vout[n2+x] := (red4 shl 16) + (green4 shl 8) + blue4 ; ;
	end ;
end ;

procedure merge_1D(vin, vout : PColor32Array ; size : integer) ;
var
  n2, d2, x : integer ;
  red1, green1, blue1 : byte ;
  red2, green2, blue2 : byte ;
  red3, green3, blue3 : byte ;
  red4, green4, blue4 : byte ;
  color1, color2 : cardinal ;
Begin
	n2 := size div 2;
	for x:=0 to n2 do Begin
		d2 := x*2 ;
    color1 := vin[x] ;
    color2 := vin[n2+x] ;

    red1 := (color1 shr 16) and $FF ;
    green1 := (color1 shr 8) and $FF ;
    blue1 := color1 and $FF ;

    red2 := ((color2 shr 16) and $FF)-127 ;
    green2 := ((color2 shr 8) and $FF) - 127 ;
    blue2 := (color2 and $FF)-127 ;

    red3 := (red1-red2) ;
    green3 := (green1-green2) ;
    blue3 := (blue1-blue2) ;

    red4 := (red1+red2) ;
    green4 := (green1+green2) ;
    blue4 := (blue1+blue2) ;

		vout[d2] := (red3 shl 16) + (green3 shl 8) + blue3 ;
 		vout[d2+1] := (red4 shl 16) + (green4 shl 8) + blue4 ; ;
	end ;
end ;

*)
procedure split_1D(vin, vout : PColor32Array ; size : integer) ;
var
  n2, d2, x : integer ;
  red1, green1, blue1 : integer ;
  red2, green2, blue2 : integer ;
  red3, green3, blue3 : integer ;
  redDetail, greenDetail, blueDetail : integer ;
  redPrevDetail, greenPrevDetail, bluePrevDetail : integer ;
  color1, color2, color3 : integer ;
  colorSmooth, colorDetail : TColorRec ;
Begin
	n2 := size div 2;

  redPrevDetail := 0 ;
  greenPrevDetail := 0 ;
  bluePrevDetail := 0 ;
	for x:=0 to n2-1 do Begin
		d2 := x*2 ;
    color1 := vin[d2] ;
    color2 := vin[d2+1] ;
    color3 := vin[d2+2] ;

    red1 := (color1 shr 16) and $FF ;
    green1 := (color1 shr 8) and $FF ;
    blue1 := color1 and $FF ;

    red2 := (color2 shr 16) and $FF ;
    green2 := (color2 shr 8) and $FF ;
    blue2 := color2 and $FF ;

    red3 := (color3 shr 16) and $FF ;
    green3 := (color3 shr 8) and $FF ;
    blue3 := color3 and $FF ;

    // detail = Odd-Prediction(Even)
    redDetail := (red2-(red1+red3) div 2) ;
    greenDetail := (green2-(green1+green3) div 2) ;
    blueDetail := (blue2-(blue1+blue3) div 2) ;

    // Smooth = Even+Update(Detail)
    if false then Begin
      colorSmooth.Red := red1 + (redPrevdetail + redDetail) div 4 ;
      colorSmooth.Green := green1 + (greenPrevDetail + greenDetail) div 4 ;
      colorSmooth.Blue := blue1 + (bluePrevDetail + blueDetail) div 4 ;
    end else Begin
      colorSmooth.Red := red1 ;
      colorSmooth.Green := green1 ;
      colorSmooth.Blue := blue1 ;
    End ;

    redPrevDetail := redDetail ;
    greenPrevDetail := greenDetail ;
    bluePrevDetail := greenDetail ;

    colorDetail.Red := (redDetail and $FF) +128 ;
    colorDetail.Green := (greenDetail and $FF) +128 ;
    colorDetail.Blue := (blueDetail and $FF) +128 ;

    vout[x] := TColor32(colorSmooth) ;
    vout[n2+x] := TColor32(ColorDetail)
	end ;
end ;

procedure merge_1D(vin, vout : PColor32Array ; size : integer) ;
var
  n2, d2, x : integer ;
  redEven1, greenEven1, blueEven1 : integer ;
  redEven2, greenEven2, blueEven2 : integer ;
  redOdd, greenOdd, blueOdd : integer ;
  redDetail, greenDetail, blueDetail : integer ;
  redSmooth, greenSmooth, blueSmooth : integer ;
  color1, color2, color3 : integer ;
Begin
	n2 := size div 2;
	for x:=0 to n2-1 do Begin
		d2 := x*2 ;
    color1 := vin[x] ;
    color2 := vin[x+1] ;
    color3 := vin[n2+x] ;

    redSmooth := (color1 shr 16) and $FF ;
    greenSmooth := (color1 shr 8) and $FF ;
    blueSmooth := color1 and $FF ;

    redEven2 := (color2 shr 16) and $FF ;
    greenEven2 := (color2 shr 8) and $FF ;
    blueEven2 := color2 and $FF ;

    redDetail := (color3 shr 16) and $FF ;
    greenDetail := (color3 shr 8) and $FF ;
    blueDetail := color3 and $FF ;

    // Even = Smooth-Update(Detail)
    redEven1 := redSmooth ;
    greenEven1 := greenSmooth ;
    blueEven1 := blueSmooth ;

    // Odd = Prediction(Even) + detail
    redOdd := (redEven1+redEven2) div 2 + redDetail -128;
    greenOdd := (greenEven1+greenEven2) div 2 + greenDetail-128 ;
    blueOdd := (blueEven1+blueEven2) div 2 + blueDetail-128 ;

		vout[d2] := (redEven1 shl 16) + (greenEven1 shl 8) + blueEven1 ;
 		vout[d2+1] := (redOdd shl 16) + (greenOdd shl 8) + blueOdd ;
	end ;
end ;

(*
procedure split_Haar_Vert(vin, vout : PColor32Array ; colHeight, imagewidth : integer) ;
var
  n2, d2, x, increment : integer ;
  red1, green1, blue1 : byte ;
  red2, green2, blue2 : byte ;
  red3, green3, blue3 : byte ;
  red4, green4, blue4 : byte ;
  pColor1, pColor2 : PColor32Array ;
  color1, color2 : TColorRec ;
  vout1, vout2 : PColor32Array ;
Begin
	n2 := colHeight div 2;
  increment := 2*imageWidth ;
  pColor1 := vin ;
  pcolor2 := vin ;
  vout2 := vout ;
  inc(vout2, n2*imagewidth) ;
  inc(pColor2, imageWidth) ;
	for x:=0 to n2 do Begin
    color1 := TColorRec(pColor1^) ;
    color2 := TColorRec(pColor2^) ;

    red1 := color1.Red ;
    green1 := color1.Green ;
    blue1 := color1.Blue ;

    red2 := color2.Red ;
    green2 := color2.Green ;
    blue2 := color2.Blue ;

    red3 := (red1+red2) div 2 ;
    green3 := (green1+green2) div 2 ;
    blue3 := (blue1+blue2) div 2 ;

    red4 := (red1-red2) ;
    green4 := (green1-green2) ;
    blue4 := (blue1-blue2) ;

		vout[0] := (red3 shl 16) + (green3 shl 8) + blue3 ;
 		vout2[0] := (red4 shl 16) + (green4 shl 8) + blue4 ; ;
    inc(pColor1, increment) ;
    inc(pColor2, increment) ;
    inc(vout, imageWidth) ;
    inc(vout2, imageWidth) ;
	end ;
end ;
  *)
//***************************************************************************

	//**
	//* Perform a wavelet transform of the ImageObject calling this
	//* method with n scales.
	//* The size of image should be M = 2^N with N integer and
	//* strictly greatly n (number of scale).
	//* The result is organised in four sub images:
	//*
	//*       -------------------------
	//*       |           |           |
	//*       | Low-Low   | Low-High  |
	//*       |           |           |
	//*       -------------------------
	//*       |           |           |
	//*       | High-Low  | High-High |
	//*       |           |           |
	//*       -------------------------

procedure TFilterHaar._run();
var
  pSrc, PDest : PColor32Array;
  y, maxX, maxY : Integer ;
  imgIn, imgOut : PBitmap32 ;
  inverse : boolean ;
begin
  // Parameters
  imgIn  := parameterImageIn.Image ;
  imgOut := parameterImageOut.Image ;
  inverse := parameterInverse.Value ;

  maxX := scanWidth(imgIn)-1 ;
  maxY := scanHeight(imgIn)-1 ;
  //eraseImage(imgOut);
  for y:=0 to maxY do begin
    pSrc := scanLine(imgIn, y) ;
    pDest := scanLine(imgOut, y) ;
    if inverse then
      merge_1D(pSrc, pDest, maxX+1)
    else
      split_1D(pSrc, pDest, maxX+1) ;
  end ;
(*
  pSrc := scanLine(imgIn, 0) ;
  pDest := scanLine(imgOut, 0) ;
  for x:=0 to maxX do begin
    split_Haar_Vert(pDest, pDest, maxY, imgIn.Width) ;
    inc(pDest) ;
  End ;
*)
end;

end.