unit filterMorphology;
(* ***** 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 ***** *)

{
 edurand (filters@edurand.com)
}

interface
uses
  filter, fparameters, image, SysUtils, filterArithmeticSubstract, filterArithmeticAdd;

type
  TFilterMorphology = class(TFilter)
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Run(); override;
    procedure setParameterImage( const aName: String; const aImage: PBitmap32); override;
  private
    parameterIteration : TParameterInteger;
    parameterImageIn, parameterImageOut : TParameterImage;
    parameterSE : TParameterImage;
    parameterType : TParameterString ;
    image1, image2, image3, image4 : PBitmap32;
    filterArithmeticSubstract : TFilterArithmeticSubstract;
    filterArithmeticAdd : TFilterArithmeticAdd;
    SE, defaultSE : PBitmap32;
    procedure erode(aImageIn, aImageOut : PBitmap32);
    procedure dilate(aImageIn, aImageOut : PBitmap32);
    procedure substract(aImageIn1, aImageIn2, aImageOut : PBitmap32);
    procedure add(aImageIn1, aImageIn2, aImageOut : PBitmap32);
    procedure destroyImages;
  end;

implementation
uses
  imageIO, Math;

constructor TFilterMorphology.Create;
begin
  inherited;
  parameterImageIn := addParameterImage( 'inImage', 'input image' );
  parameterImageOut := addParameterImage( 'outImage', 'output image' );
  parameterSE := addParameterImage( 'structuredElementImage', 'the structured element to use (a image with white pixel inside the structured element, and other pixels to black). By default the SE is a disk of size 3*3.' );
  parameterIteration := addParameterInteger( 'iteration', '', 0, 100, 1 );
  parameterType := addParameterString( 'type', 'ERODE/DILATE/OPEN/CLOSE/BLACK_TOP_HAT/WHITE_TOP_HAT/GRADIENT_BY_EROSION/GRADIENT_BY_DILATION/GRADIENT_OF_BEUCHER', 'ERODE' );
  filterArithmeticSubstract := TFilterArithmeticSubstract.Create;
  filterArithmeticAdd := TFilterArithmeticAdd.Create;
  defaultSE := image.createImage( 3, 3 );
  image.DrawDisk( defaultSE, 1, 1, 1.5, clWhite32 );
end;

destructor TFilterMorphology.Destroy;
begin
  destroyImages;
  filterArithmeticSubstract.Free;
  image.freeImage( defaultSE );
end;

procedure TFilterMorphology.destroyImages;
begin
  image.freeImage( image1 );
  image.freeImage( image2 );
  image.freeImage( image3 );
  image.freeImage( image4 );
end;

procedure TFilterMorphology.setParameterImage( const aName: String; const aImage: PBitmap32);
begin
  inherited;
  if aName='inImage' then begin
    image1 := eraseOrCreateImageLike(image1,aImage);
    image2 := eraseOrCreateImageLike(image2,aImage);
    image3 := eraseOrCreateImageLike(image3,aImage);
    image4 := eraseOrCreateImageLike(image4,aImage);
  end;
end;

// http://www.prip.tuwien.ac.at/~hanbury/MathMorph.pdf
// http://www.ulg.ac.be/telecom/teaching/notes/totali/elen016/node105_mn.html
procedure TFilterMorphology.Run();
var
  tmpImageIn : PBitmap32;
  i : Integer;
begin
 if (parameterImageIn.Image<>nil) and (parameterImageOut.Image<>nil) then begin
  SE := parameterSE.Image;
  if SE=nil then SE := defaultSE;
  tmpImageIn:=parameterImageIn.Image;
  i:=parameterIteration.Value;
  while i>0 do begin
    if parameterType.Value='ERODE' then begin
      erode(tmpImageIn, parameterImageOut.Image);
    end else
    if parameterType.Value='DILATE' then begin
      dilate(tmpImageIn, parameterImageOut.Image);
    end else
    if parameterType.Value='OPEN' then begin
      erode(tmpImageIn, image1);
      dilate(image1, parameterImageOut.Image);
    end else
    if parameterType.Value='CLOSE' then begin
      dilate(tmpImageIn, image1);
      erode(image1, parameterImageOut.Image);
    end else
    if parameterType.Value='BLACK_TOP_HAT' then begin
      dilate(tmpImageIn, image1);
      erode(image1, image2);
      substract(image2, tmpImageIn, parameterImageOut.Image);
    end else
    if parameterType.Value='WHITE_TOP_HAT' then begin
      erode(tmpImageIn, image1);
      dilate(image1, image2);
      substract(tmpImageIn, image2, parameterImageOut.Image);
    end else
    if parameterType.Value='GRADIENT_BY_EROSION' then begin
      erode(tmpImageIn, image1);
      substract(tmpImageIn, image1, parameterImageOut.Image);
    end else
    if parameterType.Value='GRADIENT_BY_DILATION' then begin
      dilate(tmpImageIn, image1);
      substract(image1, tmpImageIn, parameterImageOut.Image);
    end else
    if parameterType.Value='GRADIENT_OF_BEUCHER' then begin
      // GE
      erode(tmpImageIn, image1);
      substract(tmpImageIn, image1, image2);
      // GD
      dilate(tmpImageIn, image3);
      substract(image3, tmpImageIn, image4);
      // GE+GD
      add(image2, image4, parameterImageOut.Image);
    end;
    Dec(i);
    if tmpImageIn<>parameterImageIn.Image then image.freeImage(tmpImageIn);
    if i>0 then begin
      tmpImageIn:=createImageFromImage(parameterImageOut.Image);
    end;
  end;
 end;
end;

procedure TFilterMorphology.erode(aImageIn, aImageOut : PBitmap32);
var
  pSrc, PDest : PColor32Array;
  pSrcSE : PColor32Array;
  w,h :Integer;
  SE_w2, SE_h2 : Integer;
  SE_row, SE_col : Integer;
  SE_rowMax, SE_colMax : Integer;
  value : Integer;
  tIntensity, tIntensityMin : Integer;
  imageSrcRow, imageSrcCol : Integer;
  imageSrcRowmax, imageSrcColmax : Integer;
  imageSrcNeighborRow, imageSrcNeighborCol : Integer;
begin
  h := aImageIn.Height;
  w := aImageIn.Width;
  SE_w2 := SE.Width div 2;
  SE_h2 := SE.Height div 2;
  pSrc := aImageIn.Bits;
  imageSrcRowmax:=h-1;
  imageSrcColmax:=w-1;
  for imageSrcRow:=0 to imageSrcRowmax do begin
    pDest:=aImageOut.Bits;
    Inc(pDest,imageSrcRow*w);
    for imageSrcCol:=0 to imageSrcColmax do begin
      tIntensityMin := 255+1;
      pSrcSE := SE.Bits;
      SE_rowMax := SE.Height-1-SE_h2;
      SE_colMax := SE.Width-1-SE_w2;
      for SE_row:=-SE_h2 to SE_rowMax do begin
        imageSrcNeighborRow := imageSrcRow + SE_row;
        for SE_col:=-SE_w2 to SE_colMax do begin
          imageSrcNeighborCol := imageSrcCol + SE_col;
          if (imageSrcNeighborRow>=0) and (imageSrcNeighborRow<=imageSrcRowmax) and
             (imageSrcNeighborCol>=0) and (imageSrcNeighborCol<=imageSrcColmax) then begin
            if pSrcSE^[0]<>0 then begin
              value := pSrc[imageSrcNeighborRow*w+imageSrcNeighborCol];
              tIntensity := Intensity(value);
              if tIntensity < tIntensityMin then tIntensityMin := tIntensity;
            end;
          end;
          Inc(pSrcSE);
        end;
      end;
      pDest^[0] := Gray32(tIntensityMin);
      Inc(pDest);
    end;
  end;
end;

procedure TFilterMorphology.dilate(aImageIn, aImageOut : PBitmap32);
var
  pSrc, PDest : PColor32Array;
  pSrcSE : PColor32Array;
  w,h :Integer;
  SE_w2, SE_h2 : Integer;
  SE_row, SE_col : Integer;
  SE_rowMax, SE_colMax : Integer;
  value : Integer;
  tIntensity, tIntensityMax : Integer;
  imageSrcRow, imageSrcCol : Integer;
  imageSrcRowmax, imageSrcColmax : Integer;
  imageSrcNeighborRow, imageSrcNeighborCol : Integer;
begin
  h := aImageIn.Height;
  w := aImageIn.Width;
  SE_w2 := SE.Width div 2;
  SE_h2 := SE.Height div 2;
  pSrc := aImageIn.Bits;
  pSrcSE := SE.Bits;
  imageSrcRowmax := h-1;
  imageSrcColmax := w-1;
  for imageSrcRow:=0 to imageSrcRowmax do begin
    pDest:=aImageOut.Bits;
    Inc(pDest,imageSrcRow*w);
    for imageSrcCol:=0 to imageSrcColmax do begin
      tIntensityMax := -1;
      pSrcSE := SE.Bits;
      SE_rowMax := SE.Height-1-SE_h2;
      SE_colMax := SE.Width-1-SE_w2;
      for SE_row:=-SE_h2 to SE_rowMax do begin
        imageSrcNeighborRow := imageSrcRow + SE_row;
        for SE_col:=-SE_w2 to SE_colMax do begin
          imageSrcNeighborCol := imageSrcCol + SE_col;
          if (imageSrcNeighborRow>=0) and (imageSrcNeighborRow<=imageSrcRowmax) and
             (imageSrcNeighborCol>=0) and (imageSrcNeighborCol<=imageSrcColmax) then begin
            if pSrcSE^[0]<>0 then begin
              value:=pSrc[imageSrcNeighborRow*w+imageSrcNeighborCol];
              tIntensity := Intensity(value);
              if tIntensity > tIntensityMax then tIntensityMax:=tIntensity;
            end;
          end;
          Inc(pSrcSE);
        end;
      end;
      pDest^[0]:= Gray32(tIntensityMax);
      Inc(pDest);
    end;
  end;

end;

procedure TFilterMorphology.substract(aImageIn1, aImageIn2, aImageOut : PBitmap32);
begin
  filterArithmeticSubstract.setParameterImage('inImage1',aImageIn1);
  filterArithmeticSubstract.setParameterImage('inImage2',aImageIn2);
  filterArithmeticSubstract.setParameterImage('outImage',aImageOut);
  filterArithmeticSubstract.Run;
end;

procedure TFilterMorphology.add(aImageIn1, aImageIn2, aImageOut : PBitmap32);
begin
  filterArithmeticAdd.setParameterImage('inImage1',aImageIn1);
  filterArithmeticAdd.setParameterImage('inImage2',aImageIn2);
  filterArithmeticAdd.setParameterImage('outImage',aImageOut);
  filterArithmeticAdd.Run;
end;

end.