C PROGRAM TO PRINT FORTRAN, ASM AND PRN SOURCE FILES WITH
C IMBEDDED PAGE EJECTIONS - THUS SUBROUTINES CAN BE
C PRINTED ON SEPARATE PAGES FOR CLARITY.
C EJECTIONS ARE INSERTED IN COL 1-6 AND ARE C$ FOR
C FORTRAN FILES AND ;$ FOR ASM FILES. EJECTION FLAGS
C ARE NON-PRINTING
C.
C TABS EXPANDED,  FORM FEEDS RETAINED ON ONE OPTION
C.
C FOR PRN FILES WE LOOK THRU COLS 15-20 FOR THE ;$ COM-
C BINATION. THUS .PRN LISTINGS PAGE ALSO.
C.
C WE ATTEMP TO REMOVE SOME CLUTTER BY MAKING THE FORTRAN
C COMBINATION (COLS 1-2) OF 'C.' A LINE FEED ONLY.
C.
C PARAMETERS:
C	NCNT = COUNT OF LINES PRINTED THIS PAGE
C	IFEED = FORM FEED FLAG, 1=YES
C	ILINES = TOTAL LINES ON PAGE, DEFAULT=66
C	NLINES = NO OF PRINTED LINES PER PAGE, DEFAULT=56
C	ITAB = EXPANSION OF TABS FLAG, 1=YES
C	NFLG = END OF FILE FLAG
C.
C MENU FORMAT 600 SENDS A FORM FEED TO CONSOLE TO CLEAR
C SCREEN. IF BOTHERSOME CHANGE TO 1H0..
C IF YOUR PRINTER GIVES AN AUTOMATIC LF WITH CR YOU MUST
C DELETE 2 WRITE STATEMENTS. IN PRINT8..WRITE (2,38) D
C AND IN DOLLAR..WRITE (2,602)D,IPAGE..THESE CAUSE OVER-
C STRIKES.
C FOR A DEMO, DO A TYPE ON THIS FORTRAN LISTING AND THEN
C PRINT81  IT.
C.
C TO CONTROL LEFT MARGIN YOU MAY WISH TO CHANGE THE 6X
C IN STATEMENT 35
C.
C IF YOU USE THIS PROGRAMS, SEND ME A CARD. IF I GET
C ENOUGH INTEREST, I WILL MAINTAIN THE PROGRAM..
C AUTHOR:
C	LAWSON PIERCE
C	2516 SUNNYBROOK DR
C	KALAMAZOO MI  49008
C$
	PROGRAM PRINT8
	EXTERNAL OPEN
	LOGICAL A(128),D(25)
	COMMON NFLAG,NFLG,NCNT,ITAB,IFEED,ILINES,IBEG,A,D
	DATA NCNT,IFLAG,NFLG/3*0/
	DATA ITAB,IFEED,ILINES,NLINES,IBEG/1,1,66,56,1/
	CALL MENU (IDRIVE,NFLAG,ITAB,IFEED,ILINES,NLINES)
	CALL PNAME(D,NFLAG,IDRIVE,IBEG)
	IF (NFLAG.EQ.0) GOTO 6
		WRITE (2,37) D
		WRITE (2,38) D
		NCNT=3
6	CONTINUE
C
200	READ(6,30,END=1000)A
	IF (ITAB.EQ.1) CALL TABS(A)
C
	CALL DOLLAR
	IF (NFLG.EQ.1) GOTO 1000
C
C FIND ACTUAL LINE LENGTH & CALL IT L
45	L=128
	DO 50 I=0,127
C		IF A(I) IS NOT A CR OR BLANK, GET OUT OF LOOP
	IF (A(-1*I+128).NE.13.AND.A(-1*I+128).NE.32) GO TO 60
C		ELSE DECR END OF LINE COUNT
	L=L-1
50	CONTINUE
C
C INCR L TO PICKUP CR AT END OF LINE
60	IF (L.LT.128) L=L+1
	WRITE(2,35)(A(I),I=1,L)
	NCNT=NCNT+1
	IF (NCNT.LT.NLINES.OR.IFEED.EQ.1) GOTO 200
	DO 199  KK=NCNT,ILINES
	WRITE (2,603)
199	CONTINUE
	NCNT=0
	GO TO 200
1000	ENDFILE 6
C
30	FORMAT(128A1)
35	FORMAT('+',6X,128A1)
37	FORMAT (1H ,20X,80A1)
38	FORMAT('+',20X,25A1,///)
603	FORMAT (' ')
	END
C$
	SUBROUTINE PNAME(D,NFLAG,IDRIVE,IBEG)
C			SETUP FILE NAME
	LOGICAL B(11),D(25),DUM(12)
	DO 2 I=1,25
2	D(I)=' '
C
C INSERT DATE OF COMPILE OR PRINT
	WRITE (1,5)
	READ (1,20) (D(I),I=17,25)
5	FORMAT(1H0,'COMPILE OR PRINT DATE ? .. 01 JAN 82 ..')
	WRITE(1,10)
10	FORMAT(' FILE NAME: ')
	READ(1,20)DUM
20	FORMAT(12A1)
	IFLAG=0
	B(1)=DUM(1)
	J=9
	DO 25 I=2,8
		B(I)=DUM(I)
		IF (B(I).EQ.46) J=I
		IF (B(I).EQ.46) IFLAG=1
		IF (IFLAG.EQ.1) B(I)=32
25		IF (B(I).EQ.13) B(I)=32
	I=8
	DO 26 K=1,3
		I=I+1
		J=J+1
		B(I)=DUM(J)
26		CONTINUE
	J=3
C IS IT A PRN FILE ?
	IF(B(11).EQ.78.AND.B(10).EQ.82.AND.B(9).EQ.80)IBEG=15
C.
	CALL OPEN(6,B,IDRIVE)
C.
C MAKEUP NAME AND DATE LABEL
		DO 200 I=1,8
		IF (B(I).EQ.32) GOTO 200
		J=J+1
		D(J)=B(I)
200		CONTINUE
		J=J+1
		D(J)=46
		DO 210 I=9,11
		J=J+1
		D(J)=B(I)
210		CONTINUE
C.
	RETURN
	END
C$
	SUBROUTINE MENU(IDRIVE,NFLAG,ITAB,IFEED
     1		,ILINES,NLINES)
	WRITE (1,600)
	WRITE (1,601)
	READ (1,502) IDRIVE
	WRITE (1,602)
	READ (1,502) NFLAG
	WRITE (1,603)
	READ (1,502) IDUM
	IF (IDUM.EQ.1) RETURN
	WRITE (1,604)
	READ (1,502) ITAB
	WRITE (1,605)
	READ (1,502) IFEED
	IF (IFEED.EQ.1) RETURN
	WRITE (1,606)
	READ (1,502) IDUM
	IF (IDUM.EQ.1) RETURN
	WRITE (1,607)
	READ (1,502) ILINES
	WRITE (1,608)
	READ (1,502) NLINES
	RETURN
502	FORMAT (15I5)
600	FORMAT (1H1,'POSITION PAPER IN PRINTER')
601	FORMAT (1H0,'DRIVE SOURCE FILE IS ON ? A=1, B=2 ...')
602	FORMAT (1H ,'PAGING OPTION, 0=NONE, 1=HEADINGS...')
603	FORMAT (1H ,'DEFAULTS ARE, EXPAND TABS & SEND '
     1	,'FORM FEEDS.',/,'.WANT DEFAULTS 1=YES 2=NO..')
604	FORMAT (1H ,'WANT TO EXPAND TABS ?..')
605	FORMAT (1H ,'OUTPUT FORM FEEDS ? 1=YES  2=NO..')
606	FORMAT (1H ,'DEFAULT PAGING IS 66 LINES PER PAGE',
     1  ' AND 56 PRINTED LINES ',/,'  WANT STANDARD'
     2  ' DEFAULTS 1=YES 2=NO...')
607	FORMAT (1H ,'INPUT NO OF LINES PER PAGE ..')
608	FORMAT (1H ,'INPUT NO OF PRINTED LINES PER PAGE..')
	END
C$
	SUBROUTINE TABS(A)
C			SUBROUTINE TO EXPAND TABS
	LOGICAL A(128),E(128)
		DO 50 I=1,128
		E(I)=32
50		CONTINUE
	N=0
	DO 100 K=1,80,8
	IK=0
	DO 200 I=1,8
	IK=IK+1
	N=N+1
	M=K+I-1
	IF (A(M).EQ.9) GOTO 105
	E(N)=A(M)
	GOTO 200
105	CONTINUE
		N=N-1
		DO 110 J=IK,8
		N=N+1
		E(N)=32
110		CONTINUE
	IK=0
200	CONTINUE
100	CONTINUE
		DO 300 I=1,128
		A(I)=E(I)
300		CONTINUE
	RETURN
	END
C$
	SUBROUTINE DOLLAR
C			SUBROUTINE FOR PAGING CONTROL
	LOGICAL A(128),D(25)
	COMMON NFLAG,NFLG,NCNT,ITAB,IFEED,ILINES,IBEG,A,D
	DATA IPAGE/1/
	IEND=IBEG+5
C.
	DO 40 I=IBEG,IEND
	IF (A(I).EQ.67) GOTO 45
	IF (A(I).EQ.59) GOTO 45
40	CONTINUE
45	CONTINUE
C
C		IF HERE READ C OR ; IN COLS IBEG TO IEND
	J=I+1
	IF (A(I).EQ.67.AND.A(J).EQ.46) GOTO 120
	IF (A(J).NE.36) RETURN
	IF (IFEED.EQ.1) WRITE (2,600)
	IF (IFEED.EQ.1) GOTO 100
	DO 50 K=NCNT,ILINES
	WRITE (2,603)
50	CONTINUE
100	IPAGE=IPAGE+1
	NCNT=0
	IF (NFLAG.EQ.0) RETURN

	WRITE (2,601) D,IPAGE
	WRITE (2,602) D,IPAGE
	NCNT=3
110	READ (6,500,END=1000) A
	IF (ITAB.EQ.1) CALL TABS(A)
	RETURN
C IF PERIOD FOLLOWS "C", PRINT LF ONLY
120	WRITE (2,603)
	NCNT=NCNT+1
	GOTO 110
1000	NFLG=1
	RETURN
500	FORMAT (128A1)
600	FORMAT ('1')
601	FORMAT (1H ,20X,25A1,18X,'PAGE ',I4)
602	FORMAT ('+',20X,25A1,18X,'PAGE ',I4,//)
603	FORMAT (' ')
	END
