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

{
BLOB is an acronym for : Binary Large OBject
In image processing :
  A connected region in a image in which all pixels have the same gray-level value

Algorithm:
 I have first imaginate this algorythm alone,
 but one day I found this link : http://homepages.inf.ed.ac.uk/rbf/HIPR2/label.htm
 Name : Connected Components Labeling
 see also
  http://crd.lbl.gov/~kewu/ps/LBNL-56864.pdf
}

interface
uses
  filter, fparameters, image, classes, polygonalyzation;

type

  TFilterBlobExplorer = class(TFilter)
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure setParameterImage( const aName: String; const aImage: PBitmap32); override ;
    procedure Run(); override;
  private
    parameterImageIn, parameterImageOut : TParameterImage;
    parameterImageBlobIndex : TParameterImage;
    parameterIntensityBackground : TParameterInteger;
    parameterIntensityPrecision : TParameterInteger;
    parameterEnableBlobArea : TParameterString;
    parameterBlobAreaMin, parameterBlobAreaMax  : TParameterInteger;
    parameterContour : TParameterBoolean;
    parameterCriticalPoints : TParameterBoolean;
    parameterContourCriticalPointsAppoximationAccuracy : TParameterInteger;
    parameterApproximationMethod : TParameterString;
    parameterBlobSurfaceInfo : TParameterBoolean;
    parameterOutBlobs : TParameterArrayPointers;
    parameterIgnoreBlobsOnImageEdges : TParameterBoolean;
    parameterMonitoring : TParameterBoolean;
    imageIn, imageOut : PBitmap32;
    // _imageBlobTmpColorIndex : a image buffer containing, for each pixel,
    //  the temporary index of the color(=the label) of the corresponding blob.
    //  This label may have to be merged in a next step
    _imageBlobTmpColorIndex : PBitmap32;
    // when labels have been linked, we obtain a image containing, for each pixel,
    //  the real index of the corresponding blob.
    // This index can be used to obtain the blob in the blobs output.
    _imageBlobRealIndex : PBitmap32;
    // _imageBlobContour : a temporary image used to track the contour of blob
    _imageBlobContour : PBitmap32;
    // _arrayBlobLinks : used by the merge label process
    _arrayBlobLinks : array of array of Integer;
    // _arrayBlobTmpColors : get the color RGB of a blob tmp label
    _arrayBlobTmpColors  : array of TColor32;
    // _arrayBlobRealIndex : get the real label of a blob tmp label (after the merge process)
    _arrayBlobRealIndex : array  of TColor32;
    // _arrayBlobRealColors : get the real color RGB of a blob tmp label (after the merge process)
    _arrayBlobRealColors : array of TColor32;
    _src, _dest : PColor32Array;
    w,h :Integer;
    _blobCounter : Integer;
    intensityPrecision : Integer;
    intensityBackground : Integer;
    pixelIsInKnowBlob : boolean;
    intensityXY : Integer;
    imageSrcRowmax, imageSrcColmax : Integer;
    _blobIndexWasInspected : array of Char;
    _tblobList : array of TBlob;
    _bloblistindexByBlobrealindex : array of Integer;
    _appoximationAccuracy : Single;
    _approximationMethod : TApproximationMethod;
    procedure _run();
    procedure findBlobApproximately;
    procedure mergeLinkedBlob;
    procedure drawBlobs;
    procedure createBlobList;
    function isSameIntensity(intensity1,intensity2:Integer) : boolean;
    procedure linkBlobs(indexBlob1,indexBlob2:Integer);
    procedure checkIfCurrentPixelIsPartOfBlobAt(imageSrcNeighborRow,imageSrcNeighborCol:Integer);
    procedure findRealColorOfBlob(blobIndex:Integer; var realblobColor:TColor32);
    procedure checkBlobArea();
    procedure ignoreBlobsOnImageEdges();
    procedure findCriticalPoints();
    procedure drawCriticalPoints();
    procedure createBlobContourPoints(var blob:TBlob;firstPoint:TFPoint);
    function getBlobContourNextPoint(var blob:TBlob; currentPoint:TFPoint; direction:Byte) : TFPoint;
    procedure calculImageBlobRealIndex();
    procedure calculBlobSurfaceInfo();
  end;

implementation
uses
  imageIO, SysUtils, Math;

constructor TFilterBlobExplorer.Create;
begin
  inherited;
  parameterImageIn := addParameterImage('inImage', 'input image');
  parameterImageOut := addParameterImage('outImage', 'result image with blobs');
  parameterImageBlobIndex := addOutputParameterImage('imageBlobIndex', 'result image with blobs index');
  parameterIntensityBackground := addParameterInteger('intensityBackground','',0,255,200);
  parameterIntensityPrecision := addParameterInteger('intensityPrecision','pixel of intensity+-intensityPrecision are of the same blob',1,255,40);
  parameterEnableBlobArea := addParameterString('enableBlobArea','TRUE/FALSE','TRUE');
  parameterBlobAreaMin := addParameterInteger('blobAreaMin','explication...',0,999999,0);
  parameterBlobAreaMax := addParameterInteger('blobAreaMax','explication...',0,999999,999999);
  parameterContour := addParameterBoolean('contour','show only blobs contours',False);
  parameterCriticalPoints := addParameterBoolean('criticalPoints','find contours critical points and rectangle container',False);
  parameterContourCriticalPointsAppoximationAccuracy := addParameterInteger('contourCriticalPointsAppoximationAccuracy','',0,20,1);
  parameterApproximationMethod := addParameterString('approximationMethod','Douglas-Peucker/Sklansky-Gonzalez','Douglas-Peucker');
  parameterBlobSurfaceInfo := addParameterBoolean('blobSurfaceInfo','calcul blob rectangle container, blob area, gravity center',true);
  parameterOutBlobs := addOutputParameterArrayPointers('blobs','array of pointers on TBlob object');
  parameterIgnoreBlobsOnImageEdges := addParameterBoolean( 'ignoreBlobsOnImageEdges', 'set TRUE to ignore blobs on input image edges' , False );
  parameterMonitoring := addParameterBoolean('monitoring','monitoring',True);
  SetLength(_tblobList,0);
end;

destructor TFilterBlobExplorer.Destroy;
begin
  inherited;
  image.freeImage(_imageBlobRealIndex);
  image.freeImage(_imageBlobTmpColorIndex);
  image.freeImage(_imageBlobContour);
end;

procedure TFilterBlobExplorer.setParameterImage( const aName: String; const aImage: PBitmap32);
begin
  if aName='outImage' then begin
    _imageBlobTmpColorIndex:=image.eraseOrCreateImageLike(_imageBlobTmpColorIndex,aImage);
    _imageBlobContour:=image.eraseOrCreateImageLike(_imageBlobContour,aImage);
    _imageBlobRealIndex:=image.eraseOrCreateImageLike(_imageBlobRealIndex,aImage);
  end;
  inherited;
end;

procedure TFilterBlobExplorer.Run();
begin
  imageIn:=parameterImageIn.Image;
  imageOut:=parameterImageOut.Image;
  if (imageIn<>nil) and (imageOut<>nil) then begin
    _run();
  end;
end;

procedure TFilterBlobExplorer._run();
var
  i : Integer;
  pointersOnBlobs : array of Pointer;
begin
  // initialisation
  _src:=imageIn.Bits;
  h:=imageIn.Height;
  w:=imageIn.Width;
  eraseImage(imageOut);
  intensityPrecision:=parameterIntensityPrecision.Value;
  intensityBackground:=parameterIntensityBackground.Value;
  SetLength(_arrayBlobTmpColors,1);
  _arrayBlobTmpColors[0]:=clBlack32;
  for i:=Low(_arrayBlobLinks) to High(_arrayBlobLinks) do begin
    SetLength(_arrayBlobLinks[i],0);
  end;
  SetLength(_arrayBlobLinks,1);
  SetLength(_arrayBlobLinks[0],0);
  for i:=Low(_arrayBlobRealColors) to High(_arrayBlobRealColors) do begin
    _arrayBlobRealColors[i]:=0;
  end;
  image.resetNextColor();
  SetLength(_blobIndexWasInspected,0);

  // we start by searching blob with a fast, but approximate, method.
  _blobCounter:=0;
  findBlobApproximately();

  // now we merge blob who are one to the other
  mergeLinkedBlob;

  // check blob area
  if parameterEnableBlobArea.Value='TRUE' then begin
    checkBlobArea();
  end;

  // IgnoreBlobsOnImageEdges
  if parameterIgnoreBlobsOnImageEdges.Value = True then begin
    ignoreBlobsOnImageEdges();
  end;

  //  since we have done all the last process with indexed color,
  //   now we must set the real color of blobs
  drawBlobs();

  // create blob list
  createBlobList();

  // calcul the image containing index of blobs
  calculImageBlobRealIndex();
  setOutputParameterImage( 'imageBlobIndex', _imageBlobRealIndex );

  // criticalPoints
  if parameterCriticalPoints.Value=True then begin
    _appoximationAccuracy:=parameterContourCriticalPointsAppoximationAccuracy.Value/10;
    _approximationMethod:=amDouglasPeucker;
    if parameterApproximationMethod.Value='Sklansky-Gonzalez' then begin
      _approximationMethod:=amSklanskyGonzalez;
    end;
    findCriticalPoints();
    if parameterMonitoring.Value=true then begin
      drawCriticalPoints();
    end;
  end;

  // blob surface info
  if parameterBlobSurfaceInfo.Value=True then begin
    calculBlobSurfaceInfo();
  end;

  // set output 'blobs'
  SetLength(pointersOnBlobs,Length(_tblobList));
  for i:=0 to Length(_tblobList)-1 do begin
    pointersOnBlobs[i]:=@_tblobList[i];
  end;
  setOutputParameterArrayPointers('blobs',pointersOnBlobs);
end;

procedure TFilterBlobExplorer.findBlobApproximately();
var
  imageSrcRow, imageSrcCol : Integer;
  pSrcCurrentPixel : PColor32Array;
begin
  eraseImage(_imageBlobTmpColorIndex);
  pSrcCurrentPixel:=imageIn.Bits;
  imageSrcRowmax:=h-1;
  imageSrcColmax:=w-1;
  for imageSrcRow:=0 to imageSrcRowmax do begin
    _dest:=_imageBlobTmpColorIndex.Bits;
    Inc(_dest,imageSrcRow*w);
    for imageSrcCol:=0 to imageSrcColmax do begin
      // get intensity of the current pixel, at x,y
      intensityXY := image.Intensity( pSrcCurrentPixel^[0] );
      // set blob info by looking its neighbor
      if intensityXY<intensityBackground then begin
        // for black pixel, we set blob color to black
        // block color = index 0 of blobColors
        _dest^[0]:=0;
      end else begin
        pixelIsInKnowBlob:=False;
        checkIfCurrentPixelIsPartOfBlobAt(imageSrcRow-1,imageSrcCol);
        checkIfCurrentPixelIsPartOfBlobAt(imageSrcRow-1,imageSrcCol-1);
        checkIfCurrentPixelIsPartOfBlobAt(imageSrcRow,imageSrcCol-1);
        checkIfCurrentPixelIsPartOfBlobAt(imageSrcRow-1,imageSrcCol+1);
        // if the current pixel is the first pixel of a blob
        if pixelIsInKnowBlob=False then begin
          Inc(_blobCounter);
          SetLength(_arrayBlobTmpColors,1+_blobCounter);
          SetLength(_arrayBlobLinks,1+_blobCounter);
          SetLength(_arrayBlobLinks[_blobCounter],0);
          _dest^[0]:=_blobCounter;
          _arrayBlobTmpColors[_blobCounter]:=image.getNextColor();
          if _blobCounter>20000 then exit;
        end;
      end;
      Inc(pSrcCurrentPixel);
      Inc(_dest);
    end;
  end;
end;

procedure TFilterBlobExplorer.checkIfCurrentPixelIsPartOfBlobAt(imageSrcNeighborRow,imageSrcNeighborCol:Integer);
var
  intensityNeighbor : Integer;
  outputColorNeighbor : TColor32;
begin
  if (imageSrcNeighborRow>=0) and (imageSrcNeighborCol>=0)
  and (imageSrcNeighborCol<=imageSrcColmax)
  and (imageSrcNeighborRow<=imageSrcRowmax) then begin
    // we check if the intensity of the neighbor (in imageIn)
    // and the current pixel (in imageIn too) is equal
    intensityNeighbor := image.Intensity( _src[imageSrcNeighborRow*w+imageSrcNeighborCol] );
    if isSameIntensity(intensityNeighbor,intensityXY)=True then begin
      // we get the neighbor blob color (in _imageBlobTmpColorIndex)
      outputColorNeighbor:=image.getPixel(_imageBlobTmpColorIndex,imageSrcNeighborCol,imageSrcNeighborRow);
      // then the current pixel is part of the same blob than the neighbor
      // if it's the first neighbor to be equal to the current pixel
      if pixelIsInKnowBlob=False then begin
        _dest^[0]:=outputColorNeighbor;
        pixelIsInKnowBlob:=True;
      end else begin
      // if itsn't the first blob neighbor to be equal to the current pixel
        // if itsn't the same outputColorNeighbor/blob
        if _dest^[0]<>outputColorNeighbor then begin
          // then we must save the color conversion,
          // because in fact its the same blob,
          // and we will convert it at the end
          linkBlobs(_dest^[0],outputColorNeighbor);
          linkBlobs(outputColorNeighbor,_dest^[0]);
        end;
      end;
    end;
  end;
end;

function TFilterBlobExplorer.isSameIntensity(intensity1,intensity2:Integer) : boolean;
var
  diffIntensity : Integer;
begin
  Result:=False;
  if (intensity1>=intensityBackground) and (intensity2>=intensityBackground) then begin
    diffIntensity:=Abs(intensity1-intensity2);
    if diffIntensity<=intensityPrecision then Result:=True;
  end;
end;

procedure TFilterBlobExplorer.linkBlobs(indexBlob1,indexBlob2:Integer);
var
  blobsLinkedLength : Integer;
  i : Integer;
  alreadyLinked : boolean;
begin
  alreadyLinked:=False;
  blobsLinkedLength:=Length(_arrayBlobLinks[indexBlob1]);
  for i:=0 to blobsLinkedLength-1 do begin
    if _arrayBlobLinks[indexBlob1][i]=indexBlob2 then begin
      alreadyLinked:=True;
    end;
  end;
  if alreadyLinked=False then begin
    Inc(blobsLinkedLength);
    SetLength(_arrayBlobLinks[indexBlob1],blobsLinkedLength);
    _arrayBlobLinks[indexBlob1][blobsLinkedLength-1]:=indexBlob2;
  end;
end;

procedure TFilterBlobExplorer.mergeLinkedBlob();
var
  blobsLinkedLength : Integer;
  blobIndex, blobIndex2, blobIndexMax, i, linkedBlobIndex : Integer;
  realblobColor : TColor32;
begin
  SetLength(_arrayBlobRealColors,Length(_arrayBlobTmpColors));
  SetLength(_arrayBlobRealIndex,Length(_arrayBlobTmpColors));
  blobIndexMax:=Length(_arrayBlobTmpColors)-1;
  if _blobCounter<20000 then begin
    // for each blob real color
    for blobIndex:=1 to blobIndexMax do begin
      // if real color isn't already set
      if _arrayBlobRealColors[blobIndex]=0 then begin
        // try to find if a linked blob real color is already set
        SetLength(_blobIndexWasInspected,0);
        SetLength(_blobIndexWasInspected,Length(_arrayBlobTmpColors));
        findRealColorOfBlob(blobIndex, realblobColor);
        // if no linked blob real color is set
        if realblobColor=0 then begin
          // then we use the blob real color
          realblobColor:=_arrayBlobTmpColors[blobIndex];
        end;
        _arrayBlobRealColors[blobIndex]:=realblobColor;
      end else begin
      // if real color is already set, we get it
        realblobColor:=_arrayBlobRealColors[blobIndex];
      end;
      // we set linked blob real color to this blob real color
      blobsLinkedLength:=Length(_arrayBlobLinks[blobIndex]);
      for i:=0 to blobsLinkedLength-1 do begin
        linkedBlobIndex:=_arrayBlobLinks[blobIndex][i];
        _arrayBlobRealColors[linkedBlobIndex]:=realblobColor;
      end;
    end;
  end else begin
  // if there are too many blob, then we can't do this processing
    for blobIndex:=1 to blobIndexMax do begin
      _arrayBlobRealColors[blobIndex]:=_arrayBlobTmpColors[blobIndex];
      _arrayBlobRealIndex[blobIndex]:=blobIndex;
    end;
  end;
  // calculate real blob index
  for blobIndex:=1 to blobIndexMax do begin
    _arrayBlobRealIndex[blobIndex]:=0;
    realblobColor:=_arrayBlobRealColors[blobIndex];
    for blobIndex2:=1 to blobIndexMax do begin
      if _arrayBlobRealColors[blobIndex2]=realblobColor then begin
        _arrayBlobRealIndex[blobIndex2]:=blobIndex;        
      end;
    end;
  end;
end;

procedure TFilterBlobExplorer.findRealColorOfBlob(blobIndex:Integer; var realblobColor:TColor32);
var
  blobsLinkedLength : Integer;
  i, linkedBlobIndex : Integer;
begin
  realblobColor:=0;
  blobsLinkedLength:=Length(_arrayBlobLinks[blobIndex]);
  i:=0;
  while (i<blobsLinkedLength) and (realblobColor=0) do begin
    linkedBlobIndex:=_arrayBlobLinks[blobIndex][i];
    realblobColor:=_arrayBlobRealColors[linkedBlobIndex];
    Inc(i);
  end;
  _blobIndexWasInspected[blobIndex]:=Char(1);
  if realblobColor=0 then begin
    i:=0;
    while (i<blobsLinkedLength) and (realblobColor=0) do begin
      linkedBlobIndex:=_arrayBlobLinks[blobIndex][i];
      if _blobIndexWasInspected[linkedBlobIndex]=Char(0) then begin
        findRealColorOfBlob(linkedBlobIndex, realblobColor);
      end;
      Inc(i);
    end;
  end;
end;

procedure TFilterBlobExplorer.checkBlobArea();
var
  p, max : Cardinal;
  _dest : PColor32Array;
  blobColorIndex : TColor32;
  blobPixelCounter : array of TColor32;
  areaMin, areaMax : Integer;
  i, iMax : Integer;
  j, jMax : Integer;
  blobRealIndex : Integer;
  area : Integer;
begin
  SetLength(blobPixelCounter,Length(_arrayBlobTmpColors));
  areaMin:=parameterBlobAreaMin.Value;
  areaMax:=parameterBlobAreaMax.Value;
  iMax:=Length(blobPixelCounter)-1;
  jMax:=iMax;
  // first, we calculate the number of pixel (=area) of each blob
  for i:=0 to iMax do begin
    blobPixelCounter[i]:=0;
  end;
  //   for each pixel in the image containing the blob tmp color index
  max:=imageIn.Height*imageIn.Width-1;
  _dest:=_imageBlobTmpColorIndex.Bits;
  for p:=0 to max do Begin
    blobColorIndex:=_dest^[0];
    // we retrieve the blob real index
    blobRealIndex:=_arrayBlobRealIndex[blobColorIndex];
    // and then increment it's calculated area
    Inc(blobPixelCounter[blobRealIndex]);
    Inc(_dest);
  end;
  // second, we check if the calculated area is in the range areaMin->areaMax
  for i:=1 to iMax do begin
    area:=blobPixelCounter[i];
    // if outside the limit
    if (area<>0) then begin
      if (area<areaMin) or (area>areaMax) then begin
        // remove it
        for j:=1 to jMax do begin
          if _arrayBlobRealIndex[i]=_arrayBlobRealIndex[j] then begin
            _arrayBlobRealColors[j]:=0;
          end;
        end;
      end;
    end;
  end;
end;

procedure TFilterBlobExplorer.ignoreBlobsOnImageEdges();
var
  max : Cardinal;
  destLineTop, destLineBottom : PColor32Array;
  destColLeft, destColRight : PColor32Array;
  blobColorIndex : TColor32;
  blobToIgnore : array of boolean;
  i, iMax : Integer;
  j, jMax : Integer;
  blobRealIndex : Integer;
  x : Integer;
  ignore : Boolean;
begin
  SetLength( blobToIgnore, Length(_arrayBlobTmpColors) );
  iMax := Length(blobToIgnore)-1;
  jMax := iMax;
  // first, we search blob to ignore
  for i:=0 to iMax do begin
    blobToIgnore[i] := False;
  end;
  //   for each pixel on the edge of the image containing the blob tmp color index
  max := imageIn.Width-1;
  destLineTop := _imageBlobTmpColorIndex.Bits;
  destLineBottom := _imageBlobTmpColorIndex.Bits;
  Inc(destLineBottom, ((_imageBlobTmpColorIndex.Height)-1)*_imageBlobTmpColorIndex.Width);
  for x:=0 to max do begin
    // destLineTop
      blobColorIndex := destLineTop^[0];
      // we retrieve the blob real index
      blobRealIndex := _arrayBlobRealIndex[blobColorIndex];
      // and then we set to ignore it
      blobToIgnore[blobRealIndex] := True;
      Inc( destLineTop );
    // destLineBottom
      blobColorIndex := destLineBottom^[0];
      // we retrieve the blob real index
      blobRealIndex := _arrayBlobRealIndex[blobColorIndex];
      // and then we set to ignore it
      blobToIgnore[blobRealIndex] := True;
      Inc( destLineBottom );
  end;
  max := imageIn.Height-1;
  destColLeft := _imageBlobTmpColorIndex.Bits;
  destColRight := _imageBlobTmpColorIndex.Bits;
  Inc( destColRight, _imageBlobTmpColorIndex.Width-1 );
  for x:=0 to max do begin
    // destColLeft
      blobColorIndex := destColLeft^[0];
      // we retrieve the blob real index
      blobRealIndex := _arrayBlobRealIndex[blobColorIndex];
      // and then we set to ignore it
      blobToIgnore[blobRealIndex] := True;
      Inc( destColLeft, _imageBlobTmpColorIndex.Width );
    // destColRight
      blobColorIndex := destColRight^[0];
      // we retrieve the blob real index
      blobRealIndex := _arrayBlobRealIndex[blobColorIndex];
      // and then we set to ignore it
      blobToIgnore[blobRealIndex] := True;
      Inc( destColRight, _imageBlobTmpColorIndex.Width );
  end;
  // second, we remove blob to ignore
  for i:=1 to iMax do begin
    ignore := blobToIgnore[i];
    // if outside the limit
    if ignore=True then begin
      // remove it
      for j:=1 to jMax do begin
        if _arrayBlobRealIndex[i] = _arrayBlobRealIndex[j] then begin
          _arrayBlobRealColors[j] := 0;
        end;
      end;
    end;
  end;
end;

procedure TFilterBlobExplorer.drawBlobs;
var
  p, max : Cardinal;
  _src, _dest : PColor32Array;
  pSrcLeft, pSrcRight : PColor32Array;
  pSrcTop, pSrcBottom : PColor32Array;
  blobColorIndex : Integer;
  blobColor, destColor : TColor32;
  nblobColorIndex : Integer;
  n1Color,n2Color,n3Color,n4Color : TColor32;
  imageSrcRow, imageSrcCol : Integer;
begin
  // if we must show the blob filled
  if parameterContour.Value=False then begin
    max:=imageIn.Height*imageIn.Width-1;
    _src:=_imageBlobTmpColorIndex.Bits;
    _dest:=imageOut.Bits;
    for p:= 0 to max do begin
      blobColorIndex:=_src^[0];
      destColor:=_arrayBlobRealColors[blobColorIndex];
      _dest^[0]:=destColor;
      inc(_src);
      inc(_dest);
    end;
  end else begin
  // if we must show only the contour, we will remove blob content
   imageSrcRowmax:=h-1;
   imageSrcColmax:=w-1;
   for imageSrcRow:=1 to imageSrcRowmax-1 do begin
    _dest:=imageOut.Bits;
    Inc(_dest,imageSrcRow*w+1); // +1 because we start with col 1

    _src:=_imageBlobTmpColorIndex.Bits;
    Inc(_src,imageSrcRow*w+1);

    pSrcTop:=_src;
    Dec(pSrcTop,w);

    pSrcBottom:=_src;
    Inc(pSrcBottom,w);

    pSrcLeft:=_src;
    Dec(pSrcLeft);

    pSrcRight:=_src;
    Inc(pSrcRight);

    for imageSrcCol:=1 to imageSrcColmax-1 do begin
     blobColorIndex:=_src^[0];
     blobColor:=_arrayBlobRealColors[blobColorIndex];
     destColor:=clBlack32;
     // we must only check the 4 pixels (top, bottom,left,right)
     // left
     nblobColorIndex:=pSrcLeft^[0];
     n1Color:=_arrayBlobRealColors[nblobColorIndex];
     if (n1Color<>blobColor) then begin
       destColor:=blobColor;
     end else begin
       // right
       nblobColorIndex:=pSrcRight^[0];
       n2Color:=_arrayBlobRealColors[nblobColorIndex];
       if (n2Color<>blobColor)  then begin
         destColor:=blobColor;
       end else begin
         // top
         nblobColorIndex:=pSrcTop^[0];
         n3Color:=_arrayBlobRealColors[nblobColorIndex];
          if (n3Color<>blobColor) then begin
            destColor:=blobColor;
          end else begin
            // bottom
            nblobColorIndex:=pSrcBottom^[0];
            n4Color:=_arrayBlobRealColors[nblobColorIndex];
            if (n4Color<>blobColor) then begin
              destColor:=blobColor;
            end;
          end;
        end;
     end;
     _dest^[0]:=destColor;
     Inc(_dest);
     Inc(_src);
     Inc(pSrcLeft);
     Inc(pSrcRight);
     Inc(pSrcTop);
     Inc(pSrcBottom);
    end;
   end;
  end;
end;

procedure TFilterBlobExplorer.createBlobList;
var
  brc, b : Integer;
  brcColor, brcColor2 : TColor32;
  blobAlreadyExist : Boolean;
  i : Integer;
begin
  SetLength(_tblobList,0);
  SetLength(_bloblistindexByBlobrealindex,0);
  SetLength(_bloblistindexByBlobrealindex,Length(_arrayBlobRealColors));
  for i:=0 to Length(_bloblistindexByBlobrealindex)-1 do begin
    _bloblistindexByBlobrealindex[i]:=0;
  end;
  // for each blob real color
  for brc:=0 to Length(_arrayBlobRealColors)-1 do begin
    brcColor:=_arrayBlobRealColors[brc];
    if brcColor=0 then begin
      _bloblistindexByBlobrealindex[brc]:=-1;
    end else begin
      // search this color in all blob of blobList
      blobAlreadyExist:=False;
      for b:=0 to Length(_tblobList)-1 do begin
        if _tblobList[b].color=brcColor then begin
          blobAlreadyExist:=True;
          break;
        end;
      end;
      // if the blob doesn't exist in blobList
      if blobAlreadyExist=False then begin
        // we add it
        SetLength(_tblobList,Length(_tblobList)+1);
        b:=Length(_tblobList)-1;
        _tblobList[b].color := brcColor;
        _tblobList[b].index := b;
        _tblobList[b].rectangleContainer.Left:=w;
        _tblobList[b].rectangleContainer.Right:=0;
        _tblobList[b].rectangleContainer.Top:=h;
        _tblobList[b].rectangleContainer.Bottom:=0;
        _tblobList[b].pixelArea:=0;
        _tblobList[b].gravityCenter.x:=0;
        _tblobList[b].gravityCenter.y:=0;
        _tblobList[b].perimeter:=0;
        // and we can calcul all the link _arrayBlobRealColors->tblob (usefull for next procedure)
        for i:=0 to Length(_arrayBlobRealColors)-1 do begin
          brcColor2:=_arrayBlobRealColors[i];
          if brcColor2=brcColor then begin
            _bloblistindexByBlobrealindex[i]:=b;
          end;
        end;
      end;
    end;
  end;
end;

procedure TFilterBlobExplorer.calculImageBlobRealIndex();
var
  p, max : Integer;
  src, dest : PColor32Array;
  blobColorIndex : TColor32;
  blobRealIndex : Integer;
  blobIndex : Integer;
begin
  max := _imageBlobTmpColorIndex.Height*_imageBlobTmpColorIndex.Width-1;
  src := _imageBlobTmpColorIndex.Bits;
  dest := _imageBlobRealIndex.Bits;
  for p:= 0 to max do begin
    blobColorIndex := src^[0];
    blobRealIndex := _arrayBlobRealIndex[blobColorIndex];
    blobIndex := _bloblistindexByBlobrealindex[blobRealIndex];
    dest^[0] := blobIndex;
    Inc( src );
    Inc( dest );
  end;
end;

procedure TFilterBlobExplorer.calculBlobSurfaceInfo();
var
  x, y : Integer;
  blobIndex : Integer;
  i, iMax : Integer;
  blob : PBlob;
  dest : PColor32Array;
begin
  // step 1
  for y:=0 to _imageBlobTmpColorIndex.Height-1 do begin
    dest := _imageBlobRealIndex.Bits;
    Inc( dest, y*_imageBlobRealIndex.Width );
    for x:=0 to _imageBlobTmpColorIndex.Width-1 do begin
      blobIndex := dest^[0];
      if blobIndex<>-1 then begin
        // blob rectangle container
        if _tblobList[blobIndex].rectangleContainer.Left>x then _tblobList[blobIndex].rectangleContainer.Left:=x;
        if _tblobList[blobIndex].rectangleContainer.Right<x then _tblobList[blobIndex].rectangleContainer.Right:=x;;
        if _tblobList[blobIndex].rectangleContainer.Top>y then _tblobList[blobIndex].rectangleContainer.Top:=y;
        if _tblobList[blobIndex].rectangleContainer.Bottom<y then _tblobList[blobIndex].rectangleContainer.Bottom:=y;
        // pixelArea
        Inc(_tblobList[blobIndex].pixelArea);
        // gravity center
        _tblobList[blobIndex].gravityCenter.x:=_tblobList[blobIndex].gravityCenter.x+x;
        _tblobList[blobIndex].gravityCenter.y:=_tblobList[blobIndex].gravityCenter.y+y;
      end;
      Inc(dest);
    end;
  end;
  // step 2
  for blobIndex:=0 to Length(_tblobList)-1 do begin
    blob:=@_tblobList[blobIndex];
    // blob rectangle container:right/bottom is outside, by convention of filters ROI
    blob.rectangleContainer.Right:=Math.Min(blob.rectangleContainer.Right+1,w-1);
    blob.rectangleContainer.Bottom:=Math.Min(blob.rectangleContainer.Bottom+1,h-1);
    blob.rectangleContainer.Left:=Math.Min(blob.rectangleContainer.Left,blob.rectangleContainer.Right);
    blob.rectangleContainer.Top:=Math.Min(blob.rectangleContainer.Top,blob.rectangleContainer.Bottom);
    // gravity center
    blob.gravityCenter.x:=blob.gravityCenter.x/blob.pixelArea;
    blob.gravityCenter.y:=blob.gravityCenter.y/blob.pixelArea;
    // vector chain
    SetLength(blob.vectorChain,0);
    SetLength(blob.vectorChain,Length(blob.approximatedSegmentList));
    iMax:=Length(blob.approximatedSegmentList)-1;
    for i:=0 to iMax do begin
      blob.vectorChain[i]:=image.convertToVector(blob.approximatedSegmentList[i]);
    end;
    // perimeter
    iMax:=Length(blob.vectorChain)-1;
    for i:=0 to iMax do begin
      blob.perimeter:=blob.perimeter+blob.vectorChain[i].length;
    end;
    // monitoring
    if parameterMonitoring.Value=true then begin
      image.drawRect(imageOut,_tblobList[blobIndex].rectangleContainer,clBlue32,1);
      image.drawDisk(imageOut,_tblobList[blobIndex].gravityCenter.x,_tblobList[blobIndex].gravityCenter.y,2,clRed32);
    end;
  end;
end;

procedure TFilterBlobExplorer.findCriticalPoints();
var
  b : Integer;
  x, y : Integer;
  pColor, bColor : TColor32;
  pPoint : TFPoint;
  blobFound : Boolean;
begin
  // for each blob
  for b:=0 to Length(_tblobList)-1 do begin
    bColor:=_tblobList[b].color;
    // search a point in the current blob
    blobFound:=False;
    for y:=0 to imageOut.Height-1 do begin
      _dest:=imageOut.Bits;
      Inc(_dest,y*imageOut.Width);
      for x:=0 to imageOut.Width-1 do begin
        pColor:=_dest^[0];
        // if we have found a point of this blob
        if pColor=bColor then begin
          blobFound:=True;
          pPoint.x:=x;
          pPoint.y:=y;
          createBlobContourPoints(_tblobList[b],pPoint);
          break;
        end;
        Inc(_dest);
      end;
      if blobFound=True then begin
        break;
      end;
    end;
  end;
end;

procedure TFilterBlobExplorer.createBlobContourPoints(var blob:TBlob;firstPoint:TFPoint);
var
  currentPoint, nextPoint : TFPoint;
  direction : Byte;
  deltaX, deltaY : Integer;
  stop : boolean;
begin
  image.eraseImage(_imageBlobContour);
  currentPoint:=firstPoint;
  direction:=1;
  stop:=false;
  repeat
    nextPoint:=getBlobContourNextPoint(blob,currentPoint,direction);
    if nextPoint.x>=0 then begin
      SetLength(blob.segmentList,Length(blob.segmentList)+1);
      blob.segmentList[Length(blob.segmentList)-1].p1:=currentPoint;
      blob.segmentList[Length(blob.segmentList)-1].p2:=nextPoint;
      blob.segmentList[Length(blob.segmentList)-1].width:=1;
    end;
    deltaX:=Floor(nextPoint.x-currentPoint.x);
    deltaY:=Floor(nextPoint.y-currentPoint.y);
    if (deltaX=1) and (deltaY=0) then direction:=1;
    if (deltaX=1) and (deltaY=-1) then direction:=2;
    if (deltaX=0) and (deltaY=-1) then direction:=3;
    if (deltaX=-1) and (deltaY=-1) then direction:=4;
    if (deltaX=-1) and (deltaY=0) then direction:=5;
    if (deltaX=-1) and (deltaY=1) then direction:=6;
    if (deltaX=0) and (deltaY=1) then direction:=7;
    if (deltaX=1) and (deltaY=1) then direction:=8;
    currentPoint:=nextPoint;
    if stop=false then stop:=(currentPoint.x=firstPoint.x) and (currentPoint.y=firstPoint.y);
    if stop=false then stop:=(currentPoint.x=-1) and (currentPoint.y=-1);
  until stop=true;
  // appoximation ?
  if _appoximationAccuracy=0 then begin
    blob.approximatedSegmentList:=blob.segmentList;
  end else begin
    // approximation by polygonalization
    if _approximationMethod=amSklanskyGonzalez then begin
      blob.approximatedSegmentList:=polygonalyzation.polygonalization_SklanskyGonzalez(blob.segmentList,_appoximationAccuracy,nil{imageOut});
    end else begin
      blob.approximatedSegmentList:=polygonalyzation.polygonalization_DouglasPeucker(blob.segmentList,_appoximationAccuracy,nil{imageOut});
    end;
  end;
end;

function TFilterBlobExplorer.getBlobContourNextPoint(var blob:TBlob; currentPoint:TFPoint; direction:Byte) : TFPoint;
var
  newPoint : TFPoint;
  x,y : Integer;
  bColor : TColor32;
  directionScan, directionScanStop : Byte;

  procedure tryPoint(sx,sy:Integer);
  var
    pColor : TColor32;
  begin
    if (sx>=0) and (sx<imageOut.Width) and (sy>=0) and (sy<imageOut.Height) then begin
      pColor:=image.getPixel(imageOut,sx,sy);
      if pColor=bColor then begin
          newPoint.x:=sx;
          newPoint.y:=sy;
      end;
    end;
  end;

begin
  newPoint.x:=-1;
  newPoint.y:=-1;
  bColor:=blob.color;
  x:=Floor(currentPoint.x);
  y:=Floor(currentPoint.y);
  directionScan:=(direction+2) mod 8;
  directionScanStop:=(direction+3) mod 8;
  if directionScanStop=0 then directionScanStop:=8;
  repeat
    case directionScan of
    1:  tryPoint(x+1,y);
    2:  tryPoint(x+1,y-1);
    3:  tryPoint(x,y-1);
    4:  tryPoint(x-1,y-1);
    5:  tryPoint(x-1,y);
    6:  tryPoint(x-1,y+1);
    7:  tryPoint(x,y+1);
    8:  tryPoint(x+1,y+1);
    end;

    if directionScan=0 then
      directionScan:=8
    else
      Dec(directionScan);

  until (directionScan=directionScanStop) or (newPoint.x<>-1);
  Result:=newPoint;
end;

procedure TFilterBlobExplorer.drawCriticalPoints();
var
  b : Integer;
  sl : TSegmentList;
begin
  sl:=nil;
  // for each blob
  for b:=0 to Length(_tblobList)-1 do begin
    sl:=_tblobList[b].approximatedSegmentList;
    image.drawLines(imageOut,sl,clYellow32,clRed32);
  end;
end;


end.