var 
  n:integer

macro 'Print Video [P]';
begin
  CallExport('TV-3 Module');
end;


{ macros continuously integrate and display frames either on-clip, using the Scion LG-3 and a Coho 4910. Press and hold the mouse button near top of Camera window to increase the number of frames. Press near bottom to decrease number of frames. Press above or to left of Camera  to stop integrating. Each increment/decrement is 25% of preceding value.}

procedure Integrate (mode:string);
var
  { n:integer;  Global variable used by integration macros}
   x,y,delta:integer;
begin
   if n=0 then n:=6;
   repeat
      if button then begin
         GetMouse(x,y);
         if (x<0) or (y<0) then exit;
         delta:=round(0.250*n);
         if delta<1 then delta:=1;
         if y>220 then begin
            n:=n-delta;
            if n<1 then n:=1;
         end else begin
             n:=n+delta;
             if n>480 then n:=480;
         end;
      end;
     ShowHistogram;  
     AverageFrames(mode, n);
     {ShowHistogram;}
   until false;
end;

macro 'Integrate On-chip Using Cohu [C]';
begin
  Integrate('integrate on-chip');
end;

macro 'Integrate One Image on Cohu [V]';
begin
    AverageFrames('integrate on-chip',n);
     ShowHistogram;
end;

macro '(-';begin end;

{ Macro to read BioRAD files - both single sections and Z-Series }

procedure ShowBioRadInfo ;
{Displays the contents of the 480(?) byte header at}
{the end of Biorad MRC 600 Z Series files.}
var
  MaxInfoSize,offset:integer;
  ch:string;
begin
  MaxInfoSize:=480;
  SetCustom(MaxInfoSize,1,HdrSize+Width*Height);
  SetImport('8-bit'); {Don't invert}
  Import('');
  GetRow(0,0,MaxInfoSize);
  Dispose;
  SetNewSize(460,100);
  SetForeground(255);
  SetBackground(0);
  NewTextWindow('Info');
  SetCursor('Watch');
  SetFont('Monaco');
  SetText('With background; Left Justified');
  SetFontSize(12);
  MoveTo(8,10);
  for i:=0 to MaxInfoSize-1 do begin
    offset:=i mod 96;
    if offset=0 then writeln;
    ch:=chr(LineBuffer[i]);
    if (offset=2) and (ord(ch)=0) then exit;
    if (offset>=16) and (offset<=95) and (ord(ch)>=32) and (ord(ch)<=126)
      then write(ch);
  end;
end;


macro 'Import Biorad MRC 600 Z Series [Z]';
{
Imports a Z series(multiple images per file) from a Biorad MRC 600
confocal microscope.  The width, height and number of images are
extracted from the first 3 16-bit word in the 76 byte header and
the file name is extracted from bytes 18-23 of the header. Note that
the Undo and Clipboard buffers must be set to  at least 384K to work with
the typical 768x512 Biorad images.
}
var
  width,height,nImages,offset,hdrsize,i,start,picsize:integer;
begin
  RequiresVersion(1.50);
  width:=512;
  height:=1;
  offset:=0;
  SetImport('8-bit');
  SetCustom(width,height,offset);
  Import(''); {Read header}
  width:=GetPixel(0,0)+GetPixel(1,0)*256;
  height:=GetPixel(2,0)+GetPixel(3,0)*256;
  nImages:=GetPixel(4,0)+GetPixel(5,0)*256;
  Dispose;
  hdrsize:= 76;
  picsize:=width*height;
  if (width<128) or (width>2048) or (height<128) or (height>2048) or
(nImages<1) or (nImages>256) then begin
    PutMessage('This does not seem to be a Biorad MRC 600 Z Series file.');
    exit;
  end;
  start:=GetNumber('Starting image:',1);
  offset:=HdrSize+(start-1)*PicSize;
  SetImport('8-bit; Invert');
  SetCustom(width,height,offset,nimages);
  Import('');
  for i:=1 to nSlices do begin
    SelectSlice(i);
   { Invert;}
    ChangeValues(0,0,1);
    ChangeValues(255,255,254);
  end;
  ShowBioRadInfo;
  {Add SetScale  and SliceSpacing  Calls at this point for calibrating mag factor and 
    Z-series spacing. }
end;
macro 'Merge Split BioRAD [S]';
{Makes a macro that color merges a split screen BioRAD image, as a merged color image.}

var
  p,w,h,rgb: integer
 name: string;

begin
  p:= PidNumber;
  SelectPic(p);
  GetPicSize(w,h);
  MakeRoi(0,0,w/2,h);
  Copy;
  SetNewSize(w/2,h); 
  name := GetString('New Stack Name', 'RGB');
  MakeNewStack(name);
{Change this to read the name of the original file "Original Name", then name the new stack as "Original Name - Unsplit&Merge". }
   rgb:=PicNumber;
  SelectPic(rgb);
  Paste;
  SetBackground(255);
  AddSlice;
  AddSlice;
  SelectPic(p);
  MakeRoi(w/2,0,w/2,h);
  Copy;
  SelectPic(rgb);
  SelectSlice(2);
  Paste;
  SetBackGround (255);
  RGBToIndexed('System');
end;

macro '(-' begin end;

{This file contains macros that work with stacks.}

macro 'Add Slice [A]';    begin AddSlice end;
macro 'Delete Slice [D]'; begin DeleteSlice end;


procedure CheckForStack;
begin
  if nSlices=0 then begin
    PutMessage('This window is not a stack');
    exit;
  end;
end;

macro 'Smooth Stack';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    SetOption; Smooth;
  end;
end;

macro 'Sharpen Stack';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    SetOption; Smooth;
    SetOption; Sharpen;
  end;
end;


macro 'Invert Stack';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    Invert;
  end;
end;

macro 'Reduce Noise Stack';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    ReduceNoise;
  end;
end;

macro 'Apply LUT to Stack [L]';
var
  i,stack,slices:integer;
begin
  CheckForStack;
  stack:=PicNumber;
  slices:=nSlices;
  Duplicate('Temp');
  for i:= 1 to slices do begin
    SelectPic(stack);
    SelectSlice(i);
    ApplyLut;
    SelectPic(nPics);
    if i<>slices then PropagateLut;
  end;
  SelectPic(nPics);
   Dispose; 
end;


macro 'Remove 0 and 255 from Stack';
{
Changes 0 to 1 and 255 to 254 in all slices. We want to do this because
pixel values of 0(which always displays as white) and 255(always
displays as black) cause problems when pseudo-coloring images.
}
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    ChangeValues(0,0,1);
    ChangeValues(255,255,254);
  end;
end;

macro 'Remove 0 and 255 from Single';
{
Changes 0 to 1 and 255 to 254 in all slices. We want to do this because
pixel values of 0(which always displays as white) and 255(always
displays as black) cause problems when pseudo-coloring images.
}
var
  i:integer;
begin
    ChangeValues(0,0,1);
    ChangeValues(255,255,254);
  end;
end;


procedure flip(vertical:boolean);
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    if vertical
      then FlipVertical
      else FlipHorizontal;
  end;
end;

macro 'Flip Stack Vertical';   begin flip(true) end;
macro 'Flip Stack Horizontal'; begin flip(false) end;


procedure CheckForSelection;
var 
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  GetLine(x1,y1,x2,y2,LineWidth);
  if (RoiWidth=0) or (x1>=0) then begin
    PutMessage('Please make a rectangular selection.');
    exit;
  end;
end;


macro 'Clear Outside Stack';
var
  i:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
begin
  CheckForStack;
  CheckForSelection;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    Copy;
    SelectAll;
    Clear;
    RestoreRoi;
    Paste;
    RestoreRoi;
  end;
end;


procedure CropAndScale(fast:boolean; angle:real);
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);
  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;
  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;
  if not OneToOne then begin
    if fast 
      then SetScaling('Nearest; Create New Window')
      else SetScaling('Bilinear; Create New Window');
  end;
  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;

macro 'Crop and Scale-FastÉ';   begin CropAndScale(true, 0); end;
macro 'Crop and Scale-SmoothÉ'; begin CropAndScale(false, 0); end;

procedure Rotate(left:boolean);
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,SliceSpacing:real;
  OneToOne:boolean;
begin
  CheckForStack;
  SelectAll;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  OldStack:=PicNumber;
  SliceSpacing:=GetSliceSpacing;
  N:=nSlices;
  SetNewSize(RoiHeight,RoiWidth);
  MakeNewStack('Stack');
  if SliceSpacing>0 then SetSliceSpacing(SliceSpacing);
  NewStack:=PicNumber;
  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if left
      then RotateLeft(true)
      else RotateRight(true);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    ChoosePic(nPics);
    Dispose;
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose;
end;


macro 'Rotate Left';  begin rotate(true) end;
macro 'Rotate Right'; begin rotate(false) end;


macro 'RotateÉ';
var
  angle:real;
begin
  angle:=GetNumber('Angle(-180.0¡..180.0¡):',45.0);
  CropAndScale(false, angle);
end;



macro 'Delete Even Slices';
var
  n:integer;
begin
  CheckForStack;
  SelectSlice(2);
  repeat
    DeleteSlice;
    n:=SliceNumber;
    n:=n+2;
    if n>nSlices then exit;
    SelectSlice(n);
   until false;
end;


macro 'Replicate Slices';
var
  n,i,RepFactor:integer;
begin
  CheckForStack;
  RepFactor:=GetNumber('Replication factor(2,3,4,5,etc):',2);
  n:=nSlices;
  repeat
    SelectSlice(n);
    SelectAll;
    Copy;
    for i:=2 to RepFactor do begin
      AddSlice;
      Paste;
    end;
    n:=n-1;
   until n=0;
   KillRoi;
end;

macro 'Color Merge Two Images';
{
Merges a "red" image and a "green" image to
create a composite color image by creating a
temporary 24-bit image and converted to 8-bits.
}
var
  i,w1,w2,h1,h2,rgb:integer;
begin
  RequiresVersion(1.50);
  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);
  SetBackground(255);
  MakeNewStack('RGB');
  AddSlice;
  AddSlice;
  rgb:=PicNumber;
  SelectPic(1);
  SelectAll;
  Copy;
  SelectPic(rgb);
  SelectSlice(1);
  Paste;
  SelectPic(2);
  SelectAll;
  Copy;
  SelectPic(rgb);
  SelectSlice(2);
  Paste;
   RGBToIndexed('Custom');
  { The following two steps trash RGB Stack used for  merging. 
      If you want to modify the images in the stack for color re-merging, by altering the 
      brightness, contrast or filtering the individual images, then it will save time if you
      keep  the RGB stack}
  {SelectPic(rgb);
  Dispose;
  RestoreState;}
end;

macro 'Swap Red_Green [W]';
{This will swap the Red and Green slices from a stack, then color merge them. This will give unpredictable results if you have a Red/Blue slice.}
begin
  CheckforStack;
  SelectSlice(1);
  SelectAll;
  Copy;
  DeleteSlice;
  SetBackground(255);
  AddSlice;
  Paste;
  RGBToIndexed('System Dither');
end;

macro 'Separate SplitScreen Z Stack [T]';
var
  LeftStack,RightStack,OriginalStack,w,h,i,OriginalnSlices:integer
 name: string;
begin
  {set up parameters for new stacks}
  CheckForStack;  
  OriginalStack:= PidNumber;
  ChoosePic(OriginalStack);
  OriginalnSlices:=nSlices;
  GetPicSize(w,h);
  SetNewSize(w/2,h); 
  SetBackground(255);
  name := GetString('New Stack Name', 'RGB');
  MakeNewStack(name,' Left Stack');
   LeftStack:=PidNumber;
  MakeNewStack(name,' Right Stack');
  RightStack:=PidNumber;
{ OK, now you have two stacks, Left Stack and Right Stack}
 { PutMessage('This Stack has ',nSlices,' slices. Slice =',i);}
for i:= 1 to OriginalnSlices do begin
  ChoosePic(OriginalStack);
  SelectSlice(i);
  MakeRoi(0,0,w/2,h);
  Copy;
  ChoosePic(LeftStack);
  ChooseSlice(i);
  Paste;
  SetBackground(255);
  AddSlice;
 ChoosePic(OriginalStack);
  MakeRoi(w/2,0,w/2,h);
  Copy;
  KillRoi;
  ChoosePic(RightStack);
  SelectSlice(i);
  Paste;
  SetBackground(255);
  AddSlice;
  KillRoi;
{  SelectPic(OriginalStack);}
 end;
end;

macro 'Color Merge Two Stacks';
{
Merges a "red" stack and a "green" stack to
create a new composite color stack.
}
var
  i,w1,w2,h1,h2,d1,d2,d3:integer;
  rgb,merged:integer;
begin
  RequiresVersion(1.50); 
  SaveState;
  if nPics<>2 then begin
    PutMessage('This macro operates on exactly two stacks.');
    exit;
  end;
  SelectPic(1);
  GetPicSize(w1,h1);
  d1:=nSlices;
  SelectPic(2);
  GetPicSize(w2,h2);
  d2:=nSlices;
  if (d1=0) or (d2=0) then begin
    PutMessage('Both images must be stacks.');
    exit;
  end;
{ Checks to see if both stacks have equal number of slices }
  if d1>=d2
    then d3:=d2
    else d3:=d1;
  if (w1<>w2) or (h1<>h2) then begin
    PutMessage('The two stacks must have the same width and height.');
    exit;
  end;
  SetNewSize(w1,h2);
  SetBackground(255);
  MakeNewStack('RGB');
  AddSlice;
  AddSlice;
  rgb:=PicNumber;
  SetPalette('System');
  MakeNewStack('Merged');
  merged:=PicNumber;
  for i:=1 to d3 do begin
    SelectPic(1);
    SelectSlice(i);
    SelectAll;
    Copy;
{ Following line was deleted,  as it  makes value of 'd3' erroneous when used in loop}
    {DeleteSlice;}
    SelectPic(rgb);
    SelectSlice(1);
    SelectAll;
    Paste;
   { Invert;}
    SelectPic(2);
    SelectSlice(i);
    SelectAll;
    Copy;
{Following line was deleted, for same as previous reason above }
   { DeleteSlice;}
    SelectPic(rgb);
    SelectSlice(2);
    SelectAll;
    Paste;
   { Invert;}
    SelectPic(rgb);
    RGBToIndexed('System');
    SelectAll;
    Copy;
    Dispose;
    SelectPic(merged);
    Paste;
    if i<>d3 then AddSlice;
 end;
      SelectPic(rgb);
      Dispose;
     RestoreState;
end;

macro 'Merge Two Stacks';
{
Combines two stacks(w1xh1xd1 and w2xh2xd2) to create a new
w1+w2 x max(h1,h2) x max(d1,d2) stack. For example, a 256x256x40
and a 256x256x30 stack would be combined into one 512x256x40 stack.
}
var
  i,w1,w2,w3,h1,h2,h3,d1,d2,d3:integer;
begin
  SaveState;
  if nPics<>2 then begin
    PutMessage('This macro operates on exactly two stacks.');
    exit;
  end;
  SelectPic(1);
  GetPicSize(w1,h1);
  d1:=nSlices;
  SelectPic(2);
  GetPicSize(w2,h2);
  d2:=nSlices;
  if d1>=d2
    then d3:=d1
    else d3:=d2;
  if d3=0 then begin
    PutMessage('Both images must be stacks.');
    exit;
  end;
  w3:=w1+w2;
  if h1>=h2
    then h3:=h1
    else h3:=h2;
  SetNewSize(w3,h3);
  MakeNewStack('Merged');
  for i:=1 to d3 do begin
    SelectPic(1);
    SelectSlice(1);
    SelectAll;
    Copy;
    DeleteSlice;
    SelectPic(3);
    MakeRoi(0,0,w1,h1);
    Paste;
    SelectPic(2);
    SelectSlice(1);
    SelectAll;
    Copy;
    DeleteSlice;
    SelectPic(3);
    MakeRoi(w1,0,w2,h2);
    Paste;
    if i<d3 then AddSlice;
  end;
  SelectPic(1);
  Dispose;
  SelectPic(1);
  Dispose;
  RestoreState;
end;


macro 'Average Two Stacks';
{Creates the frame by frame average of two stacks.}
var
  i,w1,w2,w3,h1,h2,h3,d1,d2,d3,avg:integer;
begin
  RequiresVersion(1.53);
  SaveState;
  if nPics<>2 then begin
    PutMessage('This macro operates on exactly two stacks.');
    exit;
  end;
  SelectPic(1);
  KillRoi;
  GetPicSize(w1,h1);
  d1:=nSlices;
  SelectPic(2);
  KillRoi;
  GetPicSize(w2,h2);
  d2:=nSlices;
  if d1>=d2
    then d3:=d1
    else d3:=d2;
  if (w1<>w2) or (h1<>h2) or (d1<>d2) or (d1=0)  then begin
    PutMessage('This macro requires two stacks that are the same size.');
    exit;
  end;
  SetNewSize(w1,h1);
  MakeNewStack('Average');
  avg:=PicNumber;
  for i:=1 to d1 do begin
    SelectPic(1);
    SelectSlice(i);
    SelectPic(2);
    SelectSlice(i);
   ImageMath('Add', 1, 2, 0.5, 0, 'Temp');
    SelectAll;
    Copy;
    dispose;
    SelectPic(avg);
    if i<>1 then AddSlice;
    paste;
   end;
  RestoreState;
end;

macro 'Save Slices as files';
{
This macro saves the slices in a stack as individual TIFF or PICT files using
names of the form needed by Apple's Convert to [QuickTime]Movie utility.
To specify the file type, checked either TIFF or PICT in the SaveAs dialog
box, which should only appear once.
}
var
  i,stack:integer;
begin
  CheckForStack;
  stack:=PicNumber;
  for i:= 1 to nSlices do begin
    SelectPic(stack);
    SelectSlice(i);
    Duplicate('Frame.',i:2);
    SaveAs;
    {Export;}
    Dispose;
  end;
end;


macro 'Windows to Stack';
{Unlike the menu command of the same name, the windows do not all need to be the same size. However, this version is flawed as it makes a stack that is only as large as the smallest window, thereby cropping the larger image. This should be corrected to make a window large enough to encompass the largest open window.}
var
  i,width,height,MinWidth,MinHeight,n,stack:integer;
  isStack:boolean;
begin
  if nPics<=1 then begin
    PutMessage('At least two images must be open.');
    exit;
  end;
{The following section should be re-written to set the new stack size to be large enough for the largest window, rather than the smallest window. } 
 MinWidth:=9999;
  MinHeight:=9999;
  isStack:=false;
  for i:=1 to nPics do begin
    SelectPic(i);
    GetPicSize(width,height);
    if width<MinWidth then MinWidth:=width;
    if height<MinHeight then MinHeight:=height;
    isStack:=isStack or (nSlices>0);
  end;
  if isStack then begin
    PutMessage('This macro does not work with stacks.');
    exit;
  end;
  if odd(MinWidth) then MinWidth:=MinWidth-1;
  n:=nPics;
  SaveState;
  SetNewSize(MinWidth,MinHeight);
  MakeNewStack('Stack');
  stack:=nPics;
  for i:=1 to n do begin
    SelectPic(1);
    MakeRoi(0,0,MinWidth,MinHeight);
    copy;;
    Dispose;
    SelectPic(nPics);
    paste;
    if i<>n then AddSlice;
  end;
  KillRoi;
  RestoreState;
end;


procedure DoReslicing(horizontal:boolean);
var
  OutputSpacing,stack1,stack2,width,height:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight,loc,max:integer;
  InputSpacing:real;
  FirstTime:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  SetBackground(0);
  SetBackground(255);
  stack1:=PicNumber;
  InputSpacing:=GetSliceSpacing;
  if InputSpacing<=0 then InputSpacing:=1;
  InputSpacing:=GetNumber('Input Slice Spacing:',InputSpacing);
  SetSliceSpacing(InputSpacing);
  OutputSpacing:=round(InputSpacing+0.25);
  OutputSpacing:=round(GetNumber('Output Slice Spacing:',OutputSpacing));
  FirstTime:=true;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  if horizontal then begin
    loc:=RoiTop+OutputSpacing;
    max:=RoiTop+RoiHeight;
  end else begin
    loc:=RoiLeft+OutputSpacing;
    max:=RoiLeft+RoiWidth;
  end;
  while loc<max do begin
    ChoosePic(stack1);
    if horizontal
      then MakeLineRoi(RoiLeft,loc,RoiLeft+RoiWidth,loc)
      else MakeLineRoi(loc,RoiTop,loc,RoiTop+RoiTop+RoiHeight);
    Reslice;
    SelectAll;
    Copy;
    GetPicSize(width,height);
    Dispose;
    if FirstTime then begin
      SetNewSize(width,height);
      MakeNewStack(OutputSpacing:1:2);
      SetSliceSpacing(OutputSpacing);
      stack2:=PicNumber;
    end;
    ChoosePic(stack2);
    if not FirstTime then AddSlice;
    Paste;
    loc:=loc+OutputSpacing;
    FirstTime:=false;
  end;
  SelectPic(stack1);
  RestoreRoi;
  SelectPic(stack2);
  KillRoi;
  RestoreState;
end;


macro 'Reslice Horizontally [H]'; begin DoReslicing(true) end;
macro 'Reslice Vertically [V]';   begin DoReslicing(false) end;

macro 'Make stack same size as front image [N]';
var
 width, height: integer;
 name: string;
begin
 SaveState;
 GetPicSize(width, height);
 SelectAll;
 Copy;
 KillRoi;
 SetNewSize(width, height);
 name := GetString('New Stack Name', 'stack');
 SetBackground(255); 
 MakeNewStack(name);
 Paste;
 KillRoi;
 RestoreState;
end;

macro '(-' begin end;

Macro 'Draw Arrow [W]...'
{Draws an arrow based on the current straight line selection.}
var
  size,angle,dx,dy,pi,theta:real;
  x1,y1,x2,y2,LineWidth,width,height:integer;
begin
  size:=12;  {pixels}
  angle:=20; {degrees}
  pi:=3.14159;
  GetLine(x1,y1,x2,y2,LineWidth);
  if x1<0 then begin
    PutMessage('Use the line tool(straight) to select a line first.');
    exit;
  end;
  MoveTo(x1,y1);
  LineTo(x2,y2);
  KillRoi;
  GetPicSize(width,height);
  y1:=height-y1;
  y2:=height-y2;
  if LineWidth>1 then size:=size*LineWidth*0.5;
  angle:=(angle/180)*pi;
  dx:=x1-x2;
  dy:=y1-y2;
  if dx=0 then begin
    if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  end else begin
    theta:=arctan(dy/dx);
    if dx<0 then theta:=theta+pi;
  end;
  moveto(x2,height-y2);
 lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle)));
  moveto(x2,height-y2);
 lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle)));
end;

macro '(-'; begin; end;

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 '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;
  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 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 '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 '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 [Y]';
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;