Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0123/oplot.qor
There is 1 other file named oplot.qor 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
19800