]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gdraw/gdrawp.F
100 parameters now allowed for geant shapes
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdrawp.F
CommitLineData
fe4da5cc 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)
16C.
17C. ******************************************************************
18C. * *
19C. * Draw the polyline described by U and V vectors, *
20C. * of length NP. *
21C. * *
22C. * Depending on IDVIEW it draws on screen (IDVIEW=0) *
23C. * or stores in the current view bank (IDVIEW>0). *
24C. * *
25C. * In LINATT (common GCDRAW) there is *
26C. * a bit mask for the line attributes : *
27C. * *
28C. * Bit 1- 7 = Used by view bank (LENGU) *
29C. * Bit 8-10 = Line width *
30C. * Bit 11-13 = Line style *
31C. * Bit 14-16 = Fill area *
32C. * Bit 17-24 = Line color *
33C. * *
34C. * ==>Called by : GDRAWV *
35C. * Author : P.Zanarini ; S.Giani 1992 ******** *
36C. * *
37C. ******************************************************************
38C.
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/
50C.
51C. ------------------------------------------------------------------
52C.
53 LLEP=ABS(LEP)
54 LINFLA=0
55 IF (IDVIEW.EQ.0.OR.IDVIEW.EQ.-175) GO TO 40
56C
57C Store on view bank IDVIEW
58C
59 JV=LQ(JDRAW-IDVIEW)
60 IGU=IGU+1
61C
62 10 IF (IGU.LE.MAXGU) GO TO 20
63C
64C Push graphic unit banks
65C
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
78C
79 20 IF ((IGS+NP).LE.MAXGS) GO TO 30
80C
81C Push graphic segment banks
82C
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
96C
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)
112C
113C Bit 1- 7 = LENGU
114C Bit 8-24 = Line attribute
115C
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
125C
126 Q(JV2+IGU)=IGS+1
127 IGS=IGS+NP
128 GO TO 999
129C
130C Draw vectors on screen
131C
132 40 CONTINUE
133C
134C Extract the new line attributes
135C
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)
154C
155C If NP=1 draw a marker
156C
157 IF (NP.EQ.1) THEN
158 CALL IPM(1,U,V)
159 ELSE
160C
161C
162C Fill area
163C
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
171C
172C If NP>1 draw a line with a given style
173C and draw black edges both for HIDE OFF
174C and SHAD options in case of FILL
175C
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)
192C
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)
197C
198 ENDIF
199 ENDIF
200C
201 ENDIF
202C
203 GO TO 999
204C
205 50 WRITE (CHMAIL,10000)
206 CALL GMAIL(0,0)
207C
20810000 FORMAT (' *** GDRAWP ***: Memory overflow in pushing a bank')
209 999 END
210