C	PROGRAM JGST1.FT
C	----------------
C
C
C	### SUBROUTINE JGST1
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	JAN 27, 1977
C	JAN 19, 1977
C	JAN 16, 1977
C	JAN 8, 1977
C	JAN 4, 1977
C	NOV 19, 1976
C
C
C
C	INTRODUCTION
C	------------
C	JGST1.FT IS A SUBROUTINE USED WITH JGSTXTURE.FT
C
C	IT COMPUTES THE JOINT PROBABILITY MATRICES P0, P45, P90, P135
C	INSIDE OF THE /U COMPUTING WINDOW OF (MEM,IBYTE) USING
C	A DISTANCE D GIVEN IN ICNUM.
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
S	OPDEF	ISZI	2400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
	DIMENSION P0(8,8), P45(8,8), P90(8,8), P135(8,8)
C
C
C	NOTE: USE IH AS A SCRATCH PAD FOR IP0 TO IP135
C	---	DIMENSION IP0(8,8)IP45(8,8),IP90(8,8),IP135(8,8)
C	---	EQUIVALENCE (IH(1),IP0(1,1)), (IH(65),IP45(1,1)),
C	---		(IH(129),IP90(1,1)), (IH(193),IP135(1,1))
C	[1] INIT
S	ENTRY JGST1
S JGST1,	BLOCK 2
C
C	COPY LOCALS
	ID=ICNUM
C
C
C	SET MIN WINDOW
	IDUMP=ISW(12)
	KX1=MAX(ID,KX1)
	KX2=MIN(KX2,(256-ID))
	KY1=MAX(ID,KY1)
C
C
C
C	GET THE RANGE OF THE GRAY VALUES WHICH WILL BE USED
C	TO NORMALIZE THE DATA.
C	G'(X,Y)=(IHIGH/ILOW)*(G(X,Y)-ILOW)
	ILOW=ITMPSTK
	IHIGH=0
S	TAD \ITMPSTK# /ITMPSTK(2)
S	DCA \IHIGH
C
C
C	SET PRINT DEVICE
	IDEVICE=3+IOUTSPOOL
C
C
C	[2] PROCESS IMAGE TO GENERATE PK
	DO 100 IY1=KY1,KY2
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /RETURN
C
S	CLA CMA
S	TAD \IY1
S	DISP2
C
	DO 100 IX1=KX1,KX2
S	TAD \IX1
S	DISP1
C
C	GET PIXELS
	IX=IX1-1
	IY=IY1-1
S	JMS GETPIXEL /GET PIXEL, SCALE AND DIVIDE BY 32
	I=IZ
C
C@	IY=IY1-1
	IX=(IX1-1)+ID
S	JMS GETPIXEL /GET PIXEL, SCALE AND DIVIDE BY 32
	J0=IZ
C
	IY=(IY1-1)+ID
C@	IX=(IX1-1)+ID
S	JMS GETPIXEL /GET PIXEL, SCALE AND DIVIDE BY 32
	J45=IZ
C
C@	IY=(IY1-1)+ID
	IX=(IX1-1)
S	JMS GETPIXEL /GET PIXEL, SCALE AND DIVIDE BY 32
	J90=IZ
C
	IY=(IY1-1)+ID
	IX=(IX1-1)-ID
S	JMS GETPIXEL /GET PIXEL, SCALE AND DIVIDE BY 32
	J135=IZ
C
C
C
C	[2.1] COMPUTE THE INCREMENTS PK(I,J)'
C	COMPUTE:   IP0(I,J0)=IP0(I,J0)+1.0
C	NOTE: (I,J0)=I+(J0)*8
C	COMPUTE: IP0(I,J0)'
S	TAD \J0
S	CLL RAL; RTL /MULT BY 8
S	TAD (0 /SINCE START AT BASE ADDR
S	TAD \I
S	TAD PIH
S	DCA 30
S	CPAGE 10 
S	DCA \IZ /FORCE DF TO COMMON
S	ISZI 30 /DO '
S	JMP OKP0 /OK
S	CLA CMA
S	DCAI 30 /SET TO MAX # = 4095
S OKP0,	CLA
C
C	COMPUTE:   IP45(I,J45)=IP45(I,J45)+1.0
C	NOTE: (I,J45)=I+(J45)*8
C	COMPUTE: IP45(I,J45)'
S	TAD \J45
S	CLL RAL; RTL /MULT BY 8
S	TAD (D64 /SINCE START AT BASE ADDR
S	TAD \I
S	TAD PIH
S	DCA 30
S	CPAGE 10 
S	DCA \IZ /FORCE DF TO COMMON
S	ISZI 30 /DO '
S	JMP OKP45 /OK
S	CLA CMA
S	DCAI 30 /SET TO MAX # = 4095
S OKP45,	CLA
C
C	COMPUTE:   IP90(I,J90)=IP90(I,J90)+1.0
C	NOTE: (I,J90)=I+(J90-)*8
C	COMPUTE: IP90(I,J90)'
S	TAD \J90
S	CLL RAL; RTL /MULT BY 8
S	TAD (D128 /SINCE START AT BASE ADDR
S	TAD \I
S	TAD PIH
S	DCA 30
S	CPAGE 10 
S	DCA \IZ /FORCE DF TO COMMON
S	ISZI 30 /DO '
S	JMP OKP90 /OK
S	CLA CMA
S	DCAI 30 /SET TO MAX # = 4095
S OKP90,	CLA
C
C	COMPUTE:   IP135(I,J135)=IP135(I,J135)+1.0
C	NOTE: (I,J135)=I+(J1351)*8
C	COMPUTE: IP135(I,J135)'
S	TAD \J135
S	CLL RAL; RTL /MULT BY 8
S	TAD (D192 /SINCE START AT BASE ADDR
S	TAD \I
S	TAD PIH
S	DCA 30
S	CPAGE 10 
S	DCA \IZ /FORCE DF TO COMMON
S	ISZI 30 /DO '
S	JMP OKP135 /OK
S	CLA CMA
S	DCAI 30 /SET TO MAX # = 4095
S OKP135,	CLA
C
C
100	CONTINUE
C
C	[3] CONVERT IP TO P (SINGLE PRECISION TO F.P.)
	DO 300 I=1,256
	J=IH(I)
S	TAD \J
S	AND (3777
S	DCA \ILOW
S	TAD \J
S	RTL
S	AND (0001
S	DCA \IHIGH
300	P0(I)=FLOAT(IHIGH)*2048.0+FLOAT(ILOW)
C
C
C	[4] DUMP (IF /L) PK
C	FIRST COMPUTE PRINT NAME OF BMI
S	TAD (4000
S	DCA \I /SPACE=LOW
S	TAD \IBYTE
S	RAR/==>LIINK
S	CLA
S	TAD (1000 /"H@"
S	SZL
S	DCA \I
C
C	IF /L THEN DUMP P MATRICES
S	TAD \IDUMP
S	SNA CLA
S	JMP \910 /NO DUMP
C
	WRITE(IDEVICE,905)MEM,I,(KX1-1),(KX2-1),(KY1-1),(KY2-1)
905	FORMAT(1,//,' JGSTXT(BM',I1,A1
     1,') WINDOW: [',I3,':',I3,' , ',I3,':',I3,']')
C
	WRITE(IDEVICE,900)P0
900	FORMAT(1,//,' 0 DEG',/,' ',8(8F8.0,/))
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998
C
	WRITE(IDEVICE,901)P45
901	FORMAT(1,//,' 45 DEG',/,' ',8(8F8.0,/))
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998
C
	WRITE(IDEVICE,902)P90
902	FORMAT(1,//,' 90 DEG',/,' ',8(8F8.0,/))
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998
C
	WRITE(IDEVICE,903)P135
903	FORMAT(1,//,' 135 DEG',/,' ',8(8F8.0,/))
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998
C
C
C
C	[5] COMPUTE AND PRINT STATISTICS
910	CALL JGST2(P0,KX1,KX2,KY1,KY2,IOUTSPOOL,IDUMP)
C
C	[6] RETURN
S \998,	RETRN JGST1
C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C
C	************************************************************
C	SUBROUTINE:	G E T P I X E L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RGETPI,	JMP I GETPIXEL
S GETPIXEL,	0000	/ENTRY
C
C	G'(X,Y)=(INUMERATOR/IDENOMINATOR)*(G(X,Y)-ILOW)/32
	INUMERATOR=255
	IDENOMINATOR=IHIGH-ILOW
C
	CALL FETCH2D
C
	IZ=IZ-ILOW
C
S	SWAB
S	TAD \IZ
S	MQL
S	CPAGE 2
S	MUY
S	\INUMERATOR
C
S	CPAGE 2
S	DVI
S	\IDENOMINATOR
S	CLA
S	SWBA
C
C
C	DIVIDE BY 32
S	MQA
S	RTR; RTR; RAR
S	AND (0007
S	DCA \IZ
S	JMP RGETPIXEL
C
C	*****PARAMETERS*****
S PIH,	\IH /POINTER
	J0=0
	J45=0
	J90=0
	J135=0
	END
    