File: wsdriv.f

package info (click to toggle)
pgplot5 5.2-13
  • links: PTS
  • area: non-free
  • in suites: potato
  • size: 6,280 kB
  • ctags: 5,903
  • sloc: fortran: 37,938; ansic: 18,809; sh: 1,147; objc: 532; makefile: 363; perl: 234; pascal: 233; tcl: 178; awk: 51; csh: 25
file content (677 lines) | stat: -rw-r--r-- 26,798 bytes parent folder | download | duplicates (16)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
C*WSDRIV -- PGPLOT driver for VAX workstations running VWS software
C+
      SUBROUTINE WSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR)
      INTEGER IFUNC, NBUF, LCHR
      REAL    RBUF(*)
      CHARACTER*(*) CHR
C
C PGPLOT driver for VAX workstations.
C
C Version 1.0 - 1988 Feb 3  - T. J. Pearson (after an original by
C                             John Biretta).
C
C Version 1.1 - 1988 Mar 14 - S. C. Allendorf 
C                             Make work for 4 plane devices and some
C                             other minor changes/bugs.
C
C Version 1.1001 - 1988 Mar 17 - S. L. Morris
C                             Number of color entries corrected for 8 
C                             plane system.
C
C Version 1.2 - 1988 Mar 18 - S. C. Allendorf
C                             Change PAUSE to LIB$GET_COMMAND and change
C                             cursor routines.
C
C Version 2.0 - 1988 Mar 23 - S. C. Allendorf
C                             Add hardware area and rectangle fills
C                             (OPCODE = 24).  General cleanup.
C
C Version 3.0 - 1988 Apr 1  - S. C. Allendorf
C                             Use absolute device coordinates and add
C                             keypad cursor control.
C
C Version 3.1 - 1988 Nov 24 - S. C. Allendorf
C                             Change cursor so that it can be seen 
C                             against all choices of background colors.
C
C Version 3.2 - 1989 Jan 6  - S. C. Allendorf
C                             Disable display list entries to gain a 
C                             little more speed (30% in a test program).
C
C Version 3.3 - 1989 Jan 8  - S. C. Allendorf
C                             Remove all magic numbers from the code and
C                             query the hardware to get them.
C
C Version 4.0 - 1989 Apr 5  - S. C. Allendorf
C                             Add support for line of pixels and correct
C                             error in device selection support.
C
C Version 4.1 - 1989 Jun 07 - S. C. Allendorf
C                             Fix varying resolution support and other
C                             minor changes.  General cleanup.
C
C Version 4.2 - 1990 May 30 - S. C. Allendorf
C                             Fix cursor routine to function properly
C                             in a workstation environment.
C
C Version 4.3 - 1993 Apr 23 - T. J. Pearson
C                             This driver crashes when used with UISX.
C                             Changed so that it only crashes if the
C                             caller tries to use it.
C=======================================================================
C
C Supported device: This driver should work with all VAX/VMS 
C workstations running VWS software; it requires the UISSHR
C shareable image provided by DEC.
C
C Device type code: /WS.
C
C Default device name: PGPLOT.  Output is always directed to device 
C SYS$WORKSTATION; the "device name" provided by the user is used to 
C label the PGPLOT window.
C
C Default view surface dimensions: Depends on monitor.
C
C Resolution: Depends on monitor.
C
C Color capability: VAX workstations can have 1, 4, or 8 bitplanes.
C On 1-plane devices, there are only two colors (background = white,
C color index 1 = black). On 4-plane devices, color indices 0-11
C are available (4 indices are reserved for text windows and pointers).
C On 8-plane systems, color indices 0-249 are available (6 indices
C are reserved for text windows and pointers).
C
C Input capability: The cursor is controlled by the mouse or the keypad
C available on the controlling (DEC-like) keyboard. The user positions 
C the cursor, and then types any key on the controlling keyboard.
C
C File format: It is not possible (at present) to send workstation
C plots to a disk file.
C
C Obtaining hardcopy: Not possible (at present).
C-----------------------------------------------------------------------
C
C PGPLOT can be used in three modes on VAX Workstations. 
C 
C (1) Tektronix emulation. If you run a process in a Tektronix emulation
C window, you can use device specification "/TEK" to tell PGPLOT to
C plot in Tektronix mode within the same window. If you run in a VT220
C window, you can tell PGPLOT to create a new Tektronix window and plot
C in it by giving a device specification "TK:/TEK". (TK: is the VMS
C device name of the Tektronix emulator.) This has one problem: the
C window will be deleted as soon as your program calls PGEND or exits;
C you may need to add a user-prompt in your program before the call of
C PGEND. 
C 
C (2) UIS mode. In UIS mode, PGPLOT calls the UIS subroutines for
C creating graphics on the workstation. This has some advantages over
C Tektronix emulation; e.g., it is faster, can use colors, and can
C erase. The number of colors available depends on the VAXstation
C model. Use device specification "/WS" to tell PGPLOT to create a new
C window and plot using UIS calls. Again, the window is deleted on
C program exit. PGPLOT executes a LIB$GET_COMMAND statement before
C exiting, however, so that you can view the picture before it
C disappears. Type <RETURN> at the prompt when you are ready to
C continue. This also makes it impossible to overlay a plot created by
C one program on a plot created by another. (The /APPEND qualifier
C which allows this for other devices has no effect on device /WS.)
C PGPLOT uses a window which is nominally 11 inches wide by 8.5 inches
C tall, i.e., the same size as you would get in a hardcopy. If you
C prefer a vertical orientation, execute the following command before
C running the program: 
C 
C $ DEFINE PGPLOT_WS_ASPECT PORTRAIT 
C 
C Substitute LANDSCAPE for PORTRAIT to revert to horizontal
C orientation. 
C 
C The PGPLOT cursor is controlled by the mouse or the keypad on the
C controlling keyboard. Type any keyboard key to notify PGPLOT when you
C have positioned the cursor. The mouse buttons are ignored (at 
C present).
C
C (3) DECWindows mode. In DECWindows mode, PGPLOT calls the XLIB
C functions for creating graphics on the workstation.
C-----------------------------------------------------------------------
      LOGICAL    CHEAP, INIT, LANDSCAPE, MONO
      BYTE       KBYTE, PIXEL(1024)
      INTEGER*2  CROSS(32), KWORD
      INTEGER*4  HEIGHT, IC, ICH, IER, IMAX, IMIN, I0, I1, JMAX, JMIN
      INTEGER*4  J0, J1, KBID, L, GRFMEM, GRGMEM, LMESS, MAXCOL
      INTEGER*4  NPTS, REMCAL, RESCOL, SMG$CREATE_VIRTUAL_KEYBOARD
      INTEGER*4  SMG$DELETE_VIRTUAL_KEYBOARD, SMG$READ_KEYSTROKE
      INTEGER*4  SMG$SET_KEYPAD_MODE, STEP, UISDC$SET_POINTER_POSITION
      INTEGER*4  UIS$CREATE_COLOR_MAP, UIS$CREATE_DISPLAY
      INTEGER*4  UIS$CREATE_WINDOW, UIS$PRESENT, VCMID, VDID, WDID
      INTEGER*4  WIDTH, XBUF, YBUF
      REAL*4     CTABLE(3, 16), PIXEL_X, PIXEL_Y, RESOL(2), SCALE, XHGHT
      REAL*4     XWDTH
      CHARACTER  ASPECT*20, MESS*4, MSG*10, NAME*3
      EQUIVALENCE (KBYTE, KWORD)
      DATA NAME /'WS '/
      DATA INIT, STEP /.TRUE., 4/
C                                       Set up the cursor bitmap
      DATA CROSS /6 * 256, 256, 65534, 256, 6 * 256, 0,
     +            6 * 256,   0, 64638,   0, 6 * 256, 0/
C                                       Initialize the color table
      DATA CTABLE /0.0,0.0,0.0, 1.0,1.0,1.0, 1.0,0.0,0.0, 0.0,1.0,0.0,
     1             0.0,0.0,1.0, 0.0,1.0,1.0, 1.0,0.0,1.0, 1.0,1.0,0.0,
     2             1.0,0.5,0.0, 0.5,1.0,0.0, 0.0,1.0,0.5, 0.0,0.5,1.0,
     3             0.5,0.0,1.0, 1.0,0.0,0.5, 0.333,0.333,0.333, 
     5             0.667,0.667,0.667/
C                                       These avoid using the includes
      PARAMETER  PATT$C_FOREGROUND = 2
      PARAMETER  SMG$K_TRM_PF1 = 256
      PARAMETER  SMG$K_TRM_PF2 = 257
      PARAMETER  SMG$K_TRM_PF3 = 258
      PARAMETER  SMG$K_TRM_PF4 = 259
      PARAMETER  SMG$K_TRM_KP1 = 261
      PARAMETER  SMG$K_TRM_KP2 = 262
      PARAMETER  SMG$K_TRM_KP3 = 263
      PARAMETER  SMG$K_TRM_KP4 = 264
      PARAMETER  SMG$K_TRM_KP5 = 265
      PARAMETER  SMG$K_TRM_KP6 = 266
      PARAMETER  SMG$K_TRM_KP7 = 267
      PARAMETER  SMG$K_TRM_KP8 = 268
      PARAMETER  SMG$K_TRM_KP9 = 269
      PARAMETER  SMG$K_TRM_UP = 274
      PARAMETER  SMG$K_TRM_DOWN = 275
      PARAMETER  SMG$K_TRM_LEFT = 276
      PARAMETER  SMG$K_TRM_RIGHT = 277
      PARAMETER  SS$_NORMAL = 1
      PARAMETER  UIS$C_MODE_COPY = 2
C-----------------------------------------------------------------------
C                                       On first call, find out what 
C                                       sort of workstation we have.
C
      IF (INIT .AND. IFUNC.NE.1) THEN
         INIT = .FALSE.
C                                       Check for the UIS library.
         IER = UIS$PRESENT ()
C                                       Only do the following if we
C                                       actually have a UIS workstation.
         IF (IER .EQ. SS$_NORMAL) THEN
C                                       Get the number of planes.
C                                       NOTE: This may only work for
C                                       monochrome and color displays.
C                                       The code may not work for
C                                       intensity displays.
            CALL UIS$GET_HW_COLOR_INFO ('SYS$WORKSTATION', , MAXCOL,
     1                                  , , , , , , RESCOL)
C                                       Find the display resolution.
            CALL UIS$GET_DISPLAY_SIZE ('SYS$WORKSTATION', XWDTH, XHGHT,
     1                                 PIXEL_X, PIXEL_Y)
            RESOL(1) = PIXEL_X * 2.54
            RESOL(2) = PIXEL_Y * 2.54
C                                       Calculate a scale factor to 
C                                       handle display devices with
C                                       different resolutions.
            SCALE = 77.446785 / MAX (RESOL(1), RESOL(2))
C                                       Calculate the size of the border
C                                       around the plot.
            IMIN = NINT (0.25 * RESOL(1) * SCALE)
            JMIN = NINT (0.25 * RESOL(2) * SCALE)
C                                       See what orientation we want.
            CALL GRGENV ('WS_ASPECT', ASPECT, L)
            IF (ASPECT(1:1) .EQ. 'P') THEN
C                                       Portrait mode (pixels).
               WIDTH = NINT (8.113636 * RESOL(1) * SCALE)
               HEIGHT = NINT (10.5 * RESOL(2) * SCALE)
               LANDSCAPE = .FALSE.
            ELSE
C                                       Landscape mode (pixels).
               WIDTH = NINT (11.0 * RESOL(1) * SCALE)
               HEIGHT = NINT (8.5 * RESOL(2) * SCALE)
               LANDSCAPE = .TRUE.
            END IF
C                                       Set the other border.
            IMAX = WIDTH - IMIN - 1
            JMAX = HEIGHT - JMIN - 1
C                                       Calculate the size of the window
C                                       in centimeters.
            XWDTH = FLOAT (WIDTH) / PIXEL_X
            XHGHT = FLOAT (HEIGHT) / PIXEL_Y
         ELSE
C                                       Deal with error on the open
C                                       workstation call.
            MAXCOL = 1
            RESCOL = 0
         END IF
C                                       Set the machine characteristics.
         IF (MAXCOL .EQ. 256) THEN
            NAME = 'WS8'
            MONO = .FALSE.
            CHEAP = .FALSE.
         ELSE IF (MAXCOL .EQ. 16) THEN
            NAME = 'WS4'
            MONO = .FALSE.
            CHEAP = .TRUE.
         ELSE IF (MAXCOL .EQ. 2) THEN
            NAME = 'WS1'
            MONO = .TRUE.
            CHEAP = .TRUE.
         ELSE
            NAME = 'WS0'
            MONO = .TRUE.
            CHEAP = .TRUE.
         END IF
C                                       Set maximum color index.
         MAXCOL = MAXCOL - RESCOL - 1
      END IF
C                                       Branch on opcode.
      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
     1     110,120,130,140,150,160,170,180,190,200,
     2     210,220,230,240,250,260), IFUNC
  900 WRITE (MSG, '(I10)') IFUNC
      CALL GRWARN ('Unimplemented function in VAX/WS device driver:'
     1              // MSG)
      NBUF = -1
      RETURN
C
C--- IFUNC = 1, Return device name -------------------------------------
C
   10 CHR = NAME // '   (VAX UIS workstation)'
      LCHR =  27
      RETURN
C
C--- IFUNC = 2, Return physical min and max for plot device, and range
C               of color indices ---------------------------------------
C
   20 RBUF(1) = 0.0
      RBUF(2) = FLOAT (IMAX - IMIN)
      RBUF(3) = 0.0
      RBUF(4) = FLOAT (JMAX - JMIN)
      RBUF(5) = 0.0
      RBUF(6) = FLOAT (MAXCOL)
      NBUF = 6
      RETURN
C
C--- IFUNC = 3, Return device resolution -------------------------------
C
   30 RBUF(1) = RESOL(1)
      RBUF(2) = RESOL(2)
      RBUF(3) = 1.0
      NBUF = 3
      RETURN
C
C--- IFUNC = 4, Return misc device info --------------------------------
C    (This device is Interactive, Cursor, No dashed lines, Area fill,
C    No thick lines, Rectangle fill, Line of pixels.)
C
   40 CONTINUE
      IF (CHEAP) THEN
         CHR = 'ICNANRNNNN'
      ELSE
         CHR = 'ICNANRPNNN'
      END IF
      LCHR = 10
      RETURN
C
C--- IFUNC = 5, Return default file name -------------------------------
C
   50 CHR = 'PGPLOT'
      LCHR = 6
      RETURN
C
C--- IFUNC = 6, Return default physical size of plot -------------------
C
   60 RBUF(1) = 0.0
      RBUF(2) = FLOAT (IMAX - IMIN)
      RBUF(3) = 0.0
      RBUF(4) = FLOAT (JMAX - JMIN)
      NBUF = 4
      RETURN
C
C--- IFUNC = 7, Return misc defaults -----------------------------------
C
   70 RBUF(1) = 1.0
      NBUF = 1
      RETURN
C
C--- IFUNC = 8, Select plot --------------------------------------------
C
   80 CONTINUE
      RETURN
C
C--- IFUNC = 9, Open workstation ---------------------------------------
C
   90 CONTINUE
C                                       Return an error if UIS software 
C                                       is missing.
      IER = UIS$PRESENT ()
      IF (IER .NE. SS$_NORMAL) THEN
         CALL GRGMSG (IER)
         CALL GRWARN ('UIS is not installed on this system.')
         RBUF(2) = IER
         RETURN
      END IF
C                                       Open device.  First allocate a
C                                       color map.
      VCMID = UIS$CREATE_COLOR_MAP (MAXCOL + 1)
C                                       Create a display.
      VDID = UIS$CREATE_DISPLAY (0.0, 0.0, FLOAT (IMAX + IMIN), 
     1                         FLOAT (JMAX + JMIN), XWDTH, XHGHT, VCMID)
C                                       Disable display list entries
C                                       (~30% speed improvement).
      CALL UIS$DISABLE_DISPLAY_LIST (VDID)
C                                       Open a window.
      WDID = UIS$CREATE_WINDOW (VDID, 'SYS$WORKSTATION', CHR(:LCHR),
     1              0.0, 0.0, FLOAT (IMAX + IMIN), FLOAT (JMAX + JMIN),
     2              XWDTH, XHGHT)
C                                       Initialize device.  First
C                                       set the color registers.
      IF (MONO) THEN
C                                       Background (CI = 0) white, 
C                                       write (CI = 1) in black
         CALL UIS$SET_COLOR (VDID, 0, 1.0, 1.0, 1.0)
         CALL UIS$SET_COLOR (VDID, 1, 0.0, 0.0, 0.0)
      ELSE 
C                                       Define color indices 0-15;
C                                       background (CI = 0) black,
C                                       write (CI = 1) in white.
         DO 95 IC = 0, MIN (15, MAXCOL)
            CALL UIS$SET_COLOR (VDID, IC, CTABLE(1, IC + 1), 
     1                          CTABLE(2, IC + 1), CTABLE(3, IC + 1))
   95    CONTINUE
      END IF
C                                       Set the background color.
      CALL UIS$SET_BACKGROUND_INDEX (VDID, 0, 1, 0)
C                                       For some reason, this does not
C                                       work on monochrome systems.
      IF (.NOT. MONO) THEN
         CALL UIS$SET_WRITING_MODE (VDID, 1, 1, UIS$C_MODE_COPY)
      END IF
C                                       Set the font for fill patterns.
      CALL UIS$SET_FONT (VDID, 1, 1, 'UIS$FILL_PATTERNS')
C                                       Successful-- return wd_id.
      RBUF(1) = WDID
      RBUF(2) = 1.0
      NBUF = 2
      RETURN
C
C--- IFUNC=10, Close workstation ---------------------------------------
C
  100 CONTINUE
      CALL GRGCOM (MESS, CHAR (7)//'Type <RETURN> to continue: ', LMESS)
C                                       Clean up resources.
      CALL UIS$DELETE_WINDOW (WDID)
      CALL UIS$DELETE_DISPLAY (VDID)
      CALL UIS$DELETE_COLOR_MAP (VCMID)
C                                       Reset the initialization
C                                       variable.
      INIT = .TRUE.
      RETURN
C
C--- IFUNC=11, Begin picture -------------------------------------------
C
  110 CONTINUE
C                                       Clear the screen.
      CALL UISDC$ERASE (WDID)
      RETURN
C
C--- IFUNC=12, Draw line -----------------------------------------------
C
  120 CONTINUE
      I0 = INT (RBUF(1) + 0.5) + IMIN
      J0 = INT (RBUF(2) + 0.5) + JMIN
      I1 = INT (RBUF(3) + 0.5) + IMIN
      J1 = INT (RBUF(4) + 0.5) + JMIN
      CALL UISDC$PLOT (WDID, 1, I0, J0, I1, J1)
      RETURN
C
C--- IFUNC=13, Draw dot ------------------------------------------------
C
  130 CONTINUE
      I0 = INT (RBUF(1) + 0.5) + IMIN
      J0 = INT (RBUF(2) + 0.5) + JMIN
      CALL UISDC$PLOT (WDID, 1, I0, J0)
      RETURN
C
C--- IFUNC=14, End picture ---------------------------------------------
C
  140 CONTINUE
      RETURN
C
C--- IFUNC=15, Select color index --------------------------------------
C
  150 CONTINUE
      IC = RBUF(1)
      CALL UIS$SET_WRITING_INDEX (VDID, 1, 1, IC)
      RETURN
C
C--- IFUNC=16, Flush buffer. -------------------------------------------
C
  160 CONTINUE
      RETURN
C
C--- IFUNC=17, Read cursor. --------------------------------------------
C           RBUF(1)   in/out : cursor x coordinate.
C           RBUF(2)   in/out : cursor y coordinate.
C           CHR(1:1)  output : keystroke.
C
  170 CONTINUE
C                                       Create a virtual keyboard for 
C                                       cursor control.
      IER = SMG$CREATE_VIRTUAL_KEYBOARD (KBID, 'SYS$COMMAND')
      IF (IER .NE. SS$_NORMAL) THEN
         CALL GRGMSG (IER)
         CALL GRQUIT ('Failed to create a virtual keyboard.')
      END IF
C                                       Set the keyboard to keypad mode.
      IER = SMG$SET_KEYPAD_MODE (KBID, 1)
      IF (IER .NE. SS$_NORMAL) THEN
         CALL GRGMSG (IER)
         CALL GRQUIT ('Failed to set keypad mode.')
      END IF
C                                       Set cursor pattern to a cross.
      CALL UISDC$SET_POINTER_PATTERN (WDID, CROSS, 2, 8, 8, IMIN, JMIN, 
     1        IMAX, JMAX)
C                                       Convert input coordinates.
      I0 = INT (RBUF(1) + 0.5) + IMIN
      J0 = INT (RBUF(2) + 0.5) + JMIN
C                                       Set cursor to correct spot (if
C                                       it is in the PGPLOT window).
  175 IF (I0 .GE. IMIN .AND. I0 .LE. IMAX .AND.
     1    J0 .GE. JMIN .AND. J0 .LE. JMAX) THEN
         CALL UIS$POP_VIEWPORT (WDID)
         IER = UISDC$SET_POINTER_POSITION (WDID, I0, J0)
         IF (IER .NE. SS$_NORMAL) THEN
            CALL GRGMSG (IER)
            CALL GRQUIT ('Failed to set the pointer position.')
         END IF
      END IF
C                                       Wait for a keystroke.
      IER = SMG$READ_KEYSTROKE (KBID, ICH)
C                                       Read cursor location (this
C                                       covers the case where the user
C                                       moved the cursor with the 
C                                       mouse).
      CALL UISDC$GET_POINTER_POSITION (WDID, I0, J0)
C                                       Catch error returns.
      IF (IER .NE. SS$_NORMAL) ICH = 0
C                                       Handle the keypad keys.
      IF (ICH .EQ. SMG$K_TRM_UP .OR. ICH .EQ. SMG$K_TRM_KP8) THEN
         J0 = MIN (JMAX, J0 + STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_DOWN .OR. ICH .EQ. SMG$K_TRM_KP2) THEN
         J0 = MAX (JMIN, J0 - STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_LEFT .OR. ICH .EQ. SMG$K_TRM_KP4) THEN
         I0 = MAX (IMIN, I0 - STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_RIGHT .OR. 
     1         ICH .EQ. SMG$K_TRM_KP6) THEN
         I0 = MIN (IMAX, I0 + STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_KP7) THEN
         I0 = MAX (IMIN, I0 - STEP)
         J0 = MIN (JMAX, J0 + STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_KP9) THEN
         I0 = MIN (IMAX, I0 + STEP)
         J0 = MIN (JMAX, J0 + STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_KP3) THEN
         I0 = MIN (IMAX, I0 + STEP)
         J0 = MAX (JMIN, J0 - STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_KP1) THEN
         I0 = MAX (IMIN, I0 - STEP)
         J0 = MAX (JMIN, J0 - STEP)
      ELSE IF (ICH .EQ. SMG$K_TRM_KP5) THEN
         I0 = WIDTH / 2
         J0 = HEIGHT / 2
      ELSE IF (ICH .EQ. SMG$K_TRM_PF1) THEN
         STEP = 1
      ELSE IF (ICH .EQ. SMG$K_TRM_PF2) THEN
         STEP = 4
      ELSE IF (ICH .EQ. SMG$K_TRM_PF3) THEN
         STEP = 16
      ELSE IF (ICH .EQ. SMG$K_TRM_PF4) THEN
         STEP = 64
      END IF
C                                       Toss out unacceptable 
C                                       characters.
      IF (ICH .LT. 0 .OR. ICH .GT. 255) GOTO 175
C                                       Make sure the pointer is in the
C                                       PGPLOT window.
      IF (I0 .LT. IMIN .OR. I0 .GT. IMAX) GOTO 175
      IF (J0 .LT. JMIN .OR. J0 .GT. JMAX) GOTO 175
C                                       Delete the virtual keyboard.
      IER = SMG$DELETE_VIRTUAL_KEYBOARD (KBID)
      IF (IER .NE. SS$_NORMAL) THEN
         CALL GRGMSG (IER)
         CALL GRWARN ('Failed to delete virtual keyboard.')
      END IF
C                                       Return the cursor to normal.
      CALL UISDC$SET_POINTER_PATTERN (WDID, , , , , IMIN, JMIN, 
     1        IMAX, JMAX)
C                                       Set the return values.
      CHR(1:1) = CHAR (ICH)
      RBUF(1) = FLOAT (I0 - IMIN)
      RBUF(2) = FLOAT (J0 - JMIN)
      NBUF = 2
      LCHR = 1
      RETURN
C
C--- IFUNC=18, Erase alpha screen. -------------------------------------
C    (Not implemented: no alpha screen)
C
  180 CONTINUE
      RETURN
C
C--- IFUNC=19, Set line style. -----------------------------------------
C    (Not implemented: should not be called)
C
  190 CONTINUE
      GOTO 900
C
C--- IFUNC=20, Polygon fill. -------------------------------------------
C
  200 CONTINUE
      IF (REMCAL .EQ. 0) THEN
C                                       First time, set number of points
C                                       in polygon and allocate the 
C                                       memory for the arrays.
         NPTS = RBUF(1)
         REMCAL = NPTS
         IER = GRGMEM (4 * NPTS, XBUF)
         IF (IER .NE. SS$_NORMAL) THEN
            CALL GRGMSG (IER)
            CALL GRQUIT ('Failed to allocate temporary buffer.')
         END IF
         IER = GRGMEM (4 * NPTS, YBUF)
         IF (IER .NE. SS$_NORMAL) THEN
            CALL GRGMSG (IER)
            CALL GRQUIT ('Failed to allocate temporary buffer.')
         END IF
      ELSE
C                                       Second and succeeding calls,
C                                       change counter and load arrays.
         REMCAL = REMCAL - 1
         I0 = INT (RBUF(1) + 0.5) + IMIN
         J0 = INT (RBUF(2) + 0.5) + JMIN
         CALL GRWS00 (NPTS, %VAL (XBUF), %VAL (YBUF), REMCAL, I0, J0)
C                                       If last call, fill the area and
C                                       deallocate the memory.
         IF (REMCAL .EQ. 0) THEN
            CALL UIS$SET_FILL_PATTERN (VDID, 1, 1, PATT$C_FOREGROUND)
            CALL UISDC$PLOT_ARRAY (WDID, 1, NPTS, %VAL (XBUF), 
     1                                            %VAL (YBUF))
            CALL UIS$SET_FILL_PATTERN (VDID, 1, 1)
            IER = GRFMEM (4 * NPTS, XBUF)
            IF (IER .NE. SS$_NORMAL) THEN
               CALL GRGMSG (IER)
               CALL GRWARN ('Failed to deallocate temporary buffer.')
            END IF
            IER = GRFMEM (4 * NPTS, YBUF)
            IF (IER .NE. SS$_NORMAL) THEN
               CALL GRGMSG (IER)
               CALL GRWARN ('Failed to deallocate temporary buffer.')
            END IF
         END IF 
      END IF
      RETURN
C
C--- IFUNC=21, Set color representation. -------------------------------
C
  210 CONTINUE
C                                       Ignore for a monochrome device.
      IF (.NOT. MONO) THEN
         IC = RBUF(1)
         CALL UIS$SET_COLOR (VDID, IC, RBUF(2), RBUF(3), RBUF(4))
      END IF
      RETURN
C
C--- IFUNC=22, Set line width. -----------------------------------------
C    (Not implemented: should not be called)
C
  220 CONTINUE
      GOTO 900
C
C--- IFUNC=23, Escape --------------------------------------------------
C    (Not implemented: ignored)
C
  230 CONTINUE
      RETURN
C
C--- IFUNC=24, Rectangle Fill. -----------------------------------------
C
  240 CONTINUE
      CALL UIS$SET_FILL_PATTERN (VDID, 1, 1, PATT$C_FOREGROUND)
      I0 = INT (RBUF(1) + 0.5) + IMIN
      J0 = INT (RBUF(2) + 0.5) + JMIN
      I1 = INT (RBUF(3) + 0.5) + IMIN
      J1 = INT (RBUF(4) + 0.5) + JMIN
      CALL UISDC$PLOT (WDID, 1, I0, J0, I1, J0, I1, J1, I0, J1)
      CALL UIS$SET_FILL_PATTERN (VDID, 1, 1)
      RETURN
C
C--- IFUNC=25, ---------------------------------------------------------
C    (Not implemented: ignored)
C
  250 CONTINUE
      RETURN
C
C--- IFUNC=26, Line of pixels ------------------------------------------
C
  260 CONTINUE
      IF (CHEAP) THEN
          GOTO 900
      ELSE
         I0 = INT (RBUF(1) + 0.5) + IMIN
         J0 = INT (RBUF(2) + 0.5) + JMIN
         I1 = I0 + NBUF - 3
         DO 265 IC = 1, NBUF - 2
            KWORD = INT (RBUF(IC + 2) + 0.5)
            PIXEL(IC) = KBYTE
  265    CONTINUE
         CALL UISDC$IMAGE (WDID, 1, I0, J0, I1, J0, 
     1                                  NBUF - 2, 1, 8, PIXEL)
      END IF
      RETURN
C-----------------------------------------------------------------------
      END
 
C*GRWS00 -- PGPLOT WS driver, load polygon arrays
C+
      SUBROUTINE GRWS00 (N0, XBUF, YBUF, N, X, Y)
      INTEGER N, N0, X, XBUF(N0), Y, YBUF(N0)
C--
      XBUF(N0 - N) = X
      YBUF(N0 - N) = Y
      RETURN
      END