C	PROGRAM XMITBM.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	JUNE 17, 1977
C	MAY 23, 1977
C	FEB 26, 1977
C	FEB 14, 1977
C	FEB 10, 1977
C	FEB 9, 1977
C	FEB 8, 1977
C	JAN 30, 1977
C	JAN 27, 1977
C	JAN 25, 1977
C	JAN 24, 1977
C
C
C
C	INTRODUCTION
C	------------
C	XMITBM.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
C	XMITBM is used to perform I/O between a BM and an OS8 data file
C	located on a DISK or DTA. The data types used include:
C	image, mask and boundary. GETPUT and DOAUX are used in performing
C	the I/O.
C
C	XMITBM.FT differs from the early version of DDTG BM I/O in that
C	a larger buffer (4K) is used to improve speed as well
C	as using additional data types.
C
C	SWITCHES	FUNCTIONS
C	--------	---------
C	/A		Read and write 16-bit BM data.
C	/B		Trace and dump boundary on write,
C				store boundary on read
C	/L		write and read line data structures.
C	/M		write BM sign bit as mask, read mask
C			as 377 if a 1 else 000.
C	/I		Picture data type (default).
C	/H		Print header on read.
C	/R		Restore (x,y,f,z,w,n,tb,tc) state from header on
C			read.
C	/C		Request header comment on write, print header
C			comment on a read.
C	/G		If read then error. If write then use the
C			Galvanometer scanner to get data.
C	/D		If write  then  error.   If  read,  then  use
C			Dicomed  as  sink.   /E  will  preerase   the
C			Dicomed.
C	/Q		If read then error. If write, then load SRG 
C			(using QDATA convention)==>file.
C	/K		If write, wait for keypad class number input
C			in the range [0:999] before preceeding.
C
C
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
C	NOTE: IF EITHER OUTPUT DEVICE  OR 2ND INPUT DEVICE IS
C	MTA THEN DO "PIXMTA" OR "REVIEW" WITH /X SWITCH SET
C	BEFORE PRINT XMITBM LOGO.
C	IF KDEVOUT="MT"
C		THEN CHAIN ('PIXMTA'), SET /X;
	FA=GETDEVICE(KDEVOUT)
S	TAD \FA
S	TAD (-1524 /"MT"
S	SZA CLA
S	JMP \87 /NOT PIXMTA
	CURSYM='PIXMTA'
C
C	GO LOOKUP CURSYM AND CHAIN TO IT
86	ISW(24)=1
	IP=1
	CALL BSEARCH
	IF(IP)85,80,85
85	CALL CHAIN(CURSYM)
C
C	IF KDEVIN(2)="MT"
C		THEN CHAIN('REVIEW'), SET /X;
S\87,	TAD \KDEVIN#
S	DCA \IDEV
S	TAD \IDEV
S	SNA CLA
S	JMP \88 /NO INPUT DEVICE
	FA=GETDEVICE(IDEV)
S	TAD \FA
S	TAD (-1524 /"MT"
S	SZA CLA
S	JMP \88 /NO
C	GO CHAIN TO 'REVIEW'
	CURSYM='REVIEW'
	GOTO 86
C
C
C	[1.1] DO OS8 DEVICE I/O
88	WRITE(1,995)
995	FORMAT('XMITBM 6/17/77 - 9:34AM')
	ET=TIMER(0)
C
	LBMTEXT=0
S	TAD BMTEXT
S	DCA \LBMTEXT
	K2NDNAME=KINFILE(5)
C
C	INIT THE BM SPECIFIED SWITCHES
	KBMIN=0
	KBMOUT=0
C
C
C	SET SOME SWITCHES IN COMMON BASED ON CD INFO.
C	SET /C
	MODECOMMENT=ISW(3)
C
C	/K WAIT FOR KPD ON WRITE
	LSUCLASS=ISW(11)
C
C
C	[2] DETERMINE WHAT TO DO.
C	IF /G (GALVANOMETER) OR /Q (QMT) THEN DO NOT TEST 
	IF(ISW(7)+ISW(16))109,110,109
C
C	IF /G OR /Q THEN SIMULATE BM INPUT
109	KBMIN=1
	GOTO 103
C
C	IF IBM1=BM? 
C		THEN KBMIN=1 ELSE KBMIN=0;
S \110,	TAD \K2NDNAME
S	CIA
S	TAD BMTEXT /"BM"
S	SZA CLA
S	JMP \100 /NO
C
C	YES, DO "GET"
	KBMIN=1
	MEM=IBM1
	IBYTE=IHGH1
C
C	SEE IF LEGAL BM
S	JMS CKIN /CHECK INPUT BM
C
C
C	IF JBM=BM?
C		THEN KBMOUT=1 ELSE KBMOUT=0;
S \100,	TAD \KOUTFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \101 /NO
C
C	YES,
	KBMOUT=1
	MEM=JBM
	IBYTE=JHGH
C	CHECK IT
S	JMS CKOUT
C
C	IF /D (DICOMED) OR /H (HEADER) THEN (WRITE ONLY) DO NOT TEST
101	IF(ISW(4)+ISW(8))102,103,102
C	SIMULATE BM OUTPUT FOR /D  AND /H
102	KBMOUT=1
C
C
C	[2.1] MAKE SURE THAT WE HAVE THE CORRECT # OF BM'S.
C	IF (KBMOUT+KBMIN) NEQ 1
C		THEN ERROR
103	IF((KBMOUT+KBMIN)-1)999,200,999
C
C
C	[2.2] DETERMINE THE DATA TYPE:
C
C	DEFAULT /I FOR BM IMAGE
200	KSUBTYPE=1
C
C	/L TEST FOR LINE
	IF(ISW(8))201,202,201
201	KSUBTYPE=17
C
C	/M FOR BIT MASK
202	IF(ISW(13))203,204,203
203	KSUBTYPE=14
C
C	/R HEADER
204	IF(ISW(18))205,206,205
205	KSUBTYPE=13
C
C	/G FOR GALVO ON WRITE ONLY
206	IF(ISW(7))1207,208,1207
1207	IF(K2NDNAME-LBMTEXT)207,999,207
207	KSUBTYPE=9
C
C	/D FOR DICOMED READ ONLY
208	IF(ISW(4))1209,210,1209
1209	IF(KOUTFILE-LBMTEXT)209,999,209
209	KSUBTYPE=18
C
C	/Q FOR QMT WRITE ONLY
210	IF(ISW(17))1211,212,1211
1211	IF(K2NDNAME-LBMTEXT)211,999,211
211	KSUBTYPE=4
C
C	/B FOR BOUNDARY
212	IF(ISW(2)) 213,214,213
213	KSUBTYPE=7
C
C	IF /A THEN BM-16-BIT DATA TYPE
214	IF(ISW)216,216,215
215	KSUBTYPE=2
216	CONTINUE
C
C
C	[2.3] DO THE GETPUT
	IOPR=KBMIN+(KBMOUT+KBMOUT)
C
C	EVAL THE GET(1)/PUT(2) SWITCH
	GOTO(251,252),IOPR
C
C	IT IS A GET, GET THE OUTPUT FILE NAME
251	IDEVICE=KDEVOUT
	DEVICE=GETDEVICE(IDEVICE)
S	CALL 1,FAD
S	ARG \KOUTFILE
S	CALL 1,STO
S	ARG \FILE
C
C	GET THE EXTENSION
	K=KOUTFILE(4)
S	TAD \K
S	DCA \EXT
	GOTO 240
C
C
C	IT IS A PUT, SO TEST IF FILE EXISTS
C	IF INPUT
C		THEN VERIFY THAT FILE EXISTS
252	IDEVICE=KDEVIN(2)
	DEVICE=GETDEVICE(IDEVICE)
S	TAD PKINFILE
S	TAD (4
S	DCA RFF#
S	CALL 1,FAD
S RFF,	ARG \KINFILE
S	CALL 1,STO
S	ARG \FILE

C	GET THE EXTENSION
	K=KINFILE(8)
S	TAD \K
S	DCA \EXT
C
	IF(IO(IDEVICE,FILE,EXT,1))239,240,239
C	ERROR
239	WRITE(1,238)
238	FORMAT(' FILE NOT FOUND!')
	GOTO 998
C
C
C	[2.4] DO THE BGETPUT
240	CONTINUE
C@C******DEBUG*****
C@	WRITE(1,899)IOPR,KBMIN,KBMOUT,KSUBTYPE
C@899	FORMAT(' IOPR=',I3,',KBMIN=',I5,',KBMOUT=',I5,',KSUBTYPE=',I5)
C@C***************************
	IERRNUM=0
	CALL BGETPUT(IOPR)
C
C
C	[2.4.1] IF IERRNUM NEQ 0 THEN ERROR
	IF(IERRNUM)260,998,260
260	WRITE(1,261)IERRNUM
261	FORMAT(' XMITBM BGETPUT ERROR #',I5)
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD XMITBM SPECIFICATION!')
C******DEBUG*****
	WRITE(1,994)IOPR,KBMIN,KBMOUT,KSUBTYPE
994	FORMAT(' IOPR=',I3,',KBMIN=',I5,',KBMOUT=',I5,',KSUBTYPE=',I5)
C***************************
998	ET=TIMER(1)
80	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/
S PKINFILE,	\KINFILE
S PKOUTFILE,	\KOUTFILE
C
	END