1C*GRSCR -- set color representation
2C+
3      SUBROUTINE GRSCR (CI, CR, CG, CB)
4      INTEGER  CI
5      REAL     CR, CG, CB
6C
7C GRPCKG: SET COLOUR REPRESENTATION -- define the colour to be
8C associated with a colour index.  Ignored for devices which do not
9C support variable colour or intensity.  On monochrome output
10C devices (e.g. VT125 terminals with monochrome monitors), the
11C monochrome intensity is computed from the specified Red, Green, Blue
12C intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
13C systems, NTSC encoding.  Note that most devices do not have an
14C infinite range of colours or monochrome intensities available;
15C the nearest available colour is used.
16C
17C Arguments:
18C
19C CI (integer, input): colour index. If the colour index is outside the
20C       range available on the device, the call is ignored. Colour
21C       index 0 applies to the background colour.
22C CR, CG, CB (real, input): red, green, and blue intensities,
23C       in range 0.0 to 1.0.
24C--
25C 20-Feb-1984 - [TJP].
26C  5-Jun-1984 - add GMFILE device [TJP].
27C  2-Jul-1984 - add REGIS device [TJP].
28C  2-Oct-1984 - change use of map tables in Regis [TJP].
29C 11-Nov-1984 - add code for /TK [TJP].
30C  1-Sep-1986 - add GREXEC support [AFT].
31C 21-Feb-1987 - If needed, calls begin picture [AFT].
32C 31-Aug-1994 - suppress call of begin picture [TJP].
33C  1-Sep-1994 - use common data [TJP].
34C 26-Jul-1995 - fix bug: some drivers would ignore a change to the
35C               current color [TJP].
36C-----------------------------------------------------------------------
37      INCLUDE 'grpckg1.inc'
38      INTEGER   NBUF, LCHR
39      REAL      RBUF(6)
40      CHARACTER CHR
41C
42      IF (GRCIDE.LT.1) THEN
43          CALL GRWARN('GRSCR - Specified workstation is not open.')
44      ELSE IF (CR.LT.0.0 .OR. CG.LT.0.0 .OR. CB.LT.0.0 .OR.
45     1    CR.GT.1.0 .OR. CG.GT.1.0 .OR. CB.GT.1.0) THEN
46          CALL GRWARN('GRSCR - Colour is outside range [0,1].')
47      ELSE IF (CI.GE.GRMNCI(GRCIDE) .AND. CI.LE.GRMXCI(GRCIDE)) THEN
48C         IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
49          RBUF(1)=CI
50          RBUF(2)=CR
51          RBUF(3)=CG
52          RBUF(4)=CB
53          NBUF=4
54          CALL GREXEC(GRGTYP,21,RBUF,NBUF,CHR,LCHR)
55C         -- If this is the current color, reselect it in the driver.
56          IF (CI.EQ.GRCCOL(GRCIDE)) THEN
57             RBUF(1) = CI
58             CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR)
59          END IF
60      END IF
61C
62      END
63