home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / pgplot_1 / SYS_ARC_f77_NUDriver < prev    next >
Encoding:
Text File  |  1996-04-18  |  11.2 KB  |  380 lines
  1. C*NUDRIV -- PGPLOT Null device driver
  2. C+
  3.       SUBROUTINE NUDRIV (IFUNC, RBUF, NBUF, CHR, LCHR)
  4.       INTEGER IFUNC, NBUF, LCHR
  5.       REAL    RBUF(*)
  6.       CHARACTER*(*) CHR
  7. C
  8. C PGPLOT driver for Null device (no graphical output)
  9. C
  10. C Version 1.0  - 1987 May 26 - T. J. Pearson.
  11. C Version 1.1  - 1988 Mar 23 - add rectangle fill.
  12. C Version 1.2  - 1992 Sep  3 - add line-of-pixels.
  13. C Version 1.3  - 1992 Sep 21 - add markers.
  14. C Version 1.4  - 1993 Apr 22 - add optional debugging.
  15. C Version 1.5  - 1994 Aug 31 - use image primitives.
  16. C Version 2.0  - 1996 Jan 22 - allow multiple active devices;
  17. C                              add QCR primitive.
  18. C
  19. C Supported device: The ``null'' device can be used to suppress
  20. C all graphic output from a program.  If environment variable
  21. C PGPLOT_DEBUG is defined, some debugging information is
  22. C reported on standard output.
  23. C
  24. C Device type code: /NULL.
  25. C
  26. C Default device name: None (the device name, if specified, is 
  27. C ignored).
  28. C
  29. C Default view surface dimensions: Undefined (The device pretends to
  30. C be a hardcopy device with 1000 pixels/inch and a view surface 8in 
  31. C high by 10.5in wide.)
  32. C
  33. C Resolution: Undefined.
  34. C
  35. C Color capability: Color indices 0--255 are accepted.
  36. C
  37. C Input capability: None.
  38. C
  39. C File format: None.
  40. C
  41. C Obtaining hardcopy: Not possible.
  42. C-----------------------------------------------------------------------
  43. C Notes:
  44. C  Up to MAXDEV "devices" may be open at once. ACTIVE is the number
  45. C  of the currently selected device, or 0 if no devices are open.
  46. C  STATE(i) is 0 if device i is not open, 1 if it is open but with
  47. C  no current picture, or 2 if it is open with a current picture.
  48. C
  49. C  When debugging is enabled, open/close device and begin/end picture
  50. C  calls are reported on stdout, and a cumulative count of all
  51. C  driver calls is kept.
  52. C-----------------------------------------------------------------------
  53.       CHARACTER*(*) DEVICE
  54.       PARAMETER (DEVICE='NULL  (Null device, no output)')
  55.       INTEGER MAXDEV
  56.       PARAMETER (MAXDEV=8)
  57.       INTEGER NOPCOD
  58.       PARAMETER (NOPCOD=29)
  59.       CHARACTER*10 MSG
  60.       CHARACTER*32 TEXT
  61.       CHARACTER*8  LAB(NOPCOD)
  62.       INTEGER COUNT(NOPCOD), I, STATE(0:MAXDEV), L, NPIC(MAXDEV)
  63.       INTEGER ACTIVE
  64.       LOGICAL DEBUG
  65.       INTEGER CTABLE(3,0:255), CDEFLT(3,0:15)
  66.       SAVE COUNT, STATE, NPIC, DEBUG, CTABLE, CDEFLT, ACTIVE
  67. C
  68.       DATA ACTIVE/-1/
  69.       DATA COUNT/NOPCOD*0/
  70.       DATA DEBUG/.FALSE./
  71.       DATA LAB  /'qdev    ', 'qmaxsize', 'qscale  ', 'qcapab  ',
  72.      1           'qdefnam ', 'qdefsize', 'qmisc   ', 'select  ',
  73.      2           'open    ', 'close   ', 'beginpic', 'line    ',
  74.      3           'dot     ', 'endpic  ', 'set CI  ', 'flush   ',
  75.      4           'cursor  ', 'eralpha ', 'set LS  ', 'polygon ',
  76.      5           'set CR  ', 'set LW  ', 'escape  ', 'rectangl',
  77.      6           'set patt', 'pix/imag', 'scaling ', 'marker  ',
  78.      7           'query CR'/
  79.       DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000,
  80.      1             000,000,255, 000,255,255, 255,000,255, 255,255,000,
  81.      2             255,128,000, 128,255,000, 000,255,128, 000,128,255,
  82.      3             128,000,255, 255,000,128, 085,085,085, 170,170,170/
  83. C-----------------------------------------------------------------------
  84. C
  85.       IF (ACTIVE.EQ.-1) THEN
  86.            CALL GRGENV('DEBUG', TEXT, L)
  87.            DEBUG = L.GT.0
  88.            ACTIVE = 0
  89.            STATE(ACTIVE) = 0
  90.       END IF
  91. C
  92.       IF (IFUNC.LT.1 .OR. IFUNC.GT.NOPCOD) GOTO 900
  93.       COUNT(IFUNC) = COUNT(IFUNC) + 1
  94.       GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
  95.      1     110,120,130,140,150,160,170,180,190,200,
  96.      2     210,220,230,240,250,260,270,280,290), IFUNC
  97.   900 WRITE (MSG, '(I10)') IFUNC
  98.       CALL GRWARN('Unimplemented function in NULL device driver: '//MSG)
  99.       NBUF = -1
  100.       RETURN
  101. C
  102. C--- IFUNC = 1, Return device name.-------------------------------------
  103. C
  104.    10 CHR = DEVICE
  105.       LCHR = LEN(DEVICE)
  106.       RETURN
  107. C
  108. C--- IFUNC = 2, Return physical min and max for plot device, and range
  109. C               of color indices.---------------------------------------
  110. C
  111.    20 RBUF(1) = 0
  112.       RBUF(2) = 65535
  113.       RBUF(3) = 0
  114.       RBUF(4) = 65535
  115.       RBUF(5) = 0
  116.       RBUF(6) = 255
  117.       NBUF = 6
  118.       RETURN
  119. C
  120. C--- IFUNC = 3, Return device resolution. ------------------------------
  121. C
  122.    30 RBUF(1) = 1000.0
  123.       RBUF(2) = 1000.0
  124.       RBUF(3) = 1
  125.       NBUF = 3
  126.       RETURN
  127. C
  128. C--- IFUNC = 4, Return misc device info. -------------------------------
  129. C    (This device is Hardcopy, No cursor, Dashed lines, Area fill, Thick
  130. C    lines, Rectangle fill, Images, , , Markers, query color rep)
  131. C
  132.    40 CHR = 'HNDATRQNYM'
  133.       LCHR = 10
  134.       RETURN
  135. C
  136. C--- IFUNC = 5, Return default file name. ------------------------------
  137. C
  138.    50 CHR = 'NL:'
  139.       LCHR = 3
  140.       RETURN
  141. C
  142. C--- IFUNC = 6, Return default physical size of plot. ------------------
  143. C
  144.    60 RBUF(1) = 0
  145.       RBUF(2) = 10499
  146.       RBUF(3) = 0
  147.       RBUF(4) = 7999
  148.       NBUF = 4
  149.       RETURN
  150. C
  151. C--- IFUNC = 7, Return misc defaults. ----------------------------------
  152. C
  153.    70 RBUF(1) = 1
  154.       NBUF = 1
  155.       RETURN
  156. C
  157. C--- IFUNC = 8, Select plot. -------------------------------------------
  158. C
  159.    80 CONTINUE
  160.       I = RBUF(2) - 67890
  161.       IF (I.LT.1 .OR. I.GT.MAXDEV) THEN
  162.          CALL GRWARN('internal error: NULL opcode 8')
  163.       ELSE IF (STATE(I).GT.0) THEN
  164.          ACTIVE = I
  165.       ELSE
  166.          CALL GRNU00(IFUNC,0)
  167.       END IF
  168.       RETURN
  169. C
  170. C--- IFUNC = 9, Open workstation. --------------------------------------
  171. C
  172.    90 CONTINUE
  173. C     -- Find an inactive device, and select it
  174.       DO 91 I=1,MAXDEV
  175.          IF (STATE(I).EQ.0) THEN
  176.             ACTIVE = I
  177.             STATE(ACTIVE) = 1
  178.             GOTO 92
  179.          END IF
  180.  91   CONTINUE
  181.       IF (DEBUG) CALL GRWARN ('09 Open workstation')
  182.       CALL GRWARN('maximum number of devices of type NULL exceeded')
  183.       RBUF(1) = 0
  184.       RBUF(2) = 0 
  185.       NBUF = 2
  186.       RETURN
  187. C     -- Initialize the new device
  188.  92   CONTINUE
  189.       RBUF(1) = ACTIVE + 67890
  190.       RBUF(2) = 1
  191.       NBUF = 2
  192.       NPIC(ACTIVE) = 0
  193. C     -- Initialize color table
  194.       DO 95 I=0,15
  195.          CTABLE(1,I) = CDEFLT(1,I)
  196.          CTABLE(2,I) = CDEFLT(2,I)
  197.          CTABLE(3,I) = CDEFLT(3,I)
  198.  95   CONTINUE
  199.       DO 96 I=16,255
  200.          CTABLE(1,I) = 128
  201.          CTABLE(2,I) = 128
  202.          CTABLE(3,I) = 128
  203.  96   CONTINUE
  204.       IF (DEBUG) THEN
  205.          CALL GRFAO('09 Open workstation: device #',
  206.      :        L, TEXT, ACTIVE, 0, 0, 0)
  207.          CALL GRWARN(TEXT(1:L))
  208.       END IF
  209.       RETURN
  210. C
  211. C--- IFUNC=10, Close workstation. --------------------------------------
  212. C
  213.   100 CONTINUE
  214.       IF (STATE(ACTIVE).NE.1) CALL GRNU00(IFUNC,STATE(ACTIVE))
  215.       STATE(ACTIVE) = 0
  216.       IF (DEBUG) THEN
  217.          CALL GRFAO('10 Close workstation: device #',
  218.      :        L, TEXT, ACTIVE, 0, 0, 0)
  219.          CALL GRWARN(TEXT(1:L))
  220.          CALL GRWARN('Device driver calls:')
  221.          DO 101 I=1,NOPCOD
  222.             IF (COUNT(I).GT.0) THEN
  223.                WRITE (TEXT,'(3X,I2,1X,A8,I10)') I, LAB(I), COUNT(I)
  224.                CALL GRWARN(TEXT)
  225.             END IF
  226.  101     CONTINUE
  227.       END IF
  228.       RETURN
  229. C
  230. C--- IFUNC=11, Begin picture. ------------------------------------------
  231. C
  232.   110 CONTINUE
  233.       IF (STATE(ACTIVE).NE.1) CALL GRNU00(IFUNC,STATE(ACTIVE))
  234.       STATE(ACTIVE) = 2
  235.       NPIC(ACTIVE) = NPIC(ACTIVE)+1
  236.       IF (DEBUG) THEN
  237.          CALL GRFAO('11   Begin picture # on device #',
  238.      :        L, TEXT, NPIC(ACTIVE), ACTIVE, 0,0)
  239.          CALL GRWARN(TEXT(:L))
  240.       END IF
  241.       RETURN
  242. C
  243. C--- IFUNC=12, Draw line. ----------------------------------------------
  244. C
  245.   120 CONTINUE
  246.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  247.       RETURN
  248. C
  249. C--- IFUNC=13, Draw dot. -----------------------------------------------
  250. C
  251.   130 CONTINUE
  252.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  253.       RETURN
  254. C
  255. C--- IFUNC=14, End picture. --------------------------------------------
  256. C
  257.   140 CONTINUE
  258.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  259.       STATE(ACTIVE) = 1
  260.       IF (DEBUG) THEN
  261.          CALL GRFAO('14   End picture   # on device #',
  262.      :        L, TEXT, NPIC(ACTIVE), ACTIVE, 0,0)
  263.          CALL GRWARN(TEXT(:L))
  264.       END IF
  265.       RETURN
  266. C
  267. C--- IFUNC=15, Select color index. -------------------------------------
  268. C
  269.   150 CONTINUE
  270.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  271.       RETURN
  272. C
  273. C--- IFUNC=16, Flush buffer. -------------------------------------------
  274. C
  275.   160 CONTINUE
  276.       IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE))
  277.       RETURN
  278. C
  279. C--- IFUNC=17, Read cursor. --------------------------------------------
  280. C    (Not implemented: should not be called.)
  281. C
  282.   170 GOTO 900
  283. C
  284. C--- IFUNC=18, Erase alpha screen. -------------------------------------
  285. C
  286.   180 CONTINUE
  287.       IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE))
  288.       RETURN
  289. C
  290. C--- IFUNC=19, Set line style. -----------------------------------------
  291. C
  292.   190 CONTINUE
  293.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  294.       RETURN
  295. C
  296. C--- IFUNC=20, Polygon fill. -------------------------------------------
  297. C
  298.   200 CONTINUE
  299.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  300.       RETURN
  301. C
  302. C--- IFUNC=21, Set color representation. -------------------------------
  303. C
  304.   210 CONTINUE
  305.       IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE))
  306.       I = RBUF(1)
  307.       CTABLE(1, I) = NINT(RBUF(2)*255)
  308.       CTABLE(2, I) = NINT(RBUF(3)*255)
  309.       CTABLE(3, I) = NINT(RBUF(4)*255)
  310.       RETURN
  311. C
  312. C--- IFUNC=22, Set line width. -----------------------------------------
  313. C
  314.   220 CONTINUE
  315.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  316.       RETURN
  317. C
  318. C--- IFUNC=23, Escape. -------------------------------------------------
  319. C
  320.   230 CONTINUE
  321.       RETURN
  322. C
  323. C--- IFUNC=24, Rectangle fill. -----------------------------------------
  324. C
  325.   240 CONTINUE
  326.       IF (DEBUG.AND.STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  327.       RETURN
  328. C
  329. C--- IFUNC=25, Not implemented -----------------------------------------
  330. C
  331.   250 CONTINUE
  332.       RETURN
  333. C
  334. C--- IFUNC=26, Line of pixels ------------------------------------------
  335. C
  336.   260 CONTINUE
  337.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  338.       RETURN
  339. C
  340. C--- IFUNC=27, Scaling info -- -----------------------------------------
  341. C
  342.   270 CONTINUE
  343.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  344.       RETURN
  345. C
  346. C--- IFUNC=28, Draw marker ---------------------------------------------
  347. C
  348.   280 CONTINUE
  349.       IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE))
  350. C     WRITE (*,'(1X,A,I4,1X,3F10.1)') 'MARKER', NINT(RBUF(1)), RBUF(2),
  351. C    1      RBUF(3), RBUF(4)
  352.       RETURN
  353. C
  354. C--- IFUNC=29, Query color representation. -----------------------------
  355. C
  356.   290 CONTINUE
  357.       IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE))
  358.       I = RBUF(1)
  359.       RBUF(2) = CTABLE(1,I)/255.0
  360.       RBUF(3) = CTABLE(2,I)/255.0
  361.       RBUF(4) = CTABLE(3,I)/255.0
  362.       NBUF = 4
  363.       RETURN
  364. C-----------------------------------------------------------------------
  365.       END
  366.  
  367.       SUBROUTINE GRNU00(IFUNC, STATE)
  368.       INTEGER IFUNC, STATE
  369. C
  370. C PGPLOT NULL device driver: report error
  371. C-----------------------------------------------------------------------
  372.       INTEGER L
  373.       CHARACTER*80 MSG
  374. C
  375.       CALL GRFAO('++ internal error: driver in state # for opcode #',
  376.      :           L, MSG, STATE, IFUNC, 0, 0)
  377.       CALL GRWARN(MSG(1:L))
  378.       RETURN
  379.       END
  380.