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

type
  TFilterThresholdBinary = class(TFilter)
  public
    constructor Create; override; 
    procedure Run(); override;
  private
    parameterImageIn, parameterImageOut : TParameterImage;
    parameterThresholdLower : TParameterInteger;
    parameterThresholdUpper : TParameterInteger;
    parameterLowColor    : TParameterInteger;
    parameterMiddleColor : TParameterInteger;
    parameterHighColor   : TParameterInteger;
    procedure _run();
  end;

implementation

constructor TFilterThresholdBinary.Create;
begin
  inherited;
  parameterImageIn:=addParameterImage('inImage','explication...');
  parameterImageOut:=addParameterImage('outImage','explication...');
  parameterThresholdLower:=addParameterInteger('thresholdLower','Lower threshold',0,255,100);
  parameterThresholdUpper:=addParameterInteger('thresholdUpper','Upper threshold',0,255,200);
  parameterLowColor:=addParameterInteger('lowcolor','Low color',0,2,0);
  parameterMiddleColor:=addParameterInteger('middlecolor','Middle color',0,2,1);
  parameterHighColor:=addParameterInteger('highcolor','High color',0,2,2);
end;

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

procedure TFilterThresholdBinary._run();
var
  pSrc, PDest : PColor32Array;
  value : Integer;
  w,h :Integer;
  x, max : Cardinal ;
  thresholdLower, thresholdUpper : Byte ;
  lowColor, middleColor, highColor : Cardinal ;
  lowUnchanged, middleUnchanged, highUnchanged : Boolean ;
begin
  lowColor := clBlack32;
  middleColor := clBlack32;
  highColor := clBlack32;

  lowUnchanged := false ;
  case parameterLowColor.Value of
    0 : lowColor := clBlack32 ;
    1 : lowUnchanged := true ;
    2 : lowColor := clWhite32 ;
  end ;

  middleUnchanged := false ;
  case parameterMiddleColor.Value of
    0 : middleColor := clBlack32 ;
    1 : middleUnchanged := true ;
    2 : middleColor := clWhite32 ;
  end ;

  highUnchanged := false ;
  case parameterHighColor.Value of
    0 : highColor := clBlack32 ;
    1 : highUnchanged := true ;
    2 : highColor := clWhite32 ;
  end ;

  pSrc:=parameterImageIn.Image.Bits;
  if pSrc=nil then exit ;
  pDest:=parameterImageOut.Image.Bits;
  if pDest=nil then exit ;
  h:=parameterImageIn.Image.Height ;
  w:=parameterImageIn.Image.Width  ;

  max := h*w-1 ;
  thresholdLower := parameterThresholdLower.Value ;
  thresholdUpper := parameterThresholdUpper.Value ;

  for x:= 0 to max do Begin
    value := Intensity(pSrc^[0]);
    if value >= thresholdLower then begin
      if value <= thresholdUpper then begin
        if middleUnchanged then
          pDest[0] := pSrc^[0]
        else
          pDest[0] := middleColor ;
      end else begin
        if highUnchanged then
          pDest[0] := pSrc^[0]
        else
          pDest[0] := highColor ;
      end;
    end else begin
      if lowUnchanged then
        pDest[0] := pSrc^[0]
      else
        pDest[0] := lowColor ;
    end;
    inc(pSrc) ;
    inc(pDest) ;
  end ;

end;

end.