1* Date:     27-MAR-1987 11:28:46
2* From:     AFT%UK.AC.CAM.AST-STAR@AC.UK
3* To:       TJP@CITPHOBO
4* Subject:  ZEDRIVER.FOR (3)
5
6C*ZEDRIV -- PGPLOT Zeta Plotter driver
7
8      SUBROUTINE ZEDRIV(IFUNC,RBUF,NBUF,CHR,LCHR)
9C--- GRPCKG driver for ZETA plotter.
10C----
11C Supported device:  Zeta 8 Digital Plotter.
12C Device type code:  /ZEta
13C Default file name:  PGPLOT.ZET
14C Default view surface dimensions:  11 inches by 11 inches.  Current
15C   version does not allow larger plots although the manual indicates
16C   plots up to 144 feet are possible.
17C Resolution:  This version is written for the case where the resolution
18C   switch is set to .025 mm.  Actual resolution depends on thickness
19C   of pen tip.
20C Color capability:  Color indices 1 to 8 are supported corresponding
21C   to pens 1-8.  It is not possible to erase lines.
22C Input capability:  None.
23C File format:  Variable length records with Carriage control of LIST.
24C Obtaining hardcopy:  On Starlink print the file on the queue associated
25C   with the Zeta plotter.  If the Plotter is attached to a terminal
26C   line, then TYPEing the file at the terminal will produce a plot.
27C   On Starlink:
28C   $ PRINT/NOFEED/QUE=ZETA PGPLOT.ZET
29C
30C   To stop a Zeta plot job, once it has been started, use the buttons
31C   on the plotter.  Press PAUSE, NEXT PLOT and CLEAR.  Only after
32C   this sequence is it safe to delete the job from the ZETA Queue.
33C   Failing to press the NEXT PLOT button will not correctly advance
34C   the paper.  Failing to press CLEAR but, deleteing the current
35C   job can prevent the following plot from being plotted.
36C
37C  5-Aug-1986 - [AFT].
38C-----------------------------------------------------------------------
39C     IMPLICIT NONE
40      CHARACTER*(*) TYPE
41      PARAMETER (TYPE='ZETA (Zeta 8 Digital Plotter)')
42      INTEGER   IFUNC,NBUF,LCHR,I0,J0,I1,J1
43      REAL      RBUF(6)
44      CHARACTER CHR*(*)
45      INTEGER   GRGE00
46      CHARACTER COL(0:7)*2
47      INTEGER   LUN,MXCNT,ICNT,IBADR
48      SAVE      LUN,MXCNT,ICNT,IBADR
49      DATA COL/'6A','61','62','63','64','65','66','67'/
50C---
51      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
52     :     110,120,130,140,150,160) IFUNC
53      GOTO 999
54C---
55C--- IFUNC= 1, Return device name.
56 10   CHR=TYPE
57      LCHR=LEN(TYPE)
58      RETURN
59C---
60C--- IFUNC= 2, Return Physical min and max for plot device.
61 20   RBUF(1)=0
62      RBUF(2)=11175
63      RBUF(3)=0
64      RBUF(4)=11175
65      RBUF(5)=1
66      RBUF(6)=8
67      NBUF=4
68      RETURN
69C---
70C--- IFUNC= 3, Return device resolution.
71 30   RBUF(1)=1007.0
72      RBUF(2)=1007.0
73      RBUF(3)=10
74      NBUF=3
75      RETURN
76C---
77C--- IFUNC= 4, Return misc device info.
78 40   CHR='HNNNNNNNNN'
79      LCHR=10
80      RETURN
81C---
82C--- IFUNC= 5, Return default file name.
83 50   CHR='PGPLOT.ZET'
84      LCHR=LEN(CHR)
85      RETURN
86C---
87C--- IFUNC= 6, Return default physical size of plot.
88 60   RBUF(1)=0
89      RBUF(2)=11175
90      RBUF(3)=0
91      RBUF(4)=11175
92      RETURN
93C---
94C--- IFUNC= 7, Return misc defaults.
95 70   RBUF(1)=15
96      NBUF=1
97      RETURN
98C---
99C--- IFUNC= 8, Set active plot.
100 80   CALL INIT03(0,LUN,0)
101      RETURN
102C---
103C--- IFUNC= 9, Open workstation.
104 90   RBUF(2)=GRGE00('FFL',LUN,CHR,LCHR)
105      RBUF(1)=LUN
106      IF(RBUF(2).EQ.1) THEN
107         MXCNT=130
108         CALL GRGMEM(MXCNT,IBADR)
109         ICNT=0
110         CALL INIT03(0,LUN,0)
111      END IF
112      RETURN
113C---
114C--- IFUNC=10, Close workstation.
115 100  CLOSE(UNIT=LUN)
116      CALL GRFLUN(LUN)
117      CALL GRFMEM(MXCNT,IBADR)
118      RETURN
119C---
120C--- IFUNC=11, Begin Picture.
121 110  CALL GRGE02(%ref('ZZZZZZZZZZ'), 10, %val(IBADR),ICNT,MXCNT)
122      CALL GRGE02(%ref('0000000000CIII'), 14, %val(IBADR),ICNT,MXCNT)
123      CALL INZE01
124      RETURN
125C---
126C--- IFUNC=12, Draw line.
127 120  I0=NINT(RBUF(1))
128      J0=NINT(RBUF(2))
129      I1=NINT(RBUF(3))
130      J1=NINT(RBUF(4))
131      CALL GRZE01(I0,J0,I1,J1,%val(IBADR),ICNT,MXCNT)
132      RETURN
133C---
134C--- IFUNC=13, Draw dot.
135 130  I0=NINT(RBUF(1))
136      J0=NINT(RBUF(2))
137      CALL GRZE01(I0,J0,I0,J0,%val(IBADR),ICNT,MXCNT)
138      RETURN
139C---
140C--- IFUNC=14, End picture.
141C--- Move pen to origin,
142C--- Advance paper by 15 inches,
143C--- Reset.
144 140  CALL GRZE01(0,0,0,0,%val(IBADR),ICNT,MXCNT)
145      CALL GRGE02(%ref('1OGUE'),5,%val(IBADR),ICNT,MXCNT)
146      CALL GRGE02(%ref('70Z')  ,3,%val(IBADR),ICNT,MXCNT)
147      RETURN
148C---
149C--- IFUNC=15, Select pen.
150 150  I0=MAX(0,MIN(NINT(RBUF(1)),7))
151      RBUF(1)=I0
152      CALL GRGE02(%ref(COL(I0)),2,%val(IBADR),ICNT,MXCNT)
153      RETURN
154C---
155C--- IFUNC=16, Flush buffer.
156 160  CALL GRGE03(%val(IBADR),ICNT)
157      RETURN
158C---
159C--- Flag function not implemented.
160 999  NBUF=-1
161      RETURN
162C---
163      END
164
165C*GRZE01 -- PGPLOT Zeta Plotter driver, line segment
166
167      SUBROUTINE GRZE01 (I0,J0,I1,J1,IBUF,ICNT,MXCNT)
168C-----------------------------------------------------------------------
169C GRPCKG (internal routine, ZETA): draw a line segment.
170C
171C Arguments:
172C
173C I0,J0 (integer, input): the column and row numbers of the starting
174C       point.
175C I1,J1 (integer, input): the column and row numbers of the end point.
176C
177C 15-NOV-83
178C-----------------------------------------------------------------------
179C     IMPLICIT NONE
180      INTEGER    ISIZE
181      PARAMETER (ISIZE=11176)
182      INTEGER   I0, I1, J0, J1, IBUF(*), ICNT, MXCNT
183      CHARACTER CPEN(2), CSTR*8
184      INTEGER   II0, II1, JJ0, JJ1, I
185      INTEGER   IDX(2), IDY(2), LASTX, LASTY
186      SAVE      LASTX,LASTY
187      DATA CSTR(2:2)/'R'/, CPEN/'1','2'/
188C---
189      II0= MOD(I0, ISIZE)
190      II1= MOD(I1, ISIZE)
191      JJ0= MOD(J0, ISIZE)
192      JJ1= MOD(J1, ISIZE)
193C
194      IDX(1)= II0-LASTX
195      IDY(1)= JJ0-LASTY
196      IDX(2)= II1-II0
197      IDY(2)= JJ1-JJ0
198C
199C  First iteration moves to starting point, second draws line.
200C
201      DO 100 I= 1, 2
202         CSTR(1:1)= CPEN(I)
203         IF(IDX(I).NE.0  .OR. IDY(I).NE.0) THEN
204            CALL GRZE04(IDX(I), CSTR, 3)
205            CALL GRZE04(IDY(I), CSTR, 6)
206            CALL GRGE02(%ref(CSTR), 8, IBUF,ICNT,MXCNT)
207         ELSE IF(I .EQ. 2) THEN
208            CALL GRGE02(%ref(CSTR), 1, IBUF,ICNT,MXCNT)
209         END IF
210 100  CONTINUE
211C
212      LASTX= II1
213      LASTY= JJ1
214      RETURN
215C---
216      ENTRY INZE01
217C
218C  This entry is called by to initialize a new plot.
219C
220      LASTX= 0
221      LASTY= 0
222      RETURN
223      END
224
225C*GRZE04 -- PGPLOT Zeta Plotter driver, string generation
226
227      SUBROUTINE GRZE04(NUM, CSTR, NC)
228C-----------------------------------------------------------------
229C  Generate strings for sending to Zeta plotter.
230C
231C- NUM          I   I   Number to be converted.
232C- CSTR         I/O C   Output character array.
233C- NC           I/O I   Start location in CSTR
234C
235C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
236C     IMPLICIT NONE
237      INTEGER   NUM,NC
238      CHARACTER CSTR*(*)
239      INTEGER   ITMP, I, IDIV, IND
240      CHARACTER CFIG(0:31)
241C
242      DATA CFIG/'0','1','2','3','4','5','6','7','A',
243     :    'B','C','D','E','F','G','H','I','J','K','L','M','N','O',
244     :    'P','Q','R','S','T','U','V','W','X'/
245C
246      ITMP=NUM
247      IF(NUM .LT. 0) ITMP= NUM+32768
248      IDIV= 1
249      DO 100 I=NC+2,NC,-1
250         IND= MOD(ITMP/IDIV, 32)
251         IF(IND .LT. 0) IND= 32+IND
252         CSTR(I:I)= CFIG(IND)
253         IDIV= IDIV*32
254 100  CONTINUE
255      END
256