program UnDiagram
c This attempt to extract source code from diagrammed
c programs created by DIAGRAMC, DIAGRAMF and DIAGRAMI.
c Program by Mitchell R Grunes, ATSC/NRL (grunes at domain yahoo.com).
c Revision date: 10/17/95.
c This program was written in FORTRAN, for historic reasons.
c Note that this leaves the headers consisting of the following 3 lines:
c =============----=============
c ....,....1....,....2....,....3....,....4....,....5....,....6....,....7....,....8....,....9....,....
c filename lines, (and the following blank lines) but prints a warning on the screen.
c It also hasn't been extensively tested.
character*80 FilNam
character*160 Line,Line2
character*1 c,c1,c2,c3,c4,c5
parameter (nIndent=11)
print*,'Input file (with diagrammed code):'
read(*,'(a80)')FilNam
print*,FilNam
open(1,file=FilNam,status='old')
print*,'Output file (with undiagrammed code):'
read(*,'(a80)')FilNam
print*,FilNam
open(2,file=FilNam)
LCol=0 ! column of |
nLine=0
1 read(1,'(a160)',end=99)Line
nLine=nLine+1
Line2=' ' ! Turn tabs to spaces
j=1
do i=1,160
if(Line(i:i).eq.char(9))then
j=(j-1)/8*8+8+1
! Make sure is good ASCII char
elseif(j.le.160.and.Line(i:i).ge.' '.
& and.Line(i:i).lt.char(128))then
Line2(j:j)=Line(i:i)
j=j+1
endif
enddo
Line=Line2
i=LenA(Line)+1
dowhile (LCol.eq.0.and.i.gt.14) ! Find column of ending | ####
i=i-1
c5=Line(i :i)
c4=Line(i-1:i-1)
c3=Line(i-2:i-2)
c2=Line(i-3:i-3)
c1=Line(i-4:i-4)
if( (c1.eq.'|'.or.c1.eq.char(179).or.c1.eq.char(186)).and.
& (c2.eq.' '.or.(c2.ge.'0'.and.c2.le.'9')).and.
& (c3.eq.' '.or.(c3.ge.'0'.and.c3.le.'9')).and.
& (c4.eq.' '.or.(c4.ge.'0'.and.c4.le.'9')).and.
& ( (c5.ge.'0'.and.c5.le.'9')))then
LCol=i-4
print*,'| column = ',LCol,' from line ',nLine
endif
enddo
if(LCol.gt.0)then ! Remove trailing | #### field.
i=LenA(Line)
if(i.eq.LCol+4)then
c5=Line(i :i)
c4=Line(i-1:i-1)
c3=Line(i-2:i-2)
c2=Line(i-3:i-3)
c1=Line(i-4:i-4)
if( (c1.eq.'|'.or.c1.eq.char(179).or.c1.eq.char(186)).and.
& (c2.eq.' '.or.(c2.ge.'0'.and.c2.le.'9')).and.
& (c3.eq.' '.or.(c3.ge.'0'.and.c3.le.'9')).and.
& (c4.eq.' '.or.(c4.ge.'0'.and.c4.le.'9')).and.
& ( (c5.ge.'0'.and.c5.le.'9')))
& Line(LCol:160)=' '
endif
endif
i=1 ! Remove diagram marks
iflag=0
c=Line(1:1)
dowhile((c.eq.' '.and.iflag.eq.0).or.c.eq.'+'.or.c.eq.'-'.or.
& c.eq.'|'.or.c.eq.'*'.or.(c.ge.char(179).and.c.le.char(218)))
Line(i:i)=' '
if(c.ne.' ')iflag=1
i=i+1
c=Line(i:i)
enddo
if(Line(1:nIndent).eq.' ')then ! Remove indentation
Line2=Line(nIndent+1:160)
Line=Line2
else
print*,'Wrong indentation at line ',nLine
print*,Line(1:LenA(Line))
print*,char(7)
endif
write(2,'(80a1,80a1)')(Line(i:i),i=1,LenA(Line))
goto 1
99 end
c-----------------------------------------------------------------------
function LenA(a) ! Length of string, at least 1
c Program by Mitchell R Grunes, ATSC/NRL (grunes at domain yahoo.com).
c Revision date: 10/17/95.
character*(*) a
n=len(a)
dowhile(n.gt.1.and.a(n:n).eq.' ')
n=n-1
enddo
LenA=n
end