Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0049/drkplt.for
There is 1 other file named drkplt.for in the archive. Click here to see a list.
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