macro 'Unsharp Mask';
var
  I, pid1, pid2: integer;
begin
  pid1 := PidNumber;
  Duplicate(concat(WindowTitle, ' (Unsharp Mask)'));
  pid2 := PidNumber;
  for i := 1 to 8 do
     filter('smooth more');
  ImageMath('subract', pid1, pid2, 1, 0, pid2);
end;


macro 'Make Bas-relief'
begin
  Duplicate('Bas-relief');
  SelectAll;
  Smooth;
  Copy;
  MoveRoi(-1,-1);  {Try MoveRoi(1,1) for a different effect.}
  Paste;
  Subtract;
  EnhanceContrast;
  ApplyLUT;
end;


macro 'Normalize to 0 to 255';
{
Similar to enhance contrast but alters the pixel data instead of generating
a LUT function. Can be used to normalize multiple images to the same
brightness scale when creating a poster.
}
var
  min,max,count:integer;
begin
  ResetCounter;
  Measure;
  count:=rCount;
  min :=rMin[count];
  max:=rMax[count];
  KillROI;
  SelectAll;
  AddConstant(-min);
  Max:=Max-min;
  MultiplyByConstant(255/max);
  ShowMessage('Results are best if a ROI is drawn before the macro is executed');
 end;

macro 'Subtract Background';
var
  i,Corrected,smoothf:integer;
  scalef:real;
begin
  scalef:=.125;
  smoothf:=10;
  SelectAll;
  Duplicate('Background Corrected');
  Corrected:=PicNumber;
  Duplicate('Background');
  SetScaling('Bilinear'); 
  ScaleSelection(scalef,scalef);
  RestoreRoi;
  for i:=1 to smoothf do begin
    SetOption; Smooth;
  end;
  ScaleSelection(1/scalef,1/scalef);
  ScaleMath(false);
  SelectAll;
  Copy;
  SelectPic(Corrected);
  Paste;
  Subtract;
  ResetGrayMap;
end;


macro 'Make Variance ImageÉ';
{
Divides an image into cells, replacing all pixels in each cell by the standard deviation for that cell. You will need to enter the cell width, cell height, and estimated maximum standard deviation. The actual maximum standard deviation is displayed when the macro finishes.
}
var
  x,y,xinc,yinc,width,height:integer;
  cellwidth,cellheight,value:integer;
  maxstd,max:real;
begin
  RequiresVersion(1.58);
  GetPicSize(width,height);
  xinc:=GetNumber('Cell Width:', 16, 0);
  yinc:=GetNumber('Cell Height:', xinc, 0);
  max:=GetNumber('Max std dev:', 50);
  maxstd:=0;
  y:=0;
  repeat
     cellheight:=yinc;
     if (y+cellheight)>height then cellheight:=height-y;
     x:=0;
     repeat
        cellwidth:=xinc;
        if (x+cellwidth)>width then
           cellwidth:=width-x-1;
        MakeRoi(x,y,cellwidth,cellheight);
        measure;
        if rStdDev[rcount]>maxstd
          then maxstd:=rStdDev[rcount];
        value:=trunc(rStdDev[rcount]/max*253)+1;
        if value>254 then value:=254;
        SetForeground(value);
        fill;
        ResetCounter;
        x:=x+xinc;
     until x >= width;
     y:=y+yinc;
  until y >= height;
  KillRoi;
  ShowMessage('max std dev=',maxstd:1:2);
end;

procedure Square(scale:real)
{ Applies a parabolic LUT}
var i,y:integer;
begin
  for i:= 1 to 254 do begin
    y:= (i-127)*(i-127)*scale/64.25;
    if y > 255 then y:=255;
    RedLUT[i]:=y;
    GreenLUT[i]:= y;
    BlueLUT[i]:=y;
  end;
  UpdateLUT;
  ApplyLUT;
end;

procedure ImpulseFilter;
{This is an impulse filter (all zeros with a 1 in the middle) minus a 5x5 average (5x5 1's divided by 25), then scaled so the smallest tap is 1 (i.e. times 25).}
begin
  RequiresVersion(1.53);
  NewTextWindow('5x5 mean diff',150,140);
  writeln('-1 -1 -1  -1 -1');
  writeln('-1 -1 -1  -1 -1');
  writeln('-1 -1 24 -1 -1');
  writeln('-1 -1 -1  -1 -1');
  writeln('-1 -1 -1  -1 -1');
  ScaleConvolutions(true);
  Convolve('');
  Dispose;
end;

macro 'Find Variance [V]'
{
Finds the "instantaneous" variance, the variance of a pixel
in its neighborhood.

     var(i) = (x(i) - avg(x))^2/(N-1)

where avg(x) is the average of values in a neighborhood
(say 5x5) around a pixel x(i), and N is the number of
pixels in the neighborhood (25). Let's disregard the /(N-1)
operation for now -- it's merely a scaling operation. x(i) -
avg(x) can be found by convolving with an appropriate
filter.The squaring operation can be done with a parabolic LUT.  This LUT can include the scaling operation for those who need calibrated results (modify the argument to
"Square" to be other than 1.0 to scale the LUT).

Contributed by Norm Hurst (norm_hurst@maca.sarnoff.com).
}
begin
  ImpulseFilter;        {impulse minus 5x5 average}
  Square(1.0);          {Adjust argument to scale the LUT}
end;

macro 'Impulse Filter';
begin
  RequiresVersion(1.53);
  ImpulseFilter;
end;

macro '3x3 Sharpen [F]';
begin
  NewTextWindow('3x3 sharpen',120,120);
  writeln('-1 -1 -1');
  writeln('-1  9 -1');
  writeln('-1 -1 -1');
  Convolve('');
  Dispose
end;

macro '5x5 Laplace';
begin
  NewTextWindow('5x5 laplace',140,120);
  writeln('-1 -1 -1 -1 -1');
  writeln('-1 -1 -1 -1 -1');
  writeln('-1 -1 24 -1 -1');
  writeln('-1 -1 -1 -1 -1');
  writeln('-1 -1 -1 -1 -1');
  Convolve('');
  Dispose;
end;

macro '7x7 Gauss';
begin
  NewTextWindow('7x7 gauss',160,140);
  writeln(' 1 1 2  2 2 1 1');
  writeln(' 1 2 2  4 2 2 1');
  writeln(' 2 2 4  8 4 2 2');
  writeln(' 2 4 8 16 8 4 2');
  writeln(' 2 2 4  8 4 2 2');
  writeln(' 1 2 2  4 2 2 1');
  writeln(' 1 1 2  2 2 1 1');
  Convolve('');
  Dispose;
end;

procedure Hat13;
begin
  NewTextWindow('13x13 hat',350,200);
  writeln(' 0  0  0  0  0 -1  -1 -1   0  0   0  0  0');
  writeln(' 0  0  0 -1 -1 -2  -2 -2  -1 -1   0  0  0');
  writeln(' 0  0 -2 -2 -3 -3  -4 -3  -3 -2  -2  0  0');
  writeln(' 0 -1 -2 -3 -3 -3  -2 -3  -3 -3  -2 -1  0');
  writeln(' 0 -1 -3 -3 -1  4   6  4  -1 -3  -3 -1  0');
  writeln('-1 -2 -3 -3  4 14  19 14   4 -3  -3 -2 -1');
  writeln('-1 -2 -4 -2  6 19  24 19   6 -2  -4 -2 -1');
  writeln('-1 -2 -3 -3  4 14  19 14   4 -3  -3 -2 -1');
  writeln(' 0 -1 -3 -3 -1  4   6  4  -1 -3  -3 -1  0');
  writeln(' 0 -1 -2 -3 -3 -3  -2 -3  -3 -3  -2 -1  0');
  writeln(' 0  0 -2 -2 -3 -3  -4 -3  -3 -2  -2  0  0');
  writeln(' 0  0  0 -1 -1 -2  -2 -2  -1 -1   0  0  0');
  writeln(' 0  0  0  0  0 -1  -1 -1   0  0   0  0  0');
  Convolve('');
  Dispose;
end;

macro '13x13 Hat - scaled';
begin
  ScaleConvolutions(true);
  Hat13;
end;

macro '13x13 Hat - clipped';
begin
  ScaleConvolutions(false);
  Hat13;
end;

macro 'Unweighted SmoothingÉ';
var
  n, row,column:integer;
begin
  n:=GetNumber('Kernel Size[3-63]:',7);
  if (n<3) or (n>63) then begin
    PutMessage('N must be in the range 3-63.');
    exit;
  end;
  NewTextWindow('nxn smooth',300,100);
  for row:=1 to n do begin
    for column:=1 to n do write(' 1');
    writeln;
  end;
  Convolve('');
  Dispose;
end;

macro 'Grayscale Erosion';
var
  iterations,i:integer;
begin
  iterations:=GetNumber('Iterations:',1);
  for i:=1 to iterations do
     filter('min');
end;

macro 'Grayscale Dilation';
begin
  repeat
     filter('max');
  until button;
end;

macro 'Shadow Demo';
begin
   Shadow('N'); wait(1); Undo;
   Shadow('NE'); wait(1); Undo;
   Shadow('E'); wait(1); Undo;
   Shadow('SE'); wait(1); Undo;
   Shadow('S'); wait(1); Undo;
   Shadow('SW'); wait(1); Undo;
   Shadow('W'); wait(1); Undo;
   Shadow('NW'); wait(1); Undo;
   Undo;
end;


macro 'Fractal Dilation';
var
  iterations,i:integer;
begin
  iterations:=24;
  ResetCounter;
  SetUser1Label('Count');
  SetOptions('User1');
  SetBinaryCount(1);
  Measure;
  rUser1[rCount]:=histogram[255];
  UpdateResults;
  for i:=1 to iterations do begin
     Dilate;
     Measure;
     rUser1[rCount]:=histogram[255];
     UpdateResults;
  end;
  ShowResults;
end;


macro '(---'; begin end;

macro 'Smooth [1]'; begin filter('smooth') end;
macro 'Smooth More [2]'; begin filter('smooth more') end;
macro 'Sharpen [3]'; begin filter('sharpen') end;
macro 'Sharpen More [4]'; begin filter('sharpen more') end;
macro 'Sobel [5]'; begin filter('sobel') end;
macro 'Trace Edges [6]'; begin filter('smooth');
  filter('sobel'); AutoThreshold; MakeBinary end;
macro 'Median [7]'; begin filter('median') end;
macro 'Dither [8]'; begin filter('dither') end;


macro '(---'; begin end;


macro '5x5';
{
Note: you only see the open file dialog box the first time one of
these macros is called, since Image keeps track of the folder
containing the convolution kernels.
}
begin
  convolve('Hat(5x5)');
end;

macro '7x7'
begin
  convolve('Hat(7x7)');
end;

macro '9x9]'
begin
  convolve('Hat(9x9)');
end;