C*ACDRIV -- PGPLOT device driver for Acorn Archimedes machines
C+
      SUBROUTINE ACDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MTYPE)
      INTEGER IFUNC, NBUF, LCHR, MTYPE
      REAL    RBUF(*)
      CHARACTER*(*) CHR, DEFNAM
C
C PGPLOT driver for Acorn Archimedes
C This driver will cause the system to leave the Desktop, but leave the 
C screen mode provided it has the normal 16 colours
C
C This routine must be compiled with Acorn Fortran release 2
C and linked with the Fortran Friends graphics, utils and spriteop libraries.
C
C 26 January 1996 : Version 1.10
C 16 May 1996     : Version 1.11 allows concurrent /ARCF and ARCV
C
C Resolution: Depends on graphics mode. Ensure that the current mode is
C suitable before running the PGPLOT program.
C
C version 1.10 also allows the making of the pictures into sprite files
C the default sprite size is the screen size but you may alter the
C number of pixels in x and y with the variables:
C PGPLOT_ARC_WIDTH and PGPLOT_ARC_HEIGHT
C the file names will be sprite/01, sprite/02 etc.
      PARAMETER (DEFNAM = 'sprite/01')
C
C 26 April 1996 : Version 1.11 (changes to /ARCV)
C               - small corrections to the initial screen clearing
C               - allows standard PGPLOT rubber-banded cursors
C---
C             common for communicating with rubber banding GRARC3
      COMMON /GRARCC/ MAXX(2), MAXY(2), I4X0, I4Y0, I4X1, I4Y1, I4MODE
      INTEGER         MAXX,    MAXY,    I4X0, I4Y0, I4X1, I4Y1, I4MODE
C
      INTEGER NXPIX(2), NYPIX(2), MULTX(2), MULTY(2), IXSTEP(2)
      SAVE    NXPIX,    NYPIX,    MULTX,    MULTY,    IXSTEP
      INTEGER NCOLR, NEEDSP, KOLNOW(2), KOLOUR(0:255)
      SAVE    NCOLR, NEEDSP, KOLNOW,    KOLOUR
      LOGICAL INIT, APPEND, FIRSTO, INPICT(2), STATE(2)
      SAVE    INIT, APPEND, FIRSTO, INPICT, STATE
      INTEGER IERR, I4X2, I4Y2, MBUF(2), IREGS(0:9), ISCRR(4)
      LOGICAL SWIERR, SWIF77, SPOP08, SPOP15, LOGDUM
      CHARACTER ANS*4, INSTR*10, SPNAME*9
      DATA    INIT/.TRUE./, STATE/2*.FALSE./
      DATA    KOLOUR/?I00000000, ?IFFFFFF00, ?I0000FF00, ?I00FF0000,
     1               ?IFF000000, ?IFFFF0000, ?IFF00FF00, ?I00FFFF00,
     2               ?I0080FF00, ?I00FF8000, ?I80FF0000, ?IFF800000,
     3               ?IFF008000, ?I8000FF00, ?I50505000, ?IA0A0A000,
     4                240*0/
      IF(INIT .AND. IFUNC.GT.1) THEN
C            check for 16-colour mode
        NCOLR = MODEVAR(-1, 3)
        IF(NCOLR.EQ.63) NCOLR = 255
        IF(NCOLR.EQ.-1) NCOLR = ?IFFFFFF
        IF(NCOLR.LT.15) THEN
        CALL GRWARN('Archimedes driver needs at least 16 colours')
          NBUF = -1
          RETURN
        ENDIF
        INIT = .FALSE.
C           get screen characteristics
        DO 8 MTP = 1, 2
          NXPIX(MTP) = MODEVAR(-1, 11) + 1
          NYPIX(MTP) = MODEVAR(-1, 12) + 1
          IF(MTP.EQ.1) THEN
            MULTX(1) = MODEVAR(-1, 4)
            MULTY(1) = MODEVAR(-1, 5)
          ELSE
            SPNAME = DEFNAM
            CALL GRGENV('ARC_WIDTH', INSTR, L)
            IF(L.GT.0) READ(INSTR, 4)NXPIX(2)
    4       FORMAT(BN, I10)
            CALL GRGENV('ARC_HEIGHT', INSTR, L)
            IF(L.GT.0) READ(INSTR, 4)NYPIX(2)
            MULTX(2) = 1
            MULTY(2) = 1
          ENDIF
          IXSTEP(MTP) = ISHFT(1, MULTX(MTP))
          MAXX(MTP) = ISHFT(NXPIX(MTP), MULTX(MTP))
          MAXY(MTP) = ISHFT(NYPIX(MTP), MULTY(MTP))
          INPICT(MTP) = .FALSE.
    8   CONTINUE
      ENDIF
      IF(IFUNC.GT.9 .AND. .NOT.STATE(MTYPE)) THEN
        CALL GRWARN('Device is not open')
        NBUF = -1
        RETURN
      ENDIF
      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
     1     110,120,130,140,150,160,170,180,190,200,
     2     210,220,230,240,250,260,270,280,290) IFUNC
C            unknown driver function, so just return
      NBUF = -1
      RETURN
C
C--- IFUNC = 1, Return device name.-------------------------------------
C
   10 IF(MTYPE.EQ.1) THEN
        CHR = 'ARCV (screen viewer for Acorn Archimedes machines)'
        LCHR = LNBLNK(CHR)
      ELSEIF(MTYPE.EQ.2) THEN
        CHR = 'ARCF (sprite file for Acorn Archimedes machines)'
        LCHR = LNBLNK(CHR)
      ELSE
        CALL GRWARN('Requested MODE not implemented in Archi driver')
        LCHR = 0
        NBUF = -1
      ENDIF
      RETURN
C
C--- IFUNC = 2, Return physical min and max for plot device, and range
C               of color indices.---------------------------------------
C
   20 CONTINUE
      RBUF(1) = 0
      RBUF(2) = MAXX(MTYPE)
      RBUF(3) = 0
      RBUF(4) = MAXY(MTYPE)
      RBUF(5) = 0
      RBUF(6) = MIN(255, NCOLR)
      NBUF = 6
      RETURN
C
C--- IFUNC = 3, Return device resolution. ------------------------------
C Divide the number of pixels on screen by a typical screen size in
C inches.
C
   30 continue
      RBUF(1) = MAXX(MTYPE)/10.0
      RBUF(2) = RBUF(1)
      RBUF(3) = FLOAT(ISHFT(1, MULTX(MTYPE)))
      NBUF = 3
      RETURN
C
C--- IFUNC = 4, Return misc device info. -------------------------------
C    (This device is Interactive, cursor, No dashed lines, No area fill,
C    No thick lines, rectangle fill)
C
   40 IF(MTYPE.EQ.1) THEN
        CHR = 'ICNNNRPVYN'
      ELSE
        CHR = 'HNNNNRPNYN'
      ENDIF
      LCHR = 10
      NBUF = 0
      RETURN
C
C--- IFUNC = 5, Return default file name. ------------------------------
C
   50 IF(MTYPE.EQ.1) THEN
        CHR = ' '
        LCHR = 1
      ELSE
        CHR = SPNAME
        LCHR = 9
      ENDIF
      RETURN
C
C--- IFUNC = 6, Return default physical size of plot. ------------------
C
   60 CONTINUE
      RBUF(1) = 0
      RBUF(2) = MAXX(MTYPE)
      RBUF(3) = 0
      RBUF(4) = MAXY(MTYPE)
      NBUF = 4
      RETURN
C
C--- IFUNC = 7, Return misc defaults. ----------------------------------
C
   70 RBUF(1) = 1
      NBUF = 1
      RETURN
C
C--- IFUNC = 8, Select plot. -------------------------------------------
C
   80 CONTINUE
      RETURN
C
C--- IFUNC = 9, Open workstation. --------------------------------------
C
   90 CONTINUE
C     -- check for concurrent access
      IF (STATE(MTYPE)) THEN
        CALL GRWARN('Device is already open')
        RBUF(2) = 0
      ELSE
        IF(MTYPE.EQ.1) THEN
C         flag to erase screen on next picture
          FIRSTO = .TRUE.
C         set append flag to suppress screen clearing on subsequent pictures
          APPEND = RBUF(3).NE.0.
        ENDIF
C         flag the workstation active
        STATE(MTYPE) = .TRUE.
C         but not generating picture yet
        INPICT(MTYPE) = .FALSE.
C
        RBUF(2) = 1
      END IF
      RBUF(1) = 0
      NBUF = 2
      RETURN
C
C--- IFUNC = 10, Close workstation. ------------------------------------
C
  100 CONTINUE
C          flag the workstation inactive
      STATE(MTYPE) = .FALSE.
      IF(MTYPE.EQ.1) THEN
C          reset the 16 colour palette
        IF(NCOLR.EQ.15)  CALL VDU(20) 
C          clear the screen
        CALL CLS
      ENDIF
      RETURN
C
C--- IFUNC = 11, Begin picture. ----------------------------------------
C
  110 CONTINUE
      IF(MTYPE.EQ.1 .AND. (.NOT.APPEND .OR. FIRSTO)) THEN
        CALL GRARC2(0, 0, -NCOLR, KOLOUR)
C         remove viewports and clear screen to background colour
        CALL VDU(26)
        CALL CLG
C         home the text cursor
        CALL VDU(30)
C         set foreground text colour
        IF(NCOLR.EQ.15) CALL COLOUR(1)
C         remove pointer
        CALL OSCLI('Pointer 0')
      ENDIF
      FIRSTO = .FALSE.
      IERR=0
      IF(MTYPE.EQ.2) THEN
C          create sprite
        LBPPIX = MODEVAR(-1, 9)
        NBYTES = ISHFT(NXPIX(2)*NYPIX(2), LBPPIX)/8 + 64
C            first ensure there is space in system sprite area
        IF(.NOT.SPOP08(0, ISPSIZ, NSPRIT, ISPR1, IFREE)) THEN
C         case 1, no system sprite area yet
          NEEDSP = NBYTES + 16 + 44
        ELSE
C         case 2, system sprite area exists
C         remove any of our sprites which may have been left by accident
  112     DO 114 ISPRIT = 1, NSPRIT
            CALL SPOP13(0, ISPRIT, INSTR,LENG)
            IF(INSTR(1:7).EQ.'sprite/'.AND.LENG.EQ.9) THEN
              CALL SPOP25(0, INSTR(1:9))
              NSPRIT = NSPRIT -1
              GO TO 112
            ENDIF
  114     CONTINUE
          LOGDUM = SPOP08(0, ISPSIZ, NSPRIT, ISPR1, IFREE)
          NEEDSP = NBYTES + 44 - ISPSIZ + IFREE
        ENDIF
        IERR = 0
        IF(NEEDSP.GT.0) THEN
          IREGS(0) = 3
          IREGS(1) = NEEDSP
          IF(SWIF77(?I2A, IREGS, IFLAG)) IERR = 100
          IF(IERR.EQ.0) THEN
            IF(IREGS(1).GE.NEEDSP) THEN
C              successfully assigned memory
              NEEDSP = IREGS(1)
            ELSE
              IERR = 101
            ENDIF
          ENDIF
        ENDIF
C            create sprite      
        IF(IERR.EQ.0) THEN
          IF(NCOLR.EQ.15) THEN
C                       create it with palette in 16 colour mode
            SWIERR = SPOP15(0, SPNAME, 1, NXPIX(2), NYPIX(2), 27)
          ELSEIF(NCOLR.EQ.255) THEN
            SWIERR = SPOP15(0, SPNAME, 0, NXPIX(2), NYPIX(2), 28)
          ELSE
C             create sprite 'mode word' (PRM 5-87)
            MODEW = IOR(?I1680B5, ISHFT(LBPPIX + 1, 27))
            SWIERR = SPOP15(0, SPNAME, 0, NXPIX(2), NYPIX(2), MODEW)
          ENDIF
          IF(SWIERR) IERR = 103
          IF(IERR.EQ.0) CALL GRWARN('creating sprite '//SPNAME)
        ENDIF
        IF(IERR.NE.0) THEN
          CALL GRGMSG(IERR)
          CALL GRWARN('Failed to allocate plot buffer.')
C              failed to get enough memory so return it 
          IF(IERR.GT.100) THEN
            IREGS(1) = -IREGS(1)
            IF(SWIF77(?I2A, IREGS, IFLAG)) THEN
              IERR = 101
            ELSE
              IERR = 102
            ENDIF
          ENDIF
        ENDIF
      ENDIF
C            set up colours
      IF(IERR.EQ.0) THEN
        IF(NCOLR.EQ.15) THEN
          DO 118 I = 0, 15
            IF(MTYPE.EQ.2) THEN
              CALL GRARC1(SPNAME, I, KOLOUR(I))
            ELSE
              CALL VDU19(I, 16, 
     1        IAND(ISHFT(KOLOUR(I), -8), 255),
     2        IAND(ISHFT(KOLOUR(I), -16), 255),
     3        ISHFT(KOLOUR(I), -24))
            ENDIF
  118     CONTINUE
        ELSEIF(MTYPE.EQ.2) THEN
C             clear 255 colour sprite to background colour
          CALL SPOP60(0, SPNAME, 0, ISCRR)
          CALL GRARC2(0, 0, -NCOLR, KOLOUR)
          CALL CLG
          CALL NPOP60(ISCRR)
        ENDIF
      ENDIF
      IF(IERR.EQ.0) INPICT(MTYPE) = .TRUE.
      RETURN
C
C--- IFUNC = 12, Draw line. --------------------------------------------
C
  120 CONTINUE
      IF(INPICT(MTYPE)) THEN
        IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR)
        CALL GRARC2(0, KOLNOW(MTYPE), NCOLR, KOLOUR)
        CALL LINE(NINT(RBUF(1)), NINT(RBUF(2)),
     1            NINT(RBUF(3)), NINT(RBUF(4)))
        IF(MTYPE.EQ.2) CALL NPOP60(ISCRR)
      ENDIF
      RETURN
C
C--- IFUNC = 13, Draw dot. ---------------------------------------------
C
  130 CONTINUE
      IF(INPICT(MTYPE)) THEN
        IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR)
        CALL GRARC2(0, KOLNOW(MTYPE), NCOLR, KOLOUR)
        CALL SPOT(NINT(RBUF(1)), NINT(RBUF(2)))
        IF(MTYPE.EQ.2) CALL NPOP60(ISCRR)
      ENDIF
      RETURN
C
C--- IFUNC = 14, End picture. ------------------------------------------
C
  140 CONTINUE
      IF(INPICT(MTYPE).AND.MTYPE.EQ.2) THEN
C              write out sprite
        CALL SPOP12(0, SPNAME)
C              delete sprite
        CALL SPOP25(0, SPNAME)
C              update sprite name
        I = ICHAR(SPNAME(9:9)) + 1
        IF(I.LT.58) THEN
          SPNAME(9:9) = CHAR(I)
        ELSE
          SPNAME(8:9) = CHAR(ICHAR(SPNAME(8:8)) + 1)//'0'
        ENDIF
C                give back memory
        IF(NEEDSP.GT.0) THEN
          IREGS(0) = 3
          IREGS(1) = -NEEDSP
          IF(SWIF77(?I2A, IREGS, IFLAG)) THEN
            CALL GRGMSG(104)
            CALL GRWARN('Failed to deallocate plot buffer.')
          ENDIF
        ENDIF
      ENDIF
      INPICT(MTYPE) = .FALSE.
      RETURN
C
C--- IFUNC = 15, Select color index. -----------------------------------
  150 CONTINUE
      KOLNOW(MTYPE) = NINT(RBUF(1))
      RETURN
C
C--- IFUNC = 16, Flush buffer. -----------------------------------------
C
  160 CONTINUE
      RETURN
C
C--- IFUNC = 17, Read cursor. ------------------------------------------
C
  170 CONTINUE
      IF(MTYPE.EQ.2) RETURN
C             display pointer
      CALL OSCLI('Pointer')
C             wait until button(s) and keys are released
  172 CALL MOUSE(I4X0, I4Y0, I4B)
      IF(I4B.NE.0 .OR. INKEY(0).GT.0) GO TO 172
C             move to desired place
      I4X0 = NINT(RBUF(1))
      I4Y0 = NINT(RBUF(2))
      MBUF(1) = 5 + IOR(ISHFT(I4X0, 8), ISHFT(I4Y0, 24))
      MBUF(2) = ISHFT(I4Y0, -8)
      CALL OSWORD(21, MBUF)
C             anchor position
      I4X1 = NINT(RBUF(3))
      I4Y1 = NINT(RBUF(4))
C             band mode
      I4MODE = NINT(RBUF(5))
C             initial band
      IF(I4MODE.GT.0) THEN
C             set colour of banding
        CALL GRARC2(3, KOLNOW(MTYPE), NCOLR, KOLOUR)
        CALL GRARC3
      ENDIF
C             loop and wait for keystroke/button click
  174 CONTINUE
C             get mouse pointer status
      CALL MOUSE(I4X2, I4Y2, I4B)
C             check for key press
      KEY = INKEY(0)
C             'select' = 'A'
      IF(I4B.EQ.4) KEY = 65
C             'menu'   = 'D'
      IF(I4B.EQ.2) KEY = 68
C             'adjust' = 'X'
      IF(I4B.EQ.1) KEY = 88
      IF(I4MODE.GT.0) THEN
        IF(I4X2.NE.I4X0 .OR. I4Y2.NE.I4Y0) THEN
C            wait for frame scan
          CALL OSBYTE(19,0,0)
C            clear the old band
          CALL GRARC3
C            move the band
          I4X0 = I4X2
          I4Y0 = I4Y2
C            draw the new band
          CALL GRARC3
        ENDIF
      ENDIF
      IF(KEY.LE.0) GO TO 174
C             erase final band
      IF(I4MODE.GT.0) CALL GRARC3
C             return current position
      RBUF(1) = FLOAT(I4X2)
      RBUF(2) = FLOAT(I4Y2)
      NBUF = 2
C             and character
      CHR(1:1)  = CHAR(KEY)
      LCHR = 1
      RETURN
C
C--- IFUNC = 18, Erase alpha screen. -----------------------------------
C
  180 CONTINUE
      RETURN
C
C--- IFUNC = 19, Set line style. ---------------------------------------
C
  190 CONTINUE
      RETURN
C
C--- IFUNC = 20, Polygon fill. -----------------------------------------
C
  200 CONTINUE
      RETURN
C
C--- IFUNC = 21, Set color representation. -----------------------------
C
  210 CONTINUE
      ICOL = NINT(RBUF(1))
      IRED = NINT(RBUF(2)*255.)
      IGRN = NINT(RBUF(3)*255.)
      IBLU = NINT(RBUF(4)*255.)
      KOLOUR(ICOL) = ISHFT(IBLU, 24) + ISHFT(IGRN, 16) + ISHFT(IRED, 8)
      IF(NCOLR.EQ.15.AND.INPICT(MTYPE)) THEN
        IF(MTYPE.EQ.2) THEN
          CALL GRARC1(SPNAME, ICOL, KOLOUR(ICOL))
        ELSE 
          CALL VDU19(ICOL, 16, IRED, IGRN, IBLU)
        ENDIF
      ENDIF
      RETURN
C
C--- IFUNC = 22, Set line width. ---------------------------------------
C
  220 CONTINUE
      RETURN
C
C--- IFUNC = 23, Escape. -----------------------------------------------
C
  230 CONTINUE
      RETURN
C
C--- IFUNC = 24, Rectangle fill. ---------------------------------------
C
  240 CONTINUE
      IF(INPICT(MTYPE)) THEN
        IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR)
        CALL GRARC2(0, KOLNOW(MTYPE), NCOLR, KOLOUR)
        CALL RECTAN(NINT(RBUF(1)), NINT(RBUF(2)),
     1              NINT(RBUF(3)), NINT(RBUF(4)), .TRUE.)
        IF(MTYPE.EQ.2) CALL NPOP60(ISCRR)
      ENDIF
      RETURN
C
C--- IFUNC = 25, Set fill pattern. -------------------------------------
C
  250 CONTINUE
      RETURN
C
C--- IFUNC = 26, Line of pixels. ---------------------------------------
C
  260 CONTINUE
      IF(.NOT.INPICT(MTYPE)) RETURN
      IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR)
      IX = NINT(RBUF(1))
      IY = NINT(RBUF(2))
      K1 = NINT(RBUF(3))
      IX1 = IX
      DO 264 I = 3 + IXSTEP(MTYPE), NBUF, IXSTEP(MTYPE)
        K2 = NINT(RBUF(I))
        IF(K1.NE.K2) THEN
          CALL GRARC2(0, K1, NCOLR, KOLOUR)
          IF(IX.EQ.IX1) THEN
            CALL SPOT(IX, IY)
          ELSE
            CALL LINE(IX1, IY, IX, IY)
          ENDIF
          K1 = K2
          IX1 = IX + IXSTEP(MTYPE)
        ENDIF
        IX = IX + IXSTEP(MTYPE)
  264 CONTINUE
      CALL GRARC2(0, K2, NCOLR, KOLOUR)
      IF(IX.EQ.IX1) THEN
        CALL SPOT(IX, IY)
      ELSE
        CALL LINE(IX1, IY, IX, IY)
      ENDIF
      IF(MTYPE.EQ.2) CALL NPOP60(ISCRR)
      RETURN
C
C--- IFUNC = 27, Not implemented ---------------------------------------
C
  270 CONTINUE
      RETURN
C
C--- IFUNC = 28, Not implemented ---------------------------------------
C
  280 CONTINUE
      RETURN
C
C--- IFUNC = 29, Query color representation. ---------------------------
C
  290 CONTINUE
      I = RBUF(1)
      RBUF(2) = IAND(ISHFT(KOLOUR(I),  -8), 255)/255.0
      RBUF(3) = IAND(ISHFT(KOLOUR(I), -16), 255)/255.0
      RBUF(4) = IAND(ISHFT(KOLOUR(I), -24), 255)/255.0
      NBUF = 4
      RETURN
C-----------------------------------------------------------------------
      END
C
      SUBROUTINE GRARC1(SPNAME, I, KOL)
      DIMENSION IREGS(0:9)
      CHARACTER *(*) SPNAME, NAME*12
      EQUIVALENCE(IPP, IREGS(4))
      LOGICAL SWIF77
C           set sprite palette I to KOL (Only in RISC-OS 3)
      NAME = SPNAME
      L = LNBLNK(NAME)
      NAME(L+1:L+1) = CHAR(0)
      IREGS(0) = 37
      IREGS(1) = 0
      IREGS(2) = LOCC(NAME)
      IREGS(3) = -1
C          do SpriteOp 37
      IF(SWIF77(?I2E, IREGS, IFLAG))RETURN
      IF(IPP.EQ.0) RETURN
      IOFF = (IPP - LOC(IREGS))/4
C         address of palette is now IREGS(IOFF)
      KK = IOR(16, IAND(KOL, ?IFFFFFF00))
      IREGS(IOFF+I+I) = KK
      IREGS(IOFF+I+I+1) = KK
      RETURN
      END
C
      SUBROUTINE GRARC2(IACT, KOLNOW, NCOLR, KOLOUR)
C              set up currrent graphics colour and action
      DIMENSION IREGS(0:9), KOLOUR(0:255)
      IF(IABS(NCOLR).EQ.15) THEN
        IF(NCOLR.GT.0) THEN
          CALL GCOL(IACT, KOLNOW)
        ELSE
          CALL GCOL(IACT, KOLNOW + 128)
        ENDIF
      ELSE
        IREGS(0) = KOLOUR(KOLNOW)
        IREGS(3) = 0
        IF(NCOLR.LT.0) IREGS(3)=128
        IREGS(4) = IACT
C              do ColourTrans_SetGCOL
        CALL SWIF77(?I040743, IREGS, IFLAG)
      ENDIF
      RETURN
      END
C
      SUBROUTINE GRARC3
C             common for communicating with rubber banding GRARC3
      COMMON /GRARCC/ MAXX(2), MAXY(2), I4X0, I4Y0, I4X1, I4Y1, I4MODE
      INTEGER         MAXX,    MAXY,    I4X0, I4Y0, I4X1, I4Y1, I4MODE
C             only used for MTYPE=1, i.e. MAXX(1) and MAXY(1)
C
C             draw band of type I4MODE from (I4X1,I4Y1) to (I4X0,I4Y0)
C     I4MODE = 1: ordinary rubber band
C              2: rectangular box
C              3: horizontal lines
C              4: vertical lines
C              5: horizontal line through (I4X0,I4Y0) only
C              6: vertical line through (I4X0,I4Y0) only
C              7: vertical and horizontal lines through (I4X0,I4Y0) only
C
      GO TO (10, 20, 30, 40, 32, 42, 70), I4MODE
      RETURN
C               ordinary rubber band
   10 CALL LINE(I4X1, I4Y1, I4X0, I4Y0)
      RETURN
C               rectangular box
   20 CALL RECTAN(I4X1, I4Y1, I4X0, I4Y0, .FALSE.)
      RETURN
C               horizontal lines
   30 CALL LINE(0, I4Y1, MAXX, I4Y1)
   32 CALL LINE(0, I4Y0, MAXX, I4Y0)
      RETURN
C               vertical lines
   40 CALL LINE(I4X1, 0, I4X1, MAXY)
   42 CALL LINE(I4X0, 0, I4X0, MAXY)
      RETURN
C               vertical and horizontal lines through (I4X0,I4Y0) only
   70 CALL LINE(0, I4Y0, MAXX, I4Y0)
      GO TO 42
      END