h17525
s 00018/00011/00086
d D 1.2 83/03/31 12:30:16 mmm 2 1
c 
e
s 00097/00000/00000
d D 1.1 83/03/15 21:36:48 tes 1 0
c date and time created 83/03/15 21:36:48 by tes
e
u
4
U
t
T
I 1
subroutine giclad (wkid, pxy, errind, n, m)
########################################################################
#                                                                      #
#          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: Inquire cell array dimensions                          #
#                                                                      #
#     Input Parameters:                                                #
#            wkid    - workstation identifier                          #
#            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        #
#                                                                      #
#     Output Parameters:                                               #
#            errind  - error indicator                                 #
#            n       - number of elements per row in array             #
#            m       - number of rows in array                         #
#                                                                      #
#     Errors:                                                          #
#            7  GKS not in proper state: GKS must be in the state      #
#               WSAC or in the state SGOP                              #
#           20  Specified workstation identifier is invalid            #
#           25  Specified workstation is not open                      #
#           37  Specified workstation is not an output workstation     #
#               nor an output/input workstation                        #
#                                                                      #
#     Routines Called:                                                 #
#           gzwndc - convert a point from world space to ndc           #
#           gndcdc - convert a point from ndc to device space          #
#           errchk - perform appropriate error checking                #
#                                                                      #
########################################################################
integer wkid, errind, n, m
real pxy(4)

integer i
real linein(4), xndc1, yndc1, xndc2, yndc2, xdc1, xdc2, ydc1, ydc2,
D 2
     uxdc1, uxdc2, uxndc1, uxndc2, uydc1, uydc2, uyndc1, uyndc2
E 2
I 2
     uxdc1, uxdc2, uydc1, uydc2, gtreal 
E 2

D 2
REALS GETREAL
E 2
I 2
# The 'integer*1' declarations are used for real number conversions on
# CP/M.  They represent eight byte data areas that will be used to 
# convert real numbers in one language format to FORTRAN reals.
ifdef(`F80',`
integer*1 uxndc1(8), uxndc2(8), uyndc1(8), uyndc2(8)
',`
real uxndc1, uxndc2, uyndc1, uyndc2
')
E 2

ifdef(`ERROR_ON',`
   integer errchk, ierary(2), erary1, erary2
   ')

include(`gkscom')

ifdef(`ERROR_ON',`
      equivalence (ierary(1), erary1), (ierary(2), erary2)
      ')

   # In all inquiry routines, initialize errind to 0 (zero).
   errind = 0
   ifdef(`ERROR_ON',`
      rounum = GICLAD
      #   ierary(1) = wrktyp
      erary1 = wrktyp
      errind = errchk (wkid, ierary)
      if (errind != 0) return
      ')

   do i=1,4 {
D 2
      linein(i) = GETREAL(pxy(i))  # Convert from user real to ours
E 2
I 2
      linein(i) = gtreal (pxy, i-1)  # Convert from user real to ours
E 2
      }

   # Check for invalid cell array 
   if (linein(1) >= linein(3) | linein(2) >= linein(4)) return

   # Convert to ndc space 
   call gzwndc (linein(1), linein(2), xndc1, yndc1)
   call gzwndc (linein(3), linein(4), xndc2, yndc2)

D 2
   PUTREAL(xndc1, uxndc1)     # Convert from our real to users
   PUTREAL(yndc1, uyndc1)     # in order to use user callable
   PUTREAL(xndc2, uxndc2)     # routine gndcdc
   PUTREAL(yndc2, uyndc2)
E 2
I 2
   call ptreal (xndc1, 0, uxndc1)     # Convert from our real to users
   call ptreal (yndc1, 0, uyndc1)     # in order to use user callable
   call ptreal (xndc2, 0, uxndc2)     # routine gndcdc
   call ptreal (yndc2, 0, uyndc2)
E 2

   # convert to users devices coord. space to determine dimensions
   call gndcdc (uxndc1, uyndc1, uxdc1, uydc1)
   call gndcdc (uxndc2, uyndc2, uxdc2, uydc2)
D 2
   xdc1 = GETREAL(uxdc1)       # Convert from users real to ours 
   xdc2 = GETREAL(uxdc2) 
   ydc1 = GETREAL(uydc1)
   ydc2 = GETREAL(uydc2)
E 2
I 2
   xdc1 = gtreal (uxdc1, 0)       # Convert from users real to ours 
   xdc2 = gtreal (uxdc2, 0) 
   ydc1 = gtreal (uydc1, 0)
   ydc2 = gtreal (uydc2, 0)
E 2

   n = (xdc2 - xdc1) + 1.5      # Calculate cell array dimension
   m = (ydc2 - ydc1) + 1.5

  return
end
E 1
