Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50247/drkplt.f4
There are no other files named drkplt.f4 in the archive.
      SUBROUTINE  DRKPLT  (KONTRL,XPOINT,YPOINT,  NEXT,KRDBGN,KRDEND,
     1XFIRST,YFIRST,XFINAL,YFINAL,XWIDTH,YWIDTH,XCORNR,YCORNR,RELHIT,
     2 LASTX, LASTY)
C                                                               06/22/67
C     GENPLT-II PROGRAM TO DARKEN OR HATCH AN IRREGULARLY SHAPED FIGURE
C
C     DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
C     SUBROUTINE DRKPLT ARGUMENT LIST DEFINITIONS.
C
C     KONTRL = OPTION CONTROL WHICH SELECTS TYPE OF HATCHING TO BE USED.
C     KONTRL = 1 GIVES HATCHING FORMED OF PARALLEL HORIZONTAL LINES.
C     KONTRL = 2 GIVES CROSSHATCH OF HORIZONTAL AND VERTICAL LINES.
C     KONTRL = 3 GIVES HATCHING FORMED OF PARALLEL VERTICAL LINES.
C     KONTRL = 4 PLOTS PERIMETER OF FIGURE.
C     XPOINT = ARRAY OF X COORDINATES DEFINING PERIMETER OF FIGURE.
C     YPOINT = ARRAY OF Y COORDINATES DEFINING PERIMETER OF FIGURE.
C     NEXT   = FIXED OR FLOATING POINT ARRAY USED AS WORKING SPACE.
C     NEXT   = IS REDEFINED BY DRKPLT SO FORMER CONTENTS ARE DESTROYED.
C     NEXT   = MUST HAVE SAME DIMENSIONS AS XPOINT OR YPOINT.
C     KRDBGN = SUBSCRIPT OF FIRST POINT TO BE PLOTTED.
C     KRDEND = SUBSCRIPT OF FINAL POINT TO BE PLOTTED.
C     XFIRST = X COORDINATE TO BE PLACED AT LEFT BORDER OF PLOT AREA.
C     YFIRST = Y COORDINATE TO BE PLACED AT LOWER BORDER OF PLOT AREA.
C     XFINAL = X COORDINATE TO BE PLACED AT RIGHT BORDER OF PLOT AREA.
C     YFINAL = Y COORDINATE TO BE PLACED AT UPPER BORDER OF PLOT AREA.
C     XWIDTH = HORIZONTAL WIDTH OF PLOT AREA.
C     YWIDTH = VERTICAL HEIGHT OF PLOT AREA.
C     XCORNR = X DISTANCE FROM PLOTTING TABLE ORIGIN TO LEFT PLOT EDGE.
C     YCORNR = Y DISTANCE FROM PLOTTING TABLE ORIGIN TO LOWER PLOT EDGE.
C     RELHIT = DISTACE BETWEEN HATCH LINES IN UNITS OF 0.02*YWIDTH.
C     LASTX  = LAST X GRID COORDINATE PLOTTED.
C     LASTY  = LAST Y GRID COORDINATE PLOTTED.
C
      DIMENSION XPOINT(1000),YPOINT(1000),NEXT(1000),KEEP(200)
       COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
     1IFREER,ILINE
      MODE = IFREER
      IF(XFIRST-XFINAL)1,121,2
    1 XLOWER=XFIRST
      XUPPER=XFINAL
      GO TO 3
    2 XLOWER=XFINAL
      XUPPER=XFIRST
    3 IF(YFIRST-YFINAL)4,121,5
    4 YLOWER=YFIRST
      YUPPER=YFINAL
      GO TO 6
    5 YLOWER=YFINAL
      YUPPER=YFIRST
    6 XMIN=FACTOR*XCORNR + OFSETX
      YMIN=FACTOR*YCORNR + OFSETY
      XMAX=XMIN+FACTOR*XWIDTH
      YMAX=YMIN+FACTOR*YWIDTH
      XSCALE=FACTOR*XWIDTH/(XFINAL-XFIRST)
      YSCALE=FACTOR*YWIDTH/(YFINAL-YFIRST)
      LOCK=1
      IF(KONTRL-2)8,8,7
    7 IF(KONTRL-3)52,52,95
C
C     *************RULE HATCH OF PARALLEL HORIZONTAL LINES**************
    8 STEP=0.02*RELHIT*(YUPPER-YLOWER)
      IF(STEP)121,121,9
    9 TEST=YPOINT(KRDBGN)
      DO 11 I=KRDBGN,KRDEND
      NEXT(I)=I+1
      IF(TEST-YPOINT(I))10,11,11
   10 TEST=YPOINT(I)
   11 CONTINUE
      NEXT(KRDEND)=KRDBGN
      NEW=KRDBGN
      MINX=XMIN
      MAXX=XMAX
      IF(TEST-YUPPER)13,13,12
   12 TEST=YUPPER
   13 TEST=TEST+(0.5*STEP)
   14 TEST=TEST-STEP
   15 IF(TEST-YLOWER)51,16,16
   16 KOUNT=0
   17 NOW=NEW
      NEW=NEXT(NOW)
      IF(YPOINT(NOW)-TEST)24,25,18
   18 IF(YPOINT(NEW)-TEST)25,25,19
C
C     TEST FOR REMOVAL OF POINT FROM ARRAY IF LINE SEGMENT IS HIGHER
   19 LAST=NOW
      IF(NOW-NEW)22,51,20
   20 NOW=NEXT(NEW)
      IF(YPOINT(NOW)-TEST)31,31,21
   21 NEW=NOW
      NEXT(LAST)=NEW
      GO TO 31
   22 NOW=NEW
      NEW=NEXT(NEW)
      IF(YPOINT(NEW)-TEST)25,25,23
   23 NEXT(LAST)=NEW
      IF(LAST-NEW)22,51,31
   24 IF(YPOINT(NEW)-TEST)30,25,25
C
C     CALCULATE INTERCEPT WITH LINE SEGMENT
   25 IF(KOUNT-200)26,30,30
   26 KOUNT=KOUNT+1
      DIST=YPOINT(NEW)-YPOINT(NOW)
      IF(IFIX(YSCALE*DIST))28,27,28
   27 DIST=0.0
      GO TO 29
   28 DIST=(XPOINT(NEW)-XPOINT(NOW))*(TEST-YPOINT(NOW))/DIST
   29 KEEP(KOUNT)=XMIN+(XSCALE*(DIST+XPOINT(NOW)-XFIRST))
   30 IF(NOW-NEW)17,51,31
C
C     ARRANGE INTERCEPT ARRAY INTO INCREASING ORDER
   31 IF(KOUNT-(2*(KOUNT/2)))32,33,32
   32 TEST=TEST-0.05*STEP
      GO TO 15
   33 LIMIT=KOUNT-1
      DO 37 I=1,LIMIT
      LEAST=KEEP(I)
      INDEX=0
      LOWER=I+1
      DO 35 J=LOWER,KOUNT
      IF(LEAST-KEEP(J))35,35,34
   34 LEAST=KEEP(J)
      INDEX=J
   35 CONTINUE
      IF(INDEX)37,37,36
   36 KEEP(INDEX)=KEEP(I)
      KEEP(I)=LEAST
   37 CONTINUE
C
C     TEST FOR HATCH LINES OUTSIDE PLOT AREA
      LIMIT=1
   38 IF(KEEP(LIMIT)-MINX)39,42,42
   39 IF(KEEP(LIMIT+1)-MINX)40,41,41
   40 LIMIT=LIMIT+2
      IF(LIMIT-KOUNT)38,14,14
   41 KEEP(LIMIT)=MINX
   42 IF(KEEP(KOUNT)-MAXX)46,46,43
   43 IF(KEEP(KOUNT-1)-MAXX)45,45,44
   44 KOUNT=KOUNT-2
      IF(LIMIT-KOUNT)42,14,14
   45 KEEP(KOUNT)=MAXX
C
C     PLOT HATCH LINE
   46 LOCK=-LOCK
      NEWY=YMIN+(YSCALE*(TEST-YFIRST))
      IF(LOCK)47,47,49
   47 DO 48 I=LIMIT,KOUNT,2
      J=KOUNT-I+LIMIT
      NEWX=KEEP(J)
      CALL PENUP (LASTX,LASTY,NEWX,NEWY)
      NEWX=KEEP(J-1)
   48 CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
      GO TO 14
   49 DO 50 I=LIMIT,KOUNT,2
      NEWX=KEEP(I)
      CALL PENUP (LASTX,LASTY,NEWX,NEWY)
      NEWX=KEEP(I+1)
   50 CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
      GO TO 14
   51 IF(KONTRL-2)121,52,121
C
C     **************RULE HATCH OF PARALLEL VERTICAL LINES***************
   52 STEP=0.02*RELHIT*(XUPPER-XLOWER)*YWIDTH/XWIDTH
      IF(STEP)121,121,53
   53 TEST=XPOINT(KRDBGN)
      DO 55 I=KRDBGN,KRDEND
      NEXT(I)=I+1
      IF(TEST-XPOINT(I))54,55,55
   54 TEST=XPOINT(I)
   55 CONTINUE
      NEXT(KRDEND)=KRDBGN
      NEW=KRDBGN
      MINY=YMIN
      MAXY=YMAX
      IF(TEST-XUPPER)57,57,56
   56 TEST=XUPPER
   57 TEST=TEST+(0.5*STEP)
   58 TEST=TEST-STEP
   59 IF(TEST-XLOWER)121,60,60
   60 KOUNT=0
   61 NOW=NEW
      NEW=NEXT(NOW)
      IF(XPOINT(NOW)-TEST)68,69,62
   62 IF(XPOINT(NEW)-TEST)69,69,63
C
C     TEST FOR REMOVAL OF POINT FROM ARRAY IF LINE SEGMENT IS HIGHER
   63 LAST=NOW
      IF(NOW-NEW)66,121,64
   64 NOW=NEXT(NEW)
      IF(XPOINT(NOW)-TEST)75,75,65
   65 NEW=NOW
      NEXT(LAST)=NEW
      GO TO 75
   66 NOW=NEW
      NEW=NEXT(NEW)
      IF(XPOINT(NEW)-TEST)69,69,67
   67 NEXT(LAST)=NEW
      IF(LAST-NEW)66,121,75
   68 IF(XPOINT(NEW)-TEST)74,69,69
C
C     CALCULATE INTERCEPT WITH LINE SEGMENT
   69 IF(KOUNT-200)70,74,74
   70 KOUNT=KOUNT+1
      DIST=XPOINT(NEW)-XPOINT(NOW)
      IF(IFIX(XSCALE*DIST))72,71,72
   71 DIST=0.0
      GO TO 73
   72 DIST=(YPOINT(NEW)-YPOINT(NOW))*(TEST-XPOINT(NOW))/DIST
   73 KEEP(KOUNT)=YMIN+(YSCALE*(DIST+YPOINT(NOW)-YFIRST))
   74 IF(NOW-NEW)61,121,75
C
C     ARRANGE INTERCEPT ARRAY INTO INCREASING ORDER
   75 IF(KOUNT-(2*(KOUNT/2)))76,77,76
   76 TEST=TEST-0.05*STEP
      GO TO 59
   77 LIMIT=KOUNT-1
      DO 81 I=1,LIMIT
      LEAST=KEEP(I)
      INDEX=0
      LOWER=I+1
      DO 79 J=LOWER,KOUNT
      IF(LEAST-KEEP(J))79,79,78
   78 LEAST=KEEP(J)
      INDEX=J
   79 CONTINUE
      IF(INDEX)81,81,80
   80 KEEP(INDEX)=KEEP(I)
      KEEP(I)=LEAST
   81 CONTINUE
C
C     TEST FOR HATCH LINES OUTSIDE PLOT AREA
      LIMIT=1
   82 IF(KEEP(LIMIT)-MINY)83,86,86
   83 IF(KEEP(LIMIT+1)-MINY)84,85,85
   84 LIMIT=LIMIT+2
      IF(LIMIT-KOUNT)82,58,58
   85 KEEP(LIMIT)=MINY
   86 IF(KEEP(KOUNT)-MAXY)90,90,87
   87 IF(KEEP(KOUNT-1)-MAXY)89,89,88
   88 KOUNT=KOUNT-2
      IF(LIMIT-KOUNT)86,58,58
   89 KEEP(KOUNT)=MAXY
C
C     PLOT HATCH LINE
   90 LOCK=-LOCK
      NEWX=XMIN+(XSCALE*(TEST-XFIRST))
      IF(LOCK)91,91,93
   91 DO 92 I=LIMIT,KOUNT,2
      J=KOUNT-I+LIMIT
      NEWY=KEEP(J)
      CALL PENUP (LASTX,LASTY,NEWX,NEWY)
      NEWY=KEEP(J-1)
   92 CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
      GO TO 58
   93 DO 94 I=LIMIT,KOUNT,2
      NEWY=KEEP(I)
      CALL PENUP (LASTX,LASTY,NEWX,NEWY)
      NEWY=KEEP(I+1)
   94 CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
      GO TO 58
C
C     *********************PLOT PERIMETER OF FIGURE*********************
   95 THISX=XMIN+(XSCALE*(XPOINT(KRDEND)-XFIRST))
      THISY=YMIN+(YSCALE*(YPOINT(KRDEND)-YFIRST))
      MODE = ILINE
      KRD=KRDBGN-1
   96 KRD=KRD+1
      IF(KRD-KRDEND)97,97,121
   97 THATX=THISX
      THATY=THISY
      THISX=XMIN+(XSCALE*(XPOINT(KRD)-XFIRST))
      THISY=YMIN+(YSCALE*(YPOINT(KRD)-YFIRST))
      STARTX=THATX
      HALTX=THISX
      DISTX=THISX-THATX
      DISTY=THISY-THATY
C
C     TEST HORIZONTAL COORDINATES FOR LINE OUTSIDE PLOT AREA
      IF(STARTX-XMIN)98,99,99
   98 STARTX=XMIN
      LOCK=1
      IF(HALTX-XMIN)96,103,103
   99 IF(STARTX-XMAX)101,101,100
  100 STARTX=XMAX
      LOCK=1
      IF(HALTX-XMAX)101,101,96
  101 IF(HALTX-XMIN)102,103,103
  102 HALTX=XMIN
      GO TO 105
  103 IF(HALTX-XMAX)105,105,104
  104 HALTX=XMAX
  105 IF(ABS(DISTX)-0.1)106,107,107
  106 STARTY=THATY
      HALTY=THISY
      GO TO 108
  107 STARTY=THATY+((DISTY*(STARTX-THATX))/DISTX)
      HALTY=THISY-((DISTY*(THISX-HALTX))/DISTX)
C
C     TEST VERTICAL COORDINATES FOR LINE OUTSIDE PLOT AREA
  108 IF(STARTY-YMIN)109,110,110
  109 STARTY=YMIN
      LOCK=1
      IF(HALTY-YMIN)96,114,114
  110 IF(STARTY-YMAX)112,112,111
  111 STARTY=YMAX
      LOCK=1
      IF(HALTY-YMAX)112,112,96
  112 IF(HALTY-YMIN)113,114,114
  113 HALTY=YMIN
      GO TO 116
  114 IF(HALTY-YMAX)116,116,115
  115 HALTY=YMAX
  116 IF(ABS(DISTY)-0.1)118,117,117
  117 STARTX=THATX+((DISTX*(STARTY-THATY))/DISTY)
      HALTX=THISX-((DISTX*(THISY-HALTY))/DISTY)
C
C     PLOT THE LINE SEGMENT
  118 IF(LOCK)120,120,119
  119 LOCK=-1
      NEWX=STARTX
      NEWY=STARTY
      CALL PENUP (LASTX,LASTY,NEWX,NEWY)
  120 NEWX=HALTX
      NEWY=HALTY
      CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
      GO TO 96
  121 RETURN
      END