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 / CPMUG026.ARK / EDITM.FOR < prev    next >
Text File  |  1984-04-29  |  2KB  |  71 lines
  1. C    =========================
  2. C    : E D I T M   -  FORTRAN:
  3. C    :  R. C. Minnick        :
  4. C    :     Box 306           :
  5. C    : Ouray, Colorado 81427 :
  6. C    =========================
  7. C
  8. C M80  .PRN FILE EDITOR  VERSION 1.2  6/29/78
  9. C 
  10. C THIS PROGRAM EDITS THE  .PRN FILE PRODUCED BY THE M80
  11. C ASSEMBLER AND WRITES TO THE LST: DEVICE.  THE OUTPUT
  12. C IS NARROW ENOUGH TO FIT ON 8.5" PAPER.  FORM FEEDS AND
  13. C PAGE HEADINGS ARE FILTERED OUT IN THE PROCESS.
  14. C
  15.     PROGRAM EDITM
  16.     EXTERNAL OPEN
  17.     LOGICAL A(128),B(11)
  18. C
  19.     WRITE(1,10)
  20. 10    FORMAT(' FILE NAME: ')
  21.     READ(1,20)B
  22. 20    FORMAT(11A1)
  23.     DO 25 I=2,8
  24. 25        IF (B(I).EQ.13) B(I)=32
  25.     B(9)='P'
  26.     B(10)='R'
  27.     B(11)='N'
  28. C IFLAG=END RECOGNIZED, J CONTROLS HEADING DELETES
  29.     IFLAG=0
  30.     J=0
  31. C
  32.     CALL OPEN(6,B,0)
  33.     READ(6,30,END=1000)A
  34.     READ(6,30,END=1000)A
  35.     WRITE(2,37)(A(I),I=1,11)
  36. 37    FORMAT(' ',17X,11A1)
  37.     READ(6,30,END=1000)A
  38.     READ(6,30,END=1000)A
  39.     WRITE(2,36)
  40. 36    FORMAT('0')
  41. C
  42. 200    READ(6,30,END=1000)A
  43. 30    FORMAT(128A1)
  44. C REMOVE FORM FEED & SIGNAL FOR LINE DELETES
  45.     IF (J.GT.0) GO TO 45
  46.     DO 40 I=1,128
  47.         IF (A(I).EQ.12) J=I
  48. 40        IF (A(I).EQ.12) A(I)=13
  49.     IF (J.EQ.0) GO TO 47
  50.     IF (A(J-3).NE.69) GO TO 47
  51.     IF (A(J-2).NE.78) GO TO 47
  52.     IF (A(J-1).NE.68) GO TO 47
  53.     IFLAG=1
  54. 47    IF (J.NE.0) J=5
  55. C FIND ACTUAL LINE LENGTH & CALL IT L
  56. 45    L=128
  57.     DO 50 I=0,127
  58.         IF (A(-1*I+128).NE.13.AND.A(-1*I+128).NE.32) GO TO 60
  59. 50        L=L-1
  60. 60    IF (L.LT.128) L=L+1
  61.     J=J-1
  62.     IF (J.LT.0) J=0
  63.     IF (J.GT.0.AND.J.LT.4) GO TO 200
  64.     IF (IFLAG.EQ.0) WRITE(2,35)(A(I),I=1,20),(A(I),I=32,L)
  65.     IF (IFLAG.EQ.1) WRITE(2,35)(A(I),I=1,L)
  66. 35    FORMAT('+',128A1)
  67.     GO TO 200
  68. C
  69. 1000    ENDFILE 6
  70.     END
  71.