h37613
s 00003/00004/00104
d D 1.2 83/03/31 12:38:11 mmm 2 1
c 
e
s 00108/00000/00000
d D 1.1 83/03/15 21:41:47 tes 1 0
c date and time created 83/03/15 21:41:47 by tes
e
u
4
U
t
T
I 1
subroutine gschu (chux, chuy)
########################################################################
#                                                                      #
#          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: Set the character up vector                            #
#                                                                      #
#     Input Parameters:                                                #
#            chux  - users x component of charup vector                #
#            chuy  - users y component of charup vector                #
#                                                                      #
#      Output Parameters:                                              #
#            none                                                      #
#                                                                      #
#     Errors:                                                          #
#            8  GKS not in proper state: GKS must be in one the states #
#               GKOP, WSOP, WSAC, or SGOP                              #
#           61  Length of character up vector is zero                  #
#                                                                      #
#     Routines Called:                                                 #
#            errchk - perform appropriate error checking               #
#            gkserr - KERNEL error reporter                            #
#            gzddop - call current device driver                       #
#                                                                      #
########################################################################
real chux, chuy                        

integer contrl(5), intin(3), intout(1), ptsdum(1)
D 2
real tchux, tchuy, actrot, theta, dx, dy, rtemp
REALS GETREAL
E 2
I 2
real tchux, tchuy, actrot, theta, dx, dy, rtemp, gtreal 
E 2
 
ifdef(`ERROR_ON',`
   integer errchk, errind, ierdum(1)
   ')
 
include(`gkscom')

D 2
   tchux = GETREAL(chux)  # Convert to right real format
   tchuy = GETREAL(chuy)
E 2
I 2
   tchux = gtreal (chux, 0)  # Convert to right real format
   tchuy = gtreal (chuy, 0)
E 2

   ifdef(`ERROR_ON',`
      rounum = GSCHU
      errind = errchk(ierdum(1), ierdum)
      ')

   # check for zero length vector
   if (tchux == 0.0 & tchuy == 0.0 ) {
      ifdef(`ERROR_ON',`call gkserr (61)')
      return
      }

   # This test is for a bug in fortran runtime library.
   if (tchuy == 0.0) tchuy = zeps
   # Normalize the character up vector 
   rtemp = sqrt (tchux*tchux + tchuy*tchuy)
   dx = tchux / rtemp
   dy = tchuy / rtemp

   chrupx = dx  # Set the user specified normalized charup vector globals
   chrupy = dy  

		 # Convert character up vector to degrees
   rtemp = 180.0 / 3.141592653
   theta = (atan2 (dy,dx))* rtemp # (180.0/pi)                    
 
   theta = theta - 90.0          # Subtract 90 degrees to get character
				 # rotation
   if (theta < 0.0) theta = theta + 360.0  # make sure angle is positive

   intin(1) = theta * 10.0  # convert to tenths of degrees (0 - 3600)

   theta = theta / rtemp # Convert theta to radians

   unrmdx = cos(theta)  # Set the user specifed text baseline globals
   unrmdy = sin(theta)

   intin(2) = cos(theta) * 100.0
   intin(3) = sin(theta) * 100.0
 
   intout(1) = 0            # We set the output to zero here to insure
                            # that the output is set for those devices which
                            # do not support text rotation.

   contrl(OPCODE) = SETxCHARACTERxUPxVECTOR
   contrl(VERTICESxIN) = 0
   call gzddop (contrl, intin, ptsdum, intout, ptsdum)

   #
   #   the quantity cos(actrot) is: x component of best fit rotation
   #                sin(actrot) is: y component of best fit rotation
 
   actrot = (float(intout(1)) / 10.0) / rtemp

   # Set the actual text baseline globals and actual charup vector globals
   normdx = cos(actrot)
   normdy = sin(actrot)
   rtemp = actrot + (3.141592653/2.0)
   actupx = cos(rtemp) # Add 90 degrees (pi/2) to get charup
   actupy = sin(rtemp)

   return
end
E 1
