Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0049/dimplt.for
There is 1 other file named dimplt.for in the archive. Click here to see a list.
SUBROUTINE DIMPLT (KONTRL,XPOINT,YPOINT, NEXT,
1KRDBGN,KRDEND,XFIRST,YFIRST,XFINAL,YFINAL,XWIDTH,
2YWIDTH,XCORNR,YCORNR,RELHIT,RELSPC, LASTX, LASTY)
C 03/21/72
C GENPLT-II PROGRAM TO DARKEN OR HATCH AN IRREGULARLY
C SHAPED FIGURE. UNLIKE OUTPUT FROM DRKPLT, HATCH
C LINES CAN BE AT ANY ANGLE. DIMPLT ROTATES THE INPUT
C XPOINT AND YPOINT ARRAYS PRIOR TO PROCESSING. THESE
C ARRAYS ARE RETURNED TO THEIR ORIGINAL VALUES BEFORE
C RETURNING TO THE CALLING PROGRAM, BUT THE USER
C SHOULD BE AWARE THAT THERE CAN HAVE BEEN A SLIGHT
C PRECISION LOSS.
C
C DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C SUBROUTINE DIMPLT ARGUMENT LIST DEFINITIONS.
C
C KONTRL = SELECTS PERIMETER OR ANGLE OF HATCHING
C KONTRL = NEGATIVE GIVES PERIMETER
C KONTRL = 0 OR GREATER, HATCHING ANGLE IN DEGREES
C = 0 GIVES HORIZONTAL HATCH LINES
C = 90 GIVES VERTICAL HATCH LINES
C XPOINT = ARRAY OF X COORDINATES DEFINING PERIMETER
C OF FIGURE.
C YPOINT = ARRAY OF Y COORDINATES DEFINING PERIMETER
C OF FIGURE.
C NEXT = FIXED OR FLOATING POINT ARRAY USED AS
C WORKING SPACE. NEXT IS REDEFINED DURING
C PROCESSING DESTROYING FORMER CONTENTS.
C NEXT MUST BE DIMENSIONED SAME OR LARGER
C THAN XPOINT AND YPOINT. PORTION OF NEXT
C WHICH IS USED IS PARALLEL TO USED
C PORTIONS OF XPOINT AND YPOINT ARRAYS.
C KRDBGN = SUBSCRIPT OF FIRST POINT TO BE PLOTTED.
C KRDEND = SUBSCRIPT OF FINAL POINT TO BE PLOTTED.
C XFIRST = X COORDINATE (IN SYSTEM USED FOR XPOINT)
C TO BE PLACED AT LEFT BORDER OF PLOT AREA.
C YFIRST = Y COORDINATE (IN SYSTEM USED FOR YPOINT)
C TO BE PLACED AT LOWER BORDER OF PLOT AREA.
C XFINAL = X COORDINATE (IN SYSTEM USED FOR XPOINT)
C TO BE PLACED AT RIGHT BORDER OF PLOT AREA.
C YFINAL = Y COORDINATE (IN SYSTEM USED FOR YPOINT)
C TO BE PLACED AT UPPER BORDER OF PLOT AREA.
C XWIDTH = HORIZONTAL WIDTH (AS FRACTION OF MAXIMUM)
C OF PLOT AREA.
C YWIDTH = VERTICAL HEIGHT (AS FRACTION OF MAXIMUM)
C OF PLOT AREA.
C XCORNR = X DISTANCE (AS FRACTION OF MAXIMUM
C DIMENSION) FROM PLOTTING TABLE ORIGIN TO
C LEFT PLOT EDGE.
C YCORNR = Y DISTANCE (AS FRACTION OF MAXIMUM
C DIMENSION) FROM PLOTTING TABLE ORIGIN TO
C LOWER PLOT EDGE.
C RELHIT = DISTANCE BETWEEN ALTERNATE PAIRS OF HATCH
C LINES IN UNITS OF 0.02*YWIDTH. RELHIT AND
C RELSPC BOTH SET AT 1.0 WOULD GIVE 50
C LINES IN DISTANCE CORRESPONDING TO HEIGHT
C OF THE PLOT AREA.
C RELSPC = DISTANCE BETWEEN ALTERNATE PAIRS OF HATCH
C 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),
1SAVE(200)
COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,
1NTAPE,MODE,IPOINT,IFREER,ILINE
C
C DEFINE FACTORS AND GRID COORDINATE LIMITS
IF(KRDBGN-KRDEND)1,90,90
1 MODE = IFREER
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)
IF(KONTRL)60,4,2
C
C ********************************
C * ROTATE ARRAYS ABOUT ORIGIN *
C ********************************
C
2 IF(KONTRL-90)5,3,5
3 ACOS=0.0
ASIN=1.0
GO TO 6
4 ACOS=1.0
ASIN=0.0
GO TO 6
5 TEST=0.0174532925*FLOAT(KONTRL)
ACOS=COS(TEST)
ASIN=SIN(TEST)
6 DO 7 I=KRDBGN,KRDEND
XTHIS=(XSCALE*(XPOINT(I)-XFIRST))+XMIN
YTHIS=(YSCALE*(YPOINT(I)-YFIRST))+YMIN
XPOINT(I)=(XTHIS*ACOS)+(YTHIS*ASIN)
7 YPOINT(I)=(YTHIS*ACOS)-(XTHIS*ASIN)
XTHIS=(ACOS*YMAX)-(ASIN*XMIN)
YTHIS=(ACOS*YMAX)-(ASIN*XMAX)
XTHAT=(ACOS*YMIN)-(ASIN*XMIN)
YTHAT=(ACOS*YMIN)-(ASIN*XMAX)
YLOWER=XTHIS
IF(YLOWER-YTHIS)9,9,8
8 YLOWER=YTHIS
GO TO 10
9 XTHIS=YTHIS
10 IF(YLOWER-XTHAT)12,12,11
11 YLOWER=XTHAT
GO TO 14
12 IF(XTHIS-XTHAT)13,14,14
13 XTHIS=XTHAT
14 IF(YLOWER-YTHAT)16,16,15
15 YLOWER=YTHAT
GO TO 18
16 IF(XTHIS-YTHAT)17,18,18
17 XTHIS=YTHAT
C
C **********************************
C * RULE HATCH OF PARALLEL LINES *
C **********************************
C
18 LOCK=1
STEP=0.02*RELHIT*FACTOR*YWIDTH
SPACE=0.02*RELSPC*FACTOR*YWIDTH
IF(STEP)19,19,22
19 IF(SPACE)20,20,21
20 SPACE=0.02*FACTOR*YWIDTH
21 STEP=SPACE
GO TO 24
22 IF(SPACE)23,23,24
23 SPACE=STEP
24 TEST=YPOINT(KRDBGN)
DO 26 I=KRDBGN,KRDEND
NEXT(I)=I+1
IF(TEST-YPOINT(I))25,26,26
25 TEST=YPOINT(I)
26 CONTINUE
NEXT(KRDEND)=KRDBGN
NEW=KRDBGN
IF(TEST-XTHIS)28,28,27
27 TEST=XTHIS
28 TEST=TEST-STEP
29 IF(TEST-YLOWER)88,30,30
30 KOUNT=0
31 NOW=NEW
NEW=NEXT(NOW)
IF(YPOINT(NOW)-TEST)38,39,32
32 IF(YPOINT(NEW)-TEST)39,39,33
C
C TEST FOR REMOVAL OF POINT FROM ARRAY IF LINE
C SEGMENT IS HIGHER
33 LAST=NOW
IF(NOW-NEW)36,88,34
34 NOW=NEXT(NEW)
IF(YPOINT(NOW)-TEST)45,45,35
35 NEW=NOW
NEXT(LAST)=NEW
GO TO 45
36 NOW=NEW
NEW=NEXT(NEW)
IF(YPOINT(NEW)-TEST)39,39,37
37 NEXT(LAST)=NEW
IF(LAST-NEW)36,88,45
38 IF(YPOINT(NEW)-TEST)44,39,39
C
C CALCULATE INTERCEPT WITH LINE SEGMENT
39 IF(KOUNT-200)40,44,44
40 KOUNT=KOUNT+1
DIST=YPOINT(NEW)-YPOINT(NOW)
IF(DIST-0.1)41,41,43
41 IF(DIST+0.1)43,42,42
42 SAVE(KOUNT)=XPOINT(NOW)
GO TO 44
43 SAVE(KOUNT)=XPOINT(NOW)
1+((XPOINT(NEW)-XPOINT(NOW))*(TEST-YPOINT(NOW))/DIST)
44 IF(NOW-NEW)31,88,45
C
C ARRANGE INTERCEPT ARRAY INTO INCREASING ORDER
45 IF(KOUNT-(2*(KOUNT/2)))46,47,46
46 TEST=TEST-0.05*STEP
GO TO 29
47 LIMIT=KOUNT-1
DO 51 I=1,LIMIT
SMALL=SAVE(I)
INDEX=0
LOWER=I+1
DO 49 J=LOWER,KOUNT
IF(SMALL-SAVE(J))49,49,48
48 SMALL=SAVE(J)
INDEX=J
49 CONTINUE
IF(INDEX)51,51,50
50 SAVE(INDEX)=SAVE(I)
SAVE(I)=SMALL
51 CONTINUE
C
C PLOT HATCH LINE
LOCK=-LOCK
IF(LOCK)52,52,54
52 I=KOUNT
53 XTHAT=(ACOS*SAVE(I))-(ASIN*TEST)
YTHAT=(ACOS*TEST)+(ASIN*SAVE(I))
XTHIS=(ACOS*SAVE(I-1))-(ASIN*TEST)
YTHIS=(ACOS*TEST)+(ASIN*SAVE(I-1))
GO TO 63
54 I=1
55 XTHAT=(ACOS*SAVE(I))-(ASIN*TEST)
YTHAT=(ACOS*TEST)+(ASIN*SAVE(I))
XTHIS=(ACOS*SAVE(I+1))-(ASIN*TEST)
YTHIS=(ACOS*TEST)+(ASIN*SAVE(I+1))
GO TO 63
56 LIMIT=1
IF(LOCK)57,57,59
57 I=I-2
IF(I)58,58,53
58 TEST=TEST-SPACE
GO TO 29
59 I=I+2
IF(I-KOUNT)55,55,28
C
C ******************************
C * PLOT PERIMETER OF FIGURE *
C ******************************
C
60 XTHIS=XMIN+(XSCALE*(XPOINT(KRDEND)-XFIRST))
YTHIS=YMIN+(YSCALE*(YPOINT(KRDEND)-YFIRST))
MODE = ILINE
LIMIT=1
KRD=KRDBGN-1
61 KRD=KRD+1
IF(KRD-KRDEND)62,62,90
62 XTHAT=XTHIS
YTHAT=YTHIS
XTHIS=XMIN+(XSCALE*(XPOINT(KRD)-XFIRST))
YTHIS=YMIN+(YSCALE*(YPOINT(KRD)-YFIRST))
63 XSTRT=XTHAT
XHALT=XTHIS
XDIST=XTHIS-XTHAT
YDIST=YTHIS-YTHAT
C
C TEST HORIZONTAL COORDINATES FOR LINE OUTSIDE PLOT
IF(XSTRT-XMIN)64,65,65
64 XSTRT=XMIN
LIMIT=1
IF(XHALT-XMIN)87,69,69
65 IF(XSTRT-XMAX)67,67,66
66 XSTRT=XMAX
LIMIT=1
IF(XHALT-XMAX)67,67,87
67 IF(XHALT-XMIN)68,69,69
68 XHALT=XMIN
GO TO 71
69 IF(XHALT-XMAX)71,71,70
70 XHALT=XMAX
71 IF(ABS(XDIST)-0.1)72,73,73
72 YSTRT=YTHAT
YHALT=YTHIS
GO TO 74
73 YSTRT=YTHAT+((YDIST*(XSTRT-XTHAT))/XDIST)
YHALT=YTHIS-((YDIST*(XTHIS-XHALT))/XDIST)
C
C TEST VERTICAL COORDINATES FOR LINE OUTSIDE PLOT
74 IF(YSTRT-YMIN)75,76,76
75 YSTRT=YMIN
LIMIT=1
IF(YHALT-YMIN)87,80,80
76 IF(YSTRT-YMAX)78,78,77
77 YSTRT=YMAX
LIMIT=1
IF(YHALT-YMAX)78,78,87
78 IF(YHALT-YMIN)79,80,80
79 YHALT=YMIN
GO TO 82
80 IF(YHALT-YMAX)82,82,81
81 YHALT=YMAX
82 IF(ABS(YDIST)-0.1)84,83,83
83 XSTRT=XTHAT+((XDIST*(YSTRT-YTHAT))/YDIST)
XHALT=XTHIS-((XDIST*(YTHIS-YHALT))/YDIST)
C
C PLOT THE LINE SEGMENT
84 IF(LIMIT)86,86,85
85 LIMIT=-1
NEWX=XSTRT
NEWY=YSTRT
CALL PENUP (LASTX,LASTY,NEWX,NEWY)
86 NEWX=XHALT
NEWY=YHALT
CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
87 IF(KONTRL)61,56,56
C
C ******************************************
C * REMOVE ROTATION FROM ARRAY WHEN DONE *
C ******************************************
C
88 DO 89 I=KRDBGN,KRDEND
XTHIS=XPOINT(I)
YTHIS=YPOINT(I)
XPOINT(I)=XFIRST
1+(((XTHIS*ACOS)-(YTHIS*ASIN)-XMIN)/XSCALE)
89 YPOINT(I)=YFIRST
1+(((YTHIS*ACOS)+(XTHIS*ASIN)-YMIN)/YSCALE)
90 RETURN
END