
      INCLUDE 'FGRAPH.FI'
      INCLUDE 'misciofi.for'



      INTEGER FUNCTION GetPrnmaxX (orient)
      INTEGER result, getmaxX, getmaxY, orient

        CALL GetMaxCoords(getmaxX, getmaxY)
        IF (orient .EQ. 1) THEN
          result = getmaxY
        ELSE
          result = getmaxX
        END IF
        GetPrnmaxX = result
      END !FUNCTION

      INTEGER FUNCTION GetPrnmaxY (orient)
      INTEGER result, getmaxX, getmaxY, orient

        CALL GetMaxCoords(getmaxX, getmaxY)
        IF (orient .EQ. 1) THEN
          result = getmaxX
        ELSE
          result = getmaxY
        END IF
        GetPrnmaxY = result
      END !FUNCTION

      FUNCTION GetPrnPixel (x, y, orient)
      INCLUDE 'FGRAPH.FD'
      INTEGER x,y,orient,result, getmaxX, getmaxY, xval

        result = 0
        CALL GetMaxCoords(getmaxX, getmaxY)
        IF (orient .EQ. 1) THEN
          xval = getmaxX - y
          IF (xval .GE. 0) THEN
            result = getpixel(xval, x)
          ELSE
            result = 0
          END IF
        ELSE
           result = getpixel(x, y)
        END IF
        GetPrnPixel = REAL(result)
      END !FUNCTION




      SUBROUTINE GetHorizByte (x, y, xm, ym, rv, orient, GHB)
      CHARACTER GHB
      INTEGER x,y,rv, orient
      INTEGER i, result
      REAL xm, ym
      INTEGER yinc
      REAL xminc, xinc
      LOGICAL p
      INCLUDE 'FGRAPH.FD'

      result = 0
      yinc = INT(y/ym)
      xinc = 1/xm
      xminc = xinc * x
      DO i = 0, 7
        IF (GetPrnPixel(INT(xminc), yinc, orient) .GT. 0) THEN
          p = .TRUE.
        ELSE
          p = .FALSE.
        END IF
        IF (rv .EQ. 1)  p = .NOT. (p)
        IF (p) result = IBSet(result,7-i)
        xminc = xminc + xinc
      END DO
      GHB = CHAR(result)
      END !SUBROUTINE

      SUBROUTINE GetVertByte (x, y, numPix, xm, ym, rv, orient, GVB)
      CHARACTER GVB
      INTEGER x,y, numPix,  rv, orient
      INTEGER n, i, e,bm, l
      REAL xm, ym
      INTEGER xinc
      REAL yinc, yminc
      LOGICAL p
      INCLUDE 'FGRAPH.FD'

      e = y + numPix - 1
      bm = 0
      l = 0
      n = numPix - 1
      xinc = INT(x/xm)
      yinc = 1/ym
      yminc = y * yinc
      DO i = y, e
        IF (GetPrnPixel(xinc,INT(yminc), orient) .GT. 0) then
          p = .TRUE.
        ELSE
          p = .FALSE.
        END IF
        IF (rv .EQ. 1)  p = .NOT. (p)
        IF (p)    bm = IBSet(bm,n-l)
        l = l + 1
        yminc = yminc + yinc
      END DO
      GVB = CHAR(bm)
      END ! SUBROUTINE


      INTEGER FUNCTION PrinterErr (i)
      INTEGER i, prnerr
      IF ((i .EQ.32) .OR. (i .EQ. 8) .OR. (i .EQ. 1)) THEN
         prnerr = 1
       ELSE
         prnerr = 0
       END IF
       PrinterErr = 0
      END !FUNCTION



      SUBROUTINE OutPrnChar (Prnport, ch, prnerr)
      INTEGER Prnport, prnerr
      INTEGER * 2 err,port
      CHARACTER ch

      prnerr = 0
      port = Prnport
      SELECT CASE (port)
      CASE (0, 1)
          CALL POC(port, ch, err)
      CASE (2)
         CALL Send_Com(ch,err)
      CASE DEFAULT
          CALL POC (port, ch, err)
      END SELECT
      prnerr = err
      END !SUBROUTINE




      SUBROUTINE OutPrnStr (Prnport, S , prnerr)
      INTEGER Prnport, prnerr, L
      CHARACTER * 80 S

      prnerr = 0
      L = LEN_TRIM(S)
      DO i = 1, L
         CALL OutPrnChar(Prnport, S( i:i), prnerr)
      END DO
      END !SUBROUTINE



      SUBROUTINE EpsonFXSD (Prnport, res,xm,ym,rv, orient, ff, prnerr)
      INTEGER PrnPort, res, rv, orient, ff, prnerr
      CHARACTER * 80  ResArray,  linespace
      CHARACTER * 80  CR,graphInit, endgraph
      CHARACTER ch, ESC
      INTEGER maxX, maxY, x, y, PrinterErr, GetPrnmaxX, GetPrnmaxY
      REAL xm, ym

      ESC = CHAR(27)
      CALL InitStr(lineSpace)
      CALL InitStr(endGraph)
      CALL InitStr(ResArray)
      CALL InitStr(CR)
      CALL InitStr(GraphInit)
      ResArray(1:1) = CHAR(75)
      ResArray(2:2) = CHAR(76)
      ResArray(3:3) = CHAR(89)
      ResArray(4:4) = CHAR(90)
      CALL GetMaxCoords(maxX, maxY)

      maxX = INT((GetPrnmaxX(orient) + 1) * xm)
      maxY = INT((GetPrnmaxY(orient) + 1) * ym)
      prnerr = 0
      res = res + 1
      IF (res .GT. 4) res = 1
      CR(1:1) = CHAR(13)
      CR(2:2) = CHAR(10)         ! { carriage return line feed }
      lineSpace(1:1) = ESC
      lineSpace(2:2) = 'A'
      lineSpace(3:3) = CHAR(8)  ! {set line spacing for 8/72}
      endGraph(1:1) = ESC
      endGraph(2:2) = 'A'
      endGraph(3:3) = CHAR(12)  ! {set line spacing for 12/72}
      y = 0
      graphInit(1:1) = ESC
      graphInit(2:2) = ResArray(res:res)
      graphInit(3:3) = CHAR(IAND(maxX,255))
      graphInit(4:4) = CHAR(maxX/256)
      CALL OutPrnStr(Prnport, lineSpace, prnerr)
      IF (PrinterErr(prnerr) .EQ. 0) THEN
        DO WHILE (y .LT. maxY)
          CALL OutPrnStr(Prnport, graphInit, prnerr)
          IF (PrinterErr(prnerr) .EQ. 0) THEN
            DO x = 0, maxX - 1
              CALL GetVertByte(x, y, 8, xm, ym, rv, orient, ch)
              CALL OutPrnChar(Prnport, ch, prnerr)
            END DO
            IF (PrinterErr(prnerr) .NE. 0 ) STOP
            CALL OutPrnStr(Prnport, CR, prnerr)
            y = y + 8
          END IF
        END DO
        CALL OutPrnStr(Prnport, CR, prnerr)
        CALL OutPrnStr(Prnport, endGraph, prnerr)
    ! {Form feed if called for}
        IF (ff .EQ. 0)
     +    CALL OutPrnChar(Prnport, CHAR(12), prnerr)
      END IF
      END !SUBROUTINE

      SUBROUTINE EpsonLQSD(Prnport, res,xm,ym,rv, orient, ff,prnerr)
      INTEGER PrnPort, res, rv, orient, ff, prnerr
      CHARACTER * 80  ResArray, linespace
      CHARACTER * 80 CR,graphInit, endgraph
      CHARACTER ch, ESC
      INTEGER maxX, maxY, x, y, PrinterErr, GetPrnmaxX, GetPrnmaxY
      REAL xm, ym

      ESC = CHAR(27)
      CALL InitStr(lineSpace)
      CALL InitStr(endGraph)
      CALL InitStr(ResArray)
      CALL InitStr(CR)
      CALL InitStr(GraphInit)
      ResArray(1:1) = CHAR(32)
      ResArray(2:2) = CHAR(29)
      ResArray(3:3) = CHAR(38)
      ResArray(4:4) = CHAR(39)
      ResArray(5:5) = CHAR(40)
      maxX = INT((GetPrnmaxX(orient) + 1) * xm)
      maxY = INT((GetPrnmaxY(orient) + 1) * ym)
      prnerr = 0
      IF (res .GT. 8)  res = 1
      IF (res .LT. 5) THEN
         CALL EpsonFXSD(Prnport, res, xm, ym, rv, orient, ff, prnerr)
      ELSE
        res = res - 4
        lineSpace(1:1) = ESC           ! {set line spacing for 8/60}
        linespace(2:2) = 'A'
        linespace(3:3) = CHAR(8)
        endGraph(1:1) = ESC
        endGraph(2:2) = '@'
        CR(1:1) = CHAR(13)
        CR(2:2) = CHAR(10)
        y = 0
        graphInit(1:1) = ESC
        graphInit(2:2) = '*'
        graphInit(3:3) = ResArray(res:res)
        graphInit(4:4) = CHAR(IAND(maxX,255))
        graphInit(5:5) = (maxX/256)
        CALL OutPrnStr(Prnport, lineSpace, prnerr)
        IF (PrinterErr(prnerr) .EQ. 0) THEN
          DO WHILE (y .LT. maxY)
            CALL OutPrnStr(Prnport, graphInit, prnerr)
            IF ( PrinterErr(prnerr) .EQ. 0) THEN
              DO x = 0 , maxX - 1
                DO l = 0 , 2
                  CALL GetVertByte(x, y + l * 8, 8, xm, ym, rv,
     +                             orient, ch)
                  CALL OutPrnChar(Prnport, ch, prnerr)
                END DO
              END DO
              IF (PrinterErr(prnerr) .NE. 0) STOP
              CALL OutPrnStr(Prnport, CR, prnerr)
              y = y + 24
            END IF
          END DO
          CALL OutPrnStr(Prnport, endGraph, prnerr)
        END IF
        IF (ff.EQ. 0)  ! {Form feed if called for}
     +     CALL OutPrnChar(Prnport, CHAR(12), prnerr)
      END IF
      END !SUBROUTINE




      SUBROUTINE EpsonMXSD (Prnport, res,xm,ym,rv, orient, ff,prnerr)
      INTEGER PrnPort, res, rv, orient, ff, prnerr
      CHARACTER * 80  ResArray,  linespace
      CHARACTER * 80 CR,graphInit, endgraph
      CHARACTER ch, ESC
      INTEGER maxX, maxY, x,y, PrinterErr, GetPrnmaxX, GetPrnmaxY
      REAL xm, ym

      ESC = CHAR(27)
      CALL InitStr(lineSpace)
      CALL InitStr(endGraph)
      CALL InitStr(ResArray)
      CALL InitStr(CR)
      CALL InitStr(GraphInit)
      ResArray(1:1) = CHAR(75)
      ResArray(2:2) = CHAR(76)
      ResArray(3:3) = CHAR(89)
      ResArray(4:4) = CHAR(90)

      maxX = INT((GetPrnmaxX(orient) + 1) * xm)
      maxY = INT((GetPrnmaxY(orient) + 1) * ym)
      prnerr = 0
      res = res + 1
      IF (res .GT. 4)  res = 1
      ! { carriage return line feed }
      CR(1:1) = CHAR(13)
      CR(2:2) = CHAR(10)

      lineSpace(1:1) = ESC
      lineSpace(2:2) = 'A'
      lineSpace(3:3) = CHAR(8)
      lineSpace(4:4) = ESC
      lineSpace(5:5) = CHAR(50)  ! {set line spacing for 8/72}
      endGraph(1:1) = ESC
      endgraph(2:2) = 'A'
      endgraph(3:3) = CHAR(12)
      endgraph(4:4) = ESC
      endgraph(5:5) =  CHAR(50)  ! {set line spacing for 12/72}
      y = 0
      graphInit(1:1) = ESC
      graphInit(2:2) = ResArray(res:res)
      graphInit(3:3) = CHAR(IAND(maxX,255))
      graphInit(4:4) = CHAR(maxX/256)
      CALL OutPrnStr(Prnport, lineSpace, prnerr)
      IF (PrinterErr(prnerr) .EQ. 0) THEN
        DO WHILE (y .LT. maxY)
          CALL OutPrnStr(Prnport, graphInit, prnerr)
          IF (PrinterErr(prnerr) .EQ. 0) THEN
            DO x = 0, maxX - 1
              CALL GetVertByte(x, y, 8, xm, ym, rv, orient, ch)
              CALL OutPrnChar(Prnport, ch, prnerr)
            END DO
            IF (PrinterErr(prnerr) .NE. 0) STOP
            CALL OutPrnStr(Prnport, CR, prnerr)
            y = y + 8
          END IF
        END DO
        CALL OutPrnStr(Prnport, CR, prnerr)
        CALL OutPrnStr(Prnport, endGraph, prnerr)
        IF (ff .EQ. 0)         ! {Form feed if called for}
     +    CALL OutPrnChar(Prnport, CHAR(12), prnerr )
      END IF
      END !SUBROUTINE



      SUBROUTINE HPLaserPlusSD(Prnport,res,xm,ym,rv,orient,ff, prnerr)
      INTEGER PrnPort, res, rv, orient, ff, prnerr
      CHARACTER * 80  wstring,ResString,outString
      CHARACTER * 80  endgraph
      CHARACTER ch,ESC
      INTEGER l,maxX, maxY, x, y, GetPrnmaxX, GetPrnmaxY
      REAL length, xm, ym

      ESC = CHAR(27)
      CALL InitStr(wString)
      CALL InitStr(endGraph)
      CALL InitStr(ResString)
      CALL InitStr(OutString)

        SELECT CASE (res)
          CASE (0)
             resString = '100'
          CASE (1)
             resString = '100'
          CASE (2)
             resString = '150'
          CASE (3)
             resString = '300'
          CASE DEFAULT
            CALL resString = '100'
        END SELECT

      endGraph(1:1) = ESC
      endgraph(2:2) = '*'
      endgraph(3:3) = 'r'
      endgraph(4:4) = 'B'

      prnerr = 0
      outString(1:1) = ESC
      outString(2:2) = '*'
      outString(3:3) = 't'
      CALL Concat(outString,resString)
      CALL AddChar(outString,'R')
      CALL OutPrnStr(Prnport, outString, prnerr)
      CALL InitStr(OutString)
      outString(1:1) = ESC
      outString(2:2) = '*'
      outString(3:3) = 'r'
      outString(4:4) = '0'
      outString(5:5) = 'A'

      CALL OutPrnStr(Prnport, outString, prnerr)

      CALL InitStr(OutString)
      maxX = INT((GetPrnmaxX(orient) + 1) * xm)
      maxY = INT((GetPrnmaxY(orient) + 1) * ym)
      l = maxX / 8
      length = INT(l)
      CALL RealToString(length,0,1,wstring)
      outString(1:1) = ESC
      outString(2:2) = '*'
      outString(3:3) = 'b'
      CALL Concat(outstring,wstring)
      CALL AddChar(outstring,'W')
      DO y = 0 , maxY - 1
        ! {Transfer raster graphics}
        CALL OutPrnStr(Prnport, outString, prnerr)
        DO x = 0 , (maxX - 1) / 8
          CALL GetHorizByte(x * 8, y, xm, ym, rv, orient, ch)
          CALL OutPrnChar(Prnport, ch, prnerr)
        END DO
      END DO
      CALL OutPrnStr(Prnport, endGraph, prnerr)     ! {End raster graphics}
      IF (ff .EQ. 0)  ! {Form feed if called for}
     +   CALL OutPrnChar(Prnport, CHAR(12), prnerr)
      END !SUBROUTINE



      SUBROUTINE HPThinkJetSD (Prnport,res,xm,ym,rv,orient,ff,prnerr)
      INTEGER PrnPort, res, rv, orient, ff, prnerr
      CHARACTER * 80  outString, wstring,resString
      CHARACTER * 80 graphInit, endgraph
      CHARACTER ch, ESC
      INTEGER maxX, maxY, x, y, GetPrnmaxX, GetPrnmaxY
      REAL length, xm, ym

      ESC = CHAR(27)

      CALL InitStr(wString)
      CALL InitStr(endGraph)
      CALL InitStr(ResString)
      CALL InitStr(OutString)
      CALL InitStr(graphInit)

      IF (res .EQ. 0) THEN
        ResString = '640'
      ELSE
        ResString = '1280'
      END IF
      maxX = INT((GetPrnmaxX(orient) + 1) * xm)
      maxY = INT((GetPrnmaxY(orient) + 1) * ym)
      endGraph(1:1) = ESC
      endgraph(2:2) = '*'
      endgraph(3:3) = 'r'
      endgraph(4:4) = 'B'
      prnerr = 0
      outString(1:1) = ESC
      outString(2:2) = '*'
      outString(3:3) = 'r'
      CALL concat(outString, ResString )
      CALL AddChar(outString,'S')
      CALL OutPrnStr(Prnport, outString, prnerr)

      outString(1:1) = ESC
      outString(2:2) = '*'
      outString(3:3) = 'r'
      outString(4:4) = 'A'
      CALL OutPrnStr(Prnport, outString, prnerr)
      l = maxX / 8
      length = INT(l)
      CALL RealToString(length,0,1,wstring)
      graphInit(1:1) = ESC
      graphInit(2:2) = '*'
      graphInit(3:3) = 'b'
      CALL Concat(graphInit,wString)
      CALL AddChar(graphInit,'W')
      DO y = 0 , maxY - 1
        CALL OutPrnStr(Prnport, graphInit, prnerr)    ! {Transfer raster graphics}
        DO x = 0 , (maxX - 1) / 8
          CALL GetHorizByte(x * 8, y, xm, ym, rv, orient, ch)
          CALL OutPrnChar(Prnport, ch, prnerr)
        END DO
      END DO
      CALL OutPrnStr(Prnport, endGraph, prnerr)     ! {End raster graphics}
      IF (ff .EQ. 0) CALL OutPrnChar(Prnport, CHAR(12), prnerr)
      END !SUBROUTINE




      SUBROUTINE ToshibaPSD (Prnport, res,xm,ym,rv,orient,ff,prnerr)
      INTEGER PrnPort, res,  rv, orient, ff, prnerr
      CHARACTER * 80  ResArray, linespace
      CHARACTER * 80 graphInit, endgraph, ncol,  CR
      CHARACTER  ESC
      CHARACTER ch
      INTEGER maxX, maxY, x, y, PrinterErr, GetPrnmaxX, GetPrnmaxY
      REAL length, xm, ym

      CALL InitStr(lineSpace)
      CALL InitStr(endGraph)
      CALL InitStr(ResArray)
      CALL InitStr(CR)
      CALL InitStr(ncol)
      CALL InitStr(GraphInit)

      ESC = CHAR(27)
      res = res + 1
      ResArray(1:1) = ';'
      ResArray(2:2) = CHAR(29)
      ResArray(3:3) = ';'
      ResArray(4:4) = ';'
      prnerr = 0
      maxX = INT((GetPrnmaxX(orient) + 1) * xm)
      maxY = INT((GetPrnmaxY(orient) + 1) * ym)

      IF (res .GT. 2) res = 1
        lineSpace(1:1) = ESC
        lineSpace(2:2) = 'L'
        lineSpace(3:3) = '0'
        lineSpace(4:4) = '7'
        endGraph(1:1) = ESC
        endGraph(2:2) = CHAR(26)
        endGraph(3:3) = 'I'
        CR(1:1) = CHAR(13)
        CR(2:2)= CHAR(10)
        y = 0
        length = REAL(maxX)
        CALL RealToString(length,0,4,nCol)
        IF (ncol(1:1) .EQ. ' ' )  ncol(1:1) = '0'
        graphInit(1:1) = ESC
        graphInit(2:2) = ResArray(res:res)
        CALL Concat(graphInit,nCol)
        CALL OutPrnStr(Prnport, lineSpace, prnerr)
        IF (PrinterErr(prnerr) .EQ. 0) THEN
          DO WHILE (y .LT. maxY)
            CALL OutPrnStr(Prnport, graphInit, prnerr)
            IF (PrinterErr(prnerr) .EQ. 0) THEN
              DO x = 0 , maxX - 1
                DO l = 0 , 3
                  CALL GetVertByte(x,y+l*6,6,xm,ym,rv,orient,ch)
                  CALL OutPrnChar(Prnport, ch, prnerr)
                END DO
              END DO
              IF (PrinterErr(prnerr) .NE. 0) STOP
              CALL OutPrnStr(Prnport, CR, prnerr)
              y = y + 24
            END IF
          END DO
          CALL OutPrnStr(Prnport, endGraph, prnerr)
        END IF
        IF (ff .EQ. 0 )
     +    CALL OutPrnChar(Prnport, CHAR(12), prnerr)
        ! {Form feed if called for}

      END !SUBROUTINE





      SUBROUTINE ScreenDump (printer,Prnport,res,xm,ym,
     +    rv, orient, ff,prnerr)
      INCLUDE 'GrafType.FOR'
      INTEGER printer, PrnPort, res, rv, orient, ff, prnerr, gmx, gmy
      CHARACTER * 3 ESC
      REAL xm, ym
      COMMON /ESCCHAR/ ESC
      LOGICAL CRTGraphOnF, PlotterOnF
      COMMON /OnOff/ CRTGraphOnF, PlotterOnF

      IF (CRTGraphOnF) THEN
        ESC = CHAR(27)
        prnerr = 0
        CALL GetMaxCoords( gmx, gmy )
        CALL SetGraphViewport( 0, 0, gmx, gmy )

        SELECT CASE (printer)
          CASE (0)
             CALL EpsonMXSD(Prnport,res,xm, ym, rv, orient, ff, prnerr)
          CASE (1)
             CALL EpsonLQSD(Prnport,res,xm, ym, rv, orient, ff, prnerr)
          CASE (2)
             CALL ToshibaPSD(Prnport,res,xm, ym,rv, orient, ff, prnerr)
          CASE (3)
             CALL HPLaserPlusSD(Prnport,res,xm,ym,rv, orient, ff,prnerr)
          CASE (4)
             CALL HPThinkJetSD(Prnport,res,xm,ym,rv, orient, ff, prnerr)
          CASE (5)
             CALL EpsonFXSD(Prnport,res,xm, ym, rv, orient, ff, prnerr)
          CASE DEFAULT
            CALL EpsonMXSD(Prnport,res,xm, ym, rv, orient, ff, prnerr)
        END SELECT
      END IF


      END !SUBROUTINE

! Enhancement
! 1/23/90 All screen dumps now display in landscape mode
!         xm and ym multipliers now are Real type
! 2/21/90 The screen dump routines were sped up by eliminating redundant
!         multiplies and divides in the GetHorizByte and GetVertByte
!         routines.