sphericalcap_object.tex

\makeatletter
\pstheader{sphereII.pro}
\define@key[psset]{pst-V3D}{unitgrid}{\def\psk@IIID@unitgrid{#1}}       % pas du maillage
\psset[pst-V3D]{unitgrid=10}
\define@key[psset]{pst-V3D}{startlatitude}{\def\psk@IIID@startlatitude{#1}}       % angle de départ
\psset[pst-V3D]{startlatitude=0}
\define@key[psset]{pst-V3D}{sepTheta}{\def\pst@VIIID@sepTheta{#1}} % décalage des méridiens
 
 
\psset[pst-V3D]{sepTheta=0}%
 
\def\psCapSphere{\pst@object{psCapSphere}}
\def\psCapSphere@i(#1,#2,#3)#4{{%
% (#1,#2,#3) coordinates of the center
% #4 rayon
  \begin@ClosedObj
    \use@par
        \addto@pscode{%
    1 setlinejoin
    \tx@parametresIIID
/sepTheta \pst@VIIID@sepTheta\space def
            /CX #1 def
            /CY #2 def
            /CZ #3 def
            /Rsphere #4 def
            /increment \psk@IIID@unitgrid\space def
            /condition {PSfacette 0 ge} def
            /departPhi \psk@IIID@startlatitude\space def
            /colorBase H_S def
% centre de la base inférieure après transformations
            /CxFaceInf #1 def
            /CyFaceInf #2 def
            /CzFaceInf #3 def
/PointsApresTransformations{%
3 dict begin
  M11 Xpoint mul M12 Ypoint mul add M13 Zpoint mul add CX add
  M21 Xpoint mul M22 Ypoint mul add M23 Zpoint mul add CY add
  M31 Xpoint mul M32 Ypoint mul add M33 Zpoint mul add CZ add
end
  } def
   MaillageSphereII
   /Xpoint departPhi cos #4 mul def
   /Ypoint 0 def
   /Zpoint departPhi sin #4 mul def
    PointsApresTransformations
    /CzBaseInf ED
    /CyBaseInf ED
    /CxBaseInf ED
    /RXvueInf XpointVue CxBaseInf sub def
    /RYvueInf YpointVue CyBaseInf sub def
    /RZvueInf ZpointVue CzBaseInf sub def
% Sommet de la sphère
    /Xpoint 0 def
    /Ypoint 0 def
    /Zpoint Rsphere def
    PointsApresTransformations
    /ZsommetSphere ED
    /YsommetSphere ED
    /XsommetSphere ED
% Normale extérieure à la base inférieure
    /nXBaseInf CxFaceInf XsommetSphere sub def
    /nYBaseInf CyFaceInf YsommetSphere sub def
    /nZBaseInf CzFaceInf ZsommetSphere sub def
% Visibilité de la base inférieure
    /PSbaseSphere nXBaseInf RXvueInf mul
                  nYBaseInf RYvueInf mul add
                  nZBaseInf RZvueInf mul add def
PSbaseSphere 0 ge {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rsphere theta cos mul departPhi cos mul def
    /Ypoint Rsphere theta sin mul departPhi cos mul def
    /Zpoint Rsphere departPhi sin mul def
PointsApresTransformations
    3dto2d ]
    } for
    ] def
/BASE{
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
closepath} def
gsave
BASE
H_S 1 sethsbcolor
fill
grestore
gsave
BASE
0 setgray stroke
grestore
 } if
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
\makeatother