Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0110/bintrp.sai
There are 2 other files named bintrp.sai in the archive. Click here to see a list.
ENTRY;
COMMENT
.SOSPAGE_1
.SEC(BINTRP - PROC10 Boundary Operation)
.index(BINTRP - PROC10 Boundary Operation)
.;
BEGIN "BINTRP.SAI"


COMMENT




           P. LEMKIN, B. SHAPIRO, R. GORDON, L. LIPKIN

                     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 del SMSG/DEBUG, and KL oprs
Revised Sept 28, 1976- Shapiro add Xdiff and Ydiff to ICIRT call
Revised Aug 23, 1976 - Lemkin, revised SMSGs
REVISED Aug 6, 1976 - Lemkin, removed AVBOUN-,AVCIR, 1DCON,2DCONV
Revised Aug 4, 1976 - reversed sense of savebox for BDISP
Revised July 7,  1976 - Lemkin - fixed READ
Revised May 28, 1976 - Lemkin - fixed read lookup
Revised May 25, 1976 - Lemkin - added null boundry check
Revised May 24, 1976 - Lemkin - fixed READ err msg
Revised May 19, 1976 - Lemkin made boundary data arrays SAFE
Revised April 27,1976 - Shapiro fixed CIRCLET display
Revised April 20, 1976 - Shapiro fixed parameter
			extraction for CIRCLET
Revised April 19, 1976 - Lemkin fixed perimeter
Revised April 10, 1976 - Lemkin added READ/WRITE transforms
Revised April 9, 1976 - Lemkin fixed transforms, LISTTRANSFORM
Revised April 6, 1976 - Lemkin, Shapiro  fixed TRANSFORMs
Revised April 5, 1976 - Lemkin, Shapiro  fixed CIRCLETRANSFORM
Revised April 2, 1976 - Lemkin, Shapiro  fixed READ
Revised April 3, 1976 - Lemkin, fixed interpreter
Revised March 31, 1976 - Lemkin, Shapiro  added 1DPAK stuff
Revised March 30, 1976 - Lemkin, Shapiro working on CIRCLE transforms
Revised March 29, 1976 - Lemkin, Shapiro added CIRCLE transforms
March 20, 1976
;

COMMENT
.SS(BINTRP REQUIRE files)
.INDEX(BINTRP 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 "CVT.REQ" source!file;
Require "BOUND.REQ" source!file;
Require "1DPAK.REQ" source!file;
Require "PPAK.REQ" source!file;

Require "DARRAY.REQ" source!file;

Require "SYS:DISPRM.SAI" source!file;
Require "BDISP.REQ" source!file;
Require "HLFTON.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;
Require "LINPAK.REQ" source!file;
COMMENT
.SS(Procedure BND!ASSIGNMENT)
.INDEX(Procedure BND!ASSIGNMENT)
.;

Internal Procedure BND!ASSIGNMENT;
Begin "BND!ASSIGNMENT"

Comment
	This mini-interpreter semantically checks the existance
and  requirements  for  output  then  input   operands   before
dispatching the operators in a CASE statement.

	legal string array definitions need here
	----------------------------------------
	1. lgl!bops - ordered list of all boundary and boundary
		transform operators.
	2. lgl!bnames - set of legal boundary names.
	3. lgl!tnames - set of legal transform names.
	4. lgl!noutput!ops - sub set of all PROC10 operators
		which expect null output operand (including transforms
		which 'have' expected output operands).
	5. lgl!ninput!ops - sub set of all PROC10 operators
		which expect null input operand (including transforms
		which 'have' expected input operands).
	6. lglNoSHIFT!ops - sub set of boundary ops which although
		nullary output ops should not be shifted.
	7. l!T!output!ops - subset of transfer ops which require 
		output operand.
	8. l!T!input!ops - subset of transfer ops which require 
		input operands.
;
  Define DBB(x) ={ };
comment Define DBB(x) =
	{OUTSTR(" x "&" - CMD="&cmd&", sout="&sout&", sip1="&sip1
		&", sip2="&sip2&crlf)};
String
	s1,
	s2,
	s3,	
	s,
	ss,
	sss;

Integer
	Xdiff,
	Ydiff,
	savebox,
	p,
	q,
	window!size,
	number!features,
	transform!array!size,
	numtriples,
	total!num!coefficients,
	total!array!size,
	num!coefficients,
	lower!bound,
	upper!bound,
	perimeter,
	area,
	ival,
	jval,
	bnd!index1,
	bnd!index2,
	bnd!index3,
	trn!index1,
	trn!index2,
	trn!index3,
	index,
	i,
	j;

Label boundary!a!dispatch;

Real
	startangle,
	xpos,
	ypos,
	val;
"	[1] Find the boundaryoperator index"

"	[0] for now set xpos,ypos to (xp,yp)"
	xpos_xp;
	ypos_yp;

		For index_1 Step 1 Until max!number!boundaryops Do
			If equ(cmd, lgl!bops[index]) 
				Then Done;

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


"	[2] see if have required boundary or transforms are given"

	bnd1_bnd2_bnd3_none;
	trn1_trn2_trn3_none;

"	[2.1]  Get  the  output  boundary if the command is not
	output nullary"
If Equ(GUESSER(cmd,lgl!noutput!ops),null)
	Then
	Begin "Get the output boundary"
DBB([2.1] lgl!noutput!ops);
	If (bnd3_GET!BOUNDARY(sout))= none Then Return;
	bnd!index3_b!index;

"	[2.1.1] Get the boundary output title if non-null and not READ"
	If not Equ(sout,null) Then
	If bnd!title[bnd!index3]=null and 
		not Equ(cmd,"READ")
		Then
		If auto!title 
			Then bnd!title[bnd!index3]_strcopy

		Else
		SBOUND(bnd!title[bnd!index3],"any",
			"Boundary "&sout&" title", sout&" title");
	End "Get the output boundary"
	Else
	Begin "test if shift"
DBB([2.1.2] lglNoSHIFT!ops);
"		[2.1.2] Shift the input args right since sout is
		really sip1 etc."
	If Equ(GUESSER(cmd,lglNoSHIFT!ops),null)
		Then
		Begin "shift args right"
		sip5_sip4;
		sip4_sip3;
		sip3_sip2;
		sip2_sip1;
		sip1_sout;
		sout_null;
		End "shift args right";
	End "test if shift";

"	[2.2] Get the output Transform if the  command  is  not
	output nullary for transforms"
If not Equ(GUESSER(cmd,l!T!output!ops),null)
	Then
	Begin "Get the output Transform"
	DBB([2.2] l!T!output!ops);
	If (trn3_GET!TRANSFORM(sout))= none Then Return;
	trn!index3_t!index;

"	[2.2.1] Get the Transform output title if non-null  and
	not READ"
	If not Equ(sout,null) 
		Then
		If trn!title[trn!index3]=null and 
			not Equ(cmd,"READ")
			Then
			If auto!title 
				Then
				trn!title[trn!index3]_strcopy

			Else
			SBOUND(trn!title[trn!index3],"any",
				"Transform "&sout&" title",
				sout&" title");
	End "Get the output Transform";

"	[2.3] Get the input boundary if it is expected."
If Equ(GUESSER(cmd,lgl!ninput!ops),null) 
	Then
	Begin "Get input boundary"
	DBB([2.3] lgl!ninput!ops);
	 If (sip1_GUESSER(sip1,lgl!bnames)) =null
		Then Begin "Bad input boundary"
		Outstr("Bad input boundary"&crlf);
		DEL!BOUNDARY(sout);
		Return;
		End "Bad input boundary";

	bnd1_GET!BOUNDARY(sip1);
	bnd!index1_b!index;
	End "Get input boundary";


"	[2.4] Get the input transform if expected"
If not Equ(GUESSER(cmd,l!T!input!ops),null) 
	Then
	Begin "Get input transform"
	DBB([2.4] l!T!input!ops);
	 If (sip1_GUESSER(sip1,lgl!tnames)) =null
		Then Begin "Bad input transform"
		Outstr("Bad input transform"&crlf);
		DEL!TRANSFORM(sout);
		Return;
		End "Bad input transform";

	trn1_GET!TRANSFORM(sip1);
	trn!index1_t!index;
	End "Get input transform";



"	[2.5] Get the 2nd input boundary if exists"
If not Equ(GUESSER(sip2,lgl!bnames),null)
	Then bnd2_GET!BOUNDARY(sip2);
bnd!index2_b!index;

"	[2.6] Get the 2nd input transform if exists"
If not Equ(GUESSER(sip2,lgl!tnames),null)
	Then trn2_GET!TRANSFORM(sip2);
trn!index2_t!index;

"	[2.7] check for null boundary or transform input"
	If (bnd1 neq none And PROPS(bnd1)=0) or
	   (bnd1 neq none And PROPS(bnd1)=0) or
	   (trn1 neq none And PROPS(trn1)=0) or
	   (trn2 neq none And PROPS(trn2)=0) 
		Then
		Begin "Null input structure"
		Outstr("Null input data structure"&crlf);
		Return;
		End "Null input structure";
"	DISPATCH AND TEST FOR UNARY IN EACH CASE"
boundary!a!dispatch:  CASE (index-1) of
	Begin "DO boundary operations"
Begin "1 COPY"
COMMENT
.SSS(COPY)
.INDEX(COPY)
.;

		ARRTRAN(Datum(bnd3),Datum(bnd1));
		PROPS(bnd3)_PROPS(bnd1);
		End "1 COPY";

Begin "2 ZERO"
COMMENT
.SSS(ZERO)
.INDEX(ZERO)
.;

		ARRCLR(Datum(bnd3));
		PROPS(bnd3)_0;
		End "2 ZERO";

Begin "3 READ"
COMMENT
.SSS(READ)
.INDEX(READ)
.;
"		Get the input file name if specified in sip1
		else error msg"
		header[0]_sip2;
		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 bnd3 neq none
			Then
			Begin "Read boundary"
			outstr("Reading in boundary "&file!name&crlf);
			If flag_GETBOUNDARY(Datum(bnd3), file!name,
				bnd!title[bnd!index3], header,p)
				Then 
				outstr("Bad boundary file header"&
					crlf);

"			Squish the boundary if successful"
			If not flag
				Then
				Begin "Ok"
				If p < 2047
					Then
					Begin "compress"
					Safe Integer array
						 ia[0:(p/2)+1];
					iname_NEW(ia);
					ARRTRAN(Datum(iname),
						Datum(bnd3));
					Del!pname(bnd3);
					Delete (bnd3);
					New!Pname(iname,sout);
"					load the number of points
					into props field"
					PROPS(iname)_p;
					End "compress";
				End "Ok";
"			print the boundary title"
			outstr("Title:"&crlf&bnd!title[bnd!index3]
				&crlf);
			If not flag 
				Then Return 
				Else DEL!BOUNDARY(sout);
			End "Read boundary";

		If trn3 neq none
			Then
			Begin "Read transform"
"			Get the array size, then setup the array size"
"			note that the transform type is kept in the
			last data!array word as:
				CIRCLETRANSFORM = 0,
				FOURIERTRANSFORM = 1,
				CENTROIDFOURIERTRANSFORM = 2,
				WALSHTRANSFORM = 3,
				HISTOGRAM = 4"
			header[0]_1;
			GETDDTG(file!name,header);
			CLOSEINDATA;
"			compute the total array size required"
			total!array!size_header[3]+(4096*header[2]);
			Begin "Inner read"
			Integer Array itemp[0:total!array!size-1];
			Outstr("Reading transform"&crlf);
			If flag_GETARRAY(itemp,file!name,
				trn!title[trn!index3], header,
				total!array!size)
				Then
				Outstr("Bad transform file header"&
					crlf);
"			squish the array into real array if made it"
			If not flag
				Then
			Begin "Compress"
			Safe Real Array temp[0:total!array!size-1];
			ARRTRAN(temp,itemp);
			s_CVIS(trn3,flag);
			Del!pname(trn3);
			Delete (trn3);
			trn3_NEW(temp);
			New!Pname(trn3,s);
"			Make the triple"
			Case header[80] Of
				Begin "set transform type"
				"0" iname_v!CIRCLEtransform;
				"1" iname_v!FOURIERtransform;
				"2" iname_v!CENTFOURIERtransform;
				"3" iname_v!WALSHtransform;
				"4" iname_v!HISTtransform;
				End "set transform type";
			Make a!transform XOR trn3 EQV iname;
"			get the number of tuples"
			PROPS(trn3)_header[81];
			End "Compress"

			Else DEL!TRANSFORM(sout);
			End "Inner read";

			End "Read transform";
		End "3 READ";

Begin "4 WRITE"
COMMENT
.SSS(WRITE)
.INDEX(WRITE)
.;
		Integer boundary!length;

		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 bnd1 neq none
			Then
			Begin "Write boundary"
			If  equ(bnd!title[bnd!index1],null)
				Then 
				SBOUND(bnd!title[bnd!index1],"any",
					"Boundary title","Title");
			outstr("Writing boundary " & outfile & crlf);
			boundary!length_PROPS(bnd1);
"			Force it to generate a boundary header"
			header[0]_0;
			PUTBOUNDARY(Datum(bnd1),outfile,
				bnd!title[bnd!index1],
				header,boundary!length);
			End "Write boundary";

		If trn1 neq none
			Then
			Begin "Write TRANSFORM"
			If  equ(trn!title[trn!index1],null)
				Then 
				SBOUND(bnd!title[bnd!index1],"any",
					"Transform title","Title");
			outstr("Writing transform " & outfile & crlf);
			num!coefficients_PROPS(bnd1);
			Foreach iname Such That
				a!transform XOR trn1 EQV iname Do Done;
			If iname=v!CIRCLEtransform Then ival_0;
			If iname=v!FOURIERtransform Then ival_1;
			If iname=v!CENTFOURIERtransform Then ival_2;
			If iname=v!WALSHtransform Then ival_3;
			If iname=v!HISTtransform Then ival_4;
"			Force it to generate a transform header"
			header[0]_0;
			PUTARRAY(Datum(bnd1),outfile,
				trn!title[trn!index1],
				header,total!array!size,ival,
				num!coefficients);
			End "Write TRANSFORM";

		outstr(crlf);
		End "4 WRITE";

Begin "5 DELETE"
COMMENT
.SSS(DELETE)
.INDEX(DELETE)
.;
		If bnd3 neq none Then DEL!BOUNDARY(sout);
		If trn3 neq none Then DEL!TRANSFORM(sout);
		End "5 DELETE";

Begin "6 SHOW"
COMMENT
.SSS(SHOW)
.INDEX(SHOW)
.;
"		get the x and y positions is specified"
		If not Equ(sip2,null)
			Then xpos_Intscan(sip2,flag)
			Else 
			xpos_xp;
		If not Equ(sip3,null)
			Then ypos_Intscan(sip3,flag)
			Else
			ypos_yp;

"		clean up OMNI numbers if requested"
		If (equ(trm!name,"4012") or
			 Equ(trm!name,"GT40") )  
			Then
			Begin "Omni display"
			If (not autoOMNInumber)
				Then
				Begin "clearing"
				Itemvar xxx;
				Foreach xxx Such That 
					xxx In omni!post Do
						Begin "kill"
						DEL!OMNI!NUMBER(CVIS(
							xxx,i));
						End "kill";
				DREL;
				DGET;
				End "clearing";

"			Setup new OMNI numbers"
			npict_GET!OMNI!NUMBER(sip1);
			Put bnd1 In omni!post;
			End "Omni display";
		savebox_false;
		BDISP(Datum(bnd1), firstrow, lastrow, 
			firstcolumn, lastcolumn,
			bnd!title[bnd!index1],
			PROPS(bnd1), xpos, ypos, trm!name,
			savebox, npict);
		End "6 SHOW";

Begin "7 AREA"
COMMENT
.SSS(AREA)
.INDEX(AREA)
.;
		Integer ip,im,xi,yp,ym;
"	The AREA algorithm is taken from a paper by Michael Shamos,
	Comp. Sci. Dept. Yale U., 7th ACM Symposium on
	The Theory of Computing, 1975."

		area_0;
		perimeter_PROPS(bnd1);
		For i_0 step 1 until perimeter-1 Do
			Begin "Compute area"
			ip_i+1 Mod perimeter-1;
			im_ If (i-1 > 0) Then i-1 Else perimeter-1;
			xi_X!BND!FETCH({Datum(bnd1)},i);
			ym_Y!BND!FETCH({Datum(bnd1)},im);
			yp_Y!BND!FETCH({Datum(bnd1)},ip);
			xi_X!BND!FETCH({Datum(bnd1)},i);
			area_area+xi*(yp-ym);
			End "Compute area";
			area_Abs(area)/2;
		Outstr("Area("&sip1&")="&cvs(area)&crlf);
		End "7 AREA";

Begin "8 PERIMETER"
COMMENT
.SSS(PERIMETER)
.INDEX(PERIMETER)
.;
	Integer x, y, xold, yold;
	Real perimeter;

		Outstr("Number boundary points("&sip1&")="&
			cvs(ival_PROPS(bnd1))&crlf);
		ival_ival-1;
		perimeter_0;
		x_X!BND!FETCH(Datum(bnd1),ival);
		y_Y!BND!FETCH(Datum(bnd1),ival);
		For i_0 step 1 Until ival Do
			Begin "compute perimeter"
			xold_x;
			yold_y;
			x_X!BND!FETCH(Datum(bnd1),i);
			y_Y!BND!FETCH(Datum(bnd1),i);
			If Abs(x-xold)+abs(y-yold) = 2
				Then perimeter_perimeter+Sqrt(2.0)
				Else perimeter_perimeter+1.0;
			End "compute perimeter";
		Outstr("Perimeter("&sip1&")="&
			cvs(perimeter)&crlf);
		End "8 PERIMETER";

Begin "9 CIRCLETRANSFORM"
COMMENT
.SSS(CIRCLETRANSFORM)
.INDEX(CIRCLETRANSFORM)
.;
	Own Integer sampling!distance,displayflag,autoflag,oscflag;
"	The  circle  transform  computes  a  set n of curvature
triples:  (RadiusOfCurvature,DeflectionAngle,ArcLength),  where
n=perimeter/sampling distance."
"		check for output Ti and sampling value"
		If trn3=none 
			Then
			Begin "bad param"
			Outstr("Bad transform name"&crlf);
			Return;
			End "bad param";
		perimeter_PROPS(bnd1);
		If (sampling!distance_Intscan(sip2,flag))=0
			Then
			IBOUND(1,sampling!distance,perimeter/3,
				"Sampling distance",null);
		oscflag_false;
		autoflag_true;
		displayflag_false;
		If Equ(sip3[1 for 3],"DIS")
			Then
			Begin "display boundary and test others"
			displayflag_true;
			If Equ(trm!name,"4023") or
			   Equ(trm!name,"ASR33")
				Then
				Begin "not implemented"
				Outstr(trm!name&
					" not implemented"&crlf);
				displayflag_false;
				End "not implemented";
			If Equ(sip4[1 for 3],"WAI") or
			   Equ(sip5[1 for 3],"WAI")
				Then autoflag_false;
			If Equ(sip4[1 for 3],"OSC") or
			   Equ(sip5[1 for 3],"OSC")
				Then oscflag_true;
			npict_GET!OMNI!NUMBER(sip1);
			If displayflag
				Then
				Begin "Display"
				Put Cvsi(sip1,flag) in
				    OMNI!post;
				savebox_false;
				BDISP(Datum(bnd1),firstrow,lastrow,
					firstcolumn,lastcolumn,
					bnd!title[bnd!index1],
					perimeter,
					xpos,ypos,
					trm!name, savebox, npict);
				End "Display";
			End "display boundary and test others";

"		Go do the transform"
		Begin "Inner Circle"
		Real Array transform!temp[0:1023];
		CIRT(Datum(bnd1),transform!temp,numtriples,
			Displayflag,
			Autoflag,
			Oscflag,
		 	Sampling!distance,
			Xpos,
			Ypos,
			Perimeter,
			Lastrow,
			Npict);
"		compress the array"
		Begin "Compress"
		Safe Real Array temp[0:3*numtriples-1];
		ARRTRAN(temp,transform!temp);
		s_CVIS(trn3,flag);
		Del!pname(trn3);
		Delete (trn3);
		trn3_NEW(temp);
		New!Pname(trn3,s);
"		Make the triple"
		Make a!transform XOR trn3 EQV v!CIRCLEtransform;
		PROPS(trn3)_numtriples;
		End "Compress";
		End "Inner Circle";
		End "9 CIRCLETRANSFORM";
Begin "10 ICIRCLETRANSFORM"
COMMENT
.SSS(ICIRCLETRANSFORM)
.INDEX(ICIRCLETRANSFORM)
.;
		Real val;
		If not a!transform XOR trn1 EQV v!circletransform
			Then
			Begin "wrong transform type"
			Outstr("Wrong transform type!"&crlf);
			Return;
			End "wrong transform type";
		If not Equ(sip2,null)
			Then val_Realscan(sip2,flag)
			Else
			BOUND(-360.0,val,360.0,
				"Starting angle?",null);
			startangle_twopi*(val/360.0);
		numtriples_PROPS(trn1);

		Begin "Inner icircle"
		Integer Array b!temp[0:1024];
		Outstr("Reconstructing boundary at("&CVS(xpos)&
			","&CVS(ypos)&"), at Angle="&CVF(val)&crlf);
		ICIRT(b!temp,Datum(trn1),
			numtriples,
			perimeter,
			startangle,
			Xdiff,
			Ydiff,
			1,
			Numtriples,
			npict);
"		compress the boundary and put in the perim"
		Begin "Compress"
		Safe Integer Array temp[0:(perimeter/2)+1];
		ARRTRAN(temp,b!temp);
		s_CVIS(bnd3,flag);
"		fix up the omni number"
		Del!Pname(bnd3);
		Delete (bnd3);
		bnd3_NEW(temp);
		New!pname(bnd3,s);
		PROPS(bnd3)_perimeter;
		End "Compress";
		End "Inner icircle";

		End "10 ICIRCLETRANSFORM";

Begin "11 SUBARCS"
	Integer p,q,numtriples;
COMMENT
.SSS(SUBARCS)
.INDEX(SUBARCS)
.;
		numtriples_ARRINFO(Datum(trn1),0)/3;
		If not Equ(sip2,null)
			Then p_Intscan(sip2,flag)
			Else
			IBOUND(1,p,numtriples,"From arc p",null);
		If not Equ(sip3,null)
			Then q_Intscan(sip3,flag) Min p
			Else
			IBOUND(p,q,numtriples,"From arc q",null);
"		copy p:q into new array then compress"
		j_(3*p)-3;
		For i_j step 1 until (3*q)+2 Do
			Datum(trn3)[i-j]_Datum(trn1)[i];
"		now compress it"
		Begin "Compress"
		Safe Real Array temp[0:3*(q-p+1)-1];
		ARRTRAN(temp,Datum(trn3));
		s_CVIS(trn3,flag);
		Del!pname(trn3);
		Delete (trn3);
		trn3_NEW(temp);
		New!Pname(trn3,s);
"		Make the triple"
		Make a!transform XOR trn3 EQV v!CIRCLEtransform;
		PROPS(trn3)_q-p+1;
		End "Compress";
		End "11 SUBARCS";


Begin "12 LISTTRANSFORM"
COMMENT
.SSS(LISTTRANSFORM)
.INDEX(LISTTRANSFORM)
.;
Comment
	List the transform  data  according  to  its  transform  type
including the extra trailer information.;

		Getformat(p,q);
		Setformat(6,7);
		If a!transform XOR trn1 EQV v!CIRCLEtransform
			Then
			Begin "circle"
			numtriples_PROPS(trn1);
			Outstr("CIRCLE"&crlf);
			For i_0 step 3 Until 3*(numtriples-1) Do
				Outstr("["&cvs((i/3)+1)&
				  "](RofC,Dangle,Arclth)="&
				  CVF(Datum(trn1)[i])&","&
				  CVF(Datum(trn1)[i+1])&","&
				  CVF(Datum(trn1)[i+2])&crlf);
			Return;
			End "circle";

"		Note: all of the rest of the transforms except
		the circle transform have the following trailer data
		starting at j"

		If a!transform XOR trn1 EQV v!FOURIERtransform
			Then
			Begin "fourier"
			num!coefficients_PROPS(trn1);
			j_2*num!coefficients;
			Outstr("FOURIER"&crlf&
				"Perimeter of origional boundary ="&
					CVS(Datum(trn1)[j])&crlf&
			    "Lower omega="&cvf(ival_Datum(trn1)[j+1])&
					crlf&
			    "Upper omega="&cvf(Datum(trn1)[j+2])&
					crlf);
			ival_ival-1;
			For i_0 step 2 Until 
				2*(num!coefficients-1) Do
				Outstr("["&CVS(ival_ival+1)&"](r,i)="&
					CVF(Datum(trn1)[i])&","&
					CVF(Datum(trn1)[i+1])&crlf);
			End "fourier";

		If a!transform XOR trn1 EQV v!CENTFOURIERtransform
			Then
			Begin "centfourier"
			Outstr("CENTFOURIER"&crlf);
			num!coefficients_PROPS(trn1);
			j_2*num!coefficients;
			Outstr("Original boundary (x0,y0)="&
				  CVS(Datum(trn1)[j])&","&
				  CVS(Datum(trn1)[j+1])&crlf&
				"Original centroid (xc,yc)="&
				  CVS(Datum(trn1)[j+2])&","&
				  CVS(Datum(trn1)[j+3])&crlf&
				"Perimeter of origional boundary ="&
					CVS(Datum(trn1)[j+4])&crlf&
			    "# coefficients="&cvf(num!coefficients)&
				crlf);
			For i_0 step 2 Until 
				2*(num!coefficients-1) Do
				Outstr("["&CVS(i/2)&"](r,i)="&
					CVF(Datum(trn1)[i])&","&
					CVF(Datum(trn1)[i+1])&crlf);
			End "centfourier";

		If a!transform XOR trn1 EQV v!WALSHtransform
			Then
			Begin "Walsh"
			num!coefficients_PROPS(trn1);
			j_2*num!coefficients;
			j_num!coefficients;
			Outstr("WALSH"&crlf&
				"Original boundary (x0,y0)="&
				  CVS(Datum(trn1)[j])&","&
				  CVS(Datum(trn1)[j+1])&crlf&
				"Original centroid (xc,yc)="&
				  CVS(Datum(trn1)[j+2])&","&
				  CVS(Datum(trn1)[j+3])&crlf&
			"Extended perimeter of origional boundary ="&
					CVS(Datum(trn1)[j+4])&crlf&
			    "# coefficients="&cvf(num!coefficients)&
				crlf);
			For i_0 step 1 Until num!coefficients-1 Do
				Outstr("["&CVS(i)&"](r,i)="&
					CVF(Datum(trn1)[i])&crlf);
			End "Walsh";

		If a!transform XOR trn1 EQV v!HISTtransform
			Then
			Begin "HIST"
			Outstr("HISTOGRAM"&crlf);
			num!coefficients_PROPS(trn1);
			For i_0 step 1 Until num!coefficients-1 Do
				Outstr("["&CVS(i)&"](r,i)="&
					CVF(Datum(trn1)[i])&crlf);
			End "HIST";
		Setformat(p,q);
		End "12 LISTTRANSFORM";

Begin "14 FOURIERTRANSFORM"
COMMENT
.SSS(FOURIERTRANSFORM)
.INDEX(FOURIERTRANSFORM)
.;
"		check for output Ti and omega values"
		If trn3=none 
			Then
			Begin "bad param"
			Outstr("Bad transform name"&crlf);
			Return;
			End "bad param";
		perimeter_PROPS(bnd1);
		If (lower!bound_Intscan(sip2,flag))=0
			Then
			IBOUND("-inf",lower!bound,"inf",
				"Lower bound",null);
		If (upper!bound_Intscan(sip3,flag))=0
			Then
			IBOUND(lower!bound,upper!bound,"inf",
				"Upper bound",null);
"		Go do the transform"
		Begin "Inner Fourier"
		Real Array transform!temp[0:1023];
		CFOURIER(Datum(bnd1),transform!temp,
			lower!bound,
			upper!bound,
			perimeter,
			transform!array!size);
"		compress the array"
		Begin "Compress"
		Safe Real Array temp[0:transform!array!size-1];
		ARRTRAN(temp,transform!temp);
		s_CVIS(trn3,flag);
		Del!pname(trn3);
		Delete (trn3);
		trn3_NEW(temp);
		New!Pname(trn3,s);
"		Make the triple"
		Make a!transform XOR trn3 EQV v!FOURIERtransform;
		PROPS(trn3)_(upper!bound-lower!bound)+1;
		End "Compress";
		End "Inner Fourier";
		End "14 FOURIERTRANSFORM";

Begin "15 IFOURIERTRANSFORM"
COMMENT
.SSS(IFOURIERTRANSFORM)
.INDEX(IFOURIERTRANSFORM)
.;

		If not a!transform XOR trn1 EQV v!FOURIERtransform
			Then
			Begin "wrong transform type"
			Outstr("Wrong transform type!"&crlf);
			Return;
			End "wrong transform type";

			i_ARRINFO(Datum(trn1),0)-1;
			ival_Datum(trn1)[i-1];
			jval_Datum(trn1)[i];

		If (lower!bound_Intscan(sip2,flag))=0 or
			(ival > lower!bound > jval)
			Then
			IBOUND(ival,lower!bound,jval,"lower bound",null);
		If (upper!bound_Intscan(sip3,flag))=0 or
			(lower!bound > upper!bound > jval)
			Then
			IBOUND(lower!bound,upper!bound,jval,
				"upper bound",null);
		total!num!coefficients_PROPS(trn1);
		Begin "Inner icfourier"
		Integer Array b!temp[0:1024];
		ICFOURIER(b!temp,Datum(trn1),
			total!num!coefficients,
			lower!bound,
			upper!bound,
			perimeter);
"		compress the boundary and put in the perim"
		Begin "Compress"
		Safe Integer Array temp[0:(perimeter/2)+1];
		ARRTRAN(temp,b!temp);
		s_CVIS(bnd3,flag);
"		fix up OMNI number"
		Del!Pname(bnd3);
		Delete (bnd3);
		bnd3_NEW(temp);
		New!pname(bnd3,s);
		PROPS(bnd3)_perimeter;
		End "Compress";
		End "Inner icfourier";

		End "15 IFOURIERTRANSFORM";

Begin "16 WALSHTRANSFORM"
COMMENT
.SSS(WALSHTRANSFORM)
.INDEX(WALSHTRANSFORM)
.;
"		check for output Ti and number coefficients value"
		If trn3=none 
			Then
			Begin "bad param"
			Outstr("Bad transform name"&crlf);
			Return;
			End "bad param";
		If (num!coefficients_Intscan(sip2,flag))=0
			Then
			IBOUND(1,num!coefficients,PROPS(bnd1)/2,
				"Number coefficients",null);

		perimeter_PROPS(bnd1);
"		Go do the transform"
		Begin "Inner Walsh"
		Real Array transform!temp[0:1023];
		WALSH(Datum(bnd1),transform!temp,
			perimeter,
			num!coefficients,
			transform!array!size);
"		compress the array"
		Begin "Compress"
		Safe Real Array temp[0:transform!array!size-1];
		ARRTRAN(temp,transform!temp);
		s_CVIS(trn3,flag);
		Del!pname(trn3);
		Delete (trn3);
		trn3_NEW(temp);
		New!Pname(trn3,s);
"		Make the triple"
		Make a!transform XOR trn3 EQV v!WALSHtransform;
		PROPS(trn3)_num!coefficients;
		End "Compress";
		End "Inner Walsh";
		End "16 WALSHTRANSFORM";

Begin "17 IWALSHTRANSFORM"
COMMENT
.SSS(IWALSHTRANSFORM)
.INDEX(IWALSHTRANSFORM)
.;
		If not a!transform XOR trn1 EQV v!WALSHtransform
			Then
			Begin "wrong transform type"
			Outstr("Wrong transform type!"&crlf);
			Return;
			End "wrong transform type";
		If (num!coefficients_Intscan(sip2,flag))=0 or
		   (num!coefficients > PROPS(trn1))
			Then
			IBOUND(1,num!coefficients,PROPS(trn1),
				"Number coefficients?",null);
			total!num!coefficients_PROPS(trn1);
		Begin "Inner iwalsh"
		Integer Array b!temp[0:1024];
		IWALSH(b!temp,Datum(trn1),
			perimeter,
			total!num!coefficients,
			num!coefficients,
			lastcolumn,
			xpos,
			ypos);
"		compress the boundary and put in the perim"
		Begin "Compress"
		Safe Integer Array temp[0:(perimeter/2)+1];
		ARRTRAN(temp,b!temp);
		s_CVIS(bnd3,flag);
"		fix up OMNI number"
		Del!Pname(bnd3);
		Delete (bnd3);
		bnd3_NEW(temp);
		New!pname(bnd3,s);
		PROPS(bnd3)_perimeter;
		End "Compress";
		End "Inner iwalsh";

		End "17 IWALSHTRANSFORM";

Begin "18 --free2--"
COMMENT
.SSS(--free2--)
.INDEX(--free2--)
.;
		End "18 --free2--";

Begin "19 --free3--"
COMMENT
.SSS(--free3--)
.INDEX(--free3--)
.;
		End "19 --free3--";
Begin "20 CENTFOURIER"
COMMENT
.SSS(CENTFOURIER)
.INDEX(CENTFOURIER)
.;
	Own Integer num!coefficients;

"		check for output Ti and Number value"
		perimeter_PROPS(bnd1);
		If trn3=none 
			Then
			Begin "bad param"
			Outstr("Bad transform name"&crlf);
			Return;
			End "bad param";
		If (num!coefficients_Intscan(sip2,flag))=0
			Then
			IBOUND(1,num!coefficients,perimeter,
				"Number coefficients",null);

"		Go do the transform"
		Begin "Inner Cfourier"
		Real Array transform!temp[0:1023];
		CENTFOURIER(Datum(bnd1),transform!temp,
			perimeter,
			num!coefficients,
			transform!array!size);

"		compress the array"
		Begin "Compress"
		Safe Real Array temp[0:transform!array!size-1];
		ARRTRAN(temp,transform!temp);
		s_CVIS(trn3,flag);
		Del!pname(trn3);
		Delete (trn3);
		trn3_NEW(temp);
		New!Pname(trn3,s);
"		Make the triple"
		Make a!transform XOR trn3 EQV v!CENTFOURIERtransform;
		PROPS(trn3)_num!coefficients;
		End "Compress";
		End "Inner Cfourier";
		End "20 CENTFOURIER";

Begin "21 ICENTFOURIER"
COMMENT
.SSS(ICENTFOURIER)
.INDEX(ICENTFOURIER)
.;

		If not a!transform XOR trn1 EQV v!CENTFOURIERtransform
			Then
			Begin "wrong transform type"
			Outstr("Wrong transform type!"&crlf);
			Return;
			End "wrong transform type";

		total!num!coefficients_PROPS(trn1);
		If (num!coefficients_Intscan(sip2,flag))=0 or
		   (num!coefficients > PROPS(trn1))
			Then
			IBOUND(1,num!coefficients,PROPS(trn1),
				"Number coefficients?",null);
			total!num!coefficients_PROPS(trn1);
		Begin "Inner icentfourier"
		Integer Array b!temp[0:1024];
		ICENTFOURIER(b!temp,Datum(trn1),
			total!num!coefficients,
			num!coefficients,
			lastcolumn,
			xpos,
			ypos,
			perimeter);

"		compress the boundary and put in the perim"
		Begin "Compress"
		Safe Integer Array temp[0:(perimeter/2)+1];
		ARRTRAN(temp,b!temp);
		s_CVIS(bnd3,flag);
"		fix up OMNI number"
		Del!Pname(bnd3);
		Delete (bnd3);
		bnd3_NEW(temp);
		New!pname(bnd3,s);
		PROPS(bnd3)_perimeter;
		End "Compress";
		End "Inner icentfourier";
		End "21 ICENTFOURIER";

Begin "22 LISTBOUNDARY"
COMMENT
.SSS(LISTBOUNDARY)
.INDEX(LISTBOUNDARY)
.;
	Integer x,y;

		perimeter_PROPS(bnd1);
			x_X!BND!FETCH({Datum(bnd1)},0);
			y_Y!BND!FETCH({Datum(bnd1)},0);
			Outstr("First ["&cvs(0)&"](x,y)=("&CVS(x)&
				","&CVS(y)&")"&crlf);
			x_X!BND!FETCH({Datum(bnd1)},{perimeter-1});
			y_Y!BND!FETCH({Datum(bnd1)},{perimeter-1});
			Outstr("Last ["&cvs(perimeter)&
				"](x,y)=("&CVS(x)&
				","&CVS(y)&")"&crlf);
		For i_0 step 1 Until perimeter-1 Do
			Begin "print boundary"
			x_X!BND!FETCH({Datum(bnd1)},i);
			y_Y!BND!FETCH({Datum(bnd1)},i);
			Outstr("["&cvs(i)&"](x,y)=("&CVS(x)&
				","&CVS(y)&")"&crlf);
			End "print boundary";
		End "22 LISTBOUNDARY";

	End "DO boundary operations";

End "BND!ASSIGNMENT";
End "BINTRP.SAI";