C	PROGRAM COMASS.FT
C	----------------
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C	FEB 9, 1977
C	NOV 18, 1976
C	OCT 19, 1976
C	OCT 1, 1976
C
C
C
C	INTRODUCTION
C	------------
C	COMASS.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	IBM2,IHGH2, JBM, JHGH  VARIABLES IN COMMON. COMMON IS RESTORED
C	FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS
C	EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON
C	IS SAVED AND BMON2 IS CHAINED BACK TO.
C	ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED
C
C	COMASS,<BMi> - compute the center of mass of the single
C        (assumed) object in <BMi> using  the  maximums  of  the
C        horizontal  and vertical line density projections.After
C        the center of mass is computed,  the  frame  and  scale
C        window  is  positioned  at the center of mass of <BMi>.
C        The relative center of mass is returned in  Q-registers
C        [A,B]; the absolute (LCS) center of mass is returned in
C        [C,D].
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF	HPL	6360
S	OPDEF	HSR	6321
S	OPDEF	VPL	6362
S	OPDEF	VSR	6323
C	[1] INITIALIZATION
	WRITE(1,995)
995	FORMAT('COMASS 2/9/77 - 4:01PM')
	ET=TIMER(0)
C
C
C	[2] VERIFY BM SPECS
S	JMS CKIN
C@@S	JMS CKOUT
C@@S	JMS CKIN2
C
C
C
C	[3] COMPUTE THE /X PROJECTION HISTOGRAM MAX
	KOUTFILE=0
	IVAL=1
	ISW(24)=1
	CALL BMAX3
C
C	[3.1] SAVE X MAX
	IXMAX=ITMPSTK(4)
C
C
C	[4] COMPUTE /Y PROJECTION HIST MAX
	IVAL=1
	ISW(24)=0
	ISW(25)=1
	CALL BMAX3
C
C	[4.1] SAVE Y MAX
	IYMAX=ITMPSTK(4)
C
C
C	[5] GET F&SA SIZE
S	HSR
S	DCA \IHS
S	VSR
S	DCA \IVS
	IHS=IBCD(IHS,1)
	IVS=IBCD(IVS,1)
C
C
C	[6] PRINT RESULTS
	WRITE(1,500)IXMAX,IYMAX,IBM1
	WRITE(3,500)IXMAX,IYMAX,IBM1
500	FORMAT(' CENTER OF MASS (X,Y)=(',I3,',',I3,') OF BM',I1)
C
C
C	[7] POSITION F&S THERE
	LX=LSAVE(13,IBM1+1)
	LY=LSAVE(14,IBM1+1)
	LX=LX-(IHS/2)+IXMAX
	LY=LY-(IVS/2)+IYMAX
	LX=MIN((869-256),MAX(0,LX))
	LY=MIN((700-256),MAX(0,LY))
C
C
C	CVT TO BCD AND LOAD F&S
	IX=IBCD(LX,-1)
	IY=IBCD(LY,-1)
S	TAD \IX
S	HPL
S	TAD \IY
S	VPL
C
C	SAVE DATA IN Q-REGISTERS
C	SAVE RELATIVE IN A:B
	ITMPSTK=IXMAX
	ITMPSTK(2)=IYMAX
C	SAVE ABSOLUTE LCS IN C:D
	ITMPSTK(3)=LX
	ITMPSTK(4)=LY
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
C	RESTORE COMMON SINCE STORE DATA IN Q-REGISTERS
	CALL BSCOMMON(1)
	CALL CHAIN('BMON2')
C***************************************************
C	*PROCEDURE      C K O U T
C******************************************************
C
C
C	CHECK WHETHER THE OUTPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKOUT,	JMP I CKOUT
S CKOUT,	0 /ENTRY
C
C	[1] TEST IF KOUTFILE="BM"
S	TAD \KOUTFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (KOUTFILE(2) LAND '7700)=DIGIT
S	TAD \KOUTFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKOUT /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN,	JMP I CKIN
S CKIN,	0 /ENTRY
C
C	[1] TEST IF BMI1="BM"
S	TAD \SFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (BMI1(2) LAND '7700)=DIGIT
S	TAD \SFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKIN /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N 2
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN2,	JMP I CKIN2
S CKIN2,	0 /ENTRY
C
C	[1] CHECK FIRST IBM1 SPEC
S	JMS CKIN
C
C
C	[2] TEST IF BMI2="BM"
S	TAD \SEXT
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[3] TEST IF (BMI2((6) LAND '7700)=DIGIT
S	TAD \SEXT#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKIN2 /OK.
C
C
C************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
	END
   