/ConeDict 100 dict def ConeDict begin /facette { Xfacette Yfacette Zfacette 3dto2d moveto theta 1 theta incrementANGLE add {% /theta1 exch def /OK Hcone H sub TanAngleCone mul def /Xpoint OK theta1 cos mul def /Ypoint OK theta1 sin mul def /Zpoint H def PointsApresTransformations 3dto2d lineto } for H 1 H incrementHAUTEUR add { /H1 exch def /OK Hcone H1 sub TanAngleCone mul def /Xpoint OK theta incrementANGLE add cos mul def /Ypoint OK theta incrementANGLE add sin mul def /Zpoint H1 def PointsApresTransformations 3dto2d lineto } for theta incrementANGLE add -1 theta {% /theta1 exch def /OK Hcone H incrementHAUTEUR add sub TanAngleCone mul def /Xpoint OK theta1 cos mul def /Ypoint OK theta1 sin mul def /Zpoint H incrementHAUTEUR add def PointsApresTransformations 3dto2d lineto } for H incrementHAUTEUR add -1 H { /H1 exch def /OK Hcone H1 sub TanAngleCone mul def /Xpoint OK theta cos mul def /Ypoint OK theta sin mul def /Zpoint H1 def PointsApresTransformations 3dto2d lineto } for } def /cone { 0 incrementANGLE 360 {% /theta exch def 0 incrementHAUTEUR Hcone fracHeight mul incrementHAUTEUR 0.95 mul sub {% /H exch def % normale à la facette /nXfacette Hcone AngleCone dup sin exch cos mul theta incrementANGLE 2 div add cos mul mul def /nYfacette Hcone AngleCone dup sin exch cos mul theta incrementANGLE 2 div add sin mul mul def /nZfacette Hcone AngleCone sin dup mul mul def /Xpoint nXfacette def /Ypoint nYfacette def /Zpoint nZfacette def PointsApresTransformations /zN exch CZ sub def /yN exch CY sub def /xN exch CX sub def % /OK Hcone H sub TanAngleCone mul def /Xpoint OK theta cos mul def /Ypoint OK theta sin mul def /Zpoint H def PointsApresTransformations /Zfacette exch def /Yfacette exch def /Xfacette exch def % coordonnées du centre de la facette /OK Hcone H incrementHAUTEUR 2 div add sub TanAngleCone mul def /Xpoint OK theta incrementANGLE 2 div add cos mul def /Ypoint OK theta incrementANGLE 2 div add sin mul def /Zpoint H incrementHAUTEUR 2 div add def PointsApresTransformations /ZcentreFacette ED /YcentreFacette ED /XcentreFacette ED % rayon vers point de vue /RXvue XpointVue XcentreFacette sub def /RYvue YpointVue YcentreFacette sub def /RZvue ZpointVue ZcentreFacette sub def % test de visibilité /PSfacette xN RXvue mul yN RYvue mul add zN RZvue mul add def % vecteur centre de la facette vers la source de lumière /VxLight xLight XcentreFacette sub def /VyLight yLight YcentreFacette sub def /VzLight zLight ZcentreFacette sub def % norme /normeL VxLight dup mul VyLight dup mul VzLight dup mul add add sqrt def % produit scalaire /PSLight VxLight xN mul VyLight yN mul add VzLight zN mul add def /normeN xN dup mul yN dup mul zN dup mul add add sqrt def /CosCouleur PSLight normeL normeN mul div ChangeSigne def condition { facette %H_S CosCouleur sethsbcolor fill nocolor toDraw } if } for } for } def /Bases { % centre de la base inférieure après transformations /CxFaceInf CX def /CyFaceInf CY def /CzFaceInf CZ def /Xpoint 0 def /Ypoint 0 def /Zpoint 0 def % fin modification du 16/11/2002 PointsApresTransformations /CzBaseInf ED /CyBaseInf ED /CxBaseInf ED % centre de la base supérieure avant transformations /CxFaceSup 0 def /CyFaceSup 0 def /CzFaceSup Hcone fracHeight mul def % Sommet du cone /Xpoint 0 def /Ypoint 0 def /Zpoint Hcone def PointsApresTransformations /ZsommetCone ED /YsommetCone ED /XsommetCone ED % Normale extérieure à la base inférieure /nXBaseInf CxFaceInf XsommetCone sub def /nYBaseInf CyFaceInf YsommetCone sub def /nZBaseInf CzFaceInf ZsommetCone sub def % centre de la base supérieure /Xpoint CxFaceSup def /Ypoint CyFaceSup def /Zpoint CzFaceSup def PointsApresTransformations /CzBaseSup ED /CyBaseSup ED /CxBaseSup ED % Normale extérieure à la base supérieure /nXBaseSup XsommetCone CxFaceSup sub def /nYBaseSup YsommetCone CyFaceSup sub def /nZBaseSup ZsommetCone CzFaceSup sub def % rayon vers point de vue /RXvueSup XpointVue CxBaseSup sub def /RYvueSup YpointVue CyBaseSup sub def /RZvueSup ZpointVue CzBaseSup sub def /RXvueInf XpointVue CxBaseInf sub def /RYvueInf YpointVue CyBaseInf sub def /RZvueInf ZpointVue CzBaseInf sub def % Visibilité de la base inférieure /PSbaseInfCone nXBaseInf RXvueInf mul nYBaseInf RYvueInf mul add nZBaseInf RZvueInf mul add def % Visibilité de la base supérieure /PSbaseSupCone PSbaseInfCone neg def } def /FaceInf { /TableauxPoints [ 0 1 359 {% on décrit le cercle /theta exch def [ /Xpoint Rcone theta cos mul def /Ypoint Rcone theta sin mul def /Zpoint 0 def PointsApresTransformations 3dto2d ] } for ] def TableauxPoints 0 get aload pop moveto 0 1 359 { /compteur exch def TableauxPoints compteur get aload pop lineto } for } def /FaceSup { /TableauxPoints [ 0 1 359 {% on décrit le cercle /theta exch def [ /OK Hcone 1 fracHeight sub mul TanAngleCone mul def /Xpoint OK theta cos mul def /Ypoint OK theta sin mul def /Zpoint Hcone fracHeight mul def PointsApresTransformations 3dto2d ] } for ] def TableauxPoints 0 get aload pop moveto 0 1 359 { /compteur exch def TableauxPoints compteur get aload pop lineto } for } def end