1      SUBROUTINE EPDRIV(IFUNC,RBUF,NBUF,CHR,LCHR)
2C GRPCKG driver for EPSON FX100 dot matrix printer.
3C
4C    Apr-1987 - Floating-point input version Apr 1987 [PSB].
5C 16-Jan-1988 - Compile with /WARN=(DECLARE) switch [AFT].
6C---
7      CHARACTER ESC, DUAL
8      PARAMETER (ESC=CHAR(27))
9      PARAMETER (DUAL=CHAR(1))
10      REAL       PL,    PL1
11      PARAMETER (PL=765,PL1=PL-1)
12      REAL      RBUF(6)
13      INTEGER   IFUNC, NBUF, LCHR
14      CHARACTER CHR*(*)
15C
16      INTEGER   GRGMEM, GRFMEM, GRTRIM
17      INTEGER   XYMAP, LENOLD, IST, IXDIM, IYDIM, LENBUF
18      INTEGER   I, J, N, ICOL, LUN
19      INTEGER*2 BUF(0:1632)
20      CHARACTER NN*2
21      SAVE LUN,XYMAP,ICOL,IXDIM,IYDIM,LENOLD,LENBUF
22      DATA LENOLD/0/
23C---
24      GOTO (100,200,300,400,500,600,700,800,900,1000,
25     :      1100,1200,1300,1400,1500) IFUNC
26      GOTO 999
27C
28C       1: Return device name:
29100   CHR = 'EPSON (Epson dot matrix printer)'
30      LCHR = GRTRIM(CHR)
31      RETURN
32C
33C       2: Return physical min & max for device:
34200   RBUF(1) = 0
35      RBUF(2) = 1631
36C                     ! dual-density 120/"
37      RBUF(3) = 0
38      RBUF(4) = -1
39C                     ! as long as a box of paper...
40      RBUF(5) = 0
41C                     ! min colour
42      RBUF(6) = 1
43C                     ! max colour
44      NBUF = 6
45      RETURN
46C
47C       3: Return device resolution:
48300   RBUF(1) = 120.0
49C                     ! horiz dots per inch
50      RBUF(2) = 72.0
51C                     ! veric dots per inch
52      RBUF(3) = 1.0
53C                     ! thick lines
54      RETURN
55C
56C       4: Return misc info:
57C H= Hardcopy device
58C N= No cursor
59C N= No hard dash
60C N= No area fill
61C N= No hard thick lines
62400   CHR(1:10) = 'HNNNNNNNNN'
63      RETURN
64C
65C       5: Return default file name:
66500   CHR = 'PGPLOT.EPS'
67      LCHR = LEN(CHR)
68      RETURN
69C
70C       6: Return default size of plot:
71600   RBUF(1) = 0
72      RBUF(2) = 1631
73      RBUF(3) = 0
74      RBUF(4) = PL1
75C                     ! 72 ./" -> 11" PAGE.
76      RETURN
77C
78C       7: Return misc defaults:
79700   RBUF(1) = 1.
80      ICOL = 1
81      RETURN
82C
83C       8: Select Plot:
84800   RETURN
85C
86C       9: Open device:
87900   CALL GRGLUN(LUN)
88      OPEN(LUN,FILE=CHR(:LCHR),STATUS='NEW',
89     1  RECORDTYPE='VARIABLE',RECL=4000)
90      RBUF(1) = LUN
91      RBUF(2) = 1
92      RETURN
93C
94C       10: Close device:
951000  CLOSE(UNIT=LUN)
96      CALL GRFLUN(LUN)
97      IF(LENOLD.GT.0) THEN
98          IST = GRFMEM(LENOLD,XYMAP)
99          IF(IST.NE.1) STOP 'error freeing memory in EPDRIV'
100          LENOLD=0
101      ENDIF
102      RETURN
103C
104C       11: Initialise plot:
1051100  IXDIM = RBUF(1) + 1
106      IYDIM = RBUF(2)/9 + 1
107      LENBUF = IXDIM*IYDIM*2
108C                       ! length of buffer in bytes
109      IF(LENBUF.NE.LENOLD) THEN
110          IF(LENOLD.GT.0) THEN
111            IST = GRFMEM(LENOLD,XYMAP)
112            IF(IST.NE.1) STOP 'error freeing memory in EPDRIV'
113            LENOLD=0
114          ENDIF
115          IST = GRGMEM(LENBUF,XYMAP)
116          IF(IST.NE.1) STOP 'error allocating memory in EPDRIV'
117          LENOLD = LENBUF
118      ENDIF
119      CALL GREP03(LENBUF,%VAL(XYMAP))
120      RETURN
121C
122C       12: Draw a line:
1231200  CALL GREP01(RBUF,ICOL,IXDIM-1,IYDIM-1,%VAL(XYMAP))
124      RETURN
125C
126C       13: Draw a dot:
1271300  CALL GREP02(RBUF,ICOL,IXDIM-1,IYDIM-1,%VAL(XYMAP))
128      RETURN
129C
130C       14: Close plot:
1311400  CONTINUE
132C
133C       Initialise printer:
134      WRITE(LUN,1411) ESC,'A',CHAR(9)
135C                    ! 9 dots per line;
1361411  FORMAT(1X,3A1)
137      DO 1460 J=0,IYDIM-1
138          CALL GREP04(%VAL(XYMAP+IXDIM*J*2),IXDIM,BUF)
139C
140C         Find last non-zero dot position:
141          DO 1430 I=IXDIM-1,0,-1
142            N = I + 1
143            IF(BUF(I).NE.0) GOTO 1440
1441430      CONTINUE
1451440      CONTINUE
146          NN(1:1) = CHAR(N.AND.255)
147          NN(2:2) = CHAR(N/256)
148          BUF(N) = '0A0D'X
149C                  ! CR LF
150          WRITE(LUN,1441) ESC,';',DUAL,NN,(BUF(I),I=0,N)
1511441      FORMAT(1X,3A1,A2,1632A2)
1521460  CONTINUE
153C
154C       Reset printer to normal:
155      WRITE(LUN,1461)ESC,'2',CHAR(13)
156C                  ! 1/6 line spacing
1571461  FORMAT(1X,3A1)
158      RETURN
159C
160C       15: Set colour:
1611500  ICOL = MAX(MIN(NINT(RBUF(1)),1),0)
162C                  ! only black or white.
163      RBUF(1) = ICOL
164      RETURN
165C---
166C--- Flag function not implemented.
167999   NBUF=-1
168      RETURN
169      END
170
171      SUBROUTINE GREP01(RBUF,ICOL,IXDIM,IYDIM,XYMAP)
172C- Draw a line on Epson:
173      REAL      RBUF(6)
174      INTEGER   ICOL, IXDIM, IYDIM
175      INTEGER*2 XYMAP(0:IXDIM,0:IYDIM)
176C
177      REAL      XL, YL, D, XP, YP, XINC, YINC
178      INTEGER   L, LENGTH, IX, IY, IYBIT
179      INTEGER*2 BITS(0:8)
180      DATA BITS/128,64,32,16,8,4,2,1,-32768/
181C---
182      XL = RBUF(3) - RBUF(1)
183      YL = RBUF(4) - RBUF(2)
184      D = MAX(ABS(XL),ABS(YL),1.0)
185      LENGTH = NINT(D)
186      XP = RBUF(1)
187      YP = RBUF(2)
188      XINC = XL/D
189      YINC = YL/D
190      DO 180 L = 0,LENGTH
191          IX = NINT(XP)
192          IY = IYDIM*9 - NINT(YP)
193          IYBIT = MOD(IY,9)
194          IF(ICOL.GT.0) THEN
195            XYMAP(IX,IY/9) =
196     :      XYMAP(IX,IY/9).OR.BITS(IYBIT)
197          ELSE
198            XYMAP(IX,IY/9) =
199     :      XYMAP(IX,IY/9).AND.(.NOT.BITS(IYBIT))
200          ENDIF
201          XP = XP + XINC
202          YP = YP + YINC
203180   CONTINUE
204      RETURN
205      END
206
207      SUBROUTINE GREP02(RBUF,ICOL,IXDIM,IYDIM,XYMAP)
208C
209C- Draw a dot:
210      REAL      RBUF(6)
211      INTEGER   ICOL, IXDIM, IYDIM
212      INTEGER*2 XYMAP(0:IXDIM,0:IYDIM)
213C
214      INTEGER   IY, IYBIT
215      INTEGER*2 BITS(0:8)
216      DATA BITS/128,64,32,16,8,4,2,1,-32768/
217C---
218      IY = IYDIM*9 - NINT(RBUF(2))
219      IYBIT = MOD(IY,9)
220      XYMAP(NINT(RBUF(1)),IY/9) =
221     :XYMAP(NINT(RBUF(1)),IY/9).OR.BITS(IYBIT)
222      RETURN
223      END
224
225      SUBROUTINE GREP03(LENBUF,XYMAP)
226C- Erase bitmap
227      INTEGER   LENBUF, XYMAP(*)
228      INTEGER   I
229C---
230      DO 180 I=1,LENBUF/4
231          XYMAP(I) = 0
232180   CONTINUE
233      RETURN
234      END
235
236      SUBROUTINE GREP04(XYMAP,IXDIM,BUF)
237C- Copy a line of output to buf
238      INTEGER   IXDIM
239      INTEGER*2 XYMAP(IXDIM), BUF(IXDIM)
240      INTEGER   I
241C---
242      DO 180 I=1,IXDIM
243          BUF(I) = XYMAP(I)
244180   CONTINUE
245      RETURN
246      END
247