h48199
s 00003/00001/00175
d D 1.3 83/03/09 13:12:23 mrk 3 2
c  change to allow line color interaction with hershy text
e
s 00027/00014/00149
d D 1.2 83/01/28 13:52:27 tes 2 1
c initial_internal_update
e
s 00163/00000/00000
d D 1.1 83/01/28 13:02:25 tes 1 0
c date and time created 83/01/28 13:02:25 by tes
e
u
tes
mjb
mrk
mmm
U
t
T
I 1
subroutine gpgrln (type, count, xdata, ydata, stkary)
########################################################################
#                                                                      #
#          THIS MATERIAL IS CONFIDENTIAL AND IS FURNISHED UNDER        #
#          A WRITTEN LICENSE AGREEMENT.  IT MAY NOT BE USED,           #
#          COPIED OR DISCLOSED TO OTHERS EXCEPT IN ACCORDANCE          #
#          WITH THE TERMS OF THAT AGREEMENT.                           #
#                                                                      #
#          COPYRIGHT (C) 1982 GRAPHIC SOFTWARE SYSTEMS INC.            #
#          ALL RIGHTS RESERVED.                                        #
#                                                                      #
#     Function: display a data set as a line graph                     #
#                                                                      #
#     Input Parameters:                                                #
#            type   - type of graph (1=line, 2=scatter (or point))     #
#            count  - length of data array                             #
#            xdata  - array of x coordinates                           #
#            ydata  - array of y coordinates                           #
#            stkary - array used to stack current graph extents        #
#                                                                      #
#     Output Parameters:                                               #
#            stkary - array used to stack current graph extents        #
#                                                                      #
#     Routines Called:                                                 #
#            gplnat - set the current line attribute                   #
#            imove  - modify current position for later action         #
#            gpstck - put a value into the stack arrray                #
#            gpdraw - do a 2d draw                                     #
#            gpcstk - get a value from the stack array                 #
#            gpxfrm - transform a data point                           #
#            gpn2dc - convert a point from ndc to 32K space            #
#            gpsatt - Set an attribute on the current device           #
#            gzddop - Device independent interface to current device   #
#                                                                      #
########################################################################
integer type, count
real xdata(1), ydata(1), stkary

integer contrl(5), intin(1), ptsin(2), intout(1), ptsout(1), opcd
integer i, j, ilabel, ilen, istr(8), kerr, gr2chr, iout
D 2
real x, y, temp1, temp2, xd, yd
E 2
I 2
real x, y, temp1, temp2, xd, yd, gtreal
E 2
 
integer kstack,  # Variable used to indicate whether stacking should be used
        loops,   # Variable used to control the number of do loops executed
        start    # Variable used to control the initial do loop value
D 2

PLOTxREALS PLOTxGETREAL
E 2
 
include(`pltcom')

#  The following equivalences were made to reduce code size:
#      contrl(1) = opcd
equivalence (contrl(1), opcd)

D 2
   # Set up the environment
E 2
   nclip = YES  # Turn on clipping
I 2

   # If a base line has been specified, output it
   if (nbstat != 0) {
      
      i = nlstyl   # Save the current line style to put out baseline
      call gpsatt (SETxPOLYLINExCOLORxINDEX, nbsclr, iout)
      call gpsatt (SETxPOLYLINExLINETYPE, nbastl, iout)
      nlstyl = iout

      temp1 = zlwid    # Stack and reset line width
      zlwid = zbaswd

      call gpxfrm (1, zrstrt(1), x)
      call gpxfrm (2, zbrbas, y)
      call imove (ABSOLUTE,x, y)
      call gpxfrm (1, zrend(1), x)
      call gpdraw (x, y) 

      zlwid = temp1  # Restore line width
      nlstyl = i     # Restore the current line type
      nbstat = NO  # No more base lines will be displayed
      }

D 3
   # Set up the environment
E 3
I 3
   # Set up the environment for lin graphs
E 3
E 2
   call gplnat
   
   # Set the marker type
   call gpsatt (SETxPOLYMARKERxTYPE, nmstyl, iout)
   
   # Set the marker color
   call gpsatt (SETxPOLYMARKERxCOLORxINDEX, nmcolr, iout)

D 2
   if (nbstat != 0)  {  # The user wants a graph baseline
      call gpxfrm (1, zrstrt(1), x)
      call gpxfrm (2, zbrbas, y)
      call imove (ABSOLUTE, x, y)
      call gpxfrm (1, zrend(1), x)
      call gpdraw (x, y)
      }
 
E 2
   nlindx = nlindx + 1
   if (ndflgd > 0) {   # If a legend is to be displayed
      x = zlgxy(1) + zxlspc/2.
      y = zlgxy(2) - (float(nlindx)-.35)*zylspc
      call imove (ABSOLUTE, x, y)
      if (type == SCATTERxPLOT | nmstat != 0) {
	 if (x > zxleft-ZEPS & x < zxrght+ZEPS & 
	     y > zybotm-ZEPS & y < zytop+ZEPS)  {  
	    # The marker was not clipped
            opcd = POLYMARKER
            contrl(2) = 1  # Only one marker
	    call gpn2dc (x, y, ptsin)
            call gzddop (contrl, intin, ptsin, intout, ptsout)
	    }
         }

      if (type == LINExPLOT)  { # Put out a line only if drawing a line graph
         temp1 = zxlspc/3.
         call imove (RELATIVE, -temp1, 0.0)
         call gpdraw (x+temp1, y)
         }
      }
 
   zxleft = zplmin(1)    # Set clipping to graph extents
   zxrght = zplmax(1)
   zybotm = zplmin(2)
   zytop = zplmax(2)

   ilabel = 0
   if (nlbsts > 0)   {  # The user wants the points to be displayed
      njust(POINTxTEXTxATT) = 5  # Center justified
      call gptxat (POINTxTEXTxATT)  # Set the environment
      ilabel = 1                    # local flag to indicate labeling invoked
      }                             # Needed since loop can be done twice

   loops = 2
   if (type == SCATTERxPLOT)
      start = 2
   else {
      start = 1
      if (nmstat == 0) loops = 1
      }
 
   kstack = 1
   do i=start, loops {
      do j=1, count {
 
D 2
	 temp1 = PLOTxGETREAL(xdata(j))
	 temp2 = PLOTxGETREAL(ydata(j))
E 2
I 2
	 temp1 = gtreal (xdata, j-1)
	 temp2 = gtreal (ydata, j-1)
E 2
         if (kstack != 0)    # We stack the first pass
            call gpstck (count, stkary, j, temp1, temp2, xd, yd)
         else                # And obtain the stack value on the second
            call gpcstk (j, stkary, temp1, temp2, xd, yd)
 
         call gpxfrm (1, xd, x)
         call gpxfrm (2, yd, y)
 
         if (i == 1) {
            if (j == 1) call imove (ABSOLUTE, x, y)
            else        call gpdraw (x, y)
            }
         else {
	 if (x > zxleft-ZEPS & x < zxrght+ZEPS & 
	     y > zybotm-ZEPS & y < zytop+ZEPS)  {  
	       # The marker was not clipped
	       opcd = POLYMARKER
	       contrl(2) = 1
	       call gpn2dc (x, y, ptsin)
               call gzddop (contrl, intin, ptsin, intout, ptsout)
	       }
            }

	 if (ilabel == 1)  {
	    ilen = gr2chr (yd, istr, 8, 2, kerr)
	    call imove (ABSOLUTE, x, y)
	    call text (ilen, istr)
I 3
	    # The hershy fonts may have set the line color other than default
            call gpsatt (SETxPOLYLINExCOLORxINDEX, nlcolr, iout)
E 3
	    }
         }
      ilabel = 0  # do not label any more
      kstack = 0
      call imove (ABSOLUTE, zxabsl, zyabsl)  # Dump the polyline buffer
      }

   zxleft = 0.0    # Reset clipping to be full screen
   zxrght = 1.0
   zybotm = 0.0
   zytop = 1.0
   nclip = NO

   return
end
E 1
