{Simple morphology of cells by Michael Cammer}
{1.  Prep the stack to set the color range properly for the markings.
 2.  Initialize new set to begin tracings of a single cell.
 3.  [skip]
 4.  trace & Measure.
 5.  save the measurements window
 6.  save the marked picture
 7.  return to step 2 to do the next cell.
}

macro 'Import IPLab 8-bit File';
var
   width,height,offset:integer;
begin
   width:=100; 
   height:=1;
   offset:=0;
   SetImport('8-bit'); 
   SetCustom(width,height,offset);
   Import(''); {Read in header as an image, prompting for file name.}
   width := (GetPixel(8,0)*256) + GetPixel(9,0);
   height := (GetPixel(12,0)*256) + GetPixel(13,0);
   Dispose;  
   offset:=2120;  {The IPLab offset}
   SetImport('8-bit');
   SetCustom(width,height,offset,2047);
   Import('');  {No prompt this time; Import remembers the name.}
end;

procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;

MACRO 'First Slice [f]';
Begin
  SelectSlice(1);
End;

{Make all the centroids = 2 and all the tracings = 1}
MACRO 'Prep the Image [p]';
VAR
  count : integer;
  winname : string;
BEGIN
  FOR count := 1 to nSlices DO
    BEGIN
      SelectSlice(count);
      AddConstant(6);
    END;
  winname := WindowTitle;
  Delete(winname, length(winname)-4,4);
  SetPicName(ConCat(winname,'P'));
END;  {MACRO 'Prep the Image [p]';}


MACRO 'Initialize New Set [i]'
BEGIN
  InvertY(FALSE);  {CHANGE TO TRUE IF PATHS DRAWN UPSIDE DOWN}
  SetPrecision(2,2);
  SetOptions('Area X-Y Center Perimeter User1 Major Minor Angle');
  SetScale(0,'pixel');
  SetUser1Label('circle');
  ResetCounter;
  SelectSlice(1);
END;


MACRO 'Measure [1]';
VAR
  ifstack : boolean;  {is the image a stack?  if it is, assume that the user
                        wants to trace each slice in order}
  x, y : integer;
BEGIN
  ifstack := TRUE;  {assume image is a stack}
  IF nSlices < 2 THEN ifstack := FALSE;
  IF Get('RoiType') = 0 THEN        {check for a ROI; does not check type of ROI}
    BEGIN
      PutMessage('No Region Of Interest selected');
      Exit;
    END;
  Measure;
   {mark the edge}
   SetLineWidth(2);  SetForegroundColor(1);  DrawBoundary;
   {Get the centroid}
   x := Round(rX[rCount]);  y := Round(rY[rCount]);
   {draw the line from centroid to centroid}
   SetForegroundColor(3); 
   IF rCount > 1 THEN BEGIN  SetLineWidth(3);  MakeLineROI(rUser1[rCount+1],rUser2[rCount+1],x,y);
   DrawBoundary;  Fill;  END;  KillROI; 
   {mark the centroid}
   SetForegroundColor(2);    MakeROI(x-1,y,3, 1); Fill;  
   MakeROI(x,y-1,1,3); Fill; KillRoi;
   {save the current centroid}
   rUser1[rCount + 2] := x;  rUser2[rCount + 2] := y;
  {Calculate the variance from a circle}
  rUser1[rCount] := ((rLength[rCount]/(2*3.1415))*(rLength[rCount]/(2*3.1415))*3.1415) / rArea[rCount]  ;
  IF ifstack AND (SliceNumber < nSlices) THEN SelectSlice(SliceNumber + 1);  {next slice}
END;  {MACRO 'Measure [1]';}




macro '(-' begin end;
PROCEDURE MaxProjection;
begin
  SetProjection('Initial Angle',0);
  SetProjection('Total Rotation',0);
  SetProjection('Total Rotation',0);
  SetDensitySlice(0,254);
  SetProjection('Surface Opacity',0);
  SetProjection('Surface Depth-Cueing',0);
  SetProjection('Interior Depth-Cueing',0);
  SetProjection('Brightest');
  Project;  StackToWindows;
end; 


{centroid=2    perimeter=1    path=3}
PROCEDURE SelectTheFeature (feature1, feature2:integer);
VAR
  count : integer;
  colors : integer;
BEGIN
  colors := Round(255/nSlices);
  FOR count := 1 to nSlices DO
    BEGIN
      SelectSlice(count);
      ChangeValues(feature2+1, 255, 255);
      ChangeValues(0 ,feature1-1, 255);
      IF feature1 = 1 THEN
        BEGIN
           AddConstant(255-(colors*count));
        END;
    END;
  
  MaxProjection;
END;

MACRO 'See Only Centroids [c]';
BEGIN
  SelectTheFeature(2,2);
END;

MACRO 'See Paths [t]';
BEGIN
  SelectTheFeature(2,3);
  
END;

MACRO 'See the perimeters';
BEGIN
   SelectTheFeature(1,1);
END;

MACRO 'See all markings';
BEGIN
   SelectTheFeature(1,3);
END;

macro '(-' begin 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 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:=1;
  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 'Sharpen';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    SetOption; Smooth;
    SetOption; Sharpen;
  end;
end;

Macro 'Stack to Windows'
var
  mystack,i:integer
  width,height:integer;
begin
  SaveState;
  CheckForStack;
  GetPicSize(width,height);
  SetNewSize(width,height);
  mystack := picnumber;
  for i:=1 to nslices do begin
    SelectSlice(i);
    SelectAll;
    copy;
    MakeNewWindow(i);
    paste;
    SelectPic(myStack);
  end;
  Dispose(myStack);
  KillRoi;
  RestoreState;
end;

macro 'Invert';
var
  i:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
    SelectSlice(i);
    Invert;
  end;
end;

macro 'Delete Slice [x]'; begin CheckForStack; DeleteSlice; end;

 