C     NAME: COLOUR
C
C    LANGUAGE:  FORTRAN
C
C    OPERATING SYSTEM:  UNIVERSAL
C
C    ORDER NUMBER:  5428-SE
C
C    PART NUMBER:  000-026366  NOVEMBER 1985
C
C    PRODUCT:  UNIVERSAL VERSAPLOT COLOR RANDOM 2.0
C
C    VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051
C    A XEROX COMPANY
C
C    Copyright (C) 1985 by Xerox Corporation.  All rights reserved.
C
C    "NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC,
C    INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED
C    LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO
C    PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE
C    REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE
C    THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF
C    VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE
C    AGREEMENT.  THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER
C    THE COPYRIGHT ACT OF 1976."
C
C
C
C... MODIFIED TO ALLOW PLACEMENT OF PLOTTED COLOR PAGES
C
C... DRAW COLOUR TEST CHART
C
C... DEFINE VPOPT VARIABLES
      DIMENSION IARG(4), RARG(4)
C
C... FIND WHICH PLOTTER MODEL IS BEING USED
      WRITE(6,9505)
 9505 FORMAT (1X,32H ENTER PLOTTER MODEL BEING USED )
      READ (5,9506) IPLTR
 9506   FORMAT (I5)
C
C... SET PLACEMENT OF SECOND PAGE
      BX2 = 0.0
      BY2 = 8.5
C... SET PLACEMENT OF THIRD PAGE
      BX3 = 15.
        BY3 = 0.0
C
C... SET PLACEMENT OF FOURTH PAGE
      BX4 = 15.
      BY4 = 8.5
C
C... IF 11" COLOR PLOTTER IS USED SET EACH PAGE PLACEMENT AT 0.,0.
      IF (IPLTR .NE. 3211) GO TO 10
         BX2 = 0.0
         BY2 = 0.0
         BX3 = 0.0
         BY3 = 0.0
         BX4 = 0.0
         BY4 = 0.0
C
C... INITIALIZE COLOUR SOFTWARE
10    CALL VPOPT (101,0,0.0,IERROR)
C
C    IF A PLOTTER MODEL OTHER THAN 9242 IS BEING USED
C... CALL VPOPT WITH THE NEW RDENS AND IBYTES
      IF (IPLTR .EQ. 9242) GO TO 40
C
C... CHECK IF ITS A 24 INCH PLOTTER
          IF (IPLTR .NE. 3224) GO TO 20
             IARG(1) = 3224
             IARG(2) = 564
             RARG(1) = 200.
             CALL VPOPT(1,IARG,RARG,IER)
C
C... IF ITS 24" WE NEED TO MAKE THE PAPER LONGER ALSO
             RARG(1) = 0.
             RARG(2) = 40.
             RARG(3) = 0.
             RARG(4) = 22.56
             CALL VPOPT(2,IARG,RARG,IER)
C
C... CHECK IF ITS A 36" PLOTTER
20        IF (IPLTR .NE. 3236) GO TO 30
             IARG(1) = 3236
             IARG(2) = 856
             RARG(3) = 200.
             CALL VPOPT(1,IARG,RARG,IER)
C
C... INCREASE THE DEFAULT PAPER IN X DIRECTION
             RARG(1) = 0.
             RARG(2) = 40.
             RARG(3) = 0.
             RARG(4) = 34.
             CALL VPOPT(2,IARG,RARG,IER)
C
C... CHECK IF ITS 11" PLOTTER
30        IF (IPLTR .NE. 3211) GO TO 40
             IARG(1) = 3211
             IARG(2) = 264
             RARG(1) = 200.
             CALL VPOPT(1,IARG,RARG,IER)
             RARG(1) = 0.
             RARG(2) = 17.
             RARG(3) = 0.
             RARG(4) = 10.5
             CALL VPOPT(2,IARG,RARG,IER)
C
C... INITIALIZE PLOTTING SOFTWARE
40    CALL PLOTS (0,0,0)
C
C... INTIALIZE PEN COLOURS
      CALL DEFPEN (2,1,0,0,0,0)
      CALL PENCLR (2,2)
      CALL DEFPEN (3,1,0,0,0,0)
      CALL PENCLR (3,3)
      CALL DEFPEN (4,1,0,0,0,0)
      CALL PENCLR (4,4)
C
C... DRAW START OF PLOT MARKER
      CALL DRMRK
C
C... DRAW FIRST PAGE
      CALL DRBOX1
      IF (IPLTR .EQ. 3211) CALL PLOT(0.,0.,-999)
C
C... DRAW SECOND PAGE
      CALL DRBOX2 (BX2,BY2)
      IF (IPLTR .EQ. 3211) CALL PLOT (0.,0.,-999)
C
C... DRAW THIRD PAGE
      CALL DRBOX3 (BX3,BY3)
      IF (IPLTR .EQ. 3211) CALL PLOT(0.,0.,-999)
C
C... DRAW FOURTH PAGE
      CALL DRBOX4 (BX4,BY4)
C
C... TERMINATE PLOTTING
      CALL PLOT (0.,0.,999)
      STOP
      END
      SUBROUTINE DRBOX1
C
C... LOCAL DATA
      DIMENSION ICLR1(9),ICLR3(9)
      DIMENSION LABEL(9),LENGTH(9)
C
      DATA ICLR1 /2,5,3,6,4,7,9,8,1/
      DATA ICLR3 /3,1,4,2,1,3,2,4,3/
      DATA LABEL /4HC   ,4HCM=B,4HM   ,4HMY=R,
     *                  4HY   ,4HYC=G,4HW   ,4HCMY ,4HD   /
      DATA LENGTH /1,4,1,4,1,4,1,3,1/
C
C... SET PEN TO 1
      CALL NEWPEN (1)
C
C... DRAW BOX OUTLINE
      CALL DROTLN (0.,0.)
C
C... DRAW HEADING ON PAGE
      CALL DRHDNG (0.,0.,1)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... FOR BOX 1
      CALL NUMBER (2.1,5.18,0.2,1.,90.0,-1)
      CALL CIRCLE (2.0,5.25,-0.2,2)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... SET TO USE TONE COLOUR FOR TONING
      CALL TONFLG (1)
C
C... DRAW SQUARES INSIDE PAGE 1
      DO 10 I = 1,6
         X = 15.0 - (FLOAT(I) * 1.5)
         XX = (X - 0.625) + (FLOAT(LENGTH(I)) * 0.06)
         CALL SQAURL (X,2.0,ICLR1(I))
         CALL SYMBOL (XX,1.9,0.12,LABEL(I),180.0,LENGTH(I))
         IF (I .LT. 4) GO TO 10
         XX = (X - 0.625) + (FLOAT(LENGTH(I + 3)) * 0.06)
         CALL SQAURL (X,6.0,ICLR1(I + 3))
         CALL SYMBOL (XX,5.9,0.12,LABEL(I + 3),180.0,LENGTH(I + 3))
   10 CONTINUE
C
C... DRAW COMMENTS BOX ON PAGE 1
      CALL PLOT (13.5,5.5,3)
      CALL PLOT (13.5,9.0,2)
      CALL PLOT (9.5,9.0,2)
      CALL PLOT (9.5,5.5,2)
      CALL PLOT (13.5,5.5,2)
      CALL SYMBOL (9.75,5.6,.12,9HCOMMENTS:,90.0,9)
      CALL WHERE (X,Y,F)
      CALL PLOT (9.8,Y,3)
      CALL PLOT (9.8,5.6,2)
C  DRAW PLUS SIGNS ON PAGE 1
      DO 40 I = 1,31,2
         DO 30 II = 1,2
            III = I + II - 1
            ICLR = MOD (III,8) + 1
            Y = (FLOAT(III) * 0.25) + 1.125
            IF (II .NE. 1) GO TO 20
               CALL PLUS (4.5,Y,ICLR3(ICLR))
               CALL DPLUS (4.25,Y,ICLR3(ICLR + 1))
            GO TO 30
20             CALL PLUS (4.25,Y,ICLR3(ICLR + 1))
               CALL DPLUS (4.5,Y,ICLR3(ICLR))
30       CONTINUE
40    CONTINUE
      DO 70 I = 1,35,2
         DO 60 II = 1,2
            III = I + II - 1
            ICLR = MOD (III,8) + 1
            X = (FLOAT(III) * 0.25) + 4.5
            IF (II .NE. 1) GO TO 50
               CALL PLUS (X,1.625,ICLR3(ICLR + 1))
               CALL DPLUS (X,1.375,ICLR3(ICLR))
            GO TO 60
50             CALL PLUS (X,1.375,ICLR3(ICLR))
               CALL DPLUS (X,1.625,ICLR3(ICLR + 1))
60       CONTINUE
70    CONTINUE
      RETURN
      END
      SUBROUTINE DRBOX2 (XPOS,YPOS)
C
C... SET PEN TO 1
      CALL NEWPEN (1)
C
C... DRAW BOX OUTLINE
      CALL DROTLN (XPOS,YPOS)
C
C... DRAW HEADING ON PAGE
      CALL DRHDNG (XPOS,YPOS,2)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... NUMBER PAGE 2
      X = XPOS + 2.0
      Y = YPOS + 5.18
      CALL NUMBER (X+0.1,Y,0.2,2.,90.0,-1)
      CALL CIRCLE (X,Y+0.07,-0.2,2)
      CALL SYMBOL (X+0.7,Y,0.2,1HC,90.0,1)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... SET TO USE TONE COLOUR FOR TONING
      CALL TONFLG (1)
C
      CALL DRSQRS (XPOS,YPOS,2)
      CALL DRNBRS (XPOS,YPOS)
      CALL DRLBLS (XPOS,YPOS,2)
      CALL DRPLUS (XPOS,YPOS)
      RETURN
      END
      SUBROUTINE DRBOX3 (XPOS,YPOS)
C
C... SET PEN TO 1
      CALL NEWPEN (1)
C
C... DRAW BOX OUTLINE
      CALL DROTLN (XPOS,YPOS)
C
C... DRAW HEADING ON PAGE
      CALL DRHDNG (XPOS,YPOS,3)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... NUMBER PAGE 3
      X = XPOS + 2.0
      Y = YPOS + 5.18
      CALL NUMBER (X+0.1,Y,0.2,3.,90.0,-1)
      CALL CIRCLE (X,Y+0.07,-0.2,2)
      CALL SYMBOL (X+0.7,Y,0.2,1HM,90.0,1)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... SET TO USE TONE COLOUR FOR TONING
      CALL TONFLG (1)
C
      CALL DRSQRS (XPOS,YPOS,3)
      CALL DRNBRS (XPOS,YPOS)
      CALL DRLBLS (XPOS,YPOS,3)
      CALL DRPLUS (XPOS,YPOS)
      RETURN
      END
      SUBROUTINE DRBOX4 (XPOS,YPOS)
C
C... SET PEN TO 1
      CALL NEWPEN (1)
C
C... DRAW BOX OUTLINE
      CALL DROTLN (XPOS,YPOS)
C
C... DRAW HEADING ON PAGE
      CALL DRHDNG (XPOS,YPOS,4)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... NUMBER PAGE 4
      X = XPOS + 2.0
      Y = YPOS + 5.18
      CALL NUMBER (X+0.1,Y,0.2,4.,90.0,-1)
      CALL CIRCLE (X,Y+0.07,-0.2,2)
      CALL SYMBOL (X+0.7,Y,0.2,1HY,90.0,1)
C
C... SET TO USE PEN COLOUR
      CALL TONFLG (0)
C
C... SET TO USE TONE COLOUR FOR TONING
      CALL TONFLG (1)
C
      CALL DRSQRS (XPOS,YPOS,4)
      CALL DRNBRS (XPOS,YPOS)
      CALL DRLBLS (XPOS,YPOS,4)
      CALL DRPLUS (XPOS,YPOS)
      RETURN
      END
      SUBROUTINE DRHDNG (XPOS,YPOS,IPAGE)
C
C  DRAW HEADINGS ON PAGE
      XX = XPOS + 3.45
      YY = YPOS + 1.25
      Y = YY
      CALL SYMBOL (XX,Y,0.12,5HDATE:,90.0,5)
      CALL BLANK  (XX,Y,0.75)
      CALL SYMBOL (XX,Y,0.12,4H SN:,90.0,4)
      CALL BLANK  (XX,Y,1.0)
      CALL SYMBOL (XX,Y,0.12,6H PAPER,90.0,6)
      CALL BLANK  (XX,Y,1.25)
      CALL SYMBOL (XX,Y,0.12,3H BY,90.0,3)
      CALL BLANK  (XX,Y,1.25)
      CALL SYMBOL (XX,Y,0.12,6H PAGE ,90.0,6)
      CALL NUMBER (999.0,999.0,0.12,FLOAT(IPAGE),90.0,-1)
      CALL SYMBOL (999.0,999.0,0.12,5H OF 4,90.0,5)
      CALL SYMBOL (XX+0.45,YY,0.12,6HTONERS,90.0,6)
      DO 10 IBLANK = 1,4
         CALL WHERE (X,Y,F)
         CALL PLOT  (X,Y+0.25,3)
         CALL PLOT  (X,Y+1.5,2)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE DRSQRS (XPOS,YPOS,IPAGE)
C
C... LOCAL DATA
      DIMENSION ICLR1(9),ICLR2(12)
C
      DATA ICLR1 /2,5,3,6,4,7,9,8,1/
      DATA ICLR2 /61,39,17,210,188,180,172,150,128,106,84,69/
C
C... DRAW SQUARES
      DO 10 I = 1,5
      X = 5.25 + (FLOAT(I-1) * 2.0) + XPOS
      DO 10 J = 1,4
         JJ = ((J-1) * 175) + 100
         Y = (FLOAT(JJ) / 100.0) + 1.0 + YPOS
         ICLR = ICLR2(((IPAGE - 2) * 4) + (J-1) + 1) +
     *                (IFIX(FLOAT(I-1) * 1.5))
         IF (I .EQ. 3 .AND. J .EQ. 1)
     *            ICLR = ICLR1(((IPAGE - 2) * 2) + 1)
         IF (I .EQ. 3 .AND. J .EQ. 3)
     *            ICLR = ICLR1(((IPAGE - 2) * 2) + 2)
         CALL SQUARE (X,Y,ICLR,IPAGE)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE DRNBRS (XPOS,YPOS)
C
C... NUMBER ROWS 1-4
      Y = 1.75 + YPOS
      DO 10 N = 1,4
         NN = N * 2
         IF (N .GE. 3) NN = NN + 2
         X = 2.685 + FLOAT(NN) + XPOS
         CALL NUMBER (X,Y,.12,FLOAT(N),90.0,-1)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE DRLBLS (XPOS,YPOS,IPAGE)
C
C... LOCAL DATA
      DIMENSION LABEL(7)
C
      DATA LABEL /67,66,77,82,89,71,67/
C
C... LABEL CENTER COLOUR BOXES
      XX  = 8.685 + XPOS
      XX1 = 8.585 + XPOS
      XX2 = 8.785 + XPOS
      DO 30 N = 1,2
         II = ((IPAGE - 2) * 2) + N
         DO 20 NN = 1,2
            NNN = ((N-1) * 2) + NN
            Y = (FLOAT(NNN) * 1.75) + YPOS
            IF (NN .NE. 1) GO TO 10
               CALL SYMBOL (XX,Y,0.12,LABEL(II),90.0,1)
            GO TO 20
10             CALL SYMBOL (XX1,Y,0.12,LABEL(II),90.0,1)
               CALL SYMBOL (XX2,Y,0.12,LABEL(II+1),90.0,1)
20       CONTINUE
30    CONTINUE
      RETURN
      END
      SUBROUTINE DRPLUS (XPOS,YPOS)
C
C... DRAW PLUS SIGNS ON PAGES 2-4
C
C... LOCAL DATA
      INTEGER ICLR3(9)
C
      DATA ICLR3 /3,1,4,2,1,3,2,4,3/
C
      Y = YPOS
      DO 30 I = 1,37,2
         DO 20 II = 1,2
            III = I + II - 1
            ICLR = MOD (III,8) + 1
            X = (FLOAT(III) * 0.25) + 4.0 + XPOS
            IF (II .NE. 1) GO TO 10
               CALL PLUS  (X,Y+1.25,ICLR3(ICLR))
               CALL DPLUS (X,Y+1.5,ICLR3(ICLR + 1))
               CALL PLUS  (X,Y + 9.0,ICLR3(ICLR))
            GO TO 20
10             CALL DPLUS (X,Y + 1.25,ICLR3(ICLR))
               CALL PLUS  (X,Y + 1.5,ICLR3(ICLR + 1))
               CALL DPLUS (X,Y + 9.0,ICLR3(ICLR))
20       CONTINUE
30    CONTINUE
      RETURN
      END
      SUBROUTINE BLANK (X,Y,D)
C  DRAW A BLANK OF LENGTH D AND THEN UPDATE Y
      CALL WHERE (XX,Y,F)
      CALL PLOT (X,Y+D,2)
      CALL WHERE (XX,Y,F)
      RETURN
      END
      SUBROUTINE SQAURL (X,Y,ICLR)
C  SPECIAL VERSION OF SUBROUTINE SQUARE WHICH DRAWS A SQUARE
C   AND ALSO DRAWS 7 LINES TO THE RIGHT OF IT.
      DIMENSION ITEXT(8)
C     116,'L','A','B','X','Y','%',0
      DATA ITEXT/116,76,65,66,88,89,37,0/
      CALL SQUARE (X,Y,ICLR,1)
      DO 100 I = 1,7
      YY = Y + 1.25 + (FLOAT(I) * 0.25)
      CALL PLOT (X - 0.15,YY,3)
      CALL PLOT (X - 1.1,YY,2)
      CALL SYMBOL (X,YY,0.12,ITEXT(I),180.0,1)
100   CONTINUE
      RETURN
      END
      SUBROUTINE SQUARE (X,Y,ICLR,IPAGE)
C  DRAW A 1.25 X 1.25 SQUARE WITH LOWER LEFT CORNER AT (X,Y)
      DIMENSION XA(4),YA(4)
      XA(1) = X
      XA(2) = X
      XA(3) = X - 1.25
      XA(4) = XA(3)
      YA(1) = Y
      YA(2) = Y + 1.25
      YA(3) = YA(2)
      YA(4) = Y
      CALL TONCLR (ICLR)
      CALL CONVEX (XA,YA,-4)
      IF (IPAGE .NE. 1) GO TO 10
         XX = X + 0.1
      GO TO 20
10       XX = X + 0.25
         CALL PLOT (XX,Y + 0.15,3)
         CALL PLOT (XX,Y + 1.1,2)
         CALL SYMBOL (XX,Y,0.12,116,90.0,1)
         XX = X + 0.35
20    CALL SYMBOL (XX,Y,0.07,13HCOLOR NUMBER ,90.0,13)
      CALL NUMBER (999.0,999.0,0.07,FLOAT(ICLR),90.0,-1)
      RETURN
      END
      SUBROUTINE PLUS(X,Y,ICLR)
C  DRAW A PLUS CENTERED AT (X,Y) USING COLOUR ICLR
      CALL NEWPEN (ICLR)
      CALL PLOT (X - 0.125,Y,3)
      CALL PLOT (X + 0.115,Y,2)
      CALL PLOT (X,Y - 0.125,3)
      CALL PLOT (X,Y + 0.115,2)
      RETURN
      END
      SUBROUTINE DPLUS(X,Y,ICLR)
C  DRAW A DOUBLE-PLUS CENTERED AT (X,Y) USING COLOUR ICLR
      CALL NEWPEN (ICLR)
      CALL PLOT (X - 0.125,Y - 0.005,3)
      CALL PLOT (X + 0.115,Y - 0.005,2)
      CALL PLOT (X - 0.125,Y + 0.005,3)
      CALL PLOT (X + 0.115,Y + 0.005,2)
      CALL PLOT (X - 0.005,Y - 0.125,3)
      CALL PLOT (X - 0.005,Y + 0.115,2)
      CALL PLOT (X + 0.005,Y - 0.125,3)
      CALL PLOT (X + 0.005,Y + 0.115,2)
      RETURN
      END
      SUBROUTINE DROTLN (XPOS,YPOS)
C
      REAL X(5),Y(5)
C
      X(1) = XPOS + 3.0
      Y(1) = YPOS + 1.0
      X(2) = X(1)  + 11.0
      Y(2) = Y(1)
      X(3) = X(2)
      Y(3) = Y(1) + 8.5
      X(4) = X(1)
      Y(4) = Y(3)
      X(5) = X(1)
      Y(5) = Y(1)
C
      CALL PLOT (X(1),Y(1),3)
      DO 10 I = 2,5
         CALL PLOT (X(I),Y(I),2)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE DRMRK
      DATA LABEL3 /127/
C
C...  DRAW LINE AT TOP OF PLOT IN ALL 4 COLOURS AND LABEL
      DO 50 I = 1,4
      CALL NEWPEN (5 - I)
      CALL PLOT (0.0,0.0,3)
      CALL PLOT (0.0,2.0,2)
50    CONTINUE
      CALL SYMBOL (0.1,0.1,0.07,LABEL3,90.0,1)
      CALL SYMBOL (999.,999.,0.07,21H START OF PLOT MARKER,90.0,21)
      RETURN
      END