GEANT321/gdraw/gdrawp.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/09/30 13:37:32  ravndal
   6 * Backward compatibility for view banks
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:24  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 GDRAWP(U,V,NP)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *       Draw the polyline described by U and V vectors,          *
  20 C.    *       of length NP.                                            *
  21 C.    *                                                                *
  22 C.    *       Depending on IDVIEW it draws on screen (IDVIEW=0)        *
  23 C.    *       or stores in the current view bank (IDVIEW>0).           *
  24 C.    *                                                                *
  25 C.    *       In LINATT (common GCDRAW) there is                       *
  26 C.    *       a bit mask for the line attributes :                     *
  27 C.    *                                                                *
  28 C.    *       Bit  1- 7 = Used by view bank (LENGU)                    *
  29 C.    *       Bit  8-10 = Line width                                   *
  30 C.    *       Bit 11-13 = Line style                                   *
  31 C.    *       Bit 14-16 = Fill area                                    *
  32 C.    *       Bit 17-24 = Line color                                   *
  33 C.    *                                                                *
  34 C.    *    ==>Called by : GDRAWV                                       *
  35 C.    *       Author : P.Zanarini ; S.Giani  1992 ********             *
  36 C.    *                                                                *
  37 C.    ******************************************************************
  38 C.
  39 #include "geant321/gcbank.inc"
  40 #include "geant321/gcdraw.inc"
  41 #include "geant321/gcunit.inc"
  42 #include "geant321/gcflag.inc"
  43 #include "geant321/gcspee.inc"
  44 *
  45       COMMON/SP3D/ISPFLA
  46 *
  47       DIMENSION U(*),V(*)
  48       SAVE LFILOL
  49       DATA LFILOL/-1/
  50 C.
  51 C.    ------------------------------------------------------------------
  52 C.
  53       LLEP=ABS(LEP)
  54       LINFLA=0
  55       IF (IDVIEW.EQ.0.OR.IDVIEW.EQ.-175) GO TO 40
  56 C
  57 C             Store on view bank IDVIEW
  58 C
  59       JV=LQ(JDRAW-IDVIEW)
  60       IGU=IGU+1
  61 C
  62    10 IF (IGU.LE.MAXGU) GO TO 20
  63 C
  64 C             Push graphic unit banks
  65 C
  66       IF(MORGU.EQ.0)MORGU=100
  67       MORPUS=MAX(MORGU,MAXGU/4)
  68       JV = LQ(JV-1)
  69       CALL MZPUSH(IXCONS,JV,0,MORPUS,'I')
  70       IF(IEOTRI.NE.0)GO TO 50
  71       JV=LQ(JDRAW-IDVIEW)
  72       JV = LQ(JV-2)
  73       CALL MZPUSH(IXCONS,JV,0,MORPUS,'I')
  74       IF(IEOTRI.NE.0)GO TO 50
  75       JV=LQ(JDRAW-IDVIEW)
  76       MAXGU=MAXGU+MORPUS
  77       GO TO 10
  78 C
  79    20 IF ((IGS+NP).LE.MAXGS) GO TO 30
  80 C
  81 C             Push graphic segment banks
  82 C
  83       IF(MORGS.EQ.0)MORGS=100
  84       MORPUS=MAX(MORGS,MAXGS/4,NP)
  85       JV = LQ(JV-4)
  86       CALL MZPUSH(IXCONS,JV,0,MORPUS,'I')
  87       IF(IEOTRI.NE.0)GO TO 50
  88       JV=LQ(JDRAW-IDVIEW)
  89       JV = LQ(JV-5)
  90       CALL MZPUSH(IXCONS,JV,0,MORPUS,'I')
  91       IF(IEOTRI.NE.0)GO TO 50
  92       JV=LQ(JDRAW-IDVIEW)
  93       MAXGS=MAXGS+MORPUS
  94 *
  95       GO TO 20
  96 C
  97    30 CONTINUE
  98       Q(JV+13)=GTHETA
  99       Q(JV+14)=GPHI
 100       Q(JV+15)=GPSI
 101       Q(JV+16)=GU0
 102       Q(JV+17)=GV0
 103       Q(JV+18)=GSCU
 104       Q(JV+19)=GSCV
 105       JV1=LQ(JV-1)
 106       JV2=LQ(JV-2)
 107       JV4=LQ(JV-4)
 108       JV5=LQ(JV-5)
 109 *
 110       CALL UCOPY(U,Q(JV4+IGS+1),NP)
 111       CALL UCOPY(V,Q(JV5+IGS+1),NP)
 112 C
 113 C             Bit 1- 7 = LENGU
 114 C             Bit 8-24 = Line attribute
 115 C
 116       ISUM=0
 117       CALL MVBITS(LINATT,0,24,ISUM,0)
 118       IFIL=IBITS(ISUM,13,3)
 119       IF(IFIL.EQ.0)THEN
 120          CALL MVBITS(NP,0,7,ISUM,0)
 121       ELSE
 122          CALL MVBITS(NP,0,10,ISUM,0)
 123       ENDIF
 124       Q(JV1+IGU)=ISUM
 125 C
 126       Q(JV2+IGU)=IGS+1
 127       IGS=IGS+NP
 128       GO TO 999
 129 C
 130 C             Draw vectors on screen
 131 C
 132    40 CONTINUE
 133 C
 134 C             Extract the new line attributes
 135 C
 136       LINCOL=IBITS(LINATT,16,8)
 137       CALL ISFACI(LINCOL)
 138       LINFIL=IBITS(LINATT,13,3)
 139       IF(IDVIEW.NE.-175.OR.LINFIL.EQ.0)THEN
 140          LINWID=IBITS(LINATT,7,3)
 141          IF(LINWID.GT.1)LINWID=LINWID*2
 142       ELSE
 143          LINWID=8-LINFIL
 144          IF(LINFIL.EQ.1)LINWID=2
 145          IF(LINWID.GT.1)LINWID=LINWID*2
 146          IF(ZZFV.GT.1.)LINWID=LINWID*ZZFV
 147       ENDIF
 148       LINSTY=IBITS(LINATT,10,3)
 149       IF(LINSTY.EQ.7)LINSTY=1
 150       IF(LINFIL.LE.1.OR.IDVIEW.EQ.-175.OR.ISPFLA.EQ.1)
 151      +CALL ISPLCI(LINCOL)
 152       WLINW=LINWID
 153       CALL IGSET('LWID',WLINW)
 154 C
 155 C             If NP=1 draw a marker
 156 C
 157       IF (NP.EQ.1) THEN
 158          CALL IPM(1,U,V)
 159       ELSE
 160 C
 161 C
 162 C             Fill area
 163 C
 164 *SG
 165          IF(IDVIEW.EQ.-175)THEN
 166             IF(LINFIL.GT.0.AND.NP.GT.2.AND.LINSTY.NE.6)THEN
 167                CALL ISFAIS(1)
 168                CALL IFA(NP,U,V)
 169             ENDIF
 170          ENDIF
 171 C
 172 C             If NP>1 draw a line with a given style
 173 C             and draw black edges both for HIDE OFF
 174 C             and SHAD options in case of FILL
 175 C
 176          CALL UCTOH('ON  ',IFLH,4,4)
 177          IF(IHIDEN.NE.IFLH.AND.LINFIL.GT.0)THEN
 178            CALL ISPLCI(1)
 179          ENDIF
 180          IF(LINSTY.EQ.6.AND.LINFIL.NE.0)THEN
 181             LINSTY=1
 182             LINFLA=1
 183             CALL ISPLCI(1)
 184             CALL IGSET('LWID',3.)
 185             IF(LINWID.GE.12)CALL IGSET('LWID',6.)
 186             IF(LINWID.LE.4)CALL IGSET('LWID',1.)
 187          ENDIF
 188          IF(LLEP.LE.10.OR.LINFIL.EQ.0.OR.LINFLA.NE.1)THEN
 189             IF (LINSTY.EQ.1) THEN
 190 ***            call write_dxf_pline(np,u,v,lincol,linwid,1)
 191                CALL IPL(NP,U,V)
 192 C
 193             ELSE IF (LINSTY.GT.1.AND.LINSTY.LE.4) THEN
 194                CALL ISLN(LINSTY)
 195                CALL IPL(NP,U,V)
 196                CALL ISLN(1)
 197 C
 198             ENDIF
 199          ENDIF
 200 C
 201       ENDIF
 202 C
 203       GO TO 999
 204 C
 205    50 WRITE (CHMAIL,10000)
 206       CALL GMAIL(0,0)
 207 C
 208 10000 FORMAT (' *** GDRAWP ***: Memory overflow in pushing a bank')
 209   999 END
 210