1 SUBROUTINE EPDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) 2C GRPCKG driver for EPSON FX100 dot matrix printer. 3C 4C Apr-1987 - Floating-point input version Apr 1987 [PSB]. 5C 16-Jan-1988 - Compile with /WARN=(DECLARE) switch [AFT]. 6C--- 7 CHARACTER ESC, DUAL 8 PARAMETER (ESC=CHAR(27)) 9 PARAMETER (DUAL=CHAR(1)) 10 REAL PL, PL1 11 PARAMETER (PL=765,PL1=PL-1) 12 REAL RBUF(6) 13 INTEGER IFUNC, NBUF, LCHR 14 CHARACTER CHR*(*) 15C 16 INTEGER GRGMEM, GRFMEM, GRTRIM 17 INTEGER XYMAP, LENOLD, IST, IXDIM, IYDIM, LENBUF 18 INTEGER I, J, N, ICOL, LUN 19 INTEGER*2 BUF(0:1632) 20 CHARACTER NN*2 21 SAVE LUN,XYMAP,ICOL,IXDIM,IYDIM,LENOLD,LENBUF 22 DATA LENOLD/0/ 23C--- 24 GOTO (100,200,300,400,500,600,700,800,900,1000, 25 : 1100,1200,1300,1400,1500) IFUNC 26 GOTO 999 27C 28C 1: Return device name: 29100 CHR = 'EPSON (Epson dot matrix printer)' 30 LCHR = GRTRIM(CHR) 31 RETURN 32C 33C 2: Return physical min & max for device: 34200 RBUF(1) = 0 35 RBUF(2) = 1631 36C ! dual-density 120/" 37 RBUF(3) = 0 38 RBUF(4) = -1 39C ! as long as a box of paper... 40 RBUF(5) = 0 41C ! min colour 42 RBUF(6) = 1 43C ! max colour 44 NBUF = 6 45 RETURN 46C 47C 3: Return device resolution: 48300 RBUF(1) = 120.0 49C ! horiz dots per inch 50 RBUF(2) = 72.0 51C ! veric dots per inch 52 RBUF(3) = 1.0 53C ! thick lines 54 RETURN 55C 56C 4: Return misc info: 57C H= Hardcopy device 58C N= No cursor 59C N= No hard dash 60C N= No area fill 61C N= No hard thick lines 62400 CHR(1:10) = 'HNNNNNNNNN' 63 RETURN 64C 65C 5: Return default file name: 66500 CHR = 'PGPLOT.EPS' 67 LCHR = LEN(CHR) 68 RETURN 69C 70C 6: Return default size of plot: 71600 RBUF(1) = 0 72 RBUF(2) = 1631 73 RBUF(3) = 0 74 RBUF(4) = PL1 75C ! 72 ./" -> 11" PAGE. 76 RETURN 77C 78C 7: Return misc defaults: 79700 RBUF(1) = 1. 80 ICOL = 1 81 RETURN 82C 83C 8: Select Plot: 84800 RETURN 85C 86C 9: Open device: 87900 CALL GRGLUN(LUN) 88 OPEN(LUN,FILE=CHR(:LCHR),STATUS='NEW', 89 1 RECORDTYPE='VARIABLE',RECL=4000) 90 RBUF(1) = LUN 91 RBUF(2) = 1 92 RETURN 93C 94C 10: Close device: 951000 CLOSE(UNIT=LUN) 96 CALL GRFLUN(LUN) 97 IF(LENOLD.GT.0) THEN 98 IST = GRFMEM(LENOLD,XYMAP) 99 IF(IST.NE.1) STOP 'error freeing memory in EPDRIV' 100 LENOLD=0 101 ENDIF 102 RETURN 103C 104C 11: Initialise plot: 1051100 IXDIM = RBUF(1) + 1 106 IYDIM = RBUF(2)/9 + 1 107 LENBUF = IXDIM*IYDIM*2 108C ! length of buffer in bytes 109 IF(LENBUF.NE.LENOLD) THEN 110 IF(LENOLD.GT.0) THEN 111 IST = GRFMEM(LENOLD,XYMAP) 112 IF(IST.NE.1) STOP 'error freeing memory in EPDRIV' 113 LENOLD=0 114 ENDIF 115 IST = GRGMEM(LENBUF,XYMAP) 116 IF(IST.NE.1) STOP 'error allocating memory in EPDRIV' 117 LENOLD = LENBUF 118 ENDIF 119 CALL GREP03(LENBUF,%VAL(XYMAP)) 120 RETURN 121C 122C 12: Draw a line: 1231200 CALL GREP01(RBUF,ICOL,IXDIM-1,IYDIM-1,%VAL(XYMAP)) 124 RETURN 125C 126C 13: Draw a dot: 1271300 CALL GREP02(RBUF,ICOL,IXDIM-1,IYDIM-1,%VAL(XYMAP)) 128 RETURN 129C 130C 14: Close plot: 1311400 CONTINUE 132C 133C Initialise printer: 134 WRITE(LUN,1411) ESC,'A',CHAR(9) 135C ! 9 dots per line; 1361411 FORMAT(1X,3A1) 137 DO 1460 J=0,IYDIM-1 138 CALL GREP04(%VAL(XYMAP+IXDIM*J*2),IXDIM,BUF) 139C 140C Find last non-zero dot position: 141 DO 1430 I=IXDIM-1,0,-1 142 N = I + 1 143 IF(BUF(I).NE.0) GOTO 1440 1441430 CONTINUE 1451440 CONTINUE 146 NN(1:1) = CHAR(N.AND.255) 147 NN(2:2) = CHAR(N/256) 148 BUF(N) = '0A0D'X 149C ! CR LF 150 WRITE(LUN,1441) ESC,';',DUAL,NN,(BUF(I),I=0,N) 1511441 FORMAT(1X,3A1,A2,1632A2) 1521460 CONTINUE 153C 154C Reset printer to normal: 155 WRITE(LUN,1461)ESC,'2',CHAR(13) 156C ! 1/6 line spacing 1571461 FORMAT(1X,3A1) 158 RETURN 159C 160C 15: Set colour: 1611500 ICOL = MAX(MIN(NINT(RBUF(1)),1),0) 162C ! only black or white. 163 RBUF(1) = ICOL 164 RETURN 165C--- 166C--- Flag function not implemented. 167999 NBUF=-1 168 RETURN 169 END 170 171 SUBROUTINE GREP01(RBUF,ICOL,IXDIM,IYDIM,XYMAP) 172C- Draw a line on Epson: 173 REAL RBUF(6) 174 INTEGER ICOL, IXDIM, IYDIM 175 INTEGER*2 XYMAP(0:IXDIM,0:IYDIM) 176C 177 REAL XL, YL, D, XP, YP, XINC, YINC 178 INTEGER L, LENGTH, IX, IY, IYBIT 179 INTEGER*2 BITS(0:8) 180 DATA BITS/128,64,32,16,8,4,2,1,-32768/ 181C--- 182 XL = RBUF(3) - RBUF(1) 183 YL = RBUF(4) - RBUF(2) 184 D = MAX(ABS(XL),ABS(YL),1.0) 185 LENGTH = NINT(D) 186 XP = RBUF(1) 187 YP = RBUF(2) 188 XINC = XL/D 189 YINC = YL/D 190 DO 180 L = 0,LENGTH 191 IX = NINT(XP) 192 IY = IYDIM*9 - NINT(YP) 193 IYBIT = MOD(IY,9) 194 IF(ICOL.GT.0) THEN 195 XYMAP(IX,IY/9) = 196 : XYMAP(IX,IY/9).OR.BITS(IYBIT) 197 ELSE 198 XYMAP(IX,IY/9) = 199 : XYMAP(IX,IY/9).AND.(.NOT.BITS(IYBIT)) 200 ENDIF 201 XP = XP + XINC 202 YP = YP + YINC 203180 CONTINUE 204 RETURN 205 END 206 207 SUBROUTINE GREP02(RBUF,ICOL,IXDIM,IYDIM,XYMAP) 208C 209C- Draw a dot: 210 REAL RBUF(6) 211 INTEGER ICOL, IXDIM, IYDIM 212 INTEGER*2 XYMAP(0:IXDIM,0:IYDIM) 213C 214 INTEGER IY, IYBIT 215 INTEGER*2 BITS(0:8) 216 DATA BITS/128,64,32,16,8,4,2,1,-32768/ 217C--- 218 IY = IYDIM*9 - NINT(RBUF(2)) 219 IYBIT = MOD(IY,9) 220 XYMAP(NINT(RBUF(1)),IY/9) = 221 :XYMAP(NINT(RBUF(1)),IY/9).OR.BITS(IYBIT) 222 RETURN 223 END 224 225 SUBROUTINE GREP03(LENBUF,XYMAP) 226C- Erase bitmap 227 INTEGER LENBUF, XYMAP(*) 228 INTEGER I 229C--- 230 DO 180 I=1,LENBUF/4 231 XYMAP(I) = 0 232180 CONTINUE 233 RETURN 234 END 235 236 SUBROUTINE GREP04(XYMAP,IXDIM,BUF) 237C- Copy a line of output to buf 238 INTEGER IXDIM 239 INTEGER*2 XYMAP(IXDIM), BUF(IXDIM) 240 INTEGER I 241C--- 242 DO 180 I=1,IXDIM 243 BUF(I) = XYMAP(I) 244180 CONTINUE 245 RETURN 246 END 247