\def\fileversion{0.1}%
\def\filedate{2002/08/06}%
\message{`PST-MIRROR v\fileversion, \filedate\space (Manuel LUQUE)}%
\csname PSTMirrorLoaded\endcsname
\let\PSTMirrorLoaded\endinput
% Require PSTricks and pst-node packages
\ifx\PSTricksLoaded\endinput\else\input pstricks.tex\fi
\ifx\PSTnodesLoaded\endinput\else\input pst-node.tex\fi
% DPC interface to the `keyval' package (until keyval based version of PSTricks)
\input pst-key.tex
%
\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
\SpecialCoor

\pstheader{boulemiroir.pro}
%
\definecolor{Beige} {rgb}{0.96,0.96,0.86}
\definecolor{GrisClair} {rgb}{0.8,0.8,0.8}
\definecolor{GrisTresClair} {rgb}{0.9,0.9,0.9}
\definecolor{OrangeTresPale}{cmyk}{0,0.1,0.3,0}
\definecolor{OrangePale}{cmyk}{0,0.2,0.4,0}
\definecolor{BleuClair}{cmyk}{0.2,0,0,0}
\definecolor{LightBlue}{rgb}{.68,.85,.9}
\definecolor{DarkGreen}{rgb}{0,.85,0}
\definecolor{Copper}{cmyk}{0,0.9,0.9,0.2}
%%%%
\SpecialCoor
\makeatletter
\define@key{psset}{Xmax}{\edef\psk@boule@Xmax{#1}} % en cm
\define@key{psset}{Xmin}{\edef\psk@boule@Xmin{#1}} % en cm
\define@key{psset}{Ymax}{\edef\psk@boule@Ymax{#1}} % en cm
\define@key{psset}{Ymin}{\edef\psk@boule@Ymin{#1}} % en cm
\define@key{psset}{pas}{\edef\psk@boule@pas{#1}} % en cm résolution du tracé
\define@key{psset}{scale}{\edef\psk@boule@scale{#1}} % echelle
\define@key{psset}{distance}{\edef\psk@boule@Distance{#1}} % Distance du quadrillage à la boule en cm
\define@key{psset}{Rayon}{\edef\psk@boule@Rayon{#1}} % rayon de la boule en cm
\define@key{psset}{grille}{\edef\psk@boule@grille{#1}} % Pas de la grille en cm
\define@key{psset}{normaleLongitude}{\edef\psk@boule@normaleLongitude{#1}} % coordonnées angulaires de la normale
\define@key{psset}{normaleLatitude}{\edef\psk@boule@normaleLatitude{#1}} % coordonnées angulaires de la normale
\define@key{psset}{Xorigine}{\edef\psk@boule@Xorigine{#1}} % coordonnées de la nouvelle origine
\define@key{psset}{Yorigine}{\edef\psk@boule@Yorigine{#1}} % coordonnées de la nouvelle origine
\define@key{psset}{Zorigine}{\edef\psk@boule@Zorigine{#1}} % coordonnées de la nouvelle origine
\define@key{psset}{RotX}{\edef\psk@boule@RotX{#1}} % rotation autour de Ox en degrés
\define@key{psset}{RotY}{\edef\psk@boule@RotY{#1}} % rotation autour de Oy en degrés
\define@key{psset}{RotZ}{\edef\psk@boule@RotZ{#1}} % rotation autour de OZ en degrés
\define@key{psset}{A}{\edef\psk@boule@A{#1}} % double  d'une arête du parallèlépipède
\define@key{psset}{B}{\edef\psk@boule@B{#1}} % double  d'une arête du parallèlépipède
\define@key{psset}{C}{\edef\psk@boule@C{#1}} % double  de l'arête du parallèlépipède
\define@key{psset}{CX}{\edef\psk@boule@Xc{#1}} % abscisse du centre du paarallèlépipède
\define@key{psset}{CY}{\edef\psk@boule@Yc{#1}} % ordonnée centre du cube
\define@key{psset}{CZ}{\edef\psk@boule@Zc{#1}} % cote centre du cube
\define@key{psset}{Rtetraedre}{\edef\psk@boule@Rtetraedre{#1}} % Rayon du cercle tétraèdre
\define@key{psset}{ColorFaceA}{\edef\psk@boule@TetraedreColorFaceA{#1}} % couleur de la face A du tétraèdre
\define@key{psset}{ColorFaceB}{\edef\psk@boule@TetraedreColorFaceB{#1}} % couleur de la face B du tétraèdre
\define@key{psset}{ColorFaceC}{\edef\psk@boule@TetraedreColorFaceC{#1}} % couleur de la face C du tétraèdre
\define@key{psset}{ColorFaceD}{\edef\psk@boule@TetraedreColorFaceD{#1}} % couleur de la face D du tétraèdre
\define@key{psset}{ColorFaceE}{\edef\psk@boule@TetraedreColorFaceE{#1}} % couleur de la face D du tétraèdre
\define@key{psset}{fracHcone}{\edef\psk@boule@fracHcone{#1}} % fraction de la hauteur du cone
\define@key{psset}{Hpyramide}{\edef\psk@boule@Hpyramide{#1}} % hauteur pyramide
%
\setkeys{psset}{Xmax=50,%
                Ymax=50,%
                Xmin=-50,%
                Ymin=-50,%
                pas=1,%
                grille=10,%
                distance=30,%
                Rayon=10,%
                scale=1,%
                normaleLongitude=45,%
                normaleLatitude=45,%
                Xorigine=\psk@boule@Distance,%
                Yorigine=0,%
                Zorigine=0,%
                RotX=0,RotY=0,RotZ=0,%
                A=10,B=10,C=10,%
                CX=0,CY=0,CZ=0,%
                Rtetraedre=5,%
                ColorFaceD=cyan,ColorFaceA=magenta,ColorFaceB=red,ColorFaceC=blue,ColorFaceE=yellow,%
                fracHcone=1,Hpyramide=5}
%
\newif\ifPst@MirrorBoule
\define@key{psset}{Boule}[true]{\@nameuse{Pst@MirrorBoule#1}}
\setkeys{psset}{Boule=true}
%
\def\variablesBoule{%
 0 0 translate
    /Xmax \psk@boule@Xmax\space def
    /Ymax \psk@boule@Ymax\space def
    /Xmin \psk@boule@Xmin\space def
    /Ymin \psk@boule@Ymin\space def
    /pas \psk@boule@pas\space def
    /Xabscisse \psk@boule@Distance\space def
    /Rayon \psk@boule@Rayon\space def
    /grille \psk@boule@grille\space def
    /reduction \psk@boule@scale\space def
    /nTheta \psk@boule@normaleLongitude\space def
    /nPhi \psk@boule@normaleLatitude\space def
    /S1 \psk@boule@normaleLongitude\space sin def
    /C1 \psk@boule@normaleLongitude\space cos def
    /S2 \psk@boule@normaleLatitude\space sin def
    /C2 \psk@boule@normaleLatitude\space cos def
    /RotX \psk@boule@RotX\space def
    /RotY \psk@boule@RotY\space def
    /RotZ \psk@boule@RotZ\space def
    /CX \psk@boule@Xc\space def
    /CY \psk@boule@Yc\space def
    /CZ \psk@boule@Zc\space def
    /A \psk@boule@A\space def
    /B \psk@boule@B\space def
    /C \psk@boule@C\space def
    /RayonBaseTetraedre \psk@boule@Rtetraedre\space def
    /Hpyramide \psk@boule@Hpyramide\space def
    /Rpoint A 4 div def
    /M11 RotZ cos RotY cos mul def
    /M12 RotZ cos RotY sin mul RotX sin mul
         RotZ sin RotX cos mul sub def
    /M13 RotZ cos RotY sin mul RotX cos mul
         RotZ sin RotX sin mul add def
    /M21 RotZ sin RotY cos mul def
    /M22 RotZ sin RotY sin RotX sin mul mul
         RotZ cos RotX cos mul add def
    /M23 RotZ sin RotY sin mul RotX cos mul
         RotZ cos RotX sin mul sub def
    /M31 RotY sin neg def
    /M32 RotX sin RotY cos mul def
    /M33 RotX cos RotY cos mul def
 }%

\def\Cube{\pst@object{Cube}}
\def\Cube@i{\@ifnextchar[{\Cube@do}{\Cube@do[]}}
\def\Cube@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
Cube
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\Die{
\Cube
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
Cube
PointsDie
end
}% fin du code ps
\end@ClosedObj
}
\def\Tetraedre{\pst@object{Tetraedre}}
\def\Tetraedre@i{\@ifnextchar[{\Tetraedre@do}{\Tetraedre@do[]}}
\def\Tetraedre@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
Tetraedre
end
}% fin du code ps
\end@ClosedObj
}}
%
% transformation d'un point
\def\BoulePoint{\@ifnextchar[{\pst@boulePoint}{\pst@boulePoint[]}}
%
\def\pst@boulePoint[#1](#2,#3,#4)#5{{%
%(#2,#3,#4) coordonnées
% #5 nom attribué au point
\pst@killglue
\setkeys{psset}{#1}%
\pnode(!
\variablesBoule
 /Zcote #4 def
 /Xabscisse #2 def
 /Yordonnee #3 def
tx@Boule3DDict begin
 FormulesBoule
 Xi reduction mul Yi reduction mul
 end){#5}
}}
%
\def\BouleLine{\pst@object{BouleLine}}
\def\BouleLine@i{\@ifnextchar[{\BouleLine@do}{\BouleLine@do[]}}
\def\BouleLine@do[#1](#2,#3,#4)(#5,#6,#7){{%
% (#2,#3,#4) coordonnées du point1
% (#5,#6,#7) coordonnées du point2
\pst@killglue
\setkeys{psset}{#1}%
\begin@OpenObj
\addto@pscode{%
\variablesBoule
reduction reduction scale
/X1 #2 def
/Y1 #3 def
/Z1 #4 def
/X2 #5 def
/Y2 #6 def
/Z2 #7 def
tx@Boule3DDict begin
/TableauxPoints [
0 0.01 1.01 { % k
    /K exch def
    [
    /Zcote K Z2 mul 1 K sub Z1 mul add def
    /Xabscisse K X2 mul 1 K sub X1 mul add def
    /Yordonnee K Y2 mul 1 K sub Y1 mul add def
    CalcCoordinates ]
    } for
 ] def
 TableauxPoints 0 get aload pop moveto
 0 1 100 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
% fin du tracé de la ligne
end
 }% fin du code ps
 \end@OpenObj
 }}% % fin de la commande PSTricks
%
\def\BouleCircle{\pst@object{BouleCircle}}
\def\BouleCircle@i{\@ifnextchar[{\BouleCircle@do}{\BouleCircle@do[]}}
\def\BouleCircle@do[#1]#2{{%
% #2 rayon du cercle
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
/Rcercle #2 def
\variablesBoule
/XO' \psk@boule@Xorigine\space def
/YO' \psk@boule@Yorigine\space def
/ZO' \psk@boule@Zorigine\space def
tx@Boule3DDict begin
reduction reduction scale
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /Angle exch def [
    /Xcercle Rcercle Angle cos mul def
    /Ycercle Rcercle Angle sin mul def
    /Xabscisse Xcercle S1 mul Ycercle S2 C1 mul mul add XO' add
    def
    /Yordonnee Xcercle C1 mul neg Ycercle S2 S1 mul mul add YO' add
    def
    /Zcote Ycercle C2 mul neg ZO' add def
    CalcCoordinates ]
    } for
    ] def
 TableauxPoints 0 get aload pop moveto
 0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
 end
}% fin du code ps
\showpointsfalse
\end@ClosedObj
}}
%
%
\def\BouleArc{\pst@object{BouleArc}}
\def\BouleArc@i{\@ifnextchar[{\BouleArc@do}{\BouleArc@do[]}}
\def\BouleArc@do[#1]#2#3#4{{%
% #2 rayon du cercle
% #3 angle de départ
% #4 angle d'arrivée
\pst@killglue
\setkeys{psset}{#1}%
\begin@OpenObj
\addto@pscode{%
/Rcercle #2 def
/AngleStart #3 def
/AngleStop #4 def
\variablesBoule
/XO' \psk@boule@Xorigine\space def
/YO' \psk@boule@Yorigine\space def
/ZO' \psk@boule@Zorigine\space def
tx@Boule3DDict begin
reduction reduction scale
/TableauxPoints [
AngleStart 1 AngleStop {% on décrit le cercle
    /Angle exch def [
    /Xcercle Rcercle Angle cos mul def
    /Ycercle Rcercle Angle sin mul def
    /Xabscisse Xcercle S1 mul Ycercle S2 C1 mul mul add XO' add
    def
    /Yordonnee Xcercle C1 mul neg Ycercle S2 S1 mul mul add YO' add
    def
    /Zcote Ycercle C2 mul neg ZO' add def
    CalcCoordinates ]
    } for
    ] def
 TableauxPoints 0 get aload pop moveto
 0 1 AngleStop AngleStart sub abs  {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
 end
}% fin du code ps
\showpointsfalse
\end@OpenObj
}}
%
%
\def\BouleFrame{\pst@object{BouleFrame}}
\def\BouleFrame@i{\@ifnextchar[{\BouleFrame@do}{\BouleFrame@do[]}}
\def\BouleFrame@do[#1](#2,#3)(#4,#5){{%
% (#2,#3) d'un sommet
% (#4,#5) du sommet opposé
% rectangle ABCD
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
/XA #2 def
/YA #3 def
/XC #4 def
/YC #5 def
% on en déduit les autres sommets
/XB XC def
/YB YA def
/XD XA def
/YD YC def
\variablesBoule
/XO' \psk@boule@Xorigine\space def
/YO' \psk@boule@Yorigine\space def
/ZO' \psk@boule@Zorigine\space def
tx@Boule3DDict begin
reduction reduction scale
    /Xframe XA def
    /Yframe YA def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Xframe K XB mul 1 K sub XA mul add def
    /Yframe K YB mul 1 K sub YA mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Xframe K XC mul 1 K sub XB mul add def
    /Yframe K YC mul 1 K sub YB mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Xframe K XD mul 1 K sub XC mul add def
    /Yframe K YD mul 1 K sub YC mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Xframe K XA mul 1 K sub XD mul add def
    /Yframe K YA mul 1 K sub YD mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
\def\BouleQuadrillage{\pst@object{BouleQuadrillage}}
\def\BouleQuadrillage@i{\@ifnextchar[{\BouleQuadrillage@do}{\BouleQuadrillage@do[]}}
\def\BouleQuadrillage@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@OpenObj
\addto@pscode{%
\variablesBoule
/XO' \psk@boule@Xorigine\space def
/YO' \psk@boule@Yorigine\space def
/ZO' \psk@boule@Zorigine\space def
tx@Boule3DDict begin
reduction reduction scale
Ymin grille Ymax {% balayage suivant Oy
    /Ygrille exch def
/TableauxPoints [
    Xmin pas Xmax { % balayage suivant Ox
    /Xgrille exch def
    /Xabscisse Xgrille S1 mul Ygrille S2 C1 mul mul add XO' add
    def
    /Yordonnee Xgrille C1 mul neg Ygrille S2 S1 mul mul add YO' add
    def
    /Zcote Ygrille C2 mul neg ZO' add def
    FormulesBoule
        [
         Xi 28.45 mul Yi 28.45 mul %
        ]
        } for
    ] def
 TableauxPoints 0 get aload pop moveto
 0 1 Xmax Xmin sub pas div {
    /compteur exch def
    TableauxPoints compteur get aload pop
   lineto } for
% stroke
    } for
%
Xmin grille Xmax {% balayage suivant Ox
    /Xgrille exch def
/TableauxPoints [
    Ymin pas Ymax { % balayage suivant Ox
    /Ygrille exch def
    /Xabscisse Xgrille S1 mul Ygrille S2 C1 mul mul add XO' add
    def
    /Yordonnee Xgrille C1 mul neg Ygrille S2 S1 mul mul add YO' add
    def
    /Zcote Ygrille C2 mul neg ZO' add def
    FormulesBoule
        [
         Xi 28.45 mul Yi 28.45 mul %
        ]
        } for
    ] def
 TableauxPoints 0 get aload pop moveto
  0 1 Ymax Ymin sub pas div {
    /compteur exch def
    TableauxPoints compteur get aload pop
   lineto } for
  \pst@number\pslinewidth SLW
  \pst@usecolor\pslinecolor
  \@nameuse{psls@\pslinestyle}
% stroke
    } for
\ifPst@MirrorBoule
newpath
0 0 Rayon 0.707 mul 28.45 mul 0 360 arc
[3] 0 setdash
 stroke
\fi
% fin du tracé
end
 }% fin du code ps
 \end@OpenObj
 }}% % fin de la commande PSTricks
%
\def\BouleSphere{\pst@object{BouleSphere}}
\def\BouleSphere@i{\@ifnextchar[{\BouleSphere@do}{\BouleSphere@do[]}}
\def\BouleSphere@do[#1]#2{{%
% (#2,#3,#4) coordonnées du centre
% #5 rayon
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
reduction reduction scale
    /Rsphere #2 def
    /increment 10 def
tx@Boule3DDict begin
0 increment 360 increment sub {%
    /theta exch def
-90 increment 90 increment sub {%
    /phi exch def
% newpath
    /Xpoint Rsphere theta cos mul phi cos mul def
    /Ypoint Rsphere theta sin mul phi cos mul def
    /Zpoint Rsphere phi sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
     moveto
% Centre de la facette
    /Xpoint Rsphere theta increment 2 div add cos mul phi increment 2 div add cos mul def
    /Ypoint Rsphere theta increment 2 div add sin mul phi increment 2 div add cos mul def
    /Zpoint Rsphere phi increment 2 div add sin mul def
CalculsPointsAfterTransformations
    /xCentreFacette Xabscisse def
    /yCentreFacette Yordonnee def
    /zCentreFacette Zcote def
    /xCentreFacette Xabscisse def
    /yCentreFacette Yordonnee def
    /zCentreFacette Zcote def
% normale à la facette
    /nXfacette xCentreFacette CX sub def
    /nYfacette yCentreFacette CY sub def
    /nZfacette zCentreFacette CZ sub def
% test de visibilité
    /PSfacette xCentreFacette nXfacette mul
    yCentreFacette nYfacette mul add
    zCentreFacette nZfacette mul add
    def
PSfacette 0 le {
theta 1 theta increment add {%
    /theta1 exch def
    /Xpoint Rsphere theta1 cos mul phi cos mul def
    /Ypoint Rsphere theta1 sin mul phi cos mul def
    /Zpoint Rsphere phi sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
phi 1 phi increment add {
    /phi1 exch def
    /Xpoint Rsphere theta increment add cos mul phi1 cos mul def
    /Ypoint Rsphere theta increment add sin mul phi1 cos mul def
    /Zpoint Rsphere phi1 sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
theta increment add -1 theta {%
    /theta1 exch def
    /Xpoint Rsphere theta1 cos mul phi increment add cos mul def
    /Ypoint Rsphere theta1 sin mul phi increment add cos mul def
    /Zpoint Rsphere phi increment add sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
phi increment add -1 phi {
    /phi1 exch def
    /Xpoint Rsphere theta cos mul phi1 cos mul def
    /Ypoint Rsphere theta sin mul phi1 cos mul def
    /Zpoint Rsphere phi1 sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
        } for
} if
%closepath
%fill
} for
} for
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\BouleCylindre{\pst@object{BouleCylindre}}
\def\BouleCylindre@i{\@ifnextchar[{\BouleCylindre@do}{\BouleCylindre@do[]}}
\def\BouleCylindre@do[#1]#2#3{{%
% Le centre de la base sera placé avec
% les paramètres CX,CY et CZ
% #2 rayon
% #3 hauteur
% on peut ensuite faire tourner le cylindre
% avec RotX, RotY et RotZ
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
reduction reduction scale
    /Rcylindre #2 def
    /Hcylindre #3 def
    /incrementANGLE 10 def
    /incrementHAUTEUR Hcylindre 5 div def
tx@Boule3DDict begin
0 incrementANGLE 360 {%
    /theta exch def
 0 incrementHAUTEUR Hcylindre incrementHAUTEUR sub {%
    /H exch def
% newpath
    /X1 Rcylindre theta cos mul def
    /Y1 Rcylindre theta sin mul def
    /Z1 H def
    /Xpoint X1 def
    /Ypoint Y1 def
    /Zpoint Z1 def
CalculsPointsAfterTransformations
    /Xfacette Xabscisse  def
    /Yfacette Yordonnee  def
    /Zfacette Zcote def
    CalcCoordinates
     moveto
% coordonnées du centre de la facette
    /Xpoint Rcylindre theta incrementANGLE 2 div add cos mul def
    /Ypoint Rcylindre theta incrementANGLE 2 div add sin mul def
    /Zpoint H incrementHAUTEUR 2 div add def
CalculsPointsAfterTransformations
% Point sur l'axe du cylindre
% à la même hauteur que M1
    /Zpoint Z1 def
    /Xpoint 0 def
    /Ypoint 0 def
CalculsPointsAfterTransformations
% normale à la facette
    /nXfacette Xfacette Xabscisse sub def
    /nYfacette Yfacette Yordonnee sub def
    /nZfacette Zfacette Zcote sub def
% test de visibilité
    /PSfacette nXfacette Xfacette mul
    nYfacette Yfacette mul add
    nZfacette Zfacette mul add
    def
PSfacette 0 le {
theta 1 theta incrementANGLE add {%
    /theta1 exch def
    /Xpoint Rcylindre theta1 cos mul def
    /Ypoint Rcylindre theta1 sin mul def
    /Zpoint H def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
H 1 H incrementHAUTEUR add {
    /H1 exch def
    /Xpoint Rcylindre  theta incrementANGLE add cos mul def
    /Ypoint Rcylindre theta incrementANGLE add sin mul def
    /Zpoint H1 def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
theta incrementANGLE add -1 theta {%
    /theta1 exch def
    /Xpoint Rcylindre theta1 cos mul def
    /Ypoint Rcylindre theta1 sin mul def
    /Zpoint H incrementHAUTEUR add def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
H incrementHAUTEUR add -1 H {
    /H1 exch def
    /Xpoint Rcylindre theta cos mul def
    /Ypoint Rcylindre theta sin mul def
    /Zpoint H1 def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
} if
} for
} for
% Face supérieure
% centre de la face supérieure
    /Xpoint 0 def
    /Zpoint Hcylindre def
    /Ypoint 0 def
CalculsPointsAfterTransformations
    /CxFaceSup Xabscisse def
    /CyFaceSup Yordonnee def
    /CzFaceSup Zcote def
% centre de la face inférieure
    /CxFaceInf CX def
    /CyFaceInf CY def
    /CzFaceInf CZ def
% Normale à la face supérieure
    /nXFaceSup CxFaceSup CxFaceInf sub def
    /nYFaceSup CyFaceSup CyFaceInf sub def
    /nZFaceSup CzFaceSup CzFaceInf sub def
% Visibilité face supérieure
    /PSfaceSup nXFaceSup CxFaceSup mul
               nYFaceSup CyFaceSup mul add
               nZFaceSup CzFaceSup mul add def
% Visibilité face inférieure
    /PSfaceInf CX nXFaceSup mul neg
               CY nYFaceSup mul sub
               CZ nZFaceSup mul sub def
PSfaceSup 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rcylindre theta cos mul def
    /Ypoint Rcylindre theta sin mul def
    /Zpoint Hcylindre def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
% face inférieure
PSfaceInf 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rcylindre theta cos mul def
    /Ypoint Rcylindre theta sin mul def
    /Zpoint 0 def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
 0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\BouleCone{\pst@object{BouleCone}}
\def\BouleCone@i{\@ifnextchar[{\BouleCone@do}{\BouleCone@do[]}}
\def\BouleCone@do[#1]#2#3{{%
% Le centre de la base sera placé avec
% les paramètres CX,CY et CZ
% #2 rayon
% #3 hauteur
% on peut ensuite faire tourner le cylindre
% avec RotX, RotY et RotZ
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
    /fracHcone \psk@boule@fracHcone\space def
% fraction de la hauteur du cone 0<fracHcone<1
reduction reduction scale
    /Rcone #2 def
    /Hcone #3 def
    /AngleCone Rcone Hcone atan def
    /TanAngleCone AngleCone dup sin exch cos div def
    /incrementANGLE 10 def
    /incrementHAUTEUR Hcone fracHcone mul  5 div def
tx@Boule3DDict begin
newpath
0 incrementANGLE 360 {%
    /theta exch def
 0 incrementHAUTEUR Hcone fracHcone mul incrementHAUTEUR 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
CalculsPointsAfterTransformations
    /nXfacette Xabscisse CX sub def
    /nYfacette Yordonnee CY sub def
    /nZfacette Zcote CZ sub def
%
    /OK Hcone H sub TanAngleCone mul def
    /Xpoint OK theta cos mul def
    /Ypoint OK theta sin mul def
    /Zpoint H def
CalculsPointsAfterTransformations
    /Xfacette Xabscisse  def
    /Yfacette Yordonnee  def
    /Zfacette Zcote def
    CalcCoordinates
     moveto
% 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
CalculsPointsAfterTransformations
    /XcentreFacette Xabscisse  def
    /YcentreFacette Yordonnee  def
    /ZcentreFacette Zcote def
% test de visibilité
    /PSfacette nXfacette XcentreFacette mul
    nYfacette YcentreFacette mul add
    nZfacette ZcentreFacette mul add
    def
PSfacette 0 le {
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
CalculsPointsAfterTransformations
    CalcCoordinates
    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
CalculsPointsAfterTransformations
    CalcCoordinates
    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
CalculsPointsAfterTransformations
    CalcCoordinates
    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
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
} if
} for
} for
% centre de la base inférieure après transformations
    /CxFaceInf CX def
    /CyFaceInf CY def
    /CzFaceInf CZ def
% centre de la base supérieure avant transformations
    /CxFaceSup 0 def
    /CyFaceSup 0 def
    /CzFaceSup Hcone fracHcone mul def
% Sommet du cone
    /Xpoint 0 def
    /Ypoint 0 def
    /Zpoint Hcone def
CalculsPointsAfterTransformations
    /XsommetCone Xabscisse def
    /YsommetCone Yordonnee def
    /ZsommetCone Zcote def
% 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
CalculsPointsAfterTransformations
    /CxBaseSup Xabscisse def
    /CyBaseSup Yordonnee def
    /CzBaseSup Zcote def
% Normale extérieure à la base supérieure
    /nXBaseSup XsommetCone CxFaceSup sub def
    /nYBaseSup YsommetCone CyFaceSup sub def
    /nZBaseSup ZsommetCone CzFaceSup sub def
% Visibilité de la base inférieure
    /PSbaseInfCone nXBaseInf CxFaceInf mul
                nYBaseInf CyFaceInf mul add
                nZBaseInf CzFaceInf mul add def
% Visibilité de la base supérieure
    /PSbaseSupCone nXBaseSup CxFaceSup mul
                nYBaseSup CyFaceSup mul add
                nZBaseSup CzFaceSup mul add def
PSbaseInfCone 0 le {
/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
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
PSbaseSupCone 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /OK Hcone 1 fracHcone sub mul TanAngleCone mul def
    /Xpoint OK theta cos mul def
    /Ypoint OK theta sin mul def
    /Zpoint Hcone fracHcone mul def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}%
%
% pyramide
%
\def\FaceSAB{\pst@object{FaceSAB}}
\def\FaceSAB@i{\@ifnextchar[{\FaceSABC@do}{\FaceSAB@do[]}}
\def\FaceSAB@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
SommetsPyramide
 PSAB 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Zcote K ZA mul 1 K sub ZS mul add def
    /Xabscisse K XA mul 1 K sub XS mul add def
    /Yordonnee K YA mul 1 K sub YS mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZB mul 1 K sub ZA mul add def
    /Xabscisse K XB mul 1 K sub XA mul add def
    /Yordonnee K YB mul 1 K sub YA mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZS mul 1 K sub ZB mul add def
    /Xabscisse K XS mul 1 K sub XB mul add def
    /Yordonnee K YS mul 1 K sub YB mul add def
    CalcCoordinates
    lineto
    } for
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\FaceSBC{\pst@object{FaceSBC}}
\def\FaceSBC@i{\@ifnextchar[{\FaceSBC@do}{\FaceSBC@do[]}}
\def\FaceSBC@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
SommetsPyramide
 PSBC 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Zcote K ZB mul 1 K sub ZS mul add def
    /Xabscisse K XB mul 1 K sub XS mul add def
    /Yordonnee K YB mul 1 K sub YS mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZC mul 1 K sub ZB mul add def
    /Xabscisse K XC mul 1 K sub XB mul add def
    /Yordonnee K YC mul 1 K sub YB mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZS mul 1 K sub ZC mul add def
    /Xabscisse K XS mul 1 K sub XC mul add def
    /Yordonnee K YS mul 1 K sub YC mul add def
    CalcCoordinates
    lineto
    } for
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
%
\def\FaceSCD{\pst@object{FaceSCD}}
\def\FaceSCD@i{\@ifnextchar[{\FaceSCD@do}{\FaceSCD@do[]}}
\def\FaceSCD@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
SommetsPyramide
PSCD 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Zcote K ZC mul 1 K sub ZS mul add def
    /Xabscisse K XC mul 1 K sub XS mul add def
    /Yordonnee K YC mul 1 K sub YS mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZD mul 1 K sub ZC mul add def
    /Xabscisse K XD mul 1 K sub XC mul add def
    /Yordonnee K YD mul 1 K sub YC mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZS mul 1 K sub ZD mul add def
    /Xabscisse K XS mul 1 K sub XD mul add def
    /Yordonnee K YS mul 1 K sub YD mul add def
    CalcCoordinates
    lineto
    } for
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\FaceSDA{\pst@object{FaceSDA}}
\def\FaceSDA@i{\@ifnextchar[{\FaceSDA@do}{\FaceSDA@do[]}}
\def\FaceSDA@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
SommetsPyramide
 PSDA 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Zcote K ZD mul 1 K sub ZS mul add def
    /Xabscisse K XD mul 1 K sub XS mul add def
    /Yordonnee K YD mul 1 K sub YS mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZA mul 1 K sub ZD mul add def
    /Xabscisse K XA mul 1 K sub XD mul add def
    /Yordonnee K YA mul 1 K sub YD mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZS mul 1 K sub ZA mul add def
    /Xabscisse K XS mul 1 K sub XA mul add def
    /Yordonnee K YS mul 1 K sub YA mul add def
    CalcCoordinates
    lineto
    } for
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\FaceABCD{\pst@object{FaceABCD}}
\def\FaceABCD@i{\@ifnextchar[{\FaceABCD@do}{\FaceABCD@do[]}}
\def\FaceABCD@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesBoule
tx@Boule3DDict begin
SommetsPyramide
 PSABCD 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XA def
    /Yordonnee YA def
    /Zcote ZA def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Zcote K ZB mul 1 K sub ZA mul add def
    /Xabscisse K XB mul 1 K sub XA mul add def
    /Yordonnee K YB mul 1 K sub YA mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZC mul 1 K sub ZB mul add def
    /Xabscisse K XC mul 1 K sub XB mul add def
    /Yordonnee K YC mul 1 K sub YB mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZD mul 1 K sub ZC mul add def
    /Xabscisse K XD mul 1 K sub XC mul add def
    /Yordonnee K YD mul 1 K sub YC mul add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Zcote K ZA mul 1 K sub ZD mul add def
    /Xabscisse K XA mul 1 K sub XD mul add def
    /Yordonnee K YA mul 1 K sub YD mul add def
    CalcCoordinates
    lineto
    } for
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\Pyramide{\pst@object{Pyramide}}
\def\Pyramide@i{\@ifnextchar[{\Pyramide@do}{\Pyramide@do[]}}
\def\Pyramide@do[#1]{{%
\FaceSAB[fillcolor=\psk@boule@TetraedreColorFaceA]%
\FaceSBC[fillcolor=\psk@boule@TetraedreColorFaceB]%
\FaceSCD[fillcolor=\psk@boule@TetraedreColorFaceC]%
\FaceSDA[fillcolor=\psk@boule@TetraedreColorFaceD]%
\FaceABCD[fillcolor=\psk@boule@TetraedreColorFaceE]%
}}
%
%% END: pst-mirror.tex

— Syracuse — Dernière modification : 11 août 2002 (0.07s - 3208647 - 5 juillet 2008)

Site : Accueil - Contributions - TeX au Collège - TeXPNG - Liste de diffusion - Mélusine - Recherche - SVN

Formats : JPS (BBgraf) - (La)TeX - MetaPost - PostScript - PSTricks - SWF (swftools)

Bases : Les bases - Brevet des collèges - Base Collège - Base Ipe - Base JPS - Base MetaPost - Base PSTricks

Logiciels : Asymptote - Gnu BC - ePiX - Librairie GD - Giac/Xcas - Gnuplot - Maxima - Pari GP - Scilab - TeXgraph