C C These are the lower level routines for operating the HP7221 plotter. C Don't use these directly, use the common plotter routines instead. C C C David Villeneuve C Division of Physics M23A C National Research Council C Ottawa Ont. K1A 0R6 C 613-993-1288 C SUBROUTINE HPFLUS C C SENDS THE CONTENTS OF THE OUR INTERNAL BUFFER TO THE HP PLOTTER C ON UNIT 1. SWITCHES TO THE OTHER INTERNAL BUFFER. C INTEGER PARM(6) BYTE BUFFER(240), TEXT(10) COMMON /HPCOMX/ BUFFER, IPTR, IBUF, IOFF, CURANG C C IF BUFFER EMPTY WAIT FOR PREVIOUS QIO TO FINISH C IF (IPTR .GT. 0) GO TO 10 TEXT(1) = "12 TEXT(2) = "15 CALL GETADR (PARM(1), TEXT) PARM(2) = 2 CALL WTQIO ("22*256, 1, 1,,, PARM) !DUMMY WRITE TO FORCE WAIT RETURN C C ASK IF THERE IS ROOM IN THE HP PLOTTER'S HARDWARE BUFFER. C NOTE THAT HPOREQ IMPLICITLY WAITS FOR THE PREVIOUS QIO TO FINISH. C 10 CALL HPOREQ ('B', 1, ISIZE) !SEE IF THERE IS ROOM IF (ISIZE .GT. 120) GO TO 20 !IF GT YES CALL WAIT (1, 2, IDS) !WAIT ONE SECOND GO TO 10 !TRY AGAIN C C PUT TOGETHER QIO REQUEST AND QUEUE IT, BUT DON'T WAIT FOR COMPLETION C 20 CALL GETADR (PARM(1), BUFFER(IBUF+1)) PARM(2) = IPTR CALL QIO ("22*256, 1,,,, PARM) IBUF = IBUF + 120 IF (IBUF .GT. 120) IBUF = 0 IPTR = 0 RETURN END SUBROUTINE HPBUF (CHAR) C C PLACES A SINGLE CHARACTER INTO THE HP OUTPUT BUFFER. C THIS MAY CAUSE THE BUFFER TO BE FLUSHED. C BYTE BUFFER(240), CHAR COMMON /HPCOMX/ BUFFER, IPTR, IBUF, IOFF, CURANG C IF (IPTR .GE. 120) CALL HPFLUS IPTR = IPTR + 1 BUFFER(IPTR+IBUF) = CHAR RETURN END SUBROUTINE HPMOVE (X, Y) C C CAUSES THE PEN TO BE RAISED AND MOVED TO POSITION X,Y IN HP INTERNAL UNITS C CALL HPBUF ('p') CALL HPMBP (X, Y) RETURN END SUBROUTINE HPDRAW (X, Y) C C CAUSES THE PEN TO BE LOWERED AND MOVED TO POSITION X,Y IN HP INTERNAL UNITS C CALL HPBUF ('q') CALL HPMBP (X, Y) RETURN END SUBROUTINE HPSTR (STRING, NCHARS, X, Y) C C DRAWS THE CHARACTERS IN STRING AT POSITION X,Y IN HP INTERNAL UNITS. C THE LENGTH OF THE STRING MAY BE GIVEN BY NCHARS, OR A ZERO BYTE MAY MARK C THE END OF THE STRING, IN WHICH CASE NCHARS SHOULD BE SET TO A LARGE C NUMBER C BYTE STRING(1) CALL HPMOVE (X, Y) CALL HPBUF ('~') CALL HPBUF ('''') DO 10 J=1,NCHARS IF (STRING(J) .EQ. 0) GO TO 20 10 CALL HPBUF (STRING(J)) 20 CALL HPBUF (3) !SEND ETX RETURN END SUBROUTINE HPROTA (ANGLE) C C CAUSES ALL SUCCEEDING LABELS AND INCREMENTAL MOVES TO BE ROTATED BY ANGLE. C ANGLE IS IN RANGE [0,360], MEASURED COUNTERCLOCKWISE FROM THE POSITIVE C X AXIS. THE ACTUAL HP ROTATE INSTRUCTION PERFORMS AN INCREMENTAL CHANGE C IN THE ROTATION ANGLE, I.E. ASKING TO ROTATE BY 0 DEGREES HAS NO EFFECT. C THIS SUBROUTINE CHANGES THAT INTO AN ABSOLUTE ROTATION, SO ROTATING TO 0 C ALWAYS MAKES LABELS READ LEFT TO RIGHT. C BYTE BUFFER(240) COMMON /HPCOMX/ BUFFER, IPTR, IBUF, IOFF, CURANG C A = ANGLE - CURANG 10 IF (A .GE. 0.0) GO TO 20 A = A + 360.0 GO TO 10 20 CALL HPBUF ('w') CALL HPMBA (AMAX1(0.0, AMIN1(A, 359.995))) CURANG = ANGLE 30 IF (CURANG .GE. 0.0) RETURN CURANG = CURANG + 360.0 GO TO 30 END SUBROUTINE HPLSIZ (WIDTH, HEIGHT) C C CHANGES THE HEIGHT AND SPACING FOR ALL SUCCEEDING LABELS. THE WIDTH AND C HEIGHT ARE DEFINED IN HP UNITS, NORMALLY 25 AND 50 RESPECTIVELY. THE WIDTH C IS THE SPACING BETWEEN CHARACTERS, WHICH IS 1.5 TIMES THE ACTUAL CHARACTER C WIDTH. THE HEIGHT IS THE SPACING BETWEEN CHARACTER LINES, TWICE THE ACTUAL C CHARACTER HEIGHT. A VALUE OF ZERO MEANS DON'T CHANGE IT. C CALL HPBUF ('~') CALL HPBUF ('%') CALL HPMBP (AMAX1(0.0, WIDTH), AMAX1(0.0, HEIGHT)) RETURN END SUBROUTINE HPLSLA (ANGLE) C C THIS CAUSES ALL SUCCEEDING LABELS TO BE DRAWN WITH CHARACTERS SLANTED C BY ANGLE TO THE LEFT, WHERE ANGLE IS MEASURED COUNTERCLOCKWISE FROM THE C POSITIVE X AXIS. STANDARD SLANT IS 90, < 90 IS TO THE RIGHT, > 90 IS C TO THE LEFT. C A = ANGLE IF (ANGLE .LT. 0.0) A = ANGLE + 360.0 CALL HPBUF ('~') CALL HPBUF ('/') CALL HPMBA (AMAX1(0.0, AMIN1(A, 359.995))) RETURN END SUBROUTINE HPFONT (ISTD, IALT) C C CHANGES THE STANDARD AND ALTERNATE CHARACTER FONTS. CHARACTERS SETS ARE C IN THE RANGE [0,5], AND ARE SHOWN IN THE HP PLOTTER MANUAL. C CALL HPBUF ('~') CALL HPBUF ('P') F1 = MAX0(0, MIN0(ISTD, 5)) F2 = MAX0(0, MIN0(IALT, 5)) CALL HPMBP (F1, F2) RETURN END SUBROUTINE HPIMOV (X,Y) C C GENERATES AN INCREMENTAL MOVE FROM THE CURRENT POSITION. X AND Y ARE C IN HP PLOTTING UNITS, RELATIVE TO THE CURRENT POSITION, IN THE RANGE C [-16383, 16383]. C CALL HPBUF ('r') CALL HPPMB (X, Y) RETURN END SUBROUTINE HPIDRA (X,Y) C C GENERATES AN INCREMENTAL DRAW FROM THE CURRENT POSITION. X AND Y ARE C IN HP PLOTTING UNITS, RELATIVE TO THE CURRENT POSITION, IN THE RANGE C [-16383,16383]. C CALL HPBUF ('s') CALL HPPMB (X, Y) RETURN END SUBROUTINE HPSPEE (SPEED) C C DEFINES THE PLOTTING SPEED IN CM/S, IN THE RANGE [1,36]. C INITIALLY IT IS 36 CM/S, BUT MAY BE SLOWED DOWN FOR FINAL PLOTS. C CALL HPBUF ('~') CALL HPBUF ('V') IS = SPEED IF (IS .LT. 1) IS = 1 IF (IS .GT. 36) IS = 36 CALL HPSBN (IS) RETURN END SUBROUTINE HPLIMI (X0, X1, Y0, Y1) C C DEFINES THE PLOTTING LIMITS IN HP MACHINE (NOT PLOTTING) UNITS. C SEE THE MANUAL FOR THE RANGES ALLOWED. THIS ALSO EFFECTS THE C APPARENT SIZE OF STUFF PLOTTED. C CALL HPBUF ('~') CALL HPBUF ('W') CALL HPMBP (X0, Y0) CALL HPMBP (X1, Y1) RETURN END SUBROUTINE HPSCAL (XMAX, YMAX) C C DEFINES NEW SCALE FACTORS INSIDE THE PLOTTER, SUCH THAT IN THE NEW UNITS, C THE UPPER RIGHT HAND PLOTTING LIMIT HAS COORDINATES (XMAX, YMAX). C THE LOWER LEFT PLOTTING LIMIT ALWAYS HAS COORDINATES (0,0). C INITIALLY THE UPPER RIGHT POINT IS (3040, 2000). C CALL HPBUF ('~') CALL HPBUF ('S') CALL HPMBP (XMAX, YMAX) RETURN END SUBROUTINE HPINIT C C THIS INITIALIZES THE HP PLOTTING ROUTINES AND CONDITIONS THE PLOTTER C TO ACCEPT WHAT IS COMING. C INTEGER PARM(6) BYTE BUFFER(240) COMMON /HPCOMX/ BUFFER, IPTR, IBUF, IOFF, CURANG C CALL ASNLUN (1, 'TI', 0) !USED TO USE HP:, NOW USE TI: IOFF = 0 !PRETEND ON LINE CALL HPFLUS !MAKE SURE BUFFER IS EMPTY C C TURN PLOTTER ON LINE, AND SET OUTPUT MODE AS FOLLOWS: C TURN AROUND DELAY = 100 MS C OUTPUT TRIGGER = 0 (NOT USED) C ECHO TERMINATOR = CR C OUTPUT TERMINATOR = CR C ENCODE (18, 10, BUFFER) "33, "56, "50, "33, "56 10 FORMAT (5A1, 'M100;0;13;13:') CALL GETADR (PARM(1), BUFFER) PARM(2) = 18 !SAME NUMBER AS IN ENCODE CALL WTQIO ("22*256, 1, 1,,, PARM) C C SET EXTENDED OUTPUT AND HANDSHAKE MODE: C INTER CHARACTER DELAY = 20 MS C IMMEDIATE RESPONSE STRING = NULL (NOT USED) C ENCODE (8, 20, BUFFER) "33 20 FORMAT (A1, '.N20;0:') PARM(2) = 8 !SAME NUMBER AS IN ENCODE CALL WTQIO ("22*256, 1, 1,,, PARM) CALL HPFONT (0, 5) !FONT 0 STANDARD, FONT 5 ALTERNATE RETURN END SUBROUTINE HPOFL C C TURNS THE PLOTTER OFFLINE. C THIS IS ONLY NECESSARY IF A TERMINAL IS CONNECTED THROUGH C THE PLOTTER, AND ENABLES THE TERMINAL TO BE USED AFTER C PLOTTING HAS FINISHED. C COMMON /HPCOMX/ BUFFER, IPTR, IBUF, IOFF, CURANG C CALL HPFLUS !MUST FINISH FIRST CALL HPFLUS CALL HPBUF ("33) CALL HPBUF ('.') CALL HPBUF (')') CALL HPFLUS CALL HPFLUS IOFF = 1 !SAY IT IS OFFLINE RETURN END SUBROUTINE HPPEN (IPEN) C C CHANGES THE PEN ON THE HP PLOTTER. C IPEN = 1-4 FOR THE FOUR PEN COLOURS AVAILABLE. C IF IPEN = 0, THE PEN IN CURRENT USE IS PUT AWAY. C IPEN1 = IPEN IF (IPEN .LT. 0) IPEN1 = 0 IF (IPEN .GT. 4) IPEN1 = 4 CALL HPBUF ('v') CALL HPBUF (IPEN1 + 64) RETURN END SUBROUTINE HPDIGZ (X, Y) C C RETURNS THE (X,Y) COORDINATE OF THE POINT BEING DIGITIZED, IN CURRENT C PLOTTER UNITS. THE BUFFER IS FLUSHED, AND IT WAITS UNTIL THE HP'S C PLOTTER BUFFER IS EMPTY, BEFORE ASKING FOR THE COORDINATES. C INTEGER IXY(2) CALL HPFLUS CALL HPOREQ ('L', 1, ISIZE) CALL HPOREQ ('D', 2, IXY) X = IXY(1) Y = IXY(2) RETURN END SUBROUTINE HPMBP (X, Y) C C CONVERTS THE POSITION X,Y IN HP INTERNAL PLOTTING UNITS, INTO MBP FORMAT, C AND PLACES THE CONVERTED CHARACTERS INTO THE BUFFER. C BYTE IBUF(6) X1 = X Y1 = Y IF (X .LT. 0.0) X1 = 0.0 IF (Y .LT. 0.0) Y1 = 0.0 IF (X .GT. 16383.0) X1 = 16383.0 IF (Y .GT. 16383.0) Y1 = 16383.0 NX = IFIX(X + 0.5) NY = IFIX(Y + 0.5) C C SET INDEX FOR NUMBER OF SIGNIFICANT BITS IN LARGEST VALUE C IDELTA = MAX0(NX, NY) INDEX = 2 IF (IDELTA .GT. 3) INDEX = 5 IF (IDELTA .GT. 31) INDEX = 8 IF (IDELTA .GT. 255) INDEX = 11 IF (IDELTA .GT. 2047) INDEX = 14 IY = INDEX IX = INDEX C C CONVERT THE X,Y VALUES INTO MBP FORMAT, STARTING WITH THE LSB OF C THE Y-VALUE. NYBITS, NXBITS ARE THE NUMBER OF BITS OF Y,X C WHICH ARE BEING PACKED INTO THE CURRENT BYTE. IY,IX ARE THE C NUMBER OF BITS OF Y,X REMAINING TO BE PROCESSED. C NBYTES = (INDEX+1) / 3 DO 100 I=1,NBYTES L = NBYTES + 1 - I NYBITS = MIN0(6, IY) NXBITS = MIN0(MIN0(6,IX), 6-NYBITS) NYP = 2**NYBITS NXP = 2**NXBITS NINT = NY - NY/NYP*NYP + (NX - NX/NXP*NXP) * NYP * MIN0(1,NXBITS) NY = NY / NYP NX = NX / NXP IY = IY - NYBITS IX = IX - NXBITS IBUF(L) = NINT IF (NINT .LT. 32) IBUF(L) = NINT + 64 100 CONTINUE IBUF(L) = NINT + 96 DO 200 J=1,NBYTES 200 CALL HPBUF (IBUF(J)) RETURN END SUBROUTINE HPSBN (INT) C C CONVERTS AN INTEGER TO HP'S SBN FORMAT, AND PLACES IT IN THE BUFFER C INT1 = INT IF (INT .LT. 0) INT1 = 0 IF (INT .GT. 63) INT1 = 63 IF (INT1 .LT. 32) INT1 = INT1 + 64 CALL HPBUF (INT1) RETURN END SUBROUTINE HPPMB (X, Y) C C CONVERTS A PAIR OF REAL NUMBERS IN THE RANGE [-16383, 16383] TO C A SERIES OF BYTES IN HP'S PMB FORMAT. THE BYTES ARE PUT IN THE BUFFER. C BYTE IBUF(10) ITYPE = 1 XA = 0.5 IF (X .LT. 0.0) XA = -0.5 NVALUE = IFIX(X+XA) C C CALCULATE NUMBER OF BYTES NEEDED FOR X OR Y PMB FORMAT C 50 NOPTS = 1 IF ((NVALUE .LT. -16) .OR. (NVALUE .GT. 15)) NOPTS = 2 IF ((NVALUE .LT. -512) .OR. (NVALUE .GT. 511)) NOPTS = 3 IF (NVALUE .LT. -16384) NVALUE = -16384 IF (NVALUE .GT. 16383) NVALUE = 16383 C C IF NEGATIVE NUMBER, CALCULATE TWO'S COMPLEMENT EQUIVALENT C IF (NVALUE .GE. 0) GO TO 200 NCOMP = (16**NOPTS) * (2**(NOPTS-1)) NVALUE = NVALUE + NCOMP C C CONVERT THE VALUE TO PMB FORMAT, STARTING WITH THE L.S.B. C 200 DO 210 I=1,NOPTS L = NOPTS + 1 - I NINT = NVALUE - NVALUE/32*32 NVALUE = NVALUE / 32 210 IBUF(L) = NINT + 32 + ITYPE*32 C C SEE IF FINISHED WITH BOTH HALVES OF PAIR C DO 250 I=1,NOPTS 250 CALL HPBUF (IBUF(NOPTS+1-I)) IF (ITYPE .EQ. 0) RETURN XA = 0.5 IF (Y .LT. 0.0) XA = -0.5 C C PROCESS Y VALUE C NVALUE = IFIX(Y+XA) ITYPE = 0 GO TO 50 END SUBROUTINE HPMBA (ANGLE) C C CONVERTS A REAL ANGLE IN THE RANGE [0,359.995] TO HP'S MBA FORMAT, C AND ENTERS THE BYTES IN THE BUFFER. C FRACT = 0.0054931640625 !SMALLEST ANGLE REPRESENTABLE A = ANGLE A = A - (AINT(ANGLE/360.0)) * 360.0 IF (A .LT. 0.0) A = A + 360.0 C C GENERATE FIRST (MS) BYTE OF MBA FORMAT C INT = A / 22.5 A = A - INT * 22.5 CALL HPBUF (INT+96) IF (A .LT. FRACT) RETURN C C GENERATE SECOND BYTE C INT = A / 0.3515625 A = A - INT * 0.3515625 IF (INT .LT. 32) INT = INT + 64 CALL HPBUF (INT) IF (A .LT. FRACT) RETURN C C GENERATE THIRD BYTE C INT = A / FRACT IF (INT .LT. 32) INT = INT + 64 CALL HPBUF (INT) RETURN END SUBROUTINE HPOREQ (IREQ, NRESP, INT) C C SENDS AN OUTPUT REQUEST TYPE IREQ TO THE PLOTTER, AND SETS THE NRESP C ELEMENTS OF INT TO THE NRESP RESPONSES SENT BY THE PLOTTER. C INTEGER INT(1), PARM(6), IOSTAT(2) BYTE TEXT(40) COMMON /HPCOMX/ BUFFER, IPTR, IBUF, IOFF, CURANG C TEXT(1) = "33 TEXT(2) = "56 IF (IOFF .EQ. 0) GO TO 10 C C WAS SWITCHED OFFLINE BY HPOFL, MUST TURN ONLINE AGAIN C TEXT(3) = "50 CALL GETADR (PARM(1), TEXT) PARM(2) = 3 PARM(3) = 0 CALL WTQIO ("22*256, 1, 1,,, PARM) C C NOW DO READ-PROMPT TO ASK AND GET ANSWER C 10 TEXT(3) = IREQ PARM(2) = 40 !LENGTH OF READ CALL GETADR (PARM(4), TEXT) PARM(5) = 3 !LENGTH OF WRITE PARM(6) = 0 !CARRIAGE CONTROL = NULL CALL WTQIO ("11*256, 1, 1,, IOSTAT, PARM) !IO.RPR FUNCTION DECODE (IOSTAT(2), 20, TEXT) (INT(J), J=1,NRESP) 20 FORMAT (6I6) RETURN END