/tetrahedron {
100 dict begin
/dd {d 1 sub} bind def
/m 3 def % nombre d'arêtes sur un sommet
/n 3 def % nombre de côtés de chaque face
% les sommets si R=1
% Sommets du tétraèdre régulier

%/c=1/sqrt(3)
%b=sqrt(2)
%a=c*b

/c {1 3 sqrt div} bind def
/b {2 sqrt} bind def
/a {c b mul} bind def

   /S1 [  0       0     3 c mul
          2 a mul 0     c neg
          a neg   b     c neg
          a neg   b neg c neg
   ] def
% en tenant compte du rayon
    /S [
0 1 S1 length 1 sub {%
    /i exch def
    S1 i get radius mul } for
       ] def
% Les faces repérées par les No des sommets
   /F [  1  2  3
         1  3  4
         1  2  4
         3  2  4
      ] def
%% indice des autres sommets voisins de chaque sommet
/co [ 2  3  4  % voisins du sommet 1
      1  4  3  %    "    de 2
      2  1  4  %    "    de 3
      1  2  3  %    "    de 4
     ] def

/i 0 def
/SDT [ % les coordonnées des sommets du
        % trétraèdre tronqué
0 m co length m sub  {
 /j exch def
    S i get  /xt1 exch def
    S i 1 add get /yt1 exch def
    S i 2 add get /zt1 exch def
% sommet 1
    co j get 1 sub 3 mul /k exch def
    S k get  /xt2 exch def
    xt1 dd mul xt2 add d div
%
    S k 1 add get /yt2 exch def
    yt1 dd mul yt2 add d div
%
    S k 2 add get /zt2 exch def
    zt1 dd mul zt2 add d div
% sommet 2
    co j 1 add get 1 sub 3 mul /k exch def
    S k get  /xt2 exch def
    xt1 dd mul xt2 add d div
%
    S k 1 add get /yt2 exch def
    yt1 dd mul yt2 add d div
%
    S k 2 add get /zt2 exch def
    zt1 dd mul zt2 add d div
% sommet 3
    co j 2 add get 1 sub 3 mul /k exch def
    S k get  /xt2 exch def
    xt1 dd mul xt2 add d div
%
    S k 1 add get /yt2 exch def
    yt1 dd mul yt2 add d div
%
    S k 2 add get /zt2 exch def
    zt1 dd mul zt2 add d div
/i i 3 add def
} for
 ]  def

/FT [  % 4 triangles
          1  2  3
          4  5  6
          7  8  9
         10 11 12
          ] def

/FH [  % 4 hexagones
      1  2  8  7  6  4     % 1
      2  3 10 12  9  8     % 2
      1  4  5 11 10  3     % 3
      6  7  9 12 11  5     % 4
          ] def
%
colorfacette /BLUE exch def /GREEN exch def /RED exch def
0 3 FT  length 3 sub { % le dessin des triangles
    /i exch def
  FT  i get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z1 exch def
  /Y1 exch def
  /X1 exch def
%%
  FT  i 1 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z2 exch def
  /Y2 exch def
  /X2 exch def
%%
  FT  i 2 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z3 exch def
  /Y3 exch def
  /X3 exch def
%% centre de la face
   /xF {X1 X2 add X3 add 3 div} bind def
   /yF {Y1 Y2 Y3 add add 3 div} bind def
   /zF {Z1 Z2 Z3 add add 3 div} bind def
%% vecteur : centre de la face -> point de vue
    /xV {XpointVue xF sub } bind def
    /yV {YpointVue yF sub } bind def
    /zV {ZpointVue zF sub } bind def
%% normale
    /xN xF CX sub def
    /yN yF CY sub def
    /zN zF CZ sub def
% le produit scalaire des 2 vecteurs
/PSfacette xV xN mul yV yN mul add zV zN mul add def
condition  {
/facette {
newpath
% tracé de la facette
   X1 Y1 Z1 3dto2d moveto
   X2 Y2 Z2 3dto2d lineto
   X3 Y3 Z3 3dto2d lineto
closepath } def
facette
/RED RED 0.95 mul store
/GREEN GREEN 0.95 mul store
/BLUE BLUE 0.95 mul store
RED GREEN BLUE setrgbcolor
    fill
Trace_arete
} if
} for

colorface /BLUE exch def /GREEN exch def /RED exch def
0 6 FH length 6 sub { % le dessin des hexagones
    /i exch def
  FH i get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z1 exch def
  /Y1 exch def
  /X1 exch def
%%
  FH i 1 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z2 exch def
  /Y2 exch def
  /X2 exch def
%%
  FH i 2 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z3 exch def
  /Y3 exch def
  /X3 exch def
%%
  FH i 3 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z4 exch def
  /Y4 exch def
  /X4 exch def
%%
  FH i 4 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z5 exch def
  /Y5 exch def
  /X5 exch def
%%
  FH i 5 add get 1 sub 3 mul /k exch def
  SDT k get       /Xpoint exch def
  SDT k 1 add get /Ypoint exch def
  SDT k 2 add get /Zpoint exch def
  PointsApresTransformations
  /Z6 exch def
  /Y6 exch def
  /X6 exch def
%% centre de la face
   /xF {X1 X2 add X3 add X4 add X5 add X6 add 6 div} bind def
   /yF {Y1 Y2 Y3 Y4 Y5 Y6 add add add add add 6 div} bind def
   /zF {Z1 Z2 Z3 Z4 Z5 Z6 add add add add add 6 div} bind def
%% vecteur : centre de la face -> point de vue
    /xV {XpointVue xF sub } bind def
    /yV {YpointVue yF sub } bind def
    /zV {ZpointVue zF sub } bind def
%% normale
    /xN xF CX sub def
    /yN yF CY sub def
    /zN zF CZ sub def
% le produit scalaire des 2 vecteurs
/PSfacette xV xN mul yV yN mul add zV zN mul add def
condition {
/facette {
newpath
% tracé de la facette
   X1  Y1  Z1  3dto2d moveto
   X2  Y2  Z2  3dto2d lineto
   X3  Y3  Z3  3dto2d lineto
   X4  Y4  Z4  3dto2d lineto
   X5  Y5  Z5  3dto2d lineto
   X6  Y6  Z6  3dto2d lineto
closepath } def
facette
/RED RED 0.95 mul store
/GREEN GREEN 0.95 mul store
/BLUE BLUE 0.95 mul store
RED GREEN BLUE setrgbcolor
    fill
Trace_arete } if
} for
end } def