1C*GRSLS -- set line style
2C+
3      SUBROUTINE GRSLS (IS)
4      INTEGER IS
5C
6C GRPCKG: Set the line style for subsequent plotting on the current
7C device. The different line styles are generated in hardware on
8C some devices and by GRPCKG software for the other devices. Five
9C different line styles are available, with the following codes:
10C 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted),
11C 5 (dash-dot-dot-dot). The default is 1 (normal full line). Line
12C style is ignored when drawing characters, which are always drawn with
13C a full line.
14C
15C Argument:
16C
17C IS (input, integer): the line-style code for subsequent plotting on
18C       the current device (in range 1-5).
19C--
20C  9-Feb-1983 - [TJP].
21C  3-Jun-1984 - add GMFILE device [TJP].
22C  5-Aug-1986 - add GREXEC support [AFT].
23C 21-Feb-1987 - If needed, calls begin picture [AFT].
24C 19-Jan-1987 - fix bug in GREXEC call [TJP].
25C 16-May-1989 - fix bug for hardware line dash [TJP].
26C  1-Sep-1994 - do not call driver to get size and capabilities [TJP].
27C-----------------------------------------------------------------------
28      INCLUDE 'grpckg1.inc'
29      INTEGER I, L, IDASH, NBUF,LCHR
30      REAL    RBUF(6),TMP
31      CHARACTER*10 CHR
32      REAL PATERN(8,5)
33C
34      DATA PATERN/ 8*10.0,
35     1             8*10.0,
36     2             8.0, 6.0, 1.0, 6.0, 8.0, 6.0, 1.0, 6.0,
37     3             1.0, 6.0, 1.0, 6.0, 1.0, 6.0, 1.0, 6.0,
38     4             8.0, 6.0, 1.0, 6.0, 1.0, 6.0, 1.0, 6.0 /
39C
40      IF (GRCIDE.LT.1) THEN
41          CALL GRWARN('GRSLS - no graphics device is active.')
42          RETURN
43      END IF
44C
45      I = IS
46      IF (I.LT.1 .OR. I.GT.5) THEN
47          CALL GRWARN('GRSLS - invalid line-style requested.')
48          I = 1
49      END IF
50C
51C Inquire if hardware dash is available.
52C
53      IDASH=0
54      IF(GRGCAP(GRCIDE)(3:3).EQ.'D') IDASH=1
55C
56C Set up for hardware dash.
57C
58      IF(IDASH.NE.0) THEN
59          GRDASH(GRCIDE) = .FALSE.
60          IF (GRPLTD(GRCIDE)) THEN
61              RBUF(1)=I
62              NBUF=1
63              CALL GREXEC(GRGTYP,19,RBUF,NBUF,CHR,LCHR)
64          END IF
65C
66C Set up for software dash.
67C
68      ELSE
69          IF (I.EQ.1) THEN
70              GRDASH(GRCIDE) = .FALSE.
71          ELSE
72              GRDASH(GRCIDE) = .TRUE.
73              GRIPAT(GRCIDE) = 1
74              GRPOFF(GRCIDE) = 0.0
75              TMP = GRYMXA(GRCIDE)/1000.
76              DO 10 L=1,8
77                  GRPATN(GRCIDE,L) = PATERN(L,I)*TMP
78   10         CONTINUE
79          END IF
80      END IF
81      GRSTYL(GRCIDE) = I
82      END
83