h42341
s 00003/00004/00121
d D 1.2 83/03/31 12:27:20 mmm 2 1
c 
e
s 00125/00000/00000
d D 1.1 83/03/15 21:34:50 tes 1 0
c date and time created 83/03/15 21:34:50 by tes
e
u
4
U
t
T
I 1
subroutine gcla (pxy,nmax,mmax,colia)
########################################################################
#                                                                      #
#          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: Generate a cell array                                  #
#                                                                      #
#     Input Parameters:                                                #
#            pxy(1)  - lower left x point in world coordinates         #
#            pxy(2)  - lower left y point in world coordinates         #
#            pxy(3)  - upper right x point in world coordinates        #
#            pxy(4)  - upper right y point in world coordinates        #
#            nmax    - number of elements in each row of color array   #
#            mmax    - number of rows in color index array             #
#            colia   - color index array                               #
#                                                                      #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     Errors:                                                          #
#            5  GKS not in proper state: GKS must be in the state      #
#               WSAC or in the state SGOP                              #
#           85  Dimensions of color array are invalid                  #
#                                                                      #
#     Routines Called:                                                 #
#            gzwndc - convert from world to ndc space                  #
#            gzndcd - convert from ndc to 32k space                    #
#            gzcleg - polygon clip edge routine                        #
#            gzddop - call the device driver to set the pixels         #
#            errchk - perform appropriate error checking               #
#                                                                      #
########################################################################
integer nmax, mmax, colia(1)
real pxy(4)

integer contrl(9), opcd, vertin, intlen, rowlen, neused, numrow, 
	pixop,  ptsin(4), iedge1, iedge2, size1, size2, i, idummy(1)
D 2
real xtmp1(5), ytmp1(5), xtmp2(5), ytmp2(5), edge1, edge2
REALS GETREAL
E 2
I 2
real xtmp1(5), ytmp1(5), xtmp2(5), ytmp2(5), edge1, edge2, gtreal
E 2

ifdef(`ERROR_ON',`
   integer errchk, errind, ierdum, ierary(2), erary2
   ')
 
include(`gkscom')

# The following equivalence statements are used to decrease the amount of code
#    necessary to access specific array elements.

equivalence (contrl(OPCODE),opcd), (contrl(VERTICESxIN), vertin),
	    (contrl(INTEGERxINxLENGTH), intlen), (contrl(6), rowlen),
	    (contrl(7), neused), (contrl(8), numrow),(contrl(9), pixop)

ifdef(`ERROR_ON',`
      equivalence (ierary(2), erary2)
      rounum = GCLA
      #   ierary(2) = nmax * mmax
      erary2 = nmax * mmax
      errind = errchk (ierdum, ierary)
      ')

   #   contrl(OPCODE) == CELLxARRAY
   opcd = CELLxARRAY
   #   contrl(VERTICESxIN) = 2
   vertin = 2
   #   contrl(INTEGERxINxLENGTH) =  nmax * mmax color index array size
   intlen = nmax * mmax
   #   contrl(6) = nmax   number of elements per row
   rowlen = nmax   
   #   contrl(7) = nmax   number of elements per row used
   neused = nmax
   #   contrl(8) = mmax   number of rows
   numrow = mmax   
   #   contrl(9) = 1
   pixop = 1

   # Insure input reals are in correct format
D 2
   call gzwndc (GETREAL(pxy(1)), GETREAL(pxy(2)), xtmp1(1), ytmp1(1))
   call gzwndc (GETREAL(pxy(3)), GETREAL(pxy(4)), xtmp1(3), ytmp1(3))
E 2
I 2
   call gzwndc (gtreal(pxy, 0), gtreal(pxy, 1), xtmp1(1), ytmp1(1))
   call gzwndc (gtreal(pxy, 2), gtreal(pxy, 3), xtmp1(3), ytmp1(3))
E 2

   # Check for invalid cell array
   if (xtmp1(1) >= xtmp1(3) | ytmp1(1) >= ytmp1(3)) return

   # Make cell array into rectangle and pass to polygon clipper
   xtmp1(2) = xtmp1(3)
   xtmp1(4) = xtmp1(1)
   xtmp1(5) = xtmp1(1)
   ytmp1(2) = ytmp1(1)
   ytmp1(4) = ytmp1(3)
   ytmp1(5) = ytmp1(1)

   size1 = 5
   iedge1 = LEFT   # Set up to clip the left and right extremes of the
   edge1 = zxleft  #   viewing area.
   iedge2 = RIGHT
   edge2 = zxrght
         
   # clip to each clipping edge as pairs, LEFT/RIGHT and TOP/BOTTOM
   do i=1, 2 {
      call gzcleg (size1,xtmp1,ytmp1,edge1,iedge1,size2,xtmp2,ytmp2)
      call gzcleg (size2,xtmp2,ytmp2,edge2,iedge2,size1,xtmp1,ytmp1)
      iedge1 = TOP   # Set up to clip the top and bottom extremes of the
      edge1 = zytop  #  viewing area.
      iedge2 = BOTTOM
      edge2 = zybotm
      }
      
   if (size1 >= 5) {
      # Convert from ndc to 32k space and ship
      call gzndcd (xtmp1(1), ytmp1(1), ytmp2(1), ytmp2(2))
      call gzndcd (xtmp1(3), ytmp1(3), ytmp2(3), ytmp2(4))
      do i = 1, 4 {
	 ptsin(i) = ytmp2(i) + .5
	 }
      call gzddop (contrl, colia, ptsin, idummy, idummy)
      }

   return
end
E 1
