C	PROGRAM BMAX2.FT
C	------------------
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
C
C	JULY 26, 1977
C	JUNE 2, 1977
C	MAY 26, 1977
C	APRIL 27, 1977
C	APRIL 26, 1977
C	MARCH 31, 1977
C	FEB 28, 1977
C	FEB 26, 1977
C	FEB 25, 1977
C	FEB 24, 1977
C	FEB 16, 1977
C	FEB 14, 1977
C	FEB 13, 1977
C	FEB 7, 1977
C	FEB 4, 1977 /CHANGE OFFSET IN STDBM
C	JAN 23, 1977
C	JAN 21, 1977
C	JAN 20, 1977
C	NOV 16, 1976
C	NOV 3, 1976
C	OCT 26, 1976
C	OCT 22, 1976
C	OCT 19,1976
C	OCT 15, 1976
C	OCT 7, 1976
C	OCT 6, 1976
C	OCT 5, 1976
C	OCT 1, 1976
C	SEPT 30, 1976
C	SEPT 23, 1976
C	SEPT 19, 1976
C	SEPT 17, 1976
C	SEPT 16, 1976
C	SEPT 15, 1976
C	SEPT 14, 1976
C	SEPT 13, 1976
C	SEPT 11, 1976
C	SEPT 10, 1976
C	SEPT 9, 1976
C	SEPT 8, 1976
C	SEPT 2, 1976
C	SEPT 1, 1976
C	AUG 31, 1976
C	AUG 27, 1976
C	AUG 26, 1976
C
C	PURPOSE
C	-------
C	AUXILLARY PACKAGE NUMBER 2
C
C	IT HAS THE FOLLOWING OPERATIONS DIRECTED BY IVAL
C
C	IVAL	FUNCTION
C	----	--------
C	1	GET <BMI>
C	2	POST <BMI>
C	3	UNPOST <BMI>
C	4	POSXY <BMI>, X, Y
C	5	POSFS <BMI>
C	6	SETFSXY,  X,Y
C	7	SETFSBM, <BMI>
C	8	--FREE--
C	9	--FREE--
C	10	ALL384
C	11	STDBM
C	12	CMDKEYS
C	13	SETGENSYM, <SYMBOL>, <NUMBER>
C	14	INIT
C	15	BATCH,<.BI INPUT FILE>
C	16	CHAIN, <.SV FILE NAME>
C	17	LOADQR, QRi, Value
C
C
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	HPL	6360
S	OPDEF	VPL	6362
S	OPDEF	HSL	6361
S	OPDEF	VSL	6363
S	OPDEF	HPR	6320
S	OPDEF	HSR	6321
S	OPDEF	VPR	6322
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
S	OPDEF	FBW3	6343
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
S	OPDEF	POSTA	6520
S	OPDEF	POSTB	6521
C
S	OPDEF	QPROG7	6433
S	OPDEF	QSTAT	6374
C
S	OPDEF	QDAT1	6324
S	OPDEF	QDAT2	6325
S	OPDEF	STQMT	6300
S       OPDEF QSTAT 6374 /LOAD THE QMT STATUS REGISTER
S       OPDEF RQSTAT 6327 /READ THE QMT STATUS REG==>AC
S	SKPDF	QMSKP	6301
C
S	OPDEF	BMX0	6500
S	OPDEF	BMX1	6501
S	OPDEF	BMX2	6502
S	OPDEF	BMX3	6503
S	OPDEF	BMX4	6510
S	OPDEF	BMX5	6511
S	OPDEF	BMX6	6512
S	OPDEF	BMX7	6513
C
S	OPDEF	BMY0	6504
S	OPDEF	BMY1	6505
S	OPDEF	BMY2	6506
S	OPDEF	BMY3	6507
S	OPDEF	BMY4	6514
S	OPDEF	BMY5	6515
S	OPDEF	BMY6	6516
S	OPDEF	BMY7	6517
C
S	OPDEF	GETA	6522
S	OPDEF	GETB	6523
C
S	OPDEF	READGP	6146
S	SKPDF	GPSKP	6141
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DCM	7575
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DPIC	7573
S	OPDEF	CAM	7621
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
S	OPDEF	IOCLR	6007
C
C
C
C	[0] ENTRY PT
S	ENTRY BMAX2
S BMAX2,	BLOCK 2
C
C
C	[1] DISPATCHER
C	GET THE F&S POSITION IN CASE IT IS REQUIRED!
S	HPR
S	DCA \IX
S	VPR
S	DCA \IY
	IX=IBCD(IX,1)
	IY=IBCD(IY,1)
C
C	DISPATCH
	GOTO(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),IVAL
C
C	[1] "GET" (BM I <== WINDOW)
C
C
C	DO GROUP A
S \1,	TAD \IMA	/GROUP A
S	GETA
C
S	TAD \IMB	/GROUP B
S	GETB
C
C
S	STQMT	/START QUANTIMET
C
1013	CALL CLOCK
S	QMSKP
S	JMP \1013
S \2047,	CLA
S	RETRN BMAX2	/RETURN
C	[2] "POST" (WINDOW <== BM I)
C	VERIFY THAT HIGH & LOW ARE NOT ON IN SAME GROUP
C
C	(GROUP A)
C
S \2,	TAD \IPSTA	/COMPUTE TRIAL WORD
S	MQL
S	TAD \IMA
S	MQA
S	DCA \IPSTA
S	TAD \IPSTA
S	POSTA
C
C	(GROUP B)
C
S	TAD \IPSTB
S	MQL
S	TAD \IMB
S	MQA
S	DCA \IPSTB
S	TAD \IPSTB
S	POSTB
	GOTO 2047
C	[3] "UNPOST" (CLEAR WINDOW)
C
C	(GROUP A)
C
S \3,	TAD \IMA
S	CMA
S	DCA \IZ
S	TAD \IPSTA
S	AND \IZ	/BIT CLEAR
S	DCA \IPSTA
S	TAD \IPSTA
S	POSTA
C
C	(GROUP B)
C
S	TAD \IMB
S	CMA
S	DCA \IZ
S	TAD \IPSTB
S	AND \IZ	/BIT CLEAR
S	DCA \IPSTB
S	TAD \IPSTB
S	POSTB
S	JMP \2047	/RETURN
C
C	[4] POSXY <BM> X,Y
4	IX=ICNUM
S	TAD \ICNUM#
S	DCA \IY
S	JMS SVBMXY /SAVE STATE
C	DO THE LOAD IN [5.1]
	GOTO 1059
C
C	[5] "POSFS <BM>
C
C	NOTE: (IX,IY)<==BCD-TO-DEC(HPR,VPR)
S \5,	JMS SVBMXY /SAVE STATE
C
C
C	[5.1] LOAD THE BMX(IBM1), BMY(IBM1) WITH (IX,IY)
S \1059,	CLA
S	TAD \IBM1 /COMPUTE OFFSET
S	TAD (-4
S	SMA CLA
S	TAD (10 /OFFSET FOR GROUP B
S	MQL
S	TAD \IBM1
S	AND (0003
S	MQA /OR IN POSSIBLE GROUP B
S	MQL / OFFSET OF EITHER 0:3 OR 10:13.
C
S	MQA
S	TAD PBMX0
S	DCA \1050
S	TAD \IX
S \1050,	BMX0
C
S	MQA
S	TAD PBMY0
S	DCA \1051
S	TAD \IY
S \1051,	BMY0
	GOTO 2047
C
C	[6] SETFSXY, X,Y,(OPT HSIZE, VSIZE)
6	IXPOSITION=IBCD(ICNUM,-1)
C
S	TAD \ICNUM# 
S	DCA \IYPOSITION
	IYPOSITION=IBCD(IYPOSITION,-1)
C
S	TAD \IXPOSITION
S	HPL
S	TAD \IYPOSITION
S	VPL
C
C	[6.1] DO SIZE
	IHSIZE=IBCD(ICNUM(3),-1)
S	TAD \IHSIZE
S	SZA
S	HSL
C
	IVSIZE=IBCD(ICNUM(4),-1)
S	TAD \IVSIZE
S	SZA
S	VSL
C
	GOTO 2047
C	[7] SETFSBM, <BMI>
7	DO 701 IX=1,2
	IY=12+IX
	IZ=1+IBM1
701	ICNUM(IX)=LSAVE(IY,IZ)
S	TAD (1126 /256 BCD
S	HSL
S	HSR /LOAD SAME VALUE
S	VSL
C
C	FINISH INTERPRETING IT AT [6]
	GOTO 6
C
C	[8] --FREE--
8	GOTO 2047
C
C
C	[9] --FREE--
9	GOTO 2047
C	[10] "ALL384"  SET ALL BM WINDOWS TO (384,384)
10	DO 1097 KWC=1,8
S	CLA CMA	/COMPUTE GROUPA
S	TAD PBMX0
S	TAD \KWC
S	DCA GROUPA
S	CLA CMA	/COMPUTE GROUPB
S	TAD PBMX4
S	TAD \KWC
S	DCA GROUPB
S	TAD (D384
S GROUPA,	BMX0
S	TAD (D384
S GROUPB,	BMX4
	IBM1=KWC-1
	IX=384
	IY=384
S	JMS SVBMXY
	IBM1=IBM1+4
S	JMS SVBMXY
1097	CONTINUE
C
C	ALSO SET F&S TO (384,384)
S	TAD (1604
S	HPL
S	HPR /LOAD SAME VALUE
S	VPL
C
S	TAD (1126 /256
S	HSL
S	HSR /READ SAME VALUE
S	VSL
C
S	JMP \2047	/RETURN
C
C
C	[11] "STDBM"  SET BM POSITION TO COVER BM SCREEN
C	***NOTE:  KX1,KX2 ARE DEFINED TO
C	BE THE OFFSET TO KEEP THE BM'S AWAY FROM THE TOP AND LEFT
C	EDGE OF THE QMT DISPLAY****
C
C	IF /B THEN (KX1,KY1)<==(IX,IY)<==BCDTODEC(HPR,VPR)
11	KX1=IX
	KY1=IY
S	TAD \ISW#
S	SZA CLA
S	JMP \1101
C
C	DEFAULT U.L.C VALUES
	KX1=27
	KY1=40
C
C	IF /A
C	       THEN CENTER (0,1,2,3) AT QMT CENTER TO MIN. PINCUSHION
S	TAD \ISW /"/A"
S	SNA CLA
S	JMP \1101
	KX1=189
	KY1=131
C
C
C
1101	IX=KX1
	IY=KY1
S	TAD \IX
S	BMX0	/(0,0) #0
S	TAD \IY
S	BMY0
	IBM1=0
S	JMS SVBMXY /SAVE STATE
C
	IX=256+KX1
S	TAD \IX /(256,0) #1
S	BMX1
S	TAD \IY
S	BMY1
	IBM1=1
S	JMS SVBMXY /SAVE STATE
C
	IX=KX1
	IY=256+KY1
S	TAD \IX
S	BMX2	/(0,256) #2
S	TAD \IY
S	BMY2
	IBM1=2
S	JMS SVBMXY /SAVE STATE
C
	IX=256+KX1
S	TAD \IX	/(256,256) #3
S	BMX3
S	TAD \IY
S	BMY3
	IBM1=3
S	JMS SVBMXY /SAVE STATE
C
	IX=512+KX1
	IY=KY1
S	TAD \IX /(512,0) #4
S	BMX4
S	TAD \IY
S	BMY4
	IBM1=4
S	JMS SVBMXY /SAVE STATE
C
	IY=256+KY1
S	TAD \IX /(512,256) #5
S	BMX5
S	TAD \IY
S	BMY5
	IBM1=5
S	JMS SVBMXY /SAVE STATE
C
	IX=KX1
	IY=512+KY1
S	TAD \IX
S	BMX6	/(0,512) #6
S	TAD \IY
S	BMY6
	IBM1=6
S	JMS SVBMXY /SAVE STATE
C
	IX=256+KX1
S	TAD \IX /(256,512) #7
S	BMX7
S	TAD \IY
S	BMY7
	IBM1=7
S	JMS SVBMXY /SAVE STATE
C
	GOTO 2047
C	[12] CMDKEYS
C	DEFAULT TO DUMP THEM ALL 1:12
12	IX1=1
	IX2=12
C
S	CLA CMA
S	TAD \IZ
S	SPA CLA
S	JMP \1204 /DO ALL KEYS
C
C	DO KEY IZ
	IX1=IZ
	IX2=IZ
C
1204	DO 1200 KWC=IX1,IX2
	IP=0
	DO 1201 J=1,71
C	GET DATA
	IX=LSAVE(KWC,J)
	IP=IP+IX
C
C	ONLY CHANGE @ TO SPACES FOR BM AND FILENAMES [7:25]
S	TAD \J
S	TAD (-D7
S	SPA CLA
S	JMP \1201
S	TAD \J
S	TAD (-D26
S	SMA CLA
S	JMP \1206
C
C	CVT @ TO SPACES
S	TAD \IX
S	AND (7700
S	SNA
S	TAD (4000 /SPACE
S	MQL
S	TAD \IX
S	AND (77
S	SNA
S	TAD (40 /SPACE
S	MQA
S	DCA \IX
	GOTO 1201
C
C	CVT SWITCHES TO A1 6-BIT [36:71]
1206	IY=IX
S	TAD (4040
S	DCA \IX
S	TAD \IY
S	SNA CLA
S	JMP \1201 /NO, OUTPUT BLANK
C
C	CVT TO 6-BIT
	IY=J-35
S	TAD \IY
S	TAD (-40
S	SMA 
S	TAD (26 /60 FOR DIGIT -26D (32OCT)=26OCT
S	TAD (40 /ADD BACK OFFSET
S	BSW
S	DCA \IX
C
1201	IBUF1(J)=IX
C
C	TEST IF NULL
S	TAD \IP
S	SNA CLA
S	JMP \1200 /NULL, IGNORE
C
C
	IP=KWC-1
SWAITKBD,	6034
S	AND (177 /TEST FOR CONTROL/O
S	TAD (-17
S	SNA CLA
	GOTO 2047
C
S	6034
S	AND (177
S	TAD (-23 /^S
S	SNA CLA
S	JMP WAITKBD
C
	LSNUM=1+IOUTSPOOL
	LSNEW=1
	DO 1200 INDEX=1,LSNUM
	WRITE(LSNEW,1203)IP,(IBUF1(J),J=7,10),(IBUF1(J),J=16,35)
     1,(IBUF1(J),J=1,4),ICNUM,(IBUF1(J),J=36,71)
1203	FORMAT(' CMD[',I2,']=',3A2,'.',A2,'<',5(3A2,'.',A2,','),/
     1,' VAL:=',4(I5,','),'/',5(I5,','),/,' SW:=',36A1)
1200	LSNEW=4
	GOTO 2047
C
C
C	[13] SETGENSYM, 2 CHAR NAME, VALUE
C	GET FILE NAME CHARS
13	J=KINFILE(5)
C	IF J=0, THEN NOP
S	TAD \J
S	SNA CLA
S	JMP \2047 /NOP
C
C	SET GENSYM
	IGENSYM=J
S	TAD \ICNUM
S	DCA \IGENSYM#
	GOTO 2047
C
C
C	[14] INIT
C
C
C	ZERO IH[1:512]
S \14,	CLA CMA
S	TAD PIH
S	DCA 11
S	TAD (-D511
S	CPAGE 4
S	DCA \IX
S ZEROIH,	DCAI 11
S	ISZ \IX
S	JMP ZEROIH
C	IF /H THEN RETURN
	IF(ISW(8))2047,1400,2047
C
C
S \1400, IOCLR /INIT THE PDP8E
S	CALL 0,OPEN
C	INIT THE SYSTEM
C
C	SET FC1 TO AREA
S	TAD (0210 /SAVE STATUS IN COMMON
S	DCA \IFILTOP
S	TAD \IFILTOP
S	QPROG7
C
C
C	[14.1] SET A 256 X 256 WINDOW AT POSITION 384,384
S	TAD (1604 /384 BCD
S	HPL	/SET HORIZONTAL POSITION
S	HPR /LOAD SAME VALUE
S	VPL	/SET VERTICAL POSITION
C
S	TAD (1126 /256 BCD
S	HSL	/SET HORIZONTAL SIZE
S	HSR /LOAD SAME VALUE
S	VSL	/SET VERITCAL SIZE
C
C
C	[14.2] ENABLE FRAME POSITION MOVEMENT, BUT FREEZE SIZE
C
S	TAD (4020
S	QSTAT	/SET STATUS
C
C
C	[14.3] CLEAR POSTING REGISTERS
S	POSTA
S	POSTB
	IPSTA=0
	IPSTB=0
C
C
C	[14.4] ZERO THE COMMAND KEY LIST
C	NOTE: LSAVE[15,71]
	DO 1404 J=1,1065
1404	LSAVE(J)=0
C
C
C	[14.5] SETUP THE CALIBRATION #
C	DEFAULT 1S #8, 100X
C	LENS - I3 LENS # 1, 2.5, 5, 10, 25, 50 (DRY AND OIL), 100
C	FIND SWITCH
	J=8
	DO 1405 IX=28,35
	IF(ISW(IX))1406,1405,1406
1406	J=IX-27
1405	CONTINUE
C	NOW COPY INDEX INTO LSAVE(15,1)
	LSAVE(15,1)=J
C
C
C	[14.6] IF 2ND INPUT FILE="STATE@"
C			THEN RELOAD MDPDATA FROM INITBL PARAMETERS.
S	TAD (4
S	TAD PKINFILE
S	DCA ARGINI#
S	CALL 1,FAD
S ARGINI,	ARG \KINFILE
S	CALL 1,STO
S	ARG \CURSYM
	IF(CURSYM-'STATE')1402,1407,1402
C
C	OK, LOAD MDPDATA...
1407	MODEMANUAL=1
	DO 1410 IX=1,6
S	CLA CMA
S	TAD PMCURDET
S	CPAGE 5
S	DCA \IX
S	DCA 7
S	DCAI 7
1410	CONTINUE
C
	DO 1408 J=1,64
S	CLA CMA
S	TAD \J
S	TAD PINITBL /LOCAL POINTER TO INITBL.
S	DCA 7
S	TAD I 7
S	DCA \IZ
C
S	CLA CMA
S	TAD PMDPDATA
S	TAD \J
S	DCA 7
S	CPAGE 4
S	TAD \IZ
S	DCAI 7
1408	CONTINUE
C
C	INIT THE SLOW AND FAST SPEED TABLES.
S	CLA CMA
S	TAD PMSTBL
S	DCA 11
S	CLA CMA
S	TAD PMSLOW
S	DCA 12
S	TAD 12
S	TAD (D12 /OFFSET TO MFAST
S	DCA 13
C
	DO 1409 J=1,12
S	TAD I 11 /MSTBL(J)
S	DCA \IZ
S	CPAGE 6
S	TAD \IZ
S	DCAI 12 /MSLOW(J)
S	IAC
S	DCAI 13 /MFAST(J)
1409	CONTINUE
C
C
C	[14.7] INIT THE FREESTORE PTR
1402	LSFREESTORE=-1
S	CLA CMA
S	DCA \LSFREESTORE
C
C
C	[14.8] ZERO THE Q-REGISTERS
	DO 1401 IX=1,26
	ITMPSTK(IX)=0
1401	IQREG(IX)=0
C
C
C	[14.9] SETUP A STDBM AT [11]
	GOTO 11
C
C
C	[15] BATCH,<.BI INPUT FILE>
C	IF THE FILE IS NOT ON SYS, THEN
C	COPY IT TO "SYS:JUNKTM.BI" BEFORE CHAINING TO BATCH.
C
S	DUMMY	K2FCT
S	DUMMY	K2FBLK
S	CPAGE 4
S K2FCT,	6211
S	7617
S K2FBLK,	6211
S	7620
C
C
C	[15.1] CLOSE THE SPOOLER IF IT IS OPEN
15	IF(IOUTSPOOL)1507,1508,1507
1507	IOUTSPOOL=0
	CALL OCLOSE
C
C
C	[15.2] LOOKUP THE INPUT FILE
S\1508,	TAD \KDEVIN#
S	DCA \IDEV
C
	IF(IO(IDEV,KINFILE(5),'BI',1))1599,1502,1599
C	GET THE FILE LENGTH
1502	IERR=IO(IA,IB,IC,13)
C
C	IF ON SYS THEN DO NOT COPY TO JUNKTM.BI
S	 CLA CMA
S	TAD \IDEV
S	SNA CLA
S	JMP \1511 /ON SYS:!
C
C
C	[15.3] ENTER THE JUNKTM.BI FILE ON SYS:
C	THEN COPY THE INPUT FILE INTO IT.
C
	CURSYM='JUNKTM'
	IF(IO(1,CURSYM,'BI',3))1599,1504,1599
C
C	COPY -IC BLOCKS
1504	IC=-IC
	DO 1505 IX=1,IC
C	READ 1 BLOCK INTO IBUF1[1:256]
	IF(IO(1,IBUF1,0,6))1599,1506,1599
C
C	WRITE 1 BLOCK FROM IBUF1[1:256]
1506	IF(IO(1,IBUF1,0,7))1599,1505,1599
1505	CONTINUE
C
C	CLOSE THE FILE
	IF(IO(0,0,0,5))1599,1510,1599
C
C	LOOKUP THE FILE AND GET THE FILE PTRS READY
1510	IF(IO(1,CURSYM,'BI',1))1599,1512,1599
C	GET THE DEV, ST BLK, -# BLKS
1512	IERR=IO(IA,IB,IC,13)
C
C
C	[15.4] SETUP CD AREA POINTER AND CHAIN TO BATCH
	DO 1511 IX=1,39
S	TAD (7577 /7600-1
S	CPAGE 5
S	TAD \IX
S	DCA 7
S	DCAI 7
1511	CONTINUE
C
C
C	[15.5] PUT PTRS ==>2ND CD FILE AREA 
S	TAD \IC
S	RTL; RTL
S	AND (7760
S	IAC /SYS:
S	DCA \IA
C
S	TAD \IA /[-#BLKS]&[SYS DEV #]
S	DCA I K2FCT
S	TAD \IB
S	DCA I K2FBLK
C
C
C	[15.6] SETUP CHAIN TO 'BATCH'
	CURSYM='BATCH'
C	SET UP THE JOB STATUS WORD IN IP
S	TAD (2401
S	DCA \IP
S	JMP GOCHAIN
C
C
C	[15.7] FILE NOT FOUND
1599	WRITE(1,1598)
1598	FORMAT('?FILE')
	GOTO 2047
C
C	[16] CHAIN .SV FILE
C	ZERO THE JSW.
S	DUMMY JSW
S	CPAGE 2
S JSW,	6201
S	7746
C
16	IP=0
C
C	FIRST CLOSE OUTPUT FILES.
S GOCHAIN, 	TAD \IOUTSPOOL
S	SNA CLA
S	JMP \1602 /NOT OPENED
	CALL OCLOSE
C
C	*** SAVE LENS IN IA
C		ZOOM IN FA
C		PUC IN FB
C		UNAME IN FC
1602	CALL BMAP(IA,FA,FB,FC)
C
	CALL BSCOMMON(1)
C
C	SETUP THE JOB STATUS WORD IN 07746
S	TAD \IP
S	DCA I JSW
	CALL CHAIN(CURSYM)
C
C
C	[17] LOADQR, QRi, Value
17	IVAL=KOUTFILE
S	TAD \KOUTFILE#
S	DCA \IZ
C
C
C	VERIFY THAT IT IS QR ELSE NOP
S	TAD \IVAL
S	TAD (-2122 /"QR"
S	SZA CLA
S	JMP \2047 /ERROR
C
C	OK, LOAD IT
S	TAD \IZ
S	BSW
S	AND (37
S	TAD (-D27
S	SMA
S	JMP \2047 /FAILED
S	TAD (D27
S	DCA \IX
S	TAD \ICNUM
S	DCA \IY
	ITMPSTK(IX)=IY
C
C	LOAD THE HIGH PART FRO ICNUM(2)
S	TAD \ICNUM#
S	DCA \IY
	IQREG(IX)=IY
	GOTO 2047
C
C	***************************************************
C	SUBROUTINE     S V B M X Y
C	***************************************************
C	SAVE TH BM(X,Y) POSITIONS FOR BM # IBM1 PASSED IN (IX,IY).
C	LSAVE(13,(IBM1+1))=IX
C	LSAVE(14,(IBM1+1))=IY
C
S	CPAGE 3
S RSVBMXY,	JMP I SVBMXY
S SVBMXY,	0
C
	IVAL=IX
S	TAD \IY
S	DCA \IVAL#
	DO 1901 J=1,2
	ICHAN=12+J
	IBM2=IBM1+1
1901	LSAVE(ICHAN,IBM2)=IVAL(J)
S	JMP RSVBMXY
C
C
C
C	******PARAMETERS******
S PIH,	\IH
C
S PBMX0,	BMX0
S PBMY0,	BMY0
S PBMX4,	BMX4
S PBMY4,	BMY4
C
C
S PMDPDATA,	\MDPDATA
S PMCURDET,	\MCURDET /MCURDET[1:6].
S PMSLOW,	\MSLOW /MSLOW[1:12].  NOTE: MFAST=MSLOW+12 (DECIMAL)
C	***NOTE: MFAST[1:12]<== 1.
C
S PKOUTFILE, \KOUTFILE
S PKINFILE, \KINFILE
C
C	INITIAL MDPDATA[1:8,1:8] TABLE.
S PINITBL,	INITBL
S PMSTBL,	MSTBL
C
S	CPAGE 10
S MSTBL,	5
S	5
S	17
S	62
S	24
S	24
S	5
S	5
C
C
S	CPAGE 100
S INITBL, BLOCK 0
C
C	** WV **
S	0; 0 /LOWER LIMIT
S	2; 0 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** ND **
S	0; 0 /LOWER LIMIT
S	2; 0 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** ZOOM **
S	0; 0 /LOWER LIMIT
S	714; 0 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** FOCUS **
S	7400; 7777 /LOWER LIMIT
S	2000; 0 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** Y **
S	0; 7700 /LOWER LIMIT -100,0000 OCTAL
S	0; 100 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** X **
S	0; 7700 /LOWER LIMIT -100,0000 OCTAL
S	0; 100 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** THRESHOLD 1 (B)  **
S	0; 7777 /LOWER LIMIT
S	0; 100 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
C	** THRESHOLD 2 (C)  **
S	0; 7777 /LOWER LIMIT
S	0; 100 /HIGH LIMIT
S	0; 0 /DESIRED POSITION
S	0; 0 /CURRENT POSITION
C
	END