h21986
s 00015/00006/00166
d D 1.2 83/03/31 12:34:56 mmm 2 1
c 
e
s 00172/00000/00000
d D 1.1 83/03/15 21:40:43 tes 1 0
c date and time created 83/03/15 21:40:43 by tes
e
u
4
U
t
T
I 1
subroutine gopwk (wkid, conid, wtype)
########################################################################
#                                                                      #
#          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: Initialize the graphic system for the current device   #
#                                                                      #
#     Input Parameters:                                                #
#            wkid    -  workstation identifier                         #
#            conid   -  connection identifier                          #
#            wtype   -  workstation type                               #
#                                                                      #
#      Output Parameters:                                              #
#            none                                                      #
#                                                                      #
#     Errors:                                                          #
#        8 GKS not in proper state: GKS must be in one of the states   #
#          GKOP, WSOP, WSAC or SGOP                                    #
#       20 Specified workstation identifier is invalid                 #
#       22 Specified workstation type is invalid                       #
#       24 Specified workstation is open                               #
#                                                                      #
#     Routines Called:                                                 #
#            arysgn - copy integer arrays                              #
#            errchk - perform appropriate error checking               #
#            gzatt  - internal routine to call gzddop                  #
#            gzddop - call current device driver                       #
#            gzmtid - set a matrix to identity                         #
#            gschh  - set character height                             #
#            gschu  - set character up vector                          #
#            gslnsf - set line width scale factor                      #
#            gsmssf - set marker size scale factor                     #
#            gclrwk - perform new frame action                         #
#                                                                      #
########################################################################
integer wkid, conid, wtype

ifdef(`ERROR_ON',`
   integer errchk, errind, ierary(1), erary1
   ')

integer devary(45), contrl(5), intin(10), ptsin(1), idummy, 
	iarray(1), intout(45), ptsout(12), shrtax, i
I 2

# The following 'integer*1' declarations represent eight byte data
# areas to be used on CP/M in converting real numbers in non-FORTRAN 
# format to FORTRAN reals.  These areas will represent the non-FORTRAN
# format reals.
ifdef(`F80',`
integer*1 rtemp1(8), rtemp2(8)
',`
E 2
real rtemp1, rtemp2
I 2
')
E 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:
#
#       devary(1) :: mxdsdc(1)
 
equivalence (devary(1), mxdsdc(1))

ifdef(`ERROR_ON',`
      equivalence (ierary(1), erary1)
      rounum = GOPWK
      #   ierary(1) = wtype
      erary1 = wtype
      errind = errchk (wkid, ierary)
      if (gksopr <= GKOP) {   # Close console IO if error checking on
	 call giostp          # and no other workstations open
	 }
      ')

   if (gksopr >= WSOP) { 
      call gzatt (CLOSExWORKSTATION, idummy, idummy)
      }

   # Set GKS to 'at least one workstation open' state
   gksopr = WSOP
   wrkopn = wkid
   wrkid = wkid
   wrkact = 0  # Make sure no other device is open (level 0a only)
 
   intin(1) = wkid
   intin(2) = lntyp
   intin(3) = plclr
   intin(4) = mktyp
   intin(5) = pmclr
   intin(6) = txfnt
   intin(7) = txclr
   intin(8) = faint
   intin(9)= fasty
   intin(10)= faclr

   contrl(OPCODE) = OPENxWORKSTATION  
   contrl(VERTICESxIN) = 0
   contrl(INTEGERxINxLENGTH) = 10

   call gzddop (contrl, intin, ptsin, intout, ptsout)

   call gclrwk (wkid,1)          # Clear the display surface

   contrl(OPCODE) = SETxINPUTxMODE  # Initialize device to 
   contrl(INTEGERxINxLENGTH) = 2    # request input mode for
   intin(2) = 1                     # all four types of input
   do i = 1,4 {
	intin(1) = i
	call gzddop (contrl, intin, ptsin, iarray, iarray)
	}

   # Set device dependent values
   call arysgn (45, intout, devary)

   mnchht = ptsout(2)  # minimum character height
   mxchht = ptsout(4)  # maximum character height
   mnlnwd = ptsout(5)  # minimum line width
   mxlnwd = ptsout(7)  # maximum line width
   mnmksz = ptsout(10)  # minimum marker height 
   mxmksz = ptsout(12)  # maximum marker height

   # Initialize number of defined colors to be number of predefined colors
   clnum = pclnum

   # Initialize current workstation window and viewport 

   cwrkwn(1) = 0.0
   cwrkwn(2) = 1.0
   cwrkwn(3) = 0.0
   cwrkwn(4) = 1.0

   # compute to real meter per raster size
   sptszx = float(ispszx) / 1E+6
   sptszy = float(ispszy) / 1E+6

   # initialize maximum real display size
   if (devcor == METERS) {
     mxdsln(1) = sptszx * float(mxdsdc(1))
     mxdsln(2) = sptszy * float(mxdsdc(2))
     }
   else {
      mxdsln(1) = mxdsdc(1)
      mxdsln(2) = mxdsdc(2)
      }
      
   # initialize workstation viewport in 32k space

   shrtax = min0(mxdsdc(1), mxdsdc(2)) # Find the shortest axis 

   cwrkvw(1) = 0.0
   cwrkvw(2) = shrtax                       
   cwrkvw(3) = 0.0
   cwrkvw(4) = shrtax                         

   nwkvw = 1          # Set workstation viewing transform dirty so current 
		      # device viewport limits will be initialized

   # Set current character height and up vector
   
D 2
   PUTREAL(chrhgt, rtemp1)  # Put back into user format real for internal
   call gschh (rtemp1)      # calls
   PUTREAL(chrupx, rtemp1)
   PUTREAL(chrupy, rtemp2)
E 2
I 2
   call ptreal (chrhgt, 0, rtemp1)  # Put back into user real for internal
   call gschh (rtemp1)              # calls
   call ptreal (chrupx, 0, rtemp1)
   call ptreal (chrupy, 0, rtemp2)
E 2
   call gschu (rtemp1,rtemp2)

   # Set the current line width and marker size scale factors

D 2
   PUTREAL(lnwdsf, rtemp1)
E 2
I 2
   call ptreal (lnwdsf, 0, rtemp1)
E 2
   call gslwsf (rtemp1)
D 2
   PUTREAL(mkszsf, rtemp1)
E 2
I 2
   call ptreal (mkszsf, 0, rtemp1)
E 2
   call gsmssf (rtemp1)

   return
end
E 1
