C     NAME: TESTAL
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     MAIN PROGRAM TO CALL ALL TEST ROUTINES
C
C
      CALL PLOTS(0,0,0)
      CALL CHRSUM
      CALL GRDTON
      CALL VOLTS
      CALL THOUSE
      CALL TSYMBL
      CALL SYMTST
      CALL TWHERE
      CALL TCIRCL
      CALL TELLPS
      CALL TARC
      CALL TCURVE
      CALL TDEFPN
      CALL TCONVX
      CALL DASH
      CALL RECTST
      CALL PLOT (0.,0.,999)
      STOP
      END
      SUBROUTINE CHRSUM
C     NAME: CHRSUM
C
       DIMENSION KNP(16)
C
       DATA KNP/48,49,50,51,52,53,54,55,56,57,65,66,67,68,
     1 69,70/
C
C...  REDUCE PLOT TO FIT 8.5" WIDE PLOTTER
      CALL FACTOR (.78)
      CALL PLOT(0.0,10.2,3)
      CALL PLOT(8.0,10.2,2)
      CALL PLOT(8.0, 0.0,2)
      CALL PLOT(0.0, 0.0,2)
      CALL PLOT(0.0,10.2,2)
C
C...  PLOT TITLE PARAGRAPH.
C
       CALL SYMBOL(.45,9.8,0.14,
     146HCHARACTERS AVAILABLE IN THE UVS SYMBOL ROUTINE,0.0,46)
       CALL SYMBOL(.25,9.45,0.1,75HCODES NEXT TO EACH SYMBOL ARE: 1. INT
     1EGER CODE USED IN SPECIAL SYMBOL CALL.,0.0,75)
       CALL SYMBOL(3.35,9.30,0.1,43H2. INTERNAL HEXADECIMAL CODE (MODULO
     1 128). ,0.0,43)
       CALL SYMBOL(.25,9.15,0.1,66HSEE THE IVS OPERATING MANUAL FOR CORR
     1ESPONDING PUNCHED CARD CODES.,0.0,66)
C
C... PLOT SYMBOL SET 8 ROWS , 16 SYMBOLS PER ROW.
C
      X=0.25
      M=0
      DO  20  I=1,8
        Y=8.55
        DO  10  J=1,16
          Z=M
          CALL NUMBER(X,Y+.15,.1 ,Z     ,0.0,-1)
          CALL SYMBOL(X   ,Y ,.1 ,KNP(I),0.0,-1)
          CALL SYMBOL(X+.1,Y ,.1 ,KNP(J),0.0,-1)
      CALL SYMBOL(X+.4,Y,.35,M  ,0.0,-1)
          M=M+1
 10       Y=Y-.50
 20     X=X+0.95
C
C...  PLOT CLOSING 'NOTES'.
C
      CALL SYMBOL(.25,0.70,0.1,7HNOTES: ,0.0,7)
       CALL SYMBOL(.95,0.70,0.1,59H 1. THE FIRST 14 SYMBOLS IN THE TABLE
     1 ARE CENTERED SYMBOLS.,0.0,59)
       CALL SYMBOL(.95,.55,.1,55H 2. ALL SYMBOLS ARE ACCESSIBLE VIA SYMB
     1OL NUMBER AND A ,0.0,55)
       CALL SYMBOL(.95,.40,0.10,57H    SUBSET ARE ACCESSIBLE VIA HOLLERI
     1TH PUNCH CARD CODES.,0.0,57)
      CALL PLOT (0.,0.,-999)
      RETURN
      END
      SUBROUTINE GRDTON
C     NAME: GRDTON
C
      DIMENSION X(200),Y(200),IPAT(16)
C
      DIMENSION NE(2)
C
      DATA IPAT/ -12287, 00003, 16391, 00012,
     1             00029, 00048, 00116, 00192,
     2             00464, 00768, 01856, 03072,
     3             07424, 12288, 29696,-16384/
C
      DATA MASK1/-30584/,MASK2/-21846/
C
      DATA NE/50,6/
C
C...  INITIALIZE THE PLOTTING SYSTEM
C
C...  DRAW THE SMALLER GRID
      CALL GRID (1.0,1.0,35,.2,35,.2,MASK1)
C
C...  DRAW THE LARGER GRID
      CALL GRID (1.0,1.0,7,1.,7,1.,MASK2)
C
C...  DEFINE THE TONE AREA
      ANG = 0
      DELTA = 3.14159*2./50.
      DO 10 I=1,50
      X(I) = 2.0*COS(ANG)+3.5
      Y(I) = 2.0*SIN(ANG)+3.5
   10 ANG = ANG + DELTA
C
C...  DEFINE THE TONE PATTERN
      CALL TONE (0.,0.,IPAT,-16)
C
C...  PLOT THE TONE AREA
      CALL TONE (X,Y,50,1)
C
C...  DRAW A CIRCLE AROUND THE TONE PATTERN
      CALL PLOT (X(1),Y(1),3)
      DO 15 I=2,50
   15 CALL PLOT (X(I),Y(I),2)
      CALL PLOT (X(1),Y(1),2)
C
C...  DEFINE THE END OF PLOT
      CALL PLOT (0.,0.,-999)
C
C...  DEFINE A STAR
C
      ANG = 0
      AMT = 4*3.14159/5.0
      DO 20 I=51,56
      X(I) = 2.0*COS(ANG) + 3.5
      Y(I) = 2.0*SIN(ANG) + 3.5
   20 ANG = ANG + AMT
C
C...  TONE THE STAR
      CALL TONE (0.,0.,IPAT,-16)
      CALL TONE (X,Y,NE,2)
C
C...  TERMINATE PLOTTING
      CALL PLOT (0.,0.,-999)
      RETURN
      END
      SUBROUTINE VOLTS
C     NAME: VOLTS
C
      DIMENSION X(26),Y(26)
      DATA X/0.,5.,15.,25.,30.,35.,40.,45.,50.,55.,60.,65.,70.,75.,80.,
     1      85.,90.,95.,100.,105.,110.,115.,120.,125.,2*0./
C
      DATA Y/0.,10.,15.,10.,-10.,-50.,-80.,-110.,-130.,-145.,-155.,
     1      -160.,-158.,-150.,-130.,-90.,-70.,-20.,20.,50.,70.,80.,85.,
     2      90.,2*0./
C
C
C...   ALTER ACTUAL DATA SCALES
      DO 10 I=1,24
      X(I) = X(I) * 1000
   10 Y(I) = Y(I) / 10000
C
      CALL PLOT (.75,.75,-3)
C
      CALL SCALE (X,7.,24,+1)
      CALL SCALE (Y,9.,24,+1)
C
      CALL NEWPEN (2)
      CALL LINE (X,Y,24,1,+1,0)
      CALL NEWPEN (1)
C
      CALL AXIS (0.,0.,11HNANOSECONDS,-11,7.,0.,X(25),X(26))
      CALL AXIS (0.,0.,10HMILLIVOLTS,+10,9.,90.,Y(25),Y(26))
C
      CALL SYMBOL (.5,.5,.1,5HDX = ,0.,+5)
      CALL NUMBER (999.,999.,.1,X(26),0.,+3)
      CALL NUMBER (1.,.75,.1,X(26),0.,0)
      CALL NUMBER (1.,1.,.1,X(26),0.,-1)
      CALL NUMBER (1.,1.25,.1,X(26),0.,-4)
C
      CALL SYMBOL (2.3,6.5,.1,16HVERSAPLOT SAMPLE,0.,+16)
      CALL SYMBOL (1.5,6.75,.2,15HTIME VS VOLTAGE,0.,+15)
C
      CALL PLOT (0.,0.,-999)
      RETURN
      END
      SUBROUTINE THOUSE
C     NAME: THOUSE
C
C     THOUSE - CREATE A HOUSE OF TRAPEZOIDS
C
C     LOCAL VARIABLES USED:
C            IPAT - THE TONE PATTERN ARRAY
C            X,Y  - THE COORDINATE ARRAYS WHICH DEFINE THE AREAS
C                   TO BE SHADED
C            NE   - THE INTEGER ARRAY WHICH CONTAINS THE NUMBER OF
C                   X,Y ELEMENTS WHICH SPECIFY A PARTICULAR AREA
C
C
      DIMENSION X(8),Y(8),NE(2),IPAT(16)
C
      DATA NE /5,3/
      DATA IPAT /     0, 31870, 32510, 32510,
     1                 0, 31870, 32510, 32510,
     2              1760,  1760,  1760,  2016,
     3              1984,  1920,     0,     0/
C
      DATA X /0.,1.,1.,0.,0.,0.,.5,1./
      DATA Y /0.,0.,1.,1.,0.,1.,1.5,1./
C
C...  SET TONE PATTERN ARRAY
      CALL TONE (0.,0.,IPAT,-16)
C
C...  TONE AREA
      CALL TONE (X,Y,NE,2)
C
C...  TERMINATE ALL PLOTTING
      CALL PLOT (0.,0.,-999)
      RETURN
      END
      SUBROUTINE TSYMBL
C     NAME: TSYMBL
C     TSYMBL - TEST SYMBOL CALL OUTPUT
C
C     THIS PROGRAM IS A SIMPLE TEST USED TO VERIFY THE OUTPUT OF
C     THE VRF TEXT-STRING AND SET-FONT-BASELINE COMMAND FROM
C     SUBROUTINE SYMBOL.
C
C        CALLS: PLOTS,PLOT,SYMBOL
C
C
C
C
      CALL SYMBOL(3.0,3.0,.35,8HABCDEFGH,0.0,8)
      CALL SYMBOL(3.0,3.0,.35,8H.0123456,90.0,8)
      CALL PLOT(0.0,0.0,-999)
      RETURN
      END
C
C
      SUBROUTINE SYMTST
C     CALL VPORT(0.,4.0,0.,10.5)
      ANGLE = 0.0
      HEIGHT = .14
      CALL PLOT (4.,4.,-3)
      DO 100 I = 1,8
      RAD = .0174533 * ANGLE
      X = .5*COS(RAD)
      Y = .5*SIN(RAD)
      CALL SYMBOL (X,Y,HEIGHT,15HCOLOR VERSAPLOT,ANGLE,15)
      HEIGHT = HEIGHT + .028
100   ANGLE = ANGLE + 45.0
C
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
C
      SUBROUTINE TWHERE
      COMMON /IOCOM/ IUNIT,LUNIT,LREC,IOTYPE
C
C...  FACTOR,WHERE AND NEWPEN EXAMPLE
      CALL FACTOR (1.25)
      CALL OFFSET (0.,1.,0.,1.)
      CALL HOUSE
      CALL OFFSET (-1.,.5,-1.,.75)
      CALL WHERE (XNOW,YNOW,DFACT)
      WRITE (LUNIT,100) XNOW,YNOW,DFACT
100   FORMAT (' XNOW,YNOW,DFACT=',3F6.2)
      CALL NEWPEN(3)
      CALL HOUSE
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
      SUBROUTINE HOUSE
      CALL PLOT (0.,0.,13)
      CALL PLOT (1.,0.,12)
      CALL PLOT (1.,1.,12)
      CALL PLOT (0.,1.,12)
      CALL PLOT (0.,0.,12)
C
      CALL PLOT (0.,1.,13)
      CALL PLOT (.5,1.5,12)
      CALL PLOT (1.,1.,12)
      RETURN
      END
C
C
      SUBROUTINE TCIRCL
C
C...  CIRCLE EXAMPLE
      INTEGER ZPAT
      DIMENSION IPAT(16),ZPAT(1)
      DATA IPAT/7168,8704,16640,16640,16640,8704,7168,0,
     1                   65,34,20,8,20,34,65,0/
      DATA ZPAT/0/
C
      CALL DEFPAT (1,ZPAT,1)
      CALL DEFPAT (2,IPAT,16)
      CALL SETPAT (1)
C
C...  DRAW CIRCLE WITH NO FILL
      CALL CIRCLE (2.,2.,-.5,1)
C...  SET PAT#2 ACTIVE
      CALL SETPAT (2)
C...  DRAW CIRCLE WITH FILL AND OUTLINE
      CALL CIRCLE (4.,2.,.5,1)
C...  SET PAT#1 ACTIVE
      CALL SETPAT(1)
C...  DRAW CIRCLE WITH NO FILL, WIDTH = 4
      CALL CIRCLE (2.,4.,-.5,4)
      CALL SETPAT(2)
C...  DRAW FILL, NO OUTLINE
      CALL CIRCLE (4.,4.,.5,-1)
C
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
      SUBROUTINE TELLPS
C
      SIZE = 2.5
      Y0 = 5.0
      X0 = 5.0
      DO 100 I = 1,271,90
      A = FLOAT(I-1)
      RA = A*3.14159265/180.0
      X = SIZE/2.0*COS(RA)+X0
      Y = SIZE/2.0*SIN(RA)+Y0
      CALL ELLIPS(X,Y,A+90.0,SIZE,SIZE/2.0)
100   CONTINUE
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
C
      SUBROUTINE TARC
C
      CALL PLOT (2.,5.0,3)
      CALL PLOT (2.,2.,2)
      CALL PLOT (5.0,2.0,2)
      CALL CARC (5.0,5.0,3.0,180.,270.0)
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
C
      SUBROUTINE TCURVE
      DIMENSION X(9),Y(9)
      DATA X/1.,2.,3.,4.,5.,6.,7.,7.3,8./
      DATA Y/4.,3.,2.,3.,4.,4.,4.,3.,4./
      CALL CURVE (X,Y,9,-.05)
      DO 100 I = 1,9
100   CALL SYMBOL (X(I),Y(I),.14,1,0.,-1)
      CALL PLOT (0.,1.,-3)
      CALL CURVE (X,Y,9,.05)
      DO 200 I = 1,9
200   CALL SYMBOL (X(I),Y(I),.14,2,0.,-1)
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
C
      SUBROUTINE TDEFPN
C
      CALL DEFPEN (2,2,200,50,50,50)
      CALL NEWPEN (2)
      CALL PLOT (1.,1.,3)
      CALL PLOT (1.,5.,2)
      CALL DEFPEN (3,3,200,100,200,100)
      CALL NEWPEN(3)
      CALL PLOT (2.,1.,3)
      CALL PLOT (2.,5.,2)
      CALL DEFPEN (4,4,25,25,25,25)
      CALL NEWPEN(4)
      CALL PLOT (3.,1.,3)
      CALL PLOT (3.,5.,2)
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
C
      SUBROUTINE TCONVX
C
      DIMENSION IPAT(16),X(8),Y(8),X2(8),Y2(8)
      DATA IPAT/0,31870,32510,32510,0,31870,32510,32510,
     X                 1760,1760,1760,2016,1984,1920,0,0/
      DATA X/2.0,5.0,7.0,7.0,5.0,2.0,0.0,0.0/
      DATA Y/0.0,0.0,2.0,5.0,7.0,7.0,5.0,2.0/
      DATA X2/2.0,5.0,7.0,7.0,5.0,2.0,0.0,0.0/
      DATA Y2/0.0,0.0,2.0,5.0,7.0,7.0,5.0,2.0/
      DATA NPT/8/
C
      CALL DEFPAT (1,IPAT(1),16)
      CALL SETPAT (1)
      CALL WINDOW (0.,7.,0.,7.)
      CALL VPORT (0.,2.,0.,2.)
      CALL CONVEX (X,Y,NPT)
      CALL VPORT (3.,5.,0.,2.)
      CALL NEWPEN(3)
      CALL CONVEX (X2,Y2,-NPT)
      CALL PLOT (0.,0.,-999)
      RETURN
      END
C
      SUBROUTINE DASH
C
C...  DASHLN EXAMPLE
C
      DIMENSION X(2),Y(2)
      CALL FACTOR (.5)
C
      X(1) = 6.
      Y(1) = 6.
C
      NPTS = 2
      ONLTH = .75
      OFFLTH = .25
C
      X(2) = 1.
      DO 10 I = 1,11
      Y(2) = I
      CALL DASHLN (X,Y,NPTS,ONLTH,OFFLTH)
   10 CONTINUE
C
      Y(2) = 1.
      DO 20 I = 1,11
      X(2) = I
      CALL DASHLN (X,Y,NPTS,ONLTH,OFFLTH)
   20 CONTINUE
C
      X(2) = 11.
      DO 30 I = 1,11
      Y(2) = I
      CALL DASHLN (X,Y,NPTS,ONLTH,OFFLTH)
   30 CONTINUE
C
      Y(2) = 11.
      DO 40 I = 1,11
      X(2) = I
      CALL DASHLN (X,Y,NPTS,ONLTH,OFFLTH)
   40 CONTINUE
C
C...  DRAW A BOX
      CALL PLOT (0.,0.,3)
      CALL PLOT (12.,0.,2)
      CALL PLOT (12.,12.,2)
      CALL PLOT (0.,12.,2)
      CALL PLOT (0.,0.,2)
C
C...  END OF PLOT
      CALL PLOT (0.,0.,-999)
C
      RETURN
      END
      SUBROUTINE RECTST
C
C...    RECTANGLE EXAMPLE
C
      DIMENSION IPAT(16),IPAT2(16)
      DATA IPAT / 7168, 8704,16640,16640,16640, 8704, 7168,    0,
     *                    65,   34,   20,    8,   20,   34,   65,    0/
      DATA IPAT2/65535,33665,33025,33025,65535,33665,33025,33025,
     *                 63775,63775,63775,63519,63551,63615,65535,65535/
C
C...  DEFINE THE FILL PATTERNS
      CALL DEFPAT(1,IPAT,16)
      CALL DEFPAT(2,IPAT2,16)
C
C...  USING THE FIRST FILL PATTERN,
C     DRAW RECTANGLES WITH AND WITHOUT OUTLINES
      CALL SETPAT(1)
      CALL RECT( 1.5, 1.7, 1.0, 4.5, 0 )
      CALL RECT( 1.0, 4.5, 1.5, 1.7, 1 )
C
C...  SET THE SECOND FILL PATTERN ACTIVE
      CALL SETPAT(2)
C
C...  DEFINE AND SET ACTIVE A NEW PEN
      CALL DEFPEN( 3, 10, 20, 10, 10, 20 )
      CALL NEWPEN( 3 )
C
C...  DRAW TWO RECTANGLES OUTLINED IN OPPOSITE DIRECTIONS
      CALL RECT( 2.0, 3.0, 2.0, 4.5, 1 )
      CALL RECT( 3.5, 4.5, 4.5, 2.0, 1 )
C
C...  END OF PLOTTING
      CALL PLOT(0.,0.,-999)
C
      RETURN
      END