      INCLUDE 'MISCIOFI.FOR'

      SUBROUTINE WritePlotter (s)
      CHARACTER * 80 S
      CHARACTER c
      LOGICAL debugF
      INTEGER l, i
      INTEGER * 2 err
      COMMON /debug/ debugF
      l = LEN_TRIM(s)
      do i = 1, l
       c = s(i:i)
       CALL send_com(c, err)
      end do
      IF (debugF)  PRINT *, s
      END !SUBROUTINE

      SUBROUTINE InitStr(s)
      CHARACTER * 80 s
      INTEGER i
      DO i=1, 80
        s(i:i)= CHAR(32)
      END DO
      END !SUBROUTINE

      SUBROUTINE Concat( outstr, s)
      CHARACTER * 80 outstr, s
      INTEGER LenO, LenS, i
      LenO = LEN_TRIM(outstr) + 1
      LenS = LEN_TRIM(s)
      DO i = 1, Lens
        outstr(LenO:LenO) = s(i:i)
        LenO = LenO + 1
      END DO
      END !SUBROUTINE

      SUBROUTINE PConcat( outstr, s)
      CHARACTER * 80 outstr, s
      INTEGER LenO, LenS, i

      LenO = LEN_TRIM(outstr) + 2
      LenS = LEN_TRIM(s)
      DO i = 1, Lens
        outstr(LenO:LenO) = s(i:i)
        LenO = LenO + 1
      END DO
      END !SUBROUTINE

      SUBROUTINE AddChar( outstr, c)
      CHARACTER *80 outstr
      CHARACTER c
      INTEGER l
      l = LEN_TRIM(outstr) + 1
      outstr(l:l) = c
      END !SUBROUTINE


      SUBROUTINE debugOff()
      LOGICAL debugF

      COMMON /debug/ debugF
        debugF = .false.
      END !SUBROUTINE

      SUBROUTINE debugOn()
      LOGICAL debugF
      COMMON /debug/ debugF
        debugF = .true.
      END !SUBROUTINE

      SUBROUTINE DefinePlotterFill
      INTEGER ppatcolor, ppattype, MaxColor, CurColor
      INTEGER HPGLFillMap(0:10,0:1)
      COMMON /PPAT/ ppatcolor, ppattype
      COMMON /Max/ MaxColor
      COMMON /Current/ CurColor
      COMMON /HPGL/ HPGLFillMap

         HPGLFillMap(0, 0) = 5
         HPGLFillMap(0, 1) = 2
         HPGLFillMap(1, 0) = 1
         HPGLFillMap(1, 1) = 0
         HPGLFillMap(2, 0) = 3
         HPGLFillMap(2, 1) = 0
         HPGLFillMap(3, 0) = 3
         HPGLFillMap(3, 1) = 45
         HPGLFillMap(4, 0) = 3
         HPGLFillMap(4, 1) = 45
         HPGLFillMap(5, 0) = 3
         HPGLFillMap(5, 1) = 135
         HPGLFillMap(6, 0) = 3
         HPGLFillMap(6, 1) = 135
         HPGLFillMap(7, 0) = 4
         HPGLFillMap(7, 1) = 45
         HPGLFillMap(8, 0) = 4
         HPGLFillMap(8, 1) = 45
         HPGLFillMap(9, 0) = 4
         HPGLFillMap(9, 1) = 45
         HPGLFillMap(10, 0) = 4
         HPGLFillMap(10, 1) = 45
         ppattype = 1
         ppatcolor = 1
         MaxColor = 6
         CurColor = 128
         CALL PSetTextStyle(0, 0, 1)

      END !SUBROUTINE

      FUNCTION expnum (e)
      INTEGER  e, i
      REAL x

      x = 1.0
      IF (e .GT. 0) THEN
        DO i = 1, e
          x = x * 10.0
        END DO
      ELSE
        DO i = 1, -e, -1
          x = x / 10.0
        END DO
        expnum = x
      END IF
      END !FUNCTION

      SUBROUTINE GetPlotterViewport (x1, y1, x2, y2)
      INTEGER x1, y1, x2, y2, PUx1, PUy1, PUx2, PUy2
      COMMON /PlotView/  PUx1, PUy1, PUx2, PUy2

      x1 = PUx1
      x2 = PUx2
      y1 = PUy1
      y2 = PUy2
      END !SUBROUTINE

      SUBROUTINE JustifyPenPosition (s )
      REAL x, y, l
      CHARACTER * 80 outString, s, tempstr
      INTEGER tHJust, tVJust, tdir
      COMMON /PlotJust/ tHJust, tVJust, tdir

      CALL InitStr(tempStr)
      CALL InitStr(outString)

      l = REAL( LEN_trim(s))
      SELECT CASE (tHJust)
      CASE (0)
        IF (tdir .EQ. 0) THEN
          x = 0.0
        ELSE
          y = -1.0
        END IF
      CASE (1)
         IF (tdir .EQ. 0) THEN
            x = -l / 2.0
         ELSE
            y = -0.25
         END IF
      CASE (2)
         IF (tdir .EQ. 0) THEN
           x = -l
         ELSE
          y = 0.0
         END IF
      CASE DEFAULT
        IF (tdir .EQ. 0) THEN
          x = 0.0
        ELSE
          y = -1.0
        END IF

      END SELECT
      SELECT CASE (tvJust)
        CASE (0)
          IF (tdir .EQ. 0) THEN
            y = 0.0
          ELSE
            x = 0.0
          END IF
        CASE (1)
          IF (tdir .EQ. 0) THEN
            y = -.25
          ELSE
           x = -l / 2.0
          END IF
        CASE (2)
          IF (tdir .EQ. 0) THEN
             y = -1.0
          ELSE
             x = -l
          END IF
        CASE DEFAULT
         IF (tdir .EQ. 0) THEN
           y = 0.0
         ELSE
           x = 0.0
         END IF

      END SELECT
      outString = 'CP'
      CALL RTOSTR(x, tempstr, ',')
      CALL PConcat( outString, tempstr)
      CALL RTOSTR(y, tempstr, ';')
      CALL PConcat( outString, tempstr)
      CALL WritePlotter(outString)
      END !SUBROUTINE

      SUBROUTINE PBar (x1, y1, x2, y2)
      REAL x1, y1, x2, y2
      CHARACTER * 80 outString, tempstr
      INTEGER c, ppatcolor, ppattype, MaxColor, CurColor
      COMMON /PPAT/ ppatcolor, ppattype
      COMMON /Max/ MaxColor
      COMMON /Current/ CurColor

      IF (ppattype .NE. 0) THEN
        CALL InitStr(outString)
        CALL InitStr(tempstr)
        c = CurColor
        CALL PMoveTo(x1, y1)
        CALL SelectPen(ppatcolor)
        outString = 'RA'
        CALL RTOSTR(x2, tempstr, ',')
        CALL PConcat(outString, tempstr)
        CALL RTOSTR( y2, tempstr, ';')
        CALL PConcat(outString, tempstr)
        CALL WritePlotter(outString)
        CALL SelectPen(c)
      END IF
      END !SUBROUTINE



      SUBROUTINE PenDown()
      CHARACTER * 80 outString

      outString = 'PD;'
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE PenUp()
      CHARACTER * 80 outString

      outString = 'PU;'
      CALL WritePlotter(outString)
      END !SUBROUTINE


      SUBROUTINE PGetColor (c)
      INTEGER c, CurColor
      COMMON /Current/ CurColor

       c = CurColor
      END !SUBROUTINE



      SUBROUTINE PGetFillSettings (pattern, fillcolor)
      INTEGER ppatcolor, ppattype, pattern, fillcolor
      COMMON /PPAT/ ppatcolor, ppattype

      pattern = ppattype
      fillcolor = ppatcolor
      END !SUBROUTINE



      SUBROUTINE PLineRel (x1, y1)
      REAL x1, y1
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      CALL PenDown
      outString = 'PR'
      CALL RTOSTR(x1, tempstr, ',')
      CALL PConcat(outString, tempstr)
      CALL RTOSTR(y1, tempstr, ';')
      CALL PConcat(outString, tempstr)
      CALL WritePlotter(outString)
      CALL PenUp
      END !SUBROUTINE


      SUBROUTINE PLineTo (x1, y1)
      REAL x1, y1
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      CALL PenDown
      outString = 'PA'
      CALL RTOSTR(x1, tempstr, ',')
      CALL PConcat(outString, tempstr)
      CALL RTOSTR(y1, tempstr, ';')
      CALL PConcat(outString, tempstr)
      CALL WritePlotter(outString)
      CALL PenUp
      END !SUBROUTINE


      SUBROUTINE PMoveRel (x1, y1)
      REAL x1, y1
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      CALL PenUp
      outString = 'PR'
      CALL RTOSTR(x1, tempstr, ',')
      CALL PConcat(outString, tempstr)
      CALL RTOSTR(y1, tempstr, ';')
      CALL PConcat(outString, tempstr)
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE PMoveTo (x1, y1)
      REAL x1, y1
      CHARACTER * 80 outString, tempstr


      CALL InitStr(outString)
      CALL InitStr(tempstr)
      CALL PenUp
      outString = 'PA'
      CALL RTOSTR(x1,tempstr, ',')
      CALL PConcat(outString, tempstr)
      CALL RTOSTR(y1, tempstr, ';')
      CALL PConcat(outString, tempstr)
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE POutText (s)
      CHARACTER * 80 s,outString, Tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      tempstr = s
      CALL AddChar(tempstr,CHAR(3))
      CALL JustifyPenPosition(tempstr)
      outString = 'LB '
      CALL PConcat(outString, tempstr)
      CALL AddChar(outString, ';')
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE PRectangle (x1, y1, x2, y2)
      REAL x1, y1, x2, y2
      CHARACTER * 80 outString, tempstr


      CALL InitStr(outString)
      CALL InitStr(tempstr)
      CALL PMoveTo(x1, y1)
      outString = 'EA'
      CALL RTOSTR(x2, tempstr, ',')
      CALL PConcat(outString, tempstr)
      CALL RTOSTR(y2, tempstr, ';')
      CALL PConcat(outString, tempstr)
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE PSetFillStyle (pati, c)
      CHARACTER * 80 outString, tempstr
      INTEGER pat,pati, c, angle, ppatcolor, ppattype
      INTEGER HPGLFillMap(0:10,0:1)
      COMMON /HPGL/ HPGLFillMap
      COMMON /PPAT/ ppatcolor, ppattype

      IF (pati .GE. 0) THEN
        CALL InitStr(outString)
        CALL InitStr(tempstr)
        ppatcolor = c
        ppattype = pati
        pat = HPGLFillMap(pati, 0)
        angle = HPGLFillMap(pati, 1)
        outString = 'FT'
        CALL INTTOSTR(pat, tempstr, ',')
        CALL PConcat(outString, tempstr)
        CALL INTTOSTR(4, tempstr, ',')
        CALL PConcat(outString, tempstr)
        CALL INTTOSTR(angle, tempstr, ';')
        CALL PConcat(outString, tempstr)
        CALL WritePlotter(outString)
      END IF
      END !SUBROUTINE


      SUBROUTINE PSetLineStyle (ls, thick)
      INTEGER ls,  thick, l
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      IF (ls .EQ. 0) THEN
        outString = 'LT;'
      ELSE
        outString = 'LT'
        CALL INTTOSTR(ls, tempstr, ',')
        CALL PConcat(outString, tempstr)
        L = LEN_TRIM(outString)+1
        outString(l:l ) = CHAR(2)
        l = l + 1
        outString(l:l) = ';'
      END IF
      L = LEN_TRIM(outString)+1
      outString(l:l) =  'PT '
      CALL INTTOSTR(thick, tempstr, ';')
      CALL PConcat (outString, tempstr)
      CALL WritePlotter(outString)

      END !SUBROUTINE



      SUBROUTINE PSetTextJustify (h, v)
      INTEGER  tHJust, tVJust, tdir, h, v
      COMMON /PlotJust/ tHJust, tVJust, tdir

      tHJust = h
      tvJust = v
      END !SUBROUTINE



      SUBROUTINE PSetTextStyle (font, dir, size)
      REAL wr, hr
      INTEGER font, dir, size
      PARAMETER (wr = 0.075)
      PARAMETER (hr = 0.1)
      INTEGER xrun, xrise
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      tdir = dir
      IF (dir .EQ. 0) THEN
        xrun = 1
        xrise = 0
      END IF
      IF (dir .EQ. 1) THEN
        xrun = 0
        xrise = 1
      END IF

      outString = 'DI'
      CALL INTTOSTR(xrun, tempstr,',')
      CALL PConcat (outString, tempstr)
      CALL INTTOSTR(xrise,tempstr,';')
      CALL PConcat (outString, tempstr)
      CALL WritePlotter(outString)
      outString = 'SI'
      CALL RTOSTR( wr*size, tempstr, ',')
      CALL PConcat (outString, tempstr)
      CALL RTOSTR( hr*size, tempstr, ';')
      CALL PConcat (outString, tempstr)
      CALL WritePlotter(outString)

      outString = 'CS'
      CALL INTTOSTR(font,tempstr, ';')
      CALL PConcat (outString, tempstr)
      CALL WritePlotter(outString)
      END !SUBROUTINE


      SUBROUTINE RealString (r, digits, wid, TheString)
      REAL r, tempr
      CHARACTER * 80 TheString, result
      INTEGER  exponent, digits, wid, num, position, behind, before
      INTEGER delta, i,j, y, strLen, location
      LOGICAL sign

      location = 1
      CALL InitStr(TheString)
      tempr = r
      sign = .FALSE.
      strLen = ABS(REAL(digits)) + 2    !!!  min. 2 characters sign, digit
      IF (digits .NE. 0) strLen = strLen + 1
      IF (digits .LT. 0) strLen = strLen + 4
      IF (tempr .LT. 0)  sign = .TRUE.
      tempr = ABS(tempr)

      !!!  if not scientific notation then round it now
c      IF (digits .GE. 0) tempr=tempr+ 0.5 * exp10(-digits) + 1.0E-14

      !!!  normalize downward, less than 10
      exponent = 0
      DO WHILE (tempr .GE. 10.0)
       tempr=tempr/ 10.0
        exponent = exponent + 1
      END DO
      IF (digits .GE. 0) THEN
        before = exponent
      ELSE
        before = 0
      END IF
      behind = ABS(digits)

      !!!  scientific notation
      IF (digits .LT. 0 .AND.tempr.NE. 0.0) THEN
        DO WHILE (tempr .LT. 1.0 )  !!!  normalize upward, greater than 1
         tempr=tempr* 10.0
          exponent = exponent - 1
        END DO
c       tempr=tempr+ 0.5 * exp10(-ABS(digits)) + 1E-14     !!!  round it now
        IF (tempr .GE. 10.0) THEN  !!!  normalize downward to less than 10
         tempr=tempr/ 10.0
          exponent = exponent + 1
        END IF
      END IF
      !!!  sign
      IF (sign) THEN
        result(1:1) = '-'
        location = location + 1
      END IF

      !!!  Write digits before the decimal-point
      y = AINT(tempr)
      result(location:location) = CHAR(y+48)
      location = location + 1
      tempr= tempr - REAL(y)
      DO WHILE (before .GT. 0)
        tempr = tempr * 10.0
        y = AINT(tempr)
        result(location:location) =  CHAR(y+48)
        strindex = strindex + 1
        location = location + 1
        tempr = tempr - y
        before = before - 1
      END DO
      IF (behind .NE. 0) THEN
        result(location:location) = '.'
        strindex = strindex + 1
        location = location + 1
      END IF

      !!!  write digits after the decimal-point
      DO WHILE (behind .GT. 0)
        tempr = tempr * 10.0
        y = AINT(tempr)
        result(location:location) = CHAR(y + 48)
        strindex = strindex + 1
        location = location + 1
        tempr = tempr - REAL(y)
        behind = behind - 1
      END DO

      !!!  scientific notation: write exponent
      IF (digits .LT. 0) THEN
        result(location:location) =  'E'
        strindex = strindex + 1
        location = location + 1
        IF (exponent .GE. 0) THEN
          result(location:location) =  '+'
        ELSE
          result(location:location) =  '-'
        END IF
        location = location + 1
        num = ABS(exponent)
        IF (num .GE. 10) THEN
          explen = 2
        ELSE
          explen = 1
        END IF
        position = location + explen - 1    !!!  start on the right

         DO WHILE (num .NE. 0)
           i = MOD(num, 10)
           result(position:position) = CHAR(i+48)
           position = position - 1
           num = num / 10
         END DO
         DO WHILE (position .GE. location)
           result(position:position) = ' '
           position = position - 1
         END DO
         location = location + explen
       END IF

   !!!  leading blanks
       location = location - 1
       IF (wid .GT. location) THEN
         delta = wid - location
       ELSE
         delta = 0
       END IF
       DO i = 1, location
            j = i+delta
            TheString(j:j) = Result(i:i)
       END DO
       END !SUBROUTINE


      SUBROUTINE ScalePlotterViewport (x1, y1, x2, y2)
      INTEGER x1, y1, x2, y2
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      outString = 'SC'
      CALL INTTOSTR(x1, tempstr, ',' )
      CALL PConcat (outString, tempstr)
      CALL INTTOSTR(x2, tempstr, ',')
      CALL PConcat (outString, tempstr)
      CALL INTTOSTR(y1, tempstr, ',')
      CALL PConcat (outString, tempstr)
      CALL INTTOSTR(y2, tempstr, ';')
      CALL PConcat (outString, tempstr)
      CALL WritePlotter(outString)
      END !SUBROUTINE

      SUBROUTINE SelectPen (p)
      CHARACTER * 80 outString, tempStr
      INTEGER p, ppatcolor, ppattype, CurColor, MaxColor
      COMMON /PPAT/ ppatcolor, ppattype
      COMMON /Current/ CurColor
      COMMON /Max/ MaxColor

      ppatcolor = p
      IF (ppatcolor .GT. MaxColor) THEN ppatcolor = MaxColor
      IF (CurColor .NE. ppatcolor) THEN
        CALL InitStr(outString)
        CALL InitStr(tempstr)
        CALL PenUp
        CurColor = ppatcolor
        outString = 'SP'
        CALL INTTOSTR(CurColor,tempstr, ';')
        CALL PConcat (outString, tempstr)
        CALL WritePlotter(outString)
      END IF
      END !SUBROUTINE



      SUBROUTINE SelectPenVelocity (v)
      INTEGER v
      CHARACTER * 80 outString, tempStr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      outString = 'VS'
      CALL INTTOSTR(v, tempStr, ';')
      CALL PConcat (outString, tempStr)
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE SetClippingWindow (x1, y1, x2, y2)
      REAL x1, y1, x2, y2
      CHARACTER * 80 outString, tempstr

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      outString = 'IW'
      CALL RTOSTR(x1, tempStr, ',')
      CALL PConcat (outString, tempStr)
      CALL RTOSTR(y1, tempStr, ',')
      CALL PConcat (outString, tempStr)
      CALL RTOSTR(x2, tempStr, ',')
      CALL PConcat (outString, tempStr)
      CALL RTOSTR(y2, tempStr, ';')
      CALL PConcat (outString, tempStr)
      CALL WritePlotter(outString)
      END !SUBROUTINE

      SUBROUTINE SetMaxColor (c)
      INTEGER c, MaxColor
      COMMON /Max/ MaxColor
      MaxColor = c
      END !SUBROUTINE



      SUBROUTINE SetPlotterViewport (x1, y1, x2, y2)
      CHARACTER * 80 outString, tempstr
      INTEGER x1, y1, x2, y2, PUx1, PUy1, PUx2, PUy2
      COMMON /PlotView/  PUx1, PUy1, PUx2, PUy2

      CALL InitStr(outString)
      CALL InitStr(tempstr)
      PUx1 = x1
      PUx2 = x2
      PUy1 = y1
      PUy2 = y2

      outString = 'IP'

      CALL INTTOSTR(x1, tempStr, ',')
      CALL PConcat (outString, tempStr)
      CALL INTTOSTR(y1, tempStr, ',')
      CALL PConcat (outString, tempStr)
      CALL INTTOSTR(x2, tempStr, ',')
      CALL PConcat (outString, tempStr)
      CALL INTTOSTR(y2, tempStr, ';')
      CALL PConcat (outString, tempStr)
      CALL WritePlotter(outString)
      END !SUBROUTINE



      SUBROUTINE RTOSTR(x, S, dc)
      REAL x, tx
      CHARACTER * 80 TempStr, S
      CHARACTER dc
      INTEGER l

      CALL InitStr(s)
      CALL InitStr(tempstr)
      tx = x
      CALL RealString(tx, 2, 1, TempStr)

      l = LEN_TRIM(TempStr) + 1
      TempStr(l:l) =  dc
      S = TempStr
      END ! FUNCTION



      SUBROUTINE INTTOSTR(x, S, dc)
      INTEGER l,x
      REAL tx
      CHARACTER * 80 S, TempStr
      CHARACTER dc
      CALL InitStr(s)
      CALL InitStr(tempstr)
      tx = REAL(x)
      CALL RealString(tx, 0, 1, TempStr)
      l = LEN_TRIM(TempStr) + 1
      TempStr(l:l) =  dc
      S = TempStr
      END ! FUNCTION



      SUBROUTINE PEdgeWedge(x,y,radius, start,sweep)
      REAL x, y, radius
      INTEGER  start,  sweep
      CHARACTER * 80 outString, tempstr

       CALL InitStr(outString)
       CALL InitStr(tempstr)
       CALL Pmoveto(x,y)
       outString = 'EW'
       CALL RTOSTR(radius, tempStr, ',')
       CALL PConcat(outString, tempstr)
       CALL INTTOSTR(start, tempStr, ',')
       CALL PConcat (outstring, tempstr)
       CALL INTTOSTR(sweep, tempStr, ',')
       CALL PConcat (outstring, tempstr)
       CALL INTTOSTR(5, tempStr, ';')
       CALL PConcat (outstring, tempstr)
       CALL WritePlotter(outString)
      END



      SUBROUTINE PShadeWedge(x, y, radius, start, sweep)
      REAL x, y, radius
      INTEGER  start,  sweep, c, ppatcolor, ppattype
      CHARACTER * 80 outString, tempstr
      INTEGER CurColor
      COMMON /Current/ CurColor
      COMMON /PPAT/ ppatcolor, ppattype


      CALL InitStr(outString)
      CALL InitStr(tempstr)
      CALL PEdgeWedge(x,y,radius,start,sweep)
      IF (ppattype .GT. 0) THEN
        CALL Pmoveto(x,y)
        c = CurColor
        CALL SelectPen(ppatcolor)
        outString =  'WG'
        CALL RTOSTR(radius, tempStr, ',')
        CALL PConcat(outString, tempstr)
        CALL INTTOSTR(start, tempStr, ',')
        CALL PConcat (outstring, tempstr)
        CALL INTTOSTR(sweep, tempStr, ',')
        CALL PConcat (outstring, tempstr)
        CALL INTTOSTR(5, tempStr, ';')
        CALL PConcat (outstring, tempstr)
        CALL WritePlotter(outString)
        CALL SelectPen(c)
      END IF
      END

