C	PROGRAM SEGBND.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 8, 1978
C	NOV 11, 1977 /USED NEW BMIO.FT
C	OCT 25, 1977 /ADDED GRAPHPEN TO SEGB1.FT WITH /G
C	OCT 13, 1977 /FIXED SEGB2 (FILL.1 START TRACING LIST)
C	SEPT 2, 1977 /NEW BNRUN (CHANGE IN EXTEND)
C	JUNE 27, 1977
C	JUNE 24, 1977
C	JUNE 22, 1977
C	JUNE 20, 1977
C	JUNE 16, 1977
C	JUNE 11, 1977
C	JUNE 10, 1977
C	JUNE 9, 1977
C	JUNE 8, 1977
C	JUNE 7, 1977
C	JUNE 6, 1977
C	JUNE 3, 1977
C	JUNE 2, 1977
C	MAY 27, 1977
C	MAY 24, 1977
C	MAY 18, 1977
C	MAY 17, 1977
C	MAY 16, 1977
C	MAY 13, 1977
C	MAY 12, 1977
C	MAY 11, 1977
C	MAY 10, 1977
C	APRIL 12, 1977
C	APRIL 11, 1977
C	APRIL 7, 1977
C	APRIL 6, 1977
C	APRIL 4, 1977
C	MARCH 30, 1977
C	MARCH 29, 1977
C	MARCH 28, 1977
C	MARCH 26, 1977
C	MARCH 25, 1977
C	MARCH 17, 1977
C	OCT 14, 1976
C	OCT 13, 1976
C	OCT 1, 1976
C
C
C
C	INTRODUCTION
C	------------
C	SEGBND.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	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
S	OPDEF	HPR	6320
S	OPDEF	HSR	6321
S	OPDEF	VPR	6322
S	OPDEF	VSR	6323
C
S	OPDEF	HPL	6360
S	OPDEF	HSL	6361
S	OPDEF	VPL	6362
S	OPDEF	VSL	6363
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
C
C	DEBUG SWITCHES ON FBW4
C	---------------------------
C	0004	BNRUN - PRINT RLM[IY] AFTER EACH BOUNDARY POINT IS ENTERED
C	0010	BNRUN - PRINT "DID" VARIABLE AFTER EACH B.P. ENTERED
C	0020	SEGB1[1.3] - SEARCH LY,LX1,LX2.
C	0040	BFOLLOW[4.6.2] - IX,IY,ITHETA
C	0100	BFOLLOW[4.2] (MEM,IBYTE,IX,IY) I3 I2 I1
C						I4 I8 I0
C						I5 I6 I7.
C	0400	SEGB2[7]  - LIST, BKPTR, IX,IY.
C	2000	SEGB2[FILL.2.2] - RLM AFTER GENERATED
C	4000	SEGB2[2.3] TRUE CC#=.
	DIMENSION MH(2),MV(2)
C
C	[1] INITIALIZATION
C	GET THE BMAP SWITCHES
C		IA=LENS
C		FA=ZOOM
C		FB=PUC
C		FC=UNAME
	IVAL=1
	CALL SEGB2
C
C	SAVE THE SPOOLER SW
	NSPSAVE=IOUTSPOOL
C	SET THE SPOOLER SWITCH FROM /L OR ISPSAVE
	IOUTSPOOL=ISW(12)+ISPSAVE
S	TAD \IOUTSPOOL
S	SZA CLA
S	CLA IAC
S	DCA \IOUTSPOOL
C
	I=1+IOUTSPOOL
	LSNEW=1
	DO 800 K=1,I
	WRITE(LSNEW,995)
995	FORMAT('1 SEGBND: VER# 2/8/78 - 3:04PM')
	CALL DAYTIME(LSNEW)
800	LSNEW=3
C
C
C	SAVE THE F&S
S	HPR
S	DCA \MH
S	HSR
S	DCA \MH#
S	VPR
S	DCA \MV
S	VSR
S	DCA \MV#
C
C	PRINT BMJ, BMI AND WINDOW
S	TAD (4040 /"  2
S	DCA \K
S	TAD \JHGH
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1000 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \K
S	CLA
C
C	GET THE BM NAMES
S	TAD (4040 /"  "
S	DCA \J
S	TAD \IHGH1
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1000 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \J
S	CLA
C
C	SETUP SIZING CONDITIONS
S	TAD \ICNUM#
S	SNA
S	TAD (D2047
S	DCA \ICNUM#
C
C	RECORD /C SWITCH
	IZ=ISW(3)
	RANGE='NORMAL'
S	TAD \IZ
S	SNA CLA
S	JMP \255 /NO
	RANGE='COMPL.'
C
C	SAVE SWITCHES
255	DO 256 IZ=1,26
256	IBUF1(IZ)=ISW(IZ)
	ITHRESHOLD=ICNUM(3)
C
C	VERIFY BM SPEC
S	JMS CKIN
S	JMS CKOUT
C
C
C	[2] SETUP THE SIZING BOOLEAN EXPRESSION
	IVAL=1
	CALL SEGB3
C
C
C	RESTORE SWITCHES
	ICNUM(3)=ITHRESHOLD
	DO 257 IX=1,26
257	ISW(IX)=IBUF1(IX)
C
C
C	[2.1] PRINT HEADER
	LSNEW=1
	I=1+IOUTSPOOL
	DO 250 INDEX=1,I
	WRITE(LSNEW,251)JBM,K,IBM1,J,KX1-1,KX2-1,KY1-1,KY2-1
     1,RANGE,ITHRESHOLD
251	FORMAT(' BM',I1,A1,'< BM',I1,A1,', [',I3,':',I3,',',I3,':'
     1,I3,'], SIZING ',A6,', THRESHOLD=',I3)
250	LSNEW=3
C
C
C
C	[3] CALL SEGMENT
C	IF /B THEN OPEN BOUNDARY DATA FILE!
S	TAD \ISW#
S	SNA CLA
S	JMP \301 /NO
C
C	INCREMENT THE GENSYM BEFORE OPEN FILE.
S	ISZ \IGENSYM#
S	CLA
S	TAD \IGENSYM#
S	DCA \LSNEW
	CURSYM=GENSYM(IGENSYM,LSNEW)
	CALL OOPEN('DSK',CURSYM)
	LSNEW=1
	DO 302 INDEX=1,I
	WRITE(LSNEW,303)CURSYM
303	FORMAT(' BND FILE DSK:',A6,'.DA.')
302	LSNEW=3
301	CONTINUE
C
C
C	[4] GO SEGMENT
	CALL SEGB1
C
C
C	[5] SAVE SEGMENT LIST POINTER QREG[Z]  
	ITMPSTK(26)=IVAL
S	TAD \IVAL#
S	DCA \IX
	IQREG(26)=IX
C
C
C	[6] IF /B THEN CLOSE BOUNDARY DATA FILE!
S	TAD \ISW#
S	SNA CLA
S	JMP \998 /NO
S	CLA CMA /-1
S	DCA \IVAL
S	CLA CMA
S	DCA \IVAL#
C	FIRST OUTPUT (-1,-1).
	WRITE(4,1310)IVAL
1310	FORMAT(2I5)
	CALL OCLOSE
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPEC')
C
C	NORMAL EXIT
998	LSNEW=1
	I=1+IOUTSPOOL
	DO 987 K=1,I
	CALL DAYTIME(LSNEW)
987	LSNEW=3
C
C	RESTORE SPOOLER SWITCH
	IOUTSPOOL=NSPSAVE
C
C	RESTORE F&S
S	TAD \MH
S	HPL
S	TAD \MH#
S	HSL
S	TAD \MV
S	VPL
S	TAD \MV#
S	VSL
C
C
C	RESTORE COMMON
	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************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
	END
    