macro 'Export LUT [E]';
{Copies the current look-up table to a text window.}
var
  i:integer;
  v:real;
  tab:string;
begin
  RequiresVersion(1.54);
  NewTextWindow('LUT',200,400);
  tab:=chr(9);
  for i:=0 to 255 do
    Writeln(i:4,tab,RedLut[i]:4,tab,GreenLut[i]:4,tab,BlueLut[i]:4);
end;

macro 'Import Text LUT';
{
Imports a LUT stored as three column (red, green, blue)
text file. If there are four columns then the first column
is assumed to conatin sequence numbers and is ignored.
}
var
  i,r,g,b, width, height, start, row:integer;
begin
  RequiresVersion(1.53);
  SetImport('Text');
  Import('');
  GetPicSize(width,height);
  if width=3 then begin
    r:=0;
    g:=1;
    b:=2
  end else if width=4 then begin
      r:=1;
      g:=2;
      b:=3
  end else begin
    PutMessage('The text file must have either 3 or 4 columns.');
    exit;
  end;
  if height=255 then
    start:=1
  else if height=256 then
      start:=0
  else begin
      PutMessage('The text file must have either 255 or 256 rows.');
      exit;
   end;
  i:=start;
  row:=0;
  repeat
    RedLut[i]:=GetPixel(r,row);
    GreenLut[i]:=GetPixel(g,row);
    BlueLut[i]:=GetPixel(b,row);
    if (i mod 10) = 0 then UpdateLUT;
    i:=i+1;
    row:=row+1;
  until row>=height;
  UpdateLUT;
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;
  scale:real;
begin
  scale := 255.0 / ln(255.0);
  for i:=1 to 254 DO begin
    v := 255-round(ln(i) * scale);
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[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 Transform';
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 'Parabolic Transform';
{ Generates a parabolic LUT}
var
  i,y:integer;
  scale:real;
begin
  scale:=1;
  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;
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;
  UpdateLUT;
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;


macro 'Move Slice Up [U]';
var
  lower,upper:integer;
begin
  GetThresholds(lower,upper);
  lower:=lower-1;
  upper:=upper-1;
  if lower<1 then lower:=1;
  if lower>254 then lower:=254;
  if upper<lower then upper:=lower;
  if upper>254 then upper:=254;
  SetDensitySlice(lower,upper);
  ShowMessage(lower:4,upper:4)
end;

macro 'Move Slice Down [D]';
var
  lower,upper:integer;
begin
  GetThresholds(lower,upper);
  lower:=lower+1;
  upper:=upper+1;
  if lower<1 then lower:=1;
  if lower>254 then lower:=254;
  if upper<lower then upper:=lower;
  if upper>254 then upper:=254;
  SetDensitySlice(lower,upper);
  ShowMessage(lower:4,upper:4)
end;

macro 'Change One LUT EntryÉ';
var
  dn:integer;
begin
  dn:=GetNumber('Gray Value(1-254):',128);
  RedLut[dn]:=GetNumber('Red(0-255):',255);
  GreenLut[dn]:=GetNumber('Green(0-255):',0);
  BlueLut[dn]:=GetNumber('Blue(0-255):',0);
  UpdateLUT;
end;

macro 'Sort LUT by Hue';
begin
  SortPalette;
  UpdateLut;
end;


macro 'Copy Calibration to LUT';
var
   i: integer;
   value: integer;
   scale, max, min: real;
begin
   max:=-999999;
   min:=999999;
   for i:= 0 to 255 do begin
       value:=cvalue(i);
       if value<min then min:=value;
       if value>max then max:=value;
   end;
   scale := 255 / (max - min);
   for i := 0 to 255 do begin
					  	value := 255 - round(scale * (cvalue(i) - min));
								RedLUT[i] := value;
								GreenLUT[i] := value;
								BlueLUT[i] := value;
				end;
				UpdateLUT;
	end;

MACRO 'Adjust Threshold'
  VAR
  level: INTEGER; 
BEGIN
   level:=50;
   ShowMessage('Use shift-key to increase threshold \Use control-key to decrease threshold  \Use option-key when threshold is set'); 
   REPEAT
      IF KeyDown('shift') AND (level<255) THEN level:=level+1;
      IF KeyDown('control') AND (level>0) THEN level:=level-1;
      SetThreshold(level);
   UNTIL KeyDown('option') or Button;
  SetThreshold(-1);
END;

macro 'Equalize';
var
  i, j, sum, v, w, h: integer;
  scale: real;
begin
  GetPicSize(w, h);
  GetHistogram(0, 0, w, h);
  sum := 0;
  for i := 0 to 255 do
     sum := sum + histogram[i];
  scale := 255 / sum;
  sum := 0;
  j := 255;
  for i := 0 to 255 do begin
     j := 255 - i;
     sum := round(sum + histogram[j] * scale);
     if sum > 255 then
        sum := 255;
     RedLut[j] := sum;
     GreenLut[j] := sum;
     BlueLut[j] := sum;
  end;
  UpdateLut;
end;