h04605
s 00000/00000/00135
d D 1.2 83/03/31 12:45:55 mmm 2 1
c 
e
s 00135/00000/00000
d D 1.1 83/03/15 21:45:18 tes 1 0
c date and time created 83/03/15 21:45:18 by tes
e
u
4
U
t
T
I 1
subroutine gzclip (pt1, pt2, q1move, q2move, qgone)
########################################################################
#                                                                      #
#          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: clip the line formed by pt1 and pt2                    #
#                                                                      #
#     Input Parameters:                                                #
#            pt1 - 1st point on line to be clipped                     #
#            pt2 - 2nd point on line to be clipped                     #
#                                                                      #
#     Output Parameters:                                               #
#            q1move - .TRUE. if the first point has been moved         #
#            q2move - .TRUE. if the second point has been moved        #
#            qgone  - .TRUE. if the entire line is clipped             #
#                                                                      #
#     Routines Called:                                                 #
#            none                                                      #
#                                                                      #
########################################################################
 
real pt1(1),pt2(1)
logical q1move, q2move, qgone
 
real x1, x2, y1, y2
real newpt,      # Real statement function used to compute new intersections
     p1, p2,     # Dummy arguments for statement function
     t1, t2      # Temporaries used to compute a line's relative position to
                 #    an edge and used to swap coordinates
logical q1, q2,  # Logicals used to indicate a change in the first or second
                 #    point
        qswap,   # Logical flag indicating when the first and second point
                 #    has been swapped
        qt       # Temporary logical used while swapping end points
 
include(`gkscom')
 
   # The following statement funtion computes a new vertece for a line and
   # a clipping edge.
   newpt(p1, p2) = p1 + (p2 - p1)*t1/(t1 - t2)
 
      qgone = .true.      # Assume the line cannot be seen
      qswap = .false.
      q1 = .false.
      q2 = .false.
 
      if (pt1(2) > pt2(2)) { # Make sure x1,y1 is the minium point in y
         x1 = pt2(1)
         y1 = pt2(2)
         x2 = pt1(1)
         y2 = pt1(2)
         qswap = .true.      # Mark the points swapped
         }
      else {
         x1 = pt1(1)
         y1 = pt1(2)
         x2 = pt2(1)
         y2 = pt2(2)
         }
 
      t1 = y1 - zytop      # Compare to the top edge
      t2 = y2 - zytop
      if (t1 >= 0.0) return      # If x1,y1 can't be seen the line is gone
      if (t2 > 0.0) {            # If the second point is above compute
         x2 = newpt (x1, x2)     #    intersection top
         y2 = zytop
         q2 = .true.             # Point 2 has been modified
         }
 
      t1 = y1 - zybotm      # Compare to the bottom edge
      t2 = y2 - zybotm
      if (t2 <= 0.0) return # If x2,y2 below the bottom the line is gone
      if (t1 < 0.0) {          # If x1,y1 below the bottom compute the
         x1 = newpt (x1, x2)   # intersection with the bottom
         y1 = zybotm
         q1 = .true.           # Point 1 has been modified
         }
 
      if (x1 > x2) {      # Insure x1,y1 is minimum in x
         t1 = x1
         x1 = x2
         x2 = t1
         t1 = y1
         y1 = y2
         y2 = t1
         qswap = !qswap     # Adjust the swap flag
         qt = q1
         q1 = q2
         q2 = qt
         }
 
      t1 = x1 - zxrght      # Compare to the right edge
      t2 = x2 - zxrght
      if (t1 >= 0.0) return    # If x1,y1 is to the right the line is gone
      if (t2 > 0.0) {          # If x2,y2 is to the right compute the
         y2 = newpt (y1, y2)   #    intersection with the right edge
         x2 = zxrght
         q2 = .true.           # Point 2 has been modified
         }
 
      t1 = x1 - zxleft      # Compare to the left edge
      t2 = x2 - zxleft
      if (t2 <= 0.0) return    # If x2,y2 is to the left, the line is gone
      if (t1 < 0.0) {          # If x1,y1 to the left compute intersection
         y1 = newpt (y1, y2)   #    with the left edge
         x1 = zxleft
         q1 = .true.           # Point 1 has been modified
         }
 
      qgone = .false.      # The line is visible
      if (qswap) {         # If the points have been swapped, swap and return
         pt1(1) = x2
         pt1(2) = y2
         q1move = q2
         pt2(1) = x1
         pt2(2) = y1
         q2move = q1
         }
      else {
         pt1(1) = x1
         pt1(2) = y1
         q1move = q1
         pt2(1) = x2
         pt2(2) = y2
         q2move = q2
         }
 
   return
end
E 1
