summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-mirror
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2009-12-12 01:03:00 +0000
committerKarl Berry <karl@freefriends.org>2009-12-12 01:03:00 +0000
commitd69c8e6f02c8ccddda5d0e298d8ef6dd9e3810c0 (patch)
tree590d7f24265a91a9f2224781aa4bde527837921d /Master/texmf-dist/dvips/pst-mirror
parentb3d72971aeaf06ea2627c5ebca11fef7d76e0d5b (diff)
new pstricks package pst-mirror (8dec09)
git-svn-id: svn://tug.org/texlive/trunk@16370 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/dvips/pst-mirror')
-rw-r--r--Master/texmf-dist/dvips/pst-mirror/pst-mirror.pro1081
1 files changed, 1081 insertions, 0 deletions
diff --git a/Master/texmf-dist/dvips/pst-mirror/pst-mirror.pro b/Master/texmf-dist/dvips/pst-mirror/pst-mirror.pro
new file mode 100644
index 00000000000..ec382555756
--- /dev/null
+++ b/Master/texmf-dist/dvips/pst-mirror/pst-mirror.pro
@@ -0,0 +1,1081 @@
+%% $Id: pst-mirror.pro 169 2009-12-08 17:55:59Z 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.0 2009-09-12
+%
+/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 à 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 à 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 à 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 à 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