      PROGRAM LIS2LPS
C UTILITY TO CONVERT .lis files (or other ascii files) to 
C A4 formatted files that can be printed on a laserprinter
C
C A.L.Spek - Utrecht University, The Netherlands (2000)
C
      CHARACTER LINE*80
      LUA = 1
      LUB = 2
      JARG = IARGC()
      IF (JARG .GT. 0) THEN
        CALL GETARG (1, LINE)
        OPEN (LUA, FILE = LINE, STATUS='UNKNOWN')
        KD = INDEX (LINE, '.')
        LINE(KD:) = '.lps'
        OPEN (LUB, FILE = LINE, STATUS = 'UNKNOWN')
        NPAG = 1
        CALL TOPS (LUA, LUB, NPAG)
      ELSE
        WRITE (6, 99999)
      ENDIF
99999   FORMAT (/, 'Program to convert lineprinter into PostScript',
     1             ' structured file', //,
     2             ' A.L.Spek, Utrecht University, The Netherlands',
     3             ' (2000)', //, 'usage: lis2lps name.lis', //,
     4             'output: name.lps', //,
     5             'both ''name'' and ''lis'' can be substituted',
     6             //)
      END

      SUBROUTINE TOPS (LUA, LUB, NPAG)
      CHARACTER NULL*1, ICH*1, PRBUF*132, PSBUF*250
      NULL = CHAR(0)
      WRITE (LUB, 99999) NPAG
      WRITE (LUB, 99998)
      NB = 1
      NE = 132
      NP = 0
      NL = 58 
   10 READ (LUA, '(A)', END = 30) PRBUF
      IF (PRBUF(1:1) .EQ. CHAR(12)) THEN
        BACKSPACE LUA
        READ (LUA, '(1X, A)', END = 10) PRBUF
        NP = NP + 1
        IF (NP .GT. 1) WRITE (LUB, 99996)
        WRITE (LUB, 99997) NP, NP
        NL = 0 
      ENDIF
      NL = NL + 1
      IF (NL .GT. 58) THEN
        NP = NP + 1
        IF (NP .GT. 1) WRITE (LUB, 99996)
        WRITE (LUB, 99997) NP, NP
        NL = 1
      ENDIF
      N = 0
      CALL TOPS1 (1, PRBUF, 1, 132, NB, NE)
      DO 20 I = 1, NE
        ICH = PRBUF(I:I)
        IF (ICH .NE. NULL) THEN
          IF (ICH .EQ. '(' .OR. ICH .EQ. ')') THEN
            N = N + 1
            PSBUF(N:N) = CHAR(92)
          ENDIF
          N = N + 1
          PSBUF(N:N) = ICH
        ENDIF
   20 CONTINUE
      WRITE (LUB, '(''('', A, '')s'')') PSBUF(1:N)
      GOTO 10
   30 WRITE (LUB, '(''np'', /, ''%%EOF'')')
      RETURN
99999 FORMAT ('%!PS-Adobe-1.0', /,'%%Creator: PLATON - A.L.Spek', /,
     1  '%%BoundingBox: 0 0 612 792', /, '%%Pages:', I6, /,
     2  '%%PageOrder: Ascend', /, '%%EndComments', /,
     3  '/FONT (Courier) cvn def /FONT_SIZE 9.000000 def', /,
     4  '/XLMARGIN 25 def /XRMARGIN 10 def /YPAGE 612 def', /,
     5  '/XPAGE 792 def /YTMARGIN 30 def', /,
     6  '/YBMARGIN 10 def /PAGENUM 1 def', /,
     7  '/bd {bind def} bind def /m {moveto} bd /l {lineto}bd', /,
     8  '/gs {gsave}bd /gr {grestore}bd /tr {translate} bd', /,
     9  '/rt {rotate} bd /PAGES_PER_SHEET 1 def', /,
     *  '/sp {/SAVEOBJ save def gs 0 XPAGE tr -90 rt } bd', /,
     1  '/np { gr showpage SAVEOBJ restore sp bp} bd', /,
     2  'FONT findfont FONT_SIZE scalefont setfont', /,
     3  '/FONT_UPPER currentfont /FontBBox get 3 get 0 exch', /,
     4  'currentfont /FontMatrix get transform exch pop def', /,
     5  '/FONT_LOWER currentfont /FontBBox get 1 get 0 exch', /,
     6  'currentfont /FontMatrix get transform exch pop def', /,
     7  '/FONT_HT  FONT_UPPER FONT_LOWER sub def')
99998 FORMAT ('FONT_HT 0 eq {/FONT_HT FONT_SIZE def } if', /,
     1  '/FONT_MOVE FONT_SIZE FONT_HT gt {FONT_SIZE def} {FONT_HT def}',
     2  /, ' ifelse', /,
     3  '/FONT_TOL FONT_HT YBMARGIN add def', /,
     4  '/bp { XLMARGIN YPAGE YTMARGIN sub FONT_UPPER sub m } bd', /,
     5  '/s { show  currentpoint exch pop dup FONT_TOL', /,
     6  '   gt {FONT_MOVE sub XLMARGIN  exch m} {np} ifelse}  bd', /,
     7  '/S {show} bd /OFFSET (_) stringwidth pop neg def', /,
     8  '/bs { OFFSET 0 rmoveto } bd', /,
     9  '/bs {XLMARGIN currentpoint pop OFFSET add lt',
     *  ' {OFFSET 0 rmoveto}', /,
     1  '{XLMARGIN currentpoint exch pop m}ifelse} bd', /,
     2  '/TABLEN (00000000) stringwidth pop def', /,
     3  '/ht {currentpoint exch TABLEN .01 mul add XLMARGIN sub ',
     4  'TABLEN div cvi 1 add TABLEN mul XLMARGIN add exch m}bd', /,
     5  '/cr {currentpoint XLMARGIN exch m pop} bd', /,
     7  'sp', /, 'bp') 
C    6  '/lp {gr 1 PAGENUM ne {showpage}if} bd', /,
99997 FORMAT ('%%Page:', 2I7)
99996 FORMAT ('np')
      END
      SUBROUTINE TOPS1 (MODE, LINE, LB, LE, NB, NE)
      CHARACTER LINE*(*)
C MODE = -1 STRIP HEADER BLANKS,
C MODE =  1 STRIP TRAILING BLANKS
C MODE =  0 STRIP HEADER & TRAILING BLANKS
      NB = LB
      NE = LE
      IF (MODE .GE. 0) THEN
        N = LE - LB + 1
        K = LE + 1
        DO 10 I = 1, N
          K = K - 1 
          IF (LINE(K:K) .NE. ' ') GOTO 20
   10   CONTINUE
   20   NE = K 
      ENDIF
      IF (MODE .LE. 0) THEN
        N = NE - LB + 1
        K = LB - 1
        DO 30 I = 1, N  
          K = K + 1 
          IF (LINE(K:K) .NE. ' ') GOTO 40
   30   CONTINUE
        K  = K + 1
   40   NB = K
      ENDIF
      RETURN
      END
