h61292
s 00004/00005/00098
d D 1.2 83/03/31 12:38:44 mmm 2 1
c 
e
s 00103/00000/00000
d D 1.1 83/03/15 21:42:01 tes 1 0
c date and time created 83/03/15 21:42:01 by tes
e
u
4
U
t
T
I 1
subroutine gscr (wkid,ci,cr,cg,cb)
########################################################################
#                                                                      #
#          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: Define color index (associate an index with a color)   #
#                                                                      #
#     Input Parameters:                                                #
#            wkid  - workstation identifier                            #
#            ci    - color index                                       #
#            cr    - color intensities (red, green blue)               #
#            cg    -                                                   #
#            cb    -                                                   #
#                                                                      #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     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                      #
#           86  Colour index is invalid                                #
#           87  Colour invalid                                         #
#                                                                      #
#     Routines Called:                                                 #
#               errchk - perform appropriate error checking            #
#               gzddop - call current device driver                    #
#                                                                      #
########################################################################
integer wkid, ci
real cr,cg,cb
 
integer contrl(5), opcd, vertin, kind, intin(4),
	color1, color2, color3, idummy(1)

D 2
real tcr, tcg, tcb
REALS GETREAL
E 2
I 2
real tcr, tcg, tcb, gtreal 
E 2

ifdef(`ERROR_ON',`
   integer errind, errchk, ierary(2)
   ')

include(`gkscom')

# The following equivalence statements are used to decrease the amount of code
#    necessary to access specific array elements.  The arrays and the 
#    variables equivalenced are listed below:
#
#       contrl(OPCODE) :: opcd
#       contrl(VERTICESxIN) :: vertin
#
#       intin(1) :: kind
#       intin(2) :: color1
#       intin(3) :: color2
#       intin(4) :: color3
#

equivalence (contrl(OPCODE), opcd), (contrl(VERTICESxIN), vertin),
	    (intin(1), kind), (intin(2), color1), 
	    (intin(3), color2), (intin(4), color3)

D 2
   tcr = GETREAL(cr)   # Convert to R format reals
   tcg = GETREAL(cg)
   tcb = GETREAL(cb)
E 2
I 2
   tcr = gtreal (cr, 0)   # Convert to R format reals
   tcg = gtreal (cg, 0)
   tcb = gtreal (cb, 0)
E 2

   ifdef(`ERROR_ON',`
      rounum = GSCR
      ierary(1) = ci
      errind = errchk (wkid, ierary)
      ')

   # check for invalid color 
   if (tcr < 0.0 | tcr > 1.0 |
       tcg < 0.0 | tcg > 1.0 |
       tcb < 0.0 | tcb > 1.0)
       ifdef(`ERROR_ON',`call gkserr (87)',`return')

    #   intin(1) = ci
    kind = ci

    #   intin(i) = (tcr,tcg,tcb)
    color1 = int(tcr * 1000.0)
    color2 = int(tcg * 1000.0)
    color3 = int(tcb * 1000.0)
 
    # update color table

    # contrl(OPCODE) = SETxCOLORxREPRESENTATION
    opcd = SETxCOLORxREPRESENTATION
    # contrl(VERTICESxIN) = 0
    vertin = 0			     

    call gzddop (contrl, intin, idummy, idummy, idummy)

   return
end
E 1
