{ Mosaic making macros - a set of  macros for NIH-Image developed by Jeremy Young (Natural History Museum, London, jy@nhm.ac.uk). The primary purpose of these is to make composite photographs of coccoliths to allow imaging of specimens for subsequent archiving or biometrics. 


N.B. The parameters camerapar - Pixel Aspect Ratio, and Microscopecalib  need to be adjusted for the system used, see instructions on www.nhm.ac.uk/hosted_sites/ina/CODENET/CoccoBiom/getting_started.htm. To find the place to insert the calculated values do Find (cmnd-F) "camerapar"
Also optovar use has been removed from magnification dialogs.

Version edited March 2003
}

{NB Pixels in top left corner of mosaic image are used to store data}
var {Global Variables}
{GENERAL}
z:integer {main array reference} 
x,y,x1,x2,x3,x4,y1,y2,y3,y4,k:real;            {x-y pixel locations, used in various contexts, k-various uses}
N,n1,n2,c:integer;                                        {counters used in various contexts}
pi: real;                                             {constant pi, set by procinit}
sin2th,sinth,costh:real;                     {temp storage for trig fn values}
found,state,init:boolean;
unit,str:string;
hscale,vscale,par,camerapar,microscopecalib,obj,opt,mag:real;             {x and y spatial scales, pixel aspect ratio,microscope lens & final magnif}
w,h:integer;                                {image width,height}
extracolors                                  {no of reserved LUT entries}


{MOSAIC }
targetPid,sourcePid:integer {Pic or Pid numbers of images tocopy to & from}
xMos,yMos,Nmos,xN,yN:integer;      {mosaic variables - tile x/y centre, ref no., x,y ref nos.} 
cols,rows,Nmax:integer               {size of mosaic - no. of tiles across and down,total no. oftiles}
tileX,tileY,xgutter,ygutter:integer                   {tile width, height and gutter width & height}
qn1,qn2:integer                                 {tile ref from procsequence};
mosaic,tilecount:integer
m$: string
fillcolor: integer
halfphoto,top,tY:integer {params for doing half photos}

{BIOMETRIC}
cx,cy,xpos,ypos:real;               {x-y pixel locations, used for ellipse center and reporting proc results}
tcount,fcount,pcount:integer;              {counters used by auto-measure macro}
lw,pitdist,oldpitdist,pitval:real;    {variables for proclpit and procpit} 
count,ppv:integer
min,max:real;                                {variables for plotdata}
greyval:integer;               {used to record greyval of overwritten pixel}
edgethreshold:real;          {threshold ratio of min:(max-min) used by edge finding routine} 
radius:real;                     {radius used by proclpit, must be > max likely c.area length - microns} 
pt:integer                       {ca rim depth threshold - greyscale value}
tl:real;                            {length to test for procedge - microns}
maxrimcaratio:real;        {ratio of local ca radius to searched length for procedge}
cut:real;                          {threshold deviation from mean for rejecting edge points}
edgeL: real;                     {results of procedge - length (µm)}
xc,yc:real;                      {coordinate of ellipse center - microns}
xl,yl,xi,yi:real                 {image & local co-ords - pixels}
x8,y8,v:real                    {results from martin edge}
axisa,axisb:real;             {semi-axes of the ellipse - microns}
theta:real;                    {inclination of long axis - radians, clockwise from horiz.; k-various uses}

Procedure procinit;
{function - sets a series of default parameter values} 
Begin
  RequiresVersion(1.57);
  z:=0;       {actual value of z used will usually be set later}
  SetFontSize(9);
  SetText('Left Justified No Background');
  SetBackGroundColor(255);
  SetOptions('X-Y Center Length Major Angle Min/Max User1 User2');
  SetUser1Label('RimW1');
  SetUser2Label('RimW2');
  SetLineWidth(1);
  SetPalette('Grayscale',6);
  InvertY(0);
  pi:=3.141592654;
  xgutter:=10;
	 ygutter:=15;
  fillcolor:=50;

{The values of camerapar and microscopecalib MUST be adjusted for the microscope and camera being used}

camerapar:=1.00 {<==== insert your Pixel Aspect Ratio value here};
microscopecalib:=0.124; {<==== insert value for your microscope here. This is pixel length/magnification. It will vary between microscopes - typical value about 0.1}

  init:=1;
end;

{====================Mosaic Macros=============================}


procedure procmosaictest;
Begin;
GetPicSize(w,h);
GetColumn(0,0,21);
  IF (lineBuffer[0]=1) AND (linebuffer[20]=255) AND(linebuffer[14]<>255)  THEN  mosaic:=1
  ELSE IF (w=636) OR (w=635) THEN mosaic:=2 
{test if this an old mosaic image; 636 is illogical but what is produced, 635 is logical window width, and is produced by the LC}
 ELSE Mosaic:=0;
IF mosaic=1 THEN m$:='Yes, new type (1)' ELSE IF mosaic=2 THEN m$:='Yes, old type (2)' ELSE m$:='No (0)';
End;

procedure procshowinfo;
{put status info in info window} 
begin;
n2:=picNumber;
ChoosePic(targetpid);
Str:=Windowtitle;
SelectPic(n2);
GetScale(hscale,unit,par);
ShowMessage('tile size =',tileX,'x',tileY,'\','mosaic size =',cols,'x',rows,'\','gutter depth = ',ygutter,'\','mosaic?',m$,'\','\','Images will be pasted to window:   ','\',str,'\','next tile =',nMos,'\','hscale=',hscale,' pixels per ',unit);
end;

procedure procMosData; 
{loads mosaic data, stored as pixel values in the top left corner}
Begin
IF init=0 then procinit;
procmosaictest;
IF mosaic=2 THEN BEGIN 
   tileX:=100;
   tileY:=100;
   cols:=6;
   rows:=(h-5)/105;
   Nmax:=6*rows;
   SetCounter(nmax);
END
ELSE IF mosaic=1 THEN BEGIN
    tileX:=LineBuffer[12]*5;
    tileY:=LineBuffer[13]*5;
    cols:=LineBuffer[14];
    rows:=LineBuffer[15];
    xgutter:=lineBuffer[16];
IF xgutter=5 then putpixel(0,17,5); {because old mosaics only gave one gutter width value, set at 5}
   ygutter:=LineBuffer[17];
    Nmax:=cols*rows;
    SetCounter(nmax);
    mosaic:=1;
  END;
END;

procedure procn2xy(Nmos);
{given the ref number Nmos finds the x,y loc of the centre of the mosaic tile}
Begin
yN:=trunc((Nmos-1)/cols);
xN:=Nmos-(yN*cols)-1;
xMos:=0.5*(tileX)+xgutter+xN*(tileX+xgutter);
yMos:=0.5*(tileY)+ygutter+yN*(tileY+ygutter);
end;

procedure procxy2n(x,y);
{given an x,y loc finds the ref number Nmos of the mosaic tile}
Begin
xN:=round((x-0.5*tileX-xgutter)/(tileX+xgutter));
yN:=round((y-0.5*tileY-ygutter)/(tileY+ygutter));
Nmos:=xN+cols*yN+1;
xMos:=0.5*(tileX)+xgutter+xN*(tileX+xgutter);
yMos:=0.5*(tileY)+ygutter+yN*(tileY+ygutter);
end;

Procedure procgutter; 
Begin
 Setforegroundcolor(0); 
For N:= 0 to rows do begin
  x1:=0;
  y1:=n*(tiley+ygutter); {position of top of gutter}
  x2:=w;
  y2:= ygutter; {height of gutter} 
  makeroi(x1,y1,x2,y2);
  fill;
end;
 For N:= 0 to cols do begin
  x1:=n*(xgutter+tileX);
  y1:=0; 
  x2:=xgutter;
  y2:=h; 
  makeroi(x1,y1,x2,y2);
  fill;
end;
 Setforegroundcolor(1);  MakeRoi(0,0,5,5);Fill;   KillRoi;   {Make red corner}  
  PutPixel(0,12,tileX/5);
  PutPixel(0,13,tileY/5);
  PutPixel(0,14,cols);
  PutPixel(0,15,rows);
  PutPixel(0,16,xgutter);
  PutPixel(0,17,ygutter);  
PutPixel(0,20,255);
  procmosdata;
End;


Procedure procNumberTile;
begin
  procn2xy(nMos);
  setForegroundColor(255); 
{  MakeRoi(xMos-0.5*tileX,yMos+0.5*tileY,11,12);Fill;} 
  MoveTo(xMos-0.5*tileX,yMos+0.5*tileY+ygutter-6);
  setbackgroundColor(2); 
  setForegroundColor(255); 
setfontsize(9);
  Write(Nmos:0:0); 
setfontsize(9); 
END

Procedure procSetSequence(x,y);
{function  - determine which specimen(s) to work on}
{output - qn1,qn2 the ref nos of the first and last specs to be used}
Begin
procmosdata;
GetScale(hscale,unit,par);
vscale:=hscale/par;
IF  mosaic>=1 THEN BEGIN 
  Procxy2n(x,y); 

{If cursor is in top left corner work on all specs}
  IF (x<20) AND (y<20) THEN     
       BEGIN  
       qn1:=1; qn2:=Nmax;
       END

{If cursor is in black bar between tiles work on all remaining specs}
	 ELSE	IF ABS(xMos-x)>.5*tileX THEN 
		   BEGIN
       ShowMessage(xMos-x);     
       IF XMos<x  THEN qn1:= nMos+1 ELSE qn1:=nMos;  qn2:=Nmax; 
       END

{If cursor is elsewhere  work on spec in tile}
 ELSE  BEGIN  qn1:=nMos; qn2:=nMos; END;
 END

{If not a mosaic work on spec under cursor}  
ELSE  BEGIN                              
         qn1:=z+1; qn2:=z+1;
         xMos:=x; yMos:=y;
         END;
END;


Procedure Procundistort;
Begin;
SetScaling('bilinear samewindow');
MakeRoi(x-0.5*tileX,y-0.5*tileY,tileX,tileY);
If camerapar=0 then begin PutMessage('Please scale this window, using macro f8'); exit; end;
ScaleandRotate(1,camerapar,0);
MakeRoi(x-0.5*tileX-2,y-0.5*tileY-2,tileX+4,tileY+4);drawboundary;
End

Procedure proctakephoto;
Begin;
  StopCapturing;
  IF init=0 then procinit;  
  KillRoi;
  GetMouse(x,y);

 n:=nMos;
  ProcSetSequence(x,y);
  nMos:=n; 
m$:=WindowTitle; 
 IF m$='Camera' then procundistort;
  IF halfphoto=1 THEN tY:=0.5*tileY ELSE tY:=tileY;
  MakeRoi(xMos-0.5*tileX,yMos-0.5*tY,tileX,tY);

  Copy;
 sourcePid:=Pidnumber;
 If pidexists(targetpid) then selectpic(targetpid) else  
 NextWindow;
  procn2xy(nMos); 
  MakeRoi(xMos-0.5*tileX,yMos-top*0.5*tileY,tileX,tY);
  Paste;
  procNumberTile;
  Nmos:=Nmos+1; 
  selectpic(sourcepid);  
  ShowMessage(Nmos,'-Nmos');
end;

Macro 'Start or stop capturing [2]' 
{function - toggle camera on/offline}
begin 
IF nPics>0 then KillRoi;
StartCapturing; KillRoi; 
end;

Macro 'TAKE MOSAIC PHOTO * [3]' 
{function - take "photo" of specimen and save to mosaic} 
Begin
  halfphoto:=0; top:=1;
  proctakephoto;
  killroi;
  tilecount:=tilecount+1;
  IF tilecount>15 THEN BEGIN beep;tilecount:=0;  selectpic(targetpid); Save; PutMessage('saved'); selectpic(sourcepid); End; 
  IF Nmos>Nmax then begin beep; tilecount:=0;  selectpic(targetpid); Save;PutMessage('Mosaic finished and saved');   End;
End;

macro 'MAKE NEW MOSAIC WINDOW [4]'
{function - set up blank mosaic window - with option to change size & number of tiles}
Begin
If nPics>0 then Stopcapturing;
IF init=0 then procinit;  
  fillcolor:=1;
   SetBackGroundColor(50);

   If cols=0 then begin cols:=3; rows:=5;   end;
   If tileX=0 then begin  tileX:=150; tileY:=150;end; 
  If obj=0 then  begin obj:=100; opt:=1.0;  End;
   ShowMessage('tile size =',tileX,'x',tileY,'\','mosaic size =',cols,'x',rows,'\','mosaic',mosaic,'\','N.B. Tile width & height values can be from 0-1250, but must be divisible by 5');

   str:=GetString('Change mosaic or tile size? (Y/N)','N');
   x:=ord(str);

 IF (x=49) OR (x=89) or (x=121) then BEGIN     {N.B. 49=1, 89=Y, 121=y}

    cols:=GetNumber('Width - no. of columns across(1-10)',cols,0);
    rows:=GetNumber('Height - no. of rows down (1-10)',rows,0);
   x2:=tileX;
    tileX:=GetNumber('tile width(e.g.100)',tileX,0);
    if x2=tileX then x2:=tiley ELSE x2:=tileX;    {i.e. if the value of tile x has not been changed use current value of tile y}
   tileY:=GetNumber('tile height',x2,0);
   ygutter:=GetNumber('Gutter depth',ygutter,0);

  obj:=GetNumber('Objective Lens',obj,1);
  opt:=GetNumber('Optovar Lens',opt,2);
  mag:=obj*opt;
  hscale:=mag*microscopecalib;
  vscale:=hscale;
  SetScale(hscale,'µm',1);
 END;
 
   Nmax:=cols*rows;
   SetNewSize(cols*(tileX+xgutter)+xgutter,rows*(tileY+ygutter)+ygutter);
   MakeNewWindow('Mosaic');
   tilecount:=0;

 SetForeGroundColor(fillcolor);
  procgutter;   {NB procgutter also sets info pixels - so don't omit} 

   Nmos:=1;
   procn2xy(Nmos); 
   targetPid:=Pidnumber;
   SaveAs;
   NextWindow;  
procshowinfo;

End;


Macro 'Take top half mosaic photo * [1]' 
{function - take "photo" of specimen and save to top/bottom half of mosaic} 
Begin
  halfphoto:=1;
top:=1;
  proctakephoto;
 Nmos:=Nmos-1;
  killroi;
selectpic(sourcepid); End; 
End;

Macro 'Take bottom half mosaic photo * [0]' 
{function - take "photo" of specimen and save to top/bottom half of mosaic} 
Begin
  halfphoto:=1;
  top:=0;
  proctakephoto;
  killroi;
  tilecount:=tilecount+1;
  IF tilecount>15 THEN BEGIN beep;tilecount:=0;   selectpic(targetpid); Save; PutMessage('saved');  selectpic(sourcepid); End; 
  IF Nmos>Nmax then begin beep; tilecount:=0;  selectpic(targetpid); Save;PutMessage('Mosaic finished and saved');  End;
End;

Macro 'Copy tile  [C]'
{function - Copy tile under the cursor}
Begin
  StopCapturing;
  GetMouse(x,y);
  ProcSetSequence(x,y);
GetPicSize(w,h);
x1:=xMos-0.5*tileX; IF x1<0 then x1:=0;
y1:=yMos-0.5*tileY; IF y1<0 then y1:=0;
x2:=tileX;
y2:=tileY;
  MakeRoi(x1,y1,x2,y2);
  Copy;
End;

Macro 'Cut tile  [X]'
{function - Copy tile under the cursor} 
Begin
  StopCapturing;
  GetMouse(x,y);
  ProcSetSequence(x,y);
  MakeRoi(xMos-0.5*tileX,yMos-0.5*tileY,tileX,tileY);
  Copy;
  Clear;
  KillRoi;
End;

Macro 'Paste tile [V] '
{function - paste tile from clipboard to mosaic} 
Begin
  StopCapturing;
  x2:=tileX;y2:=tileY; {these will be the size of the tile in the clipboard}
  GetMouse(x,y);
  ProcSetSequence(x,y);
  MakeRoi(xMos-0.5*tileX,yMos-0.5*tileY,x2,y2);
  paste;
  procNumberTile;
End;



Macro'(-'; 

Macro 'Initialise [I]';
{function - set various parameters}
Begin
  n2:=nPics;
  IF n2=0 then begin setnewsize(150,100); makenewwindow('dummy');end;
  procinit;
   IF n2=0 then dispose;
End;


Macro 'Select Mosaic to receive image [M]'
Begin
targetPid:=pidnumber;
procMosData;
GetMouse(x,y);
procxy2n(x,y);
procshowinfo;
 End;


Macro 'Set number of next tile * [T]'
{function - determine where the next tile will go} 
Begin
StopCapturing;
procmosaictest;
IF mosaic=0 THEN nMos:=Nmos-1 ELSE BEGIN
GetMouse(x,y);
procxy2n(x,y);
End;
Nmos:=GetNumber('tile ref (1-N)',Nmos,0);
procn2xy(Nmos);
procshowinfo;
end;

Macro 'Test [y]'
begin
if 3<>3 then beep;
end; 

Macro 'RestoreMosData[R]'
{function  - Replace the dots which give size and number of tiles}
Begin
GetPicSize(w,h);
   cols:=GetNumber('Number of columns of tiles(1-10)',cols,0);
   rows:=GetNumber('Number of rows of tiles(1-10)',rows,0);
xgutter:=GetNumber('Gutter width',xgutter);
ygutter:=getNumber('Gutter height'r,yGutter);
    tileX:=(w-xgutter)/cols-xgutter;
    tileY:=(h-ygutter)/rows-ygutter;
  SetForegroundColor(1);
  MakeRoi(0,0,5,5);Fill;   KillRoi;   {Make red corner}  
  PutPixel(0,12,tileX/5);
  PutPixel(0,13,tileY/5);
  PutPixel(0,14,cols);
  PutPixel(0,15,rows);
  PutPixel(0,16,xgutter);
  PutPixel(0,17,ygutter);
  PutPixel(0,20,255);
procMosData;
procshowinfo;
End;


Macro 'Renumber ** [K]'
{function - Rewrite  specimen numbers}
Begin;
GetMouse(x,y);
ProcSetSequence(x,y);
FOR nMos:=qn1 TO qn2 DO BEGIN
procNumbertile;
END;
END;


macro 'Clean Gutters [G]'
{function - redraw the gutters between tiles. Gutters are redrawn in the current foreground color, which can be set in advance from the LUT. Broader horizontal gutters can be made -  to make space for text} 
Begin
procMosData;
procgutter;
  MakeRoi(0,0,5,5);Fill;   KillRoi;   {Make red corner}  
  PutPixel(0,12,tileX/5);
  PutPixel(0,13,tileY/5);
  PutPixel(0,14,cols);
  PutPixel(0,15,rows);
  PutPixel(0,16,xgutter);
  PutPixel(0,17,ygutter);
  PutPixel(0,20,255);
end;


macro 'Set Magnification [f13]'
{function - set spatial scale, based on microscope lenses used}
{before using this macro camerapar & microscopecalib defaults, in procinit, MUST be adjusted for your microscope/framegrabber system}
Begin
{PutMessage('This macro will only give meaningful values if the default values are set for your microscope in the macro file')};
IF NOT init THEN procinit;
  obj:=GetNumber('Objective Lens',100,1);
  opt:=Getnumber('Optovar Lens',1,1); {if your microscope does not have an intermediate lens this line can be replaced by opt:=1}
  mag:=obj*opt;
  hscale:=mag*microscopecalib;
  vscale:=hscale;
  SetScale(hscale,'µm',1);
ShowMessage('lens magnification x',mag:0:0,'\','hscale=',hscale,' pixels per  micron','\','par=',camerapar:0:2);
End;  


macro 'Show Magnif - Info Window [f14]'
Begin
GetScale(hscale,unit,par);
mag:=hscale/microscopecalib;
ShowMessage('lens magnification x',mag,'\','hscale=',hscale,' pixels per ',unit,'\','camerapar=',camerapar);
End;

macro 'Draw ScaleBar [f15]'
{function - draw scale bar}
   var
width,barlength,height:integer;
Begin
  GetPicSize (width,height);
  Procsetsequence(50,50);
  GetScale(hscale,unit,par);
    str:=Concat('Bar length -',unit);
    barlength:=GetNumber(str,10);
    SetForegroundColor(0);
    SetBackGroundColor(255);
    MakeRoi (10,height-20, barlength*hscale,5);
    Fill;
    MoveTo(barlength*hscale+20,height-12);
    Write(barlength,unit);
end;

Macro '(-'

{==============Utility macros=====================================}


Macro 'Sharpen  tile  [S]'
{function - sharpen tile under the cursor} 
Begin
  StopCapturing;
  GetMouse(x,y);
  ProcSetSequence(x,y);
  MakeRoi(xMos-0.5*tileX,yMos-0.5*tileY,tileX,tileY);
  Sharpen;
End;

Macro 'Surface plot specimen * [P]'
{function - produce surface plot of a single specimen}
Begin
StopCapturing;
RequiresVersion(1.50);
GetMouse(x,y);
n:=picnumber;
GetRoi(x1,y1,x2,y2);
IF x2<10 THEN BEGIN 
  ProcSetSequence(x,y);
  MakeRoi(xMos-.5*tileX,yMos-.5*tileY,tileX,tileY);
END;
SetNewSize(400,400);
Invert;
SurfacePlot;
ShowMessage('Press cmnd-. while clicking to keep surface plot');
Repeat Until Button;
n2:=picnumber;
ChoosePic(n);
Invert;
KillRoi;
ChoosePic(n2);
Dispose;
ChoosePic(n);
Wait(0.2)
End;



macro 'Toggle extracolours [f10]'  begin
if extracolors = 6 then extracolors:=0 else extracolors:= 6; 
SetPalette('grayscale', extracolors);
 end;

macro 'Blue Sector [B]'
{function - add a diagonal blue line to indicate c-axis orientation/colour shown with gypsum plate}
begin
GetMouse(x,y);
MakeLineRoi(x-2,y-2,x+2,y+2);
SetForegroundcolor(5);
Fill;
KillRoi;
End;

macro 'Yellow Sector [Y]'
begin
GetMouse(x,y);
MakeLineRoi(x-2,y+2,x+2,y-2);
SetForegroundcolor(4);
Fill;
KillRoi;
End;

macro 'N-S Extinction [N]'
begin
GetMouse(x,y);
MakeLineRoi(x,y+3,x,y-3);
SetForegroundcolor(6);
Fill;
KillRoi;
End;

macro 'E-W Extinction [E]'
begin
GetMouse(x,y);
MakeLineRoi(x+3,y,x-3,y);
SetForegroundcolor(6);
Fill;
KillRoi;
End;

macro 'Write LowFocus [L]'
begin; 
GetMouse(x,y);
Moveto(x,y);
setforegroundcolor(0);
write('Low f');
end;

macro 'Write High Focus [H]'
begin; 
GetMouse(x,y);
Moveto(x,y);
setforegroundcolor(0);
write('High f');
end;

macro 'Magnifier tool [f1]'
begin;  Requiresversion(1.6);SelectTool('magnifier'); end;

macro 'Rectangle tool [f2]'
begin  killroi; Requiresversion(1.6); SelectTool('rectangle'); end;

macro 'Grabber tool [f3]'
begin; Requiresversion(1.6); SelectTool('grabber'); end;

macro 'Straightline tool [f4]'
begin ; Requiresversion(1.6); SelectTool('straightline'); end;