1	SUBROUTINE IKDRIV(IFUNC, RBUF, NBUF, CHR, LCHR)
2	INTEGER   IFUNC, NBUF, LCHR
3	REAL      RBUF(*)
4	CHARACTER CHR*(*)
5C
6C PGPLOT driver for Ikon devices.
7C---
8C Supported device:  Digisolve Ikon Pixel Engine
9C
10C Device type code:  /IKon.
11C
12C Default device name:  IKON_DEFAULT (a logical name).
13C
14C Default view surface dimensions:  Depends on monitor.
15C
16C Resolution:  The full view surface is 1024 by 780 pixels.
17C
18C Color capability: Color indices 0-255 are supported.  The default
19C   representation is listed in Chapter 5 of the PGPLOT manual.  The
20C   representation of all color indices can be changed.
21C
22C Input capability:
23C
24C File format:  It is not possible to send IKON plots to a disk file.
25C
26C Obtaining hardcopy:  Not possible.
27C---
28C 30-Jan-1988 - [AFT].
29C-----------------------------------------------------------------------
30	INCLUDE '($IODEF)'
31C
32	CHARACTER MSG*10
33	INTEGER   GRIK00, SYS$DASSGN, GRGMEM, SYS$QIOW
34	INTEGER   I0, J0, ISTAT
35	INTEGER*2 ITMP(9), INIT(51), IOSB(4)
36	INTEGER   IREM, ICHAN, MXCNT, ICNT, IBADR, ICOL, NPTS, INEWP
37	SAVE      IREM, ICHAN, MXCNT, ICNT, IBADR, ICOL, NPTS, INEWP
38	LOGICAL   APPEND
39	SAVE      APPEND
40	DATA INIT/82,15,0,     0,  0,  0, 255,255,255, 255,  0,  0,
41     :		  0,255,  0,   0,  0,255,   0,255,255, 255,  0,255,
42     :		255,255,  0, 255,127,  0, 127,255, 0,    0,255,127,
43     :		  0,127,255, 127,  0,255, 255,  0,127,  85, 85, 85,
44     :		170,170,170/
45C---
46	GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
47     &       110,120,130,140,150,160,170,180,900,200,
48     &       210,900,230) IFUNC
49  900 WRITE (MSG,'(I10)') IFUNC
50	CALL GRWARN('Unimplemented function in IK device driver: '//MSG)
51	NBUF = -1
52	RETURN
53C
54C--- IFUNC= 1, Return device name. -------------------------------------
5510	CHR='IKON'
56	LCHR=LEN(CHR)
57	RETURN
58C
59C--- IFUNC= 2, Return Physical min and max for plot device. ------------
6020	RBUF(1)=0
61	RBUF(2)=1023
62	RBUF(3)=0
63	RBUF(4)=779
64	RBUF(5)=0
65	RBUF(6)=255
66	NBUF=6
67	RETURN
68C
69C--- IFUNC= 3, Return device resolution. -------------------------------
7030	RBUF(1)=50.0
71	RBUF(2)=50.0
72	RBUF(3)=1
73	NBUF=3
74	RETURN
75C
76C--- IFUNC= 4, Return misc device info. --------------------------------
77C I= Interactive device
78C C= Cursor
79C N= No hard dash
80C A= Area fill
81C N= No hard thick lines
8240	CHR='ICNANNNNNN'
83	LCHR=10
84	RETURN
85C
86C--- IFUNC= 5, Return default file name. -------------------------------
8750	CHR='IKON_DEFAULT'
88	LCHR=LEN(CHR)
89	NBUF=1
90	RETURN
91C
92C--- IFUNC= 6, Return default physical size of plot. -------------------
9360	RBUF(1)=0
94	RBUF(2)=1023
95	RBUF(3)=0
96	RBUF(4)=779
97	RETURN
98C
99C--- IFUNC= 7, Return misc defaults. -----------------------------------
10070	RBUF(1)=1
101	NBUF=1
102	RETURN
103C
104C--- IFUNC= 8, Select plot. --------------------------------------------
10580	CALL INIK03(NINT(RBUF(2)))
106	RETURN
107C
108C--- IFUNC= 9, Open workstation. ---------------------------------------
10990	APPEND=RBUF(3).NE.0.0
110	RBUF(2)=GRIK00(ICHAN,CHR,LCHR)
111	RBUF(1)=ICHAN
112C---
113C- Allocate a buffer.
114	MXCNT=8192
115	ISTAT=GRGMEM(MXCNT,IBADR)
116	IF(ISTAT.NE.1) THEN
117	    CALL GRWARN('Unable to allocate virtual memory.')
118C- Error return
11992	    CALL GRGMSG(ISTAT)
120	    RBUF(2)=0
121	    CALL SYS$DASSGN(%val(ICHAN))
122	    RETURN
123	END IF
124C- MXCNT is the number of INTEGER*2
125	MXCNT=MXCNT/2
126	ICNT=0
127C- Define channel for use by GRIK03.
128	CALL INIK03(ICHAN)
129C---
130C- If device opened remotely, set remote flag.  Note, current
131C- driver does not support remote access.
132C---
133	IF(NINT(RBUF(2)).EQ.1) THEN
134	    IREM=0
135	ELSE IF(NINT(RBUF(2)).EQ.3) THEN
136	    IREM=1
137	    RBUF(2)=1
138	ELSE
139C- Error condition.
140	    RETURN
141	END IF
142C- Set last (x,y) to be invalid
143	CALL INIK01
144C---
145C- Reset.
146	IF(.NOT.APPEND) THEN
147C- Reset interface.
148	    ISTAT=SYS$QIOW(,%val(ICHAN),
149     :                    %val(IO$_WRITEVBLK.OR.IO$M_RESET),
150     :                    ,,,%val(0),%val(0),,,,)
151C- Wait for status line A to go low (about 2.2 sec)
15294	    ISTAT=SYS$QIOW(,%VAL(ICHAN),
153     :                    %val(IO$_WRITEVBLK),IOSB,
154     :                    ,,%val(0),%val(0),,,,)
155	    IF(ISTAT.NE.1) GOTO 92
156	    IF((IOSB(3).AND.'800'x) .NE. 0) THEN
157		CALL LIB$WAIT(0.25)
158		GOTO 94
159	    END IF
160	END IF
161C- Set 8-bit register $3F (set mode) to 32 (non-buffered mode)
162	ITMP(1)=96*256+63
163	ITMP(2)=32
164	CALL GRIK02(ITMP,2,%val(IBADR),ICNT,MXCNT)
165	CALL GRIK03(%val(IBADR),ICNT)
166C- Set 8-bit register $00 (Background color) to 0.
167	ITMP(1)=96*256+0
168	ITMP(2)=0
169	CALL GRIK02(ITMP,2,%val(IBADR),ICNT,MXCNT)
170C- Select frame buffer 0 to write
171	ITMP(1)=125*256+0
172C- Select frame buffer 0 to read
173	ITMP(2)=124*256+0
174C- Load reg. 74=xA4, AUX port setup (0 trans, rel. mouse, 19200 baud).
175	ITMP(3)=96*256+74
176	ITMP(4)=227
177C- Disable clipping (useful if APPENDing to a GKS plot).
178	ITMP(5)=203
179	CALL GRIK02(ITMP,5,%val(IBADR),ICNT,MXCNT)
180	IF(.NOT.APPEND) THEN
181C- Load default lookup table (if not appending).
182	    CALL GRIK02(INIT,51,%val(IBADR),ICNT,MXCNT)
183	END IF
184	RETURN
185C
186C--- IFUNC=10, Close workstation. --------------------------------------
187100	CALL SYS$DASSGN(%val(ICHAN))
188	CALL GRFMEM(MXCNT,IBADR)
189	RETURN
190C
191C--- IFUNC=11, Begin Picture. ------------------------------------------
192110	IF(.NOT.APPEND) THEN
193C- Set frame buffer to background color.
194	    ITMP(1)=161
195	    CALL GRIK02(ITMP,1,%val(IBADR),ICNT,MXCNT)
196	END IF
197	APPEND=.FALSE.
198	RETURN
199C
200C--- IFUNC=12, Draw line. ----------------------------------------------
201120	CALL GRIK01(RBUF,%val(IBADR),ICNT,MXCNT)
202	RETURN
203C
204C--- IFUNC=13, Draw dot. -----------------------------------------------
205130	CALL GRIK05(RBUF,%val(IBADR),ICNT,MXCNT)
206	RETURN
207C
208C--- IFUNC=14, End Picture. --------------------------------------------
209140	RETURN
210C
211C--- IFUNC=15, Select color index. -------------------------------------
212150	ICOL=MAX(0,MIN(NINT(RBUF(1)),255))
213	RBUF(1)=ICOL
214	ITMP(1)=65*256+ICOL
215	CALL GRIK02(ITMP,1,%val(IBADR),ICNT,MXCNT)
216	RETURN
217C
218C--- IFUNC=16, Flush buffer. -------------------------------------------
219160	CALL GRIK03(%val(IBADR),ICNT)
220	RETURN
221C
222C--- IFUNC=17, Read cursor. --------------------------------------------
223170	I0=RBUF(1)
224	J0=RBUF(2)
225	CALL GRIK04(ICHAN,I0,J0,CHR,%val(IBADR),ICNT,MXCNT)
226	RBUF(1)=I0
227	RBUF(2)=J0
228	NBUF=2
229	LCHR=1
230	RETURN
231C
232C--- IFUNC=18, Erase alpha screen. -------------------------------------
233180	RETURN
234C
235C--- IFUNC=20, Polygon fill. -------------------------------------------
236C- Requires Ikon firmware revision V1.2 (or greater)
237200	IF(NPTS.EQ.0) THEN
238	    NPTS=RBUF(1)
239C- Set fill drawing color register (p. 59)
240	    ITMP(1)=69*256+ICOL
241C- Set fill area style to solid (p. 186)
242	    ITMP(2)=97*256+52
243	    ITMP(3)=0
244	    CALL GRIK02(ITMP,3,%val(IBADR),ICNT,MXCNT)
245	    INEWP=1
246	ELSE
247	    NPTS=NPTS-1
248	    IF(INEWP.NE.0) THEN
249		INEWP=0
250C- Draw filled polygon
251		ITMP(1)=188
252		ITMP(2)=0
253		ITMP(3)=NPTS
254		ITMP(4)=RBUF(1)
255		ITMP(5)=RBUF(2)
256		CALL GRIK02(ITMP,5,%val(IBADR),ICNT,MXCNT)
257	    ELSE
258		ITMP(1)=RBUF(1)
259		ITMP(2)=RBUF(2)
260		CALL GRIK02(ITMP,2,%val(IBADR),ICNT,MXCNT)
261	    END IF
262	END IF
263	RETURN
264C
265C--- IFUNC=21, Set color representation. -------------------------------
266210	ITMP(1)=81
267	ITMP(2)=NINT(RBUF(1))
268	ITMP(3)=IAND(255,INT(RBUF(2)*255.999))
269	ITMP(4)=IAND(255,INT(RBUF(3)*255.999))
270	ITMP(5)=IAND(255,INT(RBUF(4)*255.999))
271	CALL GRIK02(ITMP,5,%val(IBADR),ICNT,MXCNT)
272	RETURN
273C
274C--- IFUNC=23, Escape. -------------------------------------------------
275C- Send CHR array directly to Ikon (user better know what he is doing!)
276230	CALL GRIK02(%ref(CHR),LCHR/2,%val(IBADR),ICNT,MXCNT)
277	RETURN
278C-----------------------------------------------------------------------
279	END
280
281	INTEGER FUNCTION GRIK00(LUN,CHR,LCHR)
282C-----------------------------------------------------------------------
283C Open a channel to the IKON device.
284C
285C GRIK00 (returns integer): Opens a channel to the IKON device.
286C
287C  9-Dec-1987 - [AFT].
288C-----------------------------------------------------------------------
289        INCLUDE  '($IODEF)'
290        INCLUDE  '($SSDEF)'
291	INTEGER   LUN, LCHR
292	CHARACTER CHR*(*)
293	INTEGER   IER, ITEMP, ISTAT, LENGTH
294	INTEGER   SYS$ASSIGN, SYS$QIOW
295	INTEGER*2 IOSB(4)
296C---
297C- Assign an i/o channel
298C---
299	IER = SYS$ASSIGN(CHR(:LCHR), LUN,,)
300	IF(IER.NE.SS$_NORMAL .AND. IER.NE.SS$_REMOTE) GOTO 800
301C---
302C- Poll the interface waiting for status line A to go low.
303C---
304100	CALL LIB$WAIT(0.5)
305	ISTAT = SYS$QIOW(,%val(LUN),
306     :                    %val(IO$_WRITEVBLK),IOSB,
307     :                    ,,%val(0),%val(0),,,,)
308 	IF( (IOSB(3).AND.'800'X) .NE. 0) GOTO 100
309C---
310	IF(IER .EQ. SS$_REMOTE) THEN
311C---
312C Cannot check device characteristics easily if network device being used
313C so just check whether we opened the device successfully and return
314C Read back the status from assign to plotting device over network
315C---
316	    IER=SYS$QIOW(,%VAL(LUN),%VAL(IO$_READVBLK),
317     :                   IOSB,,,ISTAT,LENGTH,,,,)
318	    IF(IOSB(1) .NE. SS$_NORMAL) THEN
319	        CALL GRWARN ('Unable to read status from ASSIGN to' //
320     :                      ' graphics device on remote node')
321	        WRITE(6,*) IOSB(2), ' bytes read'
322	        ITEMP=IOSB(1)
323	        CALL GRGMSG(ITEMP)
324	        GRIK00=0
325	        RETURN
326	    END IF
327	    IF(ISTAT .NE. SS$_NORMAL) THEN
328	        IER=ISTAT
329	        GOTO 800
330	    ELSE
331	        GRIK00=3
332	        RETURN
333	    END IF
334	END IF
335C---
336C- Successful completion
337C---
338	GRIK00 = 1
339	RETURN
340C---
341C- Error exit
342C---
343  800	CALL GRWARN('Cannot open graphics device '//CHR(:LCHR))
344	CALL GRGMSG(IER)
345	GRIK00 = 0
346	END
347
348	SUBROUTINE GRIK01(RBUF,IBUF,ICNT,MXCNT)
349	REAL      RBUF(4)
350	INTEGER   ICNT, MXCNT
351	INTEGER*2 IBUF
352C-----------------------------------------------------------------------
353C Part of PGPLOT device driver for IKON
354C Draw a line segment.
355C
356C Arguments:
357C RBUF(*) (input)  Draw line from (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4))
358C IBUF    (input)  Address of a buffer area
359C ICNT    (in/out) Number of bytes in use in buffer
360C MXCNT   (input)  Maximum size of buffer in bytes
361C
362C 30-Jan-1988 - [AFT]
363C-----------------------------------------------------------------------
364	INTEGER   IPTR
365	INTEGER*2 ITMP(4)
366	INTEGER*2 I0, J0, I1, J1
367	INTEGER*2 LASTI, LASTJ
368	SAVE      LASTI, LASTJ
369C
370	I0=NINT(RBUF(1))
371	J0=NINT(RBUF(2))
372	I1=NINT(RBUF(3))
373	J1=NINT(RBUF(4))
374	IF(I0.NE.LASTI .OR. J0.NE.LASTJ) THEN
375	    ITMP(1)=164
376	    ITMP(2)=I0
377	    ITMP(3)=J0
378            IPTR=3
379	ELSE
380	    IPTR=0
381	END IF
382	ITMP(IPTR+1)=178*256
383	ITMP(IPTR+2)=I1
384	ITMP(IPTR+3)=J1
385	IPTR=IPTR+3
386	LASTI=I1
387	LASTJ=J1
388	CALL GRIK02(ITMP,IPTR,IBUF,ICNT,MXCNT)
389	RETURN
390C
391	ENTRY INIK01
392	LASTI=-1
393	LASTJ=-1
394	RETURN
395	END
396
397	SUBROUTINE GRIK02(ITMP, N, IBUF, ICNT, MXCNT)
398C-----------------------------------------------------------------------
399C GRPCKG (internal routine for IKON driver): Transfer N words to
400C the output buffer, flushing the buffer as necessary with the
401C GRIK03 routine.  If the N bytes will not fit into the current
402C buffer, then the buffer is first dumped.  This is to to cause
403C STR to be transferred as a complete unit.
404C Based on early versions of GRxx02 routines, this version does not
405C use any common blocks.
406C ***NOTE*** INIK03 must be called before any calls to GRIK02 to
407C set the LUN/Channel to which the buffer should be dumped.
408C
409C Arguments:
410C
411C ITMP(N)	I   I*2	Data to be written.
412C N		I   I	The number of words to transfer.
413C IBUF		I/O I*2 The output buffer.
414C ICNT		I/O I	Current number of words used in QBUF.
415C MXCNT		I/O I	Maximum number of words that can be stored
416C			-in IBUF.
417C
418C  9-Dec-1987 - [AFT].
419C-----------------------------------------------------------------------
420	INTEGER   N, ICNT, MXCNT, I
421	INTEGER*2 ITMP(N), IBUF(MXCNT)
422C---
423	IF(ICNT+N.GE.MXCNT) CALL GRIK03(IBUF,ICNT)
424	DO I=1,N
425	    IF(ICNT.GE.MXCNT) CALL GRIK03(IBUF,ICNT)
426	    ICNT=ICNT+1
427	    IBUF(ICNT)=ITMP(I)
428	END DO
429	RETURN
430	END
431
432	SUBROUTINE GRIK03(IBUF,ICNT)
433	INTEGER   ICNT
434	INTEGER*2 IBUF(*)
435C-----------------------------------------------------------------------
436C GRPCKG(internal routine, IKON):
437C set the channal to which the buffer should be dumped.
438C This subroutine contains the entry point INIK03 that defines
439C the variables ICHAN.
440C
441C Arguments:
442C
443C IBUF		I/O I*2 The output buffer.
444C ICNT		I/O I	Current number of words used in QBUF.
445C
446C  9-Dec-1987 - [AFT].
447C-----------------------------------------------------------------------
448	INCLUDE '($IODEF)'
449	INTEGER   SYS$QIOW
450	INTEGER   ISTAT
451	INTEGER*2 IOSB(4)
452	INTEGER   INCHAN
453	INTEGER   ICHAN
454	SAVE      ICHAN
455C
456	IF(ICNT.GT.0) THEN
457            ISTAT = sys$qiow(,%val(ICHAN),
458     :          %val(IO$_WRITEVBLK.OR.IO$M_SETFNCT.OR.IO$M_TIMED),
459     :          IOSB,,,IBUF,%val(2*ICNT),%val(15),%val(0),,)
460	END IF
461	ICNT=0
462	RETURN
463C---
464	ENTRY INIK03(INCHAN)
465C- Save info needed to dump buffer.
466	ICHAN=INCHAN
467	RETURN
468	END
469
470      SUBROUTINE GRIK04(ICHAN,IX,IY,CHR,IBUF,ICNT,MXCNT)
471C
472      INTEGER   ICHAN, IX, IY, IBUF, ICNT, MXCNT
473      CHARACTER CHR
474C
475C Arguments
476C ICHAN  (input)  QIO channel assigned to Args
477C IX,IY  (in/out) The cursor position
478C CHR    (output) The keyboard character pressed
479C IBUF   (input)  Address of a buffer area
480C ICNT   (in/out) Number of bytes in use in buffer
481C MXCNT  (input)  Maximum size of buffer in bytes
482C---
483C Read the cursor position on the Ikon.  The cursor can be moved
484C by either rolling the tracker ball.
485C The cursor can also be moved by using the cursor keys on the
486C terminal associated with SYS$COMMAND in which case the cursor
487C "speed" (step size) is controlled by the PF1 (smallest step) to
488C PF4 (largest step) keys. The numeric keys on the keypad can be
489C used in place of the arrow keys, with the addition of diagonal
490C motion:
491C         UP
492C      7  8  9
493C LEFT 4     6 RIGHT
494C      1  2  3
495C        DOWN
496C---
497C- 21-Jan-1988 - Based on ARDRIVER [AFT].
498C---
499      INCLUDE '($IODEF)'
500C-
501      INTEGER   SYS$QIOW
502      INTEGER   SMG$CREATE_VIRTUAL_KEYBOARD, SMG$READ_KEYSTROKE
503      INTEGER   ISTAT, IDSMG
504      INTEGER   ISTEP, IXWAS, IYWAS, IVAL
505      INTEGER*2 ITMP(9), IOSB(4), ICURS(9)
506      LOGICAL   QKEY
507C---
508      ISTAT=SMG$CREATE_VIRTUAL_KEYBOARD(IDSMG,'SYS$COMMAND')
509      IF(ISTAT.NE.1) THEN
510          CALL GRGMSG(ISTAT)
511          CALL GRQUIT('Fatal error.')
512      END IF
513C---
514C- Load 32-bit reg. 26=x1A GID max position
515      ITMP(1)=99*256+26
516      ITMP(2)= 779
517      ITMP(3)=1023
518C- Load 32-bit reg. 28=x1C GID size.
519      ITMP(4)=99*256+28
520      ITMP(5)= 779
521      ITMP(6)=1023
522      CALL GRIK02(ITMP,6,IBUF,ICNT,MXCNT)
523C- Load reg. 74=xA4, AUX port setup (0 trans, rel. mouse, 19200 baud).
524      ITMP(1)=96*256+74
525      ITMP(2)=227
526C- Set up zone to constrain cursor
527      ITMP(3)=99*256+44
528      ITMP(4)= 779
529      ITMP(5)=1023
530      CALL GRIK02(ITMP,5,IBUF,ICNT,MXCNT)
531C---
532C- Cursor on.
533      ITMP(1)=193
534C- Load 8-bit reg. 24=x18 with Enable GID
535      ITMP(2)=96*256+24
536      ITMP(3)=128
537      CALL GRIK02(ITMP,3,IBUF,ICNT,MXCNT)
538C- Defaults.
539      ISTEP=2
540      QKEY=.FALSE.
541C---
542C- Position cursor.
543200       ITMP(1)=164
544          ITMP(2)=IX
545          ITMP(3)=IY
546C- Anchor GID to current position (i.e., keep cursor on screen).
547          ITMP(4)=86
548          CALL GRIK02(ITMP,4,IBUF,ICNT,MXCNT)
549          CALL GRIK03(IBUF,ICNT)
550          IXWAS=IX
551          IYWAS=IY
552C- See if user has typed something at keyboard.
553          ISTAT=SMG$READ_KEYSTROKE(IDSMG,IVAL,,0)
554          IF(ISTAT.NE.1) IVAL=0
555          IF(IVAL.EQ.259) THEN
556C- PF4=large step
557              ISTEP=64
558          ELSE IF(IVAL.EQ.258) THEN
559              ISTEP=8
560          ELSE IF(IVAL.EQ.257) THEN
561              ISTEP=4
562          ELSE IF(IVAL.EQ.256) THEN
563C- PF1=small step
564              ISTEP=1
565          ELSE IF(IVAL.EQ.49 .OR. IVAL.EQ.261) THEN
566C- key 1 or KP1
567              IX=IX-ISTEP
568              IY=IY-ISTEP
569          ELSE IF(IVAL.EQ.50 .OR. IVAL.EQ.262 .OR. IVAL.EQ.275) THEN
570C- key 2, KP2 or DOWN
571              IY=IY-ISTEP
572          ELSE IF(IVAL.EQ.51 .OR. IVAL.EQ.263) THEN
573C- key 3 or KP3
574              IX=IX+ISTEP
575              IY=IY-ISTEP
576          ELSE IF(IVAL.EQ.52 .OR. IVAL.EQ.264 .OR. IVAL.EQ.276) THEN
577C- key 4, KP4 or LEFT
578              IX=IX-ISTEP
579          ELSE IF(IVAL.EQ.54 .OR. IVAL.EQ.266 .OR. IVAL.EQ.277) THEN
580C- key 6, KP6 or RIGHT
581              IX=IX+ISTEP
582          ELSE IF(IVAL.EQ.55 .OR. IVAL.EQ.267) THEN
583C- key 7 or KP7
584              IX=IX-ISTEP
585              IY=IY+ISTEP
586          ELSE IF(IVAL.EQ.56 .OR. IVAL.EQ.268 .OR. IVAL.EQ.274) THEN
587C- key 8, KP8 or UP
588              IY=IY+ISTEP
589          ELSE IF(IVAL.EQ.57 .OR. IVAL.EQ.269) THEN
590C- key 9 or KP9
591              IX=IX+ISTEP
592              IY=IY+ISTEP
593          ELSE IF((IVAL.GT.0 .AND. IVAL.LT.48) .OR.
594     &		(IVAL.GT.57 .AND. IVAL.LT.255)) THEN
595              QKEY=.TRUE.
596          END IF
597C---
598C- Read current cursor position
599C**** Due to possible hardware fault the following code will
600C**** sometimes reset the IKON.
601          ITMP(1)=165
602          CALL GRIK02(ITMP,1,IBUF,ICNT,MXCNT)
603          CALL GRIK03(IBUF,ICNT)
604C- Read 4 bytes, timing out in 2 sec.
605          ISTAT = sys$qiow(,%val(ICHAN),
606     :          %val(IO$_READVBLK.OR.IO$M_SETFNCT.OR.IO$M_TIMED),
607     :          IOSB,,,ICURS,%val(4),%val(2),%val(1),,)
608          IF(ISTAT.EQ.1 .AND. IOSB(1).EQ.1) THEN
609              IX=IX+ICURS(1)-IXWAS
610              IY=IY+ICURS(2)-IYWAS
611          END IF
612          IX=MAX(IX,   0)
613          IX=MIN(IX,1023)
614          IY=MAX(IY,   0)
615          IY=MIN(IY, 779)
616          IF(IX.EQ.IXWAS .AND. IY.EQ.IYWAS) THEN
617              CALL LIB$WAIT(0.05)
618          END IF
619      IF(.NOT.QKEY) GOTO 200
620      CHR=CHAR(IVAL)
621C---
622C- Turn cursor off
623      ITMP(1)=192
624      CALL GRIK02(ITMP,1,IBUF,ICNT,MXCNT)
625      CALL GRIK03(IBUF,ICNT)
626C---
627C- Free resources.
628      CALL SMG$DELETE_VIRTUAL_KEYBOARD(IDSMG)
629      RETURN
630      END
631
632	SUBROUTINE GRIK05(RBUF,IBUF,ICNT,MXCNT)
633	REAL      RBUF(2)
634	INTEGER   ICNT, MXCNT
635	INTEGER*2 IBUF
636C-----------------------------------------------------------------------
637C Part of PGPLOT device driver for IKON
638C Draw a dot.
639C
640C Arguments:
641C RBUF(*) (input)  (RBUF(1),RBUF(2)) is the (x,y) position of the dot.
642C IBUF    (input)  Address of a buffer area
643C ICNT    (in/out) Number of bytes in use in buffer
644C MXCNT   (input)  Maximum size of buffer in bytes
645C
646C 30-Jan-1988 - [AFT]
647C-----------------------------------------------------------------------
648	INTEGER*2 ITMP(3)
649C
650C- Move and draw pixel.
651	ITMP(1)=166
652	ITMP(2)=RBUF(1)
653	ITMP(3)=RBUF(2)
654	CALL GRIK02(ITMP,3,IBUF,ICNT,MXCNT)
655	CALL INIK01
656	RETURN
657	END
658