SUBROUTINE VECTOR (X,Y,IMODE) C C============================================================================== C C C C ************************************************************** C *** SUBROUTINE VECTOR (X,Y,IMODE) *** C *** *** C *** SUBROUTINE TO ALLOW VECTORED GRAPHICS ON VARIOUS *** C *** GRAPHICS I/O DEVICES USING ADDED BLOCKS OF FORTRAN *** C *** CODE FOR EACH DEVICE. *** C *** *** C ************************************************************** C C C C AUTHOR: R A YOST C T V ATKINSON C T G KELLY C Kluges compliments of the MOOSE C H GREGG C CHEMISTRY DEPARTMENT C MICHIGAN STATE UNIVERSITY C EAST LANSING, MI 48824 C C DATE: 25-NOV-81,2/83,4/83 C C C VECTOR CALLING MODES: C C -5: return X == 1 if device exists C -4: inititalize the device C -3: return screen size C -2: return alpha cursor position C -1: return graphics cursor position C 0: clear the screen C 1: move the graphics cursor (unwritten vector) C 2: draw a vector from the current position to new X,Y C 3: plot a point at the given X,Y C 4: complete the plot and flush the buffer C 5: set nibs (X) and line pattern (Y) C 6: print device ID to logical unit INT(X) C 7: device specific parameters (speed on HP plotter) C C============================================================================== C COMMON /VECTOR/ LUNGRP,XSCALE,YSCALE,IDEV,TRNFRM(6), 1 XOFF,YOFF,NIBS,LINPAT COMMON /GRPHDV/ GDDEV0 ! file for IDEV=0 output BYTE GDDEV0(32) BYTE BUFFER(40) ! temp buffer for each device INTEGER*2 ESCAPE DATA ESCAPE/"33/ ! looks ASCIZ to me ... C C----------------------------------------------------------------------- C C ************************************************************** C **************** TRANSFORM THE CORDINATES **************** C ************************************************************** C C----------------------------------------------------------------------- C XT = X YT = Y JDEV = IDEV + 1 C 101 IF (IMODE .EQ. -5) X = 0.0 ! assume the device doesn't exist IF ((IMODE .LT. 1) .OR. (IMODE .GT. 3)) GO TO 110 XS = X/XSCALE + XOFF YS = Y/YSCALE + YOFF XT = XS*TRNFRM(1) + YS*TRNFRM(2) + TRNFRM(3) YT = XS*TRNFRM(4) + YS*TRNFRM(5) + TRNFRM(6) 110 IF (IMODE .NE. 6) GOTO 120 LUN = INT(X) IF (LUN .LE. 0) GOTO 90 ! illegal call - ignore 120 CONTINUE C C============================================================================= C C This 'device' writes a binary vector file to be used with C raster printers, along with program RASTER. C C A binary file is written (to logical unit LUNGRP) with one integer C and two reals (IMODE,X,Y) per record. C C============================================================================= C JDEV = JDEV - 1 IF (JDEV .NE. 0) GOTO 89 C IF ((IMODE .LT. -5) .OR. (IMODE .GT. 7)) RETURN GOTO (10,20,30,90,90,50,50,50,50,50,50,60,50) IMODE + 6 C C mode -5: do this device exist? C 10 X = 1.0 GOTO 90 C C mode -4: initialize - open the output file C 20 CALL ASSIGN(LUNGRP,'SY0:') ! make sure we're looking good CALL CLOSE(LUNGRP) OPEN (UNIT=LUNGRP,NAME=GDDEV0,TYPE='NEW',FORM='UNFORMATTED', 1 ACCESS='SEQUENTIAL') GOTO 90 C C mode -3: return 'screen' size C 30 X = 160. ! make up a number Y = 11.2 GOTO 90 C C modes -4,0,1,2,3,4,5,7: pass all into the file C 50 WRITE (LUNGRP) IMODE,XT,YT IF (IMODE .EQ. 4) CALL CLOSE (LUNGRP) ! finish, if done IF (IMODE .NE. 5) GOTO 90 NIBS = X LINPAT = Y GOTO 90 C C mode 6: identify yourself C 60 WRITE (LUN,70) 70 FORMAT('+ Binary Vector List') GOTO 90 C C all done with this device - send us on to the next C 89 CONTINUE C C=========================================================================== C C RETROGRAPHICS TEK 4010 graphics emulator C C 8.0" x 6.0" (640 x 480) emulating TEK's (1024 x 780) C C=========================================================================== C JDEV = JDEV - 1 IF (JDEV .NE. 0) GOTO 2999 C IF ((IMODE .LT. -5) .OR. (IMODE .GT. 6)) RETURN GOTO (2000,2005,2010,2020,2030,2040,2050,2060,2070,2090, 1 2100,2200),IMODE+6 C C mode -5: we exist C 2000 X = 1.0 GOTO 90 C C mode -4: initialize C 2005 CALL GTATT(LUNGRP) ! and attach the terminal, set up loon GOTO 90 C C mode -3: return screen size C 2010 X = 8.0 Y = 6.0 GOTO 90 C C mode -2: alpha cursor position C 2020 CALL GTTEKI(IX,IY,I,2) ! request alpha cursor X = IX / 127.875 Y = IY / 130.000 GOTO 90 C C mode -1: graphics cursor position C 2030 CALL GTTEKI(IX,IY,I,1) ! request graphics cursor X = IX / 127.875 Y = IY / 130.000 XT = XTLAST YT = YTLAST GOTO 2050 ! reposition cursor with a dark vector C C mode 0: clear screen C 2040 CALL GT(ESCAPE) ! make sure we're in transparent mode CALL GT('"0g') CALL GT(ESCAPE) ! make sure we're in ANSI mode CALL GT('<') CALL GT(ESCAPE) ! erase all CALL GT('[2J') CALL GT("35) ! now to 4010 mode CALL GT(ESCAPE) ! erase graphics memory CALL GT("14) CALL GT(ESCAPE) ! and back to transparent mode CALL GT('"0g') CALL GTF ! flush the buffer (do it) LINPAT = -1 ! initialization does this ... GOTO 90 C C mode 1: unwritten vector C 2050 CALL GT("35) ! invokes graphics; dark vect 1st GOTO 2080 C C mode 2: written vector C 2060 GOTO 2080 ! must assume in graf mode. do it. C C mode 3: point plot C 2070 CALL GT("34) ! invokes point plot mode C C modes 1,2,3: send out the X,Y coordinates C 2080 IX = MIN1(1023.,AMAX1(0.,127.875*XT+0.5)) IY = MIN1( 779.,AMAX1(0.,130.000*YT+0.5)) CALL GTTEK(IX,IY) GOTO 90 C C mode 4: finish the plot C 2090 CALL GT("35) ! dark vector CALL GTTEK(0,779) ! to the top left corner CALL GT("15) ! enter alpha mode CALL GT(ESCAPE) ! enter transparent mode CALL GT('"0g') CALL GTF ! flush the buffer CALL GTATT(-LUNGRP) ! deattach the terminal CALL CLOSE(LUNGRP) GOTO 90 C C mode 5: set nibs (X;ignored) and line pattern (Y) C 2100 NIBS = X IY = Y ! get line pattern IF (IY .EQ. LINPAT) GOTO 90 ! if set, don't change LINPAT = IY ! set for later CALL GT("35) ! get to 4010 mode CALL GT(ESCAPE) ! init. for new pattrn IF (LINPAT .NE. -1) GOTO 2105 CALL GT('`') ! use solid line GOTO 90 C non-solid line - figure it out 2105 CALL GT('/') YT = Y IF (YT .LT. 0) YT = YT + 65536.0 ! YT = real 0-65k IY = 1 ! 1 ==> bits on, 0=off IX = 1 ! counts # bits IY C main loop - count down from the top DO 2140 I=15,0,-1 XT = 2.0**FLOAT(I) ! XY = value of a bit N = 0 ! N will be the bit IF ((XT - 0.1) .GT. YT) GOTO 2110 ! account of roundoff N = 1 ! this bit was set YT = YT - XT ! reduce our counter C now, N is the value of the next bit, YT reduced if needed 2110 IF (N .NE. IY) GOTO 2120 C we're counting this type (IY=0 ==> off ==> N=0, etc) IX = IX + 1 GOTO 2140 C bits changed from on to off, or vise versa. ship out last, set up new 2120 ENCODE (2,2130,BUFFER) IX 2130 FORMAT (I2) IF (IX .GT. 9) CALL GT(BUFFER,2) ! don't send spaces IF (IX .LE. 9) CALL GT(BUFFER(2),1) CALL GT(';') IY = IY .XOR. 1 ! invert the flag IX = 1 ! already saw one 2140 CONTINUE C now ship out the last one ENCODE (2,2130,BUFFER) IX IF (IX .GT. 9) CALL GT(BUFFER,2) IF (IX .LE. 9) CALL GT(BUFFER(2),1) CALL GT('a') ! finish the def. CALL GT(ESCAPE) ! invoke it CALL GT('x') GOTO 90 C C mode 6: identify ourself C 2200 WRITE (LUN,2210) 2210 FORMAT('+ VT100 with RETROGRAPHICS adapter') GOTO 90 C C all done - get ready for the next C 2999 CONTINUE C C============================================================================ C C Graphics driver for HP 7470A plotter C C 10.22" x 7.5" (10300 x 7650) C C============================================================================ C JDEV = JDEV - 1 IF (JDEV .NE. 0) GOTO 4999 C IF ((IMODE .LT. -5) .OR. (IMODE .GT. 7)) RETURN GOTO (4000,4005,4010,90,90,4020,4030,4040,4030,4080,4090, 1 4200,4110), IMODE+6 C C mode -5: we exist C 4000 X = 1.0 GOTO 90 C C mode -4: initialize C 4005 CALL GTATT(LUNGRP) ! attach the device CALL GT('IN;SP1;PA;') ! initialize, select pen 1 CALL GT(ESCAPE) ! CALL GT('.H40;0;17:;') ! establish DEC style handshake CALL GT(ESCAPE) CALL GT('.N;19:;VS;') ! and make the fastest drawing speed CALL GTF ! flush the buffer LINPAT = -1 ! init sets the line pattern NIBS = 1 ! and the nibs GOTO 90 C C mode -3: return paper size (active area on 8.5" x 11" paper) C 4010 X = 10.22 Y = 7.5 GOTO 90 C C mode 0: clear the 'screen' C 4020 GOTO 90 C C modes 1,3: unwritten vector, point plot C 4030 CALL GT('PU') ! pen up GOTO 4050 C C mode 2: written vector C 4040 CALL GT('PD') ! pen down C C modes 1,2,3: ship out the coordinates C 4050 IX = MIN1(10300.,AMAX1(0.,1007.8*XT+0.5)) IY = MIN1( 7650.,AMAX1(0.,1020.0*YT+0.5)) ENCODE (11,4060,BUFFER) IX,IY 4060 FORMAT (I5,',',I5) C compress the spaces out J = 1 DO 4070 I=1,11 IF (BUFFER(I) .EQ. "40) GOTO 4070 BUFFER(J) = BUFFER(I) J = J + 1 4070 CONTINUE CALL GT(BUFFER,J-1) CALL GT(';') IF (IMODE .EQ. 3) CALL GT('PDPU;') ! plot a point IF (IMODE .EQ. 1) CALL GTF ! on each unwritten vector, we C ! must make sure the pen is up - C ! else we might get a splotch of ink. C ! ie. flush the buffer. Slow, C ! but it does assure a clean plot. GOTO 90 C C mode 4: complete the plot C 4080 CALL GT('PU;SP0;') ! put the pen away CALL GTF ! flush the buffer CALL GTATT(-LUNGRP) ! and deattach the plotter CALL CLOSE(LUNGRP) GOTO 90 C C mode 5: nibs (X; right or left pen) and line pattern (Y) C 4090 IX = X IF (IX .GT. 1) IX = 2 IF (IX .EQ. NIBS) GOTO 4102 ! nibs already set - just leave NIBS = IX IF (NIBS .EQ. 1) GOTO 4100 CALL GT('SP2;') ! nibs > 1, use right pen GOTO 4102 4100 CALL GT('SP1;') ! nibs = 1, use left pen C C now do the line pattern C 4102 IY = Y IF (IY .EQ. LINPAT) GOTO 90 ! line pattern set - just leave LINPAT = IY IY = 0 C kludge - if octal constant was in the expression, it doesn't work! IX = "100000 IF (LINPAT .EQ. IX) IY = 1 ! set up the HP line types IX = "176000 IF (LINPAT .EQ. IX) IY = 2 IX = "177700 IF (LINPAT .EQ. IX) IY = 3 IX = "177772 IF (LINPAT .EQ. IX) IY = 4 IX = "177714 IF (LINPAT .EQ. IX) IY = 5 IX = "176310 IF (LINPAT .EQ. IX) IY = 6 IF ((IY .GE. 1) .AND. (IY .LE. 6)) GOTO 4103 CALL GT(';LT-1;') ! solid line LINPAT = -1 GOTO 90 4103 ENCODE (5,4104,BUFFER) IY 4104 FORMAT(';LT',I1,';') CALL GT(BUFFER,5) GOTO 90 C C mode 7: select the pen velocity (X) C 4110 IF ((X .GT. 0.0) .AND. (X .LT. 38.1)) GOTO 4118 CALL GT(';VS;') ! full speed ahead GOTO 90 4118 ENCODE (8,4120,BUFFER) X 4120 FORMAT (';VS',F4.1,';') CALL GT(BUFFER,8) GOTO 90 C C mode 6: identify ourself C 4200 WRITE (LUN,4210) 4210 FORMAT('+ HP 7470 two pen plotter') GOTO 90 C C all done - get next device C 4999 CONTINUE C C----------------------------------------------------------------------- C C ************************************************************** C ********************** ALL DEVICES ************************ C ************************************************************** C C------------------------------------------------------------------------ C 90 IF(IMODE)92,95,91 C C IF IMODE = 0, GET OFFSETS XOFF,YOFF FROM X,Y C 95 XOFF=X YOFF=Y XTLAST = 0.0 YTLAST = 0.0 GO TO 92 C C IF IMODE = 1,2, OR 3, REMEMBER POSITION AS LAST. C 91 IF(IMODE.GE.4) GO TO 92 XTLAST = XT YTLAST = YT C C IF IMODE <0 OR >3, RETURN ONLY. C 92 RETURN END