1
2C*GRPXPX -- Perform pixel operations using pixel primitive
3C+
4      SUBROUTINE GRPXPX (IA, IDIM, JDIM, I1, I2, J1, J2, X, Y)
5      INTEGER IDIM, JDIM, I1, I2, J1, J2
6      INTEGER IA(IDIM,JDIM)
7      REAL    X, Y
8C
9C Arguments:
10C  IA     (input)  : the array to be plotted.
11C  IDIM   (input)  : the first dimension of array A.
12C  JDIM   (input)  : the second dimension of array A.
13C  I1, I2 (input)  : the inclusive range of the first index
14C                    (I) to be plotted.
15C  J1, J2 (input)  : the inclusive range of the second
16C                    index (J) to be plotted.
17C  X, Y   (input)  : the lower left corner of the output region
18C                    (device coordinates)
19C--
20C 16-Jan-1991 - [GvG]
21*  4-Aug-1993 - Debugged by Remko Scharroo
22C-----------------------------------------------------------------------
23      INCLUDE 'grpckg1.inc'
24      INTEGER     NSIZE
25      PARAMETER   (NSIZE = 1280)
26      REAL        RBUF(NSIZE + 2)
27      REAL        WIDTH
28      INTEGER     IC1, IC2
29      INTEGER     I, J, L
30      INTEGER     NBUF, LCHR
31      CHARACTER*1 CHR
32
33      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
34C
35C Get allowable color range and pixel width
36C
37      CALL GRQCOL(IC1, IC2)
38      CALL GREXEC(GRGTYP, 3, RBUF, NBUF, CHR, LCHR)
39      WIDTH = RBUF(3)
40      DO 30 J = J1, J2
41C
42C Compute Y coordinate for this line
43C
44         RBUF(2) = Y + (J - J1) * WIDTH
45         I = I1
46  10        L = 1
47C
48C Compute left X coordinate for this line segment
49C
50            RBUF(1) = X + (I - I1) * WIDTH
51C
52C Check color index
53C
54  20           IF (IA(I, J) .LT. IC1 .OR. IC2 .LT. IA(I, J)) THEN
55                  RBUF(L + 2) = 1
56               ELSE
57                  RBUF(L + 2) = IA(I, J)
58               ENDIF
59               L = L + 1
60               I = I + 1
61C
62C Still room in segment and something left?
63C
64            IF (L .LE. NSIZE .AND. I .LE. I2) GOTO 20
65C
66C Output segment
67C
68*           NBUF = L + 2 ! wrong ! should be: (RS)
69            NBUF = L + 1
70            CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
71C
72C Something left?
73C
74         IF (I .LE. I2) GOTO 10
75  30  CONTINUE
76
77      END
78