home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / HPPLOT.FOR < prev    next >
Encoding:
Text File  |  1990-02-28  |  20.3 KB  |  798 lines
  1.       INCLUDE 'MISCIOFI.FOR'
  2.  
  3.       SUBROUTINE WritePlotter (s)
  4.       CHARACTER * 80 S
  5.       CHARACTER c
  6.       LOGICAL debugF
  7.       INTEGER l, i
  8.       INTEGER * 2 err
  9.       COMMON /debug/ debugF
  10.       l = LEN_TRIM(s)
  11.       do i = 1, l
  12.        c = s(i:i)
  13.        CALL send_com(c, err)
  14.       end do
  15.       IF (debugF)  PRINT *, s
  16.       END !SUBROUTINE
  17.  
  18.       SUBROUTINE InitStr(s)
  19.       CHARACTER * 80 s
  20.       INTEGER i
  21.       DO i=1, 80
  22.         s(i:i)= CHAR(32)
  23.       END DO
  24.       END !SUBROUTINE
  25.  
  26.       SUBROUTINE Concat( outstr, s)
  27.       CHARACTER * 80 outstr, s
  28.       INTEGER LenO, LenS, i
  29.       LenO = LEN_TRIM(outstr) + 1
  30.       LenS = LEN_TRIM(s)
  31.       DO i = 1, Lens
  32.         outstr(LenO:LenO) = s(i:i)
  33.         LenO = LenO + 1
  34.       END DO
  35.       END !SUBROUTINE
  36.  
  37.       SUBROUTINE PConcat( outstr, s)
  38.       CHARACTER * 80 outstr, s
  39.       INTEGER LenO, LenS, i
  40.  
  41.       LenO = LEN_TRIM(outstr) + 2
  42.       LenS = LEN_TRIM(s)
  43.       DO i = 1, Lens
  44.         outstr(LenO:LenO) = s(i:i)
  45.         LenO = LenO + 1
  46.       END DO
  47.       END !SUBROUTINE
  48.  
  49.       SUBROUTINE AddChar( outstr, c)
  50.       CHARACTER *80 outstr
  51.       CHARACTER c
  52.       INTEGER l
  53.       l = LEN_TRIM(outstr) + 1
  54.       outstr(l:l) = c
  55.       END !SUBROUTINE
  56.  
  57.  
  58.       SUBROUTINE debugOff()
  59.       LOGICAL debugF
  60.  
  61.       COMMON /debug/ debugF
  62.         debugF = .false.
  63.       END !SUBROUTINE
  64.  
  65.       SUBROUTINE debugOn()
  66.       LOGICAL debugF
  67.       COMMON /debug/ debugF
  68.         debugF = .true.
  69.       END !SUBROUTINE
  70.  
  71.       SUBROUTINE DefinePlotterFill
  72.       INTEGER ppatcolor, ppattype, MaxColor, CurColor
  73.       INTEGER HPGLFillMap(0:10,0:1)
  74.       COMMON /PPAT/ ppatcolor, ppattype
  75.       COMMON /Max/ MaxColor
  76.       COMMON /Current/ CurColor
  77.       COMMON /HPGL/ HPGLFillMap
  78.  
  79.          HPGLFillMap(0, 0) = 5
  80.          HPGLFillMap(0, 1) = 2
  81.          HPGLFillMap(1, 0) = 1
  82.          HPGLFillMap(1, 1) = 0
  83.          HPGLFillMap(2, 0) = 3
  84.          HPGLFillMap(2, 1) = 0
  85.          HPGLFillMap(3, 0) = 3
  86.          HPGLFillMap(3, 1) = 45
  87.          HPGLFillMap(4, 0) = 3
  88.          HPGLFillMap(4, 1) = 45
  89.          HPGLFillMap(5, 0) = 3
  90.          HPGLFillMap(5, 1) = 135
  91.          HPGLFillMap(6, 0) = 3
  92.          HPGLFillMap(6, 1) = 135
  93.          HPGLFillMap(7, 0) = 4
  94.          HPGLFillMap(7, 1) = 45
  95.          HPGLFillMap(8, 0) = 4
  96.          HPGLFillMap(8, 1) = 45
  97.          HPGLFillMap(9, 0) = 4
  98.          HPGLFillMap(9, 1) = 45
  99.          HPGLFillMap(10, 0) = 4
  100.          HPGLFillMap(10, 1) = 45
  101.          ppattype = 1
  102.          ppatcolor = 1
  103.          MaxColor = 6
  104.          CurColor = 128
  105.          CALL PSetTextStyle(0, 0, 1)
  106.  
  107.       END !SUBROUTINE
  108.  
  109.       FUNCTION expnum (e)
  110.       INTEGER  e, i
  111.       REAL x
  112.  
  113.       x = 1.0
  114.       IF (e .GT. 0) THEN
  115.         DO i = 1, e
  116.           x = x * 10.0
  117.         END DO
  118.       ELSE
  119.         DO i = 1, -e, -1
  120.           x = x / 10.0
  121.         END DO
  122.         expnum = x
  123.       END IF
  124.       END !FUNCTION
  125.  
  126.       SUBROUTINE GetPlotterViewport (x1, y1, x2, y2)
  127.       INTEGER x1, y1, x2, y2, PUx1, PUy1, PUx2, PUy2
  128.       COMMON /PlotView/  PUx1, PUy1, PUx2, PUy2
  129.  
  130.       x1 = PUx1
  131.       x2 = PUx2
  132.       y1 = PUy1
  133.       y2 = PUy2
  134.       END !SUBROUTINE
  135.  
  136.       SUBROUTINE JustifyPenPosition (s )
  137.       REAL x, y, l
  138.       CHARACTER * 80 outString, s, tempstr
  139.       INTEGER tHJust, tVJust, tdir
  140.       COMMON /PlotJust/ tHJust, tVJust, tdir
  141.  
  142.       CALL InitStr(tempStr)
  143.       CALL InitStr(outString)
  144.  
  145.       l = REAL( LEN_trim(s))
  146.       SELECT CASE (tHJust)
  147.       CASE (0)
  148.         IF (tdir .EQ. 0) THEN
  149.           x = 0.0
  150.         ELSE
  151.           y = -1.0
  152.         END IF
  153.       CASE (1)
  154.          IF (tdir .EQ. 0) THEN
  155.             x = -l / 2.0
  156.          ELSE
  157.             y = -0.25
  158.          END IF
  159.       CASE (2)
  160.          IF (tdir .EQ. 0) THEN
  161.            x = -l
  162.          ELSE
  163.           y = 0.0
  164.          END IF
  165.       CASE DEFAULT
  166.         IF (tdir .EQ. 0) THEN
  167.           x = 0.0
  168.         ELSE
  169.           y = -1.0
  170.         END IF
  171.  
  172.       END SELECT
  173.       SELECT CASE (tvJust)
  174.         CASE (0)
  175.           IF (tdir .EQ. 0) THEN
  176.             y = 0.0
  177.           ELSE
  178.             x = 0.0
  179.           END IF
  180.         CASE (1)
  181.           IF (tdir .EQ. 0) THEN
  182.             y = -.25
  183.           ELSE
  184.            x = -l / 2.0
  185.           END IF
  186.         CASE (2)
  187.           IF (tdir .EQ. 0) THEN
  188.              y = -1.0
  189.           ELSE
  190.              x = -l
  191.           END IF
  192.         CASE DEFAULT
  193.          IF (tdir .EQ. 0) THEN
  194.            y = 0.0
  195.          ELSE
  196.            x = 0.0
  197.          END IF
  198.  
  199.       END SELECT
  200.       outString = 'CP'
  201.       CALL RTOSTR(x, tempstr, ',')
  202.       CALL PConcat( outString, tempstr)
  203.       CALL RTOSTR(y, tempstr, ';')
  204.       CALL PConcat( outString, tempstr)
  205.       CALL WritePlotter(outString)
  206.       END !SUBROUTINE
  207.  
  208.       SUBROUTINE PBar (x1, y1, x2, y2)
  209.       REAL x1, y1, x2, y2
  210.       CHARACTER * 80 outString, tempstr
  211.       INTEGER c, ppatcolor, ppattype, MaxColor, CurColor
  212.       COMMON /PPAT/ ppatcolor, ppattype
  213.       COMMON /Max/ MaxColor
  214.       COMMON /Current/ CurColor
  215.  
  216.       IF (ppattype .NE. 0) THEN
  217.         CALL InitStr(outString)
  218.         CALL InitStr(tempstr)
  219.         c = CurColor
  220.         CALL PMoveTo(x1, y1)
  221.         CALL SelectPen(ppatcolor)
  222.         outString = 'RA'
  223.         CALL RTOSTR(x2, tempstr, ',')
  224.         CALL PConcat(outString, tempstr)
  225.         CALL RTOSTR( y2, tempstr, ';')
  226.         CALL PConcat(outString, tempstr)
  227.         CALL WritePlotter(outString)
  228.         CALL SelectPen(c)
  229.       END IF
  230.       END !SUBROUTINE
  231.  
  232.  
  233.  
  234.       SUBROUTINE PenDown()
  235.       CHARACTER * 80 outString
  236.  
  237.       outString = 'PD;'
  238.       CALL WritePlotter(outString)
  239.       END !SUBROUTINE
  240.  
  241.  
  242.  
  243.       SUBROUTINE PenUp()
  244.       CHARACTER * 80 outString
  245.  
  246.       outString = 'PU;'
  247.       CALL WritePlotter(outString)
  248.       END !SUBROUTINE
  249.  
  250.  
  251.       SUBROUTINE PGetColor (c)
  252.       INTEGER c, CurColor
  253.       COMMON /Current/ CurColor
  254.  
  255.        c = CurColor
  256.       END !SUBROUTINE
  257.  
  258.  
  259.  
  260.       SUBROUTINE PGetFillSettings (pattern, fillcolor)
  261.       INTEGER ppatcolor, ppattype, pattern, fillcolor
  262.       COMMON /PPAT/ ppatcolor, ppattype
  263.  
  264.       pattern = ppattype
  265.       fillcolor = ppatcolor
  266.       END !SUBROUTINE
  267.  
  268.  
  269.  
  270.       SUBROUTINE PLineRel (x1, y1)
  271.       REAL x1, y1
  272.       CHARACTER * 80 outString, tempstr
  273.  
  274.       CALL InitStr(outString)
  275.       CALL InitStr(tempstr)
  276.       CALL PenDown
  277.       outString = 'PR'
  278.       CALL RTOSTR(x1, tempstr, ',')
  279.       CALL PConcat(outString, tempstr)
  280.       CALL RTOSTR(y1, tempstr, ';')
  281.       CALL PConcat(outString, tempstr)
  282.       CALL WritePlotter(outString)
  283.       CALL PenUp
  284.       END !SUBROUTINE
  285.  
  286.  
  287.       SUBROUTINE PLineTo (x1, y1)
  288.       REAL x1, y1
  289.       CHARACTER * 80 outString, tempstr
  290.  
  291.       CALL InitStr(outString)
  292.       CALL InitStr(tempstr)
  293.       CALL PenDown
  294.       outString = 'PA'
  295.       CALL RTOSTR(x1, tempstr, ',')
  296.       CALL PConcat(outString, tempstr)
  297.       CALL RTOSTR(y1, tempstr, ';')
  298.       CALL PConcat(outString, tempstr)
  299.       CALL WritePlotter(outString)
  300.       CALL PenUp
  301.       END !SUBROUTINE
  302.  
  303.  
  304.       SUBROUTINE PMoveRel (x1, y1)
  305.       REAL x1, y1
  306.       CHARACTER * 80 outString, tempstr
  307.  
  308.       CALL InitStr(outString)
  309.       CALL InitStr(tempstr)
  310.       CALL PenUp
  311.       outString = 'PR'
  312.       CALL RTOSTR(x1, tempstr, ',')
  313.       CALL PConcat(outString, tempstr)
  314.       CALL RTOSTR(y1, tempstr, ';')
  315.       CALL PConcat(outString, tempstr)
  316.       CALL WritePlotter(outString)
  317.       END !SUBROUTINE
  318.  
  319.  
  320.  
  321.       SUBROUTINE PMoveTo (x1, y1)
  322.       REAL x1, y1
  323.       CHARACTER * 80 outString, tempstr
  324.  
  325.  
  326.       CALL InitStr(outString)
  327.       CALL InitStr(tempstr)
  328.       CALL PenUp
  329.       outString = 'PA'
  330.       CALL RTOSTR(x1,tempstr, ',')
  331.       CALL PConcat(outString, tempstr)
  332.       CALL RTOSTR(y1, tempstr, ';')
  333.       CALL PConcat(outString, tempstr)
  334.       CALL WritePlotter(outString)
  335.       END !SUBROUTINE
  336.  
  337.  
  338.  
  339.       SUBROUTINE POutText (s)
  340.       CHARACTER * 80 s,outString, Tempstr
  341.  
  342.       CALL InitStr(outString)
  343.       CALL InitStr(tempstr)
  344.       tempstr = s
  345.       CALL AddChar(tempstr,CHAR(3))
  346.       CALL JustifyPenPosition(tempstr)
  347.       outString = 'LB '
  348.       CALL PConcat(outString, tempstr)
  349.       CALL AddChar(outString, ';')
  350.       CALL WritePlotter(outString)
  351.       END !SUBROUTINE
  352.  
  353.  
  354.  
  355.       SUBROUTINE PRectangle (x1, y1, x2, y2)
  356.       REAL x1, y1, x2, y2
  357.       CHARACTER * 80 outString, tempstr
  358.  
  359.  
  360.       CALL InitStr(outString)
  361.       CALL InitStr(tempstr)
  362.       CALL PMoveTo(x1, y1)
  363.       outString = 'EA'
  364.       CALL RTOSTR(x2, tempstr, ',')
  365.       CALL PConcat(outString, tempstr)
  366.       CALL RTOSTR(y2, tempstr, ';')
  367.       CALL PConcat(outString, tempstr)
  368.       CALL WritePlotter(outString)
  369.       END !SUBROUTINE
  370.  
  371.  
  372.  
  373.       SUBROUTINE PSetFillStyle (pati, c)
  374.       CHARACTER * 80 outString, tempstr
  375.       INTEGER pat,pati, c, angle, ppatcolor, ppattype
  376.       INTEGER HPGLFillMap(0:10,0:1)
  377.       COMMON /HPGL/ HPGLFillMap
  378.       COMMON /PPAT/ ppatcolor, ppattype
  379.  
  380.       IF (pati .GE. 0) THEN
  381.         CALL InitStr(outString)
  382.         CALL InitStr(tempstr)
  383.         ppatcolor = c
  384.         ppattype = pati
  385.         pat = HPGLFillMap(pati, 0)
  386.         angle = HPGLFillMap(pati, 1)
  387.         outString = 'FT'
  388.         CALL INTTOSTR(pat, tempstr, ',')
  389.         CALL PConcat(outString, tempstr)
  390.         CALL INTTOSTR(4, tempstr, ',')
  391.         CALL PConcat(outString, tempstr)
  392.         CALL INTTOSTR(angle, tempstr, ';')
  393.         CALL PConcat(outString, tempstr)
  394.         CALL WritePlotter(outString)
  395.       END IF
  396.       END !SUBROUTINE
  397.  
  398.  
  399.       SUBROUTINE PSetLineStyle (ls, thick)
  400.       INTEGER ls,  thick, l
  401.       CHARACTER * 80 outString, tempstr
  402.  
  403.       CALL InitStr(outString)
  404.       CALL InitStr(tempstr)
  405.       IF (ls .EQ. 0) THEN
  406.         outString = 'LT;'
  407.       ELSE
  408.         outString = 'LT'
  409.         CALL INTTOSTR(ls, tempstr, ',')
  410.         CALL PConcat(outString, tempstr)
  411.         L = LEN_TRIM(outString)+1
  412.         outString(l:l ) = CHAR(2)
  413.         l = l + 1
  414.         outString(l:l) = ';'
  415.       END IF
  416.       L = LEN_TRIM(outString)+1
  417.       outString(l:l) =  'PT '
  418.       CALL INTTOSTR(thick, tempstr, ';')
  419.       CALL PConcat (outString, tempstr)
  420.       CALL WritePlotter(outString)
  421.  
  422.       END !SUBROUTINE
  423.  
  424.  
  425.  
  426.       SUBROUTINE PSetTextJustify (h, v)
  427.       INTEGER  tHJust, tVJust, tdir, h, v
  428.       COMMON /PlotJust/ tHJust, tVJust, tdir
  429.  
  430.       tHJust = h
  431.       tvJust = v
  432.       END !SUBROUTINE
  433.  
  434.  
  435.  
  436.       SUBROUTINE PSetTextStyle (font, dir, size)
  437.       REAL wr, hr
  438.       INTEGER font, dir, size
  439.       PARAMETER (wr = 0.075)
  440.       PARAMETER (hr = 0.1)
  441.       INTEGER xrun, xrise
  442.       CHARACTER * 80 outString, tempstr
  443.  
  444.       CALL InitStr(outString)
  445.       CALL InitStr(tempstr)
  446.       tdir = dir
  447.       IF (dir .EQ. 0) THEN
  448.         xrun = 1
  449.         xrise = 0
  450.       END IF
  451.       IF (dir .EQ. 1) THEN
  452.         xrun = 0
  453.         xrise = 1
  454.       END IF
  455.  
  456.       outString = 'DI'
  457.       CALL INTTOSTR(xrun, tempstr,',')
  458.       CALL PConcat (outString, tempstr)
  459.       CALL INTTOSTR(xrise,tempstr,';')
  460.       CALL PConcat (outString, tempstr)
  461.       CALL WritePlotter(outString)
  462.       outString = 'SI'
  463.       CALL RTOSTR( wr*size, tempstr, ',')
  464.       CALL PConcat (outString, tempstr)
  465.       CALL RTOSTR( hr*size, tempstr, ';')
  466.       CALL PConcat (outString, tempstr)
  467.       CALL WritePlotter(outString)
  468.  
  469.       outString = 'CS'
  470.       CALL INTTOSTR(font,tempstr, ';')
  471.       CALL PConcat (outString, tempstr)
  472.       CALL WritePlotter(outString)
  473.       END !SUBROUTINE
  474.  
  475.  
  476.       SUBROUTINE RealString (r, digits, wid, TheString)
  477.       REAL r, tempr
  478.       CHARACTER * 80 TheString, result
  479.       INTEGER  exponent, digits, wid, num, position, behind, before
  480.       INTEGER delta, i,j, y, strLen, location
  481.       LOGICAL sign
  482.  
  483.       location = 1
  484.       CALL InitStr(TheString)
  485.       tempr = r
  486.       sign = .FALSE.
  487.       strLen = ABS(REAL(digits)) + 2    !!!  min. 2 characters sign, digit
  488.       IF (digits .NE. 0) strLen = strLen + 1
  489.       IF (digits .LT. 0) strLen = strLen + 4
  490.       IF (tempr .LT. 0)  sign = .TRUE.
  491.       tempr = ABS(tempr)
  492.  
  493.       !!!  if not scientific notation then round it now
  494. c      IF (digits .GE. 0) tempr=tempr+ 0.5 * exp10(-digits) + 1.0E-14
  495.  
  496.       !!!  normalize downward, less than 10
  497.       exponent = 0
  498.       DO WHILE (tempr .GE. 10.0)
  499.        tempr=tempr/ 10.0
  500.         exponent = exponent + 1
  501.       END DO
  502.       IF (digits .GE. 0) THEN
  503.         before = exponent
  504.       ELSE
  505.         before = 0
  506.       END IF
  507.       behind = ABS(digits)
  508.  
  509.       !!!  scientific notation
  510.       IF (digits .LT. 0 .AND.tempr.NE. 0.0) THEN
  511.         DO WHILE (tempr .LT. 1.0 )  !!!  normalize upward, greater than 1
  512.          tempr=tempr* 10.0
  513.           exponent = exponent - 1
  514.         END DO
  515. c       tempr=tempr+ 0.5 * exp10(-ABS(digits)) + 1E-14     !!!  round it now
  516.         IF (tempr .GE. 10.0) THEN  !!!  normalize downward to less than 10
  517.          tempr=tempr/ 10.0
  518.           exponent = exponent + 1
  519.         END IF
  520.       END IF
  521.       !!!  sign
  522.       IF (sign) THEN
  523.         result(1:1) = '-'
  524.         location = location + 1
  525.       END IF
  526.  
  527.       !!!  Write digits before the decimal-point
  528.       y = AINT(tempr)
  529.       result(location:location) = CHAR(y+48)
  530.       location = location + 1
  531.       tempr= tempr - REAL(y)
  532.       DO WHILE (before .GT. 0)
  533.         tempr = tempr * 10.0
  534.         y = AINT(tempr)
  535.         result(location:location) =  CHAR(y+48)
  536.         strindex = strindex + 1
  537.         location = location + 1
  538.         tempr = tempr - y
  539.         before = before - 1
  540.       END DO
  541.       IF (behind .NE. 0) THEN
  542.         result(location:location) = '.'
  543.         strindex = strindex + 1
  544.         location = location + 1
  545.       END IF
  546.  
  547.       !!!  write digits after the decimal-point
  548.       DO WHILE (behind .GT. 0)
  549.         tempr = tempr * 10.0
  550.         y = AINT(tempr)
  551.         result(location:location) = CHAR(y + 48)
  552.         strindex = strindex + 1
  553.         location = location + 1
  554.         tempr = tempr - REAL(y)
  555.         behind = behind - 1
  556.       END DO
  557.  
  558.       !!!  scientific notation: write exponent
  559.       IF (digits .LT. 0) THEN
  560.         result(location:location) =  'E'
  561.         strindex = strindex + 1
  562.         location = location + 1
  563.         IF (exponent .GE. 0) THEN
  564.           result(location:location) =  '+'
  565.         ELSE
  566.           result(location:location) =  '-'
  567.         END IF
  568.         location = location + 1
  569.         num = ABS(exponent)
  570.         IF (num .GE. 10) THEN
  571.           explen = 2
  572.         ELSE
  573.           explen = 1
  574.         END IF
  575.         position = location + explen - 1    !!!  start on the right
  576.  
  577.          DO WHILE (num .NE. 0)
  578.            i = MOD(num, 10)
  579.            result(position:position) = CHAR(i+48)
  580.            position = position - 1
  581.            num = num / 10
  582.          END DO
  583.          DO WHILE (position .GE. location)
  584.            result(position:position) = ' '
  585.            position = position - 1
  586.          END DO
  587.          location = location + explen
  588.        END IF
  589.  
  590.    !!!  leading blanks
  591.        location = location - 1
  592.        IF (wid .GT. location) THEN
  593.          delta = wid - location
  594.        ELSE
  595.          delta = 0
  596.        END IF
  597.        DO i = 1, location
  598.             j = i+delta
  599.             TheString(j:j) = Result(i:i)
  600.        END DO
  601.        END !SUBROUTINE
  602.  
  603.  
  604.       SUBROUTINE ScalePlotterViewport (x1, y1, x2, y2)
  605.       INTEGER x1, y1, x2, y2
  606.       CHARACTER * 80 outString, tempstr
  607.  
  608.       CALL InitStr(outString)
  609.       CALL InitStr(tempstr)
  610.       outString = 'SC'
  611.       CALL INTTOSTR(x1, tempstr, ',' )
  612.       CALL PConcat (outString, tempstr)
  613.       CALL INTTOSTR(x2, tempstr, ',')
  614.       CALL PConcat (outString, tempstr)
  615.       CALL INTTOSTR(y1, tempstr, ',')
  616.       CALL PConcat (outString, tempstr)
  617.       CALL INTTOSTR(y2, tempstr, ';')
  618.       CALL PConcat (outString, tempstr)
  619.       CALL WritePlotter(outString)
  620.       END !SUBROUTINE
  621.  
  622.       SUBROUTINE SelectPen (p)
  623.       CHARACTER * 80 outString, tempStr
  624.       INTEGER p, ppatcolor, ppattype, CurColor, MaxColor
  625.       COMMON /PPAT/ ppatcolor, ppattype
  626.       COMMON /Current/ CurColor
  627.       COMMON /Max/ MaxColor
  628.  
  629.       ppatcolor = p
  630.       IF (ppatcolor .GT. MaxColor) THEN ppatcolor = MaxColor
  631.       IF (CurColor .NE. ppatcolor) THEN
  632.         CALL InitStr(outString)
  633.         CALL InitStr(tempstr)
  634.         CALL PenUp
  635.         CurColor = ppatcolor
  636.         outString = 'SP'
  637.         CALL INTTOSTR(CurColor,tempstr, ';')
  638.         CALL PConcat (outString, tempstr)
  639.         CALL WritePlotter(outString)
  640.       END IF
  641.       END !SUBROUTINE
  642.  
  643.  
  644.  
  645.       SUBROUTINE SelectPenVelocity (v)
  646.       INTEGER v
  647.       CHARACTER * 80 outString, tempStr
  648.  
  649.       CALL InitStr(outString)
  650.       CALL InitStr(tempstr)
  651.       outString = 'VS'
  652.       CALL INTTOSTR(v, tempStr, ';')
  653.       CALL PConcat (outString, tempStr)
  654.       CALL WritePlotter(outString)
  655.       END !SUBROUTINE
  656.  
  657.  
  658.  
  659.       SUBROUTINE SetClippingWindow (x1, y1, x2, y2)
  660.       REAL x1, y1, x2, y2
  661.       CHARACTER * 80 outString, tempstr
  662.  
  663.       CALL InitStr(outString)
  664.       CALL InitStr(tempstr)
  665.       outString = 'IW'
  666.       CALL RTOSTR(x1, tempStr, ',')
  667.       CALL PConcat (outString, tempStr)
  668.       CALL RTOSTR(y1, tempStr, ',')
  669.       CALL PConcat (outString, tempStr)
  670.       CALL RTOSTR(x2, tempStr, ',')
  671.       CALL PConcat (outString, tempStr)
  672.       CALL RTOSTR(y2, tempStr, ';')
  673.       CALL PConcat (outString, tempStr)
  674.       CALL WritePlotter(outString)
  675.       END !SUBROUTINE
  676.  
  677.       SUBROUTINE SetMaxColor (c)
  678.       INTEGER c, MaxColor
  679.       COMMON /Max/ MaxColor
  680.       MaxColor = c
  681.       END !SUBROUTINE
  682.  
  683.  
  684.  
  685.       SUBROUTINE SetPlotterViewport (x1, y1, x2, y2)
  686.       CHARACTER * 80 outString, tempstr
  687.       INTEGER x1, y1, x2, y2, PUx1, PUy1, PUx2, PUy2
  688.       COMMON /PlotView/  PUx1, PUy1, PUx2, PUy2
  689.  
  690.       CALL InitStr(outString)
  691.       CALL InitStr(tempstr)
  692.       PUx1 = x1
  693.       PUx2 = x2
  694.       PUy1 = y1
  695.       PUy2 = y2
  696.  
  697.       outString = 'IP'
  698.  
  699.       CALL INTTOSTR(x1, tempStr, ',')
  700.       CALL PConcat (outString, tempStr)
  701.       CALL INTTOSTR(y1, tempStr, ',')
  702.       CALL PConcat (outString, tempStr)
  703.       CALL INTTOSTR(x2, tempStr, ',')
  704.       CALL PConcat (outString, tempStr)
  705.       CALL INTTOSTR(y2, tempStr, ';')
  706.       CALL PConcat (outString, tempStr)
  707.       CALL WritePlotter(outString)
  708.       END !SUBROUTINE
  709.  
  710.  
  711.  
  712.       SUBROUTINE RTOSTR(x, S, dc)
  713.       REAL x, tx
  714.       CHARACTER * 80 TempStr, S
  715.       CHARACTER dc
  716.       INTEGER l
  717.  
  718.       CALL InitStr(s)
  719.       CALL InitStr(tempstr)
  720.       tx = x
  721.       CALL RealString(tx, 2, 1, TempStr)
  722.  
  723.       l = LEN_TRIM(TempStr) + 1
  724.       TempStr(l:l) =  dc
  725.       S = TempStr
  726.       END ! FUNCTION
  727.  
  728.  
  729.  
  730.       SUBROUTINE INTTOSTR(x, S, dc)
  731.       INTEGER l,x
  732.       REAL tx
  733.       CHARACTER * 80 S, TempStr
  734.       CHARACTER dc
  735.       CALL InitStr(s)
  736.       CALL InitStr(tempstr)
  737.       tx = REAL(x)
  738.       CALL RealString(tx, 0, 1, TempStr)
  739.       l = LEN_TRIM(TempStr) + 1
  740.       TempStr(l:l) =  dc
  741.       S = TempStr
  742.       END ! FUNCTION
  743.  
  744.  
  745.  
  746.       SUBROUTINE PEdgeWedge(x,y,radius, start,sweep)
  747.       REAL x, y, radius
  748.       INTEGER  start,  sweep
  749.       CHARACTER * 80 outString, tempstr
  750.  
  751.        CALL InitStr(outString)
  752.        CALL InitStr(tempstr)
  753.        CALL Pmoveto(x,y)
  754.        outString = 'EW'
  755.        CALL RTOSTR(radius, tempStr, ',')
  756.        CALL PConcat(outString, tempstr)
  757.        CALL INTTOSTR(start, tempStr, ',')
  758.        CALL PConcat (outstring, tempstr)
  759.        CALL INTTOSTR(sweep, tempStr, ',')
  760.        CALL PConcat (outstring, tempstr)
  761.        CALL INTTOSTR(5, tempStr, ';')
  762.        CALL PConcat (outstring, tempstr)
  763.        CALL WritePlotter(outString)
  764.       END
  765.  
  766.  
  767.  
  768.       SUBROUTINE PShadeWedge(x, y, radius, start, sweep)
  769.       REAL x, y, radius
  770.       INTEGER  start,  sweep, c, ppatcolor, ppattype
  771.       CHARACTER * 80 outString, tempstr
  772.       INTEGER CurColor
  773.       COMMON /Current/ CurColor
  774.       COMMON /PPAT/ ppatcolor, ppattype
  775.  
  776.  
  777.       CALL InitStr(outString)
  778.       CALL InitStr(tempstr)
  779.       CALL PEdgeWedge(x,y,radius,start,sweep)
  780.       IF (ppattype .GT. 0) THEN
  781.         CALL Pmoveto(x,y)
  782.         c = CurColor
  783.         CALL SelectPen(ppatcolor)
  784.         outString =  'WG'
  785.         CALL RTOSTR(radius, tempStr, ',')
  786.         CALL PConcat(outString, tempstr)
  787.         CALL INTTOSTR(start, tempStr, ',')
  788.         CALL PConcat (outstring, tempstr)
  789.         CALL INTTOSTR(sweep, tempStr, ',')
  790.         CALL PConcat (outstring, tempstr)
  791.         CALL INTTOSTR(5, tempStr, ';')
  792.         CALL PConcat (outstring, tempstr)
  793.         CALL WritePlotter(outString)
  794.         CALL SelectPen(c)
  795.       END IF
  796.       END
  797.  
  798.