unit filterPyramid;
(* ***** 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
  TFilterPyramid = class(TFilter)
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Run(); override;
  private
    parameterImageIn : TParameterImage;
    parameterImageOuts : TParameterImages;
    parameterLimit : TParameterInteger ;
    imageOuts : ArrayOfPBitmap32;
    procedure DownResolutionBy4(aImage : PBitmap32 ; var  imgOut: PBitmap32) ;
    procedure destroyImageOuts();
    procedure _run();
  end;

implementation

uses
  imageIO, Math;

constructor TFilterPyramid.Create;
begin
  inherited;
  parameterImageIn:=addParameterImage('inImage', 'input image');
  parameterImageOuts:=addOutputParameterImages('outImages', 'outImages');
  parameterLimit := addParameterInteger('limit', 'width or height limit of images', 1, 10000, 8) ;
  SetLength(imageOuts, 1);
end;

destructor TFilterPyramid.Destroy;
begin
  destroyImageOuts();
  inherited;
end;

procedure TFilterPyramid.run();
begin
  if (parameterImageIn.Image<>nil) then begin
    if imageOuts[0] <> nil then begin
      if (parameterImageIn.Image.Width <> imageOuts[0].Width) or
         (parameterImageIn.Image.Height <> imageOuts[0].Height) then begin
           destroyImageOuts();
      end;
    end;
    if imageOuts[0] = nil then begin
      imageOuts[0] := createImageFromImage(parameterImageIn.Image) ;
    end else Begin
      copyImageToImage(parameterImageIn.Image,imageOuts[0]) ;
    End ;
    _run();
  end;
end;

procedure TFilterPyramid.destroyImageOuts();
var
  i : Integer;
begin
  for i:=Low(imageOuts) to High(imageOuts) do begin
    image.freeImage(imageOuts[i]);
  end;
end;

procedure TFilterPyramid.DownResolutionBy4(aImage : PBitmap32 ; var  imgOut: PBitmap32) ;
Var
  newWidth : Integer ;
  newHeight : Integer ;
  x, y : Integer ;
  pSrc, pSrc2, PDest : PColor32Array;
  sommeR, sommeG, sommeB : Cardinal ;
Begin
  newWidth := aImage.Width div 2 ;
  newHeight := aImage.Height div 2 ;
  if imgOut=nil then Begin
    imgOut := createImage(newWidth, newHeight);
  End ;
  for Y:=0 to newHeight-1 do Begin
    pSrc := scanLine(aImage, y*2) ;
    pSrc2 := scanLine(aImage, y*2+1) ;
    pDest := scanLine(imgOut, y) ;
    for x:= 0 to newWidth-1 do Begin
      sommeR := (pSrc^[0] shr 16) and $FF ;
      sommeG := (pSrc^[0] shr 8) and $FF ;
      sommeB := pSrc^[0] and $FF ;
      inc(sommeR, (pSrc2^[0] shr 16) and $FF) ;
      inc(sommeG, (pSrc2^[0] shr 8) and $FF) ;
      inc(sommeB, pSrc2^[0] and $FF) ;
      inc(pSrc) ;
      inc(pSrc2) ;
      inc(sommeR, (pSrc^[0] shr 16) and $FF) ;
      inc(sommeG, (pSrc^[0] shr 8) and $FF) ;
      inc(sommeB, pSrc^[0] and $FF) ;
      inc(sommeR, (pSrc2^[0] shr 16) and $FF) ;
      inc(sommeG, (pSrc2^[0] shr 8) and $FF) ;
      inc(sommeB, pSrc2^[0] and $FF) ;
      inc(pSrc) ;
      inc(pSrc2) ;
      sommeR := sommeR div 4 ;
      sommeG := sommeG div 4 ;
      sommeB := sommeB div 4 ;
      pDest^[0] := (sommeR shl 16) or (sommeG shl 8) or sommeB ;
      inc(pDest) ;
    End ;
  end ;
//  Result := imgResult ;
End ;

procedure TFilterPyramid._Run();
var
  index : Byte ;
  limit : Integer ;
begin
  limit := parameterLimit.Value ;
  index := 0 ;
  while (imageOuts[index].Width >= limit) and (imageOuts[index].Height >=limit) do Begin
    inc(index) ;
    if index+1 > length(imageOuts) then
      SetLength(imageOuts, index+1);
    DownResolutionBy4(imageOuts[index-1], imageOuts[index]) ;
  End ;
  SetLength(imageOuts, index+1);
  setOutputParameterImages('outImages', imageOuts);
end;

end.