1      SUBROUTINE IMDRIV (IFUNC, RBUF, NBUF, CHR, LCHR)
2      INTEGER IFUNC, NBUF, LCHR
3      REAL    RBUF(*)
4      CHARACTER*(*) CHR
5C-----------------------------------------------------------------------
6C PGPLOT driver for Impress (Imagen) device.
7C-----------------------------------------------------------------------
8C Version 0.9  - 1987 Aug 19 - T. J. Pearson.
9C Modifications:
10C REW -- 23 MAY 1988 -- Orientation from x axis, not h axis
11C REW -- 25 MAY 1988 -- Change physical min/max
12C			 from 3074/2324 to 3150/2400  10.5 x 8)
13C REW -- 31 MAY 1988 -- Include x and y offsets to improve centering
14C
15C Note: this is a preliminary release. The driver has the following
16C problems: (a) does not use hardware thick lines; (b) white lines do
17C not to erase background as they should; (c) lines are handled as
18C separate segments, instead of combining connected segments into paths,
19C which should be more efficient.
20C-----------------------------------------------------------------------
21C
22C Supported device: any Imagen printer that accepts the Impress page
23C description language.
24C
25C Device type code: /IMPRESS (landscape mode).
26C
27C Default file name: PGPLOT.IMPLOT.
28C
29C Default view surface dimensions:
30C 10.5 inches horizontal x  8 inches vertical (landscape mode).
31C Note that the Imagen laser printer prints from the bottom edge
32C  of the sheet and cannot print on the top half inch of the sheet.
33C
34C Resolution: the driver uses coordinate increments of 1/300 inch.
35C The true resolution is device-dependent.
36C
37C Color capability: color indices 0 (erase), and 1 (black)
38C are supported. Requests for other color indices are
39C converted to 1. It is not possible to change color representation.
40C
41C Input capability: none.
42C
43C File format: binary, variable length records (max 1024 bytes); no
44C carriage control.
45C
46C Obtaining hardcopy:  $ IMPRINT/IMPRESS file.type
47C-----------------------------------------------------------------------
48      CHARACTER*(*) TYPE, DEFNAM
49      PARAMETER (DEFNAM='PGPLOT.IMPLOT')
50      PARAMETER (TYPE='IMPRESS')
51      INTEGER BUFSIZ
52      PARAMETER (BUFSIZ=1024)
53      INTEGER BUFFER
54      INTEGER BUFLEV
55      INTEGER UNIT, IER
56      INTEGER*2 I0, I1, J0, J1, NPTS
57      INTEGER GRGMEM, GRFMEM
58      CHARACTER*10 MSG
59      INTEGER IC
60      BYTE    BUF(100), COLOR
61      INTEGER NW
62	INTEGER SIZEX, SIZEY			! REW -- 26MAY88
63	PARAMETER (SIZEX=3150 ,SIZEY=2400)	! REW -- 26MAY88
64	INTEGER OFFSETX, OFFSETY		! REW -- 31MAY88
65	PARAMETER (OFFSETX=75, OFFSETY=15)      ! REW -- 31MAY88
66C-----------------------------------------------------------------------
67C
68      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
69     1     110,120,130,140,150,160,170,180,190,200,
70     2     210,220,230), IFUNC
71  900 WRITE (MSG,'(I10)') IFUNC
72      CALL GRWARN('Unimplemented function in IMPRESS device driver:'
73     1    //MSG)
74      NBUF = -1
75      RETURN
76C
77C--- IFUNC = 1, Return device name -------------------------------------
78C
79   10 CHR = TYPE
80      LCHR = LEN(TYPE)
81      RETURN
82C
83C--- IFUNC = 2, Return physical min and max for plot device, and range
84C               of color indices ---------------------------------------
85C
86   20 RBUF(1) = 0
87      RBUF(2) = SIZEX			! rew -- 25 may 1988
88      RBUF(3) = 0
89      RBUF(4) = SIZEY			! rew -- 25 may 1988
90      RBUF(5) = 0
91      RBUF(6) = 1
92      NBUF = 6
93      RETURN
94C
95C--- IFUNC = 3, Return device resolution -------------------------------
96C    (Nominal values)
97C
98   30 RBUF(1) = 300.0
99      RBUF(2) = 300.0
100C      (multiple strokes are spaced by 1 pixels, or 1/300 inch)
101      RBUF(3) = 1
102      NBUF = 3
103      RETURN
104C
105C--- IFUNC = 4, Return misc device info --------------------------------
106C    (Hardcopy, No cursor, No dashed lines, Area fill,
107C    no thick lines)
108C
109   40 CHR = 'HNNANNNNNN'
110      LCHR = 10
111      RETURN
112C
113C--- IFUNC = 5, Return default file name -------------------------------
114C
115   50 CHR = DEFNAM
116      LCHR = LEN(DEFNAM)
117      RETURN
118C
119C--- IFUNC = 6, Return default physical size of plot -------------------
120C
121   60 RBUF(1) = 0
122      RBUF(2) = SIZEX				! rew -- 25 May 1988
123      RBUF(3) = 0
124      RBUF(4) = SIZEY				! rew -- 25 May 1988
125      NBUF = 4
126      RETURN
127C
128C--- IFUNC = 7, Return misc defaults -----------------------------------
129C
130   70 RBUF(1) = 8.0
131      NBUF=1
132      RETURN
133C
134C--- IFUNC = 8, Select plot --------------------------------------------
135C
136   80 CONTINUE
137      RETURN
138C
139C--- IFUNC = 9, Open workstation ---------------------------------------
140C
141   90 CONTINUE
142C     -- allocate buffer
143      IER = GRGMEM(BUFSIZ, BUFFER)
144      IF (IER.NE.1) THEN
145          CALL GRGMSG(IER)
146          CALL GRWARN('Failed to allocate plot buffer.')
147          RBUF(2) = IER
148          RETURN
149      END IF
150C     -- open device
151      CALL GRGLUN(UNIT)
152      NBUF = 2
153      RBUF(1) = UNIT
154      OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE',
155     1      DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW',
156     2      FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER,
157     3      RECL=256)
158      IF (IER.NE.0) THEN
159          CALL GRWARN('Cannot open output file for '//TYPE//' plot: '//
160     1                CHR(:LCHR))
161          RBUF(2) = 0
162          CALL GRFLUN(UNIT)
163          IER = GRFMEM(BUFSIZ, BUFFER)
164          RETURN
165      ELSE
166          INQUIRE (UNIT=UNIT, NAME=CHR)
167          LCHR = LEN(CHR)
168   91     IF (CHR(LCHR:LCHR).EQ.' ') THEN
169              LCHR = LCHR-1
170              GOTO 91
171          END IF
172          RBUF(2) = 1
173      END IF
174      IC = 1
175C     -- initialization
176      NPTS = 0
177      COLOR = 15
178      RETURN
179C
180C--- IFUNC=10, Close workstation ---------------------------------------
181C
182  100 CONTINUE
183      CLOSE (UNIT, DISPOSE='KEEP')
184      CALL GRFLUN(UNIT)
185      IER = GRFMEM(BUFSIZ, BUFFER)
186      IF (IER.NE.1) THEN
187          CALL GRWARN('Error deallocating plot buffer.')
188          CALL GRGMSG(IER)
189      END IF
190      RETURN
191C
192C--- IFUNC=11, Begin picture -------------------------------------------
193C
194  110 CONTINUE
195C     -- set coordinate system
196      BUF(1) = 205 ! SET_HV_SYSTEM
197      BUF(2) = 29  ! 0 0 3 5			! REW -- 23 MAY 1988
198      BUF(3) = 135 ! SET_ABS_H
199      BUF(4) = 0
200      BUF(5) = 0
201      BUF(6) = 137 ! SET_ABS_V
202      BUF(7) = 0
203      BUF(8) = 0
204      NW = 8
205      GOTO 1000
206C
207C--- IFUNC=12, Draw line -----------------------------------------------
208C
209  120 CONTINUE
210      IF (IC.EQ.0) RETURN
211      I0 = OFFSETX + NINT(RBUF(1))
212      J0 = OFFSETY + NINT(RBUF(2))
213      I1 = OFFSETX + NINT(RBUF(3))
214      J1 = OFFSETY + NINT(RBUF(4))
215  125 CONTINUE
216      BUF(1) = 230 ! CREATE_PATH
217      CALL GRIM00(BUF(2), 2) ! 2 vertices
218      CALL GRIM00(BUF(4), I0) ! coordinates of vertices
219      CALL GRIM00(BUF(6), J0)
220      CALL GRIM00(BUF(8), I1)
221      CALL GRIM00(BUF(10), J1)
222      BUF(12) = 234 ! DRAW_PATH
223      BUF(13) = COLOR	! black or white
224      NW = 13
225      GOTO 1000
226C
227C--- IFUNC=13, Draw dot ------------------------------------------------
228C
229  130 CONTINUE
230      IF (IC.EQ.0) RETURN
231      I0 = OFFSETX + NINT(RBUF(1))
232      J0 = OFFSETY + NINT(RBUF(2))
233      I1 = I0
234      J1 = J0
235      GOTO 125
236C
237C--- IFUNC=14, End picture ---------------------------------------------
238C
239  140 CONTINUE
240      BUF(1) = 219 ! ENDPAGE
241      NW = 1
242      GOTO 1000
243C
244C--- IFUNC=15, Select color index --------------------------------------
245C
246  150 CONTINUE
247      IC = RBUF(1)
248      IF (IC.LT.0 .OR. IC.GT.1) THEN
249          IC = 1
250          RBUF(1) = IC
251      END IF
252      COLOR = 15
253      IF (IC.EQ.0) COLOR = 0
254      RETURN
255C
256C--- IFUNC=16, Flush buffer. -------------------------------------------
257C
258  160 CONTINUE
259      CALL GRIM03(%val(BUFFER), UNIT, BUFLEV)
260      RETURN
261C
262C--- IFUNC=17, Read cursor. --------------------------------------------
263C           Not implemented.
264C
265  170 CONTINUE
266      GOTO 900
267C
268C--- IFUNC=18, Erase alpha screen. -------------------------------------
269C    (Not implemented: no alpha screen)
270C
271  180 CONTINUE
272      RETURN
273C
274C--- IFUNC=19, Set line style. -----------------------------------------
275C    (Not implemented: should not be called)
276C
277  190 CONTINUE
278      GOTO 900
279C
280C--- IFUNC=20, Polygon fill. -------------------------------------------
281C
282  200 CONTINUE
283      IF (NPTS.EQ.0) THEN
284          NPTS = RBUF(1)
285          BUF(1) = 230 ! CREATE_PATH
286          CALL GRIM00(BUF(2), NPTS) ! # vertices
287          NW = 3
288      ELSE
289          NPTS = NPTS-1
290	  I0 = OFFSETX + NINT(RBUF(1))
291	  J0 = OFFSETY + NINT(RBUF(2))
292          CALL GRIM00(BUF(1), I0) ! coordinates of vertex
293          CALL GRIM00(BUF(3), J0)
294          NW = 4
295	  IF (NPTS.EQ.0) THEN
296              BUF(5) = 233 ! FILL_PATH
297              BUF(6) = COLOR	! black or white
298              NW = 6
299	  END IF
300      END IF
301      GOTO 1000
302C
303C--- IFUNC=21, Set color representation. -------------------------------
304C    (Not implemented: ignored)
305C
306  210 CONTINUE
307      RETURN
308C
309C--- IFUNC=22, Set line width. -----------------------------------------
310C    (Not implemented: should not be called)
311C
312  220 CONTINUE
313      GOTO 900
314C
315C--- IFUNC=23, Escape --------------------------------------------------
316C    (Not implemented: ignored)
317C
318  230 CONTINUE
319      RETURN
320C
321C--- Send the command. -------------------------------------------------
322C
323 1000 CALL GRIM02(BUF,NW,%val(BUFFER),BUFLEV,UNIT)
324C-----------------------------------------------------------------------
325      END
326
327C*GRIM00 -- PGPLOT Impress driver, write word
328C+
329      SUBROUTINE GRIM00(BUF,WORD)
330      BYTE BUF(2), WORD(2)
331C--
332      BUF(1) = WORD(2)
333      BUF(2) = WORD(1)
334      END
335
336C*GRIM02 -- PGPLOT Impress driver, transfer data to buffer
337C+
338      SUBROUTINE GRIM02 (INSTR, N, BUFFER, HWM, UNIT)
339      INTEGER   N, HWM, UNIT
340      BYTE      INSTR(*), BUFFER(*)
341C
342C Arguments:
343C  INSTR  (input)  : text of instruction (bytes).
344C  N      (input)  : number of bytes to transfer.
345C  BUFFER (input)  : output buffer.
346C  HWM    (in/out) : number of bytes used in BUFFER.
347C  UNIT   (input)  : channel number for output (when buffer is full).
348C
349C Subroutines called:
350C   GRIM03
351C-----------------------------------------------------------------------
352      INTEGER BUFSIZ
353      PARAMETER (BUFSIZ=1024)
354      INTEGER  I
355C-----------------------------------------------------------------------
356      IF (HWM+N.GE.BUFSIZ) CALL GRIM03(BUFFER, UNIT, HWM)
357      DO 10 I=1,N
358          HWM = HWM + 1
359          BUFFER(HWM) = INSTR(I)
360   10 CONTINUE
361C-----------------------------------------------------------------------
362      END
363
364C*GRIM03 -- PGPLOT Impress driver, copy buffer to file
365C+
366      SUBROUTINE GRIM03 (BUFFER, UNIT, N)
367      BYTE BUFFER(*)
368      INTEGER UNIT, N
369C
370C Arguments:
371C   BUFFER (input) address of buffer to be output
372C   UNIT   (input) unit number for output
373C   N      (input) number of bytes to transfer
374C          (output) set to zero
375C-----------------------------------------------------------------------
376      INTEGER J
377C-----------------------------------------------------------------------
378      IF (N.GT.0) WRITE (UNIT) (BUFFER(J),J=1,N)
379      N = 0
380C-----------------------------------------------------------------------
381      END
382