h61859
s 01178/00000/00000
d D 1.1 83/03/15 21:15:47 tes 1 0
c date and time created 83/03/15 21:15:47 by tes
e
u
4
U
t
T
I 1
subroutine ddgn2a (contrl, intin, ptsin, intout, ptsout)
########################################################################
#                                                                      #
#          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: ADM 5 GEN2 Digital Engineering Device Driver           #
#                                                                      #
#     Input Parameters:                                                #
#            contrl(1) - opcode for driver function                    #
#            contrl(2) - number of vertices in array ptsin             #
#            contrl(4) - length of integer array intin                 #
#            contrl(6-n) - Opcode dependent information                #
#                                                                      #
#            intin   -     Array of integer input parameters           #
#            ptsin   -     Array of input coordinate data              #
#                                                                      #
#     Output Parameters:                                               #
#            contrl(3)   - number of vertices in array ptsout          #
#            contrl(5)   - length of integer array intout              #
#            contrl(6-n) - Opcode dependent information                #
#                                                                      #
#            intout      - array of integer output parameters          #
#            ptsout      - array of output coordinate data             #
#                                                                      #
#     Routines Called:                                                 #
#             gchtoi   - convert a character string to a binary integer#
#             gitoch   - convert integer to character string           #
#             dcgen2 - change color on GEN II                          #
#             dmpgn2 - set color on GEN II                             #
#             dmgen2 - marker output emulation for GEN II              #
#             drgen2 - move/draw for GEN II                            #
#             GDEVIN  - get a character from the device                #
#             gdevot  - put a character to device                      #
#             gdstot - put a character string to the device            #
#             gdstin - get a string of characters from the device      #
#             gimnmx - perform min-max check for integer               #
#             mult   - perform integer multiplication                  #
#             divid  - perform integer division                        #
#             muldiv - perform integer division and multiplication     #
#                                                                      #
########################################################################
 
# local defines
#define(`CODExON')                        # code switch
define(`XxLIMITSxGEN2',639)              # screen surface width
define(`YxLIMITSxGEN2',419)              # screen surface height
define(`COM_CHAR',BANG)                  # command character
define(`NOTxOK',0)
define(`OK',1)
define(`DEFAULT',1)                       # Default GIN device
define(`CROSSHAIRS',2)                    # Crosshairs
define(`MOVE',1)
define(`DRAW',2)
define(`REPLACExMODE',1)                # Replace writing mode
define(`OVERSTRIKExMODE',2)             # Overstrike writing mode
define(`XORxMODE',3)                    # Xor writing mode
define(`ERASExMODE',4)                  # Erase writing mode
define(`STRINGxINPUT',4)                # String input class
define(`HOLLOW',0)                      # Hollow fill interior style
define(`SOLID',1)                       # Solid fill interior style
define(`PATTERN',2)                     # Pattern fill interior style
 
integer contrl(1),intin(1),intout(1),ptsin(1),ptsout(1)
 
#  GEN2 dd common declarations
integer rdgen2(7), grgen2(7), blgen2(7), row, column
 
SHORTINT opcode
integer i, j, k, l, line(30), nx, ny, circle(5), pie(9),
        enagin(13), newfrm(8), setup(4), iniwrk(28), iniclr(9), ptsini(12),
	lstyle(8), kstyle, nchar, xy(2), vector(4), iniary(45), chrhgt,
        temp, kstop, gitoch, cscale(9), crot(9), raster(12), chrwdt
integer xbar(4), ybar(4), poly(4), gimnmx, xtemp, ytemp,
        txtatt(9), xstart, ystart, ilen, ierror, mult, divid, muldiv,
	angbeg, angend, mdtran(4), txtstr(6), wrtmod(7), xrot(4),
	yrot(4), xoffst(4), yoffst(4), erascr(2), eralin(2), craddr(4),
	rdback(8) 
ifdef(`CODExON',`
integer xrpt, yrpt, m, n, pixel, xincr, yincr, savex, savey, colptr, xcoord,
	ycoord, xcount, ycount
')
 
include(`ddcom')
 
common /cmgen2/ rdgen2, grgen2, blgen2, row, column       # gen2 dd common
 
# The following equivalence statement is used to decrease the amount of code
#    necessary to access specific array elements. The array and the
#    variable equivalenced are listed below:
#
#       lstyle(6) :: kstyle
 
equivalence (lstyle(6), kstyle)
 
#            Table of x and y rotation factors at 90 degree intervals
data xrot  / 0, -1, 0, 1/
data yrot  / 1, 0, -1, 0/

#            Table of inter-character gaps in x and y directions with
#            rotation taken into account
data xoffst/ -1, 0, 1, 0/
data yoffst/ 0, -1, 0, 1/
 
#            Enable gin - <COM_CHAR>BEL<COM_CHAR>ENA 1
data enagin/ COM_CHAR,BIGB,BIGE,BIGL,CR,_
	     COM_CHAR,BIGE,BIGN,BIGA,BLANK,DIG1,CR,NEWLINE/
 
#            Line style - <COM_CHAR>LIN <style>
data lstyle/ COM_CHAR,BIGL,BIGI,BIGN,BLANK,0,CR,NEWLINE/
 
#            New frame - <COM_CHAR>ERA G
data newfrm/ COM_CHAR,BIGE,BIGR,BIGA,BLANK,BIGG,CR,NEWLINE/
 
#            Set up for grahics - build work space, graphics space and
#            position cursor - (GS)(ESC)"6g
data setup / ESC,DQUOTE,DIG6,LETG/

#            <COM_CHAR>WOR 30;<COM_CHAR>GRA 1,30;<COM_CHAR>BIT 6
data iniwrk/ COM_CHAR,BIGW,BIGO,BIGR,BLANK,DIG3,DIG0,CR,NEWLINE,_
             COM_CHAR,BIGG,BIGR,BIGA,BLANK,DIG1,COMMA,DIG3,DIG0,CR,NEWLINE,_
             COM_CHAR,BIGB,BIGI,BIGT,BLANK,DIG6,CR,NEWLINE/

#            <COM_CHAR>COL C1
data iniclr/ COM_CHAR,BIGC,BIGO,BIGL,BLANK,BIGC,DIG1,CR,NEWLINE/

#            Output a vector - <COM_CHAR>VEC
data vector/ COM_CHAR,BIGV,BIGE,BIGC/
 
#            Transparent mode - ESC"0g
data mdtran/ ESC,DQUOTE,DIG0,LETG/
 
#            Set text attributes - <COM_CHAR>ATT
data txtatt/ COM_CHAR,BIGA,BIGT,BIGT,BLANK,BLANK,BLANK,CR,NEWLINE/

#            Send string of text - <COM_CHAR>STR ~
data txtstr/ COM_CHAR,BIGS,BIGT,BIGR,BLANK,TILDE/

#            Polygon - <COM_CHAR>POL
data poly  / COM_CHAR,BIGP,BIGO,BIGL/
 
#            Circle - <COM_CHAR>CIR
data circle/ COM_CHAR,BIGC,BIGI,BIGR,BLANK/

#            Pie slice - <COM_CHAR>PIE
data pie   / COM_CHAR,BIGP,BIGI,BIGE,BLANK,0,0,0,0/

#            Character Scaling - <COM_CHAR>CSC
data cscale/ COM_CHAR,BIGC,BIGS,BIGC,BLANK,0,0,0,0/

#            Character rotation - <COM_CHAR>CRO
data crot  / COM_CHAR,BIGC,BIGR,BIGO,BLANK,0,0,0,0/

#            Raster input from host - <COM_CHAR>RAS
data raster/ COM_CHAR,BIGR,BIGA,BIGS,BLANK,0,0,0,0,0,0,0/

#            Read pixel value from terminal - <COM_CHAR>REA 1CR
data rdback/ COM_CHAR,BIGR,BIGE,BIGA,BLANK,DIG1,CR,NEWLINE/

#            Set writing mode
data wrtmod/ COM_CHAR,BIGC,BIGM,BIGO,BLANK,BLANK,CR/

#            Erase to end of screen
data erascr/ ESC, BIGY/

#            Erase to end of line
data eralin/ ESC, BIGT/

#            Load cursor address
data craddr/ ESC, EQUALS, 0, 0/

#            Device dependent information array
data iniary/XxLIMITSxGEN2,   # Addressable width in rasters of screen
            YxLIMITSxGEN2,   # Addressable height in rasters of screen
            OTHER,           # Device coordinates in raster units
            381,        # Micrometers per raster along x-axis
            381,        # Micrometers per raster along y-axis
            0,          # Continuous character scaling
            8,          # Number of line types
            1,          # Number of line widths
            5,          # Number of marker types
            1,          # Number of marker sizes
            1,          # Number of fonts
            120,        # Number of patterns
            0,          # Number of hatch styles
            7,          # Number of predefined colors
            4,          # Number of GDPs
            1,          # Bar GDP
            2,          # Arc GDP
            3,          # Pie Slice GDP
            4,          # Circle GDP
            -1,-1,-1,-1,-1,-1,   # Items 20 - 25 to fill out the GDP list
            3,          # Bars use fill area attributes
            0,          # Arcs use line attributes
            3,          # Pie slices use fill area attributes
            3,          # Circles use fill area attributes
	    -1,-1,-1,-1,-1,-1, # Items 30 - 35 to fill GDP attribute list
            MONOCHROME, # Color capability flag
            YES,        # Text rotation capability flag
            YES,        # Polygon fill capability flag
            YES,        # Pixel operation capability flag
            0,          # Total number of "colors" available
            1,          # Number of locator devices available
            0,          # Number of valuator devices available
            0,          # Number of choice devices available
            1,          # Number of string devices available
            2/          # Workstation type (Input/Output)

#           More device dependent information
data ptsini/ 0,
             5,           # Minimum character height
             0, 
             419,         # Maximum character height
             1,           # Minimum line width in device units
             0,   
             1,           # Maximum line width in device units
             0,
             0,
             12,          # Minimum marker height in device units
             0,
             12/          # Maximum marker height in device units
 
opcode=contrl(OPCODE)
contrl(3) = 0
 
#
#  opcode OPEN WORKSTATION
#
if (opcode == OPENxWORKSTATION) {
 
   contrl(3) = 6         # Number of vertices in ptsout
   contrl(5) = 45        # Number of elements in intout

   ndlntp = intin(2)     # Current device line style
   if (ndlntp < 1 | ndlntp > 8) ndlntp = 1
   ndlntp = ndlntp + DIG0
   ndclrl = gimnmx (intin(3), 0, 6) + DIG0   # Current polyline color
   ndmktp = intin(4)      # Current polymarker type
   if (ndmktp < 1 | ndmktp > 5) ndmktp = 3  # use default
   ndclrm = gimnmx (intin(5), 0, 6) + DIG0  # Current polymarker color
   ndclrt = gimnmx (intin(7), 0, 6) + DIG0  # Current text color
   ndfstl = intin(8)                        # Fill interior style
   if (ndfstl < HOLLOW | ndfstl > PATTERN) ndfstl = HOLLOW  # Default is hollow
   ndflpt = gimnmx (intin(9), 1, 120) -1    # Fill style index
   ndclrf = gimnmx (intin(10), 0, 6) + DIG0  # Current fill area color
   ndclrp = -1                       # No current color
   ndlcmd = REQUESTxMODE             # Locator input mode is request
   ndstmd = REQUESTxMODE             # String input mode is request

   do i = 1,45 { intout(i) = iniary(i) }  # Set integer output array

   do i = 1,12 { ptsout(i) = ptsini(i) }  # Set output points array

   # initialize color table
   # The first seven entries are dithering patterns :
   #     63, 3, 12, 48, 15, 16, 51, 0
 
   do i=1,7 {
      rdgen2(i) = 0
      grgen2(i) = 0
      blgen2(i) = 0
      }
   rdgen2(2) = 100
   grgen2(3) = 100
   blgen2(4) = 100
   grgen2(5) = 100
   blgen2(5) = 100
   rdgen2(6) = 100
   grgen2(6) = 100
   rdgen2(7) = 100
   blgen2(7) = 100
 
   # initialize device
 
   call gioini (1)            # Initialize i/o system for crt device
   call gdevot (GS)           # Put terminal in 4010 mode
   call gdstot (4, setup)     # Put terminal in 4027 mode
   call gdstot (28, iniwrk)   # Initialize the workstation and graphics area

   # Mix colors
   do i=1,7 {
      call dmpgn2 (i-1, rdgen2(i), grgen2(i), blgen2(i))
      }

   call gdstot (9, iniclr)    # Specify use of C1 for line color
   txtatt(6) = DIG3           # Use font 32 as default
   txtatt(7) = DIG2
   call gdstot (9, txtatt)
   kstyle = DIG1               # Use solid line as default
   call gdstot (8, lstyle)
   txtatt(6) = BIGC            # Use text color C1
   txtatt(7) = DIG1
   call gdstot (9, txtatt)
   }
 
#
#  opcode CLOSE WORKSTATION
#
else if (opcode == CLOSExWORKSTATION) {
   call dmpgn2 (0, 100, 100, 100)   # Map foreground text color to white
   call gdstot (4, mdtran)          # Put back in transparent mode
   call gdevot (NEWLINE)   # Insure that buffer has been output
   }

#
#    opcode CLEAR WORKSTATION
#
else if (opcode == CLEARxWORKSTATION) {
   call gdstot (8, newfrm)     # Clear the display area
   }
 
#
#  opcode UPDATE WORKSTATION
#
else if (opcode == UPDATExWORKSTATION) {
   call gdevot (NEWLINE)
   }

#
#  opcode ESCAPE
#
else if (opcode == ESCAPE) {
   opcode = contrl(6)
   if (opcode == INQUIRExADDRESSABLExCELLS) {
      intout(1) = 24
      intout(2) = 80
      }
   else if (opcode == ENTERxGRAPHICSxMODE) {
      call gdevot (GS)           # Set up 4010 mode
      call gdstot (4, setup)     # Enter 4027 mode
      call gdstot (28, iniwrk)   # Initialize workspace and graphics area
      txtatt(6) = DIG3           # Use font 32
      txtatt(7) = DIG2
      call gdstot (9, txtatt)
      }
   else if (opcode == EXITxGRAPHICSxMODE) {
      call gdstot (8, newfrm)    # Erase screen
      call gdstot (4, mdtran)    # Exit graphics mode
      }
   else if (opcode == CURSORxUP) {
      call gdevot (VT)
      row = gimnmx ((row - 1), 1, 24)
      }
   else if (opcode == CURSORxDOWN) {
      call ddlf                  # Call routine to output a linefeed character
      row = gimnmx ((row + 1), 1, 24)
      }
   else if (opcode == CURSORxRIGHT) {
      call gdevot (FF)
      column = gimnmx ((column + 1), 1, 80)
      }
   else if (opcode == CURSORxLEFT) {
      call gdevot (BS)
      column = gimnmx ((column -1), 1, 80)
      }
   else if (opcode == HOMExCURSOR) {
      call gdevot (RS)
      row = 1
      column = 1
      }
   else if (opcode == ERASExTOxENDxOFxSCREEN) {
      call gdstot (2, erascr)
      }
   else if (opcode == ERASExTOxENDxOFxLINE) {
      call gdstot (2, eralin)
      }
   else if (opcode == DIRECTxCURSORxADDRESS) {
      row = gimnmx (intin(1), 1, 24)
      column = gimnmx (intin(1), 1, 24)
      craddr(3) = row + US
      craddr(4) = column + US
      call gdstot (4, craddr)
      }
   else if (opcode == OUTPUTxCURSORxADDRESSABLExTEXT) {
      call gdstot (contrl(4), intin)
      }
   else if (opcode == INQUIRExCURRENTxCURSORxADDRESS) {
      intout(1) = row
      intout(2) = column
      }
   }

#
#  opcode POLYLINE
#
else if (opcode == POLYLINE) {
   call dcgen2 (ndclrl)      # Change color if necessary
   call gdstot (4, vector)
   j = 1
   for (i=1; i<=contrl(2); i=i+1) {
      call xygen2 (ptsin(j), ptsin(j+1))
      j = j + 2
      }
   call gdevot (CR)
   }
 
#
#  opcode POLYMARKER
#
else if (opcode == POLYMARKER) {
   kstyle = DIG1        # Set solid line style
   call gdstot (8, lstyle)
 
   call dcgen2 (ndclrm)        # Change color if necessary
 
   j = 1
   for (i=1; i<=contrl(2); i=i+1) {
      xy(1) = ptsin(j)   # x-coordinate of marker
      xy(2) = ptsin(j+1) # y-coordinate of marker
      call dmgen2 (xy)   # Emulate a marker
      j = j + 2
      }

   kstyle = ndlntp       # Restore line style
   call gdstot (8, lstyle)
   }
 
#
#  opcode text
#
else if (opcode == TEXT) {
   if (ndclrp != ndclrt) {      # Change color if necessary
      ndclrp = ndclrt
      txtatt(6) = BIGC
      txtatt(7) = ndclrt
      call gdstot (9,txtatt)
      }

   # The GEN.II device assumes that the current cursor position is the
   # middle of the left edge of the character cell.  Therefore, we must
   # move the cursor up one-half the height of the character cell and left
   # the inter-character gap.

   i = divid (ndtxrt, 900, j) + 1   # Index into x,y rot tables
   i = gimnmx (i, 1, 4)

   # Compute position based on rotation
   j = divid (ndtxsz, 2, temp)         # Compute 1/2 char height
   l = muldiv (ndtxsz, 1, 3)           # Compute inter-char gap
   xtemp = mult (j, xrot(i)) + mult (l, xoffst(i))  # Compute x-offset
   ytemp = mult (j, yrot(i)) + mult (l, yoffst(i))  # Compute y-offset
   nx = xtemp + ptsin(1)
   ny = ytemp + ptsin(2)

   if (nx >= 0 & ny >= 0) {       # Make sure character can be output
      call gdstot (4, vector)     # Move to proper start position
      call xygen2 (nx, ny)
      call gdevot (CR)
      temp = contrl(4)            # Save string length
      do i=1,temp {               # Search for delimiter
	 if (intin(i) == TILDE) intin(i) = BLANK  # Replace with blank
	 }
      call gdstot (6, txtstr)     # Send text to workspace
      call gdstot (temp, intin)
      call gdevot (TILDE)         # End string command with delimiter
      call gdevot (CR)
      }
   }
 
#
#  opcode FILL AREA
#
else if (opcode == FILLxAREA) {

   call dfgen2      # Change fill color if necessary

   line(1) = BLANK
   xstart = 1
   ystart = 2
   call gdstot (4, poly)                # Output polygon
   for (i=1; i<=contrl(2); i=i+1) {
      j = ptsin(xstart)
      ilen = gitoch (j, line(2), 3, ierror)
      call gdstot (ilen+1, line)
      j = ptsin(ystart)
      ilen = gitoch (j, line(2), 3, ierror)
      call gdstot (ilen+1, line)
      xstart = xstart + 2
      ystart = ystart + 2
      }
 
   call gdevot (CR)
   call dcgen2 (ndclrl)                 # Reset line color
   }
 
#
#  opcode CELL ARRAY
#
ifdef(`CODExON',`
else if (opcode == CELLxARRAY) {
   savex = ptsin(1)         # Upper left corner
   savey = ptsin(2)
   xtemp = ptsin(3)
   ytemp = ptsin(4)
   temp = contrl(6)         # save length of each row in color index array
   nx = contrl(7)           # save number of elements used in each row
   ny = contrl(8)           # number of rows in color array

   # Determine repeat count for each color across a row
   i = xtemp - savex + 1 + divid (nx, 2, k)
   xrpt = divid (i, nx, k)

   # Determine repeat count for each row
   i = ytemp - savey + 1 + divid (ny, 2, k)
   yrpt = divid (i, ny, k)

   ycoord = ytemp                       # Set initial y to top of area
   do m=1,ny {                          # Traverse this many rows
      do j=1,yrpt {                     # Repeat each row as necessary
	 xcoord = savex
         call gdstot (4, vector)
         call xygen2 (xcoord, ycoord)   # Move to correct location
         call gdevot (CR)
	 do n=1,nx {                    # Use this many elements per row
            colptr = mult (temp, (m-1)) + n       # Use this element
            pixel = gimnmx (intin(colptr), 0, 6)  # Bound the element

            if (pixel == 0) pixel = ATSIGN  # Pixel is off
            else pixel = BIGA               # Pixel is on

            ilen = gitoch (xrpt, raster(6), 3, ierror) # Output these elements
            raster(ilen+6) = LPAREN
            raster(ilen+7) = pixel
            raster(ilen+8) = RPAREN
	    ilen = ilen + 9
	    raster(ilen) = CR
            call gdstot (ilen, raster)
            }
         ycoord = ycoord - 1      # Move down one raster line
         }
      }
   }
')

#
#  opcode GENERALIZED DRAWING PRIMITIVE
#
else if (opcode == GENERALIZEDxDRAWINGxPRIMITIVE) {
   opcode = contrl(6)
   if (opcode == BAR) {

      call dfgen2            # Set up fill colors

      xbar(1) = ptsin(1)         # Compute vertices of polygon
      ybar(1) = ptsin(2)
      xbar(2) = ptsin(3)
      ybar(2) = ybar(1)
      xbar(3) = xbar(2)
      ybar(3) = ptsin(4)
      xbar(4) = xbar(1)
      ybar(4) = ybar(3)
      call gdstot (4, poly)               # Output polygon (bar)
      line(1) = BLANK
      do i=1,4 {
         ilen = gitoch (xbar(i), line(2), 3, ierror)
         call gdstot (ilen+1, line)
         ilen = gitoch (ybar(i), line(2), 3, ierror)
         call gdstot (ilen+1, line)
         }
      call gdevot (CR)
      }
   
   else if (opcode == ARC | opcode == PIExSLICE) { # Arc, pie-slice

      if (opcode == 3) { call dfgen2 }   # Change color for pie slice
      else { call dcgen2 (ndclrl) }   # Arcs use current line color

      call gdstot (4, vector)
      call xygen2 (ptsin(1), ptsin(2))
      call gdevot (CR)

      angbeg = divid (intin(1), 10, i)   # Start angle of ARC or PIE SLICE
      angend = divid (intin(2), 10, i)   # End angle of ARC or PIE SLICE

      if (opcode == 2) call gdstot (5,circle)
      else call gdstot (5,pie)

      ilen = gitoch (ptsin(7), line, 3, ierror)   # Radius
      temp = ilen + 1
      line(temp) = COMMA
      temp = temp + 1
      ilen = gitoch (angbeg, line(temp), 3, ierror)   # Beginning angle
      temp = temp + ilen
      line(temp) = COMMA
      temp = temp + 1
      ilen = gitoch (angend, line(temp), 3, ierror)   # End angle
      ilen = ilen + temp
      line(ilen) = CR   # Command terminator
      call gdstot (ilen, line)   # Output command
      }
   else if (opcode == CIRCLE) {   # Circle

      call dfgen2                # Set up fill colors
     
      call gdstot (4, vector)
      call xygen2 (ptsin(1), ptsin(2))
      call gdevot (CR)

      # Convert the radius to character representation and output circle
      ilen = gitoch (ptsin(5), pie(6), 3, ierror)
      ilen = ilen + 6
      pie(ilen) = CR
      call gdstot (ilen, pie)
      }
   }

#
#  opcode SET CHARACTER HEIGHT
#
else if (opcode == SETxCHARACTERxHEIGHT) {
   ndtxsz = gimnmx (ptsin(2), 5, 419)   # Bound the char height desired
   chrhgt = muldiv (ndtxsz, 100, 18)    # Compute character scale factor
   chrhgt = mult (divid ((chrhgt+2), 5, temp), 5)  # Use intervals of 5

   ilen = gitoch (chrhgt, cscale(6), 3, ierror)  # Convert height to characters
   ilen = ilen + 6
   cscale(ilen) = CR
   call gdstot (ilen, cscale)   # Output character scale command

   contrl(3) = 2
   chrwdt = muldiv (ndtxsz, 7, 9)         # Compute character width
   ptsout(1) = chrwdt                     # Return width selected
   ptsout(2) = ndtxsz                     # Return height selected
   ptsout(3) = muldiv (chrwdt, 13, 7)     # Compute char cell width
   ptsout(4) = ndtxsz                     # Return character cell height
   }

#
#  opcode SET CHARACTER UP VECTOR
#
else if (opcode == SETxCHARACTERxUPxVECTOR) {
   # Allow character rotation in 90 degree multiples
   # Device can actually do 1 degree multiples, but
   # mathematics to do so is infeasible in an integer
   # environment.

   ndtxrt = mult (divid ((intin(1)+450), 900, i), 900)  # Round up angle
   i = divid (ndtxrt, 3600, ndtxrt)
   ilen = gitoch (divid (ndtxrt, 10, i), crot(6), 3, ierror)
   ilen = ilen + 6
   crot(ilen) = CR
   call gdstot (ilen, crot)   # Output rotation command
   intout(1) = ndtxrt         # Return the rotation angle selected
   }

#
#  opcode SET COLOR REPRESENTATION
#
else if (opcode == SETxCOLORxREPRESENTATION) {
   i = gimnmx (intin(1), 0, 6)         # Seven possible color indices
   k = i + 1

   rdgen2(k) = intin(2) / 10           # Save RGB values
   grgen2(k) = intin(3) / 10
   blgen2(k) = intin(4) / 10

   call dmpgn2 (i, rdgen2(k), grgen2(k), blgen2(k))
   }
 
#
#  opcode SET POLYLINE LINETYPE
#
else if (opcode == SETxPOLYLINExLINETYPE) {
   ndlntp = gimnmx (intin(1), 1, 8) # 8 line styles (1-8)
   intout(1) = ndlntp               # Return the actual linestyle selected
   ndlntp = ndlntp + DIG0
   kstyle = ndlntp
   call gdstot (8, lstyle)
   }
 
#
#  opcode SET POLYLINE COLOR INDEX
#
else if (opcode == SETxPOLYLINExCOLORxINDEX) {
   ndclrl = gimnmx (intin(1), 0, 6)        # Seven line color indices
   intout(1) = ndclrl
   ndclrl = ndclrl + DIG0
   }
 
#
#  opcode SET POLYMARKER TYPE
#
else if (opcode == SETxPOLYMARKERxTYPE) {
   ndmktp = intin(1)
   if (ndmktp < 1 | ndmktp > 5) ndmktp = 3    # Set to default if out of range
   intout(1) = ndmktp
   }

#
#  opcode SET POLYMARKER COLOR INDEX
#
else if (opcode == SETxPOLYMARKERxCOLORxINDEX) {
   ndclrm = gimnmx (intin(1), 0, 6)        # Seven marker color indices
   intout(1) = ndclrm
   ndclrm = ndclrm + DIG0
   }

#
#  opcode SET TEXT COLOR INDEX
#
else if (opcode == SETxTEXTxCOLORxINDEX) {
   ndclrt = gimnmx (intin(1), 0, 6)        # Seven text color indices
   intout(1) = ndclrt
   ndclrt = ndclrt + DIG0
   }
 
#
#  opcode SET FILL INTERIOR STYLE
#
else if (opcode == SETxFILLxINTERIORxSTYLE) {
   ndfstl = intin(1)
   if (ndfstl < HOLLOW | ndfstl > PATTERN) ndfstl = HOLLOW  # Default is hollow
   intout(1) = ndfstl
   }

#
#  opcode SET FILL STYLE INDEX
#
else if (opcode == SETxFILLxSTYLExINDEX) {
   ndflpt = intin(1)            # Fill style index 
   if (ndflpt < 1 | ndflpt > 120) ndflpt = 1
   intout(1) = ndflpt
   ndflpt = ndflpt - 1
   }

#
#  opcode SET FILL COLOR INDEX
#
else if (opcode == SETxFILLxCOLORxINDEX) {
   ndclrf = gimnmx (intin(1), 0, 6)         # Seven fill color indices
   intout(1) = ndclrf
   ndclrf = ndclrf + DIG0
   }
 
#
#  opcode INQUIRE COLOR REPRESENTATION
#
else if (opcode == INQUIRExCOLORxREPRESENTATION) {
   i = gimnmx (intin(1), 0, 6) + 1   # Seven possible color indices
   intout(1) = i   # Return index selected
   intout(2) = rdgen2(i) * 10    # Return color representation values
   intout(3) = grgen2(i) * 10
   intout(4) = blgen2(i) * 10
   }

#
#  opcode INQUIRE CELL ARRAY
#
ifdef(`CODExON',`
else if (opcode == INQUIRExCELLxARRAY) {
   savex = ptsin(1)
   savey = ptsin(2)
   xtemp = ptsin(3)
   ytemp = ptsin(4)
   nx = contrl(6)            # Save length of each row
   ny = contrl(7)            # Save number of rows in color index array

   contrl(10) = 0            # Initialize to valid cell array

   temp = xtemp - savex +1   # Determine number of elements to use
   xincr = max0 (1, divid (temp, nx, k))  # in each row
   j = divid (temp, xincr, k)
   contrl(8) = j
   temp = ytemp - savey +1   # Determine number of rows to use
   yincr = max0 (1, divid (temp, ny, k))
   i = divid (temp, yincr, k)
   contrl(9) = i

   ycoord = ytemp

   # loop over rows starting at top of rectangular area
   do ycount=1,i {
      xcoord = savex

      # loop over cells in row
      do xcount=1,j {

	 # if x,y coordinate is within range, read the pixel
	 # value back; otherwise, indicate an error and continue
	 if (xcoord <= XxLIMITSxGEN2 & ycoord <= YxLIMITSxGEN2) {
	    call gdstot (4, vector)    # Move to pixel location
	    call xygen2 (xcoord, ycoord)
	    call gdevot (CR)

	    call gdstot (8, rdback)    # Read the pixels value
            call gdstin (2, line, temp)

	    if (line(1) == BIGA) k = 1    # Pixel is on
	    else k = 0                 # Pixel is off
            }
         else {
	    k = -1
	    contrl(10) = 1
	    }

         colptr = mult ((ycount - 1), nx) + xcount
	 intout(colptr) = k
	 xcoord = xcoord + xincr
	 }
      ycoord = ycoord - yincr
      }
   }
')
 
#
#  opcode INPUT LOCATOR 
#
else if (opcode == INPUTxLOCATOR) {
   if (intin(1) != DEFAULT & intin(1) != CROSSHAIRS) return
   call gdstot (4, vector)
   call xygen2 (ptsin(1), ptsin(2))   # Move to initial position
   call gdevot (CR)
   for (i=1; i<=3; i=i+1) {  # try 3 times for a good input point
      call gdstot (13, enagin)    # Enable gin
      call gdstin (26, line, j)
      for (k=1; k<=j; k=k+1) {   # Find the response - <COM_CHAR>DAT
         if (line(k) == COM_CHAR & line(k+1) == BIGD & line(k+2) == BIGA &
             line(k+3) == BIGT) break
         }
      if (line(k) == COM_CHAR) {
         for (k=k; k<=j; k=k+1) {    # Now find the first COMMA delimiter
            if (line(k) == COMMA) break
            }
         if (line(k) == COMMA) {
            call gchtoi (line, k, nchar, kstop)   # Get the character struck
            k = kstop
            if (k <= j) {
               call gchtoi (line, k, nx, kstop)   # Convert the x coordinate
               k = kstop
               if (k <= j) {
                  call gchtoi (line, k, ny, kstop)   # Convert the y coordinate
                  k = kstop
                  break
                  }
               }
            }
         }
      }
   if (i <= 3) {  # check to see if we got our data
      contrl(3) = 1       # inform high level that we got a point
      contrl(5) = 1
      intout(1) = nchar   # Return locator terminator
      ptsout(1) = nx      # Return coordinates of point
      ptsout(2) = ny
      }
   }
 
#
#  opcode input string
#
else if (opcode == INPUTxSTRING) {
   contrl(5) = NOTxOK
   if (intin(1) != DEFAULT) return   # Check for valid string device
      
   i = 0
   temp = intin(2)                   # Save maximum size
   k = intin(3)                      # Echo or non-echoed input
   repeat {
      if (k == NO) call gdevin (j)   # Get a character without echo
      else         call gchrin (j)   # Get a character with echo
      if (j == NEWLINE) break
      if (i+1 > temp) break          # No room in output array
      i = i + 1
      intout(i) = j
      }
   if (i > 0) contrl(5) = i          # Request successful
   } 

#
#  opcode set writing mode
#
else if (opcode == SETxWRITINGxMODE) {
   i = intin(1)
   if (i == XORxMODE) j = BIGY   # Complement mode
   else j = BIGN                 # All other modes use replace mode
   wrtmod(6) = j                 # Select write mode
   call gdstot (7, wrtmod)       # Set writing mode
   intout(1) = i
   }
 
#
#  opcode set input mode
#
else if (opcode == SETxINPUTxMODE) {
   intout(1) = REQUESTxMODE     # Default mode is request
   }

return
end
subroutine dmpgn2 (index, red, green, blue)
########################################################################
#                                                                      #
#          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 a color on the Digital Engineering GEN II      #
#                                                                      #
#     Input Parameters:                                                #
#            index   -     color index to be set (0-7)                 #
#            red     -     degree of red (0-100)                       #
#            green   -     degree of green (0-100)                     #
#            blue    -     degree of blue (0-100)                      #
#                                                                      #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     Routines Called:                                                 #
#             gitoch   - convert integer to character string           #
#             gdstot - put a character string to the device            #
#                                                                      #
########################################################################
 
integer index, red, green, blue, gitoch, setclr(21), clr(3)
integer ierror, i, j, ilen
 
#     Mix color in RGB - <COM_CHAR>MIX Cn <red>,<green>,<blue>
data setclr/ COM_CHAR,BIGM,BIGI,BIGX,BLANK,BIGC,0,BLANK,0,0,0,0,0,0,0,_
             0,0,0,0,0,0/
 
clr(1) = red
clr(2) = green
clr(3) = blue
setclr(7) = DIG0 + index        # Build color command
ilen = 8
do i=1,3 {
   ilen = ilen + 1
   j = gitoch (clr(i), setclr(ilen), 3, ierror)
   ilen = ilen + j
   setclr(ilen) = COMMA
   }
setclr (ilen) = CR
ilen = ilen + 1
setclr (ilen) = NEWLINE
call gdstot (ilen, setclr)
 
return
end
subroutine dmgen2 (intin)
########################################################################
#                                                                      #
#          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 GEN II type  #
#               devices                                                #
#                                                                      #
#     Input Parameters:                                                #
#            intin   - x/y location for marker                         #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     Routines Called:                                                 #
#            xygen2 - GEN II move/draw routine                         #
#                                                                      #
########################################################################
define(`MARKxPERIOD',`1')
define(`MARKxPLUS',`2')
define(`MARKxSTAR',`3')
define(`MARKxO',`4')
define(`MARKxX',`5')
define(`FULLSZ',`12')
define(`HALFSZ',`6')
define(`FPERSZ',`4')
define(`HPERSZ',`2')
define(`COM_CHAR',BANG)                  # command character
 
integer intin(2)
 
integer fsize, hsize, x1, x2, y1, y2
integer rxy1, rxy2, vector(4)
 
include(`ddcom')

#            Output a vector - <COM_CHAR>VEC
data vector/ COM_CHAR,BIGV,BIGE,BIGC/

   if (ndmktp == MARKxPERIOD) {
      fsize = FPERSZ
      hsize = HPERSZ
      }
   else {
      fsize = FULLSZ
      hsize = HALFSZ
      }
 
   x1 = intin(1) - hsize        #clip marker to device limits
   x2 = x1 + fsize
   y1 = intin(2) - hsize
   y2 = y1 + fsize
   if ((min0(x1,y1) < 0) | (x2 > XxLIMITSxGEN2) | (y2 > YxLIMITSxGEN2)) return
 
   # output appropriate marker centered on location
 
   call gdstot (4, vector)
   call xygen2 (x1,y1)

   if (ndmktp == MARKxPERIOD | ndmktp == MARKxO) {
      call xygen2 (x2,y1)
      call xygen2 (x2,y2)
      call xygen2 (x1,y2)
      call xygen2 (x1,y1)
      call gdevot (CR)
      }
   else {
      if (ndmktp == MARKxX | ndmktp == MARKxSTAR) {
         call xygen2 (x2,y2)
	 call gdevot (CR)
	 call gdstot (4, vector)
	 call xygen2 (x1,y2)
         call xygen2 (x2,y1)
         call gdevot (CR)
         }
      if (ndmktp == MARKxPLUS | ndmktp == MARKxSTAR) {
	 call gdstot (4, vector)
         rxy2 = y1 + hsize
	 call xygen2 (x1,rxy2)
         call xygen2 (x2,rxy2)
	 call gdevot (CR)
	 call gdstot (4, vector)
         rxy1 = x1 + hsize
	 call xygen2 (rxy1,y1)
         call xygen2 (rxy1,y2)
         call gdevot (CR)
         }
      }

   return
end
subroutine dfgen2
######################################################################
#                                                                    #
#          THIS MATERIAL IS CONFIDENTIAL AND IS FURNISED 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 fill color on the GEN II terminal         #
#                                                                    #
#     Input Parameters:                                              #
#            color - color index to change to                        #
#                                                                    #
#     Output Parameters:                                             #
#            none                                                    #
#                                                                    #
#     Routines called:                                               #
#            gdstot - output a string to the current device          #
#            dcgen2 - change color on GEN.II terminal                #
#                                                                    #
######################################################################
integer filclr(12)

include(`ddcom')

#            Set fill color attributes - <COM_CHAR>COL XX,XX
data filclr/ COM_CHAR,BIGC,BIGO,BIGL,BLANK,BLANK,BLANK,COMMA,BLANK,_
	     BLANK,CR,NEWLINE/

if (ndfstl == HOLLOW) {    # If hollow, use black interior
   filclr(6) = BIGC
   filclr(7) = DIG0
   filclr(9) = BIGC        # Outline in current fill color
   filclr(10) = ndclrf     
   call gdstot (12, filclr)
   ndclrp = DIG0
   }

else if (ndfstl == SOLID) {   # If solid, fill and outline in fill color
   call dcgen2 (ndclrf) 
   }

else if (ndfstl == PATTERN) {  # If pattern, fill and outline in pattern
   filclr(6) = BIGP
   filclr(7) = ndflpt
   filclr(9) = BIGP
   filclr(10) = ndflpt
   call gdstot (12, filclr)
   ndclrp = DIG0
   }

return
end

subroutine dcgen2(color)
######################################################################
#                                                                    #
#          THIS MATERIAL IS CONFIDENTIAL AND IS FURNISED 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 GEN II terminal              #
#                                                                    #
#     Input Parameters:                                              #
#            color - color index to change to                        #
#                                                                    #
#     Output Parameters:                                             #
#            none                                                    #
#                                                                    #
#     Routines called:                                               #
#            gdstot - output a string to the current device          #
#                                                                    #
######################################################################
integer color
integer fcolor(9)

include(`ddcom')

#       Set the foreground color
data fcolor/ COM_CHAR,BIGC,BIGO,BIGL,BLANK,BIGC,BLANK,CR,NEWLINE/

if (ndclrp != color) {       # Does color need to be changed
   ndclrp = color            # Set the current color

   fcolor(7) = color
   call gdstot (9, fcolor)
   }
return
end
subroutine xygen2 (kx, ky)
########################################################################
#                                                                      #
#          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: Convert GEN II x,y coordinate to hiy,loy,hix,lox bytes #
#               and output them                                        #
#                                                                      #
#     Input Parameters:                                                #
#           kx       - x-coordinate in 0 to device dependent space     #
#           ky       - y-coorindate in 0 to device dependent space     #
#                                                                      #
#     Output Parameters:                                               #
#            none                                                      #
#                                                                      #
#     Routines Called:                                                 #
#            gdstot - Output a character string to the device          #
#            divid  - divide 2 unsigned 16-bit numbers                 #
#                                                                      #
########################################################################
integer ilen, kx, ky, line(4), gitoch, ierror
 
include(`ddcom')
 
   line(1) = BLANK
   ilen = gitoch (kx, line(2), 3, ierror)
   call gdstot (ilen+1, line)
   line(1) = COMMA
   ilen = gitoch (ky, line(2), 3, ierror)
   call gdstot (ilen+1, line)
 
   return
end
E 1
