Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50416/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";