5 * Revision 1.2 1996/09/30 13:37:24 ravndal
6 * Backward compatibility for view banks
8 * Revision 1.1.1.1 1995/10/24 10:20:27 cernlib
12 #include "geant321/pilot.h"
13 *CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani
15 SUBROUTINE GDRAWV(U,V,NP)
17 C. ******************************************************************
19 C. * GDRAWV stores sparse segments ( NP = 2 ) in a buffer. *
20 C. * When the buffer is full it is scanned to collect *
21 C. * segments into polylines ( NP > 2 ), that will be *
22 C. * drawn by the GDRAWP routine. *
24 C. * Variables used in the routine : *
26 C. * EPS = Error range of user coordinates until which *
27 C. * they are considered as coincident points *
29 C. * I0 = Pointer to starting point of polyline (in X,Y) *
30 C. * I1 = Pointer to starting point of segment (in X,Y) *
31 C. * I2 = Pointer to ending point of segment (in X,Y) *
32 C. * INEW = Number of points of polyline (in XNEW,YNEW) *
34 C. * NSEG = Current number of segments *
35 C. * MAXSEG = Max number of segments *
36 C. * MAXNEW = Max length of polyline *
38 C. * X = Vector of x-coordinates of input segments *
39 C. * Y = Vector of y-coordinates of input segments *
40 C. * IEMPTY = Vector to flag empty points; if IEMPTY(I)=1 *
41 C. * then X(I),Y(I) has been already linked *
43 C. * (X,Y,IEMPTY are dimensioned to MAXSEG*2) *
45 C. * IATTL = Vector of attributes of input segments, *
46 C. * dimensioned to MAXSEG *
48 C. * XNEW = Vector of x-coordinates of output polyline *
49 C. * YNEW = Vector of y-coordinates of output polyline *
51 C. * (XNEW,YNEW are dimensioned to MAXNEW) *
53 C. * LUDEB = If < 0 then no debug printout will be done *
55 C. * ISTF = Flag for statistics printout; *
56 C. * if ISTF=1 a statistics of polylines length *
57 C. * will be done (to be printed interactively) *
59 C. * LINBUF = Flag to determine if GDRAWV has to perform *
60 C. * line buffering logic (LINBUF=1) or not *
62 C. * ==>Called by : <USER>, <GXINT>, GDAHIT, GDARC, GDARR, *
63 C. * GDCIRC, GDCIRR, GDCIRY, GDCUT, GDHEAD, *
64 C. * GDLINE, GDMAN, GDPRTR, GDRAW, GDRECT, *
65 C. * GDSCAL, GDSHOW, GDSURF, GDTREE *
66 C. * Author : P.Zanarini S.Giani 1992 ********* *
68 C. ******************************************************************
70 #include "geant321/gcbank.inc"
71 #include "geant321/gcdraw.inc"
72 #include "geant321/gcvolu.inc"
73 #include "geant321/gcunit.inc"
74 #include "geant321/gcspee.inc"
77 DIMENSION X(160),Y(160),IEMPTY(160)
79 DIMENSION XNEW(45),YNEW(45)
80 DIMENSION IDBIST(2,20),IDBERR(10)
81 SAVE X,Y,IEMPTY,IATTL,IDBIST,IDBERR,XNEW,YNEW
82 SAVE MAXSEG,MAXNEW,EPS,LUDEB,ISTF,NSEG,INEW
88 DATA IDBERR,IDBIST/50*0/
90 C. ------------------------------------------------------------------
94 C Initialize (open) the line buffer
101 ELSE IF (NP.EQ.0) THEN
103 C Empties (close) the line buffer
108 ELSE IF (NP.GT.2) THEN
110 C Call directly GDRAWP
116 ELSE IF (LINBUF.EQ.0) THEN
118 C Call directly GDRAWP
125 LTY=IBITS(LINATT,10,3)
126 CALL UCTOH('ON ',IFLH,4,4)
127 IF(LTY.NE.6.AND.IHIDEN.EQ.IFLH)THEN
131 C Fill the line buffer
142 IF (NSEG.NE.MAXSEG) GO TO 999
144 C Line buffer full : check for joined lines
146 C Initialisation phase
165 IF (IEMPTY(K).EQ.0) GO TO 50
176 IF (INEW.EQ.0) LINATT=IATTL(KDIV2)
187 IF ((I1/2)*2.EQ.I1) THEN
194 IF (INEW.EQ.0) LINATT=IATTL(I2DIV2)
201 IF (INEW.EQ.MAXNEW) THEN
203 WRITE (CHMAIL,10000) NAMES(NLEVEL),INEW
206 IDBERR(1)=IDBERR(1)+1
212 IF ((X(I2).LT.X(I0)-EPS).OR.(X(I2).GT.X(I0)+EPS)) GO TO 140
213 IF ((Y(I2).LT.Y(I0)-EPS).OR.(Y(I2).GT.Y(I0)+EPS)) GO TO 140
220 CALL GDRAWP(XNEW,YNEW,INEW)
222 IF (INEW.EQ.3) CALL GDRAWP(XNEW,YNEW,INEW)
224 WRITE (CHMAIL,10100) NAMES(NLEVEL),INEW
227 IDBERR(2)=IDBERR(2)+1
232 C Do some statistics if in statistics mode
235 IF (INEW.LE.3) GO TO 120
239 IF (LENPOL.EQ.IDBIST(1,I)) THEN
240 IDBIST(2,I)=IDBIST(2,I)+1
245 IF (IDBIST(1,I).EQ.0) THEN
250 WRITE (CHMAIL,10800) LENPOL
255 IF (LUDEB.LT.0) GO TO 130
257 C Do some printout if in debugging mode
260 WRITE (CHMAIL,10400) NAMES(NLEVEL),LENPOL
263 IF ((I0/2)*2.NE.I0) IC0=IC0+1
265 IF ((I1/2)*2.NE.I1) IC1=IC1+1
269 WRITE (CHMAIL,10500) I0,I1,I2,INEW,NSEG
271 WRITE (CHMAIL,10600) ILINE(1:NSEG)
275 WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=1,NPOIN1,2)
277 WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=2,NPOINT,2)
288 C Compute starting point of next segment
293 IF (K.EQ.I2) GO TO 150
294 IF ((X(I2).LT.X(K)-EPS).OR.(X(I2).GT.X(K)+EPS)) GO TO 150
295 IF ((Y(I2).LT.Y(K)-EPS).OR.(Y(I2).GT.Y(K)+EPS)) GO TO 150
309 CALL GDRAWP(XNEW,YNEW,INEW)
311 WRITE (CHMAIL,10200) NAMES(NLEVEL),INEW
314 IDBERR(3)=IDBERR(3)+1
318 C Reset flag : next call to GDRAWV will re-process
319 C the points now forming an open polyline, trying then
320 C (with the new points stored) to form a closed polyline
328 C Try to see if the buffers can be shifted
333 IF (IEMPTY(NLIN*2).EQ.0) GO TO 210
336 IF (NSEG.NE.NSEGOL) THEN
338 C The buffers have been shifted enough
344 C The buffers cannot be shifted at all
347 WRITE (CHMAIL,10300) NAMES(NLEVEL)
350 IDBERR(4)=IDBERR(4)+1
354 CALL GDRAWP(X(J),Y(J),2)
365 IF (NLIN.EQ.1) GO TO 230
372 IEMPTY(I) = IEMPTY(J+I)
374 CALL UCOPY(IATTL(NLIN),IATTL(1),NSEG)
376 IF (NSEG.GT.0) GO TO 180
382 C If last call to GDRAWV (NP=0, i.e. close the buffer)
383 C and some lines have still to be processed (NSEG>0)
384 C then don't RETURN but re-execute the body of GDRAWV
386 IF (NP.EQ.0.AND.NSEG.GT.0) GO TO 10
388 10000 FORMAT (' *** GDRAWV: ERROR 1 - NAME = ',A4,' INEW = ',I3)
389 10100 FORMAT (' *** GDRAWV: ERROR 2 - NAME = ',A4,' INEW = ',I3)
390 10200 FORMAT (' *** GDRAWV: ERROR 3 - NAME = ',A4,' INEW = ',I3)
391 10300 FORMAT (' *** GDRAWV: ERROR 4 - NAME = ',A4)
392 10400 FORMAT (' *** GDRAWV: GDRAWP called for ',A4,' (',I2,' segments)')
393 10500 FORMAT (' LOOP : I0=',I3,' - I1=',I3,' - I2=',I3,
394 + ' - INEW=',I3,' - NSEG=',I3)
396 10700 FORMAT (1X,80I1)
397 10800 FORMAT (' *** STATISTICS OVERFLOW *** LENPOL =',I3)