GEANT321/gdraw/gdrawv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/09/30 13:37:24  ravndal
   6 * Backward compatibility for view banks
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:27  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GDRAWV(U,V,NP)
  16 C.
  17 C.    ******************************************************************
  18 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.                             *
  23 C.    *                                                                *
  24 C.    *       Variables used in the routine :                          *
  25 C.    *                                                                *
  26 C.    *       EPS    = Error range of user coordinates until which     *
  27 C.    *                they are considered as coincident points        *
  28 C.    *                                                                *
  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)     *
  33 C.    *                                                                *
  34 C.    *       NSEG   = Current number of segments                      *
  35 C.    *       MAXSEG = Max number of segments                          *
  36 C.    *       MAXNEW = Max length of polyline                          *
  37 C.    *                                                                *
  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          *
  42 C.    *                                                                *
  43 C.    *                (X,Y,IEMPTY are dimensioned to MAXSEG*2)        *
  44 C.    *                                                                *
  45 C.    *       IATTL  = Vector of attributes of input segments,         *
  46 C.    *                dimensioned to MAXSEG                           *
  47 C.    *                                                                *
  48 C.    *       XNEW   = Vector of x-coordinates of output polyline      *
  49 C.    *       YNEW   = Vector of y-coordinates of output polyline      *
  50 C.    *                                                                *
  51 C.    *                (XNEW,YNEW are dimensioned to MAXNEW)           *
  52 C.    *                                                                *
  53 C.    *       LUDEB  = If < 0 then no debug printout will be done      *
  54 C.    *                                                                *
  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)      *
  58 C.    *                                                                *
  59 C.    *       LINBUF = Flag to determine if GDRAWV has to perform      *
  60 C.    *                line buffering logic (LINBUF=1) or not          *
  61 C.    *                                                                *
  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  *********            *
  67 C.    *                                                                *
  68 C.    ******************************************************************
  69 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"
  75       CHARACTER*80 ILINE
  76       DIMENSION U(*),V(*)
  77       DIMENSION X(160),Y(160),IEMPTY(160)
  78       DIMENSION IATTL(80)
  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
  83       DATA MAXSEG/80/
  84       DATA MAXNEW/45/
  85       DATA EPS/0.00001/
  86       DATA LUDEB/-1/
  87       DATA ISTF/0/
  88       DATA IDBERR,IDBIST/50*0/
  89 C.
  90 C.    ------------------------------------------------------------------
  91 C.
  92       IF (NP.EQ.-1) THEN
  93 C
  94 C             Initialize (open) the line buffer
  95 C
  96          LINBUF=1
  97          NSEG=0
  98          INEW=0
  99          GO TO 999
 100 C
 101       ELSE IF (NP.EQ.0) THEN
 102 C
 103 C             Empties (close) the line buffer
 104 C
 105          LINBUF=0
 106          GO TO 10
 107 C
 108       ELSE IF (NP.GT.2) THEN
 109 C
 110 C             Call directly GDRAWP
 111 C
 112          CALL GDRAWP(U,V,NP)
 113          GO TO 999
 114 C
 115 C
 116       ELSE IF (LINBUF.EQ.0) THEN
 117 C
 118 C             Call directly GDRAWP
 119 C
 120          CALL GDRAWP(U,V,NP)
 121          GO TO 999
 122 C
 123       ENDIF
 124 C
 125       LTY=IBITS(LINATT,10,3)
 126       CALL UCTOH('ON  ',IFLH,4,4)
 127       IF(LTY.NE.6.AND.IHIDEN.EQ.IFLH)THEN
 128          CALL GDRAWP(U,V,NP)
 129          GO TO 999
 130       ENDIF
 131 C             Fill the line buffer
 132 C
 133       NSEG=NSEG+1
 134       IATTL(NSEG)=LINATT
 135 C
 136       NPOINT=NSEG*2
 137       X(NPOINT-1)=U(1)
 138       Y(NPOINT-1)=V(1)
 139       X(NPOINT)=U(2)
 140       Y(NPOINT)=V(2)
 141 C
 142       IF (NSEG.NE.MAXSEG) GO TO 999
 143 C
 144 C             Line buffer full : check for joined lines
 145 C
 146 C             Initialisation phase
 147 C
 148    10 CONTINUE
 149 C
 150       I0=1
 151       INEW=0
 152       NPOINT=NSEG*2
 153 C
 154       DO 20 I=1,NPOINT
 155          IEMPTY(I)=0
 156    20 CONTINUE
 157 C
 158 C             Loop phase
 159 C
 160    30 CONTINUE
 161 C
 162       NPOINT=NSEG*2
 163 C
 164       DO 40 K=I0,NPOINT
 165          IF (IEMPTY(K).EQ.0) GO TO 50
 166    40 CONTINUE
 167 C
 168 C             Buffer empty
 169 C
 170       NSEG=0
 171       GO TO 999
 172 C
 173    50 CONTINUE
 174 C
 175       KDIV2=(K+1)/2
 176       IF (INEW.EQ.0) LINATT=IATTL(KDIV2)
 177 C
 178       I1=K
 179       INEW=INEW+1
 180       XNEW(INEW)=X(I1)
 181       YNEW(INEW)=Y(I1)
 182       IEMPTY(I1)=1
 183       I0=I1
 184 C
 185    60 CONTINUE
 186 C
 187       IF ((I1/2)*2.EQ.I1) THEN
 188          I2=I1-1
 189       ELSE
 190          I2=I1+1
 191       ENDIF
 192 C
 193       I2DIV2=(I2+1)/2
 194       IF (INEW.EQ.0) LINATT=IATTL(I2DIV2)
 195 C
 196       INEW=INEW+1
 197       XNEW(INEW)=X(I2)
 198       YNEW(INEW)=Y(I2)
 199       IEMPTY(I2)=1
 200 C
 201       IF (INEW.EQ.MAXNEW) THEN
 202          IF (LUDEB.GE.0) THEN
 203             WRITE (CHMAIL,10000) NAMES(NLEVEL),INEW
 204             CALL GMAIL(0,0)
 205          ENDIF
 206          IDBERR(1)=IDBERR(1)+1
 207          GO TO 70
 208       ENDIF
 209 C
 210 C             Link is closed ?
 211 C
 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
 214 C
 215 C             Link closed
 216 C
 217    70 CONTINUE
 218 C
 219       IF (INEW.GT.3) THEN
 220          CALL GDRAWP(XNEW,YNEW,INEW)
 221       ELSE
 222          IF (INEW.EQ.3) CALL GDRAWP(XNEW,YNEW,INEW)
 223          IF (LUDEB.GE.0) THEN
 224             WRITE (CHMAIL,10100) NAMES(NLEVEL),INEW
 225             CALL GMAIL(0,0)
 226          ENDIF
 227          IDBERR(2)=IDBERR(2)+1
 228       ENDIF
 229 C
 230    80 CONTINUE
 231 C
 232 C             Do some statistics if in statistics mode
 233 C
 234       IF (ISTF.EQ.1) THEN
 235          IF (INEW.LE.3) GO TO 120
 236          LENPOL=INEW-1
 237    90    CONTINUE
 238          DO 100 I=1,20
 239             IF (LENPOL.EQ.IDBIST(1,I)) THEN
 240                IDBIST(2,I)=IDBIST(2,I)+1
 241                GO TO 120
 242             ENDIF
 243   100    CONTINUE
 244          DO 110 I=1,20
 245             IF (IDBIST(1,I).EQ.0) THEN
 246                IDBIST(1,I)=LENPOL
 247                GO TO 90
 248             ENDIF
 249   110    CONTINUE
 250          WRITE (CHMAIL,10800) LENPOL
 251          CALL GMAIL(0,0)
 252   120    CONTINUE
 253       ENDIF
 254 C
 255       IF (LUDEB.LT.0) GO TO 130
 256 C
 257 C             Do some printout if in debugging mode
 258 C
 259       LENPOL=INEW-1
 260       WRITE (CHMAIL,10400) NAMES(NLEVEL),LENPOL
 261       CALL GMAIL(0,0)
 262       IC0=I0/2
 263       IF ((I0/2)*2.NE.I0) IC0=IC0+1
 264       IC1=I1/2
 265       IF ((I1/2)*2.NE.I1) IC1=IC1+1
 266       ILINE=' '
 267       ILINE(IC1:IC1)='1'
 268       ILINE(IC0:IC0)='0'
 269       WRITE (CHMAIL,10500) I0,I1,I2,INEW,NSEG
 270       CALL GMAIL(1,0)
 271       WRITE (CHMAIL,10600) ILINE(1:NSEG)
 272       CALL GMAIL(0,0)
 273       NPOINT=NSEG*2
 274       NPOIN1=NPOINT-1
 275       WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=1,NPOIN1,2)
 276       CALL GMAIL(0,0)
 277       WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=2,NPOINT,2)
 278       CALL GMAIL(0,0)
 279 C
 280   130 CONTINUE
 281       INEW=0
 282       GO TO 30
 283 C
 284   140 CONTINUE
 285 C
 286       NPOINT=NSEG*2
 287 C
 288 C             Compute starting point of next segment
 289 C
 290       NEXT=0
 291 C
 292       DO 150 K=I0,NPOINT
 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
 296          NEXT=K
 297          GO TO 160
 298   150 CONTINUE
 299 C
 300   160 CONTINUE
 301 C
 302       IF (NEXT.NE.0) THEN
 303          I1=NEXT
 304          IEMPTY(I1)=1
 305          GO TO 60
 306       ENDIF
 307 C
 308       IF (I0.EQ.1) THEN
 309          CALL GDRAWP(XNEW,YNEW,INEW)
 310          IF (LUDEB.GE.0) THEN
 311             WRITE (CHMAIL,10200) NAMES(NLEVEL),INEW
 312             CALL GMAIL(0,0)
 313          ENDIF
 314          IDBERR(3)=IDBERR(3)+1
 315          GO TO 80
 316       ENDIF
 317 C
 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
 321 C
 322       DO 170 I=I0,NPOINT
 323          IEMPTY(I)=0
 324   170 CONTINUE
 325 C
 326       NSEGOL=NSEG
 327 C
 328 C             Try to see if the buffers can be shifted
 329 C
 330   180 CONTINUE
 331 C
 332       DO 190 NLIN=1,NSEG
 333          IF (IEMPTY(NLIN*2).EQ.0) GO TO 210
 334   190 CONTINUE
 335 C
 336       IF (NSEG.NE.NSEGOL) THEN
 337 C
 338 C             The buffers have been shifted enough
 339 C
 340          GO TO 230
 341 C
 342       ELSE
 343 C
 344 C             The buffers cannot be shifted at all
 345 C
 346          IF (LUDEB.GE.0) THEN
 347             WRITE (CHMAIL,10300) NAMES(NLEVEL)
 348             CALL GMAIL(0,0)
 349          ENDIF
 350          IDBERR(4)=IDBERR(4)+1
 351          LINATT=IATTL(1)
 352          DO 200 I=1,NSEG
 353             J=I*2-1
 354             CALL GDRAWP(X(J),Y(J),2)
 355   200    CONTINUE
 356          INEW=0
 357          GO TO 30
 358 C
 359       ENDIF
 360 C
 361   210 CONTINUE
 362 C
 363 C             Shift the buffers
 364 C
 365       IF (NLIN.EQ.1) GO TO 230
 366       NSEG=NSEG-NLIN+1
 367       N=NSEG*2
 368       J=NLIN*2-2
 369       DO 220 I=1,N
 370          X(I) = X(J+I)
 371          Y(I) = Y(J+I)
 372          IEMPTY(I) = IEMPTY(J+I)
 373   220 CONTINUE
 374       CALL UCOPY(IATTL(NLIN),IATTL(1),NSEG)
 375 C
 376       IF (NSEG.GT.0) GO TO 180
 377 C
 378       GO TO 999
 379 C
 380   230 CONTINUE
 381 C
 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
 385 C
 386       IF (NP.EQ.0.AND.NSEG.GT.0) GO TO 10
 387 C
 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)
 395 10600 FORMAT (1X,A)
 396 10700 FORMAT (1X,80I1)
 397 10800 FORMAT (' *** STATISTICS OVERFLOW ***   LENPOL =',I3)
 398   999 END