C C These are the low level routines for controlling a C Tektronix 4010 compatible terminal. Do not use these C directly, use the common plotter routines. C C David Villeneuve C Division of Physics M23A C National Research Council C Ottawa Ont. K1A 0R6 C 613-993-1288 C SUBROUTINE TKDRAW (IX, IY) C C DRAWS A VECTOR FROM THE CURRENT PEN POSITION TO LOCATION (IX,IY) C IN TEKTRONIX UNITS. IF THIS CALL IS PRECEEDED BY A BYTE, C THE PEN WILL BE RAISED FIRST, AND NO VECTOR WILL BE DRAWN. C TEK UNITS ARE SUCH THAT THE UPPER RIGHT POINT IS (1023,779). C DATA IYHOLD, IYLOLD, IXHOLD / 3*-1 / C IX0 = MAX0( 0, MIN0( IX, 1023 ) ) IY0 = MAX0( 0, MIN0( IY, 779 ) ) C IYL = MOD(IY0,32) !LOW ORDER 5 BITS OF Y IYH = (IY0-IYL)/32 !HIGH ORDER 5 BITS OF Y IXL = MOD(IX0,32) !LOW ORDER 5 BITS OF X IXH = (IX0-IXL)/32 !HIGH ORDER 5 BITS OF X C C SEND ONLY THOSE PARTS OF THE ADDRESS WHICH HAVE NOT CHANGED, C EXCEPT THAT IF YOU SEND HIGH X YOU MUST SEND LOW Y FIRST. C IF (IYH .NE. IYHOLD) CALL TKBUF (IYH+32) IF (IYL .NE. IYLOLD .OR. IXH .NE. IXHOLD) CALL TKBUF (IYL+96) IF (IXH .NE. IXHOLD) CALL TKBUF (IXH+32) CALL TKBUF (IXL+64) !ALWAYS SEND LOW X C C REMEMBER LAST LOCATION SENT C IYHOLD = IYH IYLOLD = IYL IXHOLD = IXH RETURN END SUBROUTINE TKMOVE (IX, IY) C C MOVE PEN TO LOCATION (IX,IY) IN TEKTRONIX UNITS, BUT DO NOT DRAW VECTOR. C CALL TKBUF ("35) ! TO LIFT PEN CALL TKDRAW (IX, IY) !MOVE PEN RETURN END SUBROUTINE TKPUTC (IX, IY, ICHAR) C C PLACES AN ASCII CHARACTER AT THE INDICATED LOCATION ON C THE SCREEN. C NO CHECKING OR WINDOWING IS DONE AT THIS LEVEL. C BYTE ICHAR CALL TKMOVE (IX, IY) CALL TKBUF ("37) ! TO GO TO ALPHA MODE CALL TKBUF (ICHAR) !PRINT CHAR RETURN END SUBROUTINE TKSTR (STRING, NCHARS, IX, IY) C C DISPLAYS THE LINE OF ASCII TEST IN ON THE SCREEN. C THE NUMBER OF CHARACTERS TO BE DISPLAYED IS DETERMINED BY , C OR BY THE OCCURRENCE OF THE FIRST ZERO BYTE IN STRING. C SPECIAL CHARACTERS: C CR - MOVES POSITION TO LEFT SIDE OF CURRENT LINE. C LF - MOVES POSITION TO NEXT LINE, VERTICALLY. C FF - STARTS AT TOP LEFT HAND CORNER. C BYTE STRING (80) C ICX = MAX0( 0, MIN0( IX, 1023 ) ) ICY = MAX0( 0, MIN0( IY, 779 ) ) DO 40 J=1, NCHARS IF (STRING(J) .EQ. 0) RETURN IF (STRING(J) .EQ. "015) GO TO 10 IF (STRING(J) .EQ. "012) GO TO 20 IF (STRING(J) .EQ. "014) GO TO 30 CALL TKPUTC (ICX, ICY, STRING(J)) ICX = ICX + 16 IF (ICX .LE. 1023) GO TO 40 ICX = 0 ICY = ICY - 25 IF (ICY .LT. 0) ICY = 760 GO TO 40 C C CARRIAGE RETURN C 10 ICX = 0 GO TO 40 C C LINE FEED C 20 ICY = ICY - 25 IF (ICY. LT. 0) ICY = 760 GO TO 40 C C FORM FEED C 30 ICX = 0 ICY = 760 GO TO 40 C 40 CONTINUE RETURN END SUBROUTINE TKCLEA C C CLEAR THE SCREEN OF THE TEK TERMINAL, LEAVE IN ALPHA MODE. C CALL TKBUF ("35) ! TO GO TO ALPHA MODE CALL TKBUF ("33) !ESCAPE CALL TKBUF ("14) !FORM FEED CALL TKBUF ("37) ! TO GO BACK TO ALPHA MODE RETURN END SUBROUTINE TKINIT C C MUST BE CALLED BEFORE ANY TEKTRONIX SUBOUTINES ARE USED. C INITIALIZES THE BUFFERS. C CALL TKFLUS !LET FLUSH RESET BUFFER POINTER CALL TKBUF ("035) ! TO GO TO ALPHA MODE CALL TKBUF ("15) ! TO TERMINATE IT RETURN END SUBROUTINE TKBUF (CHAR) C C PLACES A SINGLE CHARACTER INTO THE TK OUTPUT BUFFER. C THIS MAY CAUSE THE BUFFER TO BE FLUSHED. C BYTE BUFFER(120), CHAR COMMON /TKCOMX/ BUFFER, IPTR, IBUF, CURANG C IF (IPTR .GE. 120) CALL TKFLUS IPTR = IPTR + 1 BUFFER(IPTR) = CHAR RETURN END SUBROUTINE TKFLUS C C SENDS THE CHARACTERS WHICH HAVE COLLECTED IN THE BUFFER C TO THE TEKTRONIX TERMINAL, RESETS THE BUFFER POINTER. C INTEGER PARM(6) BYTE BUFFER(120), CHAR COMMON /TKCOMX/ BUFFER, IPTR, IBUF, CURANG C IF (IPTR .LE. 0) GO TO 20 C C THE FOLLOWING IS THE RSX-11M VERSION. C THE TERMINAL SHOULD BE SET WITH SET TERM/NOWRAP. C CALL GETADR (PARM(1), BUFFER(1)) PARM(2) = IPTR !NUMBER OF BYTES TO OUTPUT PARM(3) = 0 !NO CARRIAGE CONTORL CALL WTQIO (256+"10, 5, 5,,, PARM) !IO.WAL FUNCTION C C THE FOLLOWING IS THE VAX CODE. C C WRITE (5,10) 0, (BUFFER(K), K=1,IPTR) C10 FORMAT (A1, 120A1) C C C 20 IPTR = 0 RETURN END