h48839
s 00834/00000/00000
d D 1.1 83/03/15 21:09:31 tes 1 0
c date and time created 83/03/15 21:09:31 by tes
e
u
4
U
t
T
I 1
#-h-  dd4662.c            local   03/24/82  11:21
#-h-  dd4662.rat          local   01/20/82  09:30
subroutine dd4662 (contrl, intin, rlin, intout, rlout)
########################################################################
#                                                                      #
#          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: GSS-CORE device driver for Tektronix 4662 plotter      #
#                                                                      #
#     Input Parameters:                                                #
#            contrl(1-3) - An integer array with following information #
#                          contrl(1) - opcode for driver function      #
#                          contrl(2) - length of integer array intin   #
#                          contrl(3) - length of real input array rlin #
#                                                                      #
#            intin   -     Array of integer input parameters           #
#                                                                      #
#            rlin    -     Array of real input parameters              #
#                                                                      #
#     Output Parameters:                                               #
#            contrl(4-6) - contrl(4) - length of integer array intout  #
#                          contrl(5) - length of integer array rlout   #
#                          contrl(6) - count of any other control parms#
#                                                                      #
#             rlout  -     Array of integer output parameters          #
#                                                                      #
#     Routines Called:                                                 #
#             dbuf62 - buffered output for the Tek 4662 plotter        #
#             dnfplt - prompt the user for a new sheet of paper        #
#             dr4662 - move/draw for Tek plotter                       #
#             da4662 - emulate a dashed line on the Tek plotter        #
#             dpnplt - prompt user to change the pen                   #
#             gimnmx - function to range check integer                 #
#             dp4662 - pen changer for 4662 plotter                    #
#             dm4662 - emulate markers for tek 4662                    #
#             itoch  - convert integer into character string           #
#             gdstot - put characters to the graphic device            #
#             gdstin - accept characters from the graphic deivice      #
#                                                                      #
########################################################################
	
include mgsdef
 
# local defines
define(X_LIMITS_TEK_4662,4095.)             #plotter surface width
define(Y_LIMITS_TEK_4662,2731.)             #plotter surface height
define(MIN_4662,.0002442)  # Number of ndc / device unit
define (MAX_TEK_4662_BUFFER,80)
 
integer contrl(1),intin(1),intout(1)
real rlin(1),rlout(1)
 
integer opcode, i, j, gimnmx,
        alpha(1), graphc(1), icnvt(4),
        liton(6), litoff(4),
        txtsiz(13), txtang(7), setup(20), stopgr(7), strtgr(3),
        line(9), tries, ginok
 
real home(2), xcoord, ycoord, xy(2)
 
integer cheksm, fixup
 
include mgscom
 
common /cm4662/ cheksm, fixup
 
# The following equivalence statements are used to decrease the amount of code
#   necessary to access specific array elements.  The array and the variables
#   equivalenced are listed below:
#       xy(1) :: xcoord
#       xy(2) :: ycoord
equivalence (xy(1), xcoord), (xy(2), ycoord)
 
#   Set text angle:  <esc> A J 0 0 0 <sub>
data txtang / ESC, BIGA, BIGJ, DIG0, DIG0, DIG0, SUB/
 
#   Set text size:  <esc> A  I 0000,0000 <sub>
data txtsiz / ESC, BIGA, BIGI, DIG0, DIG0, DIG0, DIG0, COMMA,
              DIG0,DIG0,DIG0,DIG0,SUB/
 
#   Set up the plotter for operation:
#      Turn the plotter on:   <esc> A E
#      Device reset:          <esc> A N
#      Set block size:        <esc> A H 125
#      Set alpha dimensions:  <esc> A I 41,41
data setup / ESC, BIGA, BIGE,
             ESC, BIGA, BIGN,
             ESC, BIGA, BIGH, DIG1, DIG2, DIG5,
             ESC, BIGA, BIGI, DIG4, DIG1, COMMA, DIG4, DIG1/
 
#  Start up block mode  <esc> A (
data strtgr / ESC, BIGA, LPAREN/
#  Stop graphics: Send block end and checksum:
#            <esc> A ) 1 7 3 <sub>
data stopgr / ESC, BIGA, RPAREN, DIG1, DIG7, DIG3, SUB/
 
#  Ring the bell and turn on the light for gin: <esc> <bell> <esc> A K <sub>
data liton /ESC, BELL, ESC, BIGA, BIGK, SUB/
 
#  Turn off the light after a gin:  <esc> A L <sub>
data litoff / ESC, BIGA, BIGL, SUB/
 
 
data graphc / GS/ # Used to get to graphic mode
data alpha / US/    # Used to get out of graphics mode
data home /0.0, 0.0/
 
 
opcode=contrl(OPCODE)
 
#
#  opcode move and draw
#
if  ((opcode == DRAW) | (opcode == MOVE)) {
 
   if ((opcode == DRAW) & (ndclrp ~= ndclrl))  {  # Need a new color
      i = ndclrl
      call dp4662 (i)
      }
 
   if (fixup == YES & opcode == DRAW)  {  # The cursor was moved by gin
      xcoord = zdxpos
      ycoord = zdypos
      call dr4662 ( MOVE, xy)
      fixup = NO
      }
 
   if ((opcode == MOVE) | (ndlntp == 1))  {
      call dr4662 (opcode, rlin)
      }
   else {  # Need to emulate the dash pattern
      call da4662 (rlin)   # Emulate the dash pattern
      }
   }
#
#  opcode text
#
else if (opcode == TEXT) {
 
   if (ndclrp ~= ndclrt) { # Need a new color
      i = ndclrt
      call dp4662 (i)
      }
   call dbuf62 (1, alpha)  # Get to alpha mode
 
   j = contrl(INTEGER_IN_LENGTH)   # Get the string length
 
   for (i = 1; i <= j; i = i + 1) {
       call dbuf62 (1, intin(i))
       }
   call dbuf62 (1, graphc)
   }
 
#
#  opcode marker
#
else if (opcode == MARKER) {
 
   if (ndclrp ~= ndclrm)  {  # Need a new color
      i = ndclrm
      call dp4662 (i)
      }
   call dm4662 ( intin, rlin)
   }
 
#
#  opcode set fill color
#
else if (opcode == SET_FILL_COLOR) {
 
   intout(1) = gimnmx (intin(1), 0, 7) # Emulation supports 8 patterns
   }
 
#
#  opcode text size
#
 
else if (opcode == TEXT_SIZE) {
 
   i = rlin(1) / MIN_4662 # Determine x value size
   if (i == 0) i = 1   # Make the char size as small as possible
   len = itoch (i, txtsiz(4), 4, ierror)
   #                      1/x_limit
   rlout(1) = float(i) * MIN_4662 # Return actual width
   txtsiz(len+4) = COMMA
 
   # And now convert the height values
   # These must be fudged somewhat since the plotter gives some 40% worth
   # Factor is (device char cell:88/device text hgt:53)* .90  (allow 10% gap)
   i = rlin(2) / MIN_4662 * 1.49  # Make the device size 49% bigger
   if (i == 0) i = 1   # Make the char size as small as possible
   ipos = len + 5
   len = itoch (i, txtsiz(ipos), 4, ierror)
   # Now returned the fudged height which is (size/fudge)
   rlout(2) = float(i) * MIN_4662 * .67 # Return the fudged height
   ipos = ipos + len
   txtsiz(ipos) = SUB
 
   call dbuf62 (ipos, txtsiz)  # Send out the text size command
   }
#
#  opcode line style
#
else if (opcode == LINESTYLE) {
      ndlntp = gimnmx (intin(1), 1, 5)  # Emulation supports 5 patterns
      intout(1) = ndlntp # Inform upper level of style selected 1-5
      }
 
#
#  opcode text rotation
#
else if (opcode == CHAR_ROTATION) {
      ndtxrt = mod (int(rlin(1)),360.) #Device can rotate in 1 degree
                                          # increments
      len = itoch ( ndtxrt, txtang(4), 3, ierror)
      len = len + 4
      txtang(len) = SUB
      call dbuf62 (len, txtang)
 
      rlout(1) = ndtxrt            # Inform upper level of angle
      }
#
#    opcode new_frame
#
else if (opcode == NEW_FRAME) {
      call dr4662 (MOVE, home)  # Home the plotter
      call dbuf62 (-1, icnvt)  # Dump buffer
      call dnfplt               # prompt user for new paper
      }
 
#
# opcode set line color
#
else if (opcode == SET_LINE_COLOR) {
   ndclrl = gimnmx( intin(1), 1, 8)
   intout(1) = ndclrl
   }
 
#
# opcode set text color
#
else if (opcode == SET_TEXT_COLOR) {
   ndclrt = gimnmx( intin(1), 1, 8)
   intout(1) = ndclrt
   }
 
#
# opcode set marker color
#
else if (opcode == SET_MARKER_COLOR) {
   ndclrm = gimnmx( intin(1), 1, 8)
   intout(1) = ndclrm
   }
 
#
# opcode set_device_parameters
#
else if (opcode == SET_DEVICE_PARAMETERS) {
 
      # set up device capability array
 
      devcap(TEXT_CAP) = YES      # Text capability
      devcap(LINESTYLE_CAP) = 5   # Capable of 5 different linestyle
      devcap(TEXT_SIZE_CAP) = 100 # Capable of many different text sizes
      devcap(GIN_CAP) = YES       # Capable of graphic input
      devcap(MARKER_CAP) = 5      # Capable of 5 different markers
      devcap(TEXT_ROT_CAP) = 360  # Capable of 360 different text rotations
 
      # Initialize Device Driver globals
 
      zdlgax = X_LIMITS_TEK_4662  # Set the length of the longest axis
      zdxlng = 1.0              # Set x and y axis lengths in NDC units
      zdylng = 0.6669108        # Y_LIMITS_TEK_4662/X_LIMITS_TEK_4662
 
      ndlntp = 1                # A solid line
      ndclrl = 1                # Default line color is index 1
      ndclrt = 1                # Default text color is index 1
      ndclrm = 1                # Default marker color is index 1
      ndclrp = -1               # No pen has been selected yet
 
      zdxpos = 0.0              # Default position is at home
      zdypos = 0.0
      zdtxsz = .0100122        # Set character width in common
      zdtysz = .0100122        # Set character height in common
 
      # initialize plotter
 
      fixup = NO                # Initialize the GIN/cursor position flag
      cheksm = LPAREN           # Initialize the checksum for block mode
      ndotkt = 0                # Initialize the plotter ouput counter. This
                                #    counter is used by the routine 'dbuf62'
      call gdstot (20, setup)   # Must use gdstot because block mode is set
                                # by this command
      call gdstot (3, strtgr)   # Start up block mode
      call gdevot (NEWLINE)     # force the buffer out
      }
 
#
#    get point
#
else if (opcode == GET_POINT) {
   call dbuf62 (-1, alpha)  # First flush the buffer
   contrl(4) = 0
   tries = 0
   repeat  {   # Try three times for good point
      ginok = YES
      call dbuf62 (6, liton)  # Turn on the prompt light and ring the bell
      call dbuf62 (-1, alpha)  # Dump the buffer
      call gdstot (7, stopgr)  # End the nul block
      repeat { call gdstin (2,line,k) } until (line(1)==BIGA | line(1)==BIGI)
      call gdstin (9, line, i)
      if (i <= 17)  { # Verify characters returned
         do j = 1, 6 {
            if (line(j) < SPACE | line(j) > QMARK) ginok = NO
            }
         }
      else { # Too many chars
         ginok = NO
         }
      tries = tries + 1
 
      call gdstot (3, strtgr)  # Start up the block mode again
      cheksm = LPAREN
 
      } until (ginok == YES | tries >= 3)
   call dbuf62 (4, litoff)  # Turn off the prompt light
 
   # Parse the gin report
   if (ginok == YES) {
      xcoord = mod(line(1),32)*128+mod(line(3),32)*4+mod(line(5)/8,4)
      ycoord = mod(line(2),32)*128+mod(line(4),32)*4+mod(line(6)/8,4)
      rlout(1) = xcoord / X_LIMITS_TEK_4662
      rlout(2) = ycoord / X_LIMITS_TEK_4662
      intout(1) = mod(line(7)/4,2) + DIG0 # 0 = pen up,  1 = pen down
      contrl(4) = 1
      }
   fixup = YES   # Now must reposition the cursor for the next move
   }
#
#     inquire screen size
#
else if (opcode == INQUIRE_SCREEN_SIZE) {
   rlout(1) = zdxlng
   rlout(2) = zdylng
   rlout(3) = X_LIMITS_TEK_4662
   }
 
#
#  opcode escape
#
else if (opcode == ESCAPE) {
   j = contrl(INTEGER_IN_LENGTH)
   call dbuf62 (j, intin(i))
   }
 
#
#     stop graphics
#
else if (opcode == STOP_GRAPHICS) {
   call dr4662 (MOVE, home)
   call dbuf62 (-1, alpha)      # Dump buffer
   call gdstot (7, stopgr)
   call gdevot (NEWLINE)  # Force the buffer out
   repeat { call gdevin (i) } until (i == BIGA | i == BIGI)
   }
 
return
end
#-t-  dd4662.rat          local   01/20/82  09:30
#-h-  dm4662.rat          local   03/24/82  11:21
subroutine dm4662 (marker,rlin)
########################################################################
#                                                                      #
#          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: Place a marker at the current location on a 4662       #
#                                                                      #
#     Input Parameters:                                                #
#            marker - marker symbol index (1-5)                        #
#            rlin   - x/y location for marker                          #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     Routines Called:                                                 #
#            dr4662 - TEK 4662 move/draw routine                       #
#                                                                      #
########################################################################
 
include mgsdef
 
define (MARK_PERIOD,1)
define (MARK_PLUS,2)
define (MARK_STAR,3)
define (MARK_O,4)
define (MARK_X,5)
define (FULLSZ,.0125)
define (HALFSZ,.00625)
define (FPERSZ,.005)
define (HPERSZ,.0025)
 
integer marker
real rlin(1)
 
real fsize, hsize, x1, x2, y1, y2
real rxy(2), rxy1, rxy2
 
include mgscom
 
# 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:
#
#       rxy(1) :: rxy1
#       rxy(2) :: rxy2
 
equivalence (rxy(1), rxy1), (rxy(2), rxy2)
 
 
   if (marker == MARK_PERIOD) {
      fsize = FPERSZ
      hsize = HPERSZ
      }
   else {
      fsize = FULLSZ
      hsize = HALFSZ
      }
 
   x1 = rlin(1) - hsize        #clip marker to device limits
   x2 = x1 + fsize
   y1 = rlin(2) - hsize
   y2 = y1 + fsize
   if ((amin1(x1,y1) < 0.0) | (x2 > zdxlng) | (y2 > zdylng)) return
 
   # output appropriate marker centered on location
 
   rxy1 = x1
   rxy2 = y1
   call dr4662 (MOVE, rxy)   # move to lower left corner of character cell
 
   if (marker == MARK_PERIOD | marker == MARK_O) {
      rxy1 = x2
      call dr4662 (DRAW, rxy)
      rxy2 = y2
      call dr4662 (DRAW, rxy)
      rxy1 = x1
      call dr4662 (DRAW, rxy)
      rxy2 = y1
      call dr4662 (DRAW, rxy)
      }
   else {
      if (marker == MARK_X | marker == MARK_STAR) {
         rxy1 = x2
         rxy2 = y2
         call dr4662 (DRAW, rxy)
         rxy2 = y1
         call dr4662 (MOVE, rxy)
         rxy1 = x1
         rxy2 = y2
         call dr4662 (DRAW, rxy)
         }
      if (marker == MARK_PLUS | marker == MARK_STAR) {
         rxy2 = y1 + hsize
         call dr4662 (MOVE, rxy)
         rxy1 = x2
         call dr4662 (DRAW, rxy)
         rxy1 = x1 + hsize
         rxy2 = y1
         call dr4662 (MOVE, rxy)
         rxy2 = y2
         call dr4662 (DRAW, rxy)
         }
      }
   call dr4662 (MOVE, rlin)     # Return the cursor position to the original
                                #    value
   return
end
#-t-  dm4662.rat          local   03/24/82  11:21
#-h-  da4662.rat          local   04/23/82  14:00
subroutine da4662 (rlin)
########################################################################
#                                                                      #
#          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: GSS-CORE device driver dash emulation for 4662 devices #
#                                                                      #
#     Input Parameters:                                                #
#            rlin    -     Array of real input parameters              #
#                                                                      #
#     Output Parameters: none                                          #
#                                                                      #
#     Routines Called:                                                 #
#             dr4662 - do a move/draw                                  #
#                                                                      #
########################################################################
 
include mgsdef
 
#local defines
define (DASH_INCREMENT,.015625)
 
real rlin(1)
 
integer actary(16), action, j, k, kk, opcode
real dx, dy, dxinc, dyinc, px1, py1, px2, py2,
     dr, p1(2), x, y
 
include mgscom
 
# 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:
#
#       p1(1) :: x
#       p1(2) :: y
 
equivalence (p1(1), x), (p1(2), y)
 
 
#action definitions for line styles 2-5: 0=move, 1=draw, 2=point
data actary / 2, 2, 2, 2,  2, 0, 1, 2,  0, 1, 0, 1,  0, 1, 1, 0 /
 
   dx = rlin(1) - zdxpos   # determine the distance from the current position
   dy = rlin(2) - zdypos
   dr = sqrt(dx**2 + dy**2)
   if (dr < zeps) return   # If we're already there just return
 
   dxinc = (dx/dr)*DASH_INCREMENT   #normalize dx and dy
   dyinc = (dy/dr)*DASH_INCREMENT   #   and scale to incremental value
   plngth = abs(dy)
   pinc = abs(dyinc)
   if (abs(dx) > abs(dy)) {
      plngth = abs(dx)
      pinc = abs(dxinc)
      }
   # p1(1)
   x = zdxpos
   # p1(2)
   y  = zdypos
   j = 0
   k = (ndlntp-2)*4 + 1
   for (p=0.0; p<=plngth; p=p+pinc) {
      if (j > 3) {
         j = 0
         call gdevot (NEWLINE)   #flush output buffer
         }
      kk = k + j
      action = actary(kk)
      if (action == 0)      { opcode = MOVE }
      else if (action == 1) { opcode = DRAW }
      else {
         call dr4662 (MOVE, p1)
         opcode = DRAW
         }
      call dr4662 (opcode, p1)
      # p1(1) = p(1) + dxinc
      x = x + dxinc
      # p1(2) = p1(2) + dyinc
      y = y + dyinc
      j = j + 1
      }
   if (j > 3) j = 0
   kk = k + j
   if (actary(kk) == 1) { call dr4662 (DRAW, rlin) }
   else                 { call dr4662 (MOVE, rlin) }  # Insure that we are at
                                                      #    the end point.
   return
end
#-t-  da4662.rat          local   04/23/82  14:00
#-h-  dr4662.rat          local   01/20/82  09:30
subroutine dr4662 (opcode, rlin)
########################################################################
#                                                                      #
#          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: GSS-CORE device driver move/draw for TEK_4662          #
#                                                                      #
#     Input Parameters:                                                #
#           opcode - driver function, either move/draw                 #
#                                                                      #
#            rlin    -     Array of real input parameters              #
#                                                                      #
#     Output Parameters: none                                          #
#                                                                      #
#     Routines Called:                                                 #
#            dbuf62 - output a string to the TEK_4662 plotter          #
#                                                                      #
########################################################################
 
include mgsdef
 
integer opcode
real rlin(1)
 
integer bytes(5), xhi, ext, xlo, yhi, ylo, moveit(1)
 
integer cheksm
 
include mgscom
 
common /cm4662/ cheksm
 
# The following equivelence statement is used to decrease the amount of code
#    necessary to access specific array elements.  The arrays and the
#    variables equivalenced are listed below:
#
#        bytes(1) :: yhi
#        bytes(2) :: ext
#        bytes(3) :: ylo
#        bytes(4) :: xhi
#        bytes(5) :: xlo
 
equivalence (bytes(1),yhi), (bytes(2),ext), (bytes(3),ylo), (bytes(4),xhi),
            (bytes(5),xlo)
 
data moveit /GS/
 
   if (opcode == MOVE) { # Put out a GS
      call dbuf62( 1, moveit)
      }
 
   call xy4662 (rlin(1), rlin(2), bytes)
   # Save the hiy...lox bytes
   nhiy = yhi
   nextby = ext
   nloy = ylo
   nhix = xhi
   nlox = xlo
 
   zdxpos = rlin(1)   # Save the current device pen position in NDC units
   zdypos = rlin(2)
   return
end
#-t-  dr4662.rat          local   01/20/82  09:30
#-h-  xy4662.rat          local   01/20/82  09:30
subroutine xy4662 (x, y, bytes)
########################################################################
#                                                                      #
#          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: GSS-CORE device driver move/draw for TEK_4662          #
#                                                                      #
#     Input Parameters:                                                #
#           opcode - driver function, either move/draw                 #
#                                                                      #
#            rlin    -     Array of real input parameters              #
#                                                                      #
#     Output Parameters: none                                          #
#                                                                      #
#     Routines Called:                                                 #
#            dbuf62 - output a string to the TEK_4662 plotter          #
#                                                                      #
########################################################################
 
include mgsdef
 
# Local defines
define(HI_Y,32)                              # Tek hi y tag
define(EXTRA_BYTE,96)                        # Tek extra byte tag
define(LO_Y,96)                              # Tek lo y tag
define(HI_X,32)                              # Tek hi x tag
define(LO_X,64)                              # Tek lo x tag
 
integer bytes(5), i, kx, ky
real x, y
 
include mgscom
 
   kx = zdlgax * x   # Transform point from NDC to device dependent coord
   ky = zdlgax * y   #   `zdlgax` is the length of the longest axis
 
   bytes(1) = mod(ky/128,32) + HI_Y # Shift left 7 bits and set yhi tag
   bytes(2) = mod(kx,4) + mod(ky,4)*4 + EXTRA_BYTE # Take 2 bits from each
   bytes(3) = mod(ky/4,32) + LO_Y    # Take the middle 5 bits for loy
   bytes(4) = mod(kx/128,32) + HI_Y  # Shift left 7 bits and set xhi tag
   bytes(5) = mod(kx/4,32) + LO_X    # Take the middle 5 bits for lox
 
   call dbuf62 (5, bytes)
 
   return
 
end
#-t-  xy4662.rat          local   01/20/82  09:30
#-h-  dp4662.rat          local   03/24/82  11:21
subroutine dp4662 (color)
########################################################################
#                                                                      #
#          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: Change the color on the Tektronix 4662 plotter         #
#                                                                      #
#     Input Parameters:                                                #
#            color - color to change to                                #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     Routines Called:                                                 #
#            dbuf62 - device dependent communications routine          #
########################################################################
 
include mgsdef
 
integer color
 
integer penchg(6)
 
include mgscom
data penchg / ESC, BIGA, BIGB, BIGP, DIG0, SUB/
 
   penchg(5) = color + DIG0
   call dbuf62 ( 6, penchg)
 
   ndclrp = color
   return
end
#-t-  dp4662.rat          local   03/24/82  11:21
#-h-  dbuf62.rat          local   01/20/82  09:30
subroutine dbuf62(icount,iarray)
########################################################################
#                                                                      #
#          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: TEK_4662 buffered output handler                       #
#                                                                      #
#     Input Parameters:                                                #
#           icount - number of characters in iarray to be output       #
#                                                                      #
#           iarray - Array of characters to be output                  #
#                                                                      #
#     Output Parameters: none                                          #
#                                                                      #
#     Routines Called:                                                 #
#            gdevin - get a character form the graphics device         #
#            gdevot - output a character to the device                 #
#            gdstot - output a string to the device                    #
#                                                                      #
########################################################################
 
include mgsdef
 
#local define
define (MAX_TEK_4662_BUFFER,100)
 
integer icount, iarray(1)
 
integer c, k, strtbk(3), endbk(3), icnvt(4), len, buf(2)
 
integer cheksm, fixup
 
include mgscom
 
common /cm4662/ cheksm, fixup
 
data strtbk / ESC, BIGA, LPAREN/
 
data endbk  / ESC, BIGA, RPAREN/
 
 
   k = icount
   if (k < 0)  k = 0
   if ((ndotkt+k > MAX_TEK_4662_BUFFER) | (icount < 0))  { # Send the block
 
      do i = 1, 3  {  # Put the block end into the check sum
         if (cheksm+endbk(i) > 4095)  cheksm = cheksm - 4095
         cheksm = cheksm + endbk(i)
         }
      call gdstot ( 3, endbk)
      len = itoch( cheksm, icnvt, 4, ierror)
      call gdstot ( len, icnvt)  # Put out the checksum
      call gdevot (SUB)  # End the checksum
      call gdevot (NEWLINE)
 
      repeat { call gdevin (c) } until (c==BIGA | c==BIGI)
 
      call gdstot (3, strtbk)
 
      ndotkt = 0   # Reset the character counter
      cheksm = LPAREN  # Reset the checksum
      }
 
   for ( i=1; i<=k; i=i+1)  {
      if (iarray(i)==NUL | iarray(i)==SYN | iarray(i)==NEWLINE)  next
      if (cheksm+iarray(i) > 4095)  cheksm = cheksm - 4095
      cheksm = cheksm + iarray(i)
      }
   call gdstot ( k, iarray)
   ndotkt = ndotkt + k
 
   return
end
#-t-  dbuf62.rat          local   01/20/82  09:30
#-t-  dd4662.c            local   03/24/82  11:21
#-h-  dd7470.c            local   03/24/82  11:21
E 1
