{ Image Macros for intensity calculations on Photometrics CCD images }
{Globals}
var
{16 to 8 conversion info}
ymin, ymax,
{pid numbers for images}
customLUTpid, smoothPid, kernelPid,
raw16Pid, rawWidth, rawHeight,
proc16Pid, proc8Pid, procXmin, procXmax,
temp16Pid, flagPid,
mask1Pid, maskWidth, maskHeight,
seg8aPid, seg8bPid,
dark16Pid, unif16Pid,
{segmentation}
fore,
{YES/NO parameters}
skipFlat, {nonzero = skip flat field correction}
skipMedian, {nonzero = skip median filter step}
skipSmooth, {nonzero = skip smooth step}
{smooth kernel parameters}
{flat field ratio constant}
{fix for choosePic/selectPic bug which leaves LUT wrong}
{before doing a selectPic, do choosePic(lastSelectPid)}
{at start of macro, note lastSelectPid}
{after each select, note lastSelectPid}
lastSelectPid
: integer;
{initialize/restore globals}
begin
requiresUser('Pixel16u',2);
requiresUser('GetPutPixel',1);
requiresUser('timer',1);
requiresUser('utilities',1);
requiresUser('markup',1);
kernelPid := getMemo('kernelPid');
if not pidExists(kernelPid) then begin
if getMemo('openedKernel') <> 0 then begin
putMessage('please do not close standardBkgKernel window');
putMessage('now you have to find it again');
end;
setMemo('openedKernel',1);
Open('standardBkgKernel');
kernelPid := pidNumber;
SetMemo('kernelPid', kernelPid);
end;
ymin := getMemo('ymin');
ymax := getMemo('ymax');
{pid numbers}
customLUTpid := getMemo('customLUTpid');
smoothPid := getMemo('smoothPid');
raw16Pid := getMemo('raw16Pid');
rawWidth := getMemo('rawWidth');
rawHeight := getMemo('rawHeight');
proc16Pid := getMemo('proc16Pid');
temp16Pid := getMemo('temp16Pid');
flagPid := getMemo('flagPid');
mask1Pid := getMemo('mask1Pid');
maskWidth := getMemo('maskWidth');
maskHeight := getMemo('maskHeight');
proc8Pid := getMemo('proc8Pid');
procXmin := getMemo('procXmin');
procXmax := getMemo('procXmax');
seg8aPid := getMemo('seg8aPid');
seg8bPid := getMemo('seg8bPid');
dark16Pid := getMemo('dark16Pid');
unif16Pid := getMemo('unif16Pid');
fore := getMemo('fore');
if fore < 1 then fore := 1;
if fore > 250 then fore := 250;
setMemo('fore',fore);
SetBackgroundColor(0);
SetForeGroundColor(255);
end;
{selectPic(pidNumber) is needed before choosePic/copy in case front}
{window is Map or Histogram. But selectPic(pidNumber) clears threshold.}
procedure fixCopyBug;
var
lower, upper: integer;
begin
lastSelectPid := pidNumber;
if pidExists(lastSelectPid) then begin
getThreshold(lower, upper);
selectPic(pidNumber);
if upper = 255 then
setThreshold(lower)
else
setDensitySlice(lower, upper);
end;
end;
{use choosePic to go back to the "right" image before selectPic}
{to a new image. This should be done in the Pascal code.}
procedure selectPicBugFix(pid: integer);
begin
if pidExists(lastSelectPid) then
choosePic(lastSelectPid);
selectPic(pid);
lastSelectPid := pidNumber;
end;
procedure disposePicBugFix(pid: integer);
begin
if pidExists(lastSelectPid) then
choosePic(lastSelectPid);
selectPic(pid);
dispose;
lastSelectPid := pidNumber;
end;
{also, put this code before and after every MakeNewWindow:
if pidExists(lastSelectPid) then
choosePic(lastSelectPid);
MakeNewWindow(name);
lastSelectPid := pidNumber;
}
{ Procedure: }
{ create uniform image from a series of data images. }
{ import dark image. }
{ import data image. }
{ flat field correction. }
{ reduce noise and smooth. }
{ convert to 8 bit with automatic scaling. }
{ adjust 8 bit scaling. }
{ threshold }
{ use wand tool to select a series of fragments. }
{ after each wand click, invoke macro to define the segment }
{ (fills roi on segment image with segment number)}
{ and a separate macro to assign the segment to a class }
{ (places class number into array indexed by segment number)}
{ (different macro for each class)}
{ use wand tool to select any nearby bright spots (dirt) }
{ invoke macro to define dirt segment }
{ circular dilate segments. }
{ copy the segments to another image, convert to one value, dilate more, }
{ subtract to produce background segment definition }
{ measure each segment in 16 bit data for sum, area, standard deviation, min, max}
{ Use "analyze particles" command on 8 bit segment image to find area, coordinates, seg number}
{ output to spreadsheet format text window: }
{ image name, top left coordinates, area, sum, standard deviation. }
{ also need way to identify values for internal standard}
{status window: next segment number}
procedure checkKernelPid;
begin
selectPicBugFix(pidNumber);
if not pidExists(kernelPid) then begin
putMessage('please do not close standardBkgKernel window');
putMessage('now you have to find standardBkgKernel again');
Open('standardBkgKernel');
kernelPid := pidNumber;
SetMemo('kernelPid', kernelPid);
end;
end;
procedure autoDispose(p);
begin
if pidExists(p) then begin
disposePicBugFix(p);
end;
end;
procedure createSmoothKernel;
var
x, y: integer;
sum: real;
begin
RequiresUser('getputpixel', 1);
AutoDispose(smoothPid);
SaveState;
SetNewSize(kw * 4, kh + 1);
if pidExists(lastSelectPid) then
choosePic(lastSelectPid);
MakeNewWindow('kernel ', kx : 0, 'x ', ky : 0, 'y ', kw : 0, 'w ', kh : 0, 'h');
smoothPid := pidNumber;
SetMemo('smoothPid', smoothPid);
RestoreState;
putPixel(0, 0, kx);
putPixel(1, 0, ky);
putPixel(2, 0, kw);
putPixel(3, 0, kh);
sum := 0.0;
for x := -kx to kw - kx - 1 do begin
for y := -ky to kh - ky - 1 do begin
sum := sum + exp(-sqrt(sqr(x) + sqr(y)));
end;
end;
sum := 32000.0 / sum; {nearly maximum before overflow on 65535 pixel}
for x := -kx to kw - kx - 1 do begin
for y := -ky to kh - ky - 1 do begin
putPixel32s(smoothPid, x + kx, y + ky + 1, sum * exp(-sqrt(sqr(x) + sqr(y))));
end;
end;
sum := 0.0;
for x := -kx to kw - kx - 1 do begin
for y := -ky to kh - ky - 1 do begin
sum := sum + getPixel32s(smoothPid, x + kx, y + ky + 1);
end;
end;
showmessage('kernel sum = ', sum);
selectPicBugFix(smoothPid);
MakeRoi(0, 1, kw * 4, kh);
end;
procedure stdSmooth;
var
kx, ky, kw, kh: integer;
begin
kx := 1;
ky := 1;
kw := 3;
kh := 3;
createSmoothKernel;
end;
macro 'Create standard 3x3 smoothing kernel';
begin
fixCopyBug;
stdSmooth;
end;
macro 'Create arbitrary smoothing kernel';
var
kx, ky, kw, kh: integer;
begin
fixCopyBug;
kw := GetNumber('kernel width',5);
kh := GetNumber('kernel height',5);
kx := GetNumber('kernel x center',kw div 2);
ky := GetNumber('kernel y center',kh div 2);
createSmoothKernel;
end;
procedure setMaskSize;
var
skx, sky, skw, skh: integer;
kx, ky, kw, kh: integer;
kmin, kdelta, knum, koverlap: integer;
front: integer;
begin
front := pidNumber;
{find size of smoothing kernel}
ChoosePic(smoothPid);
skx := getPixel(0, 0);
sky := getPixel(1, 0);
skw := getPixel(2, 0);
skh := getPixel(3, 0);
{find size of background kernel}
CheckKernelPid;
ChoosePic(kernelPid);
kmin := getPixel(0, 0);
kdelta := getPixel(1, 0);
knum := getPixel(2, 0);
koverlap := getPixel(3, 0);
kx := kmin + kdelta * (knum - 1);
ky := kmin + kdelta * (knum - 1);
kw := kx * 2 + 1;
kh := ky * 2 + 1;
{choose larger kernel}
if kw < skw then kw := skw;
if kh < skh then kh := skh;
MakeRoi(0, 1, kw * 4, kh);
maskWidth := rawWidth + kw - 1;
maskHeight := rawHeight + kh - 1;
SetMemo('maskWidth',maskWidth);
SetMemo('maskHeight',maskHeight);
ChoosePic(front);
end;
procedure forceROIWithin;
var
left, top, rwidth, rheight, iwidth, iheight: integer;
begin
GetPicSize(iwidth,iheight);
GetRoi(left,top,rwidth,rheight);
if rwidth = 0 then selectAll; {this fixes most cases}
GetRoi(left,top,rwidth,rheight);
if (left < 0)
or (top < 0)
or (left + rwidth > iwidth)
or (top + rheight > iheight) then begin
putmessage('ROI must not extend outside image');
exit;
{make ROI doesn't hack it if ROI wasn't rectangular...}
if left < 0 then begin
rwidth := rwidth + left;
left := 0;
end;
if top < 0 then begin
rheight := rheight + top;
top := 0;
end;
if left + rwidth > iwidth then begin
rwidth := iwidth - left;
end;
if top + rheight > iheight then begin
rheight := iheight - top;
end;
makeroi(left,top,rwidth,rheight);
end;
end;
procedure forceUncalib;
begin
choosePic(proc8Pid);
if Calibrated then begin
selectAll;
copy;
disposePicBugFix(proc8Pid);
SaveState;
setNewSize(rawWidth, rawHeight);
if pidExists(lastSelectPid) then
choosePic(lastSelectPid);
makeNewWindow('Processed 8 bit image');
lastSelectPid := pidNumber;
proc8Pid := pidNumber;
setMemo('proc8Pid',proc8Pid);
RestoreState;
Paste;
KillRoi;
end;
SelectPicBugFix(proc8Pid);
end;
{adjust xmin/xmax using mean ± stdev}
procedure enhanceStdev;
var
mean, sigma, coef: real;
begin
choosePic(proc16Pid);
KillROI;
choosePic(proc8Pid);
forceROIWithin;
forceUncalib;
KillROI;
coef := (procXmax - procXmin + 1) / (ymax - ymin + 1);
{might not work if coef < 0???}
linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax);
Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid);
RestoreRoi; {take mean & stdev over ROI of 8 bit image}
SaveState;
SetOptions('Area,Mean,Std. Dev.,User1,User2');
Measure;
RestoreState; {does not restore option settings???}
mean := (rmean[rCount]-ymin) * coef + procXmin + coef / 2;
sigma := rStdDev[rCount] * coef + coef / 2;
ruser1[rCount] := coef;
ruser2[rCount] := mean;
{serious round off errors happen when sigma < coef }
{so that the mean is not known well enough, }
{image comes out white or black}
if sigma < coef then sigma := coef;
{SetCounter(rCount - 1);}
procXmin := mean - 2*sigma; {this needs to be an adjustable parameter}
procXmax := mean + 4*sigma;
SetMemo('procXmin',procXmin);
SetMemo('procXmax',procXmax);
end;
{display 16 bit data into the 8 bit image using specified xmin/xmax}
procedure show16;
var
lower, upper: integer;
begin
choosePic(proc16Pid);
KillROI;
choosePic(proc8Pid);
forceROIWithin;
KillROI;
linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax);
Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid);
RestoreRoi;
selectPicBugFix(proc8Pid);
GetThresholds(lower, upper);
ShowMessage(procXmin,' min\',procXmax,' max\',lower,' lower\',upper,' upper\');
end;
macro 'Set 8 bit display range';
begin
fixCopyBug;
ymin := getnumber('gray level for smallest pixel value',ymin);
ymax := getnumber('gray level for largest pixel value',ymax);
SetMemo('ymin',ymin);
SetMemo('ymax',ymax);
end;
procedure swapTemp16;
var
temp: integer;
begin
temp := temp16Pid;
temp16Pid := proc16Pid;
proc16Pid := temp;
temp := pidNumber;
choosePic(proc16Pid);
SetPicName('Processed 16 bit image');
killROI;
choosePic(temp16Pid);
SetPicName('Temporary 16 bit image');
killROI;
choosePic(temp);
end;
procedure hide8image;
var
width, height: integer;
begin
selectPicBugFix(proc8Pid);
setDensitySlice(0,0);
setforegroundcolor(255);
setbackgroundcolor(0);
selectAll;
clear;
getPicSize(width, height);
moveto(width div 3, height div 3);
writeln('Press 8 to display image');
end;
procedure checkSize(p,w,h: integer);
var
width, height, front: integer;
begin
if pidExists(p) then begin
front := pidNumber;
choosePic(p);
getPicSize(width, height);
choosePic(front);
if (width <> w) or (height <> h) then disposePicBugFix(p);
end;
end;
{if the scratch windows are wrong size or missing, create them}
procedure makeScratchIfNeed;
var
width, height: integer;
begin
selectPicBugFix(pidNumber);
saveState;
if (ymin = 0) and (ymax = 0) then begin
ymin := 1;
ymax := 254;
end;
if (ymin < 0) or (ymin > 255) then ymin := 1;
if (ymax < 0) or (ymax > 255) then ymax := 254;
if ymin > ymax then begin
ymin := 1;
ymax := 254;
end;
SetMemo('ymin',ymin);
SetMemo('ymax',ymax);
if not pidExists(customlutPid) then begin
setNewSize(256,256);
makeNewWindow('custom LUT');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
customLUTpid := pidNumber;
SetMemo('customLUTpid',customLUTpid);
end;
linLUT16uto8(customLUTpid, 0, 65535, ymin, ymax);
if not pidExists(smoothPid) then begin
stdSmooth;
end;
checkKernelPid;
if not pidExists(raw16Pid) then begin
putMessage('makeScratch no raw16');
exit;
end;
choosePic(raw16Pid);
getPicSize(width, height);
rawWidth := (width div 4) * 2;
rawHeight := height;
setMemo('rawWidth',rawWidth);
setMemo('rawHeight',rawHeight);
if rawWidth * 2 <> width then begin
putMessage('makeScratch raw width not multiple of 4');
exit;
end;
checkSize(proc16Pid,rawWidth * 2,rawHeight);
if not pidExists(proc16Pid) then begin
setNewSize(rawWidth * 2, rawHeight);
makeNewWindow('Processed 16 bit image');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
proc16Pid := pidNumber;
SetMemo('proc16Pid',proc16Pid);
end;
checkSize(temp16Pid,rawWidth * 2,rawHeight);
if not pidExists(temp16Pid) then begin
setNewSize(rawWidth * 2, rawHeight);
makeNewWindow('Temporary 16 bit image');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
temp16Pid := pidNumber;
SetMemo('temp16Pid',temp16Pid);
end;
checkSize(dark16Pid,rawWidth * 2,rawHeight);
if not pidExists(dark16Pid) then begin
setNewSize(rawWidth * 2, rawHeight);
makeNewWindow('Dark 16 bit image');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
dark16Pid := pidNumber;
SetMemo('dark16Pid',dark16Pid);
end;
checkSize(unif16Pid,rawWidth * 2,rawHeight);
if not pidExists(unif16Pid) then begin
setNewSize(rawWidth * 2, rawHeight);
makeNewWindow('Uniform 16 bit image');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
unif16Pid := pidNumber;
SetMemo('unif16Pid',unif16Pid);
end;
checkSize(flagPid,rawWidth,rawHeight);
if not pidExists(flagPid) then begin
setNewSize(rawWidth, rawHeight);
makeNewWindow('smoothing flag image');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
flagPid := pidNumber;
SetMemo('flagPid',flagPid);
end;
setMaskSize;
checkSize(mask1Pid,maskWidth,maskHeight);
if not pidExists(mask1Pid) then begin
setNewSize(maskWidth, maskHeight);
makeNewWindow('smoothing mask image 1');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
mask1Pid := pidNumber;
SetMemo('mask1Pid',mask1Pid);
end;
checkSize(proc8Pid,rawWidth,rawHeight);
if not pidExists(proc8Pid) then begin
setNewSize(rawWidth, rawHeight);
makeNewWindow('Processed 8 bit image');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
proc8Pid := pidNumber;
setMemo('proc8Pid',proc8Pid);
end;
checkSize(seg8aPid,rawWidth,rawHeight);
if not pidExists(seg8aPid) then begin
setNewSize(rawWidth, rawHeight);
makeNewWindow('Segments A');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
seg8aPid := pidNumber;
setMemo('seg8aPid',seg8aPid);
end;
checkSize(seg8bPid,rawWidth,rawHeight);
if not pidExists(seg8bPid) then begin
setNewSize(rawWidth, rawHeight);
makeNewWindow('Segments B');
lastSelectPid := pidNumber;
SelectAll;
KillRoi;
seg8bPid := pidNumber;
setMemo('seg8bPid',seg8bPid);
end;
restoreState;
end;
procedure copyRawToProc;
begin
choosePic(raw16Pid);
selectAll;
copy;
killRoi;
choosePic(proc16Pid);
selectAll;
paste;
killRoi;
end;
{
import arbitrary IPLab image:
if (getpixel(0,0) <> ord('2'))
or (getpixel(1,0) <> ord('.'))
or (getpixel(2,0) <> ord('3'))
or (getpixel(3,0) <> ord('a'))
or (getpixel(4,0) <> 0)
or (getpixel(5,0) <> 1) {short int}
then
else
width := ((getpixel(6,0) * 256 + getpixel(7,0)) * 256 + getpixel(8,0)) * 256 + getpixel(9,0);
height := ((getpixel(10,0) * 256 + getpixel(11,0)) * 256 + getpixel(12,0)) * 256 + getpixel(13,0);
offset := 2120;
}
{if there is no raw data image, import one}
procedure importIfNeed;
var
origPid: integer;
begin
origPid := 0;
if not pidExists(raw16Pid) then begin
SaveState;
SetImport('8-bits,Custom');
SetCustom(2634,1034,2124);
Import('');
origPid := pidNumber;
{MakeNewWindow will not make odd width windows.}
{Therefore, 16 bit images must be even # pixels wide}
{or width multiple of 4}
SetNewSize(2632,1032);
MakeRoi(0, 2, 2632,1032);
Copy;
MakeNewWindow(GetPicName);
raw16Pid := pidNumber;
SetMemo('raw16Pid',raw16Pid);
Paste;
KillROI;
disposePicBugFix(origPid);
RestoreState;
end;
makeScratchIfNeed;
if origPid <> 0 then begin
CopyRawToProc;
end;
end;
macro '[1] copy proc to dark image';
begin
fixCopyBug;
choosePic(proc16Pid);
selectAll;
copy;
killRoi;
choosePic(dark16Pid);
selectAll;
paste;
killRoi;
selectPicBugFix(proc8Pid);
end;
macro '[2] copy proc to uniform image';
begin
fixCopyBug;
choosePic(proc16Pid);
selectAll;
copy;
killRoi;
choosePic(unif16Pid);
selectAll;
paste;
killRoi;
selectPicBugFix(proc8Pid);
end;
macro '[d] subtract dark image';
begin
fixCopyBug;
choosePic(proc16Pid);
killROI;
choosePic(temp16Pid);
killROI;
choosePic(dark16Pid);
killROI;
sub16u(proc16Pid,dark16Pid,temp16Pid);
swapTemp16;
hide8Image;
writeln('subtract dark');
end;
macro '[f] flat field -- divide by uniform image';
begin
fixCopyBug;
choosePic(proc16Pid);
killROI;
choosePic(temp16Pid);
killROI;
choosePic(unif16Pid);
killROI;
ratio16u(proc16Pid,unif16Pid,temp16Pid,32768);
swapTemp16;
hide8Image;
writeln('divide by uniform');
end;
{macro 'include median filter step';
macro 'skip median filter step';
macro 'include smoothing step';
macro 'skip smoothing step';
macro 'include flat field step';
macro 'skip flat field step';}
macro '[a] start over from raw image';
begin
fixCopyBug;
importIfNeed;
CopyRawToProc;
hide8Image;
writeln('raw data');
end;
macro '[z] undo last 16 bit transform';
begin
fixCopyBug;
swapTemp16;
hide8Image;
writeln('undo');
end;
macro '[r]reduce noise';
begin
fixCopyBug;
{actually only need to copy the border}
choosePic(proc16Pid);
selectAll;
copy;
killRoi;
choosePic(temp16Pid);
selectAll;
paste;
{end copy}
choosePic(proc16Pid);
makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
choosePic(temp16Pid);
makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
median16u(proc16Pid,temp16Pid);
choosePic(proc16Pid);
killROI;
choosePic(temp16Pid);
killROI;
swapTemp16;
hide8Image;
writeln('reduce noise');
end;
macro 'radial median filter';
var
radius: real;
r: integer;
begin
fixCopyBug;
radius := getNumber('radius',10);
r := round(radius + 0.5);
{actually only need to copy the border}
choosePic(proc16Pid);
selectAll;
copy;
killRoi;
choosePic(temp16Pid);
selectAll;
paste;
killRoi;
{end copy}
choosePic(proc16Pid);
makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r);
choosePic(temp16Pid);
makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r);
radMedian16u(proc16Pid,temp16Pid,radius);
choosePic(proc16Pid);
killROI;
choosePic(temp16Pid);
killROI;
swapTemp16;
hide8Image;
writeln('radial median filter');
end;
macro '[m]min spatial filter';
begin
fixCopyBug;
choosePic(proc16Pid);
makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
choosePic(temp16Pid);
makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
minspat16u(proc16Pid,temp16Pid);
choosePic(proc16Pid);
killROI;
choosePic(temp16Pid);
killROI;
swapTemp16;
hide8Image;
writeln('min spatial');
end;
macro '[s] smooth';
var
kx, ky, kw, kh: integer;
begin
fixCopyBug;
SetBackgroundColor(0);
ChoosePic(proc16Pid);
killRoi;
ChoosePic(temp16Pid);
killRoi;
ChoosePic(smoothPid);
kx := getPixel(0, 0);
ky := getPixel(1, 0);
kw := getPixel(2, 0);
kh := getPixel(3, 0);
MakeRoi(0, 1, kw * 4, kh);
ChoosePic(flagPid);
SelectAll;
Clear;
KillRoi;
ChoosePic(mask1Pid);
MakeRoi(kx, ky, rawWidth, rawHeight);
Clear;
SetForegroundColor(255);
MakeRoi(0, 0, kx, rawHeight + kh);
Fill;
MakeRoi(kx + rawWidth, 0, kw - kx - 1, rawHeight + kh);
Fill;
MakeRoi(kx, 0, rawWidth, ky);
Fill;
MakeRoi(kx, ky + rawHeight, rawWidth, kh - ky - 1);
Fill;
{Mask image must have an ROI same size as image and}
{with borders matching kernel, thus:}
MakeRoi(kx, ky, rawWidth, rawHeight);
Convolve16u(flagPid, proc16Pid, smoothPid, kx, ky, mask1Pid, temp16Pid);
swapTemp16;
hide8Image;
writeln('smooth');
end;
macro 'Copy 8 bit image to seg8b and make binary';
var
lower, upper: integer;
begin
fixCopyBug;
ChoosePic(proc8Pid);
GetThresholds(lower, upper);
SelectAll;
Copy;
ChoosePic(seg8bPid);
SelectAll;
Paste;
if upper = 255 then begin
SetThreshold(lower);
end else begin
SetDensitySlice(lower,upper);
end;
MakeBinary;
selectPicBugFix(seg8bPid);
end
macro 'Masked smooth against seg8b';
var
kx, ky, kw, kh: integer;
kmin, kdelta, knum, koverlap: integer;
k, hist0, yb: integer;
begin
fixCopyBug;
hide8Image;
writeln('starting masked smooth');
SetBackgroundColor(0);
{Use the background kernel not smoothing kernel}
ChoosePic(kernelPid);
kmin := getPixel(0, 0);
kdelta := getPixel(1, 0);
knum := getPixel(2, 0);
koverlap := getPixel(3, 0);
kx := kmin + kdelta * (knum - 1);
ky := kmin + kdelta * (knum - 1);
kw := kx * 2 + 1;
kh := ky * 2 + 1;
MakeRoi(0, 1, kw * 4, kh);
ChoosePic(flagPid);
SelectAll;
Clear;
KillRoi;
ChoosePic(proc16Pid);
KillRoi;
ChoosePic(temp16Pid);
KillRoi;
ChoosePic(seg8bPid);
MakeRoi(0, 0, rawWidth, rawHeight);
Copy;
ChoosePic(mask1Pid);
MakeRoi(kx, ky, rawWidth, rawHeight);
Paste;
SetForegroundColor(255);
MakeRoi(0, 0, kx, rawHeight + kh);
Fill;
MakeRoi(kx + rawWidth, 0, kw - kx - 1, rawHeight + kh);
Fill;
MakeRoi(kx, 0, rawWidth, ky);
Fill;
MakeRoi(kx, ky + rawHeight, rawWidth, kh - ky - 1);
Fill;
{Mask image must have an ROI same size as image and}
{with borders matching kernel, thus:}
MakeRoi(kx, ky, rawWidth, rawHeight);
ChoosePic(flagPid);
MakeRoi(0,0,rawWidth,rawHeight); {in case rawWidth is odd, actual width is even}
hist0 := 1;
kx := kmin;
ky := kmin;
yb := 1;
SetOptions('User1,User2'); {turn off unneeded measurements}
for k := 1 to knum do begin
kw := kx * 2 + 1;
kh := ky * 2 + 1;
if hist0 <> 0 then begin
ChoosePic(kernelPid);
MakeRoi(0, yb, kw * 4, kh);
Convolve16u(flagPid, proc16Pid, kernelPid, kx, ky, mask1Pid, temp16Pid);
{Check for complete}
ChoosePic(flagPid);
SelectAll;
{Recalculate any pixels which depended on less than 4 }
ChangeValues(1, 4, 0);
Measure;
hist0 := histogram[0];
end;
kx := kx + kdelta;
ky := ky + kdelta;
yb := yb + kh;
end;
if hist0 <> 0 then
PutMessage('Incomplete convolution -- Results not reliable');
swapTemp16;
hide8Image;
writeln('masked smooth');
end;
macro '[3]Load a new image';
begin
fixCopyBug;
disposePicBugFix(raw16Pid);
importIfNeed;
minmax16u(proc16Pid, procXmin, procXmax);
SetMemo('procXmin',procXmin);
SetMemo('procXmax',procXmax);
show16;
enhanceStdev;
show16;
end;
macro 'Front 16 bit image is raw data';
begin
fixCopyBug;
raw16Pid := pidNumber;
SetMemo('raw16Pid',raw16Pid);
makeScratchIfNeed;
CopyRawToProc;
hide8Image;
writeln('raw data');
end;
macro '[*]Convert to 8 bit with min max scaling';
begin
fixCopyBug;
importIfNeed;
minmax16u(proc16Pid, procXmin, procXmax);
SetMemo('procXmin',procXmin);
SetMemo('procXmax',procXmax);
show16;
end;
macro '[8]Convert to 8 bit with mean ± stdev scaling';
begin
fixCopyBug;
importIfNeed;
minmax16u(proc16Pid, procXmin, procXmax);
SetMemo('procXmin',procXmin);
SetMemo('procXmax',procXmax);
show16;
enhanceStdev;
show16;
end;
macro '[¥]Enhance ROI of 8 bit image';
begin
fixCopyBug;
importIfNeed;
enhanceStdev;
show16;
end;
macro '[9]reduce xmin';
begin
fixCopyBug;
importIfNeed;
procXmin := round(procXmin - 0.1*(procXmax - procXmin) - 1);
if procXmin > procXmax then procXmax := procXmin + 1;
SetMemo('procXmin',procXmin);
show16;
end;
macro '[»]increase xmin';
begin
fixCopyBug;
importIfNeed;
procXmin := round(procXmin + 0.1*(procXmax - procXmin) + 1);
if procXmin > procXmax then procXmax := procXmin + 1;
SetMemo('procXmin',procXmin);
show16;
end;
macro '[0]reduce xmax';
begin
fixCopyBug;
importIfNeed;
procXmax := round(procXmax - 0.1*(procXmax - procXmin) - 1);
if procXmax < procXmin then procXmin := procXmax - 1;
SetMemo('procXmin',procXmin);
show16;
end;
macro '[¼]increase xmax';
begin
fixCopyBug;
importIfNeed;
procXmax := round(procXmax + 0.1*(procXmax - procXmin) + 1);
if procXmin > procXmax then procXmin := procXmax - 1;
SetMemo('procXmin',procXmin);
show16;
end;
macro 'remove calibration on 8 bit image';
begin
fixCopyBug;
forceUncalib;
end;
macro 'Show calibration numbers';
begin
fixCopyBug;
ShowMessage('Analyze/optionCalibrate... straight line',
'\(hold option key while selecting Calibrate)',
'\measured ',ymin,' known ',procXmin,
'\measured ',ymax,' known ',procXmax);
setCounter(2);
end;
macro 'rename front image';
begin
fixCopyBug;
SetPicName(GetString('new image name',GetPicName));
end;
macro 'Hilight marked areas in sequence';
var
fg, i: integer;
begin
fixCopyBug;
fg := pidNumber;
selectPicBugFix(seg8aPid);
killRoi;
SetOptions('');
measure;
for i := 1 to 254 do begin
if histogram[i] <> 0 then begin
setDensitySlice(i,i);
showMessage('Mark number ',i:0);
KillDelay(1);
StartDelay(1,1.0);
WaitDelay(1);
end;
end;
setDensitySlice(0,0);
selectPicBugFix(fg);
end;
macro '[g] Show processed 8 bit image';
begin
fixCopyBug;
selectPicBugFix(proc8Pid);
end;
procedure adjustFore(offset: integer);
var
wrap: integer;
begin
if offset < 0 then
wrap := 250
else
wrap := 1;
fore := fore + offset;
if fore > 250 then fore := wrap;
if fore < 1 then fore := wrap;
setMemo('fore',fore);
end;
macro '[h]Hilight previous segment';
var
oldFore: integer;
begin
fixCopyBug;
adjustFore(0);
oldFore := fore;
selectPicBugFix(seg8aPid);
killRoi;
measure;
SetCounter(rCount - 1);
repeat
adjustFore(-1);
until (histogram[fore] <> 0) or (fore = oldFore);
setDensitySlice(fore,fore);
ShowMessage('Hilight color is ',fore);
end;
macro '[j] Hilight next segment';
var
oldFore: integer;
begin
fixCopyBug;
adjustFore(0);
oldFore := fore;
selectPicBugFix(seg8aPid);
killRoi;
measure;
SetCounter(rCount - 1);
repeat
adjustFore(1);
until (histogram[fore] <> 0) or (fore = oldFore);
setDensitySlice(fore,fore);
ShowMessage('Hilight color is ',fore);
end;
procedure appendROI;
var
fg, lower,upper: integer;
begin
fg := pidNumber;
GetThreshold(lower,upper);
SetDensitySlice(0,0);
KillRoi;
RestoreRoi;
Clear;
ChoosePic(seg8aPid);
SetBackgroundColor(0);
SetForegroundColor(fore);
RestoreRoi;
fill;
SetForegroundColor(255);
selectPicBugFix(fg);
ShowMessage('Hilight color is ',fore,'\lower',lower,'\upper',upper);
if upper = 255 then
SetThreshold(lower)
else
SetDensitySlice(lower,upper);
end;
macro '[n]ROI is next segment';
begin
fixCopyBug;
adjustFore(1);
appendROI;
SelectPicBugFix(pidNumber);
end;
macro '[m]append ROI to segment';
begin
fixCopyBug;
appendROI;
SelectPicBugFix(pidNumber);
end;
macro 'dilate segments A onto segments B';
var
r: integer;
width,height: integer;
begin
fixCopyBug;
choosePic(seg8aPid);
r := GetNumber('dilation radius',5);
SelectAll;
Copy;
InsetRoi(r+1);
choosePic(seg8bPid);
SelectAll;
Paste;
InsetRoi(r+1);
Dilate8Circular(seg8aPid, seg8bPid, r);
choosePic(seg8aPid);
KillRoi;
selectPicBugFix(seg8bPid);
KillRoi;
end;
macro 'copy segments B onto segments A';
begin
fixCopyBug;
choosePic(seg8bPid);
SelectAll;
Copy;
KillRoi;
selectPicBugFix(seg8aPid);
SelectAll;
Paste;
KillRoi;
end;
macro 'Tabulate intensities using segments A';
var
i, k, x, y, z: integer;
sumPid, areaPid: integer;
xlatePid: integer;
begin
fixCopyBug;
SaveState;
SetNewSize(32,32);
MakeNewWindow('Sums');
sumPid := pidNumber;
MakeNewWindow('Areas');
areaPid := pidNumber;
{***fill temp16Pid with ones***}
SetNewSize(512, 1);
SetBackgroundColor(0);
MakeNewWindow('8 to 16 conversion table');
xlatePid := pidNumber;
for i := 0 to 255 do
putpixel(i * 2, 0, 1); {translate anything to 1}
MakeRoi(0, 0, 512, 1);
ChoosePic(seg8aPid);
killRoi;
ChoosePic(temp16Pid);
killRoi;
Cnvrt8to16u(seg8aPid, xlatePid, temp16Pid);
disposePicBugFix(xlatePid);
Sum16sMark(proc16Pid,seg8aPid,sumPid);
Sum16sMark(temp16Pid,seg8aPid,areaPid);
{also need standard deviation, min, max}
ResetCounter;
SetOptions('area,user1,user2');
x := 0;
for k := 1 to 256 do begin
y := GetPixVec32s(areaPid,k);
z := GetPixVec32s(sumPid,k);
if y <> 0 then begin
x := x + 1;
SetCounter(x);
rUser1[x] := k;{segment number}
rArea[x] := y; {area}
rUser2[x] := z;{sum}
end;
end;
disposePicBugFix(sumPid);
disposePicBugFix(areaPid);
SetUser1Label('segment');
SetUser2Label('sum');
ShowResults;
RestoreState;
SelectPicBugFix(pidNumber);
end;