macro 'Export LUT [E]';
{
Copies the current look-up table to the Area(Red), Mean(Green) and
Perimeter/Length(blue) columns. Max Measurements must be set to
256 or greater.
}
var
  i:integer;
  v:real;
begin
  RequiresVersion(1.45);
  SetCounter(256); 
  SetOptions('Area,Mean, Perimeter');
  for i:=0 to 255 do begin
    rArea[i+1]:=RedLut[i];
    rMean[i+1]:=GreenLut[i];
    rLength[i+1]:=BlueLut[i];
  end;
  ShowResults;
  SetExport('Measurements');
  Export('RGB LUT');
end;


macro 'Invert LUT [I]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  UpdateLUT;
end;


macro 'Log Tranform';
var
  i,v:integer;
  ln255:real;
BEGIN
  RedLUT[255]:=0;
  GreenLUT[255]:=0;
  BlueLUT[255]:=0;
  ln255:=ln(255);
  for i:=1 to 255 DO begin
    v:=round(ln(i)*255.0/ln255);
    RedLUT[255-i]:=v;
    GreenLUT[255-i]:=v;
    BlueLUT[255-i]:=v;
  end;
  UpdateLUT;
END.


macro 'Gamma TranformÉ [G]';
var
  i,v:integer;
  n,mode,min,max:integer
  gamma,mean:real;
begin
  gamma:=GetNumber('Gamma(0.1-3.0):',2);
  measure;
  GetResults(n,mean,mode,min,max);
  ShowMessage('min=',min:1,'\max=',max:1);
  for i:=1 to 254 DO begin
    if (i>min) and (i<max)
      then v:=exp(gamma*ln((i-min)/(max-min)))*255 {x^y=exp(y*ln(x)}
      else begin
        if i<=min then v:=0 else v:=255;
      end;
    RedLUT[i]:=255-v;
    GreenLUT[i]:=255-v;
    BlueLUT[i]:=255-v;
  end;
  UpdateLUT;
end;


macro 'Square Tranform';
var
  i,v:integer;
  sqr255:real;
BEGIN
  sqr255:=sqr(255.0);
  for i:=1 to 255 DO begin
    v:=round(sqr(i)*255.0/sqr255);
    RedLUT[255-i]:=v;
    GreenLUT[255-i]:=v;
    BlueLUT[255-i]:=v;
  end;
  UpdateLUT;
END.


macro 'Square Root Tranform';
var
  i,v:integer;
  sqrt255:real;
BEGIN
  sqrt255:=sqrt(255.0);
  for i:=1 to 255 DO begin
    v:=round(sqrt(i)*255.0/sqrt255);
    RedLUT[255-i]:=v;
    GreenLUT[255-i]:=v;
    BlueLUT[255-i]:=v;
  end;
  UpdateLUT;
END;


macro 'Reset LUT [R]';
begin
  ResetGrayMap;
end;


macro 'Plot LUT [P]';
var
  i,xscale,yscale:real;
  width,height,margin,pwidth,pheight:integer;
  xbase,ybase:integer;
begin
  SaveState;
  margin:=25;
  pwidth:=400;
  pheight:=125;
  width:=pwidth+2*margin;
  height:=pheight*3+2*margin;
  SetNewSize(width,height);
  SetBackground(0); 
  MakeNewWindow('LUT');
  xscale:=(pwidth-2)/256;
  yscale:=(pheight-1)/256;
  SetForeground(252);
  xbase:=margin; ybase:=margin;
  MoveTo(xbase,ybase);
  for i:=0 to 255 do
    LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
  SetForeground(255);
  MakeRoi(xbase,ybase,pwidth,pheight);
  FlipVertical;
  DrawBoundary;
  SetForeground(253);
  ybase:=ybase+pheight-1;
  MoveTo(xbase,ybase);
  for i:=0 to 255 do
    LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
  SetForeground(255);
  MakeRoi(xbase,ybase,pwidth,pheight);
  FlipVertical;
  DrawBoundary;
  SetForeground(254);
  ybase:=ybase+pheight-1;
  MoveTo(xbase,ybase);
  for i:=0 to 255 do
    LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
  SetForeground(255);
  MakeRoi(xbase,ybase,pwidth,pheight);
  FlipVertical;
  DrawBoundary;
  KillRoi;
  RedLUT[252]:=255; GreenLUT[252]:=0;   BlueLUT[252]:=0;
  RedLUT[253]:=0;   GreenLUT[253]:=255; BlueLUT[253]:=0;
  RedLUT[254]:=0;   GreenLUT[254]:=0;   BlueLUT[254]:=255;
  UpdateLUT;
  SetFont('Geneva');
  SetFontSize(9);
  SetText('Centered');
  MoveTo(margin+4,height-margin+8);
  writeln(0:1:2);
  MoveTo(margin+pwidth,height-margin+8);
  writeln(255:1:2);
  RestoreState;
end;


macro 'PosterizeÉ';
var
  level,i:integer
  delta,steps,StepSize,NextStep:real;
begin
  steps:=GetNumber('Number of Gray Steps(2-256):',8);
  StepSize:=256/steps;
  delta:=256/(steps-1);
  NextStep:=trunc(StepSize);
  level:=255;
  for i:=0 to 255 do begin
    if i>=NextStep then begin
      NextStep:=trunc(NextStep+StepSize);
      level:=level-delta;
      UpdateLUT;
    end;
    if level<0 then level:=0;
    RedLUT[i]:=level;
    GreenLUT[i]:=level;
    BlueLUT[i]:=level;
  end;
end;


macro 'Make Four Ramp LUT';
var
  i,entry:integer;
BEGIN
  entry:=0;
  for i:=0 to 63 DO begin
    RedLUT[entry]:=255-i*4;
    GreenLUT[entry]:=255-i*4;
    BlueLUT[entry]:=255-i*4;
    entry:=entry+1;
  end;
  for i:=0 to 63 DO begin
    RedLUT[entry]:=255-i*4;
    GreenLUT[entry]:=0;
    BlueLUT[entry]:=0;
    entry:=entry+1;
  end;
   for i:=0 to 63 DO begin
    RedLUT[entry]:=0;
    GreenLUT[entry]:=255-i*4;
    BlueLUT[entry]:=0;
    entry:=entry+1;
  end;
  for i:=0 to 63 DO begin
    RedLUT[entry]:=0;
    GreenLUT[entry]:=0;
    BlueLUT[entry]:=255-i*4;
    entry:=entry+1;
  end;
  UpdateLUT;
end.


macro 'Set Pixels RedÉ';
var
 v1,v2,i:integer;
begin
    v1:=GetNumber('Starting Pixel Value(1-254)',10);
    v2:=GetNumber('Ending Pixel Value(1-254)',10);
    if v2<v1 then begin
      PutMessage('Ending value less than starting value.');
      exit;
    end;
    for i:=v1 to v2 do begin
      RedLUT[i]:=255;
      GreenLUT[i]:=0;
      BlueLUT[i]:=0;
    end;
  end;
  UpdateLUT;
end;


macro 'Nearly Gray LUTÉ';
{
Here is a macro that changes the LUT to make the values near 128 fairly visible when making polygon and line selections which use XOR drawing mode.
Play around with it to get better results. It was written on the
(incorrect) assumption that brightness = r+g+b.
j is i xor 255 and also white is 255,255,255 not 0,0,0.
{The brightness of each pixel is not quite right, there is a better way to get different colors with same brightness...)
--Edward J. Huff (huff@mcclb0.med.nyu.edu)
}
var
 i,j,d: integer;
begin
   while (d < 1) or (d > 63) do
     d := GetNumber('Amount of color',20);
  for i := d*2 to 127 do begin
     j := 255 - i; 
     RedLUT[i] := j + d;
     GreenLUT[i] := j + d;
     BlueLUT[i] := j - d*2;
     RedLUT[j] := i - d*2;
     GreenLUT[j] := i + d;
     BlueLUT[j] := i + d;
  end;
  UpdateLUT;
end;

macro 'Color Merge Two Images';
{
Merges a "red" image and a "green" image to create a
composite color image. The macro does this by scaling both
images to 0-15, multiplying the second by 16, creating a
single 8-bit by ORing the two 4-bit images, and then
generating a custom red and green LUT to display the
composite image.
}
var
  i,w1,w2,h1,h2,merged:integer;
begin
  SaveState;
  if nPics<>2 then begin
    PutMessage('This macro operates on exactly two images.');
    exit;
  end;
  SelectPic(1);
  GetPicSize(w1,h1);
  SelectPic(2);
  GetPicSize(w2,h2);
  if (w1<>w2) or (h1<>h2) then begin
    PutMessage('The two images must have the same width and height.');
    exit;
  end;
  SetNewSize(w1,h2);
  MakeNewWindow('Merged');
  merged:=PicNumber;
  SelectPic(1);
  SelectAll;
  Copy;
  SelectPic(merged);
  Paste;
  SelectAll;
  MultiplyByConstant(1/16);
  ChangeValues(0,0,1);
  ChangeValues(16,16,15);
  SelectPic(2);
  SelectAll;
  Duplicate('Temp');
  MultiplyByConstant(1/16);
  ChangeValues(16,16,15);
  MultiplyByConstant(16);
  ChangeValues(0,0,1);
  SelectAll;
  Copy;
  SelectPic(merged);
  Paste;
  DoOr;
  for i:=0 to 255 do begin
     RedLut[i]:=(i mod 16)*16;
     GreenLut[i]:=(i div 16)*16;
     BlueLut[i]:=0;
   end;
  UpdateLut;
  SelectPic(nPics);
  Dispose;  {Temp}
  RestoreState;
end;