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 >
Wrap
Text File
|
1984-04-29
|
2KB
|
71 lines
C =========================
C : E D I T M - FORTRAN:
C : R. C. Minnick :
C : Box 306 :
C : Ouray, Colorado 81427 :
C =========================
C
C M80 .PRN FILE EDITOR VERSION 1.2 6/29/78
C
C THIS PROGRAM EDITS THE .PRN FILE PRODUCED BY THE M80
C ASSEMBLER AND WRITES TO THE LST: DEVICE. THE OUTPUT
C IS NARROW ENOUGH TO FIT ON 8.5" PAPER. FORM FEEDS AND
C PAGE HEADINGS ARE FILTERED OUT IN THE PROCESS.
C
PROGRAM EDITM
EXTERNAL OPEN
LOGICAL A(128),B(11)
C
WRITE(1,10)
10 FORMAT(' FILE NAME: ')
READ(1,20)B
20 FORMAT(11A1)
DO 25 I=2,8
25 IF (B(I).EQ.13) B(I)=32
B(9)='P'
B(10)='R'
B(11)='N'
C IFLAG=END RECOGNIZED, J CONTROLS HEADING DELETES
IFLAG=0
J=0
C
CALL OPEN(6,B,0)
READ(6,30,END=1000)A
READ(6,30,END=1000)A
WRITE(2,37)(A(I),I=1,11)
37 FORMAT(' ',17X,11A1)
READ(6,30,END=1000)A
READ(6,30,END=1000)A
WRITE(2,36)
36 FORMAT('0')
C
200 READ(6,30,END=1000)A
30 FORMAT(128A1)
C REMOVE FORM FEED & SIGNAL FOR LINE DELETES
IF (J.GT.0) GO TO 45
DO 40 I=1,128
IF (A(I).EQ.12) J=I
40 IF (A(I).EQ.12) A(I)=13
IF (J.EQ.0) GO TO 47
IF (A(J-3).NE.69) GO TO 47
IF (A(J-2).NE.78) GO TO 47
IF (A(J-1).NE.68) GO TO 47
IFLAG=1
47 IF (J.NE.0) J=5
C FIND ACTUAL LINE LENGTH & CALL IT L
45 L=128
DO 50 I=0,127
IF (A(-1*I+128).NE.13.AND.A(-1*I+128).NE.32) GO TO 60
50 L=L-1
60 IF (L.LT.128) L=L+1
J=J-1
IF (J.LT.0) J=0
IF (J.GT.0.AND.J.LT.4) GO TO 200
IF (IFLAG.EQ.0) WRITE(2,35)(A(I),I=1,20),(A(I),I=32,L)
IF (IFLAG.EQ.1) WRITE(2,35)(A(I),I=1,L)
35 FORMAT('+',128A1)
GO TO 200
C
1000 ENDFILE 6
END