Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0110/mintrp.sai
There are 2 other files named mintrp.sai in the archive. Click here to see a list.
ENTRY;
COMMENT
.SOSPAGE_1
.SEC(MINTRP - PROC10 Mask Operation Interpreter)
.index(MINTRP - PROC10 Mask Operation Interpreter)
.;
BEGIN "MINTRP.SAI"
COMMENT
P. LEMKIN, R. GORDON, B. SHAPIRO
IMAGE PROCESSING UNIT
DIVISION OF CANCER BIOLOGY AND DIAGNOSIS
NATIONAL CANCER INSTITUTE
NATIONAL INSTITUTES OF HEALTH
BETHESDA, MD 20014
301-496-2394
Oct 12, 1976 - Lemkin, removed SMSG/DEBUG
Revised Aug 25, 1976 - Lemkin, MSLICE density
Revised Aug 24, 1976 - Lemkin, MSLICE density
Revised Aug 23, 1976 - Lemkin, revised SMSG comments
Revised Aug 6, 1976 - Lemkin, removed POLYGON command
Revised May 28, 1976 fixed read filelookup
Revised July 7, 1976 fixed read filelookup
Revised May 27, 1976 CHANGED - TO MINUS
Revised May 24, 1976 - Lemkin READ
Revised May 22, 1976 - Lemkin READ/WRITE, MCIRCLE
Revised May 17, 1976 - Lemkin fixed sip5,6 xfer
Revised April 19, 1976 - Lemkin fixed PERIMETER
Revised April 14, 1976 - Lemkin - changed CIRCLE to MCIRCLE cmd
;
COMMENT
.ss(MINTRP REQUIRE files)
.INDEX(MINTRP REQUIRE files)
.;
Comment
" ================================"
" = R E Q U I R E ="
" ================================"
" The following files are required for use by PROC10.
They all reside in the Image Processing Unit's common user area
";
Comment
note the following REQ's are for debugging and will be removed;
Require "ARINFO.REQ" source!file;
Comment Permanent REQ's;
Require "DEFINE.REQ" source!file;
Require "GETABL.REQ" source!file;
Require "IO.REQ" source!file;
Require "SYS:DISPRM.SAI" source!file;
Require "PPAK.REQ" source!file;
Require "CVT.REQ" source!file;
Require "BOUND.REQ" source!file;
Require "DARRAY.REQ" source!file;
Require "PIXDMP.REQ" source!file;
" The following require files are used to link this
interpreter with PROC10 itself"
Require "PRCMAX.REQ" source!file;
Require "PRCINV.REQ" source!file;
Require "PRCWRK.REQ" source!file;
COMMENT
.ss(Procedure MASK!ASSIGNMENT)
.INDEX(Procedure MASK!ASSIGNMENT)
.;
Internal Procedure MASK!ASSIGNMENT;
Begin "MASK!ASSIGNMENT"
String
s1,
s2,
s3,
s,
ss,
sss;
Integer Array
xy!list[1:2,1:100];
Own integer
nvertices,
side,
zcenter,
row!start,
column!start,
row!square,
column!square,
row!circle,
column!circle;
Own Real
radius,
radius!of!sphere,
radius2;
Integer
i,
j,
r,
c,
row,
column,
ival,
jval,
msk!index1,
msk!index2,
msk!index3,
index;
Label mask!a!dispatch;
Real val;
" Find the maskoperator index"
For index_1 Step 1 Until max!number!maskops Do
If equ(cmd, lgl!mops[index])
Then Done;
If db=2 Then Goto mask!a!dispatch;
"see if have a mask anywhere"
mask1_mask2_mask3_none;
" Get the output mask if the command is not output nullary"
If Equ(GUESSER(cmd,lgl!noutput!ops), null)
Then
Begin "Get the output mask"
If (mask3_GET!MASK(sout)) = none Then Return;
" copy the mask index"
msk!index3_m!index;
" Get the mask output title if non-null and not READ"
If not Equ(sout,null) Then
If Mask!title[msk!index3]=null and not Equ(cmd,"READ")
Then
If auto!title Then mask!title[msk!index3]_strcopy
Else
SBOUND(Mask!title[msk!index3],"any",
"Mask "&sout&" title", sout&" title");
End "Get the output mask"
Else
If not Equ(cmd,"WRITE")
Then
Begin "shift args right"
" Shift the input args right since sout is
really sip1 etc."
sip6_sip5;
sip5_sip4;
sip4_sip3;
sip3_sip2;
sip2_sip1;
sip1_sout;
sout_null;
End "shift args right";
If Equ(GUESSER(cmd,lgl!ninput!ops),null)
Then
Begin "Get input mask"
If (sip1_GUESSER(sip1,lgl!mnames)) =null
Then Begin "Bad input mask"
Outstr("Bad input mask"&crlf);
DEL!MASK(sout);
Return;
End "Bad input mask";
If (mask1_GET!MASK(sip1))=none
Then Return;
msk!index1_m!index;
End "Get input mask";
" If input2 is a mask then get it"
If not Equ(GUESSER(sip2,lgl!mnames),null)
Then
If (mask2_GET!MASK(sip2))=none
Then Return;
msk!index2_m!index;
" DISPATCH AND TEST FOR UNARY IN EACH CASE"
mask!a!dispatch: CASE (index-1) of
Begin "DO MASKOPERATIONS"
Begin "1 AND"
COMMENT
.sss(AND)
.INDEX(AND)
.;
If (mask2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input mask."&crlf);
DEL!MASK(sout);
Return;
End "Not enough";
PMAND(Datum(mask1),Datum(mask2),Datum(mask3));
End "1 AND";
Begin "2 OR"
COMMENT
.sss(OR)
.INDEX(OR)
.;
If (mask2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input mask."&crlf);
DEL!MASK(sout);
Return;
End "Not enough";
PMOR(Datum(mask1),Datum(mask2),Datum(mask3));
End "2 OR";
Begin "3 MINUS"
COMMENT
.sss(SUB)
.INDEX(SUB)
.;
If (mask2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input mask."&crlf);
DEL!MASK(sout);
Return;
End "Not enough";
PMSUB(Datum(mask1),Datum(mask2),Datum(mask3));
End "3 MINUS";
Begin "4 COPY"
COMMENT
.sss(COPY)
.INDEX(COPY)
.;
PMCOPY(Datum(mask1),Datum(mask3));
End "4 COPY";
Begin "5 NOT"
COMMENT
.sss(COMPLEMENT)
.INDEX(COMPLEMENT)
.;
PMCOMPLEMENT(Datum(mask1),Datum(mask3));
End "5 NOT";
Begin "6 ZERO"
COMMENT
.sss(ZERO)
.INDEX(ZERO)
.;
PMZERO(Datum(mask3));
End "6 ZERO";
Begin "7 READ"
COMMENT
.sss(READ)
.INDEX(READ)
.;
PFRAME("SAVE");
" Get the input file name if specified in sip1
else ask for it"
If not Equ(sip1,null)
Then
Begin "From args"
file!name_sip1&proj!programmer;
" Lookup the file"
s_dev!name;
If s=":" or s=null
Then s_"DSK"
Else s_s[1 to inf-1];
Open(i_Getchan,s,0,0,0,1,j,flag);
Lookup(i,file!name,flag);
Release(i);
file!name_dev!name&file!name;
End "From args"
Else
flag_true;
If flag
Then
Begin "Not found"
Outstr("File not found."&crlf);
Return;
End "Not found";
If sip2 Neq "N"
Then
Begin "Check size"
" Get the header and check to see if it is non
256x256 size"
header[0]_1;
GETDDTG(file!name,header);
CLOSEINDATA;
" See if the type is neq current size"
If header[80] neq imsiz
Then
Begin "change mask size"
Outstr("Computing size ="&cvs(imsiz+1)&
" inconsistant with file size ="&
cvs(header[80]+1)&crlf&
"To read it in, the current mask "&
"must be deleted."&crlf);
If not DEL!MASK(sout)
Then
Begin "ok, make new mask"
ival_(16 Max header[80]) Min 256;
PINI(trunc!max,ival);
mask3_GET!MASK(sout);
msk!index3_m!index;
End "ok, make new mask";
End "change mask size";
End "Check size";
" Setup NUMBER option if exists"
header[0]_sip2;
outstr("Reading in mask "&file!name&crlf);
If flag_GETBMASK(Datum(mask3), file!name,
mask!title[msk!index3], header)
Then
outstr("Bad mask file header"&crlf);
" print the mask title"
outstr("Title:"&crlf&mask!title[msk!index3]&crlf);
PFRAME("RESTORE");
If not flag Then Return
Else DEL!mask(sout);
End "7 READ";
Begin "8 WRITE"
COMMENT
.sss(WRITE)
.INDEX(WRITE)
.;
If not Equ(sout,null)
Then outfile_dev!name&sout&proj!programmer
Else
While FBOUND(outfile,"any","Output file",
"file") Do
outstr("file " & outfile &
" already exists" & crlf);
If equ(mask!title[msk!index1],null)
Then SBOUND(mask!title[msk!index1],"any",
"mask title","Title");
outstr("Writing mask " & outfile & crlf);
" Force it to generate a mask header"
header[0]_0;
PUTBMASK(Datum(mask1),outfile,mask!title[msk!index1],
header);
outstr(crlf);
End "8 WRITE";
Begin "9 DELETE"
COMMENT
.sss(DELETE)
.INDEX(DELETE)
.;
DEL!MASK(sout);
End "9 DELETE";
Begin "10 MCIRCLE"
COMMENT
.sss(MCIRCLE)
.INDEX(MCIRCLE)
.;
If not (sip1 = null)
Then
radius_(1 max Realscan(sip1,flag))
min imsiz
Else
BOUND(1,radius,imsiz,"radius",null);
radius2_radius^2;
If not (sip2 = null)
Then
row!circle_(firstrow max
Intscan(sip2,flag)) min lastrow
Else
IBOUND("-inf",row!circle,"inf",
"center row","row");
If not (sip3 = null)
Then
column!circle_(firstcolumn max
Intscan(sip3,flag)) min
lastcolumn
Else
IBOUND("-inf",column!circle,"inf",
"center column", "column");
PMCIRCLE(Datum(mask3),row!circle,column!circle,radius);
End "10 MCIRCLE";
Begin "11 RECTANGLE"
COMMENT
.sss(RECTANGLE)
.INDEX(RECTANGLE)
.;
If not(sip1=null)
Then
row!side_(0 Max Intscan(sip1,flag)) Max
imsiz
Else
IBOUND(1,row!side,imsiz,"number of rows",
"# rows");
If not (sip2=null)
Then
column!side_(0 Max Intscan(sip2,flag)) Max
imsiz
Else
IBOUND(1,column!side,imsiz,
"number of columns", "# columns");
If not (sip3=null)
Then
rect!row!center_
(0 Max Intscan(sip3,flag)) Max imsiz
Else
IBOUND(row!side,rect!row!center,imsiz-row!side,
"center row","row");
If not (sip4=null)
Then
rect!column!center_
(0 Max Intscan(sip4,flag)) Max imsiz
Else
IBOUND(column!side,rect!column!center,
imsiz-column!side,
"center column", "column");
PMRECTANGLE(Datum(mask3), rect!row!center,
rect!column!center, row!side, column!side);
End "11 RECTANGLE";
Begin "12 MSLICE"
COMMENT
.sss(MSLICE)
.INDEX(MSLICE)
.;
Own Integer dmin, dmax;
If (image1_GET!IMAGE(sip1))=none
Then return;
If (sip2 neq "U")
Then
dmin_(0 max abs(Intscan(sip2,flag)))
min trunc!max
Else
dmin_thr!density;
If (sip2 neq "U")
Then
dmax_(dmin max abs(Intscan(sip3,flag)))
min trunc!max
Else
dmax_trunc!max;
PMSLICE(Datum(mask3),Datum(image1),dmin,dmax);
End "12 MSLICE";
Begin "13 MSEGMENT"
COMMENT
.sss(MSEGMENT)
.INDEX(MSEGMENT)
.;
Own Integer segment!number;
If sip1=null Then Begin "get pix name"
outstr("Generate mask from segment picture: ");
sip1_UPLOWINCHWL;
End "get pix name";
If (image1_GET!IMAGE(sip1))=none Then return;
If not Equ(sip2,null)
Then
segment!number_(1 max Intscan(sip2,flag))
min 253
Else
IBOUND(1,segment!number,253,
"Segment number?","Seg #?");
PMSEGMENT(Datum(mask3),Datum(image1),segment!number);
End "13 MSEGMENT";
Begin "14 SPHERE"
COMMENT
.sss(SPHERE)
.INDEX(SPHERE)
.;
If not (sip1 = null)
Then
zcenter_(mininteger max Intscan(sip1,flag) )
min maxinteger
Else
IBOUND("-inf",zcenter,"inf",
"distance of center from plane","z distance");
If not (sip2 = null)
Then
radius!of!sphere_(minreal max
Realscan(sip2,flag))
min maxreal
Else
BOUND(abs(zcenter),radius!of!sphere,
"inf","radius of SPHERE","radius");
radius_sqrt(radius!of!sphere^2-zcenter^2);
If radius < 1 Then Return;
radius2_radius^2;
If not (sip3 = null)
Then
row!circle_(mininteger max
Intscan(sip3,flag))
min maxinteger
Else
IBOUND("-inf",row!circle,"inf",
"center row","row");
If not (sip4 = null)
Then
column!circle_(mininteger max
Intscan(sip4,flag))
min maxinteger
Else
IBOUND("-inf",column!circle,"inf","center column",
"column");
PMCIRCLE(Datum(mask3),row!circle,column!circle,radius);
End "14 SPHERE";
Begin "15 SQUARE"
COMMENT
.sss(SQUARE)
.INDEX(SQUARE)
.;
If not (sip1 = null)
Then
side_(mininteger max Intscan(sip1,flag))
min maxinteger
Else
IBOUND(1,side,imsiz,"Size of side","Size");
If not (sip2 = null)
Then
row!square_(mininteger max
Intscan(sip2,flag))
min maxinteger
Else
IBOUND(-imsiz,row!square,imsiz,
"center row","row");
If not (sip3 = null)
Then
column!square_(mininteger max
Intscan(sip3,flag))
min maxinteger
Else
IBOUND(-imsiz,column!square,imsiz,
"center column","column");
PMRECTANGLE(Datum(mask3), row!square, column!square,
side, side);
End "15 SQUARE";
Begin "16 WHOLE"
COMMENT
.sss(WHOLE)
.INDEX(WHOLE)
.;
For row_firstrow Step 1 Until lastrow Do
For column_firstcolumn Step 1 Until lastcolumn Do
MSK!PACK2D(Datum(mask3), row, column, 1);
End "16 WHOLE";
Begin "17 AREA"
COMMENT
.sss(AREA)
.INDEX(AREA)
.;
Integer area;
" Compute area of mask by counting 1's"
area_0;
usemask_true;
mskimage_mask1;
For r_ firstrow step 1 until lastrow Do
For c_ firstcolumn step 1 until lastcolumn Do
If MSK!BOOL(r,c) Then area_area+1;
Outstr("mask "&sip1&" AREA="&cvs(area)&
" pixels"&crlf);
End "17 AREA";
Begin "18 PERIMETER"
COMMENT
.sss(PERIMETER)
.INDEX(PERIMETER)
.;
Real perimeter;
" Compute PERIMETER of mask by counting 1's"
perimeter_0;
usemask_true;
mskimage_mask1;
For r_ firstrow+1 step 1 until lastrow-1 Do
For c_ firstcolumn+1 step 1 until lastcolumn-1 Do
If MSK!BOOL(r,c)
Then
If (MSK!BOOL(r-1,c)=1 and
MSK!BOOL(r+1,c)=0) or
(MSK!BOOL(r,c-1)=1 and MSK!BOOL(r,c+1)=0) or
(MSK!BOOL(r+1,c)=1 and MSK!BOOL(r-1,c)=0)
Then perimeter_perimeter+1
Else
If
(MSK!BOOL(r-1,c-1)=1 and MSK!BOOL(r,c-1)=0) or
(MSK!BOOL(r-1,c+1)=1 and MSK!BOOL(r-1,c)=0) or
(MSK!BOOL(r+1,c-1)=1 and MSK!BOOL(r,c-1)=0) or
(MSK!BOOL(r+1,c+1)=1 and MSK!BOOL(r+1,c)=0)
Then
perimeter_perimeter+sqrt(2);
Outstr("mask "&sip1&" PERIMETER="&
cvs(perimeter)&crlf);
End "18 PERIMETER";
End "DO maskOPERATIONS";
End "MASK!ASSIGNMENT";
End "MINTRP.SAI";