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