h28768
s 00005/00007/00095
d D 1.2 83/03/31 12:36:27 mmm 2 1
c 
e
s 00102/00000/00000
d D 1.1 83/03/15 21:41:12 tes 1 0
c date and time created 83/03/15 21:41:12 by tes
e
u
4
U
t
T
I 1
subroutine grqlc (wkid, lcdnr, inipx, inipy, stat, tnr, px, py, lctmtr)
########################################################################
#                                                                      #
#          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: Request locator                                        #
#                                                                      #
#     Input Parameters:                                                #
#            wkid   - workstation identifier                           #
#            lcdnr  - locator device number                            #
#            inipx, inipy - initial locator position                   #
#     Output Parameters:                                               #
#            stat - status (OK = 1, NONE = 0)                          #
#            tnr - normalization transformation number                 #
#            px,py - locator position in world space                   #
#            lctmtr - locator terminator                               #
#                                                                      #
#     Errors:                                                          #
#            7 GKS not in proper state: GKS must be in one of the      #
#              states WSOP, WSAC or SGOP                               #
#           20 Specified workstation identifier is invalid             #
#           25 Specified workstation is not open                       #
#           36 Specified workstation is neither an input workstation   #
#              nor an output/input workstation                         #
#                                                                      #
#     Routines Called:                                                 #
#            gzddop - call current device driver                       #
#            gwddc2 - convert/clip line from world to device           #
#            gzdcwd - convert from device to world units               #
#            gndcw2 - map ndc point to the 2D world                    #
#            errchk - perform appropriate error checking               #
#                                                                      #
########################################################################
integer wkid, lcdnr, stat, tnr, lctmtr
real inipx, inipy, px, py
 
integer contrl(5), intin(1), ptsin(2), ptsout(2), intout(1), lineot(4)
D 2
real linein(4), tpx, tpy
E 2
I 2
real linein(4), tpx, tpy, gtreal 
E 2

D 2
REALS GETREAL

E 2
ifdef(`ERROR_ON',`
   integer errchk, errind, ierdum(1)
   ')

logical q1move, q2move, qgone
include(`gkscom')
 
ifdef(`ERROR_ON',`
      rounum = GRQLC
      errind = errchk(wkid, ierdum)
      ')

   # Initialize locator point and locator terminator for no locate done
   contrl(5) = NONE
   tpx = 0.0
   tpy = 0.0
   lctmtr = -1
 
   contrl(OPCODE) = INPUTxLOCATOR
   contrl(VERTICESxIN) = 1
   intin(1) = lcdnr

   #   linein(1)...linein(4)
D 2
   linein(1) = GETREAL(inipx)   # Need two points for gwddc2
   linein(2) = GETREAL(inipy)
E 2
I 2
   linein(1) = gtreal (inipx, 0)   # Need two points for gwddc2
   linein(2) = gtreal (inipy, 0)
E 2
   linein(3) = linein(1)
   linein(4) = linein(2)

   call gwddc2 (linein, lineot, q1move, q2move, qgone)

   ptsin(1) = 0  # Set initial point to zero if points are clipped
   ptsin(2) = 0

   if (!qgone) {
      ptsin(1) = lineot(1)
      ptsin(2) = lineot(2)
      }

   call gzddop (contrl, intin, ptsin, intout, ptsout)
 
   # If a point has been returned, transform from DC to World 

   stat = contrl(5)

   if (stat == OK) {
      # Convert device coords to world
      call gzdcwd (ptsout(1), ptsout(2), tpx, tpy)
      lctmtr = intout(1)
      }
   tnr = nrmcur   # Return current normalization trans. number
D 2
   PUTREAL(tpx, px)    # Put back into user format reals
   PUTREAL(tpy, py)
E 2
I 2
   call ptreal(tpx, 0, px)    # Put back into user format reals
   call ptreal(tpy, 0, py)
E 2

   return
end
E 1
