home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / 14 / plot.f < prev    next >
Encoding:
Text File  |  1990-07-13  |  2.1 KB  |  100 lines
  1.     subroutine plot (x, y, ipen)
  2.     real             x, y
  3.     integer                ipen
  4. C
  5. C  Plotter driver conforming to:
  6. C    "Programming CalComp Electromechanical Plotters", CalComp, January 1976
  7. C    Output for PostScript printers like Apple LaserWriter Plus
  8. C
  9. C  Rex Sanders, USGS, 2/87
  10. C
  11. C  Where:
  12. C    x,y = coordinates, in inches from the current origin, of the position
  13. C          to which the pen is to be moved
  14. C
  15. C    ipen = pen control, origin definition, and plot termiination such that:
  16. C      if ipen = 1, move with pen in present condition
  17. C      if ipen = 2, move with pen down
  18. C      if ipen = 3, move with pen up
  19. C      if ipen = -1, move with no pen change, reset origin to terminal position
  20. C      if ipen = -2, move with pen down, reset origin to terminal position
  21. C      if ipen = -3, move with pen up, reset origin to terminal position
  22. C      if ipen = 999, move with pen up, terminate plot, close plot file
  23. C      if ipen = anything else, no action is taken
  24. C
  25.  
  26.     common /cqpbnf/ xold, yold, fac, ires
  27.     save   /cqpbnf/
  28.     real            xold, yold, fac
  29.     integer                          ires
  30.  
  31.     integer locpen
  32.     logical penup
  33.     save    penup
  34.     data    penup /.true./
  35.  
  36.     locpen = abs (ipen)
  37.  
  38. C
  39. C   Check pen for proper values
  40. C
  41.     if (locpen .ne. 1 .and. locpen .ne. 2 .and. locpen .ne. 3 .and.
  42. &          ipen .ne. 999) return
  43.  
  44. C
  45. C   Reset locpen to current pen status
  46. C
  47.     if (locpen .eq. 1) then
  48.         if (penup) then
  49.         locpen = 3
  50.         else
  51.         locpen = 2
  52.         endif
  53.     endif
  54.  
  55. C
  56. C   Set up for move or draw
  57. C     Output "x y"
  58. C
  59.     call pliout (nint (x * fac * ires))
  60.     call plcout (32)
  61.     call pliout (nint (y * fac * ires))
  62.  
  63. C
  64. C   Pen down - draw
  65. C
  66.     if (locpen .eq. 2) then
  67.         call plsout (" D\n")
  68.         penup = .false.
  69.  
  70. C
  71. C   Pen up - move
  72. C
  73.     else if (locpen .eq. 3 .or. locpen .eq. 999) then
  74.         call plsout (" M\n")
  75.         penup = .true.
  76.     endif
  77.  
  78.     if (ipen .ge. 0) then
  79.         xold = x
  80.         yold = y
  81.     else
  82. C
  83. C    Set new origin
  84. C
  85.         call plsout ("O\n")
  86.         xold = 0.0
  87.         yold = 0.0
  88.     endif
  89.  
  90. C
  91. C   Close and clean up plot file
  92. C
  93.     if (ipen .eq. 999) then
  94.         call plsout ("showpage\n")
  95.         call pldone
  96.     endif
  97.  
  98.     return
  99.     end
  100.