C*EXDRIV -- PGPLOT Talaris/EXCL driver (landscape mode) C+ SUBROUTINE EXDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for EXCL devices (Talaris) C----------------------------------------------------------------------- C Version 1.0 - 1989 Nov 10 - A. L. Fey. C 2.0 - 1994 Nov 08 C----------------------------------------------------------------------- C C Supported device: Any Talaris printer that accepts the EXCL C page description language. 7-bit mode is used. C C Device type code: /EXCL (landscape) C /VEXCL (portrait) C C Default file name: pgplot.explot. C C Default view surface dimensions: 10.25 inches horizontal x 7.75 inches C vertical (landscape mode). C Default view surface dimensions: 7.75 inches horizontal x 10.25 inches C vertical (portrait mode). C C Resolution: The driver uses coordinate increments of 1/1000 inch. C The true resolution is device-dependent; at time of C writing, it is typically 300 dots per inch. C C Color capability: Color indices 0 (erase), and 1 (black) are C supported. Requests for other color indices are C converted to 1. It is not possible to change color C representation. C C Input capability: None. C C File format: Ascii, variable length records (max 80 bytes). C----------------------------------------------------------------------- C CHARACTER*(*) DEFNAM REAL WIDTH, HEIGHT, MARGIN C-- PARAMETER (DEFNAM = 'pgplot.explot') PARAMETER (WIDTH = 11000.0) PARAMETER (HEIGHT = 8500.0) PARAMETER (MARGIN = 375) C-- CHARACTER*(*) ESC, SP, ESCP, ESCLB, ESCBS PARAMETER (ESC = CHAR (27)) PARAMETER (SP = CHAR (32)) PARAMETER (ESCP = CHAR (27)//CHAR (80)) PARAMETER (ESCLB = CHAR (27)//CHAR (91)) PARAMETER (ESCBS = CHAR (27)//CHAR (92)) C CHARACTER*80 BUFFER CHARACTER*80 INSTR CHARACTER*10 MSG INTEGER UNIT, I0, J0, I1, J1, IC INTEGER L, NPAGE, NPTS, PENWID REAL EXSCAL, EYSCAL REAL EXSIZE, EYSIZE REAL XRESOL, YRESOL LOGICAL NOTHIN INTEGER GRTRIM, GROPTX C C ---- BUFFER should not exceed 80 - this makes well formed EXCL files. C ---- The E*SIZE parameters are the physical size of the plot (used C ---- more than once here) in resolution units (1/1000 inch). The C ---- *OFF parameters are offsets from the physical origin of the C ---- page assuming a page size of 8.5 x 11 inches. The E*SCAL C ---- parameters are PGPLOT-modifiable scale factors. C PARAMETER (XRESOL = 1000.00, : YRESOL = 1000.00, : PENWID = 5) SAVE EXSIZE, EYSIZE C C======================================================================= C C ---- Do the best one can in F77 for a "case" statement. -------------- C 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), IFUNC C C ---- Unknown opcode/function; most likely a logic error somewhere ---- C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in EXCL device driver:'//MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF(MODE .EQ. 1) THEN CHR = 'EXCL (Talaris/EXCL printers, landscape)' ELSE CHR = 'VEXCL (Talaris/EXCL printers, portrait)' END IF LCHR = GRTRIM(CHR) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C Units are in device co-ordinates (1/1000 inches) C 20 RBUF(1) = 0.0 RBUF(3) = 0.0 RBUF(5) = 0.0 RBUF(6) = 1.0 IF(MODE .EQ. 1) THEN RBUF(2) = WIDTH - 2*MARGIN RBUF(4) = HEIGHT - 2*MARGIN ELSE RBUF(2) = HEIGHT - 2*MARGIN RBUF(4) = WIDTH - 2*MARGIN END IF NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C (Nominal values) C 30 RBUF(1) = XRESOL RBUF(2) = YRESOL C C (multiple strokes are spaced by PENWID/*RESOL inches) C RBUF(3) = PENWID NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (Hardcopy, No cursor, No Dashed lines, Area fill, No Thick lines) C 40 CHR = 'HNNANNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C (in device coordinates). C 60 RBUF(1) = 0.0 RBUF(3) = 0.0 IF(MODE .EQ. 1) THEN RBUF(2) = WIDTH - 2*MARGIN RBUF(4) = HEIGHT - 2*MARGIN ELSE RBUF(2) = HEIGHT - 2*MARGIN RBUF(4) = WIDTH - 2*MARGIN END IF 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 Future option, nothing done yet. (Multiple devices open at one C time will be allowed later; this opcode will select active device). C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C C -- Get a Unit number. C CALL GRGLUN(UNIT) C C -- Open the file. C NBUF = 2 RBUF(1) = UNIT IF(GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) .NE. 0) THEN CALL GRWARN('Cannot open output file for EXCL plot') RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = GRTRIM(CHR) RBUF(2) = 1 END IF C C -- initialization C EXSCAL = 1.0 EYSCAL = 1.0 IF(MODE .EQ. 1) THEN EXSIZE = WIDTH - 2 * MARGIN EYSIZE = HEIGHT - 2 * MARGIN ELSE EXSIZE = HEIGHT - 2 * MARGIN EYSIZE = WIDTH - 2 * MARGIN END IF NOTHIN = .TRUE. NPAGE = 0 NPTS = 0 C C -- Start vector graphics mode. C Initialize EXCL, set ANSI mode to EXCL (TALAMS), reset the C printstation to power-up state (TALMOD), set copy count C to one (TALCCNT), set paper size to letter (TALFCTL), C turn on Absorb Forms Control (TALASF). C BUFFER = ESCLB//'0*s' : //ESCLB//'1;0r' : //ESCLB//'1;0u' : //ESCLB//';3x' : //ESCLB//'1'//SP//'z' CALL GREX00 (UNIT, BUFFER, 27) C C -- Comments; write user and date created to file. C CALL GREX00 (UNIT, : ESC//'Q ------------------------------ '//ESC//'R', 36) CALL GRUSER (INSTR, L) BUFFER = : ESC//'Q -- EXCL plot created by '//INSTR(1:L)//' -- '//ESC//'R' CALL GREX00 (UNIT, BUFFER, 33+L) CALL GRDATE (INSTR, L) BUFFER = : ESC//'Q -- EXCL plot created on '//INSTR(1:L)//' -- '//ESC//'R' CALL GREX00 (UNIT, BUFFER, 33+L) CALL GREX00 (UNIT, : ESC//'Q ------------------------------ '//ESC//'R', 36) RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE C IF (NOTHIN) THEN C C -- Nothing was plotted so no need to keep the file around. C CLOSE (UNIT) C ELSE C C -- Don't need to formfeed; end picture will do that. C Reset printstation to its power-up state. C BUFFER = ESC//'Q -- End of File -- '//ESC//'R'//ESC//'c' CALL GREX00 (UNIT, BUFFER, 25) CLOSE (UNIT) ENDIF C C -- Return UNIT to free pool. C CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture and possibly rescale ----------------------- C 110 CONTINUE NPAGE = NPAGE + 1 C C -- Define the unit of measure to be mils (TALPRM), define the page C orientation to be landscape or portrait (TALPGO), set page C clipping window to default page size (TALPCW), and set the C origin to the top left of the physical page at MARGIN,MARGIN C (TALORG). C BUFFER = ESCLB//'3y' : //ESCLB//'0p' : //ESCLB//'0;;;0*c' IF(MODE .EQ. 1) THEN BUFFER(7:7)='1' ELSE BUFFER(7:7)='0' END IF WRITE (BUFFER (18:31), 1000) ESCLB, MARGIN, MARGIN 1000 FORMAT (A2, I5.5, ';', I5.5, 'o') CALL GREX00 (UNIT, BUFFER, 31) C C -- Set the line defaults (TALGLP, TALGLT) and set fill C pattern (TALGRP). C BUFFER = ESCLB//' ; ;8;1;112;5279;1*w' : //ESCLB//'112;5279;0*r' : //ESCLB//'*t' WRITE (BUFFER (3:4), '(I2.2)') PENWID WRITE (BUFFER (6:7), '(I2.2)') PENWID CALL GREX00 (UNIT, BUFFER, 42) C C -- Rescale if needed. C EXSCAL = MIN (1.0, RBUF(1) / EXSIZE) EYSCAL = MIN (1.0, RBUF(2) / EYSIZE) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C C -- Move with TALGMV, draw with TALGDW. C 120 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. I0 = NINT(RBUF(1) * EXSCAL) J0 = NINT((EYSIZE - RBUF(2)) * EYSCAL) I1 = NINT(RBUF(3) * EXSCAL) J1 = NINT((EYSIZE - RBUF(4)) * EYSCAL) 125 CONTINUE IF(MODE.EQ.1) THEN WRITE (BUFFER( 1:15), 2000) ESCLB, I0, J0, '*m' WRITE (BUFFER(16:30), 2000) ESCLB, I1, J1, '*d' ELSE WRITE (BUFFER( 1:15), 2001) ESCLB, I0, J0, '*m' WRITE (BUFFER(16:30), 2001) ESCLB, I1, J1, '*d' ENDIF 2000 FORMAT (A2, ';', I5.5, ';', I4.4, A2) 2001 FORMAT (A2, ';', I4.4, ';', I5.5, A2) CALL GREX00 (UNIT, BUFFER, 30) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C EXCL takes care of dot size by the pen width command so we C don't have to worry about it here. Just draw to same point and C let the "draw line" code handle it. C 130 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. I0 = NINT(RBUF(1) * EXSCAL) J0 = NINT((EYSIZE - RBUF(2)) * EYSCAL) I1 = I0 J1 = J0 GOTO 125 C C--- IFUNC=14, End picture --------------------------------------------- C C -- Eject page and clear bitmap (TALFPO). C 140 CONTINUE C IF (.NOT. NOTHIN) THEN CALL GRFAO ('Q -- End Page: # ', L, INSTR, NPAGE, 0, 0, 0) BUFFER = ESCLB//'0*F'//ESC//INSTR(1:L)//' -- '//ESC//'R' CALL GREX00 (UNIT, BUFFER, 12+L) ENDIF RETURN C C--- IFUNC=15, Select color index -------------------------------------- C C Use TALGLP. C 150 CONTINUE IC = RBUF(1) C IF (IC .EQ. 0) THEN C C -- Color index 0 is erase. C BUFFER = ESCLB//' ; ;11;1;112;5279;1*w' : //ESCLB//'112;5279;11*r' : //ESCLB//'*t' WRITE (BUFFER (3:4), '(I2.2)') PENWID WRITE (BUFFER (6:7), '(I2.2)') PENWID CALL GREX00 (UNIT, BUFFER, 44) ELSE IF (IC .EQ. 1) THEN C C -- Color index 1 is black. C BUFFER = ESCLB//' ; ;8;1;112;5279;1*w' : //ESCLB//'112;5279;0*r' : //ESCLB//'*t' WRITE (BUFFER (3:4), '(I2.2)') PENWID WRITE (BUFFER (6:7), '(I2.2)') PENWID CALL GREX00 (UNIT, BUFFER, 42) ELSE IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C Hardcopy so ignore it C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C Not implemented, hardcopy device. Return error code. C 170 CONTINUE NBUF = -1 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen so ignore it). C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C C -- Use TALPFL to fill polygon. C 200 CONTINUE C C -- Use NPTS as our indicator of whether this is first time or not. C IF (NPTS .EQ. 0) THEN C C -- First time so set number of points in polygon and start polygon C command. C NPTS = RBUF (1) BUFFER = ESCP//'4;1;0;1}' CALL GREX00 (UNIT, BUFFER, 10) ELSE C C -- Second or other time so decrement NPTS and draw to next vertex. C IF (NOTHIN) NOTHIN = .FALSE. NPTS = NPTS - 1 I0 = NINT(RBUF(1) * EXSCAL) J0 = NINT((EYSIZE - RBUF(2)) * EYSCAL) IF(MODE .EQ. 1) THEN WRITE (BUFFER, 3000) I0, J0 ELSE WRITE (BUFFER, 3001) I0, J0 END IF 3000 FORMAT (I5.5, ':', I4.4, ';') 3001 FORMAT (I4.4, ':', I5.5, ';') CALL GREX00 (UNIT, BUFFER, 11) C C -- Give the polygon fill command on last call. C IF (NPTS .EQ. 0) THEN BUFFER = ESCBS CALL GREX00 (UNIT, BUFFER, 2) END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored. Will we ever get color laser printers?) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC=23, Escape -------------------------------------------------- C Note that the NOTHIN flag which indicates if there is anything C written on the paper is set here regardless of the content of C the escape characters. C 230 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. RETURN C----------------------------------------------------------------------- END C*GREX00 -- PGPLOT Talaris/EXCL driver, flush buffer C+ SUBROUTINE GREX00 (LUN, BUF, SIZ) CHARACTER*(*) BUF INTEGER LUN, SIZ C-- WRITE (LUN, '(A)') BUF(1:SIZ) END