sw/rescue/lab8e_goettingen/disk2_11/rka/paroff/plot2.ft

   1         SUBROUTINE PLOT(X,Y,IP)
   2 C
   3 C       THIS ROUTINE IS THE HEART OF THE PLOTTING SYSTEM
   4 C
   5 C       THE CALL IS:
   6 C
   7 C       CALL PLOT(XP,YP,IPEN)
   8 C
   9 C       WHERE XP IS THE VIRTUAL X COORDANATE OF THE END POINT OF THE DESIRED
  10 C       LINE,
  11 C       WHERE YP IS THE VIRTUAL Y COORDANATE OF THE END POINT OF THE DESIRED
  12 C       LINE,
  13 C       AND IPEN IS THE PEN CONTROL PARAMETER.
  14 C
  15 C       IF THE ABSOLUTE VALUE OF IPEN IS 2, THE MOVE IS MADE WITH THE PEN DOWN,
  16 C       IF THE ABSOLUTE VALUE OF IPEN IS 3, THE MOVE IS MADE WITH THE PEN UP.
  17 C       IF THE ABSOLUTE VALUE OF IPEN IS ANYTHING ELSE, NO CHANGE IN THE PEN IS
  18 C       MADE.
  19 C       IF THE SIGN OF IPEN IS -, THE END POINT OF THE LINE DRAWN IS ASSIGNED TO
  20 C       BE THE ORIGIN, (0,0).
  21 C       IF THE SIGN OF IPEN IS +, THE ENDPOINT OF THE LINE WILL BE (XP,YP).
  22 C
  23 C       PLOT SHOULD BE CALLED ONCE TO INITIALIZE IT.
  24 C       THE CALL 'CALL PLOT(0,0,3)' WOULD SUFFICE.
  25 C
  26         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR
  27 C
  28 C       SCALE IS THE SCALE EXPRESSED IN RASTER UNITS PER VIRTUAL UNIT.
  29 C       IDEV IS A DEVICE SELECTION FLAG.
  30 C       IPEN IS THE CURRENT IPEN PARAMETER
  31 C       XCUR IS THE CURRENT VIRTUAL X COORDANATE IN RASTER UNITS.
  32 C       YCUR IS THE CURRENT VIRYUAL Y COORDANATE IN RASTER UNITS.
  33 C
  34         DATA XCUR,YCUR/0.,0./
  35         DATA IDEV,SCALE/1,200./
  36 C
  37 C       DEFAULT VALUES ARE SCALE=1, ANGLE=0, PEN AT (0,0).
  38 C
  39         XT=IFIX(X*SCALE)
  40         YT=IFIX(Y*SCALE)
  41 C
  42 C       CALCULATIONS ARE DONE IN RASTER UNITS TO AVOID ROUND OFF ERROR
  43 C
  44         CALL DELTAP(XT-XCUR,YT-YCUR,IABS(IP))
  45         IF(IP)23,25,25
  46 25      XCUR=XT
  47         YCUR=YT
  48 C
  49 C       IPEN POSATIVE MEANS END POINT AS SPECIFIED PLUS/MINUS ONE RASTER UNIT
  50 C
  51         RETURN
  52 23      XCUR=0.
  53         YCUR=0.
  54 C
  55 C       IPEN NEGATIVE MEANS END POINT IS NEW ORIGIN
  56 C
  57         RETURN
  58         END
  59 \f       SUBROUTINE SYMBOL(X,Y,HGT,BCD,ANGD,N)
  60 C
  61 C       THIS IS THE SYMBOL DRAWING SUBROUTINE.
  62 C
  63 C       X AND Y SPECIFY THE POSITION AT WHICH THE SYMBOL IS TO BE DRAWN.
  64 C       HGT IS THE HIGHT OF THE CHARACTERS IN VIRTUAL UNITS
  65 C       BCD CONTAINS THE CHARACTERS (S) TO BE PLOTTED
  66 C       ANGD IS THE ORIENTAION IN DEGREES RELATIVE TO THE X AXIS
  67 C       N IS A CONTROL PARAMETER.
  68 C
  69 C       THE CHARACTER AND ITS SPACE FORMS A SQUARE OF WIDTH HGT.
  70 C
  71 C       IF N > 0, N CHARACTERS IN H FORMAT ARE PLOTTED.
  72 C       IF N = 0, ONE CHARACTER IS PLOTTED WHOSE CODE IS BCD.
  73 C
  74 C       IF N >0, OR =0 , X AND Y ARE THE LOWER LEFT POINT OF THE CHARACTER.
  75 C
  76 C       IF N < 0, ONE CHARACTER WHOS CODE IS B IS PLOTTED CENTERED AROUND (X,Y
  77 C       ).
  78 C
  79         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG,ANG
  80         DATA ANG,SINA,COSA/0.,0.,1./
  81         CALL PLOT(X,Y,3)
  82 C
  83 C       FIRST GO TO THE SPECIFIED POINT
  84 C
  85         IF(ANG-ANGD)10,20,10
  86 C
  87 C       IF THE REQUESTED ANGLE IS THE SAME AS THE CURRENT ONE,
  88 C       AVOID CALCULATING THE SIN AND COSINE
  89 C
  90 10      ANG=ANGD
  91         SINA=SIND(ANG)
  92         COSA=COSD(ANG)
  93 20      SEG=HGT/6.
  94 C
  95 C       CHARACTERS ARE ON A 6X6 GRID
  96 C
  97         IF(N) 60,50,30
  98 30      DO 40 J=1,N
  99 C
 100 C       THIS LOOP PLOTS THE N CHARACTERS IN BCD.
 101 C
 102         CALL CGET(BCD,J,CHAR)
 103 40      CALL CPLOT(CHAR)
 104         RETURN
 105 50      CALL CPLOT(BCD)
 106 C
 107 C       THIS PLOTS ONE CHARACTER WHOS CODE IS BCD
 108 C
 109         RETURN
 110 60      CALL CPLOT(-BCD)
 111 C
 112 C       THIS PRODUCES A CENTERED CHARACTER.
 113 C
 114         RETURN
 115         END
 116 \f       SUBROUTINE CPLOT(CHAR)
 117
 118 C
 119 C       THIS ROUTINE DRIVES THE CHARACTER GENERATOR.
 120 C       THE ANGLE AND HIGHT HAVE ALREADY BE COMPUTED.
 121 C
 122         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG
 123         IF(CHAR)50,5,5
 124 C
 125 C       CHECK FOR CENTERED OR NORMAL CHARACTER
 126 C
 127 5       CALL WHERE(XLL,YLL)
 128 C
 129 C       SET THE LOWER LEFT OF THE CHARACTER AT CURRENT POSITION.
 130 C
 131         CALL SELCQ(CHAR)
 132 C
 133 C       SET UP FOR REQUESTED CHARACTER.
 134 C
 135 10      CALL CQXY(X,Y,IPEN)
 136 C
 137 C       CALL FOR A VECTOR
 138 C
 139         X=X*SEG
 140         Y=(Y-1.)*SEG
 141         XP=XLL+X*COSA-Y*SINA
 142         YP=YLL+X*SINA+Y*COSA
 143         IF(IPEN-7)25,20,20
 144 C
 145 C       CHECK FOR LAST VECTOR
 146 C
 147 25      CALL PLOT(XP,YP,IPEN)
 148 C
 149 C       PLOT RELATIVE TO XLL,YLL AND GO BACK FOR MORE
 150 C
 151         GOTO 10
 152  20     IF(CHAR)30,40,40
 153 C
 154 C       CENTERED CHARACTERS GET FUDGED, SO CHECK FOR THAT
 155 C
 156  40     CALL PLOT(XP,YP,IPEN)
 157         RETURN
 158  30     CALL PLOT(X0,Y0,IPEN)
 159 C
 160 C       PLOT TO CENTER OF CHARACTER
 161 C
 162         RETURN
 163  50     CALL WHERE(X0,Y0)
 164 C
 165 C       FIND OUT WHERE CENTER OF CHARACTER SHOULD BE (IS)
 166 C
 167         XLL=X0-2.*SEG
 168         YLL=Y0-3.*SEG
 169         CALL PLOT(XLL,YLL,3)
 170 C
 171 C       CALCULATE THE LOWER LEFT FROM GIVEN CENTER, THEN GO THERE.
 172 C
 173         CALL SELCQ(-CHAR)
 174         GOTO 10
 175 C
 176 C       SELECT CENTERED CHARACTER, THEN PROCESS NORMALLY
 177 C
 178         END
 179 \f       SUBROUTINE ASSIGN(X,Y)
 180 C
 181 C       THIS ROUTINE ASSIGNS THE CURRENT PEN POSITION AS VIRTUAL (X,Y).
 182 C
 183         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG
 184         XCUR=IFIX(X*SCALE)
 185         YCUR=IFIX(Y*SCALE)
 186 C
 187 C       XCUR AND YCUR ARE STORED IN RASTER TS
 188 C
 189         RETURN
 190         END
 191 \f       SUBROUTINE WHERE(X,Y)
 192 C
 193 C       THIS ROUTINE RETURNS THE VIRTUAL COORDANADTES OF THE CURRENT
 194 C       PEN POSITION
 195 C
 196         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG
 197         X=XCUR/SCALE
 198         Y=YCUR/SCALE
 199 C
 200 C       XCUR AND YCUR ARE IN RASTER UNITS
 201 C
 202         RETURN
 203         END
 204 \f       SUBROUTINE FACTOR(FACT)
 205 C
 206 C       THIS ROUTINE ESTABLISHES A NEW SCALE FACTOR
 207 C       FACT=1 IS 1 UNIT = 1 INCH
 208 C
 209         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG,ANG
 210         SCALE=FACT*200.
 211 C
 212 C       MY PLOTTER HAS 200 STEPS PER INCH
 213 C
 214         RETURN
 215         END
 216 \f       SUBROUTINE NUMBER (XP, YP, HGT, FPN, THETA, ND)
 217 C
 218 C       THIS ROUTINE CONVERTS A NUMBER INTO PLOTTED FORM
 219 C
 220 C       XP AND YP ARE THE COORDANATES WHERE THE PLOTTED NUMBER SHOULD BEGIN
 221 C       HGT IS THE HIGHT IF THE CHARACTERS.
 222 C       FPN IS THE NUMBER (FLOATING OR FIXED IN PDP) TO BE CONVERTED
 223 C       THETA IS THE ANGLE THE CHARACTERS MAKE WITH THE X AXIS
 224 C
 225 C       IF ND>0, IT SPECIFIES THE NUMBER OF DIGITS TO THE RIGHT OF THE DECIMAL
 226 C       POINT THAT ARE TO BE CONVERTED AND PLOTTED, AFTER PROPER ROUNDING.
 227 C       FOR EXAMBLE, ASSUME AN INTERNAL VALUE OF -0.1234567X10^3. IF
 228 C       ND WERE 2, THE PLOTTED NUMBER WOULD BE '-123.46' .
 229 C
 230 C       IF ND=0, ONLY THE INTEGER PORTION AND A DECIMAL POINT
 231 C       ARE PLOTTED, AFTER ROUNDING.
 232 C
 233 C       IF ND=-1, ONLY THE NUMBERS INTEGER PORTION IS PLOTTED, AFTER
 234 C       ROUNDING. (THE NUMBER ABOVE WOULD BE PLOTTED AS '-123' W/O DECIMAL POINT
 235 C
 236 C       IF ND<-1, ABS(ND)-1 DIGITS ARE TRUNCATED FROM THE INTEGER PORTION,
 237 C       AFTER ROUNDING..
 238 C
 239         COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG,ANG
 240         DATA MAXN/9/
 241         DATA SINA,COSA,ANG/0.,1.,0./
 242 C       MOVE TO REQURSTED LOCATION
 243         CALL PLOT(XP,YP,3)
 244 C       IF THE ANGLE IS THE SAME, SAVE THE SIN-COSIN WORK
 245         IF(THETA-ANG) 5, 6, 5
 246 5       ANG=THETA       SINA=SIND(ANG)
 247         COSA=COSD(ANG)
 248 6       SEG=HGT/6.
 249         FPV = FPN
 250         N = ND
 251 C       SET N VALUE TO + OR - MAXN, IF OUT OF RANGE
 252         IF (N - MAXN) 11, 11, 10
 253         10 N = MAXN
 254         11 IF (N + MAXN) 12, 20, 20
 255         12 N = -MAXN
 256 C       INSERT MINUS SIGN IN FRONT OF NUMBER, IF NEGATIVE
 257         20 IF (FPV) 21, 30, 30
 258         21 CALL CPLOT(45)
 259 C       WHEN SYMBOL IS CALLED WITH SAMEV FOR X AND Y, THE CHARACTER STRING
 260 C       CONTINUES FROM THE LAST CHARACTER PLOTTED BY SYMBOL
 261 C       MN LOCATES EXPONENT VALUE FOR PROPER ROUNDING OF NUMBER
 262         30 MN = -N
 263 C       IF SCALING IS DONE, MN MUST BE ADJUSTED
 264         IF (N) 31, 32, 32
 265         31 MN = MN - 1
 266 C       ROUND INPUT NUMBER AND SET TO POSITIVE VALUE
 267         32 FPV = ABS(FPV) + (0.5 * 10. ** MN)
 268 C       DETERMINE CHARACTERISTIC OF FPV AND INCREMENT IT BY 1
 269         I = ALOG10(FPV) + 1.0
 270         ILP = I
 271 C       IF SCALING IS DONE, ILP MUST BE REDUCED ACCORDING TO SCALING
 272         IF (N + 1)      40, 41, 41
 273         40 ILP = ILP + N + 1
 274 C       IF NUMBER IS LESS THAN 1 PLOT A ZERO BEFORE DECIMAL (IF ANY)
 275         41 IF (ILP)     50, 50, 51
 276         50 CALL CPLOT(48)
 277         GO TO 61
 278 C       ILP IS NUMBER OF DIGITS TO LEFT OF DECIMAL POINT
 279         51 DO 60 J = 1, ILP
 280 C       LOCATE SINGLE LEFTMOST DIGIT OF NUMBER
 281         K = FPV * 10. ** (J - I)
 282         CALL CPLOT(K+48)
 283 C       SUBTRACT VALUE OF PREVIOUS DIGIT FROM NUMBER TO LOCATE NEXT DIGIT
 284         60      FPV = FPV - (FLOAT(K) * 10. ** (I - J))
 285 C       NO DECIMAL POINT IS PLOTTED IF N IS NEGATIVE, EXIT FROM ROUTINE
 286         61 IF (N) 99, 70, 70
 287         70 CALL CPLOT(46)
 288 C       PLOT DIGITS TO RIGHT OF DECIMAL IF N GT 0, OTHERWISE EXIT
 289         IF (N)  99, 99, 80
 290         80 DO 90 J = 1, N
 291 C       SCALE FRACTIONAL REMAINDER TO GIVE INTEGER DIGIT
 292         K = FPV * 10.
 293         CALL CPLOT(K+48)
 294 C       SUBTRACT INTEGER VALUE TO LOCATE NEXT DIGIT
 295         90      FPV = FPV * 10. - FLOAT(K)
 296         99 RETURN
 297         END
 298 \f       SUBROUTINE AXIS(XPAGE,YPAGE,IBCD,NCHAR,AXLEN,ANGLE,FIRSTV,DELTAV)
 299 C.....  XPAGE,YPAGE     COORDINATES OF STARTING POINT OF AXIS, IN INCHES
 300 C.....  IBCD    AXIS TITLE.
 301 C.....  NCHAR   NUMBER OF CHARACTERS IN TITLE. + FOR C.C-W SIDE.
 302 C.....  AXLEN   FLOATING POINT AXIS LENGTH IN INCHES.
 303 C.....  ANGLE   ANGLE OF AXIS FROM THE X-DIRECTION, IN DEGREES.
 304 C.....  FIRSTV  SCALE VALUE AT THE FIRST TIC MARK.
 305 C.....  DELTAV  CHANGE IN SCALE BETWEEN TIC MARKS ONE INCH APART
 306         DIMENSION IBCD(2)
 307         KN=NCHAR
 308         A=1.0
 309         IF (KN) 1,2,2
 310         1       A=-A
 311         KN=-KN
 312         2       EX=0.0
 313         ADX= ABS        (DELTAV)
 314         IF (ADX) 3,7,3
 315         3       IF (ADX- 99.0) 6,4,4
 316         4       ADX=ADX/10.0
 317         EX=EX+1.0
 318         GO TO 3
 319         5       ADX=ADX*10.0
 320         EX=EX-1.0
 321         6       IF (ADX-0.01) 5,7,7
 322         7       XVAL=FIRSTV*10.0**(-EX)
 323         ADX= DELTAV*10.0**(-EX)
 324         STH=ANGLE*0.0174533
 325         CTH=COS(STH     STH=SIN(STH)
 326         DXB=-0.1
 327         DYB=0.15*A-0.05
 328         XN=XPAGE+DXB*CTH-DYB*STH
 329         YN=YPAGE+DYB*CTH+DXB*STH
 330         NTIC=AXLEN+1.0
 331         NT=NTIC/2
 332         DO      20      I=1,NTIC
 333         CALL NUMBER(XN,YN,0.105,XVAL,ANGLE,2)
 334         XVAL=XVAL+ADX
 335         XN=XN+CTH
 336         YN=YN+STH
 337         IF (NT) 20,11,20
 338  11     Z=KN
 339         IF (EX) 12,13,12
 340  12     Z=Z+7.0
 341  13     DXB=-.07*Z+AXLEN*0.5
 342         DYB=0.325*A-0.075
 343         XT=XPAGE+DXB*CTH-DYB*STH
 344         YT=YPAGE+DYB*CTH+DXB*STH
 345         CALL SYMBOL(XT,YT,0.14,IBCD(1),ANGLE,KN)
 346         IF (EX) 14,20,14
 347  14     Z=KN+2
 348         XT=XT+Z*CTH*0.14
 349         YT=YT+Z*STH*0.14
 350         CALL SYMBOL(XT,YT,0.14,3H*10,ANGLE,3)
 351         XT=XT+(3.0*CTH-0.8*STH)*0.14
 352         YT=YT+(3.0*STH+0.8*CTH)*0.14
 353         CALL NUMBER(XT,YT,0.07,EX,ANGLE,-1)
 354  20     NT=NT-1
 355         CALL PLOT(XPAGE+AXLEN*CTH,YPAGE+AXLEN*STH,3)
 356         DXB=-0.07*A*STH
 357         DYB=+0.07*A*CTH
 358         A=NTIC-1
 359         XN=XPAGE+A*CTH
 360         YN=YPAGE+A*STH
 361         DO      30      I=1,NTIC
 362         CALL PLOT(XN,YN,2)
 363         CALL PLOT(XN+DXB,YN+DYB,2)
 364         CALL PLOT(XN,YN,2)
 365         XN=XN-CTH
 366         YN=YN-STH
 367  30     CONTINUE
 368         RETURN
 369         END
 370 \fC
 371 C       THIS ROUTINE PRODUCES A SYMBOL TABLE, WHICH SHOWS THE CHARACTERS
 372 C       AVAILABLE IN THE SYMBOL ROUTINE.
 373 C
 374 C       MAXCHR IS THE INTEGER EQUIVALENT OF THE LAST CHARACTER.
 375         MAXCHR=63
 376         CALL PLOT(0,0,3)
 377         CALL PLOT (0.0,11.0,2)
 378         CALL PLOT (8.5,11.0,2)
 379         CALL PLOT (8.5,0.0,2)
 380         CALL PLOT (0.0,0.0,2)
 381         CALL SYMBOL(0.75,10.4,.14,49HCHARACTERS AVAILABLE IN SYMBOL ROUTIN
 382         1E ( PDP 8E ),0.,49)
 383         CALL PLOT(8.25,10.,3)
 384         CALL PLOT(0.25,10.,2)
 385         CALL PLOT(0.25,0.25,2)
 386         CALL PLOT(8.25,0.25,2)
 387         CALL PLOT(8.25,10.0,2)
 388         X=0.5
 389         K=0
 390         DO 200 I=1,5
 391         Y=9.4
 392         DO 100 J=1,13
 393         CALL NUMBER(X,Y+0.1,.14,FLOAT (K),0.0,-1)
 394         4       CALL SYMBOL(X+0.45,Y,0.35,K,0.0,0)
 395  10     IO1=K/8
 396         IO2=K-IO1*8
 397         CALL NUMBER(X+0.90,Y+0.1,0.14,FLOAT (IO1),0.0,-1)
 398         CALL NUMBER(X+1.04,Y+0.1,0.14,FLOAT (IO2),0.0,-1)
 399         GO TO 20
 400         15      CALL SYMBOL(X+1.0,Y+0.1,.14,1H-,0.0,1)
 401         20      K=K+1
 402         Y=Y-.7307
 403         IF(K-MAXCHR) 100,100,300
 404         100     CONTINUE
 405         CALL PLOT(X+1.35,0.25,3)
 406         CALL PLOT(X+1.35,10.,2)
 407         200     X=X+1.6
 408 300     CALL WAIT
 409         END
 410 \f`x\1a