%% $Id: pst-mirror.pro 248 2021-09-14 08:57:11Z herbert $ %% %% This is file `pst-mirror.pro', %% %% IMPORTANT NOTICE: %% %% PostScript prologue for pst-mirror.tex %% %% Manuel Luque %% Herbert Voss %% %% This program can be redistributed and/or modified under the terms %% of the LaTeX Project Public License Distributed from CTAN archives %% in directory CTAN:/macros/latex/base/lppl.txt. %% %% DESCRIPTION: %% `pst-mirror' is a PSTricks package to view objects ob a spherical sphere %% %% version 1.1 2014-02-17 % %% === ajouté le 28 octobre 2011 ----------------------------------------------- %% === adapté de Jean-Michel Sarlat dans pst-anamorphosis ---------------------- /tx@Sphere3DImageDict 100 dict def tx@Sphere3DImageDict begin %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% === Capture de commandes de systemdict -------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /LINETO { systemdict /lineto get exec } def /MOVETO { systemdict /moveto get exec } def /CURVETO { systemdict /curveto get exec } def /RCURVETO { systemdict /rcurveto get exec } def /CLOSEPATH { systemdict /closepath get exec } def /RLINETO { systemdict /rlineto get exec } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% === Transformation des commandes de construction des path(s) ---------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 12/10/2011 : version incompléte et un peu brute ! /moveto { /s@y ED /s@x ED /c@x s@x def /c@y s@y def /Xpoint s@x unit_image reduction mul def /Ypoint s@y unit_image reduction mul def 2dto3d /Zpoint exch def /Ypoint exch def /Xpoint exch def CalculsPointsApresTransformations 3dto2d MOVETO } bind def /lineto { /c@yt ED /c@xt ED /dx c@xt c@x sub 50 div def /dy c@yt c@y sub 50 div def 1 1 50 {dup dx mul c@x add exch dy mul c@y add /Ypoint exch unit_image reduction mul def /Xpoint exch unit_image reduction mul def 2dto3d /Zpoint exch def /Ypoint exch def /Xpoint exch def CalculsPointsApresTransformations 3dto2d LINETO} for /c@x c@xt def /c@y c@yt def } bind def /closepath { s@x s@y lineto CLOSEPATH } bind def /curveto { /c@yt ED /c@xt ED /c@yb ED /c@xb ED /c@ya ED /c@xa ED 1 1 20 { 20 div /s ED 1 s sub /t ED t c@x mul 3 s c@xa mul mul add t mul 3 s s c@xb mul mul mul add t mul s 3 exp c@xt mul add t c@y mul 3 s c@ya mul mul add t mul 3 s s c@yb mul mul mul add t mul s 3 exp c@yt mul add /Ypoint exch unit_image reduction mul def /Xpoint exch unit_image reduction mul def 2dto3d /Zpoint exch def /Ypoint exch def /Xpoint exch def CalculsPointsApresTransformations 3dto2d LINETO } for /c@x c@xt def /c@y c@yt def } bind def /curvetoinv { /c@ya ED /c@xa ED /c@yb ED /c@xb ED /c@yt ED /c@xt ED 1 1 20 { 20 div /s ED 1 s sub /t ED t c@x mul 3 s c@xa mul mul add t mul 3 s s c@xb mul mul mul add t mul s 3 exp c@xt mul add t c@y mul 3 s c@ya mul mul add t mul 3 s s c@yb mul mul mul add t mul s 3 exp c@yt mul add /Ypoint exch unit_image reduction mul def /Xpoint exch unit_image reduction mul def 2dto3d /Zpoint exch def /Ypoint exch def /Xpoint exch def CalculsPointsApresTransformations 3dto2d LINETO } for /c@x c@xt def /c@y c@yt def } bind def /rlineto { c@y add exch c@x add exch lineto } bind def /rcurveto { c@y add 6 1 roll c@x add 6 1 roll c@y add 6 1 roll c@x add 6 1 roll c@y add 6 1 roll c@x add 6 1 roll curveto } bind def end % % /tx@Sphere3DDict 100 dict def tx@Sphere3DDict begin %% macros de %% Jean-Paul Vignault %% dans pst-solides3d %%%%% ### defpoint ### %% syntaxe : xA yA /A defpoint /defpoint { 1 dict begin /t@mp@r@ire exch def [ 3 1 roll ] cvx t@mp@r@ire exch end def } def %%%%% ### vecteur ### %% syntaxe~: A B vecteur /vecteur { %% xA yA xB yB 3 -1 roll %% xA xB yB yA sub %% xA xB yB-yA 3 1 roll %% yB-yA xA xB exch sub %% yB-yA xB-xA exch } def %%%%% ### mulv ### %% syntaxe : u a mulv --> au /mulv { %% xA, yA, a dup %% xA, yA, a, a 3 1 roll %% xA, a, yA, a mul 3 1 roll %% ayA, xA, a mul exch } def %%%%% ### addv ### %% syntaxe : u v addv --> u+v /addv { %% xA yA xB yB 3 1 roll %% xA yB yA xB 4 1 roll %% xB xA yB yA add 3 1 roll %% yB+yA xB xA add exch } def %% syntaxe : n currentpathsegmenteline --> ajoute n-1 points sur chaque %% segment droit sur le chemin courant /currentpathsegmenteline { 6 dict begin /n exch def % /warp {2 copy ptojpoint point} def %% pour remplacer 'move' /warpmove{ 2 index { newpath } if moveto pop false } def % %% pour remplacer 'lineto' /warpline { currentpoint /A defpoint /B defpoint A B vecteur /u defpoint 1 1 n { /i exch def A u i n div mulv addv %% la ligne ci-dessous est a decommenter pour verifier que ca marche % 2 copy ptojpoint point lineto } for } bind def % true { warpmove } { warpline } { curveto } { closepath } pathforall pop end } def %% fin des macros de JPV %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /Cube{% /XA M11 A mul M12 B mul add M13 C mul add CX add def /YA M21 A mul M22 B mul add M23 C mul add CY add def /ZA M31 A mul M32 B mul add M33 C mul add CZ add def /XB M11 A mul neg M12 B mul add M13 C mul add CX add def /YB M21 A mul neg M22 B mul add M23 C mul add CY add def /ZB M31 A mul neg M32 B mul add M33 C mul add CZ add def /XC M11 A mul neg M12 B mul neg add M13 C mul add CX add def /YC M21 A mul neg M22 B mul neg add M23 C mul add CY add def /ZC M31 A mul neg M32 B mul neg add M33 C mul add CZ add def /XD M11 A mul M12 B mul neg add M13 C mul add CX add def /YD M21 A mul M22 B mul neg add M23 C mul add CY add def /ZD M31 A mul M32 B mul neg add M33 C mul add CZ add def /XE M11 A mul M12 B mul add M13 C mul sub CX add def /YE M21 A mul M22 B mul add M23 C mul sub CY add def /ZE M31 A mul M32 B mul add M33 C mul sub CZ add def /XF M11 A mul neg M12 B mul add M13 C mul sub CX add def /YF M21 A mul neg M22 B mul add M23 C mul sub CY add def /ZF M31 A mul neg M32 B mul add M33 C mul sub CZ add def /XG M11 A mul neg M12 B mul sub M13 C mul sub CX add def /YG M21 A mul neg M22 B mul sub M23 C mul sub CY add def /ZG M31 A mul neg M32 B mul sub M33 C mul sub CZ add def /XH M11 A mul M12 B mul sub M13 C mul sub CX add def /YH M21 A mul M22 B mul sub M23 C mul sub CY add def /ZH M31 A mul M32 B mul sub M33 C mul sub CZ add def % Centres des faces : condition de visibilité % FACE 1 % OC1 /XC1 M13 C mul CX add def /YC1 M23 C mul CY add def /ZC1 M33 C mul CZ add def % Normale à la face 1 /NX1 M13 C mul def /NY1 M23 C mul def /NZ1 M33 C mul def % produit scalaire % ? /PS1 XC1 NX1 mul YC1 NY1 mul add ZC1 Rayon add NZ1 mul add def /PS1 XC1 NX1 mul YC1 NY1 mul add ZC1 NZ1 mul add def % FACE 2 % OC2 /XC2 M11 A mul CX add def /YC2 M21 A mul CY add def /ZC2 M31 A mul CZ add def % normale à la face 2 /NX2 M11 A mul def /NY2 M21 A mul def /NZ2 M31 A mul def % produit scalaire % ? /PS2 XC2 NX2 mul YC2 NY2 mul add ZC2 Rayon add NZ2 mul add def /PS2 XC2 NX2 mul YC2 NY2 mul add ZC2 NZ2 mul add def % FACE 3 % OC3 /XC3 M13 C neg mul CX add def /YC3 M23 C neg mul CY add def /ZC3 M33 C neg mul CZ add def % normale a la face 3 /NX3 M13 C neg mul def /NY3 M23 C neg mul def /NZ3 M33 C neg mul def % produit scalaire % ? /PS3 XC3 NX3 mul YC3 NY3 mul add ZC3 Rayon add NZ3 mul add def /PS3 XC3 NX3 mul YC3 NY3 mul add ZC3 NZ3 mul add def % FACE 4 % OC4 /XC4 M11 A neg mul CX add def /YC4 M21 A neg mul CY add def /ZC4 M31 A neg mul CZ add def % normale a la face 4 /NX4 M11 A neg mul def /NY4 M21 A neg mul def /NZ4 M31 A neg mul def % produit scalaire % ? /PS4 XC4 NX4 mul YC4 NY4 mul add ZC4 Rayon add NZ4 mul add def /PS4 XC4 NX4 mul YC4 NY4 mul add ZC4 NZ4 mul add def % FACE 5 % OC5 /XC5 M12 B neg mul CX add def /YC5 M22 B neg mul CY add def /ZC5 M32 B neg mul CZ add def % normale a la face 5 /NX5 M12 B neg mul def /NY5 M22 B neg mul def /NZ5 M32 B neg mul def % produit scalaire % /PS5 XC5 NX5 mul YC5 NY5 mul add ZC5 Rayon add NZ5 mul add def /PS5 XC5 NX5 mul YC5 NY5 mul add ZC5 NZ5 mul add def % FACE 6 % OC6 /XC6 M12 B mul CX add def /YC6 M22 B mul CY add def /ZC6 M32 B mul CZ add def % normale a la face 6 /NX6 M12 B mul def /NY6 M22 B mul def /NZ6 M32 B mul def % produit scalaire % /PS6 XC6 NX6 mul YC6 NY6 mul add ZC6 Rayon add NZ6 mul add def /PS6 XC6 NX6 mul YC6 NY6 mul add ZC6 NZ6 mul add def % faceOne PS1 0 le { % reduction reduction scale 1 setlinejoin /Yordonnee YA def /Zcote ZA def /Xabscisse XA 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 % faceTwo PS2 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 ZD mul 1 K sub ZA mul add def /Xabscisse K XD mul 1 K sub XA mul add def /Yordonnee K YD mul 1 K sub YA mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZH mul 1 K sub ZD mul add def /Xabscisse K XH mul 1 K sub XD mul add def /Yordonnee K YH mul 1 K sub YD mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZE mul 1 K sub ZH mul add def /Xabscisse K XE mul 1 K sub XH mul add def /Yordonnee K YE mul 1 K sub YH mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZA mul 1 K sub ZE mul add def /Xabscisse K XA mul 1 K sub XE mul add def /Yordonnee K YA mul 1 K sub YE mul add def CalcCoordinates lineto } for } if % face three PS3 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XE def /Yordonnee YE def /Zcote ZE def CalcCoordinates moveto 0 0.01 1 { % k /K exch def /Zcote K ZF mul 1 K sub ZE mul add def /Xabscisse K XF mul 1 K sub XE mul add def /Yordonnee K YF mul 1 K sub YE mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZG mul 1 K sub ZF mul add def /Xabscisse K XG mul 1 K sub XF mul add def /Yordonnee K YG mul 1 K sub YF mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZH mul 1 K sub ZG mul add def /Xabscisse K XH mul 1 K sub XG mul add def /Yordonnee K YH mul 1 K sub YG mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZE mul 1 K sub ZH mul add def /Xabscisse K XE mul 1 K sub XH mul add def /Yordonnee K YE mul 1 K sub YH mul add def CalcCoordinates lineto } for } if % face four PS4 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XB def /Yordonnee YB def /Zcote ZB def CalcCoordinates moveto 0 0.01 1 { % k /K exch def /Zcote K ZF mul 1 K sub ZB mul add def /Xabscisse K XF mul 1 K sub XB mul add def /Yordonnee K YF mul 1 K sub YB mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZG mul 1 K sub ZF mul add def /Xabscisse K XG mul 1 K sub XF mul add def /Yordonnee K YG mul 1 K sub YF mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZC mul 1 K sub ZG mul add def /Xabscisse K XC mul 1 K sub XG mul add def /Yordonnee K YC mul 1 K sub YG mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZB mul 1 K sub ZC mul add def /Xabscisse K XB mul 1 K sub XC mul add def /Yordonnee K YB mul 1 K sub YC mul add def CalcCoordinates lineto } for } if % face five PS5 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XC def /Yordonnee YC def /Zcote ZC def CalcCoordinates moveto 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 ZH mul 1 K sub ZD mul add def /Xabscisse K XH mul 1 K sub XD mul add def /Yordonnee K YH mul 1 K sub YD mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZG mul 1 K sub ZH mul add def /Xabscisse K XG mul 1 K sub XH mul add def /Yordonnee K YG mul 1 K sub YH mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZC mul 1 K sub ZG mul add def /Xabscisse K XC mul 1 K sub XG mul add def /Yordonnee K YC mul 1 K sub YG mul add def CalcCoordinates lineto } for } if % face six PS6 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XB def /Yordonnee YB def /Zcote ZB def CalcCoordinates moveto 0 0.01 1 { % k /K exch def /Zcote K ZA mul 1 K sub ZB mul add def /Xabscisse K XA mul 1 K sub XB mul add def /Yordonnee K YA mul 1 K sub YB mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZE mul 1 K sub ZA mul add def /Xabscisse K XE mul 1 K sub XA mul add def /Yordonnee K YE mul 1 K sub YA mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZF mul 1 K sub ZE mul add def /Xabscisse K XF mul 1 K sub XE mul add def /Yordonnee K YF mul 1 K sub YE mul add def CalcCoordinates lineto } for 0 0.01 1 { % k /K exch def /Zcote K ZB mul 1 K sub ZF mul add def /Xabscisse K XB mul 1 K sub XF mul add def /Yordonnee K YB mul 1 K sub YF mul add def CalcCoordinates lineto } for } if } def % /PointsDie{% PS6 0 le { % reduction reduction scale A 2 div neg A A 2 div { /XCpoint exch def C 2 div neg C C 2 div { /ZCpoint exch def newpath /Zpoint Rpoint ZCpoint add def /Xpoint XCpoint def /Ypoint B def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Zpoint Rpoint Angle cos mul ZCpoint add def /Xpoint Rpoint Angle sin mul XCpoint add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } for } for } if PS5 0 le { % reduction reduction scale newpath /Ypoint B neg def /XCpoint A 2 div neg def /ZCpoint C 2 div def /Xpoint Rpoint XCpoint add def /Zpoint ZCpoint def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Xpoint Rpoint Angle cos mul XCpoint add def /Zpoint Rpoint Angle sin mul ZCpoint add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill % newpath /XCpoint A 2 div def /ZCpoint C 2 div neg def /Xpoint Rpoint XCpoint add def /Zpoint ZCpoint def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Xpoint Rpoint Angle cos mul XCpoint add def /Zpoint Rpoint Angle sin mul ZCpoint add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill % newpath /XCpoint 0 def /ZCpoint 0 def /Xpoint Rpoint XCpoint add def /Zpoint ZCpoint def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Xpoint Rpoint Angle cos mul XCpoint add def /Zpoint Rpoint Angle sin mul ZCpoint add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } if PS4 0 le { % reduction reduction scale C 2 div neg C C 2 div { /ZCpoint exch def B 2 div neg B B 2 div { /YCpoint exch def newpath /Zpoint Rpoint ZCpoint add def /Ypoint YCpoint def /Xpoint A neg def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Zpoint Rpoint Angle cos mul ZCpoint add def /Ypoint Rpoint Angle sin mul YCpoint add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } for } for % le point du milieu newpath /Zpoint Rpoint def /Ypoint 0 def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Zpoint Rpoint Angle cos mul def /Ypoint Rpoint Angle sin mul def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } if PS3 0 le { % reduction reduction scale A 2 div neg A A 2 div { /XCpoint exch def B 2 div neg B 2 div B 2 div { /YCpoint exch def newpath /Xpoint Rpoint XCpoint add def /Ypoint YCpoint def /Zpoint C neg def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Xpoint Rpoint Angle cos mul XCpoint add def /Ypoint Rpoint Angle sin mul YCpoint add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } for } for } if PS2 0 le { % reduction reduction scale newpath /Xpoint A def /Ypoint Rpoint B 2 div add def /Zpoint C 2 div neg def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Ypoint Rpoint Angle cos mul B 2 div add def /Zpoint Rpoint Angle sin mul C 2 div sub def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill newpath /Xpoint A def /Ypoint Rpoint B 2 div sub def /Zpoint C 2 div def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Xpoint A def /Ypoint Rpoint Angle cos mul B 2 div sub def /Zpoint Rpoint Angle sin mul A 2 div add def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } if PS1 0 le { % reduction reduction scale newpath /Xpoint Rpoint def /Ypoint 0 def /Zpoint C def CalculsPointsAfterTransformations CalcCoordinates moveto 0 1 359 {% /Angle exch def /Xpoint Rpoint Angle cos mul def /Ypoint Rpoint Angle sin mul def CalculsPointsAfterTransformations CalcCoordinates lineto } for closepath 0 setgray fill } if } def /SommetsTetraedre{% /xA RayonBaseTetraedre neg def /yA 0 def /zA 0 def /xB 0.5 RayonBaseTetraedre mul def /yB RayonBaseTetraedre 0.866 mul neg def /zB 0 def /xC xB def /yC yB neg def /zC 0 def /xD 0 def /yD 0 def /zD RayonBaseTetraedre 1.414 mul def % coordonnées centre des faces /xFaceA xA xB xC add add 3 div def /yFaceA yA yB yC add add 3 div def /zFaceA zA zB zC add add 3 div def /xFaceB xD xA xB add add 3 div def /yFaceB yD yA yB add add 3 div def /zFaceB zD zA zB add add 3 div def /xFaceC xA xD xC add add 3 div def /yFaceC yA yD yC add add 3 div def /zFaceC zA zD zC add add 3 div def /xFaceD xD xB xC add add 3 div def /yFaceD yD yB yC add add 3 div def /zFaceD zD zB zC add add 3 div def % sommets après rotation et translation /XA M11 xA mul M12 yA mul add M13 zA mul add CX add def /YA M21 xA mul M22 yA mul add M23 zA mul add CY add def /ZA M31 xA mul M32 yA mul add M33 zA mul add CZ add def /XB M11 xB mul M12 yB mul add M13 zB mul add CX add def /YB M21 xB mul M22 yB mul add M23 zB mul add CY add def /ZB M31 xB mul M32 yB mul add M33 zB mul add CZ add def /XC M11 xC mul M12 yC mul add M13 zC mul add CX add def /YC M21 xC mul M22 yC mul add M23 zC mul add CY add def /ZC M31 xC mul M32 yC mul add M33 zC mul add CZ add def /XD M11 xD mul M12 yD mul add M13 zD mul add CX add def /YD M21 xD mul M22 yD mul add M23 zD mul add CY add def /ZD M31 xD mul M32 yD mul add M33 zD mul add CZ add def % centres de faces après transformations /XFaceA M11 xFaceA mul M12 yFaceA mul add M13 zFaceA mul add CX add def /YFaceA M21 xFaceA mul M22 yFaceA mul add M23 zFaceA mul add CY add def /ZFaceA M31 xFaceA mul M32 yFaceA mul add M33 zFaceA mul add CZ add def /XFaceB M11 xFaceB mul M12 yFaceB mul add M13 zFaceB mul add CX add def /YFaceB M21 xFaceB mul M22 yFaceB mul add M23 zFaceB mul add CY add def /ZFaceB M31 xFaceB mul M32 yFaceB mul add M33 zFaceB mul add CZ add def /XFaceC M11 xFaceC mul M12 yFaceC mul add M13 zFaceC mul add CX add def /YFaceC M21 xFaceC mul M22 yFaceC mul add M23 zFaceC mul add CY add def /ZFaceC M31 xFaceC mul M32 yFaceC mul add M33 zFaceC mul add CZ add def /XFaceD M11 xFaceD mul M12 yFaceD mul add M13 zFaceD mul add CX add def /YFaceD M21 xFaceD mul M22 yFaceD mul add M23 zFaceD mul add CY add def /ZFaceD M31 xFaceD mul M32 yFaceD mul add M33 zFaceD mul add CZ add def % Normales aux faces /NxA XFaceA XD sub def /NyA YFaceA YD sub def /NzA ZFaceA ZD sub def /NxB XFaceB XC sub def /NyB YFaceB YC sub def /NzB ZFaceB ZC sub def /NxC XFaceC XB sub def /NyC YFaceC YB sub def /NzC ZFaceC ZB sub def /NxD XFaceD XA sub def /NyD YFaceD YA sub def /NzD ZFaceD ZA sub def % Conditions de visibilité /PSA XFaceA NxA mul YFaceA NyA mul add ZFaceA NzA mul add def /PSB XFaceB NxB mul YFaceB NyB mul add ZFaceB NzB mul add def /PSC XFaceC NxC mul YFaceC NyC mul add ZFaceC NzC mul add def /PSD XFaceD NxD mul YFaceD NyD mul add ZFaceD NzD mul add def } def /Tetraedre{% SommetsTetraedre % face ABC PSA 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 ZA mul 1 K sub ZC mul add def /Xabscisse K XA mul 1 K sub XC mul add def /Yordonnee K YA mul 1 K sub YC mul add def CalcCoordinates lineto } for } if % face DAB PSB 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XD def /Yordonnee YD def /Zcote ZD def CalcCoordinates moveto 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 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 ZD mul 1 K sub ZB mul add def /Xabscisse K XD mul 1 K sub XB mul add def /Yordonnee K YD mul 1 K sub YB mul add def CalcCoordinates lineto } for } if % face DAC PSC 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XD def /Yordonnee YD def /Zcote ZD def CalcCoordinates moveto 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 ZC mul 1 K sub ZA mul add def /Xabscisse K XC mul 1 K sub XA mul add def /Yordonnee K YC mul 1 K sub YA 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 } if % face DBC PSD 0 le { % reduction reduction scale 1 setlinejoin /Xabscisse XD def /Yordonnee YD def /Zcote ZD def CalcCoordinates moveto 0 0.01 1 { % k /K exch def /Zcote K ZB mul 1 K sub ZD mul add def /Xabscisse K XB mul 1 K sub XD mul add def /Yordonnee K YB mul 1 K sub YD 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 } if } def % 2 aout 2002 /SommetsPyramide{% /xA A def /yA A neg def /zA 0 def /xB A def /yB A def /zB 0 def /xC A neg def /yC A def /zC 0 def /xD A neg def /yD A neg def /zD 0 def /xS 0 def /yS 0 def /zS Hpyramide def % coordonnées centre des faces /Alpha A Hpyramide atan def /xFaceSAB Hpyramide Alpha dup sin exch cos mul mul def /yFaceSAB 0 def /zFaceSAB Hpyramide Alpha sin dup mul mul def /xFaceSBC 0 def /yFaceSBC xFaceSAB def /zFaceSBC zFaceSAB def /xFaceSCD xFaceSAB neg def /yFaceSCD 0 def /zFaceSCD zFaceSAB def /xFaceSDA 0 def /yFaceSDA xFaceSAB neg def /zFaceSDA zFaceSAB def % sommets après rotation et translation /XA M11 xA mul M12 yA mul add M13 zA mul add CX add def /YA M21 xA mul M22 yA mul add M23 zA mul add CY add def /ZA M31 xA mul M32 yA mul add M33 zA mul add CZ add def /XB M11 xB mul M12 yB mul add M13 zB mul add CX add def /YB M21 xB mul M22 yB mul add M23 zB mul add CY add def /ZB M31 xB mul M32 yB mul add M33 zB mul add CZ add def /XC M11 xC mul M12 yC mul add M13 zC mul add CX add def /YC M21 xC mul M22 yC mul add M23 zC mul add CY add def /ZC M31 xC mul M32 yC mul add M33 zC mul add CZ add def /XD M11 xD mul M12 yD mul add M13 zD mul add CX add def /YD M21 xD mul M22 yD mul add M23 zD mul add CY add def /ZD M31 xD mul M32 yD mul add M33 zD mul add CZ add def /XS M11 xS mul M12 yS mul add M13 zS mul add CX add def /YS M21 xS mul M22 yS mul add M23 zS mul add CY add def /ZS M31 xS mul M32 yS mul add M33 zS mul add CZ add def % centres de faces après transformations /XFaceSAB M11 xFaceSAB mul M12 yFaceSAB mul add M13 zFaceSAB mul add CX add def /YFaceSAB M21 xFaceSAB mul M22 yFaceSAB mul add M23 zFaceSAB mul add CY add def /ZFaceSAB M31 xFaceSAB mul M32 yFaceSAB mul add M33 zFaceSAB mul add CZ add def /XFaceSBC M11 xFaceSBC mul M12 yFaceSBC mul add M13 zFaceSBC mul add CX add def /YFaceSBC M21 xFaceSBC mul M22 yFaceSBC mul add M23 zFaceSBC mul add CY add def /ZFaceSBC M31 xFaceSBC mul M32 yFaceSBC mul add M33 zFaceSBC mul add CZ add def /XFaceSCD M11 xFaceSCD mul M12 yFaceSCD mul add M13 zFaceSCD mul add CX add def /YFaceSCD M21 xFaceSCD mul M22 yFaceSCD mul add M23 zFaceSCD mul add CY add def /ZFaceSCD M31 xFaceSCD mul M32 yFaceSCD mul add M33 zFaceSCD mul add CZ add def /XFaceSDA M11 xFaceSDA mul M12 yFaceSDA mul add M13 zFaceSDA mul add CX add def /YFaceSDA M21 xFaceSDA mul M22 yFaceSDA mul add M23 zFaceSDA mul add CY add def /ZFaceSDA M31 xFaceSDA mul M32 yFaceSDA mul add M33 zFaceSDA mul add CZ add def % Normales aux faces /NxSAB XFaceSAB CX sub def /NySAB YFaceSAB CY sub def /NzSAB ZFaceSAB CZ sub def /NxSBC XFaceSBC CX sub def /NySBC YFaceSBC CY sub def /NzSBC ZFaceSBC CZ sub def /NxSCD XFaceSCD CX sub def /NySCD YFaceSCD CY sub def /NzSCD ZFaceSCD CZ sub def /NxSDA XFaceSDA CX sub def /NySDA YFaceSDA CY sub def /NzSDA ZFaceSDA CZ sub def /NxABCD CX XS sub def /NyABCD CY YS sub def /NzABCD CZ ZS sub def % Conditions de visibilité /PSAB XFaceSAB NxSAB mul YFaceSAB NySAB mul add ZFaceSAB NzSAB mul add def /PSBC XFaceSBC NxSBC mul YFaceSBC NySBC mul add ZFaceSBC NzSBC mul add def /PSCD XFaceSCD NxSCD mul YFaceSCD NySCD mul add ZFaceSCD NzSCD mul add def /PSDA XFaceSDA NxSDA mul YFaceSDA NySDA mul add ZFaceSDA NzSDA mul add def /PSABCD CX NxABCD mul CY NyABCD mul add CZ NzABCD mul add def } def % /FormulesSphere { % /RHO Zcote dup mul Yordonnee dup mul add sqrt def /incidence RHO Xabscisse Atan 2 div def /RHO' incidence sin Rayon mul def RHO 0 eq {/Xi 0 def /Yi 0 def} {/Yi RHO' RHO div Zcote mul def /Xi RHO' RHO div Yordonnee mul neg def } ifelse } def % /CalcCoordinates{% FormulesSphere Xi 28.45 mul Yi 28.45 mul } def % pour la 3D conventionnelle /formulesTroisD{% /xObservateur Xabscisse Sin1 mul neg Yordonnee Cos1 mul add def /yObservateur Xabscisse Cos1Sin2 mul neg Yordonnee Sin1Sin2 mul sub Xabscisse Cos2 mul add def /zObservateur Xabscisse neg Cos1Cos2 mul Yordonnee Sin1Cos2 mul sub Xabscisse Sin2 mul sub Dobs add def /xScreen DScreen xObservateur mul zObservateur div def /yScreen DScreen yObservateur mul zObservateur div def xScreen 28.45 mul yScreen 28.45 mul} def % /CalculsPointsAfterTransformations{% /Xabscisse M11 Xpoint mul M12 Ypoint mul add M13 Zpoint mul add CX add def /Yordonnee M21 Xpoint mul M22 Ypoint mul add M23 Zpoint mul add CY add def /Zcote M31 Xpoint mul M32 Ypoint mul add M33 Zpoint mul add CZ add def } def % % /tx@WARP{ %% D'après un fichier original de %%(c) P. Kleiweg 1997 %% adapté par : %% Manuel Luque %% Arnaud Schmittbuhl %% Jean-Paul Vignault %% les commentaires sont de Jean-Paul Vignault /warpmove{ %% on teste le booleen place 2 tokens plus en avant sur la pile %% si c'est 'true', alors on en est au 1er appel => on initialise %% le chemin 2 index { newpath } if %% puis on applique warp a notre point warp moveto %% on enleve le 'true' pour mettre un 'false' a la place pop false } bind def %% pour remplacer 'lineto /warpline { warp lineto } bind def %% pour remplacer 'curveto' /warpcurve { 6 2 roll warp 6 2 roll warp 6 2 roll warp curveto } bind def %% 'warpit' declenche la transformation du chemin courant /warpit { true { warpmove } { warpline } { warpcurve } { closepath } pathforall pop } bind def } def /tx@PathForAll{ /warp { 5 dict begin /Ypoint exch def /Xpoint exch def 2dto3d /Zpoint exch def /Ypoint exch def /Xpoint exch def CalculsPointsApresTransformations 3dto2d end } bind def tx@WARP warpit } def /tx@TransformPlan{ % le calcul des coefficients %% pour passer des coordonnées du plan aux coordonnées %% (x,y,z) du repère absolu %% les coordonnées sphériques du vecteur normal %% au plan %% l'origine du plan /zO' exch def /yO' exch def /xO' exch def %% les coefficients de la matrice de transformation /C11 {K_theta sin neg} def /C12 {K_theta cos K_phi sin mul neg} bind def /C21 {K_theta cos} bind def /C22 {K_phi sin K_theta sin mul neg } bind def /C31 {K_phi cos} bind def /2dto3d { %% coordonnées dans le repère absolu 3 dict begin C11 Xpoint mul C12 Ypoint mul add xO' add % x C21 Xpoint mul C22 Ypoint mul add yO' add % y C31 Ypoint mul zO' add end } def } def % end