
	PROGRAM SATTRN
C
C	FOR TRANSFERRING WP-SATURN WPS FILES TO AND FROM RT <-> RSX
C	VERSION OF 11-JUL-83
C	R. W. BARNARD, SNLA, 2565A
C
	DIMENSION EXT(2)
	BYTE CHARS(512), READNM(14), INPNAM(15), OUPNAM(15), CR, LF, NUL
	DATA CR, LF, NUL /"15, "12, "0 /
	DATA DEV, INPEXT, EXT /3RDK , 3RWPS, 3RWPX, 3RWPT /
	LASCHR= 0
	IIN= 1
	IOUT= 1
C
10	TYPE 160
	ACCEPT *, IDIR
	IF (IDIR.GT.1) GO TO 10		!LOOP ON BAD INPUT
	ID= IDIR+ 1			!MAKE IT AN INDEX
	TYPE 170
	ACCEPT 180, READNM
	CALL PARSE (READNM, INPNAM, DEV, INPEXT, LASCHR)
	OPEN (UNIT=1, NAME=INPNAM, TYPE='OLD', ACCESS='DIRECT',
     1ASSOCIATEVARIABLE=IIN, RECORDSIZE=128)
	CALL PARSE (INPNAM, OUPNAM, DEV, EXT(ID), LASCHR)
	OPEN (UNIT=2, NAME=OUPNAM, TYPE='NEW', ACCESS='DIRECT',
     1ASSOCIATEVARIABLE=IOUT, RECORDSIZE=1)
C
	IBLK= 0					!NUMBER OF BLOCKS CONVERTED
	INDX= 1					!LOCAL COUNTER
	ICT= 0					!4-BYTE COUNTER
	IEXTRA= 0				!NUMBER OF EXTRA CRLFS WRITTEN
C
20	READ (1'IIN) CHARS			!READ IN A BLOCK
	IBLK= IBLK+ 1				!BUMP THE BLOCK COUNTER AND
	TYPE 190, IBLK				!TELL USER
	IBYTCT= 0				!COUNTER IN BLOCK
C
30	IBYTCT= IBYTCT+ 1			!BUMP BLOCK COUNTER
	IF (CHARS(IBYTCT).EQ."0) GO TO 120	!END OF DATA
C
C	ID=1 FOR RT -> RSX; ID=2 FOR RSX -> RT
	IF (ID.EQ.2) GO TO 70			!FOR RSX -> RT
C
C	RT -> RSX SECTION
	CALL PUTCHR (CHARS(IBYTCT), ICT, IOUT)	!WRITE THE CHARACTER OUT
	IF (INDX.GE.80) GO TO 50		!TIME TO WRITE CRLF
	IF (CHARS(IBYTCT).EQ.LF) GO TO 60	!WE GOT A CRLF
40	INDX= INDX+ 1				!BUMP LOCAL INDEX
	IF (IBYTCT.LT.512) GO TO 30		!STILL IN THE BLOCK
	GO TO 20					!READ A NEW BLOCK
C
50	CALL PUTCHR (CR, ICT, IOUT)		!PUT IN A CR
	CALL PUTCHR (LF, ICT, IOUT)		!PUT IN A LF
	IEXTRA= IEXTRA+ 2			!# OF EXTRA CHARS IN OUTPUT
60	INDX= 1					!RESET LOCAL COUNTER
	GO TO 30
C
C	RSX -> RT SECTION
70	IF (CHARS(IBYTCT).EQ.CR) GO TO 90	!IS IT A CR?
80	CALL PUTCHR (CHARS(IBYTCT), ICT, IOUT)	!NO, WRITE IT
	GO TO 40				!ONWARD
90	IF (INDX-80) 100,110,110		!YES, SEE IF IT IS IN 80TH
100	INDX= -1			!NO, TAKE CARE OF LF COMING
	GO TO 80
110	INDX= 0				!YES
	IBYTCT= IBYTCT+ 1		!SKIP NEXT LF
	IEXTRA= IEXTRA- 2		!WE DIDN'T WRITE 2 CHARS
	GO TO 40
C
C	END SECTION
120	CALL PUTCHR (CR, ICT, IOUT)		!ADD LAST CR FOR FLX
	IEXTRA= IEXTRA+ 1			!AND COUNT IN EXTRAS
	IF (ICT.EQ.0) GO TO 140			!ICT CAN BE 0,1,2 OR 3
	LEFT= 4-ICT				!MEANING THAT THERE ARE
	DO 130 I=1,LEFT				!0,1,2 OR 3 BYTES LEFT IN
	IEXTRA= IEXTRA+ 1			!THE OUTPUT ARRAY. THIS
130	CALL PUTCHR(NUL, ICT, IOUT)		!PADS TO 4 AND WRITES.
C
140	LEFT= 513- IBYTCT- IEXTRA		!THIS FILLS THE LAST BLOCK
	DO 150 I=1,LEFT,4			!WITH NULLS
150	WRITE (2'IOUT) NUL
	TYPE 200, 7, IBLK, (OUPNAM(K),K=1,14)
	STOP 'END OF CONVERSION'
C
160	FORMAT ('0WHICH WAY TO TRANSFER? (0=RT -> RSX, 1=RSX -> RT) ',$)
170	FORMAT ('0ENTER SATURN FILE TO BE CONVERTED (DEFAULT= DK:XXXXXX.
     1WPS)')
180	FORMAT (14A1)
190	FORMAT (' CONVERTING BLOCK NUMBER',I4)
200	FORMAT ('0' A1, I4, ' BLOCKS CONVERTED'/' OUTPUT FILE NAME IS '
     114A1)
	END
	SUBROUTINE PUTCHR (INCHR, ICT, IOUT)
C
C	ACCUMULATES 4 BYTES AND WRITES THEM OUT WHEN APPROPRIATE
C
	BYTE INCHR, OUTARR(4)
C
	ICT= ICT+ 1			!BUMP 4-BYTE COUNTER
	OUTARR(ICT)= INCHR		!TRANSFER THE CHAR TO THE ARRAY
	IF (ICT.NE.4) RETURN
	WRITE (2'IOUT) OUTARR		!WRITE THE ARRAY OUT
	ICT= 0				!RESET THE COUNTER
	RETURN
	END
