home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / utilities / utilsp / pgplot / Examples / f77 / PGSCRN < prev   
Encoding:
Text File  |  1994-02-27  |  4.2 KB  |  125 lines
  1. C*PGSCRN -- set color representation by name
  2. C+
  3.       SUBROUTINE PGSCRN(CI, NAME, IER)
  4.       INTEGER CI
  5.       CHARACTER*(*) NAME
  6.       INTEGER IER
  7. C
  8. C Set color representation: i.e., define the color to be
  9. C associated with a color index.  Ignored for devices which do not
  10. C support variable color or intensity.  This is an alternative to
  11. C routine PGSCR. The color representation is defined by name instead
  12. C of (R,G,B) components.
  13. C
  14. C Color names are defined in an external file which is read the first
  15. C time that PGSCRN is called. The name of the external file is
  16. C found as follows:
  17. C 1. if environment variable (logical name) PGPLOT_RGB is defined,
  18. C    its value is used as the file name;
  19. C 2. otherwise, if environment variable PGPLOT_DIR is defined, a
  20. C    file "rgb.txt" in the directory named by this environment
  21. C    variable is used;
  22. C 3. otherwise, file "rgb.txt" in the current directory is used.
  23. C If all of these fail to find a file, an error is reported and
  24. C the routine does nothing.
  25. C
  26. C Each line of the file
  27. C defines one color, with four blank- or tab-separated fields per
  28. C line. The first three fields are the R, G, B components, which
  29. C are integers in the range 0 (zero intensity) to 255 (maximum
  30. C intensity). The fourth field is the color name. The color name
  31. C may include embedded blanks. Example:
  32. C
  33. C 255   0   0 red
  34. C 255 105 180 hot pink
  35. C 255 255 255 white
  36. C   0   0   0 black
  37. C
  38. C Arguments:
  39. C  CI     (input)  : the color index to be defined, in the range 0-max.
  40. C                    If the color index greater than the device
  41. C                    maximum is specified, the call is ignored. Color
  42. C                    index 0 applies to the background color.
  43. C  NAME   (input)  : the name of the color to be associated with
  44. C                    this color index. This name must be in the
  45. C                    external file. The names are not case-sensitive.
  46. C                    If the color is not listed in the file, the
  47. C                    color representation is not changed.
  48. C  IER    (output) : returns 0 if the routine was successful, 1
  49. C                    if an error occurred (either the external file
  50. C                    could not be read, or the requested color was
  51. C                    not defined in the file).
  52. C--
  53. C 12-Oct-1992 [TJP]
  54. C 31-May-1993 [TJP] use GROPTX to open file.
  55. C-----------------------------------------------------------------------
  56.       INTEGER MAXCOL
  57.       PARAMETER (MAXCOL=1000)
  58.       INTEGER I, IR, IG, IB, J, L, NCOL, UNIT, IOS
  59.       INTEGER GRCTOI, GROPTX
  60.       REAL RR(MAXCOL), RG(MAXCOL), RB(MAXCOL)
  61.       CHARACTER*20 CREQ, CNAME(MAXCOL)
  62.       CHARACTER*80 TEXT
  63.       SAVE NCOL, CNAME, RR, RG, RB
  64.       DATA NCOL/0/
  65. C
  66. C On first call, read the database.
  67. C
  68.       IF (NCOL.EQ.0) THEN
  69.           CALL GRGLUN(UNIT)
  70.           CALL GRGENV('RGB', TEXT, L)
  71.           IF (L.EQ.0) THEN
  72.               CALL GRGENV('DIR', TEXT, L)
  73.               TEXT(L+1:) = 'rgb.txt'
  74.               L = L+7
  75.           END IF
  76.           IOS = GROPTX(UNIT, TEXT(1:L), 'rgb.txt', 0)
  77.           IF (IOS.NE.0) GOTO 40
  78.           PRINT *,'opened unit',UNIT,', name ',TEXT(1:L)
  79.           DO 10 I=1,MAXCOL
  80.               READ (UNIT, '(A)', ERR=15, END=15) TEXT
  81.               J = 1
  82.               CALL GRSKPB(TEXT, J)
  83.               IR = GRCTOI(TEXT, J)
  84.               CALL GRSKPB(TEXT, J)
  85.               IG = GRCTOI(TEXT, J)
  86.               CALL GRSKPB(TEXT, J)
  87.               IB = GRCTOI(TEXT, J)
  88.               CALL GRSKPB(TEXT, J)
  89.               NCOL = NCOL+1
  90.               CALL GRTOUP(CNAME(NCOL), TEXT(J:))
  91.               RR(NCOL) = IR/255.0
  92.               RG(NCOL) = IG/255.0
  93.               RB(NCOL) = IB/255.0
  94.    10     CONTINUE
  95.    15     CLOSE (UNIT)
  96.           CALL GRFLUN(UNIT)
  97.       END IF
  98. C
  99. C Look up requested color and set color representation if found.
  100. C
  101.       CALL GRTOUP(CREQ, NAME)
  102.       DO 20 I=1,NCOL
  103.           IF (CREQ.EQ.CNAME(I)) THEN
  104.               CALL PGSCR(CI, RR(I), RG(I), RB(I))
  105.               IER = 0
  106.               RETURN
  107.           END IF
  108.    20 CONTINUE
  109. C
  110. C Color not found.
  111. C
  112.       IER = 1
  113.       TEXT = 'Color not found: '//NAME
  114.       CALL GRWARN(TEXT)
  115.       PRINT *,' NCOL =',NCOL,', CREQ =',CREQ
  116.       RETURN
  117. C
  118. C Database not found.
  119. C
  120.    40 IER = 1
  121.       NCOL = -1
  122.       CALL GRWARN('Unable to read color file: PGPLOT_RGB')
  123.       RETURN
  124.       END
  125.