Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0123/oplot.for
There are 2 other files named oplot.for in the archive. Click here to see a list.
00100 C PLOTTER SEQUENCER
00200 C
00300 C THE PACKAGE CONSISTS OF THE SUBROUTINES OPLOT,DELETE,OLINE AND OPOINT.
00400 C A SAMPLE PROGRAM IS ALSO GIVEN.
00500 C
00600 C OPLOT(XX,YY,IPEN)
00700 C THIS PROGRAM MOVES THE PEN FROM ITS CURRENT POSITION TO THE POINT
00800 C (XX,YY). THE CONTROL (IPEN) OF THE PEN IS
00900 C 3, RISE THE PEN
01000 C 2, LOVER THE PEN
01100 C 1, POSITION UNCHANGED.
01200 C THE POSITION OF THE PEN IS CONTROLLED BEFORE THE MOVEMENT. THE
01300 C VERY LAST CALL OF OPLOT MUST CONTAIN A IPEN VALUE LESS THAN 0.
01400 C THE ACTUAL PLOTTING IS MADE IN THE ORDER CONTROLLED BY THE
01500 C PROGRAM DELETE. FOR ADDITIONAL INFORMATION SEE: KUOKKANEN, LEIPALA,
01600 C NEVALAINEN: IMPLEMENTATION AND ANALYSIS OF A PLOTTING SEQUENCER,
01700 C INST. OF COMP. SCI, UNIV. OF TURKU, FINLAND.
01800 C INTERNAL VARIABLES:
01900 C (X,Y) AN INTERNAL AREA FOR STORING THE POINTS OF THE CURVES,
02000 C LSG THE LENGTH OF THE CURVE SEGMENTS IN THE AREA (X,Y),
02100 C N THE NUMBER OF CURVE SEGMENTS IN THE AREA (X,Y),
02200 C NS THE NUMBER OF RESERVED CURVE SEGMENTS,
02300 C IS THE INDEX OF THE CURRENT CURVE SEGMENT,
02400 C (IREAR,IFRONT) VECTORS GIVING THE LAST AND FIRST USED ELEMENTS
02500 C IN THE CURVE SEGMENTS. AN EMPTY CURVE SEGMENT IS RECOGNISED
02600 C FROM THE CONDITION IREAR(J)=IFRONT(J)-1.
02700 C IFIRST 0, WHEN CALLING THE SUBROUTINE FOR THE FIRST TIME
02800 C 1, OTHERWISE.
02900 C KON 1,WHEN THE PEN IS IN THE UPPER POSITION.
03000 C IC THE ABSOLUTE VALUE OF IPEN.
03100 C (XN,YN) THE CURRENT COORDINATES OF THE PHYSICAL PEN OF THE PLOTTER.
03200 C (XE,YE) THE CURRENT COORDINATES, WHEN MOVING THE PEN IN THE UPPER
03300 C POSITION.
03400 C (XI,YI) THE LAST POINT OF THE CURVE SEGMENT THAT MUST BE CONTINUED
03500 C TO ANOTHER SEGMENT.
03600 C NRSEG THE NUMBER OF RESERVED SEGMENTS AT THE TIME OF THE LAST CALL.
03700 C LN THE DEGREE OF THE HEURISTICS WHEN CHOOSING THE NEXT
03800 C SEGMENT AT THE TIME OF LAST CALL.
03900 C WASTE THE TOTAL LENGTH OF THE WASTE MOVEMENTS.
04000 SUBROUTINE OPLOT (XX,YY,IPEN)
04100 DIMENSION X(1001),Y(1001),IFRONT(50),IREAR(50)
04200 DATA LSG,N/20,50/
04300 DATA IFRST/0/
04400 IF(IFRST) 20,10,20
04500
04600 C INITIALIZATION
04700 10 WASTE=0.
04800 XN=0.
04900 YN=0.
05000 NS=0
05100 KON=1
05200 DO 15 I=1,N
05300 IFRONT(I)=(I-1)*LSG+2
05400 IREAR(I) = (I-1)*LSG+1
05500 15 CONTINUE
05600 IFRST=1
05700 XE=0.
05800 YE=0.
05900
06000 C TEST THE POSITION OF THE PEN
06100 20 IC=IABS(IPEN)
06200 25 IF(IC-2) 60,35,30
06300
06400 C THE PEN IS LIFTED UP,IC=3
06500 30 IF(KON.GT.0) GO TO 31
06600 NS=NS+1
06700 KON=1
06800 31 XE=XX
06900 YE=YY
07000 GO TO 100
07100
07200 C THE PEN IS SET DOWN,IC=2
07300 35 IF (KON.EQ.0) GO TO 61
07400 KON=0
07500 X1=XE
07600 Y1=YE
07700 IF(NS.GE.N) GO TO 63
07800 IS=NS+1
07900 GO TO 64
08000
08100 C THE PEN IS NEITHER LIFTED UP NOR SET DOWN
08200 C IS IT IN THE UPPER POSITION
08300 60 IF(KON) 130,61,130
08400 130 XE=XX
08500 YE=YY
08600 GO TO 100
08700
08800 C STORE THE NEXT POINT
08900 C IS THE SEGMENT FULL
09000 61 LFREE=IREAR(IS)-IFRONT(IS)+1
09100 IF(LFREE-LSG) 65,62,62
09200 62 L=IREAR(IS)
09300 X1=X(L)
09400 Y1=Y(L)
09500 NS=NS+1
09600 IS=NS+1
09700 IF(NS.LT.N) GO TO 64
09800 C ALL SEGMENTS ARE RESERVED,
09900 C DEALLOCATE ONE OF THE SEGMENTS
10000 63 CALL DELETE (X,Y,IFRONT,IREAR,XN,YN,IS,N,WASTE)
10100 64 L=IREAR(IS)+1
10200 IREAR(IS)=L
10300 X(L)=X1
10400 Y(L)=Y1
10500 C STORE THE POINT OF THE CALL
10600 65 L=IREAR(IS)+1
10700 IREAR(IS)=L
10800 X(L)=XX
10900 Y(L)=YY
11000
11100 C RETURN
11200 100 IF(IPEN.GT.0) RETURN
11300
11400 C THE LAST CALL
11500 IF (KON.EQ.0) NS=NS+1
11600 NRSEG=N
11700 IFRST=0
11800 IF(NS.LT.N) NRSEG=NS
11900
12000 C DEALLOCATE ONE SEGMENT
12100 LN=NRSEG
12200 160 IF(NRSEG) 150,150,120
12300 120 CALL DELETE(X,Y,IFRONT,IREAR,XN,YN,IS,LN,WASTE)
12400 L=IFRONT(IS)
12500 X(L)=9999.
12600 Y(L)=9999.
12700 IREAR(IS)=L
12800 NRSEG=NRSEG-1
12900 GO TO 160
13000 150 CALL PLOT(XX,YY,-3)
13100 RETURN
13200 END
13300
13400
13500
13600 C DELETE (X,Y,IFRONT,IREAR,XN,YN,IS,N,WASTE)
13700 C THE SELECTION OF THE NEXT CURVE AND ITS PLOTTING. THIS RPOGRAM IS
13800 C USED ONLY BY OPLOT.
13900 C INTERNAL VARIABLES:
14000 C DN THE MINIMUM DISTANCE TO THE NEXT CURVE SEGMENT.
14100 C D,G THE DISTANCES TO A CERTAIN CURVE SEGMENT.
14200 C IDIR THE DIRECTION OF THE CURVE DRAWING:
14300 C =1, IF THE DIRECTION IS FROM THE FIRST TO THE LAST COORDINATE,
14400 C =-1, FOR THE OPPOSITE.
14500 C L THE INDEX OF THE LAST POINT.
14600 C IA THE INDEX OF THE CURRENT POINT.
14700 SUBROUTINE DELETE(X,Y,IFRONT,IREAR,XN,YN,IS,N,WASTE)
14800 DIMENSION X(1),Y(1),IFRONT(1),IREAR(1)
14900 DN=9999999999.
15000 DO 45 J=1,N
15100
15200 C DETERMINE THE DISTANCE AND TEST, IF MINIMUM
15300 D= ABS(XN-X(IFRONT(J)))
15400 G= ABS(YN-Y(IFRONT(J)))
15500 IF (G.GT.D) D=G
15600 IF (D.GE.DN) GO TO 42
15700 DN = D
15800 IS=J
15900 IDIR=1
16000 42 D= ABS(XN-X(IREAR(J)))
16100 G= ABS(YN-Y(IREAR(J)))
16200 IF (G.GT.D) D=G
16300 IF(D.GE.DN) GO TO 45
16400 DN=D
16500 IS=J
16600 IDIR=-1
16700 45 CONTINUE
16800
16900 C PLOTTING OF THE SEGMENT
17000 C CHOOSE THE DIRECTION
17100 IF(IDIR) 81,82,82
17200 81 L=IFRONT(IS)
17300 IA=IREAR(IS)
17400 XN=X(L)
17500 YN=Y(L)
17600 GO TO 85
17700 82 L=IREAR(IS)
17800 IA=IFRONT(IS)
17900 XN=X(L)
18000 YN=Y(L)
18100 85 CALL PLOT(X(IA),Y(IA),3)
18200 CALL PLOT(X(IA),Y(IA),2)
18300
18400 C LOOP
18500 I=2
18600 86 IF(I.GT.(IREAR(IS)-IFRONT(IS)+1)) GO TO 87
18700 I=I+1
18800 IA=IA+IDIR
18900 CALL PLOT (X(IA),Y(IA),1)
19000 GO TO 86
19100
19200 C MARK THE SEGMENT FREE
19300 87 IREAR(IS)=IFRONT(IS)-1
19400 CALL PLOT(XN,YN,3)
19500 WASTE=WASTE+DN
19600 RETURN
19700 END