{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';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    Smooth;
  end;
end;


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


macro 'Remove 0 and 255';
{
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;


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 Vertical';   begin flip(true) end;
macro 'Flip 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;


procedure Rotate(left:boolean);
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor:real;
  OneToOne:boolean;
begin
  CheckForStack;
  SelectAll;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  OldStack:=PicNumber;
  N:=nSlices;
  SetNewSize(RoiHeight,RoiWidth);
  MakeNewStack('Stack');
  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;


procedure CropAndScale(fast:boolean);
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[1.0]:',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 then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,0);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    ChoosePic(nPics);
    Dispose;
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose;
  RestoreState;
end;

macro 'Crop and Scale-Fast';   begin CropAndScale(true); end;
macro 'Crop and Scale-Smooth'; begin CropAndScale(false); 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 '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 '(---'; begin end;


macro 'Reconstruct One Slice [R]'
begin
  Reslice;
end;


macro 'Reconstruct Horizontal Set [H]'
var
  i,nImages,step,stack1,stack2,width,height:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight,yloc:integer;
  scale:real;
  FirstTime:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  stack1:=PicNumber;
  nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  scale:=1.0;
  step:=RoiHeight div nImages;
  if odd(RoiWidth) then RoiWidth:=RoiWidth-1;
  FirstTime:=true;
  yloc:=RoiTop+step;
  while yloc<(RoiTop+RoiHeight) do begin
    ChoosePic(stack1);
    MakeLineRoi(RoiLeft,yloc,RoiLeft+RoiWidth,yloc);
    Reslice;
    SelectAll;
    Copy;
    GetPicSize(width,height);
    Dispose;
    if FirstTime then begin
      SetNewSize(width,height);
      MakeNewStack(step:1:2);
      stack2:=PicNumber;
    end;
    ChoosePic(stack2);
    if not FirstTime then AddSlice;
    Paste;
    yloc:=yloc+step;
    FirstTime:=false;
  end;
  SelectPic(stack2);
  KillRoi;
  RestoreState;
end;


macro 'Horizontal Set to Disk'
var
  i,nImages,step,stack,width,height:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight,yloc:integer;
  scale:real;
begin
  CheckForStack;
  CheckForSelection;
  stack:=PicNumber;
  nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  scale:=1.0;
  step:=RoiHeight div nImages;
  if odd(RoiWidth) then RoiWidth:=RoiWidth-1;
  yloc:=RoiTop+step;
  i:=0;
  while yloc<(RoiTop+RoiHeight) do begin
    ChoosePic(stack);
    MakeLineRoi(RoiLeft,yloc,RoiLeft+RoiWidth,yloc);
    Reslice;
    i:=i+1;
    SaveAs(step:1:2,'-',i:2:0);
    Dispose;
    yloc:=yloc+step;
  end;
end;


macro 'Reconstruct Vertical Set [V]'
var
  i,nImages,step,stack1,stack2,width,height:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight,hloc:integer;
  scale:real;
  FirstTime:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  stack1:=PicNumber;
  nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  scale:=1.0;
  step:=RoiWidth div nImages;
  if odd(RoiHeight) then RoiHeight:=RoiHeight-1;
  FirstTime:=true;
  hloc:=RoiLeft+step;
  while hloc<(RoiLeft+RoiWidth) do begin
    ChoosePic(stack1);
    MakeLineRoi(hloc,RoiTop,hloc,RoiTop+RoiHeight);
    Reslice;
    SelectAll;
    Copy;
    GetPicSize(width,height);
    Dispose;
    if FirstTime then begin
      SetNewSize(width,height);
      MakeNewStack(step:1:2);
      stack2:=PicNumber;
    end;
    ChoosePic(stack2);
    if not FirstTime then AddSlice;
    Paste;
    hloc:=hloc+step;
    FirstTime:=false;
  end;
  SelectPic(stack2);
  KillRoi;
  RestoreState;
end;


macro 'Vertical Set to Disk'
var
  i,nImages,step,stack,width,height:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight,hloc:integer;
  scale:real;
begin
  CheckForStack;
  CheckForSelection;
  stack:=PicNumber;
  nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  scale:=1.0;
  step:=RoiWidth div nImages;
  if odd(RoiHeight) then RoiHeight:=RoiHeight-1;
  hloc:=RoiLeft+step;
  i:=0;
  while hloc<(RoiLeft+RoiWidth) do begin
    ChoosePic(stack);
    MakeLineRoi(hloc,RoiTop,hloc,RoiTop+RoiHeight);
    Reslice;
    i:=i+1;
    SaveAs(step:1:2,'-',i:2:0);
    Dispose;
    hloc:=hloc+step;
  end;
end;