home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG091.ARK / PRINT80.FOR < prev    next >
Text File  |  1984-04-29  |  4KB  |  182 lines
  1. C EXTENSIVE REVISION BY LAWSON PIERCE 27 MAR 1982
  2. C TABS EXPANDED, PAGING OPTIONS, DRIVE OPTIONS, &
  3. C TITLE MODS ADDED.
  4. C FORM FEEDS RETAINED ON ONE OPTION
  5. C M80  .PRN FILE EDITOR  VERSION 1.2  6/29/78
  6. C. 
  7. C THIS PROGRAM EDITS THE  .PRN FILE PRODUCED BY THE M80
  8. C ASSEMBLER AND WRITES TO THE LST: DEVICE.  THE OUTPUT
  9. C IS NARROW ENOUGH TO FIT ON 8.5" PAPER.
  10. C ADAPTED FROM CMUG 026 ,EDITM.FOR BY R. C. MINNICK, BOX 306
  11. C   OURAY, COLORADO 81427
  12. C$
  13.     PROGRAM EDITM
  14.     EXTERNAL OPEN
  15.     LOGICAL A(128),D(25)
  16.     CALL PNAME(D,NFLAG)
  17.     J=0
  18.     IFLAG=0
  19.     NDFLAG=0
  20.     READ(6,30,END=1000)A
  21.     CALL TABS(A)
  22.     DO 300 I=1,25
  23.     A(I+55)=D(I)
  24. 300    CONTINUE
  25.     WRITE(2,37)(A(I),I=2,80)
  26. 37    FORMAT(' ',80A1)
  27.     READ(6,30,END=1000)A
  28.     WRITE(2,36)
  29. 36    FORMAT('0')
  30. C.
  31. 200    READ(6,30,END=1000)A
  32. 30    FORMAT(128A1)
  33.     CALL TABS(A)
  34. C.
  35.     IF (J.GT.0) GO TO 45
  36.       DO 40 I=1,128
  37.       IF (A(I).EQ.12) J=I
  38.       IF (A(I).EQ.12) CALL OPTION (I,NFLAG,NDFLAG,A,D)
  39.       IF (NDFLAG.EQ.1) GOTO 1000
  40. 40      CONTINUE
  41.     IF (J.EQ.0) GO TO 47
  42. C IFLAG=END RECOGNIZED
  43.     IF (A(J-3).NE.69) GO TO 47
  44.     IF (A(J-2).NE.78) GO TO 47
  45.     IF (A(J-1).NE.68) GO TO 47
  46.     IFLAG=1
  47. 47    IF (J.NE.0) J=5
  48. C FIND ACTUAL LINE LENGTH & CALL IT L
  49. 45    L=128
  50. C
  51.     DO 50 I=0,127
  52. C        IF A(I) IS NOT A CR OR BLANK, GET OUT OF LOOP
  53.     IF (A(-1*I+128).NE.13.AND.A(-1*I+128).NE.32) GO TO 60
  54. C        ELSE DECR END OF LINE COUNT
  55.     L=L-1
  56. 50    CONTINUE
  57. C.
  58. C INCR L TO PICKUP CR AT END OF LINE
  59. 60    IF (L.LT.128) L=L+1
  60.     J=J-1
  61.     IF (J.LT.0) J=0
  62.     IF (IFLAG.EQ.0) WRITE(2,35)(A(I),I=1,20),(A(I),I=32,L)
  63.     IF (IFLAG.EQ.1) WRITE(2,35)(A(I),I=1,L)
  64. 35    FORMAT('+',2X,128A1)
  65.     GO TO 200
  66. C.
  67. 1000    ENDFILE 6
  68.     END
  69. C$
  70. C SETUP FILE NAME
  71.     SUBROUTINE PNAME(D,NFLAG)
  72.     LOGICAL B(11),D(25),DUM(12)
  73.     DO 2 I=1,25
  74. 2    D(I)=' '
  75. C.
  76. C INSERT DATE OF COMPILE OR PRINT
  77.     WRITE (1,5)
  78.     READ (1,20) (D(I),I=17,25)
  79. 5    FORMAT(1H0,'COMPILE OR PRINT DATE ? .. 01 JAN 82 ..')
  80.     WRITE(1,10)
  81. 10    FORMAT(' FILE NAME: ')
  82.     READ(1,20) DUM
  83. 20    FORMAT(12A1)
  84.     IFLAG=0
  85.     B(1)=DUM(1)
  86.     DO 25 I=2,8
  87.         B(I)=DUM(I)
  88.         IF (B(I).EQ.46) IFLAG=1
  89.         IF (IFLAG.EQ.1) B(I)=32
  90. 25        IF (B(I).EQ.13) B(I)=32
  91. 26    B(9)='P'
  92.     B(10)='R'
  93.     B(11)='N'
  94.     WRITE (1,600)
  95. 600    FORMAT (1H0,'POSITION PAPER 7 LINES FROM TOP OF PAGE')
  96.     WRITE (1,28)
  97. 28    FORMAT (1H0,'DRIVE PRN FILE IS ON ? A=1, B=2 ...')
  98.     READ (1,602) IDRIVE
  99.     WRITE (1,29)
  100. 29    FORMAT (1H ,'PAGING OPTION, 0=NONE, 1=MACRO',
  101.      1        ' HEADINGS ... ')
  102.     READ (1,602) NFLAG
  103. 602    FORMAT (15I5)
  104.     J=3
  105. C
  106.     CALL OPEN(6,B,IDRIVE)
  107. C
  108. C MAKEUP NAME AND DATE LABEL
  109.         DO 200 I=1,8
  110.         IF (B(I).EQ.32) GOTO 200
  111.         J=J+1
  112.         D(J)=B(I)
  113. 200        CONTINUE
  114.         J=J+1
  115.         D(J)=46
  116.         DO 210 I=9,11
  117.         J=J+1
  118.         D(J)=B(I)
  119. 210        CONTINUE
  120. C
  121.     RETURN
  122.     END
  123. C
  124. C SUBROUTINE TO EXPAND TABS
  125. C
  126.     SUBROUTINE TABS(A)
  127.     LOGICAL A(128),E(128)
  128.         DO 50 I=1,128
  129.         E(I)=32
  130. 50        CONTINUE
  131.     N=0
  132.     DO 100 K=1,80,8
  133.     DO 200 I=1,8
  134.     N=N+1
  135.     M=K+I-1
  136.     IF (A(M).EQ.9) GOTO 105
  137.     E(N)=A(M)
  138.     GOTO 200
  139. 105    CONTINUE
  140.         DO 110 J=I,8
  141.         E(N)=32
  142.         N=N+1
  143. 110        CONTINUE
  144. 200    CONTINUE
  145. 100    CONTINUE
  146.         DO 300 I=1,128
  147.         A(I)=E(I)
  148. 300        CONTINUE
  149.     RETURN
  150.     END
  151. C
  152. C SUBROUTINE FOR PAGING CONTROL
  153. C
  154.     SUBROUTINE OPTION(I,NFLAG,NDFLAG,A,D)
  155.     LOGICAL A(128),D(25)
  156.     IF (NFLAG.NE.1) GOTO 100
  157. C
  158. C IF HERE WE WANT MACRO TITLE ON EACH PAGE
  159. C
  160.     IF (I.GT.100) GOTO 301
  161.     DO 300 K=3,25
  162.     KK=I+K+55
  163.     A(KK)=D(K)
  164. 300    CONTINUE
  165. C
  166. 301    WRITE (2,37) (A(K),K=1,24),(A(K),K=30,85)
  167.     READ (6,30,END=1000) A
  168.     RETURN
  169. 1000    NDFLAG=1
  170.     RETURN
  171. C
  172. C FOR NOW, RETURN
  173. C
  174. C READ NEXT 2 RECORDS AND IGNORE, USE THIRD
  175. 100    DO 110 K=1,3
  176.     READ (6,30,END=1000) A
  177. 110    CONTINUE
  178.     RETURN
  179. 37    FORMAT (' ',80A1)
  180. 30    FORMAT (128A1)
  181.     END
  182.