Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50416/pintrp.sai
There are 2 other files named pintrp.sai in the archive. Click here to see a list.
ENTRY;
COMMENT
.SOSPAGE_1
.SEC(PINTRP - PROC10 Picture Operation Interpreter)
.index(PINTRP - PROC10 Picture Operation Interpreter)
.;
BEGIN "PINTRP.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

Rev Nov 14, 1976 - Lemkin, fixed PIXDMP
Rev Oct 12, 1976 - Lemkin, removed SMSG/DEBUG
Rev oct 2, 1976 - lemkin modify GRAD4 and PDIFF
Revised Aug 25, 1976 - Lemkin, fixed thr!density use
Revised Aug 24, 1976 - Lemkin, fixed WHITENOISE args 
Revised Aug 23, 1976 - Lemkin, fixed SMSG comments
Revised July 7, 1976 - Lemkin changed READ
Revised June 11, 1976 - Lemkin changed - to MINUS, DIRLST
Revised May 27, 1976 - Lemkin changed - to MINUS, DIRLST
Revised May 26, 1976 - Lemkin added R/W NUMBER opt
Revised May 25, 1976 - Lemkin added mask size checker
Revised May 24, 1976 - Lemkin fixed PTEX2 args
Revised May 21, 1976 - Lemkin fixed SEGMENT,
Revised May 22, 1976 - Lemkin fixed SEGMENT, AND READ/WRITE SIZE ERR
Revised May 19, 1976 - Lemkin fixed SEGMENT,
Revised May 17, 1976 - Lemkin fixed SEGMENT, added TEXTUREi
Revised May 13, 1976 - Lemkin fixed  dmin/dmax setups
Revised April 19, 1976 - fixed  for 50,752
Revised April 13, 1976 - fixed SHOW (x0,y0)==>(xp,yp)
MARCH 20, 1976
;
COMMENT
.ss(PINTRP REQUIRE files)
.INDEX(PINTRP 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 "LINPAK.REQ" source!file;
Require "SPAK.REQ" source!file;
Require "CVT.REQ" source!file;
Require "BOUND.REQ" source!file;
Require "DARRAY.REQ" source!file;
Require "HLFTON.REQ" source!file;
Require "CROSSH.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 PIX!ASSIGNMENT)
.INDEX(Procedure PIX!ASSIGNMENT)
.;

Internal Procedure PIX!ASSIGNMENT;
Begin "PIX!ASSIGNMENT"

String
	smask,
	s1,
	s2,
	s3,
	s,
	ss,
	sss;

Boolean direction;

Integer delta,
	i,
	j,
	k,
	ival,
	jval,
	index,
	pix!index1,
	pix!index2,
	pix!index3;

Label pix!a!dispatch;

Real val;

"	clear the itemvar names"
	mskimage_image1_image2_image3_none;

"	Find the operator index"
	For index_1 Step 1 Until max!number!pixops Do
		If equ(cmd,lgl!pops[index]) Then Done;

	If db=2 Then Goto pix!a!dispatch;

"	see if have a mask anywhere"
	smask_GUESSER(sip1,lgl!mnames)&
		GUESSER(sip2,lgl!mnames)&
		GUESSER(sip3,lgl!mnames)&
		GUESSER(sip4,lgl!mnames)&
		GUESSER(sip5,lgl!mnames)&
		GUESSER(sip6,lgl!mnames);

"	See if the mask is being used, then get the item"
	If not Equ(smask, null)
	   Then 
		Begin "set mask"
		usemask_true;
		mskimage_GET!MASK(smask);
"		check to see if mask same size as current image"
		i_Sqrt(36*(-1+(ARRINFO(Datum(mskimage),0))));
		If i neq imsiz+1
			Then
			Begin "bad size"
			Outstr("Wrong mask size " & CVS(i) &
				" from pix size "&CVS(imsiz+1)&crlf);
			Return;
			End "bad size";
		End "set mask"
	   Else usemask_false;

"	See if have output"
	If Equ(GUESSER(cmd,lgl!noutput!ops),null)
		Then
		Begin "get output image"
		If (image3_GET!IMAGE(sout))=none Then Return;

"		copy the image3 index "
		pix!index3_p!index;

"		Get the image title if null and not READ"
		If not (image3 = none)
		   Then
		   If auto!title 
			Then pix!title[pix!index3]_strcopy
			Else
			If pix!title[pix!index3]=null and
			 not Equ(cmd,"READ")
			  Then
			  SBOUND(pix!title[pix!index3],"any",
				"Picture "&sout&" title", sout&
				" title");
		End "get output image"
		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;
			image1_none;
			End "shift args right";

"	Note: test for operators which take no picture args and
	then do not get an input picture"
	If Equ(GUESSER(cmd,lgl!ninput!ops), null)
		Then
		Begin "get input image"
		image1_GET!IMAGE(sip1);
		pix!index1_p!index;
"		test for now input image"
		If image1 = none Then 
			Begin "bad  pix"
			If image3 neq none 
				Then
				DEL!PIX(sout);
		return;
		End "bad  pix";
		End "get input image";

"	If we have a unary operation (sip2) will be none";
	If not Equ((s_GUESSER(sip2,lgl!pnames)), null)
		Then Begin "get image 2"
			image2_GET!IMAGE(s);
			pix!index2_p!index;
			End "get image 2";

"	DISPATCH and TEST FOR UNARY IN EACH CASE"

pix!a!dispatch: CASE (index-1) of 
	Begin "DO OPERATIONS"
Begin "1 +"
COMMENT
.sss(PLUS)
.INDEX(PLUS)
.;
		
		If (image2 = none)
			Then Begin "Not enough"
				outstr("Bad 2nd input image name."
					&crlf);
				DEL!PIX(sout);
				Return;
			     End "Not enough";
		PADD(Datum(image1),Datum(image2),Datum(image3));
		End "1 +";

Begin "2 MINUS"
COMMENT
.sss(MINUS)
.INDEX(MINUS)
.;
		
		If (image2 = none)
			Then Begin "Not enough"
				outstr("Bad 2nd input image name."&
					crlf);
				DEL!PIX(sout);
				Return;
			     End "Not enough";
		PSUB(Datum(image1),Datum(image2),Datum(image3));
		End "2 MINUS";

Begin "3 *"
COMMENT
.sss(TIMES)
.INDEX(TIMES)
.;
		
		If (image2 = none)
			Then Begin "Not enough"
				outstr("Bad 2nd input image name."
					&crlf);
				DEL!PIX(sout);
				Return;
			     End "Not enough";
		PMUL(Datum(image1),Datum(image2),Datum(image3));
		End "3 *";

Begin "4 /"
COMMENT
.sss(DIVIDED BY)
.INDEX(DIVIDED BY)
.;
		
		If (image2 = none)
			Then Begin "Not enough"
				outstr("Bad 2nd input image name."
					&crlf);
				DEL!PIX(sout);
				Return;
			     End "Not enough";
		PDIV(Datum(image1),Datum(image2),Datum(image3));
		End "4 /";

Begin "5 MAX"
COMMENT
.sss(MAX)
.INDEX(MAX)
.;
		
		If (image2 = none)
			Then Begin "Not enough"
				outstr("Bad 2nd input image name."
					&crlf);
				DEL!PIX(sout);
				Return;
			     End "Not enough";
		PMAX(Datum(image1),Datum(image2),Datum(image3));
		End "5 MAX";

Begin "6 MIN"
COMMENT
.sss(MIN)
.INDEX(MIN)
.;
		
		If (image2 = none)
			Then Begin "Not enough"
				outstr("Bad 2nd input image name."
					&crlf);
				Return;
			     End "Not enough";
		PMIN(Datum(image1),Datum(image2),Datum(image3));
		End "6 MIN";

Begin "7 SCALE"
COMMENT
.sss(SCALE)
.INDEX(SCALE)
.;
	Own Real val;
		
		If not( (sip2=null) or (sip2="M"))
			Then val_abs(realscan(sip2,flag))
			Else
			BOUND("-inf",val,"inf","Scaler?",
				"Scaler?");
		PSCALE(Datum(image1),Datum(image3),val);
		End "7 SCALE";

Begin "8 ROTATE"
COMMENT
.sss(ROTATE)
.INDEX(ROTATE)
.;
	Own Integer row!val,col!val;
	Own Real val;
		
		If not( (sip2=null) or (sip2="M"))
			Then row!val_Intscan(sip2,flag)
			Else
			IBOUND(firstrow,row!val,lastrow,
				"row center", "row center");
		If not( (sip3=null) or (sip3="M"))
			Then col!val_Intscan(sip3,flag)
			Else
			IBOUND(firstcolumn,col!val,lastcolumn,
				"column center", "column center");
		If not( (sip4=null) or (sip4="M"))
			Then val_Realscan(sip4,flag)
			Else
			BOUND(-360,val,360,"Degrees?","Degrees?");
		PROTATE(Datum(image1),Datum(image3),
			row!val,col!val,val)
		End "8 ROTATE";

Begin "9 COPY"
COMMENT
.sss(COPY)
.INDEX(COPY)
.;
		
		PCOPY(Datum(image1),Datum(image3));
		End "9 COPY";

Begin "10 AVG4"
COMMENT
.sss(AVG4)
.INDEX(AVG4)
.;
		
		PAVG4(Datum(image1),Datum(image3));
		End "10 AVG4";

Begin "11 AVG8"
COMMENT
.sss(AVG8)
.INDEX(AVG8)
.;
		
		PAVG8(Datum(image1),Datum(image3));
		End "11 AVG8";

Begin "12 GRAD4"
COMMENT
.sss(GRAD4)
.INDEX(GRAD4)
.;
		
		If sip2="D"
			Then direction_true
			Else direction_false;
		PGRAD4(Datum(image1),Datum(image3),direction);
		End "12 GRAD4";

Begin "13 GRAD8"
COMMENT
.sss(GRAD8)
.INDEX(GRAD8)
.;
		
		If sip2="D"
			Then direction_true
			Else direction_false;
		PGRAD8(Datum(image1),Datum(image3),direction);
		End "13 GRAD8";

Begin "14 FILLPINHOLES"
COMMENT
.sss(FILLPINHOLES)
.INDEX(FILLPINHOLES)
.;
	Own Integer ival;
		
		If (sip2 neq null) and (sip2 neq "M")
			Then
			ival_(Intscan(sip2,flag) max 0)
				 min trunc!max
			Else
			IBOUND(0,ival,trunc!max,"Delta density",
				"Delta density");
		outstr("Filled: "&cvs(PFILLPIN(Datum(image1),
			Datum(image3), ival))&crlf);
		End "14 FILLPINHOLES";

Begin "15 SLICE"
COMMENT
.sss(SLICE)
.INDEX(SLICE)
.;
	Own Integer dmin, dmax;
		
"		Do initial init for dmax"
		If dmax=0 
			Then dmax_trunc!max;

		If sip2="U"
			Then
			Begin "use global thrshold"
			dmin_thr!density;
			dmax_trunc!max;
			End "use global thrshold"
		Else
		Begin "use local density"
		If (sip2 neq null) and (sip2 neq "M")
			Then
			dmin_(Intscan(sip2,flag) max 0) min 
				trunc!max;

"		get the upper limit and check if sip3 is Mi"
		If (sip3 neq null) and (sip3 neq "M")
			Then
			dmax_(Intscan(sip3,flag) max dmin) min
				 trunc!max;
		End "use local density";

		PSLICE(Datum(image1),Datum(image3),dmin,dmax);
		End "15 SLICE";

Begin "16  NOT"
COMMENT
.sss(COMPLEMENT)
.INDEX(COMPLEMENT)
.;
		
		PCOMPLEMENT(Datum(image1),Datum(image3));
		End "16  NOT";

Begin "17 EXPAND"
COMMENT
.sss(EXPAND)
.INDEX(EXPAND)
.;
	Own Integer ival;
		
		If (sip1 neq null) and (sip1 neq "M")
			Then
			ival_(Intscan(sip1,flag) max 0)
				 min imsiz
			Else
			IBOUND(-imsiz,ival,imsiz,"#points","#points");
		PEXPAND(Datum(image3),ival);
		End "17 EXPAND";

Begin "18 SHRINK"
COMMENT
.sss(SHRINK)
.INDEX(SHRINK)
.;
		
		If (sip1 neq null) and (sip1 neq "M")
			Then
			ival_(Intscan(sip1,flag) max 0 )
				 min imsiz
			Else
			IBOUND(-imsiz,ival,imsiz,"#points","#points");
		PSHRINK(Datum(image3),ival);
		End "18 SHRINK";

Begin "19 SHIFT"
COMMENT
.sss(SHIFT)
.INDEX(SHIFT)
.;
	Own Integer ival,jval;
		
		If (sip2 neq null) and (sip2 neq "M")
			Then
			ival_(Intscan(sip2,flag) max -imsiz)
				 min imsiz
			Else
			IBOUND(-imsiz,ival,imsiz,"Delta X","Del X");

		If (sip3 neq null) and (sip3 neq "M")
			Then
			jval_(Intscan(sip3,flag) max -imsiz)
				 min imsiz
			Else
			IBOUND(-imsiz,jval,imsiz,"Delta Y","Del Y");
		PSHIFT(Datum(image1),Datum(image3),ival,jval);
		End "19 SHIFT";

Begin "20 SEGMENT"
COMMENT
.sss(SEGMENT)
.INDEX(SEGMENT)
.;
		String ss;
		Boolean save!boundaries;
		Integer b,
			size!lower,
			size!upper;
		Boolean fill!holes;
		

"		[20.1] See if save the boundaries then pass the
		output picture name to be used in
		making the boundary PNAMES"
		If Equ(sip2[1 for 3],"NOB") or
		   Equ(sip3[1 for 3],"NOB") or
		   Equ(sip4[1 for 3],"NOB")
			Then save!boundaries_false
			Else save!boundaries_true;

"		[20.2] see if do not fill holes in segments"
		If Equ(sip2[1 for 3],"NOF") or
		   Equ(sip3[1 for 3],"NOF") or
		   Equ(sip4[1 for 3],"NOF") or
		   Equ(sip5[1 for 3],"NOF")
			Then fill!holes_false
			Else fill!holes_true;

"		[20.3] get the size limets, default to 2:2047"
		size!lower_2;
		size!upper_2047;
		If ((ival_Intscan(s_sip2,flag)) > 1 and
		    (jval_Intscan(s_sip3,flag)) > ival)
			Then 
			Begin "set size"
			size!lower_ival;
			size!upper_jval;
			End "set size";

"		[20.4] go segment the image"
		PSEGMENT(Datum(image1), Datum(image3), ival, jval, 
			image1,image3,save!boundaries,fill!holes,
			size!lower, size!upper, strcopy);


"		[20.5] print the number of segments and holes"
		outstr("Found "&cvs(ival)&" segments, "
			&cvs(jval)&" holes."&crlf);
		End "20 SEGMENT";

Begin "21 WHITENOISE"
COMMENT
.sss(WHITENOISE)
.INDEX(WHITENOISE)
.;
		
		If not Equ(sip1,null) 
			Then
			std!dev_0 Max (Intscan(sip1,flag) 
				   Min ((trunc!max+1)/2));
		If not Equ(sip2,null) 
			Then
			density!value_0 Max 
			   (Intscan(sip2,flag) Min trunc!max);
		PGAUSS(Datum(image3),std!dev,density!value);
		End "21 WHITENOISE";

Begin "22 ZERO"
COMMENT
.sss(ZERO)
.INDEX(ZERO)
.;
		
		PZERO(Datum(image3));
		End "22 ZERO";

Begin "23 DELSQPIX"
COMMENT
.sss(DELSQPIX)
.INDEX(DELSQPIX)
.;
		
		If image2=none 
			Then
			Begin "Bad 2nd param"
			Outstr("Bad 2nd parameter");
			Return;
			End "Bad 2nd param";
		delta_PDELSQ(Datum(image1),Datum(image2));
		Outstr("Sum of gray scale differences Squared="&
			cvs(delta)&crlf);
		End "23 DELSQPIX";

Begin "24 FINDWINDOW"
COMMENT
.sss(FINDWINDOW)
.INDEX(FINDWINDOW)
.;
		Integer f!row,f!column,l!row,l!column;
		
		ival_0;
		If (sip2 neq "U") or (sip2 neq "M") 
			Then
			ival_(0 max Intscan(sip2,flag))
					 min trunc!max
			Else
			If sip2="U"
				Then ival_thr!density;
		PFINDWINDOW(Datum(image1), f!row, l!row,
			f!column, l!column, ival);
		outstr("Max window (" & cvs(f!row) & ":"
			& cvs(l!row) & "," &cvs(f!column) & 
			":" & cvs(l!column) &") size " &
			cvs(l!row-f!row+1) & " x "
			& cvs(l!column-f!column+1) & 
			" pixels using density threshold " &
			cvs(ival) & crlf);

"		see if set up RECTANGLE mask parameters"
		If LBOUND(trn!rectangle,
			"Transfer window parameters to RECTANGLE"
			&" mask generator,"&" ok?",
			"Trans. to Rectangle?")
				Then 
				Begin "yes, transfer parameters"
				row!side_l!row-f!row;
				column!side_l!column-f!column;
				rect!row!center_(l!row-f!row)/2;
				rect!column!center_(l!column-
					f!column)/2;
				End "yes, transfer parameters";
		If LBOUND(trn!window,
			"Transfer window parameters to "
			&"computation window, ok?", 
			"Trans. to computation window?")
				Then 
				Begin "yes, transfer working window"
				firstrow_f!row;
				lastrow_l!row;
				firstcolumn_f!column;
				lastcolumn_l!column;
				End "yes, transfer working window";
		End "24 FINDWINDOW";

Begin "25 HISTOGRAMPIX"
COMMENT
.sss(HISTOGRAMPIX)
.INDEX(HISTOGRAMPIX)
.;
		Integer p,q,imax,imin,count,maximum;
		Own Boolean see!histogram;
		getformat(p,q);
		
		Begin "Histogrampix"
		Safe Integer Array average[0:511];
		Integer avgbin,i,k,m,avgmax,rc!switch;

"		[25.1]  set the window to that of the current pix
		get the averaging number of gray values/bin"
		i_Sqrt(4*ARRINFO(Datum(image1),0));
		If imsiz neq i-1
			Then PINI(-1,i);

		avgbin_(1 max Intscan(sip2,flag)) min trunc!max;
		rc!switch_0;

"		[25.2] See if do just Row or Column"
		rc!switch_0;
		If sip2="R" or sip3="R" Then rc!switch_"R";
		If sip2="C" or sip3="C" Then rc!switch_"C";

"		[25.3] get the histogram"
		PHIST(Datum(image1),hist,
			maxima,minima,imax,imin,
			rc!switch);
"		If sout eq T<number>
			then put it into Ti datum"
		If (sout="T") and ("0" leq sout[2 for 1] leq "9")
			Then
			Begin "make Ti"
			iname_NEW(hist);
			New!Pname(iname,sout);
			PROPS(iname)_512;
		Make a!transform XOR iname EQV v!HISTtransform;
			End "make Ti";

"		[25.4] Determine the display type"
		If equ(trm!name,"4012") or
			 Equ(trm!name,"GT40")
			Then
			Begin "4012 or GT40"
			Itemvar xxx;
			xxx_CVSI("HIST"&sip1,flag);
			If flag
				Then
				Begin "make it"
				xxx_NEW;
				New!Pname(xxx,"HIST"&sip1);
				End "make it";

"			[25.4.1] Display on 4012 or GT40"
			If not autoOMNInumber
				Then
				Begin "clearing"
				Itemvar xxx;
				Foreach xxx Such That 
					xxx In omni!post Do
					   DEL!OMNI!NUMBER(
						CVIS(xxx,flag));
				DREL;
				DGET;
				End "clearing";
"				Setup new OMNI numbers"
				npict_GET!OMNI!NUMBER("HIST"&sip1);
				xxx_CVSI("HIST"&sip1,flag);
				Put xxx In omni!post;

"			[25.4.2] display"
			DOPEN(npict);
			DARRAY(hist,0,255,0,255,null);
			DPOST(npict);
			DDONE1;

"			[25.4.3] get cross hairs if needed"
			If r!cross and Equ(trm!name,"4012")
				Then
				Begin "do c-h"
				PFRAME("SAV");
				firstrow_firstcolumn_0;
				lastrow_lastcolumn_779;
				CROSSHAIRS;
				PFRAME("RES");
				End "do c-h";
			End "4012 or GT40"

			Else
			Begin "TTY"
"			[25.4.2] Display on ASR33 type terminal"
			Outstr("Histogram of "&sip1&crlf&
			       "Title: "&pix!title[pix!index1]&crlf);
			count_0;
			maximum_0;
			For i_  0 Step avgbin Until trunc!max Do
				  Begin "Histogrampix scan"
				  avgmax_0;
			For k_ i step 1 until 255 min (i+avgbin-1) Do
				Begin "AVG-hist"
				    If  hist[k] > 0
					Then count_count+1;
				    avgmax_avgmax+hist[k];
				   End "AVG-hist";
				  maximum_maximum max avgmax;
				  average[i]_avgmax;
				  End "Histogrampix scan";

			LBOUND(see!histogram,
				"Histogram has " & cvs(count) &
				" nonzero entries." & crlf &
				"Do you want to see them as a graph?",
				cvs(count)&" histogram entries. Ok?");
			If see!histogram
			    Then 
			    For i_ 0 Step avgbin Until trunc!max Do
				If  average[i] > 0
					Then
					Begin "output"
					setformat(3,0);
					outstr(cvs(i) & ":");
					setformat(5,0);
					outstr(cvs(average[i]) & ":");
					For j_  0 Step 1 Until 
					   (61.*average[i])/maximum Do
					    outstr("X");
					outstr(crlf);
					End "output";
			End "TTY";
		End "Histogrampix";
				setformat(p,q);
		End "25 HISTOGRAMPIX";

Begin "26 SHOW"
COMMENT
.sss(SHOW)
.INDEX(SHOW)
.;
		
"		Set the frame to image1 size after save frame"
		PFRAME("SAV");
		i_Sqrt(4*ARRINFO(Datum(image1),0));
		If imsiz neq (i-1)
			Then PINI(-1,i);

"		If using the mask, then make a new pix display it and
		then trash it"
		If usemask
			Then
			Begin "get a copy under mask"
			image3_PMAKIMAGE("TRASH");
			PCOPY(Datum(image1),Datum(image3));
			image1_image3;
			outstr("Display under mask "&smask&crlf);
			End "get a copy under mask";
		If  equ(trm!name,"4012") or Equ(trm!name,"GT40")
			Then
			Begin "4012 or GT40"

"			[26.1] Display on 4012 or GT40"
			If not autoOMNInumber
				Then
				Begin "clearing"
				Itemvar xxx;
				Foreach xxx Such That 
					xxx In omni!post Do
						DEL!OMNI!NUMBER(CVIS(
							xxx,flag));
				DREL;
				DGET;
				End "clearing";
"				Setup new OMNI numbers"
				npict_GET!OMNI!NUMBER(sip1);
				Put image1 In omni!post;
			End "4012 or GT40";

"	display the image"
	HLFTON(Datum(image1),firstrow,lastrow,firstcolumn,
		lastcolumn, sampled, pix!title[p!index], 
		xp, yp,  dmin,  dmax,  scaling,  npict,  r!cross,
		c!cross, trm!name);

"	If used mask, then delete the trash image"
	If usemask Then PDELIMAGE("TRASH");
"		Restore the computing frame"
		PFRAME("RES");
		End "26 SHOW";

Begin "27 READ"
COMMENT
.sss(READ)
.INDEX(READ)
.;
		
		PFRAME("SAV");
"		Get the input file name if specified in sip1"
		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 image size"
		If ((header[5]=15) and (header[80] neq imsiz))
		  or ((header[5]=9) and (imsiz neq 255))
			Then
			Begin "change image size"
			Outstr("Computing size ="&cvs(imsiz+1)&
			   " inconsistant with file size ="&
			   cvs(header[80]+1)&"."&crlf&
			   "To read the file in, the current picture "&
			   "must be deleted"&crlf&
			   "otherwise the READ is not performed."&crlf);
			If not DEL!PIX(sout) 
				Then
				Begin "ok, make new pix"
				ival_(16 Max header[80]) Min 256;
				PINI(trunc!max,ival);
				image3_GET!IMAGE(sout);
				pix!index3_p!index;
				End "ok, make new pix"
				Else 
				Begin "forget it"
				PFRAME("RES");
				Return;
				End "forget it";
			End "change image size";
		 End "check size";

		outstr("Reading "&file!name&crlf);

"		Setup NUMBER switch if exists"
		header[0]_sip2;
		If flag_GETPIX(Datum(image3), file!name,
			pix!title[pix!index3], header)
				Then 
				outstr("Bad Picture file header"&crlf);
"		print the picture title"
		outstr("Title:"&crlf&pix!title[pix!index3]&crlf);
		PFRAME("RES");
		If not flag Then Return 

			Else DEL!PIX(sout);
		End "27 READ";

Begin "28 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(pix!title[pix!index1],null)
			Then SBOUND(pix!title[pix!index1],"any",
					"Picture title","Title");
		outstr("Writing picture " & outfile & crlf);
"		Force it to generate a picture header"
		header[0]_0;
		PUTPIX(Datum(image1),outfile,pix!title[pix!index1],
			header);
		outstr(crlf);
		End "28 WRITE";

Begin "29 DELETE"
COMMENT
.sss(DELETE)
.INDEX(DELETE)
.;
		DEL!PIX(sout);
		End "29 DELETE";

Begin "30 AREA"
COMMENT
.sss(AREA)
.INDEX(AREA)
.;
		
"		get optional threshold"
		ival_0;
		If (sip2 neq "M") or (sip2 neq "U")
			Then
			ival_(0 max Intscan(sip2,flag))
					 min trunc!max
			Else
			If sip2="U"
			Then ival_thr!density;
		Outstr("Computing AREA > threshold "&
				cvs(ival)&", Frame area="&
				CVS((lastrow-firstrow)*
				    (lastcolumn-firstcolumn))&crlf);
		Outstr("Image "&sip1&" AREA = "&cvs(
			PAREA(Datum(image1),ival))&
				" pixels"&crlf);
		End "30 AREA";

Begin "31 DENSITY"
COMMENT
.sss(DENSITY)
.INDEX(DENSITY)
.;
		
"		get optional threshold"
		ival_0;
		If (sip2 neq "M") or (sip2 neq "U")
			Then
			ival_(0 max Intscan(sip2,flag))
					 min trunc!max
			Else
			If sip2="U"
				Then ival_thr!density;
		Outstr("computing DENSITY > threshold "&
				cvs(ival)&", Frame area="&
				CVS((lastrow-firstrow)*
				    (lastcolumn-firstcolumn))&crlf);
		Outstr("Image "&sip1&" DENSITY = "&cvs(
			PDENSITY(Datum(image1),ival))&crlf);
		End "31 DENSITY";

Begin "32 PERIMETER"
COMMENT
.sss(PERIMETER)
.INDEX(PERIMETER)
.;
"		get optional threshold"
		ival_0;
		If (sip2 neq "M") or (sip2 neq "U")
			Then
			ival_(0 max Intscan(sip2,flag))
					min trunc!max
			Else
			If sip2="U"
				Then ival_thr!density;
		Outstr("computing PERIMETER > threshold "&
				cvs(ival)&", Frame area="&
				CVS((lastrow-firstrow)*
				    (lastcolumn-firstcolumn))&crlf);
		Outstr("Image "&sip1&" PERIMETER = "&cvs(
			PPERIMETER(Datum(image1),ival))&crlf);
		End "32 PERIMETER";

Begin "33 MOMENTS"
COMMENT
.sss(MOMENTS)
.INDEX(MOMENTS)
.;
		Integer r,c,p,q;
		Real Array moments[0:3,0:3];
		
		Getformat(p,q);
		PMOMENTS(Datum(image1),moments);
		Outstr("Image "&sip1&crlf);
		Setformat(6,0);
		Outstr("      M0r   M1r   M2r   M3r"&crlf);
		For r_0 step 1 until 3 Do
	 	  Begin "row"
		  Setformat(0,0);
		  Outstr("Mc"&cvs(r));
		  Setformat(6,0);
		  For c_0 step 1 until 3 Do
			Outstr(Cvs(moments[r,c]&"   "));
		  outstr(crlf);
		  End "row";
		Setformat(p,q);
		End "33 MOMENTS";

Begin "34 DIFFERENCE"
COMMENT
.sss(DIFFERENCE)
.INDEX(DIFFERENCE)
.;
Integer threshold;
		threshold_Intscan(sip3,flag);
		PDIFF(Datum(image1),Datum(image2),Datum(image3),
		threshold);
		End "34 DIFFERENCE";

Begin "35 LAPLACE8"
COMMENT
.sss(LAPLACE8)
.INDEX(LAPLACE8)
.;
		
		PLAPC8(Datum(image1),Datum(image3));
		End "35 LAPLACE8";

Begin "36 INSERT"
COMMENT
.sss(INSERT)
.INDEX(INSERT)
.;
		If PINSERT(Datum(image1),Datum(image3))
			Then
			Begin "Bad insert"
			Outstr("Bad insert"&crlf);
			DEL!PIX(sout);
			Return;
			End "Bad insert";
		End "36 INSERT";

Begin "37 EXTRACT"
COMMENT
.sss(EXTRACT)
.INDEX(EXTRACT)
.;
		If (image3_PEXTRACT(Datum(image1),sout)) = none
			Then
			Begin "Bad EXTRACT"
			Outstr("EXTRACT failed"&crlf);
			DEL!PIX(sout);
			Return;
			End "Bad EXTRACT";
		End "37 EXTRACT";

Begin "38 EXTREMA"
COMMENT
.sss(EXTREMA)
.INDEX(EXTREMA)
.;
		Integer
			i,
			j,
			rc!switch,
			mean,
			use!mean,
			imax,
			imin;
		Own Boolean
			see!extrema,
			use!extrema;
"		Get the use density index"
		ival_0;
"		test if USEMEAN"
		If sip2="U"
			Then use!mean_true
			Else use!mean_false;
		If "1" geq sip2 leq "9"
			Then ival_Intscan(ss_lop(sip2),flag);

"		Get the RC switch"
		If sip2="R" or sip3="R" 
			Then rc!switch_"R";

		If sip2="C" or sip3="C" 
			Then rc!switch_"C";

"		Get the extrema"
		PHIST(Datum(image1),hist,
			maxima,minima,imax,imin,
			rc!switch);
"			See if print the extrema"
			If ival = 0
			Then
			LBOUND(see!extrema,"Histogram has "&
			   cvs(imin)&" minima: "&cvs(imax)&
			   " maxima."&crlf&
			   "Do you want them listed?", "Extrema "&
			   cvs(imin)&":"&cvs(imax)&". List?")
			Else see!extrema_true;

			If see!extrema
				Then
				Begin "list extrema"
				For i_1 step 1 until imax Do
					outstr("MAX "&Cvs(j_maxima[i])&
					  ":"&cvs(hist[j])&crlf);
				Outstr(crlf);
				For i_1 step 1 until imin Do
					outstr("MIN "&Cvs(j_minima[i])&
					  ":"&cvs(hist[j])&crlf);
				End "list extrema";

"			See if take the last max and set dmin with it"
			If ival = 0
			Then
			LBOUND(use!extrema,
				"Set threshold at last min?",
				null)
			Else 
			Begin "auto"
			use!extrema_true;
			imin_ival;
			End "auto";
			If use!extrema
				Then
				Begin "use extrema"
				thr!density_minima[imin];
				End "use extrema";
"			compute the mean density"
			j_0;
			For i_0 step 1 until trunc!max Do
				j_j+hist[i];
			mean_j/trunc!max;
			If use!mean
				Then
				thr!density_mean;
		End "38 EXTREMA";

Begin "39 LINCOMB"
COMMENT
.sss(LINCOMB)
.INDEX(LINCOMB)
.;
	Own Real Aj,Bk;
"		Get Aj, Bk"
		If (sip3 neq null) and (sip3 neq "M")
			Then Aj_Realscan(sip3,flag)
			Else
			BOUND("-inf",Aj,"inf","Aj?","Aj");

		If (sip4 neq null) and (sip4 neq "M")
			Then Bk_Realscan(sip4,flag)
			Else
			BOUND("-inf",Bk,"inf","Bk?","Bk");
		PLINCOMB(Datum(image1),Datum(image2),Datum(image3),
				Aj,Bk);
		End "39 LINCOMB";


Begin "40 LISTSEGMENTS"
COMMENT
.sss(LISTSEGMENTS)
.index(LISTSEGMENTS)
.;
	
	sout_sip2;
	ACTIVE!DATA;
		End "40 LISTSEGMENTS";

Begin "41 ZOOM"
COMMENT
.sss(ZOOM)
.INDEX(ZOOM)
.;
	Real magnif;
		
		If (sip2 neq null) and (sip2 neq "M")
			Then
			magnif_Realscan(sip2,flag);
	  If ((1./256.) > magnif) or (magnif > 256.)
		Then
		BOUND(1./256.,magnif,256.,"Magnification?",
			null);
		PZOOM(Datum(image1),Datum(image3),magnif);
		End "41 ZOOM";

Begin "42 MAKEPIX"
COMMENT
.sss(MAKEPIX)
.INDEX(MAKEPIX)
.;
	Boolean fillsw;
	Integer xf,xl,yf,yl;
		
"		get the boundary name"
		If (iname_GET!BOUNDARY(sip1)) = none
			Then
			Begin "Not B name"
			Outstr(sip1&" is not a boundary name"&crlf);
			Return;
			End "Not B name";

"		Check and set fill switch value"
		If "0" leq sip2 leq "9"
			Then fillsw_true
			Else fillsw_false;

		If fillsw
			Then ival_Intscan(sip2,flag)
			Else ival_trunc!max;

"		Save the current frame and swap in the boundary frame"
		PFRAME("SAV");
		FIND!REC(Datum(iname),PROPS(iname),xf,xl,yf,yl);
		firstrow_yf;
		lastrow_yl;
		firstcolumn_xf;
		lastcolumn_xl;

"		now fill up the output image  with line data"
		For i_0 step 1 until PROPS(iname) Do
			Begin "build pix"
			Integer r,c;
			c_((0 Max X!BND!FETCH({Datum(iname)},i)) 
				Min imsiz);
			r_((0 Max Y!BND!FETCH({Datum(iname)},i)) 
				Min imsiz);
			If MSK!BOOL(r,c)
			   and (firstrow leq r leq lastrow)
			   and (firstcolumn leq c leq lastcolumn)
				Then
				PACK2D({Datum(image3)},r,c,ival);
			End "build pix";

"		Test if fill then fill"
		If fillsw 
			Then 
			PFILLHOLES(Datum(image3),ival,ival);
"		Restore the frame"
		PFRAME("RES");
		End "42 MAKEPIX";

Begin "43 PRINT"
COMMENT
.sss(PRINT)
.INDEX(PRINT)
.;
	String print!mode;
		
"		Set the print mode to sip2, note default is
		8 character gray scale"
"		let the LPT file name be the picture name"
		file!name_sip1;
		print!mode_sip2&(If Equ(sip3,"TTY")
					Then "TTY" Else null);
		PIXDMP(Datum(image1),file!name, 
			pix!title[pix!index3],print!mode,
			scaling);
		End "43 PRINT";

Begin "44 TEXTURE1"
COMMENT
.sss(TEXTURE1)
.INDEX(TEXTURE1)
.;
		
		If (sip2 neq "U")
			Then
			ival_(0 max Intscan(sip2,flag))
					 min trunc!max
			Else
			ival_thr!density;
			PTEX1(Datum(image1),ival);
		End "44 TEXTURE1";

Begin "45 TEXTURE2"
COMMENT
.sss(TEXTURE2)
.INDEX(TEXTURE2)
.;
		PTEX2(Datum(image1));
		End "45 TEXTURE2";

Begin "46 TEXTURE3"
COMMENT
.sss(TEXTURE3)
.INDEX(TEXTURE3)
.;
		If (sip2 neq "U") 
			Then
			ival_(0 max Intscan(sip2,flag))
					 min trunc!max
			Else
			ival_thr!density;
			PTEX3(Datum(image1),ival);
		End "46 TEXTURE3";

Begin "47 FILTER"
COMMENT
.sss(FILTER)
.INDEX(FILTER)
.;
	Real Array dlist[0:8];
"		Get the direction list into dlist"
		j_length(strcopy);
		s_strcopy;
		If usemask
			Then
			Begin "look for mask"
			k_length(smask);
			For i_1 step 1 until j Do
				If Equ(smask,s[i for k])
					Then Done;
			End "look for mask"
			Else
			Begin "look for input pix"
			k_length(sip1);
			For i_1 step 1 until j Do
				If Equ(sip1,s[i for k])
					Then Done;
			End "look for input pix";
		s_strcopy[i+k to Inf];
		i_-1;
		While not Equ(s,null) or (i<7) Do
			Begin "get from string"
			i_i+1;
			dlist[i]_Realscan(s,flag);
			End "get from string";
		If i < 8
		  Then
		  For j_i step 1 until 8 Do
			BOUND("-inf",dlist[j],"inf",
				"Dlist["&CVS(j)&"]?",null);
	Outstr(
	CVF(dlist[3])&" "&CVF(dlist[2])&" "&CVF(dlist[1])&crlf&
	CVF(dlist[4])&" "&CVF(dlist[8])&" "&CVF(dlist[0])&crlf&
	CVF(dlist[5])&" "&CVF(dlist[6])&" "&CVF(dlist[7])&crlf&crlf);

		PFILTER(Datum(image1),Datum(image3),dlist);
		End "47 FILTER";

	End "DO OPERATIONS";
End "PIX!ASSIGNMENT";
End "PINTRP.SAI";