C C THESE are the common level plotter subroutines for the HP7221 plotter. C C David Villeneuve C Division of Physics M23A C National Research Council C Ottawa Ont. K1A 0R6 C 613-993-1288 C SUBROUTINE PLOT (X, Y, L) C C [MOVE PEN] C (X, Y) DESTINATION OF PEN, IN INCHES. C L RAISE OR LOWER PEN. C L=1 NO CHANGE IN PEN STATUS C L=2 LOWER PEN BEFORE MOVEMENT C L=3 RAISE PEN BEFORE MOVEMENT C L<0 HAS SAME EFFECT AS IABS(L), EXCEPT THAT THE DESTINATION C BECOMES THE NEW ORIGIN. C C THIS ROUTINE ALSO CHECKS FOR PROPER RANGE OF X AND Y, TO FIT ON THE 15 BY 11 C INCH PAGE. HOWEVER THE WINDOWING IS DONE AT A HIGHER LEVEL. C C THE VALUES OF X AND Y ARE IN INCHES, RELATIVE TO THE CURRRENT ORIGIN C (XORG, YORG). (XS,YS) IS IN INCHES, RELATIVE TO THE LOWER LEFT HAND C CORNER. (XP,YP) IS IN HP PLOTTING UNITS. C LOGICAL MOVED COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT DATA MOVED /.FALSE./ C LABS = IABS(L) XS = X + XORG YS = Y + YORG C IF (XS .LT. 0.0) XS = 0.0 IF (XS .GT. 15.0) XS = 15.0 IF (YS .LT. 0.0) YS = 0.0 IF (YS .GT. 10.0) YS = 10.0 C XP = XS * XSCALE YP = YS * YSCALE C C L = 2 -- DRAW A LINE C IF (.NOT.(LABS .EQ. 2 .OR. (LABS.EQ.1 .AND. LPREV.EQ.2))) GO TO 10 IF (IPEN .NE. IPENC .AND. MOVED) CALL HPMOVE (1800.0, 0.0) IF (IPEN .NE. IPENC) CALL HPPEN (IPEN) !CHANGE PEN IPENC = IPEN IF (MOVED) CALL HPMOVE (XMOVE, YMOVE) CALL HPDRAW (XP, YP) MOVED = .FALSE. C C L = 3 -- MOVE PEN (LOGICAL ONLY, SAVE REAL MOVE TILL L=2) C 10 IF (.NOT.(LABS .EQ. 3 .OR. (LABS.EQ.1 .AND. LPREV.EQ.3))) GO TO 20 XMOVE = XP YMOVE = YP MOVED = .TRUE. C 20 IF (LABS .EQ. 2 .OR. LABS .EQ. 3) LPREV = LABS IF (L .GE. 0) GO TO 30 XORG = X + XORG YORG = Y + YORG 30 RETURN END SUBROUTINE PLOTS (I) C C [INITIALIZE PLOTTER] C C MUST BE CALLED INITIALLY IN EVERY PROGRAM WHICH USES THE HP PLOTTER. C IT SETS UP THE ORIGIN TO THE LOWER LEFT, EMPTIES THE BUFFER, ETC. C IT MAY BE CALLED LATER ON DURING THE PROGRAM WITHOUT LOSS OF DATA. C IT ALSO ASKS THE USER TO SET THE SCALE AND SPEED, IF DESIRED. C COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT XORG = 0.0 YORG = 0.0 XSCALE = 200.0 YSCALE = 200.0 LPREV = 3 CSIZE = 0.0 CANGLE = 1000.0 IPEN = 0 IPENC = 0 5 WRITE (5,10) 10 FORMAT (' PLOTS -- Enter options', 1 ' (? for help, control-Z to quit): ', $) READ (5,20,ERR=50,END=100) SCALE, SPEED 20 FORMAT (2F15.0) CALL HPINIT CALL HPLSLA (85.0) IF (SCALE .EQ. 0.0) SCALE = 0.75 XSCALE = XSCALE * SCALE YSCALE = YSCALE * SCALE 30 IF (SPEED .GT. 0.0) CALL HPSPEE (SPEED) RETURN C C PROMPT GIVEN WHEN HE ENTERS "?" C 50 WRITE (5,60) 60 FORMAT (' You may enter the scale factor by which to scale the plot;'/ 1 ' a scale factor of 1.0 gives a (12,10) inch plot.'/ 2 ' You may also enter the plotting speed, in cm/s [1-36].'/ 3 ' Use a slower speed for final plots.'/ 4 ' Enter both numbers, separated by commas, on the line.'/ 5 ' For default values of 0.75,36, just press .') GO TO 5 C C HE ENTERED CONTROL-Z IN RESPONSE C 100 CALL EXIT END SUBROUTINE PLOTF C C [TERMINATE PLOTTING] C CALLED TO TERMINATE PLOTTING. EMPTIES THE BUFFER. C COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT CALL HPMOVE (2400.0, 0.0) !NEAR PEN STALLS CALL HPPEN (0) !DROP PEN IPENC = 0 CALL HPMOVE (3000.0, 0.0) !NEAR SENSING STALL CALL HPROTA (0.0) !FORCE BACK TO HORIZONTAL CALL HPOFL !TURN PLOTTER OFFLINE WRITE (1,10) 0 10 FORMAT (A1, '*') !PLOTTER SWALLOWS FIRST CHARACTER AFTER PLOT RETURN END SUBROUTINE SYMBOC (X, Y, HEIGHT, TEXT, ANGLE, NCHARS, ICENTR) C C PLOTS A CHARACTER STRING WITH CHARACTER HEIGHT IN INCHES, C AT DEGREES COUNTERCLOCKWISE FROM THE POSITIVE X-AXIS. C IS THE MAXIMUM NUMBER OF CHARACTERS IN , BUT A ZERO C BYTE WILL ALSO TERMINATE THE STRING. =-1 FOR LEFT JUSTIFIED C TEXT, =0 FOR CENTERED AND +1 FOR RIGHT JUSTIFIED. X,Y IS THE STARTING C LOCATION IN INCHES, AND THE STRING IS POSITIONED ABOUT THIS POINT C DEPENDING ON THE VALUE OF . C BYTE TEXT(1) IF (NCHARS .EQ. 0) RETURN CALL SYMLEN (TEXT, NCHARS, HEIGHT, XLEN) SHIFT = 0.0 !ASSUME LEFT JUSTIFIED IF (ICENTR .EQ. 0) SHIFT = 0.5*XLEN IF (ICENTR .EQ. 1) SHIFT = XLEN XPOS = X - SHIFT*COS(ANGLE/57.3) YPOS = Y - SHIFT*SIN(ANGLE/57.3) CALL SYMBOL (XPOS, YPOS, HEIGHT, TEXT, ANGLE, NCHARS) RETURN END SUBROUTINE SYMBOL (X, Y, HEIGHT, TEXT, ANGLE, NCHARS) C C [SYMBOL] C C STANDARD VARIAN TYPE ROUTINE WHICH WRITES A CHARACTER STRING. C C X,Y = POSITION IN INCHES FROM THE CURRENT ORIGIN WHERE THE LOWER LEFT C CORNER OF THE FIRST CHARACTER IS TO BE PLACED. C HEIGHT = HEIGHT OF THE CHARACTERS, IN INCHES. C TEXT = CHARACTER STRING CONTAINING THE CHARACTERS TO BE DRAWN. C ANGLE = ANGLE AT WHICH THE TEXT IS TO BE DRAWN, MEASURED COUNTERCLOCKWISE C FROM THE POSITIVE X AXIS. C NCHARS = NUMBER OF CHARACTERS IN TEXT. TEXT MAY ALSO CONTAIN A ZERO BYTE C TO SIGNIFY THE END OF THE STRING, IN WHICH CASE NCHARS IS SET TO C A LARGE NUMBER. C IF NCHAR=-1 OR -2, THE BYTE VALUE OF TEXT(1) IS USED AS THE CODE C FOR THE SPECIAL SYMBOL TO BE PLOTTED CENTERED AT X-Y. C SEE SYMBOS FOR WHAT SYMBOLS ARE AVAILABLE. C IF NCHARS=-1 THE SYMBOL IS DRAWN, IF NCHARS=-2 A LINE IS C FIRST DRAWN TO X-Y THEN THE SYMBOL DRAWN. C BYTE TEXT(1) COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT C IF (NCHARS .LT. 0) GO TO 200 CSPACE = XSCALE * HEIGHT IF (CSIZE .NE. HEIGHT) CALL HPLSIZ (CSPACE, CSPACE*2.0) IF (CANGLE .NE. ANGLE) CALL HPROTA (ANGLE) CSIZE = HEIGHT CANGLE = ANGLE IF (IPEN .EQ. IPENC) GO TO 20 CALL HPMOVE (1800.0, 0.0) !NEAR STALLS CALL HPPEN (IPEN) 20 IPENC = IPEN 50 XP = (X+XORG) * XSCALE YP = (Y+YORG) * YSCALE CALL HPSTR (TEXT, NCHARS, XP, YP) RETURN C C SPECIAL PLOTTING SYMBOLS C 200 IF (NCHARS .EQ. -2) CALL PLOT (X, Y, 2) CALL SYMBOS (X, Y, HEIGHT, TEXT) IF (NCHARS .EQ. -2) CALL PLOT (X, Y, 3) RETURN END SUBROUTINE SYMLEN (TEXT, NCHARS, SIZE, XLEN) C C CALCULATES PLOTTING LENGTH OF THE CHARACTER STRING C OF MAXIMUM LENGTH USING PLOTTING HEIGHT C IN INCHES, AND SETS XLEN TO THE LENGTH IN INCHES. C NOTE THAT THIS IS THE HARDWARE CHARACTER SET VERSION, C SO IT IS NOT VERY ACCURATE. C BYTE TEXT(1) XLEN = 0.0 IF (NCHARS .LE. 0) RETURN DO 10 J=1,NCHARS IF (TEXT(J) .EQ. 0) RETURN XLEN = XLEN + SIZE 10 CONTINUE RETURN END SUBROUTINE NUMBER (X, Y, HEIGHT, FNUM, ANGLE, NDEC) C C DRAWS A DECIMAL NUMBER AT LOCATION X,Y. C C X,Y = POSITION IN INCHES FROM THE CURRENT ORIGIN WHERE LOWER C LEFT CORNER OF FIRST CHARACTER WILL GO. C HEIGHT = HEIGHT IN INCHES OF CHARACTER. C FNUM = REAL NUMBER TO BE WRITTEN. C ANGLE = ANGLE IN DEGREES TO DRAW NUMBER, C MEASURED COUNTERCLOCKWISE FROM POSITIVE X-AXIS. C NDEC = NUMBER OF DECIMAL PLACES AFTER DECIMAL POINT [0:8]. C IF -1, WILL ONLY DRAW INTEGRAL PART, WITHOUT DECIMAL. C BYTE TEXT(15), FMT1(9), FMT2(7) DATA FMT1 / '(', '1', 'P', 'E', '1', '5', '.', '2', ')' / DATA FMT2 / '(', 'F', '1', '5', '.', '2', ')' / C C FLOATING POINT NUMBER C N = MAX0( 0, MIN0( NDEC, 8 ) ) IF (NDEC .LT. 0 .OR. FNUM .EQ. 0 .OR. 1 (ABS(FNUM) .LT. 1.0E4 .AND. ABS(FNUM) .GT. 10.0**(-N))) GO TO 100 FMT1(8) = N + "60 !FORMAT (1PE15.N) ENCODE (15, FMT1, TEXT) FNUM !ENCODE NUMBER INTO TEXT GO TO 200 C C FIXED POINT NUMBER C 100 FMT2(6) = "60 + N !FORMAT (F15.N) ENCODE (15, FMT2, TEXT) FNUM C C DROP LEADING BLANKS C 200 DO 250 J=1,15 IF (TEXT(J) .NE. "40 .AND. TEXT(J) .NE. "44) GO TO 300 250 CONTINUE C C STRIP TRAILING ZEROS AFTER DECIMAL POINT C 300 DO 350 L=15,J,-1 IF (TEXT(L) .NE. "60) GO TO 400 350 CONTINUE 400 IF (TEXT(L) .EQ. "56) L = L-1 !DROP TRAILING DECIMAL C C PLOT THE NUMBER, IN TEXT(J:L) C CALL SYMBOL (X, Y, HEIGHT, TEXT(J), ANGLE, L-J+1) RETURN END SUBROUTINE SYMTYP (IFONTP, SLANT) C C [DEFINE SYMBOL TYPE] C C DEFINES THE TYPE OF SYMBOLS TO USE WHEN THE SYMBOL ROUTINE IS CALLED. C THE HARDWARE CHARACTER SET OF THE PLOTTING DEVICE IS USED BY DEFAULT, C BUT SOFTWARE CHARACTER SETS MAY BE SPECIFIED AS FOLLOWS: C C IFONTP = 0 DEFAULT HARDWARE CHARACTER SET C IFONTP = 51 ENHANCED STICK CHARACTERS C IFONTP = 52 SCRIPT CHARACTERS C IFONTP = 53 TRIPLEX ROMAN CHARACTERS C IFONTP = 54 GOTHIC CHARACTERS C C SEE THE HP PLOT/21 MANUAL, APPENDIX B, FOR SAMPLES OF THESE SETS. C C DEFINES THE ANGLE IN DEGREES FROM THE VERTICAL THAT ALL SUCCEEDING C CHARACTERS ARE TO BE SLANTED AT. C COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT C IFONT = IFONTP CALL HPLSLA (90.0 - SLANT) CSLANT = SLANT RETURN END SUBROUTINE NEWPEN (IPEN1) C C CHANGES THE PEN IN CURRENT USE. IPEN1 IS IN RANGE 0-4, WHERE 1-4 ARE THE C FOUR PEN COLOURS AVAILABLE, AND 0 MEANS PUT AWAY THE CURRENT PEN. C NOTE THAT THE PEN IS NOT ACTUALLY CHANGED UNTIL AN ATTEMPT IS MADE TO C DRAW WITH THE NEW COLOUR, TO PREVENT UNNECESSARY PEN MOVEMENTS. C COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT C IPEN = IPEN1 IF (IPEN1 .LT. 0) IPEN = 0 IF (IPEN1 .GT. 4) IPEN = 4 RETURN END SUBROUTINE UNPLOT (X, Y, ICHAR, IWAIT) C C READ BACK LOCATION OF PEN IN DIGITIZING MODE. C THE ENTER LIGHT ON THE PLOTTER WILL FLASH AND THE USER CAN POSITION C THE PEN WITH FRONT PANEL CONTROLS, THEN PRESS ENTER. THE LOCATION C IS RETURNED IN X AND Y IN INCHES, USING THE CURRENT ORIGIN AND C SCALE FACTORS AS USED IN THE REVERSE DIRECTION BY PLOT. C NOTE THAT PLOTS MUST BE CALLED FIRST TO INITIALIZE THE PLOTTER, C AND THE PLOTF MUST BE CALLED AFTER THE LAST UNPLOT CALL. C NO PRINTING TO THE TERMINAL MAY OCCUR BETWEEN THE PLOTS AND THE C PLOTF CALLS. C NOTE THAT ICHAR AND IWAIT ARE IGNORED IN THIS IMPLEMENTATION. C COMMON /VARIAN/ XSCALE, YSCALE, XORG, YORG, LPREV, CSIZE, CANGLE, 1 IPEN, IPENC, IFONT, CSLANT C CALL HPDIGZ (XP, YP) X = XP/XSCALE - XORG Y = YP/YSCALE - YORG RETURN END SUBROUTINE PLOTNM (FILENM, ICODE) C C Dummy routine to match the one used in the PFLIB version, C which specifies the name of an output plot file. C For this library, this subroutine has no effect C BYTE FILENM(40) RETURN END