{Manual stereology macros for NIH Image.

 Overlay grids on an image with arrays of lines or points (reports
 the number of points or the length of the lines in image units).
 Grids provided include three different point arrays and four
 line arrays, one of which is cycloids for vertical section method.
 Then use paintbrush set to any of the fixed colors (up to 6)
 to mark locations to be counted (e.g., where line grids cross
 feature boundaries). Finally, use macro to count marks in each
 class, and use results for stereological calculations.

 For more details, see the paper "Computer-Assisted Manual Stereology"
 in Journal of Computer Assisted Microscopy, vol. 7 #1, p. 1, Mar. 1995

 © 1995 John C. Russ - may be freely distributed if the documentation
 is included.}

Macro 'Point Grid';
Var
   k,x,y,xoff,pwd,pht,nrow,ncol:integer;
   area,ppx:real;
	  un:string;
Begin
   GetPicSize(pwd,pht);
			NRow:=pht div 50;
			NCol:=pwd div 50;
			XOff:=(pwd - 50*NCol) div 2;
			if XOff<25 THEN XOff:=25;
			y:=(pht - 50*NRow) div 2;
			if y<25 THEN y:=25;
      Setlinewidth(1);
			k:=0;
			repeat {until >pht}
				  x:= XOff;
				  repeat {until >pwd}
						   MoveTo (x-5, y);
						   LineTo (x-1, y);
					   	MoveTo (x+1, y);
				   		LineTo (x+5, y);
			   			MoveTo (x, y-5);
		   				LineTo (x, y-1);
		   				MoveTo (x, y+1);
		   				LineTo (x, y+5);
		   				k:=k+1; {counter}
			   			x:=x+50;
			  	until ((x+10)>pwd);
			  	y:=y+50;
			until ((y+20)>pht);
   GetScale(ppx,un);
			MoveTo (2,pht-6);
   SetFont('Geneva');
   SetFontSize(10);
   Write('Total Points=',k:3);
	  Area:=pwd*pht/(ppx*ppx);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,'sq.',un);
End;

Macro 'Staggered Grid';
Var
   i,k,x,y,xoff,yoff,pwd,pht,nrow,ncol:integer;
   area,ppx:real;
   un:string;
Begin
   GetPicSize(pwd,pht);
			nrow:=pht div 34;
			ncol:=pwd div 50;
			XOff:=(pwd - 50*NCol) div 2;
			if XOff<25 THEN XOff:=25;
			YOff:=(pht - 34*NRow) div 2;
			if yoff<25 THEN yoff:=25;
      setlinewidth(1);
			k:=0;
			i:=0;
			y:=yoff;
			repeat {until >height}
				  x:= XOff;
				  IF (2*(i div 2)=i)
					    THEN x:= x + 25;
				  repeat {until >width}
					   	MoveTo (x-5, y);
						   LineTo (x-2, y);
						   MoveTo (x+2, y);
						   LineTo (x+5, y);
						   MoveTo (x, y-5);
					   	LineTo (x, y-2);
				   		MoveTo (x, y+2);
			   			LineTo (x, y+5);
         MakeOvalRoi(x-2,y-2,5,5);
         DrawBoundary;
         KillRoi;
				   		k:=k+1; {counter}
				   		x:=x+50;
		   	until ((x+25)>pwd);
		   	y:=y+34;
			   i:=i+1;
			until ((y+25)>pht);
   GetScale(ppx,un);
			MoveTo (2,pht-6);
   SetFont('Geneva');
   SetFontSize(10);
   Write('Total Points=',k:3);
	  Area:=pwd*pht/(ppx*ppx);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,'sq.',un);
END;

Macro 'Cycloids';
Var
   h,i,j,k,x,y,xoff,yoff,pwd,pht,nrow,ncol,xstep,ystep:integer;
   len,area,ppx,pi,theta:real;
   un:string;
Begin
	  pi:=3.14159265;
   GetPicSize(pwd,pht);
			NRow:=pht div 90;
			NCol:=pwd div 130;
			XOff:=(pwd - 130*NCol) div 2;
			YOff:=(pht - 90*NRow) div 2;
   {cycloids are 110 wide x 70 high, length 140}
   setlinewidth(1);
	  h:=0;
			FOR j:=1 to NRow DO
				  BEGIN
					    y:=yoff + j*90-10;
					    For i:=1 to ncol DO
						      BEGIN
							        x:=xoff+(i-1)*130+10;
							        IF (h mod 4)=0 THEN
                  BEGIN
									            MoveTo (x,y);
									            For k := 1 to 40 DO
										              BEGIN
											                theta:=(pi/40) *k;
											                xstep:=round(35*(theta-sin(theta)));
											                ystep:=round(35*(1.0-cos(theta)));
											                Lineto (x+xstep,y-ystep);
										              END;
                  END;
		             IF (h mod 4)=1 THEN
                  BEGIN
									            MoveTo (x,y-70);
								         	   For k := 1 to 40 DO
							            		   BEGIN
							                				theta:=(pi/40) *k;
						                					xstep:=round(35*(theta-sin(theta)));
												               ystep:=round(35*(1.0-cos(theta)));
					             						   Lineto (x+xstep,y-70+ystep);
				           					   	END;
                  END;
				     		   	IF (h mod 4)=2 THEN
                  BEGIN
					   			         	MoveTo (x+110,y);
									            For k := 1 to 40 DO
									              	BEGIN
										                	theta:=(pi/40) *k;
									                		xstep:=round(35*(theta-sin(theta)));
									                		ystep:=round(35*(1.0-cos(theta)));
							                				Lineto (x+110-xstep,y-ystep);
							           	   		END;
                  END;
		             IF (h mod 4)=3 THEN
                  BEGIN
									            MoveTo (x+110,y-70);
									            For k := 1 to 40 DO
									              	BEGIN
										                	theta:=(pi/40) *k;
										                	xstep:=round(35*(theta-sin(theta)));
										                	ystep:=round(35*(1.0-cos(theta)));
									                		Lineto (x+110-xstep,y-70+ystep);
								              		END;
                  END;
               h:=h+1;
					       END; {for i}
				  END; {for j}
   GetScale(ppx,un);
   Len:=h*140/ppx;
			MoveTo (2,pht-6);
   SetFont('Geneva');
   SetFontSize(10);
   Write('Total Length=',Len:10:4,' ',un);
	  Area:=pwd*pht/(ppx*ppx);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,' sq.',un);
END; 

Macro 'Square Lines';
Var
   i,j,x,y,xoff,yoff,pwd,pht,nrow,ncol:integer;
   len,area,ppx:real;
   un:string;
Begin
   GetPicSize(pwd,pht);
			NRow:=pht div 100;
			NCol:=pwd div 100;
			XOff:=(pwd - 100*NCol) div 2;
			YOff:=(pht - 100*NRow) div 2;
			if XOff=0 THEN
				  BEGIN
				    	XOffset:=50;
				    	ncol:=ncol-1;
				  END;
			if yoff=0 THEN
				  BEGIN
				    	yoff:=50;
				    	nrow:=nrow-1;
				  END;
   setlinewidth(1);
			For j:=0 to NRow DO
				  BEGIN
					    y:= YOff + j*100;
				    	MoveTo (xoff, y);
				    	LineTo (pwd-xoff-1, y);
				  END;
			For i:=0 to ncol DO
				  BEGIN
					    x:= XOff + i*100;
				 	   MoveTo (x,YOff);
					    LineTo (x,pht-YOff-1);
				  END;
   GetScale(ppx,un);
   Len:=(NRow*(Ncol+1)+NCol*(Nrow+1))*100/ppx;
			MoveTo (2,pht-6);
   SetFont('Geneva');
   SetFontSize(10);
   Write('Total Length=',Len:10:4,' ',un);
	  Area:=pwd*pht/(ppx*ppx);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,' sq.',un);
END;

Macro 'Circle Grid';
var
   i,j,x,y,xoff,yoff,pwd,pht,nrow,ncol:integer;
   len,area,ppx,pi:real;
   un:string;
begin
   GetPicSize(pwd,pht);
   setlinewidth(1);
	  pi:=3.14159265;
			NRow:=pht div 120;
			NCol:=pwd div 120;
			XOff:=(pwd - 130*ncol) div 2;
			YOff:=(pht - 130*NRow) div 2;
			For j:=1 to NRow DO
			  	BEGIN
				    	y:= YOff + 15 + (j-1)*130;
					    For i:=1 to NCol DO
						      BEGIN
							        x:= XOff + 15 + (i-1)*130;
               MakeOvalRoi(x,y,101,101);
               DrawBoundary;
               KillRoi;
					      	END;
      END;
   GetScale(ppx,un);
   Len:=NRow*NCol*pi*100/ppx;
			MoveTo (2,pht-6);
   SetFont('Geneva');
   SetFontSize(10);
   Write('Total Length=',Len:10:4,' ',un);
	  Area:=pwd*pht/(ppx*ppx);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,' sq.',un);
END;

Macro '(-';
BEGIN END;


Macro 'Random Points';
Var
	  x,y,k,i,pwd,pht,limt:integer;
   ppx,area:real;
   un:string;
   collide:boolean;
Begin
			GetPicSize(pwd,pht);
   limt:=50;{number of points}
   k:=1;
			repeat
						x:=random*(pwd-20); {10 pixel margin around borders}
      y:=random*(pht-20);
      collide:=false;
      if k>1 then {avoid existing marks}
									for i:=1 to k-1 do
            if (Abs(x-rUser1[i])<5) and (Abs(y-rUser2[i])<5)
               then collide:=true;
      if not collide then
									begin
            rUser1[k]:=x;
            rUser2[k]:=y;
            MakeOvalRoi(x+6,y+6,7,7);
            DrawBoundary;
            KillRoi;
            k:=k+1;
         end;
   until (k>limt);
   GetScale(ppx,un);
	  Area:=pwd*pht/(ppx*ppx);
   SetFont('Geneva');
   SetFontSize(10);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,'sq.',un);
			Moveto (2,pht-6);
   Write('Total Points=',k-1:4);
End;
	
Macro 'Random Lines';
Var
   x,y,theta,m,area,ppx,dummy:real;
   i,j,k,x1,x2,y1,y2,pwd,pht:integer;
   len,limt:integer;
   un:string;
Begin
			GetPicSize(pwd,pht);
			len:=0;
			k:=0;
			limt:=3*(pwd+pht); {minimum total length in pixels}
			repeat {until length>limt}
						x:=random*pwd;
      y:=random*pht;
      theta:=random*3.14159265;
      m:=sin(theta)/cos(theta);
      x1:=0;
      y1:=y+m*(x1-x);
      if y1<0 then
						  begin
	           y1:=0;
            x1:=x+(y1-y)/m;
         end;
      if y1>pht then
         begin
            y1:=pht;
            x1:=x+(y1-y)/m;
         end;
      x2:=pwd;
      y2:=y+m*(x2-x);
      if y2<0 then
						  begin
	           y2:=0;
            x2:=x+(y2-y)/m;
         end;
      if y2>pht then
         begin
            y2:=pht;
            x2:=x+(y2-y)/m;
         end;
      moveto(x1,y1);
      lineto(x2,y2);
      len:=len+sqrt((x2-x1)*(x2-x1)+(y1-y2)*(y1-y2))
      k:=k+1;
   until len>limt;
   GetScale(ppx,un);
	  Area:=pwd*pht/(ppx*ppx);
   SetFont('Geneva');
   SetFontSize(10);
	  Moveto (2,pht-18);
   Write('Total Area=',Area:10:3,'sq.',un);
   Len:=Len/ppx;
			Moveto (2,pht-6);
   Write('Total Length=',Len:10:3,' ',un);
END;

Macro '(-';
BEGIN END;

Macro 'Count Marks'; {note - this routine is VERY slow because it must
access each pixel. The Photoshop drop-in is much faster for counting
features, and when used by NIH Image will perform exactly as this does
and count the number of marks in each of the six reserved colors.}
VAR
	  i,j,k,pwd,pht,valu,nbr,newfeat : integer;
BEGIN
   GetPicSize(pwd,pht);
	  For i:= 1 to 6 DO
		    BEGIN
		       rUser1[i]:=0;
      END;
   MoveTo(0,0);
	  FOR i:=1 to pht DO
		    BEGIN
         GetRow(0,i,pwd);
		      	newfeat:=0; {start of a new image line - nothing pending}
			      for j:=1 to pwd-1 DO {skip edge pixels}
				        BEGIN
					          valu:=Linebuffer[j]; {test pixel}
					          if ((valu=0) or (valu>6)) THEN
						            BEGIN {pixel is not a fixed color}
						              	if (newfeat>0) then {End of a line}
						                		BEGIN
							                  		rUser1[newfeat]:=rUser1[newfeat]+1;
							                	END;
							              newfeat:=0;
						            END;
				          	if ((valu>=1) and (valu<=6)) then {a fixed color point}
						            BEGIN
							              nbr:=LineBuffer[j-1]; {left side}
							              if (nbr<>valu) THEN {test continuation of line}
								                BEGIN
								      	            if newfeat>0 then {prev touching color}
										                    BEGIN
										                      	rUser1[newfeat]:=rUser1[newfeat]+1;
										                    END;
									                  newfeat:=valu;{start of a chord}
								                END; 
						  	            for k:=j-1 to j+1 DO {check prev line}
								                BEGIN
								      	            nbr := GetPixel(k,i-1);
								      	            if (nbr = valu) then
										                    BEGIN
										          	            newfeat:=0;{touches}
										                    END;
								                END;
						            END;
			         END; {for j}
				     LineTo(0,i); {progress indicator because getpixel is very slow}
		    END; {for i}
   Showmessage('Class#1=',rUser1[1]:3,'\Class#2=',rUser1[2]:3,'\Class#3=',rUser1[3]:3,
        '\Class#4=',rUser1[4]:3,'\Class#5=',rUser1[5]:3,'\Class#6=',rUser1[6]:3);
   {can substitute other output procedures as needed}
END;