root/trunk/solides.pro

%!
% PostScript prologue for pst-solides3d.tex.
% Version 4.16, 2010/01/07
%
%% COPYRIGHT 2009 by Jean-Paul Vignault
%%
%% This program can be redistributed and/or modified under the terms
%% of the LaTeX Project Public License Distributed from CTAN
%% archives in directory macros/latex/base/lppl.txt.
%
/SolidesDict 100 dict def
/SolidesbisDict 100 dict def
SolidesDict begin

%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %% les variables globales gerees par PSTricks %%
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %% les lignes dessous sont a decommenter si l on veut utiliser le
%% %% fichier solides.pro independamment du package PSTricks
%% /Dobs 20 def
%% /THETA 20 def
%% /PHI 50 def
%% /Decran 30 def
%% /XpointVue {Dobs Cos1Cos2 mul} def
%% /YpointVue {Dobs Sin1Cos2 mul} def
%% /ZpointVue {Dobs Sin2 mul} def
%% /xunit 28.14 def
%% /solidhollow false def
%% /solidbiface false def
%% /xunit 28.45 def
%% /tracelignedeniveau? true def
%% /hauteurlignedeniveau 1 def
%% /couleurlignedeniveau {rouge} def
%% /linewidthlignedeniveau 4 def
%% /solidgrid true def
/aretescachees true def
/defaultsolidmode 2 def
%
/Stroke { strokeopacity .setopacityalpha stroke } def
/Fill { fillopacity .setopacityalpha fill } def
%
%% variables globales specifiques a PSTricks
%% /activationgestioncouleurs true def
/xmin -10 def
/xmax 10 def
/ymin -10 def
/ymax 10 def

/fillstyle {} def
/startest false def
/cm {} def
/cm_1 {} def
/yunit {xunit} def
/angle_repere 90 def

/hadjust 2.5 def
/vadjust 2.5 def
/pl@n-en-cours false def

/pointilles { [6.25 3.75] 1.25 setdash } def
/stockcurrentcpath {} def
/newarrowpath {} def
/chaine 15 string def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% choix d une fonte accentuee pour le .ps %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/ReEncode { exch findfont
dup length dict begin { 1 index /FID eq {pop pop} {def} ifelse
}forall /Encoding ISOLatin1Encoding def currentdict end definefont
pop }bind def
/Font /Times-Roman /ISOfont ReEncode /ISOfont def
%Font findfont 10 scalefont setfont

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% extrait de color.pro pour pouvoir recuperer ses couleurs %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/GreenYellow{0.15 0 0.69 0 setcmykcolor}def
/Yellow{0 0 1 0 setcmykcolor}def
/Goldenrod{0 0.10 0.84 0 setcmykcolor}def
/Dandelion{0 0.29 0.84 0 setcmykcolor}def
/Apricotq{0 0.32 0.52 0 setcmykcolor}def
/Peach{0 0.50 0.70 0 setcmykcolor}def
/Melon{0 0.46 0.50 0 setcmykcolor}def
/YellowOrange{0 0.42 1 0 setcmykcolor}def
/Orange{0 0.61 0.87 0 setcmykcolor}def
/BurntOrange{0 0.51 1 0 setcmykcolor}def
/Bittersweet{0 0.75 1 0.24 setcmykcolor}def
/RedOrange{0 0.77 0.87 0 setcmykcolor}def
/Mahogany{0 0.85 0.87 0.35 setcmykcolor}def
/Maroon{0 0.87 0.68 0.32 setcmykcolor}def
/BrickRed{0 0.89 0.94 0.28 setcmykcolor}def
/Red{0 1 1 0 setcmykcolor}def
/OrangeRed{0 1 0.50 0 setcmykcolor}def
/RubineRed{0 1 0.13 0 setcmykcolor}def
/WildStrawberry{0 0.96 0.39 0 setcmykcolor}def
/Salmon{0 0.53 0.38 0 setcmykcolor}def
/CarnationPink{0 0.63 0 0 setcmykcolor}def
/Magenta{0 1 0 0 setcmykcolor}def
/VioletRed{0 0.81 0 0 setcmykcolor}def
/Rhodamine{0 0.82 0 0 setcmykcolor}def
/Mulberry{0.34 0.90 0 0.02 setcmykcolor}def
/RedViolet{0.07 0.90 0 0.34 setcmykcolor}def
/Fuchsia{0.47 0.91 0 0.08 setcmykcolor}def
/Lavender{0 0.48 0 0 setcmykcolor}def
/Thistle{0.12 0.59 0 0 setcmykcolor}def
/Orchid{0.32 0.64 0 0 setcmykcolor}def
/DarkOrchid{0.40 0.80 0.20 0 setcmykcolor}def
/Purple{0.45 0.86 0 0 setcmykcolor}def
/Plum{0.50 1 0 0 setcmykcolor}def
/Violet{0.79 0.88 0 0 setcmykcolor}def
/RoyalPurple{0.75 0.90 0 0 setcmykcolor}def
/BlueViolet{0.86 0.91 0 0.04 setcmykcolor}def
/Periwinkle{0.57 0.55 0 0 setcmykcolor}def
/CadetBlue{0.62 0.57 0.23 0 setcmykcolor}def
/CornflowerBlue{0.65 0.13 0 0 setcmykcolor}def
/MidnightBlue{0.98 0.13 0 0.43 setcmykcolor}def
/NavyBlue{0.94 0.54 0 0 setcmykcolor}def
/RoyalBlue{1 0.50 0 0 setcmykcolor}def
/Blue{1 1 0 0 setcmykcolor}def
/Cerulean{0.94 0.11 0 0 setcmykcolor}def
/Cyan{1 0 0 0 setcmykcolor}def
/ProcessBlue{0.96 0 0 0 setcmykcolor}def
/SkyBlue{0.62 0 0.12 0 setcmykcolor}def
/Turquoise{0.85 0 0.20 0 setcmykcolor}def
/TealBlue{0.86 0 0.34 0.02 setcmykcolor}def
/Aquamarine{0.82 0 0.30 0 setcmykcolor}def
/BlueGreen{0.85 0 0.33 0 setcmykcolor}def
/Emerald{1 0 0.50 0 setcmykcolor}def
/JungleGreen{0.99 0 0.52 0 setcmykcolor}def
/SeaGreen{0.69 0 0.50 0 setcmykcolor}def
/Green{1 0 1 0 setcmykcolor}def
/ForestGreen{0.91 0 0.88 0.12 setcmykcolor}def
/PineGreen{0.92 0 0.59 0.25 setcmykcolor}def
/LimeGreen{0.50 0 1 0 setcmykcolor}def
/YellowGreen{0.44 0 0.74 0 setcmykcolor}def
/SpringGreen{0.26 0 0.76 0 setcmykcolor}def
/OliveGreen{0.64 0 0.95 0.40 setcmykcolor}def
/RawSienna{0 0.72 1 0.45 setcmykcolor}def
/Sepia{0 0.83 1 0.70 setcmykcolor}def
/Brown{0 0.81 1 0.60 setcmykcolor}def
/Tan{0.14 0.42 0.56 0 setcmykcolor}def
/Gray{0 0 0 0.50 setcmykcolor}def
/Black{0 0 0 1 setcmykcolor}def
/White{0 0 0 0 setcmykcolor}def
%% fin de l extrait color.pro

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             autres couleurs                        %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/bleu {0 0 1 setrgbcolor} def
/rouge {1 0 0 setrgbcolor} def
/vert {0 .5 0 setrgbcolor} def
/gris {.4 .4 .4 setrgbcolor} def
/jaune {1 1 0 setrgbcolor} def
/noir {0 0 0 setrgbcolor} def
/blanc {1 1 1 setrgbcolor} def
/orange {1 .65 0 setrgbcolor} def
/rose {1 .01 .58  setrgbcolor} def
/cyan {1 0 0 0 setcmykcolor} def
/magenta {0 1 0 0 setcmykcolor} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             definition du point de vue             %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% pour la 3D conventionnelle
%% Dony : graphisme scientifique : page 187
%% Editeur : Masson

%% calcul des coefficients de la matrice
%% de transformation
/Sin1 {THETA sin} def
/Sin2 {PHI sin} def
/Cos1 {THETA cos} def
/Cos2 {PHI cos} def
/Cos1Sin2 {Cos1 Sin2 mul} def
/Sin1Sin2 {Sin1 Sin2 mul} def
/Cos1Cos2 {Cos1 Cos2 mul} def
/Sin1Cos2 {Sin1 Cos2 mul} def

/3dto2d {
6 dict begin
   /Zcote exch def
   /Yordonnee exch def
   /Xabscisse exch def
   /xObservateur
      Xabscisse Sin1 mul neg Yordonnee Cos1 mul add
   def
   /yObservateur
      Xabscisse Cos1Sin2 mul neg Yordonnee Sin1Sin2 mul sub Zcote Cos2
      mul add
   def
   /zObservateur
      Xabscisse neg Cos1Cos2 mul Yordonnee Sin1Cos2 mul sub Zcote Sin2
      mul sub Dobs add
   def
   %% maintenant on depose les resultats sur la pile
   Decran xObservateur mul zObservateur div cm
   Decran yObservateur mul zObservateur div cm
end
} def

/getpointVue {
   XpointVue
   YpointVue
   ZpointVue
} def

/GetCamPos {
   getpointVue
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%         jps modifie pour PSTricks                  %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/solid {continu} def
/dashed {pointilles} def
/dotted { [2] 0 setdash } def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             geometrie basique                      %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% syntaxe~: [x1 y1 ... xn yn] ligne
/ligne {
gsave
   newpath
      dup 0 getp smoveto
      ligne_
      starfill
   Stroke
grestore
} def

%% syntaxe~: [x1 y1 ... xn yn] ligne_
/ligne_ {
   reversep
   aload length 2 idiv
   {
      slineto
   } repeat
} def

%% syntaxe~: [x1 y1 ... xn yn] polygone
/polygone* {
1 dict begin
   /startest {true} def
   polygone
end
} def

/polygone_ {
   newpath
      aload length 2 idiv
      3 copy pop
      smoveto
      {
         slineto
      } repeat
   closepath
} def

/polygone {
   gsave
      polygone_
      starfill
      currentlinewidth 0 eq {} { Stroke } ifelse
   grestore
} def

%% syntaxe : x y point
/point {
gsave
   1 setlinecap
   newpath
      smoveto
      0 0 rlineto
      5 setlinewidth
   Stroke
grestore
} def

/point_ {
   1 setlinecap
   5 setlinewidth
      smoveto
      0 0 rlineto
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                                                    %%%%
%%%%          insertion librairie jps                   %%%%
%%%%                                                    %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%              le repere jps                         %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### AAAopacity ###

%% les parametres pour la gestion de la transparence

/setstrokeopacity { /strokeopacity exch def } def
/setfillopacity { /fillopacity exch def } def

%% d apres un code de Jean-Michel Sarlat
%% http://melusine.eu.org/syracuse/swf/pdf2swf/setdash/
%% Mise en reserve de la procedure stroke originelle.
/sysstroke {systemdict /stroke get exec} def
/sysfill {systemdict /fill get exec} def
/sysatan {systemdict /atan get exec} def
/atan {2 copy 0 0 eqp {pop pop 0} {sysatan} ifelse} def
% Mise en place de la nouvelle procedure
/Stroke { /strokeopacity where { /strokeopacity get }{ 1 } ifelse
   .setopacityalpha sysstroke
} def
/Fill { /fillopacity where { /fillopacity get }{ 1 } ifelse
   .setopacityalpha sysfill
} def

%%%%% ### AAAscale ###
%%%%%%%%%%%%%%%% les deplacements a l echelle %%%%%%%%%%%%%%%%%%%

 /v@ct_I {xunit 0} def
 /v@ct_J {angle_repere cos yunit mul angle_repere sin yunit mul} def

/xscale {} def
/yscale {} def

/xscale-1 {} def
/yscale-1 {} def

/gtransform {} def
/gtransform-1 {} def

/jtoppoint {
2 dict begin
   gtransform
   /y exch yscale def
   /x exch xscale def
   v@ct_I x mulv
   v@ct_J y mulv
   addv
end
} def

/rptojpoint {
   xtranslate ytranslate 
   3 1 roll         %% xA yB yA xB 
   4 1 roll         %% xB xA yB yA 
   sub neg 3 1 roll %% yB-yA xB xA 
   sub neg exch
   ptojpoint
} def

/rptoppoint {
   xtranslate ytranslate 
   3 1 roll         %% xA yB yA xB 
   4 1 roll         %% xB xA yB yA 
   sub neg 3 1 roll %% yB-yA xB xA 
   sub neg exch
} def

/ptojpoint {
4 dict begin
   /Y exch yscale-1 def
   /X exch xscale-1 def
   /y Y yunit angle_repere sin mul div def
   /x X y yunit mul angle_repere cos mul sub xunit div def
   x y
   gtransform-1
end
} def

/smoveto {
   jtoppoint
   moveto
} def

/srmoveto {
   jtoppoint
   rmoveto
} def

/slineto {
   jtoppoint
   lineto
} def

/srlineto {
   jtoppoint
   rlineto
} def

/stranslate {
   jtoppoint
   translate
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%            methodes numeriques                     %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### solve2nddegre ###
%% syntaxe : a b c solve2nddegre --> x1 x2
/solve2nddegre {
5 dict begin
   /@c exch def
   /@b exch def
   /@a exch def
   /delt@ @b dup mul 4 @a mul @c mul sub def
   @b neg delt@ sqrt sub 2 @a mul div
   @b neg delt@ sqrt add 2 @a mul div
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  la 2D                             %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  points                            %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### tripointangle ###
%% syntaxe : A B C tripointangle --> angle ABC
/tripointangle {
9 dict begin
   /yC exch def
   /xC exch def
   /yB exch def
   /xB exch def
   /yA exch def
   /xA exch def
   /A {xA yA} def
   /B {xB yB} def
   /C {xC yC} def
   B C angle
   B A angle
   sub
end   
} def

%%%%% ### angle ###
%% syntaxe : A B angle
%% --> num, l'angle defini par le vecteur AB dans le repere orthonorme jps 
/angle {
   vecteur exch atan
   dup 180 gt 
      {360 sub}
   if
} def

%% syntaxe : A B pangle
%% --> num, l'angle defini par le vecteur AB dans le repere postscript
/pangle {
   jtoppoint exchp jtoppoint exchp vecteur exch atan
   dup 180 gt 
         {360 sub}
   if
} def

%%%%% ### setxrange ###
/setxrange {
   /xmax exch def
   /xmin exch def
} def

%%%%% ### setyrange ###
/setyrange {
   /ymax exch def
   /ymin exch def
} def

%%%%% ### 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

%%%%% ### milieu ###
%% syntaxe~: A B milieu 
/milieu {  
                %% xA yA xB yB
   3 -1 roll    %% xA xB yB yA 
   add 2 div    %% xA xB yM
   3 1 roll     %% yM xA xB 
   add 2 div    %% yM xM
   exch
} def

%%%%% ### parallelopoint ###
%% syntaxe : A B C parallelopoint --> point D, tel que ABCD parallelogramme
/parallelopoint {
11 dict begin
   /yC exch def
   /xC exch def
   /yB exch def
   /xB exch def
   /yA exch def
   /xA exch def
   /A {xA yA} def
   /B {xB yB} def
   /C {xC yC} def
   /d1 {A B C paral} def
   /d2 {B C A paral} def
   d1 d2 interdroite
end
} def

%%%%% ### translatepoint ###
%% syntaxe : A u translatepoint --> B image de A par la translation de vecteur u
/translatepoint {
   addv
} def

%%%%% ### rotatepoint ###
%% syntaxe : B A r rotatepoint --> C image de B par la rotation de centre A,
%% d'angle r (en degre)
%% En prenant les affixes des pts associes, il vient
%%    (zC - zA) = (zB-zA) e^(ir)
%% soit 
%%    zC = (zB-zA) e^(ir) + zA
/rotatepoint {     %% B, A, r
   5 copy          %% B, A, r, B, A, r
   cos 5 1 roll    %% B, A, r, cos r, B, A
   4 1 roll        %% B, A, r, cos r, yA, B, xA
   4 1 roll        %% B, A, r, cos r, A, B 
   vecteur         %% B, A, r, cos r, xB-xA, yB-yA
   4 -1 roll sin   %% B, A, cos r, xB-xA, yB-yA, sin r
   4 copy mul      %% B, A, cos r, xB-xA, yB-yA, sin r, cos r, xB-xA, (yB-yA) sin r
   7 1 roll mul    %% B, A, (yB-yA) sin r, cos r, xB-xA, yB-yA, sin r, cos r (xB-xA)
   5 1 roll        %% B, A, (yB-yA) sin r, cos r (xB-xA), cos r, xB-xA, yB-yA, sin r
   exch            %% B, A, (yB-yA) sin r, cos r (xB-xA), cos r, xB-xA, sin r, yB-yA
   4 -1 roll mul   %% B, A, (yB-yA) sin r, cos r (xB-xA), xB-xA, sin r, (yB-yA)cos r
   3 1 roll mul    %% B, A, (yB-yA) sin r, cos r (xB-xA), (yB-yA) cos r, (xB-xA) sin r
   add             %% B, A, (yB-yA) sin r, cos r (xB-xA), (yB-yA) cos r +(xB-xA) sin r
   3 1 roll        %% B, A, (yB-yA) cos r + (xB-xA) sin r, (yB-yA) sin r, cos r (xB-xA), 
   exch sub        %% B, A, (yB-yA) cos r + (xB-xA) sin r, cos r (xB-xA)-(yB-yA) sin r 
   exch            %% B, zA, (zB-zA) e^(ir)
   addv
   3 -1 roll pop
   3 -1 roll pop
} def

%%%%% ### hompoint ###
%% syntaxe : B A alpha hompoint -> le point A' tel que AA' = alpha AB
/hompoint {
   5 copy
   pop
   vecteur      %% vecteur BA
   3 -1 roll
   neg
   mulv   %% alpha x vecteur AB
   addv
   4 -1 roll
   4 -1 roll
   pop pop
} def

%%%%% ### orthoproj ###
%% syntaxe : A D orthoproj --> B, le projete orthogonal de A sur D
/orthoproj {
   6 -1 roll
   6 -1 roll            %% D A
   6 copy               %% D A D A
   7 -1 roll pop
   7 -1 roll pop        %% D D A
   perp 
   interdroite
} def

%% syntaxe : A projx --> le projete orthogonal de A sur Ox
/projx {
   pop 0
} def

%% syntaxe : A projy --> le projete orthogonal de A sur Oy
/projy {
   exch pop 0 exch
} def

%%%%% ### sympoint ###
%% syntaxe : A I sympoint --> point A', le symetrique de A par rapport
%% au point I
/sympoint {
   4 copy
   pop pop
   vecteur 
   -2 mulv
   addv
} def

%%%%% ### axesympoint ###
%% syntaxe : A D axesympoint --> point B, le symetrique de A par rapport
%% a la droite D
/axesympoint {
2 dict begin
   6 copy
   pop pop pop pop
   /yA exch def
   /xA exch def
   orthoproj 
   xA yA vecteur 
   -2 mulv
   xA yA addv
end   
} def

%%%%% ### cpoint ###
%% syntaxe : alpha C cpoint -> M, le point du cercle C correspondant a
%% l'angle alpha
/cpoint {           %% a, xI, yI, r 
1 dict begin
   dup              %% a, xI, yI, r, r
   5 -1 roll        %% xI, yI, r, r, a
   /alpha exch def  
   alpha cos mul    %% xI, yI, r, r cos a
   exch
   alpha sin mul    %% xI, yI, r cos a, r sin a
   3 -1 roll add    %% xI, r cos a, yI + r sin a
   3 1 roll         %% yI + r sin a, xI, r cos a, 
   add exch         %% xI + r cos a, yI + r sin a
end
} def

%%%%% ### xdpoint ###
%% x A B xdpoint : le point de la droite (AB) d'abscisse x
/xdpoint {
5 dict begin
   /pt2 defpoint
   /pt1 defpoint
   /x exch def
   /a pt1 pt2 coeffdir def
   /b pt1 pt2 ordorig def
   x dup a mul b add
end   
} def

%%%%% ### ydpoint ###
%% y A B ydpoint : le point de la droite (AB) d'ordonnee y
/ydpoint {
5 dict begin
   /pt2 defpoint
   /pt1 defpoint
   /y exch def
   pt1 pt2 verticale? 
      {
         pt1 pop y
      }
      {
         /a pt1 pt2 coeffdir def
         /b pt1 pt2 ordorig def
         y b sub a div y
      }
   ifelse
end   
} def

%%%%% ### ordonnepoints ###
%% syntaxe : xA yA xB yB ordonnepoints --> idem si yB>yA ou si yB=yA
%% avec xB>xA, sinon xB yB xA yA
/ordonnepoints {
   4 copy
   exch pop             %% ... xA, yA, yB
   lt                   %% yA < yB ?
      {pop}                     %% oui, c'est fini
      {                         %% non : yA >= yB
         pop 4 copy  
         exch pop               %% ... xA, yA, yB
         eq                     %% yA = yB ?
            {
               3 copy                   %% oui, yA = yB
               pop pop                  %% ... xA, xB
               le                       %% xA =< xB ?
                  {}                          %% oui, c'est fini
                  {                           %% non, on echange A et B
                     4 -1 roll
                     4 -1 roll
                  }
               ifelse
            }
            {                           %% non : yA < yB => on echange A et B
               pop
               4 -1 roll
               4 -1 roll
            }
         ifelse
      } 
   ifelse
} def

%%%%% ### distance ###
%% syntaxe~: A B distance
/distance {      %% xA yA xB yB
   vecteur       %% x y
   dup mul exch  %% y^2 x
   dup mul       %% y^2 x^2
   add
   sqrt
} def

%%%%% ### dup ###
/dupp {2 copy} def
/dupc {3 copy} def
/dupd {4 copy} def

%%%%% ### fin insertion ###
/interdroites {interdroite} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                 vecteurs                           %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### 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

%%%%% ### normalize ###
%% syntaxe : u normalize -> u / ||u||
/normalize {
2 dict begin
   /u defpoint
   /n u norme def
   u 1 n div mulv
end
} 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

%%%%% ### subv ###
%% syntaxe : u v subv --> u - v
/subv { %% xA yA xB yB
   -1 mulv
   addv
} 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

%%%%% ### scalprod ###
%% syntaxe : u v scalprod --> le produit scalaire de u par v
/scalprod {
2 dict begin
   /y' exch def
   exch 
   /y exch def
   mul y y' mul add
end
} def

%%%%% ### normal ###
%% syntaxe : u normal --> v tel u.v = 0
/normal {
   neg exch
} def

%%%%% ### norme ###
%% syntaxe : u norme --> |u|
/norme {
   dup mul
   exch
   dup mul
   add sqrt
} def

%%%%% ### oldarrow ###
%% syntaxe : A B oldarrow --> trace fleche en B, direction AB
/oldarrow {
4 dict begin
gsave
   /B defpoint
   /A defpoint
   oldarrowscale scale
   oldarrowangle rotate
   newpath 
   B smoveto
   A B vecteur normalize /u defpoint
   u neg exch /v defpoint
   u oldarrowpointe neg mulv rmoveto %% ainsi c'est la pointe qui est en (0, 0)
   %% le pt extremal arriere haut
      u oldarrowplume neg mulv        %% l'abscisse
      v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul mulv addv %% l'ordonnee
   rlineto
      u oldarrowplume oldarrowpointe add mulv
      v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul neg mulv addv
   rlineto 
      u oldarrowplume oldarrowpointe add neg mulv
      v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul neg mulv addv
   rlineto
   closepath Fill
grestore
end
} def

/oldarrowpointe {xunit 5 div} def
/oldarrowplume {xunit 10 div} def 
/oldarrow@ngle 45 def        
/oldarrowscale {1 1} def
/oldarrowangle 0 def     %% pour l'utilisateur

%%%%% ### drawvecteur ###
%% syntaxe : A B drawvecteur
/drawvecteur {
2 dict begin
   /B defpoint
   /A defpoint
   [A B] ligne
   A B oldarrow
end
} def

%%%%% ### orthovecteur ###
%% syntaxe : u orthovecteur --> v, vecteur orthogonal a u
/orthovecteur {
   neg exch
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  cercles                           %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### defcercle ###
%% syntaxe : A r /d defcercle
/defcercle {
1 dict begin
   /t@mp@r@ire exch def
   [ 4 1 roll ] cvx t@mp@r@ire exch 
end def
} def

%%%%% ### interdroitecercle ###
%% intersection de la droite y = ax+b avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
%% { --       b - y                   2          2           3
%% { |  x = - -----, y = (b + a x0 + a  y0 + (2 a  b y0 - 2 a  b x0 +
%% { --         a
%% 
%%       3          2  2    2  2    4  2    2   2    4   2             2
%%    2 a  x0 y0 - a  b  + a  r  + a  r  - a  y0  - a  x0 )^(1/2)) / (a  + 1)
%% 
%% 
%%    -- 
%%     |,
%%    -- 
%%     --       b - y                   2          2           3
%%     |  x = - -----, y = (b + a x0 + a  y0 - (2 a  b y0 - 2 a  b x0 +
%%     --         a
%% 
%%       3          2  2    2  2    4  2    2   2    4   2             2
%%    2 a  x0 y0 - a  b  + a  r  + a  r  - a  y0  - a  x0 )^(1/2)) / (a  + 1)
%% 
%%    -- }
%%     | }
%%    -- }

%% intersection de la droite x = a avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
%%                              2    2     2 1/2
%% {[x = a, y = y0 + (2 a x0 - a  + r  - x0 )   ],
%% 
%%                                2    2     2 1/2
%%    [x = a, y = y0 - (2 a x0 - a  + r  - x0 )   ]}

%% intersection de la droite y = b avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
%%                              2    2     2 1/2
%% {[y = b, x = x0 + (2 b y0 - b  + r  - y0 )   ],
%% 
%%                                2    2     2 1/2
%%    [y = b, x = x0 - (2 b y0 - b  + r  - y0 )   ]}

%% syntaxe : D I r interdroitecercle
/interdroitecercle {
16 dict begin
   /r exch def
   /y0 exch def
   /x0 exch def
   /yB exch def
   /xB exch def
   /yA exch def
   /xA exch def

   xA yA xB yB verticale?

   %% la droite est verticale
   {
      /xpt1 xA def
      /xpt2 xA def
      /quantite 
         2 xA mul x0 mul xA dup mul sub r dup mul add x0 dup mul sub sqrt
      def
      /ypt1
         y0 quantite add
      def
      /ypt2
         y0 quantite sub
      def
   }

   %% la droite n'est pas verticale
   {
      /a xA yA xB yB coeffdir def
      /b xA yA xB yB ordorig def

      0 a eq 
      %% la droite est horizontale
      {
         /quantite
            2 b mul y0 mul 
            b dup mul sub
            r dup mul add
            y0 dup mul sub
            sqrt
         def
         /xpt1 
            x0 quantite add
         def
         /xpt2 
            x0 quantite sub
         def
         /ypt1 b def
         /ypt2 b def
      } 

      %% la droite n'est pas horizontale
      {
         /quantite1 
            b 
            a x0 mul add
            a dup mul y0 mul add
         def
         /quantite2
            2 a dup mul mul b mul y0 mul 
            2 a 3 exp mul b mul x0 mul sub
            2 a 3 exp mul x0 mul y0 mul add
            a dup mul b dup mul mul sub
            a dup mul r dup mul mul add
            a 4 exp r dup mul mul add
            a dup mul y0 dup mul mul sub
            a 4 exp x0 dup mul mul sub 
            sqrt 
         def
         /quantite3 
            a dup mul 1 add 
         def
         /ypt1
            quantite1 quantite2 add quantite3 div
         def
         /xpt1 
            ypt1 b sub a div 
         def
         /ypt2
            quantite1 quantite2 sub quantite3 div
         def
         /xpt2 
            ypt2 b sub a div 
         def
      } 
      ifelse
   }
   ifelse
   
   xpt1 ypt1 
   xpt2 ypt2 
   ordonnepoints
end
} def

%%%%% ### intercercle ###
%% syntaxe : cerc1 cerc2 intercercle --> A B les points d'intersection
%% des 2 cercles, tries par 'ordonnepoints'
/intercercle {
12 dict begin
   /r2 exch def
   /y2 exch def
   /x2 exch def
   /r1 exch def
   /y1 exch def
   /x1 exch def

   %% on translate pour se ramener a (x1, y1) = (0, 0)
   x2 y2 x1 y1 subv
   /y2 exch def
   /x2 exch def

   %% on prepare l'equation du 2nd degre

%%                    2       2    2
%%   {y = RootOf((4 x2  + 4 y2 ) _Z
%% 
%%                  3        2              2       2            4
%%          + (-4 y2  - 4 r1~  y2 + 4 y2 r2~  - 4 x2  y2) _Z + x2
%% 
%%               4       2    2       2   2       2    2        2   2
%%          + r2~  - 2 y2  r2~  + 2 x2  y2  - 2 x2  r2~  - 2 r1~  x2
%% 
%%               4     4        2   2        2    2
%%          + r1~  + y2  + 2 r1~  y2  - 2 r1~  r2~ ), x = 1/2 (-2 y2
%% 
%%                     2       2    2
%%         RootOf((4 x2  + 4 y2 ) _Z
%% 
%%                  3        2              2       2            4
%%          + (-4 y2  - 4 r1~  y2 + 4 y2 r2~  - 4 x2  y2) _Z + x2
%% 
%%               4       2    2       2   2       2    2        2   2
%%          + r2~  - 2 y2  r2~  + 2 x2  y2  - 2 x2  r2~  - 2 r1~  x2
%% 
%%               4     4        2   2        2    2       2     2     2
%%          + r1~  + y2  + 2 r1~  y2  - 2 r1~  r2~ ) + r1~  + x2  + y2
%% 
%%               2
%%          - r2~ )/x2}

   %% coeff pour le degre 2
   /a 
      %%                    2       2    2
      %%   {y = RootOf((4 x2  + 4 y2 ) _Z
      4 x2 dup mul mul
      4 y2 dup mul mul add
   def

   %% coeff pour le degre 1
   %%
   /b 
      %%                    3        2              2       2        
      %%            + (-4 y2  - 4 r1~  y2 + 4 y2 r2~  - 4 x2  y2) _Z 
      -4 y2 3 exp mul
      4 r1 dup mul mul y2 mul sub
      4 r2 dup mul mul y2 mul add
      4 x2 dup mul mul y2 mul sub
   def

   %% coeff pour le degre 0
   %%
   /c {
      %%              4
      %%          + x2
      x2 4 exp
      %% 
      %%               4       2    2       2   2       2    2        2   2
      %%          + r2~  - 2 y2  r2~  + 2 x2  y2  - 2 x2  r2~  - 2 r1~  x2
      r2 4 exp add
      2 y2 dup mul mul r2 dup mul mul sub
      2 x2 dup mul mul y2 dup mul mul add
      2 x2 dup mul mul r2 dup mul mul sub
      2 x2 dup mul mul r1 dup mul mul sub
      %% 
      %%               4     4        2   2        2    2
      %%          + r1~  + y2  + 2 r1~  y2  - 2 r1~  r2~ )
      r1 4 exp add
      y2 4 exp add
      2 r1 dup mul mul y2 dup mul mul add
      2 r1 dup mul mul r2 dup mul mul sub
   } def

   a b c solve2nddegre
   /Y1 exch def
   /Y0 exch def
   
   /X0
      %% x = 1/2 (-2 y2  Y
      -2 y2 mul Y0 mul
      %% 
      %%        2     2     2
      %% + r1~  + x2  + y2
      r1 dup mul add
      x2 dup mul add
      y2 dup mul add
      %% 
      %%                 2
      %%            - r2~ )/x2}
      r2 dup mul sub
   
      2 x2 mul div
   def
   
   /X1
      %% x = 1/2 (-2 y2  Y
      -2 y2 mul Y1 mul
      %% 
      %%        2     2     2
      %% + r1~  + x2  + y2
      r1 dup mul add
      x2 dup mul add
      y2 dup mul add
      %% 
      %%                 2
      %%            - r2~ )/x2}
      r2 dup mul sub
   
      2 x2 mul div
   def

   %% on depose le resultat, en n'oubliant pas de retranslater en sens
   %% inverse

   X0 Y0 x1 y1 addv
   X1 Y1 x1 y1 addv
   ordonnepoints
end
} def

%%%%% ### ABcercle ###
%% syntaxe : A B C ABcercle --> le cercle passant par A, B, C
/ABcercle {
3 dict begin
   /@3 defpoint
   /@2 defpoint
   /@1 defpoint
   @1 @2 mediatrice
   @1 @3 mediatrice
   interdroite
   dupp
   @3 distance
end   
} def

%%%%% ### diamcercle ###
%% syntaxe : A B diamcercle --> le cercle de diametre [AB]
/diamcercle {
   4 copy
   distance 2 div
   5 1 roll 
   milieu
   3 -1 roll 
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  droites                           %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### horizontale ###
%% syntaxe : y horizontale 
/horizontale {
1 dict begin
   /y exch def
   xmin y xmax y
end
} def

%%%%% ### coeffdir ###
%% syntaxe~: A B coeffdir
/coeffdir {
   vecteur exch div
} def

%%%%% ### ordorig ###
%% syntaxe : A B ordorig
%% attention, la droite est supposee ne pas etre verticale
/ordorig {
   /dr@ite 4 array def
   dr@ite 3 3 -1 roll put
   dr@ite 2 3 -1 roll put
   dr@ite 1 3 -1 roll put
   dr@ite 0 3 -1 roll put
   dr@ite aload pop coeffdir /c@eff exch def
   dr@ite aload pop pop pop  %% xA yA
   exch                      %% yA xA 
   c@eff mul neg add
} def

%%%%% ### verticale ###
%% syntaxe~: A B verticale?
/verticale? {
   pop 2 1 roll pop
   eq
} def

%% syntaxe : x verticale
/verticale {
1 dict begin
   /x exch def
   x ymin x ymax
end
} def

%%%%% ### droite ###
%% %% syntaxe : A B droite
%% /droite {
%% gsave
%% 6 dict begin
%%    /yB exch def
%%    /xB exch def
%%    /yA exch def
%%    /xA exch def
%%    xA yA xB yB
%%    eqp
%%       {}
%%       { 
%%          xA yA xB yB
%%       verticale?
%%       {
%%       newpath
%%          xA ymin smoveto
%%          xA ymax slineto
%%             stockcurrentcpath
%%       stroke
%%       }
%%       {
%%       newpath
%%          /alpha xA yA xB yB coeffdir def
%%          /beta xA yA xB yB ordorig def
%%          xmin dup alpha mul beta add smoveto
%%          xmax dup alpha mul beta add slineto
%%             stockcurrentcpath
%%       stroke
%%       }
%%       ifelse
%%       }
%%    ifelse
%% end
%% grestore
%% } def

%% syntaxe : A B droite
/droite {
gsave
6 dict begin
   /B defpoint
   /A defpoint
   A pop B pop eq {
      %% droite verticale
      newpath
         A pop ymin smoveto
         A pop ymax slineto
         stockcurrentcpath
      Stroke
   } {
      %% on cherche le point le + a gauche
      xmin A B xdpoint /C defpoint
      C exch pop ymin lt {
         %% trop a gauche
         ymin A B ydpoint /C defpoint
      } if
      C exch pop ymax gt {
         %% trop a gauche
         ymax A B ydpoint /C defpoint
      } if
      %% on cherche le point le + a droite
      xmax A B xdpoint /D defpoint
      D exch pop ymin lt {
         %% trop a droite
         ymin A B ydpoint /D defpoint
      } if
      D exch pop ymax gt {
         %% trop a gauche
         ymax A B ydpoint /D defpoint
      } if
      newpath
         C smoveto
         D slineto
         stockcurrentcpath
     Stroke
   } ifelse
end
grestore
} def

%%%%% ### defdroite ###
%% syntaxe : A B /d defdroite
/defdroite {
1 dict begin
   /t@mp@r@ire exch def
   [ 5 1 roll ] cvx t@mp@r@ire exch 
end def
} def

%%%%% ### paral ###
%% syntaxe : D A paral --> droite parallele a D passant par A
/paral {
4 dict begin
   /yA exch def
   /xA exch def
   vecteur
   /u2 exch def
   /u1 exch def
   xA yA
   2 copy
   u1 u2 translatepoint
end
} def

%%%%% ### interdroite ###
/interdroite {
                %% A B C D
   /dr@ite2 4 array def
   dr@ite2 3 3 -1 roll put
   dr@ite2 2 3 -1 roll put
   dr@ite2 1 3 -1 roll put
   dr@ite2 0 3 -1 roll put
   /dr@ite1 4 array def
   dr@ite1 3 3 -1 roll put
   dr@ite1 2 3 -1 roll put
   dr@ite1 1 3 -1 roll put
   dr@ite1 0 3 -1 roll put

%%%    %% trace pour deboguage
%%%    dr@ite1 aload pop droite
%%%    dr@ite2 aload pop droite

%%% Dans tous les cas, on suppose que l'intersection existe
%%% 
%%% * la 1ere droite est verticale. les equations reduites sont
%%%       x = a1      et       y = a2 x + b2
%%% Le point d'intersection est :
%%%       {{x = a1, y = b2 + a1 a2}}
%%% 
%%% * la 2eme droite est verticale. les equations reduites sont
%%%       x = a1 x+ b1     et       x = a2
%%% Le point d'intersection est :
%%%       {{x = a2, y = b1 + a1 a2}}
%%% 
%%% * aucune n'est verticale. Les equations reduites sont
%%%       y = a1 x + b1      et       y = a2 x + b2
%%% Le point d'intersection est :
%%%                 { {     b2 - b1      a1 b2 - a2 b1 } }
%%%                 { { x = -------, y = ------------- } }
%%%                 { {     a1 - a2         a1 - a2    } }

%%% remarque : pour le moment, je n'arrive pas a rendre mes variables
%%% locales : elle restent globales. Pour que cela ne soit pas trop
%%% genant, je les note respectivement @1, @@1, @2 et @@2 au lieu de a1,
%%% b1, a2 et b2.

   dr@ite1 aload pop verticale?
      {
         /@1 {dr@ite1 aload pop pop pop pop} def
         /@2 {dr@ite2 aload pop coeffdir} def
         /@@2 {dr@ite2 aload pop ordorig} def
         @1 
         @1 @2 mul @@2 add
      }
      {
      dr@ite2 aload pop verticale?
         {
            /@1 {dr@ite1 aload pop coeffdir} def
            /@@1 {dr@ite1 aload pop ordorig} def
            /@2 {dr@ite2 aload pop pop pop pop} def
            @2
            @1 @2 mul @@1 add
         }
         {
            /@1 {dr@ite1 aload pop coeffdir} def
            /@@1 {dr@ite1 aload pop ordorig} def
            /@2 {dr@ite2 aload pop coeffdir} def
            /@@2 {dr@ite2 aload pop ordorig} def
            @@2 @@1 sub @1 @2 sub div
            @1 @@2 mul @2 @@1 mul sub
            @1 @2 sub div
         }
      ifelse
      }
   ifelse
} def

%%%%% ### perp ###
%% syntaxe : D A perp --> droite perpendiculaire a D passant par A
/perp {
4 dict begin
   /yA exch def
   /xA exch def
   vecteur orthovecteur
   /u2 exch def
   /u1 exch def
   xA yA
   2 copy
   u1 u2 translatepoint
end
} def

%%%%% ### mediatrice ###
%% synaxe : A B mediatrice --> droite
/mediatrice {
   4 copy 
   milieu
   perp
} def

%%%%% ### bissectrice ###
%% syntaxe : A B C bissectrice --> B E ou E est un point de la bissectrice
/bissectrice {
10 dict begin
   /yC exch def
   /xC exch def
   /yB exch def
   /xB exch def
   /yA exch def
   /xA exch def
   /A {xA yA} def
   /B {xB yB} def
   /C {xC yC} def
   /alpha {A B C tripointangle} def
   B
   A B alpha rotatepoint
   A milieu
end
} def

%%%%% ### angledroit  ###
 /widthangledroit 5 def

%% syntaxe : A B C angledroit --> dessine un angle droit en B
/angledroit {
10 dict begin
   dup xcheck {
      /widthangledroit exch def
   } if
   /C defpoint
   /B defpoint
   /A defpoint
   B C vecteur normalize widthangledroit 20 div mulv /u defpoint
   B A vecteur normalize widthangledroit 20 div mulv /v defpoint
   [B u addv dupp v addv B v addv] ligne
end
} def

%%%%% ### translatedroite ###
%% syntaxe : A B u translatedroite --> C D images resp de A et B par la translation de vecteur u
/translatedroite {         %% A B u
   2 copy          %% A B u u
   6 1 roll       
   6 1 roll        %% A u B u 
   addv      %% A u D
   6 1 roll        
   6 1 roll        %% D A u 
   addv
   4 1 roll
   4 1 roll
} def

%%%%% ### rotatedroite ###
%% syntaxe : A B O r rotatedroite --> C D images resp de A et B par la
%% rotation de centre O et d'angle r (en degre)
/rotatedroite {
   5 copy rotatepoint   %% A B O r D
   6 -1 roll pop        %% A xB O r D
   6 -1 roll pop        %% A O r D
   7 1 roll
   7 1 roll rotatepoint %% D C
   4 1 roll 4 1 roll 
} def

/rotatevecteur {
   rotatedroite
} def

/rotatesegment {
   rotatedroite
} def

%%%%% ### axesymdroite ###
%% syntaxe : d D axesymdroite --> droite d', symetrique de la droite d par rapport
%% a la droite D
/axesymdroite {
2 dict begin
   /D defdroite
   /B defpoint
   D axesympoint
   B D axesympoint
end   
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  polygones                         %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### poltransformfile ###
%% syntaxe : pol u translatepol --> pol'
/translatepol {
2 dict begin   
   /uy exch def
   /ux exch def
   {ux uy translatepoint} papply
end
} def

%% syntaxe : pol u rotatepol --> pol'
/rotatepol {
2 dict begin   
   /alpha exch def
   /I defpoint
   {I alpha rotatepoint} papply
end
} def

%% syntaxe : pol I alpha hompol --> pol'
/hompol {
2 dict begin   
   /alpha exch def
   /I defpoint
   {I alpha hompoint} papply
end
} def

%% syntaxe : pol I sympol --> pol'
/sympol {
1 dict begin   
   /I defpoint
   {I sympoint} papply
end
} def

%% syntaxe : pol D axesympol --> pol'
/axesympol {
1 dict begin   
   /D defdroite
   {D axesympoint} papply
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  les tests                         %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### isbool ###
%% syntaxe : any isbool --> booleen
/isbool {
   type (booleantype) cvn eq
} def

%%%%% ### isarray ###
%% syntaxe : any isarray --> booleen
/isarray {
   type (arraytype) cvn eq
} def

%%%%% ### isstring ###
%% syntaxe : any isstring --> booleen
/isstring {
   type (stringtype) cvn eq
} def

%%%%% ### isinteger ###
%% syntaxe : any isinteger --> booleen
/isinteger {
   type (integertype) cvn eq
} def

%%%%% ### isnum ###
%% syntaxe : any isnum --> booleen
/isnum {
   dup isreal 
   exch isinteger or
} def

%%%%% ### isreal ###
%% syntaxe : any isreal --> booleen
/isreal {
   type (realtype) cvn eq
} def

%%%%% ### eq ###
%% syntaxe : A B eqp3d --> booleen = true si les points A et B sont identiques
/eqp3d {
               %% x1 y1 z1 x2 y2 z2
   4 -1 roll   %% x1 y1 x2 y2 z2 z1 
   eq {        %% x1 y1 x2 y2 
      eqp
   } {
      pop pop pop pop false
   } ifelse
} def

%% syntaxe : A B eqp --> booleen = true si les points A et B sont identiques
/eqp {
   3 -1 roll
   eq 
      {
         eq 
            {true} 
            {false}
         ifelse
      }
      {pop pop false}
   ifelse
} def

%% syntaxe : z z' eqc --> true si z = z', false sinon
/eqc {
   eqp
} def

%%%%% ### eqstring ###
/eqstring {
3 dict begin
   /str2 exch def
   /str1 exch def
   str1 length str2 length eq {
      /i 0 def
      true
      str1 length {
         str1 i get str2 i get eq and
         /i i 1 add store
      } repeat
   } {
      false
   } ifelse
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                conversions de types                %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### astr2str ###
%% syntaxe : array str astr2str --> str
%% convertit le contenu de array en chaines de caracteres puis les
%% concatene avec str, en inserant un caractere "space" apres chaque
%% element du tableau array
/astr2str {
5 dict begin
   /str exch def
   /table exch def
   /n table length def
   n 0 eq {
      str
   } {
      table 0 n 1 sub getinterval
      table n 1 sub get (                               ) cvs
      ( ) append
      str append
      astr2str
   } ifelse
end
} def

%%%%% ### numstr2array ###
%% syntaxe : str str2num --> num
/str2num {
5 dict begin
   /str exch def
   /n str length def
   /signnum 1 def
   /frct false def
   /k 0 def
   0 1 n 1 sub {
      /i exch def
      str i get
      dup 46 eq {
         %% il y a un point
         /frct true def
         pop
         i 0 eq {
            0
         } if
      } {
         dup 45 eq {
            /signnum -1 def
            pop
         } {
            frct not {
               i 1 ge signnum 0 ge and i 2 ge or {
                  exch 10 mul 48 sub add
               } {
                  48 sub
               } ifelse
            } {
               48 sub
               /k k 1 add store
               10 k exp div add
            } ifelse
         } ifelse
      } ifelse
   } for
   signnum mul
end
} def

/str2num {cvx exec} def

%% syntaxe : str numstr2array -> array
%% ou str est une chaine de nombres reels separes par des espaces
%% et array est constitue des elements numeriques de string.
%% exemple :
%% (0 -12 .234 54) --> [0 -12 0.234 54]
/numstr2array {
6 dict begin
   /str exch def
   /n str length def
   /separateurs [] def
   [
      0 1 n 1 sub {
         /i exch def
         str i get
         32 eq {
            /separateurs [separateurs aload pop i] def
         } if
      } for
      /j 0 def
      /oldsep 0 def
      0 1 separateurs length 1 sub {
         /i exch def
         str j separateurs i get oldsep sub getinterval str2num
         /j separateurs i get 1 add def
         /oldsep separateurs i get 1 add def
      } for
      str j n oldsep sub getinterval str2num
   ]
end
} def

%% syntaxe : array numstr2array -> array
/arraynumstr2arrayarray {
   {numstr2array} apply
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                macros de projection                %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### projtext ###
%% syntaxe : str x0 y0 z0 [normal_vect] ultextp3d --> -
%% syntaxe : str x0 y0 z0 [normal_vect] bool ultextp3d --> -
%% syntaxe : str x0 y0 plantype ultextp3d --> -
%% syntaxe : str x0 y0 plantype bool ultextp3d --> -
%% syntaxe : str1 solid i str2 ultextp3d --> -
%% syntaxe : str1 solid i str2 bool ultextp3d --> -
%% syntaxe : str1 solid i alpha str2 bool ultextp3d --> -
 /initpr@jtext {
5 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   dup isplan {
      /type_plan_proj true def
      /lepl@n exch def
      lepl@n plangetbase aload pop
      /@V defpoint3d
      /@U defpoint3d
      lepl@n plangetorigine
      /z0 exch def
      /y0 exch def
      /x0 exch def
      /table [@U @U @V vectprod3d] def
   } {
      dup isarray {
         %% c est un planprojpath
         /type_plan_proj true def
         /table exch def
         /z0 exch def
         /y0 exch def
         /x0 exch def
         0 0
      } {
         %% c est un solidprojpath
         /type_plan_proj false def
         %% y a-t-il un str2
         dup isstring {
            /str2 exch def
         } {
            /str2 {} def
         } ifelse
         %% y a-t-il un alpha
         2 copy pop issolid {
            /alpha 0 def
         } {
            /alpha exch def
         } ifelse
         /i exch def
         /solid exch def
         0 0
      } ifelse
   } ifelse
} def
 /closepr@jtext {
   type_plan_proj {
      x0 y0 z0 table mybool projpath
   } {
      solid i alpha str2 mybool projpath
   } ifelse
   Fill
   Stroke
end
} def

%% syntaxe : str x0 y0 z0 [normal_vect] ultextp3d --> -
%% syntaxe : str x0 y0 z0 [normal_vect] bool ultextp3d --> -
%% syntaxe : str1 solid i str2 ultextp3d --> -
%% syntaxe : str1 solid i str2 bool ultextp3d --> -
%% syntaxe : str1 solid i alpha str2 bool ultextp3d --> -
/ultextp3d {initpr@jtext ultext_ closepr@jtext} def
/cltextp3d {initpr@jtext cltext_ closepr@jtext} def
/bltextp3d {initpr@jtext bltext_ closepr@jtext} def
/dltextp3d {initpr@jtext dltext_ closepr@jtext} def
/ubtextp3d {initpr@jtext ubtext_ closepr@jtext} def
/cbtextp3d {initpr@jtext cbtext_ closepr@jtext} def
/bbtextp3d {initpr@jtext bbtext_ closepr@jtext} def
/dbtextp3d {initpr@jtext dbtext_ closepr@jtext} def
/uctextp3d {initpr@jtext uctext_ closepr@jtext} def
/cctextp3d {initpr@jtext cctext_ closepr@jtext} def
/bctextp3d {initpr@jtext bctext_ closepr@jtext} def
/dctextp3d {initpr@jtext dctext_ closepr@jtext} def
/urtextp3d {initpr@jtext urtext_ closepr@jtext} def
/crtextp3d {initpr@jtext crtext_ closepr@jtext} def
/brtextp3d {initpr@jtext brtext_ closepr@jtext} def
/drtextp3d {initpr@jtext drtext_ closepr@jtext} def

%%%%% ### currentppathtransform ###
%% syntaxe : {f} currentppathtransform --> applique la transformation f
%% au chemin courant
/currentppathtransform {
6 dict begin
   /warp exch def
   %% pour remplacer 'move'
   /warpmove{
      2 index {
        newpath
      } if
      warp moveto
      pop false
   } 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

   true
   { warpmove } {  warpline } { warpcurve } { closepath } pathforall
   pop
end
} def

%% syntaxe : {f} currentpathtransform --> applique la transformation f
%% au chemin courant
/currentpathtransform {
7 dict begin
   /transform exch def
   /warp {ptojpoint transform} def
   %% pour remplacer 'move'
   /warpmove{
      2 index {
        newpath
      } if
      warp smoveto
      pop false
   } def

   %% pour remplacer 'lineto'
   /warpline {
      warp slineto
   } bind def

   %% pour remplacer 'curveto'
   /warpcurve {
      6 2 roll warp
      6 2  roll warp
      6 2 roll warp
      scurveto
   }  bind def

   true
   { warpmove } {  warpline } { warpcurve } { closepath } pathforall
   pop
end
} def

%%%%% ### normalvect_to_orthobase ###
%% syntaxe : [normal_vect] normalvect_to_orthobase
%%    --> imI imJ imK
/normalvect_to_orthobase {
4 dict begin
   dup length 3 eq {
      aload pop normalize3d /normal_vect defpoint3d
      normal_vect -1 0 0 eqp3d {
         /imageI {0 -1 0} def
         /imageK {-1 0 0} def
         /imageJ {0 0 1} def 
      } {
         %% on calcule l image de la base (I,J,K)
         /imageJ {normal_vect 1 0 0 vectprod3d normalize3d} def
         /imageK {normal_vect} def
         /imageI {imageJ imageK vectprod3d} def
         1 0 0 imageK angle3d 0 eq {
            0 1 0 normal_vect vectprod3d /imageI defpoint3d
            /imageJ {0 1 0} def
            normal_vect /imageK defpoint3d
         } if
      } ifelse
   } {
      dup length 6 eq {
         aload pop
         normalize3d /imageK defpoint3d
         normalize3d /imageI defpoint3d
         imageK imageI vectprod3d /imageJ defpoint3d
      } {
         dup length 7 eq {
            aload pop 
            /alpha exch 2 div def
            normalize3d /imageK defpoint3d
            normalize3d /imageI defpoint3d
            imageK imageI vectprod3d /imageJ defpoint3d
            %% et ensuite, on fait tourner la base autour de imageK
            imageI alpha cos mulv3d
            imageJ alpha sin mulv3d
            addv3d
   
            imageI alpha sin neg mulv3d
            imageJ alpha cos mulv3d
            addv3d
   
            /imageJ defpoint3d
            /imageI defpoint3d
         } {
            %% length = 4
            aload pop
            /alpha exch def
            normalize3d /normal_vect defpoint3d
   
            normal_vect -1 0 0 eqp3d {
               /imageI {0 -1 0} def
               /imageK {-1 0 0} def
               /imageJ {0 0 1} def 
            } {
               %% on calcule l image de la base (I,J,K)
               /imageJ {normal_vect 1 0 0 vectprod3d normalize3d} def
               /imageK {normal_vect} def
               /imageI {imageJ imageK vectprod3d} def
               1 0 0 imageK angle3d 0 eq {
                  0 1 0 normal_vect vectprod3d /imageI defpoint3d
                  /imageJ {0 1 0} def
                  normal_vect /imageK defpoint3d
               } if
            } ifelse
         } ifelse

         %% et ensuite, on fait tourner la base autour de imageK
         imageI alpha cos mulv3d
         imageJ alpha sin mulv3d
         addv3d

         imageI alpha sin neg mulv3d
         imageJ alpha cos mulv3d
         addv3d

         /imageJ defpoint3d
         /imageI defpoint3d
      } ifelse
   } ifelse
   imageI
   imageJ
   imageK
end
} def

%%%%% ### projpath ###
%% syntaxe : x y z [normal] projpath --> planprojpath
%% syntaxe : x y z [normal] bool projpath --> planprojpath
%% syntaxe : solid i projpath --> solidprojpath
%% syntaxe : solid i bool projpath --> solidprojpath
%% syntaxe : solid i str bool projpath --> solidprojpath
%% syntaxe : solid i alpha str bool projpath --> solidprojpath
/projpath {
2 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   dup isplan {
      3 dict begin
         /lepl@n exch def
         lepl@n plangetbase aload pop
         /@V defpoint3d
         /@U defpoint3d
         lepl@n plangetorigine
         [@U @U @V vectprod3d] mybool planprojpath
      end
   } {
      dup isarray {
         mybool planprojpath
      } {
         mybool solidprojpath
      } ifelse
   } ifelse
end
} def


%% %% syntaxe : x y z [normal] projpath --> planprojpath
%% %% syntaxe : x y z [normal] bool projpath --> planprojpath
%% %% syntaxe : solid i projpath --> solidprojpath
%% %% syntaxe : solid i bool projpath --> solidprojpath
%% %% syntaxe : solid i str bool projpath --> solidprojpath
%% %% syntaxe : solid i alpha str bool projpath --> solidprojpath
%% /projpath {
%% 2 dict begin
%%    dup isbool {
%%       /mybool exch def
%%    } {
%%       /mybool true def
%%    } ifelse
%%    dup isarray {
%%       mybool planprojpath
%%    } {
%%       mybool solidprojpath
%%    } ifelse
%% end
%% } def
%% 
%% syntaxe : solid i str bool solidprojpath --> -
%% ou
%% syntaxe : solid i alpha str bool solidprojpath --> -
%% projette le chemin courant sur la face i du solide, apres
%% eventuellement une rotation d angle alpha autour de la normale
%% bool : pour savoir si on tient compte de la visibilite
/solidprojpath {
5 dict begin
   /visibility exch def
   dup isstring {
      /option exch def
   } if
   2 copy pop
   issolid {
      /alpha 0 def
   } {
      /alpha exch def
   } ifelse
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidprojpath) ==
   } if
   /n solid solidnombrefaces def
   i n 1 sub le {
      visibility not solid i solidfacevisible? or {
         currentdict /option known {
            option cvx exec
         } {
            solid i solidcentreface 
         } ifelse
         [
            solid 0 i solidgetsommetface 
            solid 1 i solidgetsommetface 
            vecteur3d normalize3d
            solid i solidnormaleface alpha 
         ] false planprojpath 
      } {
         newpath 0 0 smoveto
      } ifelse
   } {
      (Error : indice trop grand dans solidprojpath) ==
      quit
   } ifelse
end
} def

%% syntaxe : x y z [normal] bool planprojpath
/planprojpath {
6 dict begin
   /visibility exch def
   %% on calcule l image de la base (I,J,K)
   normalvect_to_orthobase
   /imageK defpoint3d
   /imageJ defpoint3d
   /imageI defpoint3d
   /z exch def
   /y exch def
   /x exch def

   visibility not x y z imageK planvisible? or {
      {ptojpoint 0
      imageI
      imageJ
      imageK
      transformpoint3d
      x y z addv3d
      3dto2d jtoppoint} currentppathtransform
   } {
      newpath
   } ifelse
end
} def

%%%%% ### projscene ###
%% syntaxe : plantype bool bprojscene ... eprojscene
/bprojscene {
10 dict begin
gsave
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   /l@pl@n exch def
   /saveStroke {SolidesDict /Stroke get exec} def
   /Stroke {l@pl@n mybool projpath saveStroke} def
   /savefill {SolidesDict /Fill get exec} def
   /Fill {l@pl@n mybool projpath savefill} def
   /masque {} def
   l@pl@n plangetrange aload pop 
   setyrange setxrange
   newpath
%%       xmin ymin l@pl@n pointplan smoveto
%%       xmin ymax l@pl@n pointplan slineto
%%       xmax ymax l@pl@n pointplan slineto
%%       xmax ymin l@pl@n pointplan slineto
%%       xmin ymin l@pl@n pointplan smoveto
%%  %   closepath
%% %gsave orange Fill grestore
%%    clip
} def
/eprojscene {
grestore
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%          fonctions numeriques                      %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### courbeparam ###
/setresolution {
   /resolution exch def
} def
/resolution 200 def

/courbe_dic 2 dict def
courbe_dic /X {} put
courbe_dic /Y {} put

%% syntaxe : tmin tmax C@urbeparam_
 /C@urbeparam_ {
6 dict begin
   /tmax@ exch def
   /tmin@ exch def
   /t tmin@ def
   /dt tmax@ tmin@ sub resolution 1 sub div def
   tmin@ courbe_dic /X get exec
   pstrickactionR
   tmin@ courbe_dic /Y get exec
   pstrickactionR
   smoveto
   resolution 1 sub
   {
      t courbe_dic /X get exec
      pstrickactionR
      t courbe_dic /Y get exec
      pstrickactionR
      slineto

      /t t dt add store                      %% on incremente
   }
   repeat
   tmax@ courbe_dic /X get exec
   pstrickactionR
   tmax@ courbe_dic /Y get exec
   pstrickactionR
   slineto
end
} def

%% syntaxe : tmin tmax {X} {Y} Courbeparam_
/Courbeparam_ {
   courbe_dic exch /Y exch put
   courbe_dic exch /X exch put
   C@urbeparam_
} def

%% syntaxe : {X} {Y} courbeparam_
/courbeparam_ {
   tmin tmax
   4 -1 roll
   4 -1 roll
   Courbeparam_
} def

%% syntaxe : tmin tmax {X} {Y} Courbeparam
/Courbeparam {
gsave
6 dict begin
   dup isstring
      {
         /option exch def
      }
   if
   courbe_dic exch /Y exch put
   courbe_dic exch /X exch put
   /tmax exch def
   /tmin exch def

   newpath
      tmin courbe_dic /X get exec
      pstrickactionR
      tmin courbe_dic /Y get exec
      pstrickactionR
      smoveto                        %% on commence le chemin
      tmin tmax C@urbeparam_
      starfill

   stockcurrentcpath
   newarrowpath
   currentdict /option known
      {
         /dt tmax tmin sub resolution 1 sub div def
         tmin dt add courbe_dic /X get exec
         tmin dt add courbe_dic /Y get exec
         tmin courbe_dic /X get exec
         tmin courbe_dic /Y get exec
         arrowpath0
         tmax dt sub courbe_dic /X get exec
         tmax dt sub courbe_dic /Y get exec
         tmax courbe_dic /X get exec
         tmax courbe_dic /Y get exec
         currentdict /dt undef
         arrowpath1
         option
         gere_arrowhead
      }
   if

   currentlinewidth 0 eq {} { Stroke } ifelse

end
grestore
} def

%% syntaxe : {X} {Y} courbeparam
/courbeparam {
   dup isstring
      {
         tmin tmax
         5 -1 roll
         5 -1 roll
         5 -1 roll
      }
      {
         tmin tmax
         4 -1 roll
         4 -1 roll
      }
   ifelse
   Courbeparam
} def

%% syntaxe : tmin tmax {X} {Y} Courbeparam*
/Courbeparam* {
1 dict begin
   /startest {true} def
   Courbeparam
end
} def

%% syntaxe : {X} {Y} courbeparam*
/courbeparam* {
1 dict begin
   /startest {true} def
   courbeparam
end
} def

%%%%% ### courbe ###
%% syntaxe : {f} courbe
/courbe {
   dup isstring   %% y a-t-il une option de fin de ligne ?
      {
         xmin xmax 
         {} 
         5 -1 roll
         5 -1 roll
      }
      {
         xmin xmax 
         {} 
         4 -1 roll
      }
   ifelse
   Courbeparam
} def

%% syntaxe : mini maxi {f} Courbe
/Courbe {
   dup isstring {
      {}
      3 -1 roll
      3 -1 roll
   } {
      {}
      2 -1 roll
   } ifelse
   Courbeparam
} def

%% syntaxe : {f} courbe_
/courbe_ {
   xmin xmax 
   {} 
   4 -1 roll
   Courbeparam_
} def

%% syntaxe : mini maxi {f} Courbe_
/Courbe_ {
   {}
   2 -1 roll
   Courbeparam_
} def

%% syntaxe : mini maxi {f} Courbe*
/Courbe* {
1 dict begin
   /startest {true} def
   Courbe
end
} def

%% syntaxe : {f} courbe*
/courbe* {
1 dict begin
   /startest {true} def
   courbe
end
} def

%%%%% ### courbeR2 ###
%% syntaxe : tmin tmax C@urbeR2_
 /C@urbeR2_ {
6 dict begin
   /tmax@ exch def
   /tmin@ exch def
   /t tmin@ def
   /dt tmax@ tmin@ sub resolution 1 sub div def
   tmin@ courbe_dic /X get exec
   pstrickactionR2
   smoveto
   /t t dt add store
   resolution 2 sub
   {
      t courbe_dic /X get exec
      pstrickactionR2
      slineto
      /t t dt add store                      %% on incremente
   }
   repeat
   tmax@ courbe_dic /X get exec
   pstrickactionR2
   slineto
end
} def

%% syntaxe : tmin tmax {X} CourbeR2_
/CourbeR2_ {
   courbe_dic exch /X exch put
   C@urbeR2_
} def

%% syntaxe : {X} courbeR2_
/courbeR2_ {
   tmin tmax
   3 -1 roll
   3 -1 roll
   CourbeR2_
} def

%% syntaxe : tmin tmax {X} CourbeR2
/CourbeR2+ {
2 dict begin
   /slineto {} def
   /smoveto {} def
   CourbeR2
end
} bind def

/CourbeR2 {
gsave
6 dict begin
   dup isstring
      {
         /option exch def
      }
   if
   courbe_dic exch /X exch put
   /tmax exch def
   /tmin exch def

   newpath
      tmin tmax C@urbeR2_
      starfill
   currentlinewidth 0 eq {} { Stroke } ifelse

end
grestore
} def

%% syntaxe : {X} courbeR2
/courbeR2 {
   tmin tmax
   3 -1 roll
   CourbeR2
} def

%% syntaxe : tmin tmax {X} CourbeR2*
/CourbeR2* {
1 dict begin
   /startest {true} def
   CourbeR2
end
} def

%% syntaxe : {X} {Y} courbeR2*
/courbeR2* {
1 dict begin
   /startest {true} def
   courbeR2
end
} def

%%%%% ### courbeR3 ###
%% syntaxe : t1 t2 {f} (option) CourbeR3
/CourbeR3 {
2 dict begin
   dup isstring {
      /option exch def
   } if
   /lafonction exch def
   {lafonction 3dto2d}
   currentdict /option known
      {option}
   if
  CourbeR2
end
} def

%% syntaxe : {f} (option) CourbeR3
/courbeR3 {
   tmin tmax 3 -1 roll CourbeR3
} def

%%%%% ### cercle ###
%% syntaxe : x0 y0 r cercle
/cercle {
3 dict begin
   /r@y@n exch def
   /y@ exch def
   /x@ exch def
   0 360 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam
end
} def

%% syntaxe : x0 y0 r cercle_
/cercle_ {
3 dict begin
   /r@y@n exch def
   /y@ exch def
   /x@ exch def
   x@ r@y@n add y@ smoveto
   0 360 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
end
} def

%% syntaxe : x0 y0 r cercle-_
/cercle-_ {
3 dict begin
   /r@y@n exch def
   /y@ exch def
   /x@ exch def
   x@ r@y@n add y@ smoveto
   360 0 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
end
} def

%% syntaxe : x0 y0 r cercle*
/cercle* {
1 dict begin
   /startest true def
   cercle
end
} def

%% syntaxe : alpha beta x0 y0 r Cercle
/Cercle {
4 dict begin
   dup isstring
      {/option exch def}
   if
   /r@y@n exch def
   /y@ exch def
   /x@ exch def
   {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} 
   currentdict /option known
      {option}
   if
   Courbeparam
end
} def

%% syntaxe : alpha beta x0 y0 r Cercle_
/Cercle_ {
3 dict begin
   /r@y@n exch def
   /y@ exch def
   /x@ exch def
   {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
end
} def

%% syntaxe : alpha beta x0 y0 r Cercle
/Cercle* {
1 dict begin
   /startest {true} def
   Cercle
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%      fonctions et constantes mathematiques         %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### math ###
%%%%%%%%%%% constantes mathematiques %%%%%%%%%%%%%%

/pi 3.14159 def
/e 2.71828 def

%%%%%%%%%%% fonctions mathematiques %%%%%%%%%%%%%%%

/rd {180 pi div mul} def        %% transforme des rd en degres
/deg {pi mul 180 div} def       %% transforme des degres en rd
/log {ln 10 ln div} def
/Exp {e exch exp} def
/Cos {rd cos} def
/Sin {rd sin} def
/tan {dup sin exch cos div} def
/cotan {dup cos exch sin div} def
/Tan {dup Sin exch Cos div} def
/Cotan {dup Cos exch Sin div} def
/coTan {Cotan} def
/arctan {
dup 0 ge
   {1 atan}
   {neg 1 atan neg}
ifelse
} def
/Arctan {arctan deg} def
/arccos {
   dup
   dup mul neg 1 add sqrt
   exch
   atan
} def
/Arccos {arccos deg} def
/arcsin {
   dup 1 eq {
      90
   } {
      dup
      dup mul neg 1 add sqrt
      atan
      dup 90 lt
         {}
         {360 sub}
      ifelse
   } ifelse
} def
/Arcsin {arcsin deg} def
/cosh {dup Exp exch neg Exp add 2 div} def
/sinh {dup Exp exch neg Exp sub 2 div} def
/tanh {dup sinh exch cosh div} def
/cotanh {dup cosh exch sinh div} def
/argcosh {dup dup mul 1 sub sqrt add ln} def
/argsinh {dup dup mul 1 add sqrt add ln} def
/argtanh {
   setxvar
   x 1 add
   1 x sub
   div
   ln
   2 div
} def
/factorielle {
      dup 0 eq
         {pop 1}
         {dup 1 sub factorielle mul}
      ifelse
} def
/Gauss {
3 dict begin
   /sigma exch def
   /m exch def
   /x exch def
   x m sub dup mul sigma dup mul 2 mul div neg Exp
   2 pi mul sigma dup mul mul sqrt div
end
} def
%% syntaxe : a n modulo
/modulo {
2 dict begin
   /n exch def
   /a exch def
   {
      a 0 lt {
         /a a n add store
      } {
         exit
      } ifelse
   } loop
   a n mod
end
} def

%%%%% ### max ###
/max {
   2 copy
   lt {exch} if
   pop
} def

%%%%% ### min ###
/min {
2 dict begin
   dup isarray {
      duparray /table exch def pop
      table 0 get
      1 1 table length 1 sub {
         /i exch def
         table i get
         min
      } for
   } {
      2 copy
      gt {exch} if
      pop
   } ifelse
end
} def

%%%%% ### setcolor ###
%% syntaxe : tableau setcolor
/setcolor {
   dup length 4 eq
      {aload pop setcmykcolor}
      {aload pop setrgbcolor}
   ifelse
} def

%%%%% ### in ###
%% cherche si un elt donne appartient au tableau donne
%% rque : utilise 3 variables locales
%% syntaxe : elt array in --> index boolean
/in {
3 dict begin
   /liste exch def
   /elt exch def
   /i 0 def
   false                        %% la reponse a priori
   liste length {
      liste i get elt eq {
         pop                    %% en enleve la reponse
         i true                 %% pour mettre la bonne
         exit
      } if
      /i i 1 add store
   } repeat
end
} def

%% cherche si un elt donne appartient au tableau donne
%% syntaxe : elt array in --> boolean
/In {
3 dict begin
   /liste exch def
   /elt exch def
   /i 0 def
   false                        %% la reponse a priori
   liste length {
      liste i get elt eq {
         pop                    %% en enleve la reponse
         true                 %% pour mettre la bonne
         exit
      } if
      /i i 1 add store
   } repeat
end
} def

%%%%% ### starfill ###
%% la procedure pour les objets "star"
%% si c est "star" on fait le fillstyle, sinon non
/starfill {
   startest {
      gsave
         clip
         fillstyle
      grestore
      /startest false def
   } if
} 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

%%%%% ### continu ### 
/continu {
   [] 0 setdash 
} def

%%%%% ### trigospherique ### 
%% passage spherique --> cartesiennes
%% les formules de passage ont été récupérées ici :
%%    http://fr.wikipedia.org/wiki/Coordonn%C3%A9es_polaires
%% syntaxe : r theta phi rtp2xyz -> x y z
/rtp2xyz {
6 dict begin
   /phi exch def
   /theta exch def
   /r exch def
   /x phi cos theta cos mul r mul def 
   /y phi cos theta sin mul r mul def
   /z phi sin r mul def
   x y z
end
} def

%% trace d'un arc sur une sphere de centre O
%% syntaxe : r theta1 phi1 r theta2 phi2 arcspherique
/arcspherique {
9 dict begin
   dup isstring {
      /option exch def
   } if
   /phi2 exch def
   /theta2 exch def
   pop
   /phi1 exch def
   /theta1 exch def
   /r exch def
   /n 12 def

   1 theta1 phi1 rtp2xyz /u defpoint3d
   1 theta2 phi2 rtp2xyz /v defpoint3d
   u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d

   /sinalpha u v vectprod3d norme3d def
   /cosalpha u v scalprod3d def
   /alpha sinalpha cosalpha atan def
   /n 12 def
   /pas alpha n div def

   gsave
      /t pas neg def
      [
         n 1 add {
            /t  t pas add store
            u t cos r mul mulv3d
            w t sin r mul mulv3d
            addv3d
         } repeat
      ] 
      currentdict /option known {
         option
      } if
      ligne3d
   grestore
end
} def

%% trace d'un arc sur une sphere de centre O
%% syntaxe : r theta1 phi1 r theta2 phi2 arcspherique
/arcspherique_ {
8 dict begin
   /phi2 exch def
   /theta2 exch def
   pop
   /phi1 exch def
   /theta1 exch def
   /r exch def
   /n 12 def

   1 theta1 phi1 rtp2xyz /u defpoint3d
   1 theta2 phi2 rtp2xyz /v defpoint3d
   u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d

   /sinalpha u v vectprod3d norme3d def
   /cosalpha u v scalprod3d def
   /alpha sinalpha cosalpha atan def
   /n 12 def
   /pas alpha n div def

   /t pas neg def
   [
      n 1 add {
         /t  t pas add store
         u t cos r mul mulv3d
         w t sin r mul mulv3d
         addv3d
      } repeat
   ] ligne3d_
end
} def

%% trace d'une geodesique sur une sphere de centre O
%% syntaxe : r theta1 phi1 r theta2 phi2 geodesique_sphere
/geodesique_sphere {
13 dict begin
   /phi2 exch def
   /theta2 exch def
   pop
   /phi1 exch def
   /theta1 exch def
   /r exch def
   /n 360 def

   1 theta1 phi1 rtp2xyz /u defpoint3d
   1 theta2 phi2 rtp2xyz /v defpoint3d
   u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d

   /sinalpha u v vectprod3d norme3d def
   /cosalpha u v scalprod3d def
   /alpha sinalpha cosalpha atan def
   /pas 360 n div def

   gsave
      /t pas neg def
      [
         n 1 add {
            /t  t pas add store
            u t cos r mul mulv3d
            w t sin r mul mulv3d
            addv3d
         } repeat
      ] ligne3d
   grestore
end
} def


%% syntaxe : A B C trianglespherique --> trace le rtiangle ABC
%% (coordonnees spheriques)
/trianglespherique* {
1 dict begin
   /startest {true} def
   trianglespherique
end
} def

/trianglespherique {
10 dict begin
   /C defpoint3d
   /B defpoint3d
   /A defpoint3d
   gsave
   newpath
      A rtp2xyz 3dto2d smoveto
      A B arcspherique_
      B C arcspherique_
      C A arcspherique_
   closepath
   starfill
   currentlinewidth 0 eq {} { Stroke } ifelse
   grestore
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%         operations sur les tableaux                %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### duparray ###
/duparray {
1 dict begin
   /table exch def
   table
   [ table aload pop ]
end
} def

%%%%% ### append ###
%% syntaxe : string1 string2 append --> concatene les 2 chaines ou fusionne 2 tableaux
/append {
3 dict begin
   dup isarray {
      /tab2 exch def
      /tab1 exch def
      [ tab1 aload pop tab2 aload pop ]
   } {
      /str2 exch def
      /str1 exch def
      /result str1 length str2 length add string def
      str1 result copy pop
      result str1 length str2 putinterval
      result
   } ifelse
end
} def

%%%%% ### rollparray ###
%% syntaxe : array n rollparray -> array
%% opere une rotation de n sur les couplets du tableau array
/rollparray {
4 dict begin
   /k exch def
   /table exch def
   /n table length def
   k 0 eq {
       table
   } {
       k 0 ge {
          [ table aload pop 2 {n 1 roll} repeat ]
           k 1 sub
       } {
          [ table aload pop 2 {n -1 roll} repeat ]
           k 1 add
       } ifelse
       rollparray
   } ifelse
end
} def

%%%%% ### bubblesort ###
%% syntaxe : array bubblesort --> array2 trie par ordre croissant
%% code de Bill Casselman
%% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
/bubblesort {
4 dict begin
   /a exch def
   /n a length 1 sub def
   n 0 gt {
      % at this point only the n+1 items in the bottom of a remain to
      % the sorted largest item in that blocks is to be moved up into
      % position n
      n {
         0 1 n 1 sub {
            /i exch def
            a i get a i 1 add get gt {
               % if a[i] > a[i+1] swap a[i] and a[i+1]
               a i 1 add
               a i get
               a i a i 1 add get
               % set new a[i] = old a[i+1]
               put
               % set new a[i+1] = old a[i]
               put
            } if
         } for
         /n n 1 sub def
      } repeat
   } if
   a
end
} def

%% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
%% trie par ordre croissant et array2 correspond a la position des
%% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
%% code de Bill Casselman, modifie par jpv, 15/08/2006
%% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
/doublebubblesort {
5 dict begin
   /table exch def
   /n table length 1 sub def
   /indices [ 0 1 n {} for ] def
   n 0 gt {
      % at this point only the n+1 items in the bottom of a remain to
      % the sorted largest item in that blocks is to be moved up into
      % position n
      n {
         0 1 n 1 sub {
            /i exch def
            table i get table i 1 add get gt {
               % if a[i] > a[i+1] swap a[i] and a[i+1]
               table i 1 add
               table i get
               table i table i 1 add get
               % set new a[i] = old a[i+1]
               put
               % set new a[i+1] = old a[i]
               put

               indices i 1 add
               indices i get
               indices i indices i 1 add get
               % set new a[i] = old a[i+1]
               put
               % set new a[i+1] = old a[i]
               put
            } if
         } for
         /n n 1 sub def
      } repeat
   } if
   indices table
end
} def

%%%%% ### quicksort ###
%% src : http://www.math.ubc.ca/~cass/graphics/text/www/code/sort.inc
%% code de Bill Casselman, modifie par jpv, 18/10/2007

/qsortdict 8 dict def

qsortdict begin

% args: /comp a L R x
% effect: effects a partition into two pieces [L j] [i R]
%     leaves i j on stack

/partition { 8 dict begin
/x exch def
/j exch def
/i exch def
/a exch def
load /comp exch def
{
  {
    a i get x comp exec not {
      exit
    } if
    /i i 1 add def
  } loop
  {
    x a j get comp exec not {
      exit
    } if
    /j j 1 sub def
  } loop

  i j le {
    % swap a[i] a[j]
    a j a i get
    a i a j get
    put put
    indices j indices i get
    indices i indices j get
    put put
    /i i 1 add def
    /j j 1 sub def
  } if
  i j gt {
    exit
  } if
} loop
i j
end } def

% args: /comp a L R
% effect: sorts a[L .. R] according to comp

/subsort {
% /c a L R
[ 3 1 roll ] 3 copy
% /c a [L R] /c a [L R]
aload aload pop
% /c a [L R] /c a L R L R
add 2 idiv
% /c a [L R] /c a L R (L+R)/2
3 index exch get
% /c a [L R] /c a L R x
partition
% /c a [L R] i j
% if j > L subsort(a, L, j)
dup
% /c a [L R] i j j
3 index 0 get gt {
  % /c a [L R] i j
  5 copy
  % /c a [L R] i j /c a [L R] i j
  exch pop
  % /c a [L R] i j /c a [L R] j
  exch 0 get exch
  % ... /c a L j
  subsort
} if
% /c a [L R] i j
pop dup
% /c a [L R] i i
% if i < R subsort(a, i, R)
2 index 1 get lt {
  % /c a [L R] i
  exch 1 get
  % /c a i R
  subsort
}{
  4 { pop } repeat
} ifelse
} def

end

% args: /comp a
% effect: sorts the array a
% comp returns truth of x < y for entries in a

/quicksort { qsortdict begin
dup length 1 gt {
% /comp a
dup
% /comp a a
length 1 sub
% /comp a n-1
0 exch subsort
} {
pop pop
} ifelse
end } def

% ----------------------------------------

%% fin du code de Bill Casselman

%% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
%% trie par ordre croissant et array2 correspond a la position des
%% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
%% code de Bill Casselman, modifie par jpv, 18/10/2007
%% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
/doublequicksort {
qsortdict begin
   /comp exch
   /a exch def
   a dup length /n exch def
   /indices [0 1 n 1 sub {} for ] def
   dup length 1 gt {
      % /comp a
      dup
      % /comp a a
      length 1 sub
      % /comp a n-1
      0 exch subsort
   } {
      pop pop
   } ifelse
   indices a
end
} def

/comp {lt} def

%%%%% ### apply ###
%% syntaxe : [x1 ... xn] (f) apply --> [f(x1) ... f(xn)]
/apply {
3 dict begin
   dup isstring
      {/fonction exch cvx def}
      {/fonction exch def}
   ifelse
   /liste exch def
   /@i 0 def
   [
   liste length {
      liste @i get fonction
      /@i @i 1 add store
   } repeat
   counttomark
   0 eq
      {pop}
      {]}
   ifelse
end
} def

%% syntaxe : [x1 ... xn] (f) papply
/papply {
3 dict begin
   dup isstring
      {/fonction exch cvx def}
      {/fonction exch def}
   ifelse
   /liste exch def
   /@i 0 def
   [
   liste length 2 idiv {
      liste @i get
      liste @i 1 add get
      fonction
      /@i @i 2 add store
   } repeat
   counttomark
   0 eq
      {pop}
      {]}
   ifelse
end
} def

%% syntaxe : [x1 ... xn] (f) capply 
/capply {
3 dict begin
   dup isstring
      {/fonction exch cvx def}
      {/fonction exch def}
   ifelse   
   /liste exch def
   /@i 0 def
   [
   liste length 3 idiv {
      liste @i get 
      liste @i 1 add get 
      liste @i 2 add get 
      fonction
      /@i @i 3 add store
   } repeat
   counttomark 
   0 eq
      {pop}
      {]}
   ifelse
end
} def

%%%%% ### reverse ###
%% syntaxe : array reverse --> inverse l ordre des items dans
%% le tableau
/reverse {
3 dict begin
   /le_tableau exch def
   /n le_tableau length def
   /i n 1 sub def
   [
      n {
         le_tableau i get
         /i i 1 sub store
      } repeat
   ]
end
} def

%% syntaxe : array_points reversep --> inverse l ordre des points dans
%% le tableau
/reversep {
3 dict begin
   /le_tableau exch def
   /n le_tableau length 2 idiv def
   /i n 1 sub def
   [
      n {
         le_tableau i getp
         /i i 1 sub store
      } repeat
   ]
end
} def

%%%%% ### get ###
%% syntaxe : array_points n getp --> le n-ieme point du tableau de
%% points array_points
/getp {
   2 copy
   2 mul get
   3 1 roll
   2 mul 1 add get
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             matrices                               %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### linear ###
%% syntaxe : M i j any --> depose any dans M en a_ij
/put_ij {
5 dict begin
   /a exch def
   /j exch def
   /i exch def
   /M exch def
   /L M i get_Li def
   L j a put
   M i L put_Li
end
} def

%% syntaxe : M i j get_ij --> le coeff c_ij
/get_ij {
   3 1 roll   %% j M i
   get_Li     %% j L_i
   exch get
} def

%% syntaxe : M i L put_Li --> remplace dans M la ligne Li par L
/put_Li {
   put
} def

%% syntaxe : M i get_Li --> la ligne Li de M
/get_Li {
   get
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%          geometrie 3d (calculs)                    %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### p3dtoplane ###
%% syntaxe : x y z P p3dtoplane --> X Y
/p3dtoplane {
5 dict begin
   /leplan exch def
   /M defpoint3d
   leplan plangetbase 0 getp3d /U defpoint3d
   leplan plangetbase 1 getp3d /V defpoint3d
   leplan plangetorigine /I defpoint3d
   I M vecteur3d U scalprod3d
   I M vecteur3d V scalprod3d
end
} def

%%%%% ### pplaneto3d ###
%% syntaxe : x y P pplaneto3d --> X Y Z
/pplaneto3d {
6 dict begin
   /leplan exch def
   /y exch def
   /x exch def
   leplan plangetbase 0 getp3d /U defpoint3d
   leplan plangetbase 1 getp3d /V defpoint3d
   leplan plangetorigine /I defpoint3d
   U x mulv3d
   V y mulv3d addv3d
   I addv3d
end
} def

%%%%% ### orthoprojplane3d ### 
%% Projection orthogonale d'un point 3d sur un plan
%% Mx My Mz (=le point a projeter) 
%% Ax Ay Az (=un point du plan) 
%% Vx Vy Vz (un vecteur normal au plan)
/orthoprojplane3d { 
4 dict begin
   dup isplan {
      /monplan exch def
      monplan plangetorigine
      monplan plangetbase aload pop vectprod3d
   } if
   /V defpoint3d
   /A defpoint3d
   /M defpoint3d
   /VN {V unitaire3d} def
   VN M A vecteur3d VN scalprod3d mulv3d
   M addv3d
end
} def

%%%%% ### sortp3d ### 
/sortp3d {
6 dict begin
   /M1 defpoint3d
   /M0 defpoint3d
   M1
   /z1 exch def
   /y1 exch def
   /x1 exch def
   M0
   /z0 exch def
   /y0 exch def
   /x0 exch def
   x0 x1 lt {
      M0 M1
   } {
      x0 x1 gt {
         M1 M0
      } {
         y0 y1 lt {
            M0 M1
         } {
            y0 y1 gt {
               M1 M0
            } {
               z0 z1 lt {
                  M0 M1
               } {
                  M1 M0
               } ifelse
            } ifelse
         } ifelse
      } ifelse
   } ifelse
end
} def

%%%%% ### dupp3d ### 
%% duplique le vecteur 3d
/dupp3d { %% x y z
        3 copy
} def
/dupv3d {dupp3d} def

%%%%% ### angle3d ###
%% syntaxe : vect1 vect2 angle3d
/angle3d {
4 dict begin
   normalize3d /vect2 defpoint3d
   normalize3d /vect1 defpoint3d
   /cosalpha vect1 vect2 scalprod3d def
   /sinalpha vect1 vect2 vectprod3d norme3d def
   sinalpha cosalpha atan
end
} def

%%%%% ### transformpoint3d ###
%% syntaxe : x y z a11 a21 a31 a12 a22 a32 a13 a23 a33
%%    transformpoint3d -> X Y Z
/transformpoint3d {
12 dict begin
   /a33 exch def
   /a23 exch def
   /a13 exch def
   /a32 exch def
   /a22 exch def
   /a12 exch def
   /a31 exch def
   /a21 exch def
   /a11 exch def
   /z   exch def
   /y   exch def
   /x   exch def
   a11 x mul a12 y mul add a13 z mul add
   a21 x mul a22 y mul add a23 z mul add
   a31 x mul a32 y mul add a33 z mul add
end
} def

%%%%% ### normalize3d ###
%% rend le vecteur 3d unitaire. Ne fait rien si u=0
/unitaire3d { %% x y z
2 dict begin
   /u defpoint3d
   /norme u norme3d def
   norme 0 eq {
      u
   } {
      u 1 norme div mulv3d
   } ifelse
end
} def
/normalize3d {unitaire3d} def

%%%%% ### geom3d ###
%% syntaxe : A k1 B k2 barycentre3d -> G, barycentre du systeme
%% [(A, k1) (B, k2)]
/barycentre3d {
4 dict begin
   /k2 exch def
   /B defpoint3d
   /k1 exch def
   /A defpoint3d
   A k1 mulv3d
   B k2 mulv3d
   addv3d
   1 k1 k2 add div mulv3d
end
} def

%% syntaxe : array isobarycentre3d --> G
/isobarycentre3d {
2 dict begin
   /table exch def
   /n table length 3 idiv def
   table 0 getp3d
   1 1 n 1 sub {
       table exch getp3d
       addv3d
   } for
   1 n div mulv3d
end
} def

%% syntaxe : M A alpha hompoint3d -> le point M' tel que AM' = alpha AM 
/hompoint3d {
3 dict begin
   /alpha exch def
   /A defpoint3d
   /M defpoint3d
   A M vecteur3d alpha mulv3d A addv3d
end
} def

%% syntaxe : M A sympoint3d -> le point M' tel que AM' = -AM
/sympoint3d {
2 dict begin
   /A defpoint3d
   /M defpoint3d
   A M vecteur3d -1 mulv3d A addv3d
end
} def

%% syntaxe : A u translatepoint3d --> B image de A par la translation de vecteur u
/translatepoint3d {
   addv3d
} def

/scaleOpoint3d {
6 dict begin
   /k3 exch def
   /k2 exch def
   /k1 exch def
   /z exch def
   /y exch def
   /x exch def
   k1 x mul
   k2 y mul
   k3 z mul
end
} def

% syntaxe : M alpha_x alpha_y alpha_z rotateOpoint3d --> M'
/rotateOpoint3d {
21 dict begin
   /RotZ exch def
   /RotY exch def
   /RotX exch def
   /Zpoint exch def
   /Ypoint exch def
   /Xpoint exch def
   /c1 {RotX cos} bind def
   /c2 {RotY cos} bind def
   /c3 {RotZ cos} bind def
   /s1 {RotX sin} bind def
   /s2 {RotY sin} bind def
   /s3 {RotZ sin} bind def
   /M11 {c2 c3 mul} bind def
   /M12 {c3 s1 mul s2 mul c1 s3 mul sub} bind def
   /M13 {c1 c3 mul s2 mul s1 s3 mul add} bind def
   /M21 {c2 s3 mul} bind def
   /M22 {s1 s2 mul s3 mul c1 c3 mul add} bind def
   /M23 {s3 s2 mul c1 mul c3 s1 mul sub} bind def
   /M31 {s2 neg} bind def
   /M32 {s1 c2 mul} bind def
   /M33 {c1 c2 mul} bind def
   M11 Xpoint mul M12 Ypoint mul add M13 Zpoint mul add
   M21 Xpoint mul M22 Ypoint mul add M23 Zpoint mul add
   M31 Xpoint mul M32 Ypoint mul add M33 Zpoint mul add
end
} def

%%%%% ### symplan3d ###
%% syntaxe : M eqplan/plantype symplan3d --> M'
%% ou M' symetrique de M par rapport au plan P defini par eqplan/plantype
/symplan3d {
13 dict begin
   dup isplan {
      plan2eq /args exch def
   } {
      /args exch def
   } ifelse
   /z exch def
   /y exch def
   /x exch def
   args aload pop
   /d1 exch def
   /c1 exch def
   /b1 exch def
   /a1 exch def
   /n_U a1 dup mul b1 dup mul add c1 dup mul add sqrt def
   /a a1 n_U div def
   /b b1 n_U div def
   /c c1 n_U div def
   /d d1 n_U div def
   /u a x mul b y mul add c z mul add d add def
   x 2 a mul u mul sub
   y 2 b mul u mul sub
   z 2 c mul u mul sub
end
} def

%%%%% ### vecteur3d ###
%% creation du vecteur AB a partir de A et B
/vecteur3d { %% xA yA zA xB yB zB
6 dict begin
   /zB exch def
   /yB exch def
   /xB exch def
   /zA exch def
   /yA exch def
   /xA exch def
   xB xA sub
   yB yA sub
   zB zA sub
end
}def

%%%%% ### vectprod3d ###
%% produit vectoriel de deux vecteurs 3d
/vectprod3d { %% x1 y1 z1 x2 y2 z2
6 dict begin
   /zp exch def
   /yp exch def
   /xp exch def
   /z exch def
   /y exch def
   /x exch def
   y zp mul z yp mul sub
   z xp mul x zp mul sub
   x yp mul y xp mul sub
end
} def

%%%%% ### scalprod3d ###
%% produit scalaire de deux vecteurs 3d
/scalprod3d { %% x1 y1 z1 x2 y2 z2
6 dict begin
   /zp exch def
   /yp exch def
   /xp exch def
   /z exch def
   /y exch def
   /x exch def
   x xp mul y yp mul add z zp mul add
end
} def

%%%%% ### papply3d ###
%% syntaxe : [A1 ... An] (f) papply3d --> [f(A1) ... f(An)]
/papply3d {
3 dict begin
   /fonction exch def
   /liste exch def
   /i 0 def
   [
   liste length 3 idiv {
      liste i get
      liste i 1 add get
      liste i 2 add get
      fonction
      /i i 3 add store
   } repeat
   counttomark
   0 eq
      {pop}
      {]}
   ifelse
end
} def

%%%%% ### defpoint3d ###
%% creation du point A a partir de xA yA yB et du nom /A
/defpoint3d { %% xA yA zA /nom
1 dict begin
   /memo exch def
   [ 4 1 roll ] cvx memo exch
end def
}def

%%%%% ### distance3d ###
/distance3d { %% A B
   vecteur3d norme3d
} def

%%%%% ### get3d ###
/getp3d { %% [tableau de points 3d] i --> donne le ieme point du tableau
   2 copy 2 copy
   3 mul get
   5 1 roll
   3 mul 1 add get
   3 1 roll
   3 mul 2 add get
} def

%%%%% ### norme3d ###
%% norme d un vecteur 3d
/norme3d { %% x y z
3 dict begin
   /z exch def
   /y exch def
   /x exch def
   x dup mul y dup mul add z dup mul add sqrt
end
} def

%%%%% ### mulv3d ###
%% (scalaire)*(vecteur 3d) Attention : dans l autre sens !
/mulv3d { %% x y z lambda
4 dict begin
   /lambda exch def
   /z exch def
   /y exch def
   /x exch def
   x lambda mul
   y lambda mul
   z lambda mul
end
} def

%%%%% ### addv3d ###
%% addition de deux vecteurs 3d
/addv3d { %% x1 y1 z1 x2 y2 z2
6 dict begin
   /zp exch def
   /yp exch def
   /xp exch def
   /z exch def
   /y exch def
   /x exch def
   x xp add
   y yp add
   z zp add
end
} def

%%%%% ### milieu3d ###
/milieu3d { %% A B --> I le milieu de [AB]
   addv3d 0.5 mulv3d
} def

%%%%% ### exch ###
/exchp {
   4 -1 roll
   4 -1 roll
} def
/exchc {
   6 -1 roll
   6 -1 roll
   6 -1 roll
} def
/exchd {
   4 {8 -1 roll} repeat
} def
/exchp3d {
   6 -1 roll
   6 -1 roll
   6 -1 roll
} def

%%%%% ### ABpoint3d ###
%% syntaxe : A B k ABpoint3d --> M
%% M tel que vect(AM) = k vect (AB)
/ABpoint3d {
3 dict begin
   /k exch def
   /B defpoint3d
   /A defpoint3d
   A B vecteur3d
   k mulv3d
   A addv3d 
end
} def

%%%%% ### angle3doriente ###
%% syntaxe : vect1 vect2 vect3 angle3d
%% vect3 est la normale au plan (vect1, vect2)
/angle3doriente {
4 dict begin
   normalize3d /vect3 defpoint3d
   normalize3d /vect2 defpoint3d
   normalize3d /vect1 defpoint3d
   /cosalpha vect1 vect2 scalprod3d def
   /sinalpha vect1 vect2 vectprod3d vect3 scalprod3d def
   sinalpha cosalpha atan
end
} def

%%%%% ### points3dalignes ###
%% syntaxe : A B C points3dalignes -> bool
/points3dalignes {
3 dict begin
   /C defpoint3d
   /B defpoint3d
   /A defpoint3d
   A B vecteur3d /u defpoint3d
   A C vecteur3d /v defpoint3d
   u v vectprod3d norme3d 1E-7 lt
end
} def

%% syntaxe : M A B point3dsursegment --> true si M in [AB], false sinon
/point3dsursegment {
3 dict begin
   /B defpoint3d
   /A defpoint3d
   /M defpoint3d
   M A B points3dalignes {
      M A vecteur3d
      M B vecteur3d
      scalprod3d 0 lt {
         true
      } {
         false
      } ifelse
   } {
      false
   } ifelse
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%          geometrie 3d (dessins)                    %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### point3d ###
/point3d { %% A
   3dto2d point
} def

/points3d { %% tableau de points3d
   tab3dto2d points
} def

%%%%% ### ligne3d ###
%% [tableau de points3d] option --> trace la ligne brisee
/ligne3d { 
1 dict begin
   dup isstring
      {/option exch def}
   if
   tab3dto2d
   currentdict /option known
      {option}
   if
   ligne
end
} def

%% [tableau de points3d] option --> trace la ligne brisee
/ligne3d_ { 
1 dict begin
   dup isstring
      {/option exch def}
   if
   tab3dto2d
   currentdict /option known
      {option}
   if
   ligne_
end
} def

%%%%% ### tab3dto2d ###
%% transforme un tableau de points 3d en tableau de points 2d
/tab3dto2d {
2 dict begin
   /T exch def
   /n T length def
   [ T aload pop
   n 1 sub -1 n 3 idiv 2 mul
   { 1 dict begin
   /i exch def
   3dto2d i 2 roll
   end } for ]
end
} def

%%%%% ### polygone3d ###
/polygone3d { %% tableau de points3d
   tab3dto2d polygone
} def

/polygone3d* { %% tableau de points3d
   tab3dto2d polygone*
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                 gestion du texte                   %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### marks ###
/xmkstep 1 def          % les marques sur Ox
/xmarkstyle {dctext} def
/ymarkstyle {(-1 0) bltext} def
/setxmkstep {
   /xmkstep exch def
} def
/xmark {
   dup xtick
   /Courier findfont .8 fontsize mul scalefont setfont
   dup dup truncate eq {
      cvi dup chaine cvs exch 
   } {
      dup chaine cvs exch 
   } ifelse
   Oy xmarkstyle
} def
/xmarks {
2 dict begin
   /n xmax xmax xmin sub 1000 div sub xmkstep div truncate cvi 
      xmkstep mul def                   % mark max
   /i xmin xmkstep div truncate cvi 
      xmkstep mul def                   % la 1ere
   i xmin lt {/i i xmkstep add store} if
   {
      i 0 ne {i xmark} if
      /i i xmkstep abs add store
      i n gt {exit} if
   } loop 
end
} def

/ymkstep 1 def          % les marques sur Oy
/setymkstep {
   /ymkstep exch def
} def
/ymark {
   dup ytick
   /Courier findfont .8 fontsize mul scalefont setfont
   dup chaine cvs exch 
   Ox exch ymarkstyle
} def
/ymarks {
2 dict begin
   /n ymax ymax ymin sub 1000 div sub ymkstep div truncate cvi 
      ymkstep mul def                   % mark max
   /i ymin ymkstep div truncate cvi 
      ymkstep mul def                   % la 1ere
   {
      i 0 ne {i ymark} if
      /i i ymkstep abs add store
      i n gt {exit} if
   } loop 
end
} def

/setmkstep {
   setymkstep
   setxmkstep
} def
/marks {
   xmarks
   ymarks
} def

%%%%% ### setfontsize ###
/setfontsize {
   /fontsize exch def
} def

%%%%% ### setCourrier ###
/Courier findfont 
dup length dict begin
   {
   1 index /FID ne 
      {def}
      {pop pop} 
   ifelse
   } forall
   /Encoding ISOLatin1Encoding def
   currentdict
end

/Courier-ISOLatin1 exch definefont pop

/setCourier {
   /Courier-ISOLatin1 findfont 
   fontsize scalefont 
   setfont
} def

%%%%% ### pathtext ###
%% syntaxe : string x y initp@thtext
 /initp@thtext {
7 dict begin
   /y exch def
   /x exch def
   /str exch def
   str 0 0 show_dim
   /wy exch def
   /wx exch def
   /lly exch def
   /llx exch def
   pop pop pop
   newpath 
      x y  smoveto
} def
 /closep@thtext {
      str true charpath
end
} def

%% syntaxe : string x y cctext_
/cctext_ {
   initp@thtext
   llx wx add lly wy add -.5 mulv rmoveto
   closep@thtext
} def

/brtext_ {
   initp@thtext
   hadjust 0 rmoveto
   llx neg 0 rmoveto
   closep@thtext
} def

/bbtext_ {
   initp@thtext
   0 0 rmoveto
   0 0 rmoveto
   closep@thtext
} def

/bltext_ {
   initp@thtext
   hadjust neg 0 rmoveto
   wx neg 0 rmoveto
   closep@thtext
} def

/bctext_ {
   initp@thtext
   0 0 rmoveto
   wx llx add -.5 mul 0 rmoveto
   closep@thtext
} def

/ubtext_ {
   initp@thtext
   0 vadjust rmoveto
   0 lly neg rmoveto
   closep@thtext
} def

/urtext_ {
   initp@thtext
   hadjust vadjust rmoveto
   llx neg lly neg rmoveto
   closep@thtext
} def

/ultext_ {
   initp@thtext
   hadjust neg vadjust rmoveto
   wx neg lly neg rmoveto
   closep@thtext
} def

/uctext_ {
   initp@thtext
   0 vadjust rmoveto
   llx wx add -.5 mul lly neg rmoveto
   closep@thtext
} def

/drtext_ {
   initp@thtext
   hadjust vadjust neg rmoveto
   llx neg wy neg rmoveto
   closep@thtext
} def

/dbtext_ {
   initp@thtext
   0 vadjust neg rmoveto
   0 wy neg rmoveto
   closep@thtext
} def

/dltext_ {
   initp@thtext
   hadjust neg vadjust neg rmoveto
   wx neg wy neg rmoveto
   closep@thtext
} def

/dctext_ {
   initp@thtext
   0 vadjust neg rmoveto
   llx wx add -2 div wy neg rmoveto
   closep@thtext
} def

/crtext_ {
   initp@thtext
   hadjust 0 rmoveto
   llx neg lly wy add -2 div rmoveto
   closep@thtext
} def

/cbtext_ {
   initp@thtext
   0 0 rmoveto
   0 lly wy add -2 div rmoveto
   closep@thtext
} def

/cltext_ {
   initp@thtext
   hadjust neg 0 rmoveto
   wx neg lly wy add -2 div rmoveto
   closep@thtext
} def

/cctext_ {
   initp@thtext
   0 0 rmoveto
   llx wx add lly wy add -.5 mulv rmoveto
   closep@thtext
} def

%%%%% ### text3d ###
%%%% Version 3d des commandes jps TEXTE
 /pr@p@re3d {
2 dict begin
%   /vect_echelle [1 1] def
%   /angle_de_rot {0} def
%   dup xcheck
%      {/angle_de_rot exch def}
%   if
%   dup isarray
%      {/vect_echelle exch def}
%   if%   CamView vect_echelle {angle_de_rot}
   3dto2d
} def

/bbtext3d {
   pr@p@re3d
   bbtext
end
} def

/bbtexlabel3d {
   pr@p@re3d
   bbtexlabel
end
} def

/bctext3d {
   pr@p@re3d
   bctext
end
} def

/bctexlabel3d {
   pr@p@re3d
   bctexlabel
end
} def

/bltext3d {
   pr@p@re3d
   bltext
end
} def

/bltexlabel3d {
   pr@p@re3d
   bltexlabel
end
} def

/brtext3d {
   pr@p@re3d
   brtext
end
} def

/brtexlabel3d {
   pr@p@re3d
   brtexlabel
end
} def

/cbtext3d {
   pr@p@re3d
   cbtext
end
} def

/cbtexlabel3d {
   pr@p@re3d
   cbtexlabel
end
} def

/cctext3d {
   pr@p@re3d
   cctext
end
} def

/cctexlabel3d {
   pr@p@re3d
   cctexlabel
end
} def

/cltext3d {
   pr@p@re3d
   cltext
end
} def

/cltexlabel3d {
   pr@p@re3d
   cltexlabel
end
} def

/crtext3d {
   pr@p@re3d
   crtext
end
} def

/crtexlabel3d {
   pr@p@re3d
   crtexlabel
end
} def

/dbtext3d {
   pr@p@re3d
   dbtext
end
} def

/dbtexlabel3d {
   pr@p@re3d
   dbtexlabel
end
} def

/dctext3d {
   pr@p@re3d
   dctext
end
} def

/dctexlabel3d {
   pr@p@re3d
   dctexlabel
end
} def

/dltext3d {
   pr@p@re3d
   dltext
end
} def

/dltexlabel3d {
   pr@p@re3d
   dltexlabel
end
} def

/drtext3d {
   pr@p@re3d
   drtext
end
} def

/drtexlabel3d {
   pr@p@re3d
   drtexlabel
end
} def

/ubtext3d {
   pr@p@re3d
   ubtext
end
} def

/ubtexlabel3d {
   pr@p@re3d
   ubtexlabel
end
} def

/uctext3d {
   pr@p@re3d
   uctext
end
} def

/uctexlabel3d {
   pr@p@re3d
   uctexlabel
end
} def

/ultext3d {
   pr@p@re3d
   ultext
end
} def

/ultexlabel3d {
   pr@p@re3d
   ultexlabel
end
} def

/urtext3d {
   pr@p@re3d
   urtext
end
} def

/urtexlabel3d {
   pr@p@re3d
   urtexlabel
end
} def

%%%%% ### fin insertion ###

%% La macro provisoire de developpement (27/01/2009)
%% syntaxe : solid table tablez --> -
/solidcolorz {
10 dict begin
   %% les hauteurs
   /tablez exch def
   %% les couleurs
   /usertable exch def
   /solid exch def
   %% a-t-on des couleurs nommees ?
   usertable 0 get isstring {
      %% oui, et autant que d etages
      usertable length 1 sub tablez length eq {
         /table usertable def
      } {
         %% oui, mais moins que d etages
         %% ==> on definit les 2 premieres en RGB
         /a0 usertable 0 get def
         /a1 usertable 1 get def
         /lacouleurdepart {
            gsave
               [a0 cvx exec] length 0 eq {
                  a0 cvx exec currentrgbcolor
               } {
                  a0 cvx exec
               } ifelse 
            grestore
         } def
         /lacouleurarrivee {
            gsave
               [a1 cvx exec] length 0 eq {
                  a1 cvx exec currentrgbcolor
               } {
                  a1 cvx exec
               } ifelse 
            grestore
         } def
         /usertable [lacouleurdepart lacouleurarrivee] def
      } ifelse
   } if
   usertable 0 get isnum {
      %% c est un degrade : nb de couleurs a definir
      /n tablez length 1 add def
%      
      usertable length 4 eq {
          /a0 usertable 0 get def
          /a1 usertable 1 get def
          /A {a0 i a1 a0 sub mul n 1 sub div add} def
          /B usertable 2 get def
          /C usertable 3 get def
          /D {} def
          /espacedecouleurs (sethsbcolor) def
      } if
%      
      usertable length 6 eq {
          /a0 usertable 0 get def
          /b0 usertable 1 get def
          /c0 usertable 2 get def
          /a1 usertable 3 get def
          /b1 usertable 4 get def
          /c1 usertable 5 get def
          /A {a0 i a1 a0 sub mul n 1 sub div add} def
          /B {b0 i b1 b0 sub mul n 1 sub div add} def
          /C {c0 i c1 c0 sub mul n 1 sub div add} def
          /D {} def
          /espacedecouleurs (setrgbcolor) def
      } if
%
      usertable length 7 eq {
          /a0 usertable 0 get def
          /b0 usertable 1 get def
          /c0 usertable 2 get def
          /a1 usertable 3 get def
          /b1 usertable 4 get def
          /c1 usertable 5 get def
          /A {a0 i a1 a0 sub mul n 1 sub div add} def
          /B {b0 i b1 b0 sub mul n 1 sub div add} def
          /C {c0 i c1 c0 sub mul n 1 sub div add} def
          /D {} def
          /espacedecouleurs (sethsbcolor) def
      } if
%   
      usertable length 8 eq {
          /a0 usertable 0 get def
          /b0 usertable 1 get def
          /c0 usertable 2 get def
          /d0 usertable 3 get def
          /a1 usertable 4 get def
          /b1 usertable 5 get def
          /c1 usertable 6 get def
          /d1 usertable 7 get def
          /A {a0 i a1 a0 sub mul n 1 sub div add} def
          /B {b0 i b1 b0 sub mul n 1 sub div add} def
          /C {c0 i c1 c0 sub mul n 1 sub div add} def
          /D {d0 i d1 d0 sub mul n 1 sub div add} def
          /espacedecouleurs (setcmykcolor) def
      } if
%
      usertable length 2 eq {
         /a0 usertable 0 get def
         /a1 usertable 1 get def
         0 1 n 1 sub {
            /i exch def
            /A {a0 i a1 a0 sub mul n 1 sub div add} def
            /B {1} def
            /C {1} def
            /D {} def
            /espacedecouleurs (sethsbcolor) def
         } for
      } if
%
      %% on affecte la table des couleurs
      /table [
         0 1 n 1 sub {
            /i exch def
            [A B C D] espacedecouleurs astr2str
         } for
      ] def
   } if
%
   /n solid solidnombrefaces def
   0 1 n 1 sub {
      /i exch def
      solid i solidcentreface /z exch def pop pop
      /resultat 0 def
      0 1 tablez length 1 sub {
         /j exch def
         /ztest tablez j get def
         z ztest le {
            /resultat j store
            exit
         } {
            /resultat j 1 add store
         } ifelse
      } for
      solid i table resultat get solidputfcolor
   } for
end
} def


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             bibliotheque sur les solides           %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### solide ###
%% solid = [Sommets Faces Colors_Faces InOut_Table]
/solidgetsommets {
   0 get
} def
/solidgetpointstable {solidgetsommets} def

/solidgetfaces {
   1 get
} def

/solidgetface {
1 dict begin
   /i exch def
   solidgetfaces i get
end
} def

/solidgetfcolors {
   2 get
} def

%% syntaxe : solid i solidgetfcolor --> str
/solidgetfcolor {
1 dict begin
   /i exch def
   solidgetfcolors i get
end
} def

%% syntaxe : solid i str solidputfcolor --> -
/solidputfcolor {
2 dict begin
   /str exch def
   /i exch def
   solidgetfcolors i str put
end
} def

/solidgetinouttable {
   3 get
} def

/solidputsommets {
   0 exch put
} def
/solidputpointstable {solidputsommets} def

/solidputfaces {
   1 exch put
} def

%% syntaxe : solid solidfacesreverse -> -
/solidfacesreverse {
5 dict begin
   /solid exch def
   /n solid solidnombrefaces def
   0 1 n 1 sub {
      /i exch def
      /F solid i solidgetface reverse def
      /m F length def
      solid i [F aload pop m 0 roll ] solidputface
   } for
end
} def

/solidputfcolors {
   2 exch put
} def

/solidputinouttable {
   3 exch put
} def

%% syntaxe : any issolid --> booleen, vrai si any est de type solid
/issolid {
1 dict begin
   /candidat exch def
   candidat isarray {
      candidat length 4 eq {
         candidat 0 get isarray
         candidat 1 get isarray and
         candidat 2 get isarray and
         candidat 3 get isarray and {
            /IO candidat 3 get def
            IO length 4 eq 
            IO 0 get isnum and
            IO 1 get isnum and
            IO 2 get isnum and
            IO 3 get isnum and
         } {
            false
         } ifelse
      } {
         false
      } ifelse
   } {
      false
   } ifelse
end
} def

/dupsolid {
5 dict begin
   /solid exch def
   /S solid solidgetsommets def
   /F solid solidgetfaces def
   /FC solid solidgetfcolors def
   /IO solid solidgetinouttable def
   solid
   [
      S duparray exch pop
      F duparray exch pop
      FC duparray exch pop
      IO duparray exch pop
   ]
end
} def

%% syntaxe : solid array solidputinfaces --> -
/solidputinfaces {
4 dict begin
   /facesinternes exch def
   /solid exch def
   /n2 facesinternes length def
   /IO solid solidgetinouttable def
   /facesexternes solid solidgetoutfaces def
   /n1 facesexternes length def
   solid
      [facesexternes aload pop facesinternes aload pop]
      solidputfaces
   IO 0 0 put
   IO 1 n1 1 sub put
   IO 2 n1 put
   IO 3 n1 n2 add 1 sub put
end
} def

%% syntaxe : solid array solidputoutfaces --> -
/solidputoutfaces {
4 dict begin
   /facesexternes exch def
   /solid exch def
   /n1 facesexternes length def
   /IO solid solidgetinouttable def
   /facesinternes solid solidgetinfaces def
   /n2 facesinternes length def
   solid
      [facesexternes aload pop facesinternes aload pop]
      solidputfaces
   IO 0 0 put
   IO 1 n1 1 sub put
   IO 2 n1 put
   IO 3 n1 n2 add 1 sub put
end
} def

/solidnombreinfaces {
1 dict begin
   /solid exch def
   solid solidwithinfaces {
      /IO solid solidgetinouttable def
      IO 3 get IO 2 get sub 1 add
   } {
      0
   } ifelse
end
} def

/solidnombreoutfaces {
1 dict begin
   /solid exch def
   /IO solid solidgetinouttable def
   IO 1 get IO 0 get sub 1 add
end
} def

%% syntaxe : solid solidgetinfaces --> array
/solidgetinfaces {
4 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetinfaces) ==
      quit
   } if
   solid solidwithinfaces {
      /IO solid solidgetinouttable def
      /F solid solidgetfaces def
      /n1 IO 2 get def
      /n2 IO 3 get def
      /n n2 n1 sub 1 add def
      F n1 n getinterval
   } {
      []
   } ifelse
end
} def

%% syntaxe : solid solidgetoutfaces --> array
/solidgetoutfaces {
4 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetoutfaces) ==
      quit
   } if
   /IO solid solidgetinouttable def
   /F solid solidgetfaces def
   /n1 IO 0 get def
   /n2 IO 1 get def
   /n n2 n1 sub 1 add def
   F n1 n getinterval
end
} def

%% /tracelignedeniveau? false def
%% /hauteurlignedeniveau 1 def
%% /couleurlignedeniveau {rouge} def
%% /linewidthlignedeniveau 4 def

/solidgridOn {
   /solidgrid true def
} def
/solidgridOff {
   /solidgrid false def
} def

%% syntaxe : solid i string solidputfcolor
%% syntaxe : solid str outputcolors
%% syntaxe : solid str1 str2 inoutputcolors
%% syntaxe : solid string n solidputncolors
%% syntaxe : solid array solidputincolors --> -
%% syntaxe : solid array solidputoutcolors --> -
%% syntaxe : solid solidgetincolors --> array
%% syntaxe : solid solidgetoutcolors --> array

%% syntaxe : solid array solidputinfaces --> -
%% syntaxe : solid array solidputoutfaces --> -
%% syntaxe : solid solidgetinfaces --> array
%% syntaxe : solid solidgetoutfaces --> array

%% syntaxe : solid1 solid2 solidfuz -> solid

%% syntaxe : solid i solidgetsommetsface -> array
%% array = tableau de points 3d
/solidgetsommetsface {
1 dict begin
   /i exch def
   /solid exch def
   /F solid i solidgetface def
   [
      0 1 F length 1 sub {
         /k exch def
         solid F k get solidgetsommet
      } for
   ]
end
} def

%% syntaxe : solid index table solidputface -> -
/solidputface {
1 dict begin
   /table exch def
   /i exch def
   solidgetfaces i table put
end
} def

%% syntaxe : solid table solidaddface -> -
%% syntaxe : solid table (couleur) solidaddface -> -
%% on ne se preoccupe pas des faces internes
/solidaddface {
6 dict begin
   dup isstring {
      /lac@uleur exch def
   } {
      /lac@uleur () def
   } ifelse
   /table exch def
   /solid exch def
   /IO solid solidgetinouttable def
   /n2 IO 1 get def
   /FC solid solidgetoutcolors def
   IO 1 n2 1 add put
   solid [ solid solidgetfaces aload pop table ] solidputfaces
   solid IO solidputinouttable
%   solid solidnombrefaces
    solid [
      FC aload pop lac@uleur
    ] solidputoutcolors
end
} def

/solidnombrefaces {
1 dict begin
   /solid exch def
   solid solidnombreinfaces
   solid solidnombreoutfaces
   add 
end
} def

%% syntaxe : solid M solidaddsommetexterne -> -
%% on ajoute le sommet sans se preoccuper de rien
/solidaddsommetexterne {
2 dict begin
   /M defpoint3d
   /solid exch def
   solid
   [ solid solidgetsommets aload pop M ]
   solidputsommets
end
} def

%% syntaxe : solid array solidaddsommets -> -
/solidaddsommets {
2 dict begin
   /table exch def
   /solid exch def
   /n table length 3 idiv def
   0 1 0 {
      /i exch def
      solid table i getp3d solidaddsommet pop
   } for
end
} def

%% syntaxe : solid M solidaddsommet -> k
%% on ajoute le sommet M. Si il est deja sur une arete,
%% on l incorpore a la face concernee 
%% s il est deja present, on ne le rajoute pas.
%% Renvoie l indice du sommet rajoute.
/solidaddsommet {
10 dict begin
   /M defpoint3d
   /solid exch def
   /nbf solid solidnombrefaces def
   /N solid solidnombresommets def
   /sortie -1 def
   %% le sommet est-il deja dans la structure
   0 1 N 1 sub {
      /i exch def
%%       (addsommet) ==
%%       solid i solidgetsommet == == == 
%%       M == == ==
%%       solid i solidgetsommet M eqp3d ==
   
%      solid i solidgetsommet M eqp3d {
      solid i solidgetsommet M distance3d 1e-5 le {
         %% oui => c est fini
         /sortie i store
      } if
   } for
   sortie 0 lt {
      %% non => on le rajoute
      /sortie N def
      solid M solidaddsommetexterne
      %% est il sur une arete deja codee
      0 1 nbf 1 sub {
         %% face d indice i
         /i exch def
         solid i solidgetface /F exch def
         /nbsf F length def
         0 1 nbsf 1 sub {
            /j exch def
            M
            solid j i solidgetsommetface 
            solid j 1 add nbsf mod i solidgetsommetface 
            point3dsursegment {
               %% il est sur l arete concernee
               solid i [
                  0 1 j {
                     /k exch def
                     F k get
                  } for
                  N
                  j 1 add nbsf mod dup 0 eq {
                     pop
                  } {
                     1 nbsf 1 sub {
                        /k exch def
                        F k get
                     } for
                  } ifelse
               ]  solidputface
               exit
            } if
         } for 
      } for
   } if
   sortie
end
} def

%%%%% ### solidrmsommet ###
%% syntaxe : solid i solidrmsommet -> -
/solidrmsommet {
5 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Erreur : mauvais type d argument dans solidrmsommet) ==
      quit 
   } if
   solid i solidsommetsadjsommet length 0 gt {
      (Erreur : sommet non isole dans solidrmsommet) ==
      quit 
   } if

   %% on s occupe des sommets
   /n solid solidnombresommets def
   /S [
      0 1 n 1 sub {
         /j exch def
         j i ne {
            solid j solidgetsommet
         } if
      } for
   ] def
   solid S solidputsommets
   %% on s occupe des faces
   /n solid solidnombrefaces def
   /F [
      0 1 n 1 sub {
         %% face d indice j
         /j exch def
         /Fj solid j solidgetface def
         [0 1 Fj length 1 sub {
            %% sommet d indice k de la face Fj
            /k exch def
            Fj k get dup i gt {
               1 sub
            } if
         } for]
      } for
   ] def
   solid F solidputfaces
end
} def

%%%%% ### solidsommetsadjsommet ###
%% syntaxe : solid i solidsommetsadjsommet --> array
%% array est le tableau des indices des sommets adjacents au
%% sommet d indice i
/solidsommetsadjsommet {
6 dict begin
   /no exch def
   /solid exch def
   solid no solidfacesadjsommet /facesadj exch def
   /sommetsadj [] def
   /nbadj facesadj length def
   0 1 nbadj 1 sub {
      /j exch def
      %% examen de la jieme face
      %/j 0 def
      /F solid facesadj j get solidgetface def
      /nbsommetsface F length def
      no F in {
         /index exch def
         /i1 F index 1 sub nbsommetsface modulo get def
         /i2 F index 1 add nbsommetsface mod get def
         %% si i1 n est pas deja note, on le rajoute
         i1 sommetsadj in {
            pop
         } {
            /sommetsadj [ sommetsadj aload pop i1 ] store
         } ifelse
         %% si i2 n est pas deja note, on le rajoute
         i2 sommetsadj in {
            pop
         } {
            /sommetsadj [ sommetsadj aload pop i2 ] store
         } ifelse
      } {
         (Error : bug dans solidsommetsadjsommet) ==
         quit
      } ifelse
   } for
   sommetsadj
end
} def

%%%%% ### solidfacesadjsommet ###
%% syntaxe : solid i solidfacesadjsommet --> array
%% array est le tableau des indices des faces adjacentes au
%% sommet d indice i
/solidfacesadjsommet {
6 dict begin
   /no exch def
   /solid exch def
   /n solid solidnombrefaces def
   /indicesfacesadj [] def
   0 1 n 1 sub {
      /j exch def
      /F solid j solidgetface def
      no F in {
         pop
         /indicesfacesadj [ indicesfacesadj aload pop j ] store
      } if
   } for
   indicesfacesadj
end
} def

%%%%% ### ordonnepoints3d ###
%% syntaxe : array1 M ordonnepoints3d --> array2
%% array1 = tableau de points 3d coplanaires (plan P)
%% M = point3d indiquant la direction de la normale a P
%% array2 = les indices des points de depart, ranges dans le 
%% sens trigo par rapport a la normale
/ordonnepoints3d {
5 dict begin
   /M defpoint3d
   /table exch def
   table isobarycentre3d /G defpoint3d
   %% calcul de la normale
   table 0 getp3d /ptref defpoint3d
   table 1 getp3d /A defpoint3d
   G ptref vecteur3d
   G A vecteur3d
   vectprod3d /vecteurnormal defpoint3d
   vecteurnormal G M vecteur3d scalprod3d 0 lt {
      vecteurnormal -1 mulv3d /vecteurnormal defpoint3d
   } if
   %% la table des angles
   table duparray exch pop
   {1 dict begin
      /M defpoint3d
      G ptref vecteur3d
      G M vecteur3d
      vecteurnormal angle3doriente
   end} papply3d
%   [0 1 table length 3 idiv 1 sub {} for]
%   exch
    doublebubblesort pop
end
} def

%%%%% ### fin insertion ###

%% /tracelignedeniveau? false def
%% /hauteurlignedeniveau 1 def
%% /couleurlignedeniveau {rouge} def
%% /linewidthlignedeniveau 4 def
%% 
%% /solidgrid true def
%% /aretescachees true def
%% /defaultsolidmode 2 def

%% syntaxe : alpha beta r h newpie --> solid
/newpie {
6 dict begin
   [[/resolution /nbetages] [8 1] [10 1] [12 1] [18 3] [36 5]] gestionsolidmode
   /h exch def
   /r exch def
   /beta exch def
   /alpha exch def
   [
      0 0
%      alpha cos r mul alpha sin r mul
      alpha beta {1 dict begin /t exch def t cos r mul t sin r mul end} CourbeR2+
   ] 0 h [nbetages] newprismedroit
end
} def

%%%%% ### newsolid ###
%% syntaxe : newsolid --> depose le solide nul sur la pile
/newsolid {
   [] [] generesolid
} def

%%%%% ### generesolid ###
/generesolid {
2 dict begin
   /F exch def
   /S exch def
   [S F [F length {()} repeat] [0 F length 1 sub -1 -1]]
end
} def

%%%%% ### nullsolid ###
%% syntaxe : solide nullsolid -> booleen, vrai si le solide est nul
/nullsolid {
1 dict begin
   /candidat exch def
   candidat issolid not {
      (Error type argument dans "nullsolid") ==
      quit
   } if
   candidat solidgetsommets length 0 eq {
      true
   } {
      false
   } ifelse
end
} def

%%%%% ### solidnombreoutfaces ###
/solidnombreoutfaces {
4 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidnombreoutfaces) ==
      quit
   } if
   solid nullsolid {
      0
   } {
      /IO solid solidgetinouttable def
      IO 1 get
      IO 0 get sub
      1 add
   } ifelse
end
} def

%%%%% ### solidnombreinfaces ###
/solidnombreinfaces {
4 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidnombreinfaces) ==
      quit
   } if
   solid solidwithinfaces {
      /IO solid solidgetinouttable def
      IO 3 get
      IO 2 get sub
      1 add
   } {
      0
   } ifelse
end
} def

%%%%% ### solidtests ###
%% syntaxe : solid solidwithinfaces --> bool, true si le solide est vide
/solidwithinfaces {
2 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidwithinfaces) ==
      quit
   } if
   /table solid solidgetinouttable def
   table 2 get -1 ne {
      true
   } {
      false
   } ifelse
end
} def

%%%%% ### solidgetsommet ###
%% syntaxe : solid i j solidgetsommetface --> sommet i de la face j
/solidgetsommetface {
6 dict begin
   /j exch def
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetsommetface) ==
      quit
   } if
   /table_faces solid solidgetfaces def
   /table_sommets solid solidgetsommets def
   /k table_faces j get i get def
   table_sommets k getp3d
end
} def

%% syntaxe : solid i solidgetsommetsface --> array, tableau des
%% sommets de la face i du solide
/solidgetsommetsface {
6 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetsommetsface) ==
      quit
   } if
   /table_faces solid solidgetfaces def
   /table_sommets solid solidgetsommets def
   /table_indices table_faces i get def
   [
      0 1 table_indices length 1 sub {
         /j exch def
         table_sommets table_indices j get getp3d
      } for
   ]
end
} def

%% syntaxe : solid i solidgetsommet --> sommet i du solide
/solidgetsommet {
3 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetsommet) ==
      quit
   } if
   /table_sommets solid solidgetsommets def
   table_sommets i getp3d
end
} def

%%%%% ### solidcentreface ###
%% syntaxe : solid i solidcentreface --> M
/solidcentreface {
   solidgetsommetsface isobarycentre3d
} def

%%%%% ### solidnombre ###
/solidnombresommets {
   solidgetsommets length 3 idiv
} def

/solidfacenombresommets {
   solidgetface length
} def

/solidnombrefaces {
   solidgetfaces length
} def

%%%%% ### solidshowsommets ###
/solidshowsommets {
8 dict begin
   dup issolid not {
      %% on a un argument
      /option exch def
   } if
   /sol exch def
   /n sol solidnombresommets def
   /m sol solidnombrefaces def
   currentdict /option known not {
      /option [0 1 n 1 sub {} for] def
   } if
   0 1 option length 1 sub {
      /k exch def
      option k get /i exch def       %% indice du sommet examine
      sol i solidgetsommet point3d
   } for
end
} def

%%%%% ### solidnumsommets ###
/solidnumsommets {
8 dict begin
%   Font findfont 10 scalefont setfont
   dup issolid not {
      %% on a un argument
      /option exch def
   } if
   /sol exch def
   /n sol solidnombresommets def
   /m sol solidnombrefaces def
   currentdict /option known not {
      /option [0 1 n 1 sub {} for] def
   } if
   /result [
      n {false} repeat
   ] def
   0 1 option length 1 sub {
      /k exch def
      option k get /i exch def       %% indice du sommet examine
      0 1 m 1 sub {
         /j exch def %% indice de la face examinee
         i sol j solidgetface in {
            %% le sommet i est dans la face j
            pop
            exit
         } if
      } for
      sol i solidgetsommet /S defpoint3d
      i (   ) cvs
      m 0 ne {
         %% le sommet i est dans la face j
         sol j solidcentreface /G defpoint3d
         G S vecteur3d normalize3d
         15 dup ptojpoint pop
         mulv3d
         S addv3d
         3dto2d cctext 
      } {
         S 3dto2d uctext
      } ifelse
   } for
end
} def

%%%%% ### gestionsolidmode ###
%% table = [ [vars] [mode0] [mode1] [mode2] [mode3] [mode4] ]
/gestionsolidmode {
5 dict begin
   /table exch def
   dup xcheck {
      /mode exch def
   } {
      dup isarray {
         /tableaffectation exch def
         /mode -1 def
      } {
         /mode defaultsolidmode def
      } ifelse
   } ifelse
   /vars table 0 get def
   /nbvars vars length def
   mode 0 ge {
      /tableaffectation table mode 1 add 5 min get def
   } if
   0 1 nbvars 1 sub {
      /i exch def
      vars i get
      tableaffectation i get
   } for
   nbvars 
end
   {def} repeat
} def

%%%%% ### solidfuz ###
%% syntaxe : solid1 solid2 solidfuz -> solid
/solidfuz {
5 dict begin
   /solid2 exch def
   /solid1 exch def
   /S1 solid1 solidgetsommets def
   /S2 solid2 solidgetsommets def
   /n S1 length 3 idiv def

   %% les sommets
   /S S1 S2 append def

   %% les faces internes et leurs couleurs
   /FI1 solid1 solidgetinfaces def
   /FIC1 solid1 solidgetincolors def
   solid2 solidnombreinfaces 0 eq {
      /FI2 [] def
      /FIC2 [] def
   } {
      /FI2 solid2 solidgetinfaces {{n add} apply} apply def
      /FIC2 solid2 solidgetincolors def
   } ifelse
   /FI [FI1 aload pop FI2 aload pop] def
   /FIC [FIC1 aload pop FIC2 aload pop] def

   %% les faces externes et leurs couleurs
   /FO1 solid1 solidgetoutfaces def
   /FOC1 solid1 solidgetoutcolors def
   /FO2 solid2 solidgetoutfaces {{n add} apply} apply def
   /FOC2 solid2 solidgetoutcolors def
   /FO [FO1 aload pop FO2 aload pop] def
   /FOC [FOC1 aload pop FOC2 aload pop] def

   /F [FO aload pop FI aload pop] def
   /FC [FOC aload pop FIC aload pop] def
   /IO [
      0 FO length 1 sub
      FI length 0 gt {
         dup 1 add dup FI length add 1 sub
      } {
         -1 -1
      } ifelse
   ] def

   S F generesolid
   dup FC solidputfcolors
   dup IO solidputinouttable
end
} def

%%%%% ### solidnormaleface ###
%% syntaxe : solid i solidnormaleface --> u, vecteur normale a la
%% face d indice i du solide
/solidnormaleface {
4 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetsommetface) ==
      quit
   } if
%%    solid 0 i solidgetsommetface /G defpoint3d
%%    G
%%    solid 1 i solidgetsommetface
%%    vecteur3d
%%    G
%%    solid 2 i solidgetsommetface
%%    vecteur3d

   /n solid i solidfacenombresommets def
   solid i solidcentreface /G defpoint3d
  %% debug %%   G 3dto2d point
   G
   solid 0 i solidgetsommetface
   /A defpoint3d
  %   gsave bleu A point3d grestore
   A
   vecteur3d normalize3d
   G
   solid 1 i solidgetsommetface
   /A defpoint3d
  %   gsave orange A point3d grestore
   A
   vecteur3d normalize3d
   vectprod3d
   /resultat defpoint3d
   resultat normalize3d
end
} def

%%%%% ### solidtransform ###
%% syntaxe : solid1 {f} solidtransform --> solid2, solid2 est le
%% transforme de solid1 par la transformation f : R^3 -> R^3
/solidtransform {
3 dict begin
   /@f exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidtransform) ==
      quit
   } if
   /les_sommets
      solid solidgetsommets {@f} papply3d
   def
   solid les_sommets solidputsommets
   solid
end
} def

%%%%% ### solidputcolor ###
%% syntaxe : solid i string solidputfcolor
/solidputfcolor {
3 dict begin
   /str exch def
   /i exch def
   /solid exch def
   /FC solid solidgetfcolors def
   i FC length lt {
      FC i str put
   } if
end
} def

%% syntaxe : solid solidgetincolors --> array
/solidgetincolors {
3 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetincolors) ==
      quit
   } if
   solid solidwithinfaces {
      /fcol solid solidgetfcolors def
      /IO solid solidgetinouttable def
      /n1 IO 2 get def
      /n2 IO 3 get def
      /n n2 n1 sub 1 add def
      fcol n1 n getinterval
   } {
      []
   } ifelse
end
} def

%% syntaxe : solid solidgetoutcolors --> array
/solidgetoutcolors {
3 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetoutcolors) ==
      quit
   } if
   /fcol solid solidgetfcolors def
   /IO solid solidgetinouttable def 
   /n1 IO 0 get def
   /n2 IO 1 get def
   /n n2 n1 sub 1 add def
   fcol n1 n getinterval 
end
} def
 
%% syntaxe : solid array solidputincolors --> -
/solidputincolors {
4 dict begin
   /newcolorstable exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidputincolors) ==
      quit
   } if
   /n newcolorstable length def
   n solid solidnombreinfaces ne {
      (Error : mauvaise longueur de tableau dans solidputincolors) ==
      quit
   } if
   n 0 ne {
      /FC solid solidgetfcolors def
      /IO solid solidgetinouttable def
      /n1 IO 2 get def
      FC n1 newcolorstable putinterval
   } if
end
} def

%% syntaxe : solid array solidputoutcolors --> -
/solidputoutcolors {
4 dict begin
   /newcolorstable exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidputoutcolors) ==
      quit
   } if
   /n newcolorstable length def
   n solid solidnombreoutfaces ne {
      (Error : mauvaise longueur de tableau dans solidputoutcolors) ==
      quit
   } if
   n 0 ne {
      /FC solid solidgetfcolors def
      /IO solid solidgetinouttable def
      /n1 IO 0 get def
      FC n1 newcolorstable putinterval
   } if
end
} def

%% syntaxe : solid str outputcolors
/outputcolors {
5 dict begin
   /color exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans inoutputcolors) ==
      quit
   } if
   /n solid solidnombreoutfaces def
   solid [ n {color} repeat ] solidputoutcolors
end
} def

%% syntaxe : solid str inputcolors
/inputcolors {
5 dict begin
   /color exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans inoutputcolors) ==
      quit
   } if
   /n solid solidnombreinfaces def
   solid [ n {color} repeat ] solidputincolors
end
} def

%% syntaxe : solid str1 str2 inoutputcolors
/inoutputcolors {
5 dict begin
   /colout exch def
   /colin exch def
   /solid exch def
   solid colin inputcolors
   solid colout outputcolors
end
} def

%% syntaxe : solid array solidputoutcolors --> -
/solidputoutcolors {
4 dict begin
   /newcolorstable exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidputoutcolors) ==
      quit
   } if
   /n newcolorstable length def
   n solid solidnombreoutfaces ne {
      (Error : mauvaise longueur de tableau dans solidputoutcolors) ==
      quit
   } if
   n 0 ne {
      /FC solid solidgetfcolors def
      /IO solid solidgetinouttable def
      /n1 IO 0 get def
      FC length n n1 add lt {
         solid newcolorstable solidputfcolors
      } {
         FC n1 newcolorstable putinterval
      } ifelse
   } if
end
} def

/solidputcolors {
3 dict begin
   2 copy pop
   isstring {
      inoutputcolors
   } {
      outputcolors
   } ifelse
end
} def

%%%%% ### solidputhuecolors ###
%% syntaxe : solid table solidputhuecolors --> -
/solidputhuecolors {
1 dict begin
   2 copy pop
   solidgetinouttable /IO exch def
   IO 0 get
   IO 1 get
   s@lidputhuec@l@rs
end
} def

/solidputinhuecolors {
2 dict begin
   /table exch def
   /solid exch def
   solid solidgetinouttable /IO exch def
   solid solidwithinfaces {
      solid table
      IO 2 get
      IO 3 get
      s@lidputhuec@l@rs
   } if
end
} def

/solidputinouthuecolors {
1 dict begin
   2 copy pop
   solidgetinouttable /IO exch def
   IO 0 get
   IO 3 get IO 1 get max
   s@lidputhuec@l@rs
end
} def

%% syntaxe : solid table n1 n2 s@lidputhuec@l@rs --> -
%% affecte les couleurs des faces d indice n1 a n2 du solid solid, par
%% un degrade defini par la table.
 /s@lidputhuec@l@rs {
9 dict begin
   /n2 exch def
   /n1 exch def
   /table exch def
   /solid exch def
   /n n2 n1 sub def

   table length 2 eq {
       /a0 table 0 get def
       /a1 table 1 get def
       a1 isstring {
          /lacouleurdepart {
             gsave
                [a0 cvx exec] length 0 eq {
                   a0 cvx exec currentrgbcolor
                } {
                   a0 cvx exec
                } ifelse 
             grestore
          } def
          /lacouleurarrivee {
             gsave
                [a1 cvx exec] length 0 eq {
                   a1 cvx exec currentrgbcolor
                } {
                   a1 cvx exec
                } ifelse 
             grestore
          } def
          /table [lacouleurdepart lacouleurarrivee] def
       } {
          /A {a0 i a1 a0 sub mul n 1 sub div add} def
          /B {1} def
          /C {1} def
          /D {} def
          /espacedecouleurs (sethsbcolor) def
       } ifelse
   } if

   table length 4 eq {
       /a0 table 0 get def
       /a1 table 1 get def
       /A {a0 i a1 a0 sub mul n 1 sub div add} def
       /B table 2 get def
       /C table 3 get def
       /D {} def
       /espacedecouleurs (sethsbcolor) def
   } if

   table length 6 eq {
       /a0 table 0 get def
       /b0 table 1 get def
       /c0 table 2 get def
       /a1 table 3 get def
       /b1 table 4 get def
       /c1 table 5 get def
       /A {a0 i a1 a0 sub mul n 1 sub div add} def
       /B {b0 i b1 b0 sub mul n 1 sub div add} def
       /C {c0 i c1 c0 sub mul n 1 sub div add} def
       /D {} def
       /espacedecouleurs (setrgbcolor) def
   } if

   table length 7 eq {
       /a0 table 0 get def
       /b0 table 1 get def
       /c0 table 2 get def
       /a1 table 3 get def
       /b1 table 4 get def
       /c1 table 5 get def
       /A {a0 i a1 a0 sub mul n 1 sub div add} def
       /B {b0 i b1 b0 sub mul n 1 sub div add} def
       /C {c0 i c1 c0 sub mul n 1 sub div add} def
       /D {} def
       /espacedecouleurs (sethsbcolor) def
   } if

   table length 8 eq {
       /a0 table 0 get def
       /b0 table 1 get def
       /c0 table 2 get def
       /d0 table 3 get def
       /a1 table 4 get def
       /b1 table 5 get def
       /c1 table 6 get def
       /d1 table 7 get def
       /A {a0 i a1 a0 sub mul n 1 sub div add} def
       /B {b0 i b1 b0 sub mul n 1 sub div add} def
       /C {c0 i c1 c0 sub mul n 1 sub div add} def
       /D {d0 i d1 d0 sub mul n 1 sub div add} def
       /espacedecouleurs (setcmykcolor) def
   } if

   n1 1 n2 {
      /i exch def
      solid i
      [A B C D] espacedecouleurs astr2str
      solidputfcolor
   } for
   
end
} def

%%%%% ### solidrmface ###
%% syntaxe : solid i solidrmface -> -
/solidrmface {
5 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidrmface) ==
      quit
   } if
   %% on enleve la face
   /F solid solidgetfaces def
   F length 1 sub i lt {
      (Error : indice trop grand dans solidrmface) ==
      quit
   } if
   [
      0 1 F length 1 sub {
         /j exch def
         i j ne {
            F j get
         } if
      } for
   ]
   /NF exch def
   solid NF solidputfaces
   %% on enleve la couleur correspondante
   /FC solid solidgetfcolors def
   [
      0 1 FC length 1 sub {
         /j exch def
         i j ne {
            FC j get
         } if
      } for
   ]
   /NFC exch def
   solid NFC solidputfcolors
   %% on ajuste la table inout
   /IO solid solidgetinouttable def
   solid i solidisoutface {
      IO 1 IO 1 get 1 sub put 
      solid solidwithinfaces {
         IO 2 IO 2 get 1 sub put
         IO 3 IO 3 get 1 sub put
      } if
   } if
   solid i solidisinface {
      IO 1 IO 1 get 1 sub put
      IO 2 IO 2 get 1 sub put
      IO 3 IO 3 get 1 sub put
   } if
   solid IO solidputinouttable
end
} def

%% syntaxe : solid table solidrmfaces --> -
/solidrmfaces {
2 dict begin
   /table exch bubblesort reverse def
   /solid exch def
   table {solid exch solidrmface} apply
end
} def

%%%%% ### videsolid ###
%% syntaxe : solid videsolid -> -
/videsolid {
5 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans videsolid) ==
      quit
   } if
   solid solidwithinfaces not {
      /IO solid solidgetinouttable def
      /FE solid solidgetfaces def
      /n FE length def
      IO 2 n put
      IO 3 2 n mul 1 sub put
      solid IO solidputinouttable
      %% on inverse chaque face
      /FI FE {reverse} apply def
      solid FE FI append solidputfaces
      %% et on rajoute autant de couleurs vides que de faces
      /FEC solid solidgetfcolors def
%      /FIC [FI length {()} repeat] def
%      solid FEC FIC append solidputfcolors
      solid FEC duparray append solidputfcolors
   } if 
end
} def

%%%%% ### solidnumfaces ###
%% syntaxe : solid array solidnumfaces
%% syntaxe : solid array bool solidnumfaces
%% array, le tableau des indices des faces a numeroter, est optionnel
%% si bool=true, on ne numerote que les faces visibles
/solidnumfaces {
5 dict begin
   dup isbool {
      /bool exch def
   } {
      /bool true def
   } ifelse
%   setTimes
   dup issolid not {
      %% on a un argument
      /option exch def 
   } if
   /sol exch def
   /n sol solidnombrefaces def
   currentdict /option known not {
      /option [0 1 n 1 sub {} for] def
   } if

   0 1 option length 1 sub {
      /i exch def
      /j option i get def
      j (     ) cvs sol j bool cctextp3d
   } for
end
} def

%%%%% ### creusesolid ###
%% syntaxe : solid creusesolid -> -
/creusesolid {
5 dict begin
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans creusesolid) ==
      quit
   } if
   %% on enleve le fond et le chapeau
   solid 1 solidrmface
   solid 0 solidrmface
   %% on inverse chaque face
   solid videsolid
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                 dessin des solides                 %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### solidisinface ###
%% syntaxe : solid i solidisinface --> bool
%% true si i est l indice d une face interne, false sinon
/solidisinface {
4 dict begin
   /i exch def
   solidgetinouttable /IO exch def
   /n1 IO 2 get def
   /n2 IO 3 get def
   n1 i le 
   i n2 le and
end
} def

%%%%% ### solidisoutface ###
%% syntaxe : solid i solidisoutface --> bool
%% true si i est l indice d une face externe, false sinon
/solidisoutface {
4 dict begin
   /i exch def
   solidgetinouttable /IO exch def
   /n1 IO 0 get def
   /n2 IO 1 get def
   n1 i le 
   i n2 le and
end
} def

%%%%% ### planvisible ###
%% syntaxe : A k planvisible? --> true si le plan est visible
/planvisible? {
4 dict begin
   /normale_plan defpoint3d
   /origine defpoint3d
   /ligne_de_vue {
      origine
      GetCamPos
      vecteur3d
   } def
   ligne_de_vue normale_plan scalprod3d 0 gt
end
} def

%%%%% ### solidlight ###
/setlightintensity {
   /lightintensity exch def
} def

/setlightsrc {
   /lightsrc defpoint3d
} def

/setlight {
1 dict begin
gsave
   exec
   [ currentrgbcolor ] /lightcolor exch 
grestore
end
def
} def

%%%%% ### drawsolid ###
/solidlightOn {
   /s@lidlight true def
} def
/solidlightOff {
   /s@lidlight false def
} def
solidlightOff

%% syntaxe : solid i solidfacevisible? --> true si la face est visible
/solidfacevisible? {
4 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans solidgetsommetface) ==
      quit
   } if
   solid i solidgetface length 2 le {
      true
   } {
      /ligne_de_vue {
         solid i solidcentreface
         GetCamPos
         vecteur3d
      } def
   
      /normale_face {
         solid i solidnormaleface
      } def
      ligne_de_vue normale_face scalprod3d 0 gt
   } ifelse
end
} def

%% syntaxe : solid i affectecouleursolid_facei --> si la couleur de
%% la face i est definie, affecte fillstyle a cette couleur
/affectecouleursolid_facei {
3 dict begin
   /i exch def
   /solid exch def
   solid solidgetfcolors /FC exch def
   FC length 1 sub i ge {
      FC i get length 1 ge {
         /fillstyle FC i get ( Fill) append cvx
         solidgrid not {
            FC i get cvx exec
         } if
         true
      } {
         false
      } ifelse
   } {
      false
   } ifelse
end
{def} if
} def

%% syntaxe : solid i dessinefacecachee
/dessinefacecachee {
11 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans dessinefacecachee) ==
      quit
   } if

   /F solid solidgetfaces def
   /S solid solidgetsommets def

   %% face cachee => on prend chacune des aretes de la face et on
   %% la dessine
   4 dict begin
      /n F i get length def %% nb de sommets de la face
      0 1 n 1 sub {
         /k exch def
         /k1 F i k get_ij def              %% indice sommet1
         /k2 F i k 1 add n mod get_ij def  %% indice sommet2
         gsave
            currentlinewidth .5 mul setlinewidth
            pointilles
            [S k1 getp3d
            S k2 getp3d sortp3d] ligne3d
         grestore
      } for

   %% trace de la ligne de niveau
   solidintersectiontype 0 ge {
      /face_a_dessiner [  %% face visible : F [i]
         0 1 n 1 sub {
            /j exch def
            solid j i solidgetsommetface
         } for
      ] def 
      0 1 solidintersectionplan length 1 sub {
         /k exch def
         /lignedeniveau [] def
         gsave
            solidintersectiontype 0 eq {
               pointilles
            } {
               continu
            } ifelse
            k solidintersectionlinewidth length lt {
               solidintersectionlinewidth k get setlinewidth
            } {
               solidintersectionlinewidth 0 get setlinewidth
            } ifelse
            k solidintersectioncolor length lt {
               solidintersectioncolor k get cvx exec
            } {
               solidintersectioncolor 0 get cvx exec
            } ifelse
            0 1 n 1 sub {
               /j exch def
               face_a_dessiner j getp3d
               face_a_dessiner j 1 add n mod getp3d
               solidintersectionplan k get
               dup isarray {
                  segment_inter_plan
               } {
                  segment_inter_planz
               } ifelse {
               1 dict begin
                  /table exch def
                  table length 6 eq {
                     /lignedeniveau table store
                     exit
                  } {
                     /lignedeniveau [ 
                        lignedeniveau aload pop 
                        table 0 getp3d
                     ] store
                  } ifelse
               end
               } if
            } for
            
            %% dessin de la ligne
            lignedeniveau length 4 ge {
               [lignedeniveau aload pop sortp3d] ligne3d
            } if
         grestore
      } for         
   } if
   
   end
end
} def

%% syntaxe : solid i dessinefacevisible
/dessinefacevisible {
8 dict begin
   /i exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans dessinefacevisible) ==
      quit
   } if
   /F solid solidgetfaces def
   /S solid solidgetsommets def

   /n F i get length def %% nb de sommets de la face

   startest {
      s@lidlight {
         /coeff
            lightintensity
            solid i solidnormaleface normalize3d
            solid i solidcentreface lightsrc vecteur3d normalize3d
            scalprod3d mul
            0 max 1 min
         def
         /lightcolor where {
            pop
            /lacouleur lightcolor def
         } {
            /lacouleur [
               gsave
                  solid solidgetfcolors i get cvx exec currentrgbcolor
               grestore
            ] def
         } ifelse
         /fillstyle {
             lacouleur {coeff mul} apply setcolor Fill
         } def
         solidgrid not {
            lacouleur {coeff mul} apply setcolor
         } if
      } {
         n 2 eq {
            1 dict begin
               solidgridOff
               solid i affectecouleursolid_facei
            end
         } {
            solid i affectecouleursolid_facei
         } ifelse
      } ifelse
   } if

   /face_a_dessiner [  %% face visible : F [i]
      0 1 n 1 sub {
         /j exch def
         solid j i solidgetsommetface
      } for
   ] def 
   face_a_dessiner polygone3d

   %% trace de la ligne de niveau
   solidintersectiontype 0 ge {
      0 1 solidintersectionplan length 1 sub {
         /k exch def
         /lignedeniveau [] def
         gsave
            k solidintersectionlinewidth length lt {
               solidintersectionlinewidth k get setlinewidth
            } {
               solidintersectionlinewidth 0 get setlinewidth
            } ifelse
            k solidintersectioncolor length lt {
               solidintersectioncolor k get cvx exec
            } {
               solidintersectioncolor 0 get cvx exec
            } ifelse
            0 1 n 1 sub {
               /j exch def
               face_a_dessiner j getp3d
               face_a_dessiner j 1 add n mod getp3d
               solidintersectionplan k get
               dup isarray {
                  segment_inter_plan
               } {
                  segment_inter_planz
               } ifelse {
               1 dict begin
                  /table exch def
                  /lignedeniveau [ 
                     lignedeniveau aload pop 
                     table 0 getp3d
                     table length 4 ge {
                        table 1 getp3d
                     } if
                  ] store
               end
               } if
            } for
            
            %% dessin de la ligne
            lignedeniveau length 4 ge {
               solid i solidisinface solidintersectiontype 0 eq and {
                  pointilles 
               } if
               lignedeniveau ligne3d
            } if
         grestore
      } for         
   } if
      
end
} def

/drawsolid* {
1 dict begin
   /startest {true} def
   drawsolid
end
} def

/peintrealgorithme false def

/drawsolid** {
2 dict begin
   /aretescachees false def
   /peintrealgorithme true def
   drawsolid*
end
} def

%% syntaxe : solid array drawsolid
%% array est en option, il indique les faces triees
/drawsolid {
8 dict begin
   dup issolid not {
      /ordre exch def
   } if
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans drawsolid) ==
      quit
   } if
   solid nullsolid not {
      solid solidgetfaces
      /F exch def
      solid solidgetsommets
      /S exch def
      /n S length 3 idiv def

      currentdict /ordre known not {
         peintrealgorithme {
            %% tri des indices des faces par distance decroissante
            [
               0 1 F length 1 sub {
                  /i exch def
                  solid i solidcentreface
                  GetCamPos
                  distance3d
               } for
            ] doublequicksort pop reverse
         } {
            [
               0 1 F length 1 sub {
               } for
            ]
         } ifelse
         /ordre exch def
      } if

      0 1 F length 1 sub {
         /k exch def
         /i ordre k get def
         gsave
            solid i solidfacevisible? {
               solid i dessinefacevisible
            } if
         grestore
      } for
      aretescachees {
         0 1 F length 1 sub {
            /k exch def
            /i ordre k get def
            gsave
               solid i solidfacevisible? not {
                  solid i dessinefacecachee
               } if 
            grestore
         } for
      } if

%%       %% si on veut repasser les traits des faces visibles
%%       0 1 F length 1 sub {
%%          /k exch def
%%          /i ordre k get def
%%          gsave
%%          1 dict begin
%%             /startest false def
%%             solid i solidfacevisible? {
%%             solid i dessinefacevisible
%%             } if
%%          end
%%          grestore
%%       } for
   } if
end
} def

%%%%% ### segment_inter_planz ###
%% syntaxe : A B k segment_inter_planz --> array true ou false
/segment_inter_planz {
4 dict begin
   /k exch def
   /B defpoint3d
   /A defpoint3d
   A /zA exch def pop pop
   B /zB exch def pop pop
   zA k sub zB k sub mul dup 0 gt {
      %% pas d intersection
      pop
      false
   } {
      0 eq {
         %% intersection en A ou en B
         [ 
            zA k eq {A} if
            zB k eq {B} if
         ] true
      } {
         %% intersection entre A et B
         [
            A B vecteur3d
            k zA sub zB zA sub div mulv3d
            A addv3d
         ] true
      } ifelse
   } ifelse
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                  plans affines                     %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### planaffine ###
%% plan : origine, base, range, ngrid
%% [0 0 0 [1 0 0 0 1 0] [-3 3 -2 2] [1. 1.] ]

/explan [0 0 0 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1. 1.] ] def

%% syntaxe : any isplan --> bool
/isplan {
1 dict begin
   /candidat exch def
   candidat isarray {
      candidat length 6 eq {
         candidat 3 get isarray {
            candidat 4 get isarray {
               candidat 5 get isarray              
            } {
               false
            } ifelse
         } {
            false
         } ifelse
      } {
         false
      } ifelse
   } {
      false
   } ifelse
end
} def

/newplanaffine {
   [0 0 0 [1 0 0 0 1 0] [-3 3 -2 2] [1 1]] 
} def

/dupplan {
4 dict begin
   /leplan exch def
   /result newplanaffine def
   result leplan plangetorigine planputorigine
   result leplan plangetbase planputbase
   result leplan plangetrange planputrange
   result leplan plangetngrid planputngrid
   result
end
} def

%% syntaxe : plantype getorigine --> x y z
/plangetorigine {
1 dict begin
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans plangetorigine) ==
      Error
   } if
   plan 0 get 
   plan 1 get 
   plan 2 get 
end
} def

%% syntaxe : plantype getbase --> [u v]
%% ou u, v et w vecteurs de R^3
/plangetbase {
1 dict begin
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans plangetbase) ==
      Error
   } if
   plan 3 get 
end
} def

%% syntaxe : plantype getrange --> array
%% ou array = [xmin xmax ymin ymax]
/plangetrange {
1 dict begin
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans plangetrange) ==
      Error
   } if
   plan 4 get 
end
} def

%% syntaxe : plantype getngrid --> array
%% ou array = [n1 n2]
/plangetngrid {
1 dict begin
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans plangetngrid) ==
      Error
   } if
   plan 5 get 
end
} def

%% ===================

%% syntaxe : plantype x y z putorigine --> -
/planputorigine {
4 dict begin
   /z exch def
   /y exch def
   /x exch def
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans planputorigine) ==
      Error
   } if
   plan 0 x put 
   plan 1 y put 
   plan 2 z put 
end
} def

%% syntaxe : plantype [u v w] putbase --> -
%% ou u, v et w vecteurs de R^3
/planputbase {
2 dict begin
   /base exch def
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans planputbase) ==
      Error
   } if
   plan 3 base put 
end
} def

%% syntaxe : plantype array putrange --> -
%% ou array = [xmin xmax ymin ymax]
/planputrange {
2 dict begin
   /table exch def
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans planputrange) ==
      Error
   } if
   plan 4 table put 
end
} def

%% syntaxe : plantype array putngrid --> -
%% ou array = [n1 n2]
/planputngrid {
2 dict begin
   /table exch def
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans planputngrid) ==
      quit
   } if
   plan 5 table put 
end
} def

%% -3 3 -2 2 1. 1. newgrille
%% drawsolid

%orange

%% plan : origine, base, range, ngrid

%% syntaxe : plantype drawplanaffine --> -
/drawplanaffine {
5 dict begin
   /plan exch def
   plan plangetbase 
   aload pop
   /imK defpoint3d
   /imJ defpoint3d
   /imI defpoint3d
   newpath
      plan plangetrange plan plangetngrid aload pop  quadrillagexOy_
      plan plangetorigine [imI imK] false planprojpath
   Stroke
end
} def


%% %% syntaxe : [a b c d] (x0 y0 z0) alpha defeqplanaffine --> plantype
%% %% plan defini par l equation ax+by+cz+d=0, 
%% %% rotation de alpha autour de la normale (alpha est optionnel)
%% %% origine (x0, y0, z0). l origine est optionnelle
%% /defeqplanaffine {
%% 5 dict begin
%%    dup isarray {
%%       /alpha 0 def
%%    } {
%%       dup isstring {
%%          /alpha 0 def
%%       } {
%%          /alpha exch def
%%       } ifelse
%%    } ifelse
%%    dup isstring {
%%       cvx /origine exch def
%%    } if
%%    /table exch def
%%    table length 4 ne {
%%       (Erreur : mauvais type d argument dans defeqplanaffine) ==
%%       Error
%%    } if
%%    table 0 get /a exch def
%%    table 1 get /b exch def
%%    table 2 get /c exch def
%%    table 3 get /d exch def
%%    /resultat newplanaffine def
%%    [a b c alpha] normalvect_to_orthobase
%%    /imK defpoint3d
%%    /imJ defpoint3d
%%    /imI defpoint3d
%%    resultat [imI imJ imK] planputbase
%%    currentdict /origine known {
%%       origine /z exch def /y exch def /x exch def
%%       a x mul b y mul add c z mul add d add 0 ne {
%%          (Erreur : mauvaise origine dans defeqplanaffine) ==
%%          Error
%%       } if
%%       resultat origine planputorigine
%%    } {
%%       c 0 ne {
%%          resultat 0 0 d neg c div planputorigine
%%       } {
%%          a 0 ne {
%%             resultat d neg a div 0 0 planputorigine
%%          } {
%%             resultat 0 d neg b div 0 planputorigine
%%          } ifelse
%%       } ifelse
%%    } ifelse
%%    resultat
%% end
%% } def

%% /explan [0 0 0 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1 1] ] def
%% explan drawplanaffine
%% noir
%% /explan [0 0 2 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1 .5] ] def
%% explan drawplanaffine

%% orange
%% [0 0 1 -2] defeqplanaffine
%% drawplanaffine
%% noir
%% [0 0 1 0] defeqplanaffine
%% drawplanaffine
%% bleu
%% [1 1 1 0] (1 -1 0) defeqplanaffine
%% drawplanaffine
%% 

/dessinebase {
4 dict begin
gsave
   /V3 defpoint3d
   /V2 defpoint3d
   /V1 defpoint3d
   /M0 defpoint3d
   rouge
   V3 newvecteur 
   {M0 translatepoint3d} solidtransform
   drawsolid**
   bleu
   V2 newvecteur 
   {M0 translatepoint3d} solidtransform
   drawsolid**
   orange
   V1 newvecteur 
   {M0 translatepoint3d} solidtransform
   drawsolid**
grestore
end
} def

%% syntaxe : solid i solidface2eqplan --> [a b c d]
%% equation cartesienne de la face d'indice i du solide solid
/solidface2eqplan {
8 dict begin
   /i exch def
   /solid exch def
   solid i solidnormaleface
   /c exch def
   /b exch def
   /a exch def
   solid 0 i solidgetsommetface
   /z exch def
   /y exch def
   /x exch def
   [a b c a x mul b y mul add c z mul add neg]
end
} def


%% syntaxe : plantype newplan --> solid
/newplan {
5 dict begin
   /lepl@n exch def
   lepl@n plangetbase /@base exch def
   @base 0 getp3d /@U defpoint3d
   @base 1 getp3d /@V defpoint3d
   lepl@n plangetorigine /@M defpoint3d
   lepl@n plangetrange /@range exch def
   lepl@n plangetngrid /@ngrid exch def
   /@F {
   2 dict begin
      /@y exch def
      /@x exch def
      @U @x mulv3d
      @V @y mulv3d
      addv3d
      @M addv3d
   end
   } def
   @range aload pop @ngrid {@F} newsurfaceparametree
end
} def

%% syntaxe : M eqplan --> real
%% image de M par la fonction definie par l equation eqplan
/pointeqplan {
8 dict begin
   /eqplan exch def
   /@z exch def
   /@y exch def
   /@x exch def
   /@a eqplan 0 get def
   /@b eqplan 1 get def
   /@c eqplan 2 get def
   /@d eqplan 3 get def
   @a @x mul @b @y mul add @c @z mul add @d add
end
} def

/plan2eq {
6 dict begin
   /leplan exch def
   leplan plangetbase aload pop vectprod3d
   /c exch def
   /b exch def
   /a exch def
   leplan plangetorigine
   /z0 exch def
   /y0 exch def
   /x0 exch def
   [a b c a x0 mul b y0 mul add c z0 mul add neg]
end
} def

%% syntaxe : [a b c d] (x0 y0 z0) alpha defeqplanaffine --> plantype
%% plan defini par l equation ax+by+cz+d=0, 
%% rotation de alpha autour de la normale (alpha est optionnel)
%% origine (x0, y0, z0). l origine est optionnelle
/eq2plan {
5 dict begin
   dup isarray {
      /alpha 0 def
   } {
      dup isstring {
         /alpha 0 def
      } {
         /alpha exch def
      } ifelse
   } ifelse
   dup isstring {
      cvx /origine exch def
   } if
   /table exch def
   table length 4 ne {
      (Erreur : mauvais type d argument dans eq2plan) ==
      quit
   } if
   table 0 get /a exch def
   table 1 get /b exch def
   table 2 get /c exch def
   table 3 get /d exch def
   /resultat newplanaffine def
   [a b c alpha] normalvect_to_orthobase
   /imK defpoint3d
   /imJ defpoint3d
   /imI defpoint3d
   resultat [imI imJ] planputbase
   currentdict /origine known {
      origine /z exch def /y exch def /x exch def
      a x mul b y mul add c z mul add d add 0 ne {
         (Erreur : mauvaise origine dans eq2plan) ==
         quit
      } if
      resultat origine planputorigine
   } {
      c 0 ne {
         resultat 0 0 d neg c div planputorigine
      } {
         a 0 ne {
            resultat d neg a div 0 0 planputorigine
         } {
            b 0 ne {
               resultat 0 d neg b div 0 planputorigine
            } {
               (Error dans eq2plan : (a,b,c) = (0,0,0)) ==
            } ifelse
         } ifelse
      } ifelse
   } ifelse
   resultat
end
} def

/points2eqplan {
10 dict begin
   /C defpoint3d
   /B defpoint3d
   /A defpoint3d
   A B vecteur3d
   A C vecteur3d
   vectprod3d
   normalize3d
   /c exch def
   /b exch def
   /a exch def
   A
   /zA exch def
   /yA exch def
   /xA exch def
   [a b c a xA mul b yA mul add c zA mul add neg]
end
} def

%% /monplan 
%% %[0 0 -2 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1. 1.]]
%% [0 0 1 1] 30 eq2plan
%% def
%% 
%% [0 0 1 -2] eq2plan newplan
%% dup (blanc) outputcolors
%% monplan newplan
%% dup (blanc) outputcolors
%% solidfuz
%% drawsolid**
%% monplan plangetorigine
%% monplan plangetbase aload pop dessinebase

%% syntaxe : x0 y0 z0 [normalvect] norm2plan
/norm2plan {
9 dict begin
   normalvect_to_orthobase
   /imK defpoint3d
   /imJ defpoint3d
   /imI defpoint3d
   imK
   /c exch def
   /b exch def
   /a exch def
   /z0 exch def
   /y0 exch def
   /x0 exch def
   [a b c a x0 mul b y0 mul add c z0 mul add neg] eq2plan
   dup x0 y0 z0 planputorigine
   dup [imI imJ] planputbase
end
} def

%% syntaxe : plantype planxmarks
/planxmarks {
5 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   /leplan exch def
   leplan plangetrange aload pop
   /ymax exch def
   /ymin exch def
   /xmax exch def
   /xmin exch def
   newpath
      xmin truncate cvi 0 smoveto
      xmax truncate cvi 0 slineto
      leplan mybool projpath
   Stroke
   xmin truncate cvi xmkstep xmax truncate cvi {
      dup 0 ne {
         /x exch def
         x
         x x truncate eq {
            cvi
         } if
         dup chaine cvs exch 0 leplan mybool dctextp3d
         newpath
            x 0 smoveto
            0 2.5 rmoveto
            0 -5 rlineto
            leplan mybool projpath
         Stroke
      } {
         pop (0) 0 0 leplan mybool dltextp3d 
      } ifelse
   } for
end
} def

%% syntaxe : plantype planymarks
/planymarks {
5 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   /leplan exch def
   leplan plangetrange aload pop
   /ymax exch def
   /ymin exch def
   /xmax exch def
   /xmin exch def
   newpath
      0 ymin truncate cvi smoveto
      0 ymax truncate cvi slineto
      leplan mybool projpath
   Stroke
   ymin truncate cvi ymkstep ymax truncate cvi {
      dup 0 ne {
         /y exch def
         y
         y y truncate eq {
             cvi
         } if
         dup chaine cvs exch 0 exch leplan mybool cltextp3d
         newpath
            0 y smoveto
            2.5 0 rmoveto
            -5 0 rlineto
            leplan mybool projpath
         Stroke
      } {
         pop (0) 0 0 leplan mybool dltextp3d 
      } ifelse
   } for
end
} def

%% syntaxe : plantype planmarks
/planmarks {
1 dict begin
    dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   dup mybool planxmarks mybool planymarks
end
} def

%% bleu
%% [-3 3 -2 2] quadrillagexOy_
%% Stroke
%% noir

%% syntaxe : [xmin xmax ymin ymax] dx dy quadrillagexOy_
/quadrillagexOy_ {
4 dict begin
   dup isarray {
      /dx 1 def
      /dy 1 def
   } {
      /dy exch def
      dup isarray {
         /dx dy def
      } {
         /dx exch def
      } ifelse
   } ifelse
   /table exch def
   table 0 get /xmin exch def
   table 1 get /xmax exch def
   table 2 get /ymin exch def
   table 3 get /ymax exch def
   ymin dy ymax {
      /y exch def
      xmin y smoveto
      xmax y slineto
   } for
   xmin dx xmax {
      /x exch def
      x ymin smoveto
      x ymax slineto
   } for
end
} def

%% syntaxe : plan [ngrid] planquadrillage
/planquadrillage {
4 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   dup isplan {
      /ngrid [1 1] def
   } {
      /ngrid exch def
   } ifelse
   /leplan exch def
   /dx ngrid 0 get def
   /dy ngrid 1 get def
   /table leplan plangetrange def
   table 0 get cvi truncate /xmin exch def
   table 1 get cvi truncate /xmax exch def
   table 2 get cvi truncate /ymin exch def
   table 3 get cvi truncate /ymax exch def
   newpath
      ymin dy ymax {
         /y exch def
         xmin y smoveto
         xmax y slineto
      } for
      xmin dx xmax {
         /x exch def
         x ymin smoveto
         x ymax slineto
      } for
      leplan mybool projpath
   Stroke
end
} def

%% syntaxe : plantype str1 str2 planshowbase -> - 
%% syntaxe : plantype str2 planshowbase -> - 
%% syntaxe : plantype planshowbase -> - 
/planshowbase {
3 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   dup isstring {
      /couleur2 exch def
      dup isstring {
         /couleur1 exch def
      } {
         /couleur1 (rouge) def
      } ifelse
   } {
      /couleur1 (rouge) def
      /couleur2 (vert) def
   } ifelse
   mybool bprojscene
      couleur1 cvx exec
      newpath
         0 0 smoveto
         1 0 slineto
      Stroke
      0 0 1 0 oldarrow
      couleur2 cvx exec
      newpath
         0 0 smoveto
         0 1 slineto
      Stroke
      0 0 0 1 oldarrow
   eprojscene
end
} def

%% syntaxe : plantype str1 str2 str3 planshowbase3d -> - 
%% syntaxe : plantype str2 str3 planshowbase3d -> - 
%% syntaxe : plantype str3 planshowbase3d -> - 
%% syntaxe : plantype planshowbase3d -> - 
%% syntaxe : plantype str1 str2 str3 array planshowbase3d -> - 
%% syntaxe : plantype str2 str3 array planshowbase3d -> - 
%% syntaxe : plantype str3 array planshowbase3d -> - 
%% syntaxe : plantype array planshowbase3d -> - 
/planshowbase3d {
7 dict begin
   dup isbool {
      /mybool exch def
   } {
      /mybool true def
   } ifelse
   dup dup isarray exch isplan not and {
      /table exch def
   } {
      /table {} def
   } ifelse
   dup isstring {
      /couleur3 exch def
      dup isstring {
         /couleur2 exch def
         dup isstring {
            /couleur1 exch def
         } {
            /couleur1 (rouge) def
         } ifelse
      } {
         /couleur2 (vert) def
         /couleur1 (rouge) def
      } ifelse
   } {
      /couleur1 (rouge) def
      /couleur2 (vert) def
      /couleur3 (bleu) def
   } ifelse
   /plan exch def
   plan couleur1 couleur2 mybool planshowbase
   plan plangetorigine /I defpoint3d
   plan plangetbase
   dup 0 getp3d /u defpoint3d
   1 getp3d /v defpoint3d
   u v vectprod3d table newvecteur
   {I addv3d} solidtransform
   dup couleur3 solidputcolors
   solidgridOff
   drawsolid**
end
} def

%% syntaxe : plantype x y z plantranslate --> -
/plantranslate {
4 dict begin
   /M defpoint3d
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans plantranslate) ==
      quit
   } if
   plan plan plangetorigine M addv3d planputorigine
end
} def

% syntaxe : alpha_x alpha_y alpha_z rotateOpplan --> -
/rotateOplan {
4 dict begin
   /Rxyz defpoint3d
   /plan exch def
   plan isplan not {
      (Erreur : mauvais type d argument dans rotateOplan) ==
      quit
   } if
   plan plan plangetorigine Rxyz rotateOpoint3d planputorigine

   plan plangetbase 0 getp3d /U defpoint3d
   plan plangetbase 1 getp3d /V defpoint3d
   plan [
      U Rxyz rotateOpoint3d
      V Rxyz rotateOpoint3d
   ] planputbase
end
} def

%% syntaxe : plantype phi rotateplan --> -
/rotateplan {
5 dict begin
   /phi exch def
   /leplan exch def
   leplan plangetbase 0 getp3d /U defpoint3d
   leplan plangetbase 1 getp3d /V defpoint3d
   U phi cos mulv3d
   V phi sin mulv3d addv3d /U0 defpoint3d
   U phi sin neg mulv3d
   V phi cos mulv3d addv3d /V0 defpoint3d
   leplan [U0 V0] planputbase
end
} def

%% syntaxe : solid i solidface2plan --> plantype
%% syntaxe : solid i I solidface2plan --> plantype
/solidface2plan {
5 dict begin
   2 copy pop issolid {
      /i exch def
      /solid exch def
      solid i solidcentreface /I defpoint3d
   } {
      /I defpoint3d
      /i exch def
      /solid exch def
   } ifelse
   /result newplanaffine def
   solid i solidcentreface /G defpoint3d
   solid i solidnormaleface /K defpoint3d
   solid 0 i solidgetsommetface
   solid 1 i solidgetsommetface
   milieu3d /A defpoint3d
   G A vecteur3d normalize3d /U defpoint3d
   K U vectprod3d /V defpoint3d
   result [U V] planputbase
   result I planputorigine
   result
end
} def

%%%%% ### fin insertion ###
%% syntaxe : x y plantype pointplan --> X Y Z
/pointplan {
5 dict begin
   /leplan exch def
   /y exch def
   /x exch def
   leplan plangetbase 0 getp3d /U defpoint3d
   leplan plangetbase 1 getp3d /V defpoint3d
   U x mulv3d V y mulv3d addv3d
end
} def

%%%%% ### fin insertion ###


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%     operations sur des solides particuliers        %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/piedist {
4 dict begin
   /mypie exch def
   mypie 0 solidgetface length /n exch def
   mypie n 2 idiv solidgetsommet /A defpoint3d
   mypie n 2 idiv 1 add solidgetsommet /B defpoint3d
   A B milieu3d GetCamPos distance3d
end
} def

/sortpieset {
5 dict begin
   dup issolid {
      ]
   } if
   /table exch def
   [
      0 1 table length 1 sub {
         /i exch def
         table i get piedist
      } for
   ]
   doublequicksort pop reverse
   /result exch def
   [
      0 1 result length 1 sub {
         /i exch def
         table result i get get 
      } for
   ]
end
} def

/drawpieset {
1 dict begin
   /startest true def
   sortpieset dup {drawsolid**} apply {0 dessinefacevisible} apply
end
} def

%%%%% ### solidchanfreine ###
%% syntaxe : solid coeff solidchanfreine --> solid
/solidchanfreine {
10 dict begin
   /coeff exch def
   /solid exch def
   /result newsolid def
   solid issolid not {
      (Erreur : mauvais type d argument dans solidchanfreine) ==
      quit
   } if
   /n solid solidnombresommets def
   /nf solid solidnombrefaces def

   %% ajout des faces reduites
   0 1 nf 1 sub {
      /i exch def
      /Fsommets solid i solidgetsommetsface def
      /Findex solid i solidgetface def
      /ns Fsommets length 3 idiv def
      /couleurfaceorigine solid i solidgetfcolor def
      Fsommets isobarycentre3d /G defpoint3d
      %% on ajoute les nouveaux sommets
      /Sindex [] def
      0 1 ns 1 sub {
         /j exch def
         /Sindex [ Sindex aload pop
            Fsommets j getp3d /M defpoint3d
            result M G coeff hompoint3d solidaddsommet
         ] store
      } for
      %% Sindex contient les indices des nouveaux sommets
      result Sindex couleurfaceorigine solidaddface
   } for

   %% ajout des faces rectangulaires entre faces d'origines adjacentes
   %% pour chaque face de depart
   0 1 nf 2 sub {
      /i exch def
      /F solid i solidgetface def
      /couleurfaceorigine solid i solidgetfcolor def
      /Fres result i solidgetface def
      %% pour chaque arete de la face
      0 1 F length 1 sub {
         /j exch def
         /trouve false def
         /indice1 F j get def
         /indice2 F j 1 add F length mod get def
         /a1 j def
         /a2 j 1  add F length mod def
         %% on regarde toutes les autres faces
         i 1 add 1 nf 1 sub {
            /k exch def
            /Ftest solid k solidgetface def
            indice1 Ftest in {pop true} {false} ifelse
            indice2 Ftest in {pop true} {false} ifelse
            and {
               /indiceFadj k def
               indice1 Ftest in pop /k1 exch def
               indice2 Ftest in pop /k2 exch def
               /trouve true def
            exit
            } if
         } for
         trouve {
            /Fadj solid indiceFadj solidgetface def
            result [
               Fres a1 get
               result indiceFadj solidgetface k1 get
               result indiceFadj solidgetface k2 get
               Fres a2 get
            ] couleurfaceorigine solidaddface
         } if
      } for
   } for

   %% pour chaque face
   0 1 nf 2 sub {
      /i exch def
      /F solid i solidgetface def
      /couleurfaceorigine solid i solidgetfcolor def
      %% et pour chaque sommet de cette face
      0 1 F length 1 sub {
         /j exch def
         /k F j get def
         solid k solidfacesadjsommet /adj exch def
         %% adj est le tableau des indices des faces adjacentes
         %% au sommet d'indice k
         %% rque : toutes les faces d'indice strict inferieur a i
         %% sont deja traitees
         %% Pour chaque face adjacente, on repere l'indice du sommet concerne dans
         %% la face
         adj min i lt not {
            /indadj [] def
            0 1 adj length 1 sub {
               /m exch def
               k solid adj m get solidgetface in {
                  /ok exch def
                  /indadj [indadj aload pop ok] store
               } if
            } for
         
            /aajouter [
               0 1 adj length 1 sub {
                  /m exch def
                  result adj m get solidgetface indadj m get get
               } for
            ] def

            %% la table des sommets
            [0 1 aajouter length 1 sub {
               /m exch def
               result aajouter m get solidgetsommet
            } for]
            solid k solidgetsommet %% le point indiquant la direction de la normale
            ordonnepoints3d
            /indicestries exch def

            result [
               0 1 indicestries length 1 sub {
                  /m exch def
                  aajouter indicestries m get get
               } for
            ] couleurfaceorigine solidaddface
         } if
      } for
   } for

   result
end
} def

%%%%% ### solidplansection ###
%% syntaxe : M eqplan --> real
%% image de M par la fonction definie par l equation eqplan
/pointeqplan {
8 dict begin
   /@qplan exch def
   /@z exch def
   /@y exch def
   /@x exch def
   /@a @qplan 0 get def
   /@b @qplan 1 get def
   /@c @qplan 2 get def
   /@d @qplan 3 get def
   @a @x mul @b @y mul add @c @z mul add @d add 
end
} def

%% syntaxe : A B eqplan segment_inter_plan --> array true ou false
%% array contient 1 point M si [AB] inter plan = {M}
%% array contient les 2 points A et B si [AB] inter plan = [AB]
/segment_inter_plan {
4 dict begin
   dup isplan {plan2eq} if
   /plan exch def
   plan aload pop
   /d exch def
   /c exch def
   /b exch def
   /a exch def
   /B defpoint3d
   /A defpoint3d
   A 
   /zA exch def
   /yA exch def
   /xA exch def
   B 
   /zB exch def
   /yB exch def
   /xB exch def
   /imA a xA mul b yA mul add c zA mul add d add def
   /imB a xB mul b yB mul add c zB mul add d add def
   imA imB mul dup 0 gt {
      %% pas d intersection
      pop
      false
   } {
      0 eq {
         %% intersection en A ou en B
         [ 
            imA 0 eq {A} if 
            imB 0 eq {B} if 
         ] true
      } {
         %% intersection entre A et B
         /k 
            imA neg
            xB xA sub a mul
            yB yA sub b mul add
            zB zA sub c mul add
            dup 0 eq {
               (Error dans segment_inter_plan) ==
               quit
            } if
            div
         def
         [
            A B vecteur3d
            k mulv3d
            A addv3d
         ] true
      } ifelse
   } ifelse
end
} def

%% syntaxe : solid i solidface2eqplan --> [a b c d]
%% equation cartesienne de la face d'indice i du solide solid
/solidface2eqplan {
8 dict begin
   /i exch def
   /solid exch def
   solid i solidnormaleface
   /c exch def
   /b exch def
   /a exch def
   solid 0 i solidgetsommetface
   /z exch def
   /y exch def
   /x exch def
   [a b c a x mul b y mul add c z mul add neg]
end
} def

%% syntaxe : array1 arrayrmdouble --> array2
%% remplace 2 elts identiques consecutifs par 1 elt
/arrayrmdouble {
5 dict begin
   /table exch def
   /result [table 0 get] def
   /j 0 def
   1 1 table length 1 sub {
      /i exch def
      table i get
      result j get
      eq not {
         /result [result aload pop table i get] store
         /j j 1 add store
      } if
   } for
   result
end
} def

%% syntaxe : solid eqplan/plantype solidplansection --> solid2
/solidplansection {
10 dict begin
   dup isbool {
      /tr@nsmit exch def
   } {
      /tr@nsmit false def
   } ifelse
   dup isplan {
      plan2eqplan
      /eqplan exch def
   } {
      /eqplan exch def
   } ifelse
   dupsolid /result exch def
   /solid exch def
   /aenlever [] def
   /indnouveauxsommets [] def
   /nouvellesaretes [] def

   %% pour chaque face d'indice i
   0 1 solid solidnombrefaces 1 sub {
      /i exch def
      /lacouleur solid i solidgetfcolor def
      /F solid i solidgetface def %% table des indices des sommets
      /n F length def %% nb d'aretes
      /k1 -1 def
      /k2 -1 def
      /k3 -1 def
      /k4 -1 def
      /k3a -3 def
      /k4a -3 def
      %% pour chaque arete [AB]
      0 1 n 1 sub {
         /j exch def
         %% arete testee : [j, j+1 mod n] (indices relatifs a la face i)
         solid j i solidgetsommetface /A defpoint3d
         solid j 1 add n mod i solidgetsommetface /B defpoint3d
         %% y a-t-il intersection
         A B eqplan segment_inter_plan {
            %% il y a intersection
            dup length 6 eq {
               %% l'intersection, c'est [AB]
               /k1 -1 def
               /k2 -1 def
               /k3 -1 def
               /k4 -1 def
               /k3a -1 def
               /k4a -1 def
               dup 0 getp3d /A defpoint3d
               1 getp3d /B defpoint3d
               result A solidaddsommet /a1 exch def
               result B solidaddsommet /a2 exch def
               /indnouveauxsommets [
                  indnouveauxsommets aload pop a1 a2
               ] store
               /nouvellesaretes [
                  [a1 a2]
                  nouvellesaretes aload pop
               ] store
               exit %% c est deja scinde
            } if
            %% il y a intersection <> [AB]
            k1 0 lt {
            %% 1ere intersection de la face
               /k1 j def %% sommet precedent intersection 1
               result exch aload pop solidaddsommet
               /k1a exch def %% sommet intersection 1
            } {
               k2 0 lt {
               %% 2eme intersection de la face
                  /k2 j def %% sommet precedent intersection 2
                  result exch aload pop solidaddsommet
                  /k2a exch def %% sommet intersection 2
               } {
                  k3 0 lt {
                  %% 3eme intersection de la face
                     /k3 j def %% sommet precedent intersection 3
                     result exch aload pop solidaddsommet
                     /k3a exch def %% sommet intersection 3
                  } {
                  %% 4eme intersection de la face
                     /k4 j def %% sommet precedent intersection 4
                     result exch aload pop solidaddsommet
                     /k4a exch def %% sommet intersection 4
                  } ifelse
               } ifelse
            } ifelse
         } if
      } for
      
      %% y a-t-il eu une coupe ?
      %% si oui, il faut scinder la face d'indice i en cours 
      k1 0 ge {
%% (coupe) ==
%% (n) == n ==
%% k1 == k2 == k3 == k4 ==
%% (a) ==
%% k1a == k2a == k3a == k4a ==
         k1a k2a eq k3 0 lt and {
            %% 1 pt d'intersection
         } {
            %% il y a coupe, on cherche a eliminer les
            %% doublons dans {k1a, k2a, k3a, k4a}
            k1a k2a eq k3 0 ge and {
               %% 2 pts d'intersection
               /k2a k3a def
               /k2 k3 def
            } if
            k1a k3a eq k4 0 ge and {
               %% 2 pts d'intersection
               /k2a k4a def
               /k2 k4 def
            } if
            /nouvellesaretes [
               [k1a k2a]
               nouvellesaretes aload pop
            ] store
            [
               k1a F k1 1 add n mod get ne {
                  k1a
               } if
               k1 1 add n mod 1 k2 {F exch get} for
               k2a F k2 get ne {
                  k2a
               } if
            ]
            result exch lacouleur solidaddface
            /indnouveauxsommets [indnouveauxsommets aload pop k1a k2a] store
            [
               k2a F k2 1 add n mod get ne {
                  k2a
               } if
               k2 1 add n ne {
                  k2 1 add n mod 1 n 1 sub {F exch get} for
               } if
               0 1 k1 {F exch get} for
               k1a F k1 get ne {
                  k1a
               } if
            ]
            result exch lacouleur solidaddface
            /aenlever [aenlever aload pop i] store
         } ifelse
      } if
   } for
   result aenlever solidrmfaces

   nouvellesaretes separe_composantes
   /composantes exch def

   %% pour chacune des composantes
   0 1 composantes length 1 sub {
      %% on oriente et on ajoute la face
      /icomp exch def
      %indnouveauxsommets bubblesort arrayrmdouble
      /indnouveauxsommets composantes icomp get def
      %% maintenant, on ajoute la face de plan de coupe
      /nouveauxsommets [
         0 1 indnouveauxsommets length 1 sub {
            /i exch def
            result indnouveauxsommets i get solidgetsommet
         } for
      ] def
   
      0 0 0 eqplan pointeqplan 0 eq {
         /ptref {0 1 1} def
      } {
         /ptref {0 0 0} def
      } ifelse
   
      %% restera a traiter le cas limite ou la nouvelle face existe deja
      %% tester si max(indicestries) < nb sommets avant section
      nouveauxsommets ptref ordonnepoints3d
      /indicestries exch def
      /nvelleface [
         0 1 indicestries length 1 sub {
            /m exch def
            indnouveauxsommets indicestries m get get
         } for
      ] def
      /F result solidgetfaces def
      /FC result solidgetfcolors def
      /IO result solidgetinouttable def
      /n1 IO 1 get def
      IO 1 n1 1 add put
      result IO solidputinouttable
      result [nvelleface F aload pop] solidputfaces
      result [lacouleur FC aload pop] solidputfcolors
   } for
   result
   tr@nsmit {
      composantes length 
   } if
end    
} def

%% syntaxe : elt array compteoccurences
%% ou array est un tableau du type [ [a1 a2] [b1 b2] [c1 c2] ... ]
/compteoccurences {
5 dict begin
   /table exch def
   /elt exch def
   /n 0 def
   0 1 table length 1 sub {
      /i exch def
      elt table i get in {
         pop
         /n n 1 add store
      } if
   } for
   n
end
} def

/separe_composantes {
10 dict begin
   /result [] def %% les composantes deja faites
   /table exch def %% ce qui reste a faire

%   (recu) == table {==} apply
   {
      /ext1 table 0 get 1 get def
      /ext0 table 0 get 0 get def
      /composante [] def
   
      { %% maintenant on suit les extremites et on epluche une composante
         /change false def
         /aenlever [] def
         0 1 table length 1 sub {
            /i exch def
            ext1 table i get In
            ext0 table i get In or {
               /aenlever [aenlever aload pop i] store
               /change true store
               %% l'arete i contient l'extremite ext0 ou ext1
               ext0 table i get in {
                  %% index = 0 ou 1
                  neg 1 add table i get exch get
                  /ext0 exch store
                  ext0 composante In not {
                     /composante [composante aload pop ext0] store
                  } if
                  %% on verifie que ext0 est legitime
                  ext0 table compteoccurences 2 gt {
                     /ext0 -1 store
                  } if
               } if
               ext1 table i get in {
                  %% index = 0 ou 1
                  neg 1 add table i get exch get
                  /ext1 exch store
                  ext1 composante In not {
                     /composante [composante aload pop ext1] store
                  } if
                  %% on verifie que ext1 est legitime
                  ext1 table compteoccurences 2 gt {
                     /ext1 -1 store
                  } if
               } if
            } if
         } for
         %% il faut reconstruire table
         /table [
            0 1 table length 1 sub {
               /i exch def
               i aenlever in {
                  pop
               } {
                  table i get
               } ifelse
            } for
         ] store
         change not {exit} if
      } loop
      %% on vient de finir une composante
      /result [result aload pop composante] store
      %% (nouvelle comp) == composante {==} apply
      table length 0 eq {exit} if
   } loop
   result
%   (renvoie) == result {==} apply
end
} def

/solideqplansepare {solidplansepare} def
    
%% syntaxe : solid eqplan/plantype solidplansepare --> solid1 solid2
/solidplansepare {
10 dict begin
   dup isplan {
      plan2eq
      /eqplan exch def
   } {
      /eqplan exch def
   } ifelse
   eqplan true solidplansection
   /nbcomposantes exch def
   /solid exch def
   /n solid solidnombrefaces def

   /F [] def
   /FC [] def
   %% on retire les faces de coupe
   0 1 nbcomposantes 1 sub {
      /i exch def
      /F [F aload pop solid i solidgetface] store
      /FC [FC aload pop solid i solidgetfcolor] store
   } for
   solid [0 1 nbcomposantes 1 sub {} for] solidrmfaces
   /n n nbcomposantes sub store

   %% on separe les autres faces en 2 parties
   /lesneg [] def %% indices des faces "positives"
   /lespos [] def %% indices des faces negatives"
   0 1 n 1 sub {
      /i exch def
      solid i solidcentreface /G defpoint3d
      G eqplan pointeqplan dup 0 gt {
         pop
         /lespos [lespos aload pop i] store
      } {
         0 lt {
            /lesneg [lesneg aload pop i] store
         } {
%           /lesneg [lesneg aload pop i] store
%           /lespos [lespos aload pop i] store
         } ifelse
      } ifelse
   } for
   solid
   dupsolid dup lesneg solidrmfaces
   /result1 exch def
   dupsolid dup lespos solidrmfaces
   /result2 exch def
   pop

   0 1 nbcomposantes 1 sub {
      /i exch def
      /facecoupe F i get def
      /couleurfacecoupe FC i get def
      /lesfaces1 result1 solidgetfaces def
      /lescouleurs1 result1 solidgetfcolors def
      /IO1 result1 solidgetinouttable def
      /lesfaces2 result2 solidgetfaces def
      /lescouleurs2 result2 solidgetfcolors def
      /IO2 result2 solidgetinouttable def
      %% on rajoute maintenant la face du plan de coupe
%      result1 facecoupe couleurfacecoupe solidaddface
      result1 [facecoupe lesfaces1 aload pop] solidputfaces
      result1 [couleurfacecoupe lescouleurs1 aload pop] solidputfcolors
      result1 IO1 dup dup 1 get 1 add 1 exch put solidputinouttable
      %% et on verifie l'orientation
%      result1 dup solidnombrefaces 1 sub solidnormaleface 
%      result1 dup solidnombrefaces 1 sub solidcentreface addv3d
      result1 0 solidnormaleface 
      result1 0 solidcentreface addv3d
      eqplan pointeqplan 0 gt {
         %% l'orientation est mauvaise
         result1 0 solidrmface 
         result2 [facecoupe lesfaces2 aload pop] solidputfaces
         result2 [couleurfacecoupe lescouleurs2 aload pop] solidputfcolors
         result2 IO2 dup dup 1 get 1 add 1 exch put solidputinouttable
         result1 [facecoupe reverse lesfaces1 aload pop] solidputfaces
         result1 [couleurfacecoupe lescouleurs1 aload pop] solidputfcolors
         result1 dup solidgetinouttable dup dup 1 get 1 add 1 exch put solidputinouttable
      } {
         %% l'orientation est ok
         result2 IO2 dup dup 1 get 1 add 1 exch put solidputinouttable
         result2 [facecoupe reverse lesfaces2 aload pop] solidputfaces
         result2 [couleurfacecoupe lescouleurs2 aload pop] solidputfcolors
      } ifelse
   } for
   
   %% maintenant on enleve les sommets isoles
   /sommetspos [] def
   /sommetsneg [] def
   %% pour chaque face du cote negatif
   0 1 lesneg length 1 sub {
      lesneg exch get /i exch def
      /F solid i solidgetface def
      %% pour chaque sommet de cette face
      0 1 F length 1 sub {
         /j exch def
         /sommet F j get def
         %% si le sommet n'est pas encore note
         sommet sommetsneg in not {
            %% et s'il est isole, on peut l'enlever
            result1 sommet solidsommetsadjsommet length 0 eq {
               /sommetsneg [sommetsneg aload pop sommet] store
            } if
         } {
            pop
         } ifelse
      } for
   } for
   sommetsneg bubblesort reverse {result1 exch solidrmsommet} apply

   %% pour chaque face du cote positif
   0 1 lespos length 1 sub {
      lespos exch get /i exch def
      /F solid i solidgetface def
      %% pour chaque sommet de cette face
      0 1 F length 1 sub {
         /j exch def
         /sommet F j get def
         %% si le sommet n'est pas encore note
         sommet sommetspos in not {
            %% et s'il est isole, on peut l'enlever
            result2 sommet solidsommetsadjsommet length 0 eq {
               /sommetspos [sommetspos aload pop sommet] store
            } if
         } {
            pop
         } ifelse
      } for
   } for
   sommetspos bubblesort reverse {result2 exch solidrmsommet} apply

   result1 result2
end
} def

%%%%% ### solidaffine ###
%% syntaxe : solid coeff i solidaffine -> -
%% syntaxe : solid coeff array solidaffine -> -
%% syntaxe : solid coeff solidaffine -> -
%% syntaxe : solid coeff str solidaffine -> -
%% syntaxe : solid coeff bool solidaffine -> -
/solidaffine {
10 dict begin
   dup isbool {
      /rmfacecentrale exch def
   } {
      /rmfacecentrale true def
   } ifelse
   dup isstring {
      /couleurface exch def
   } if
   2 copy pop issolid {
      %% 2 arguments --> on affine tout
      2 copy pop solidnombrefaces /n exch def
      /table [n 1 sub -1 0 {} for] def 
   } {
      %% 1 tableau --> il donne les faces a enlever
      dup isarray {
         /table exch bubblesort reverse def
      } {
      %% 1 seule face a enlever
         [ exch ] /table exch def
      } ifelse
   } ifelse
   /coeff exch def
   /solid exch def
   0 1 table length 1 sub {
      /i exch def
      solid coeff table i get 
      currentdict /couleurface known {
         couleurface 
      } if
      rmfacecentrale s@lidaffineface
   } for
end
} def

%% syntaxe : solid coeff i s@lidaffineface
 /s@lidaffineface {
10 dict begin
   /rmfacecentrale exch def
   dup isstring {
      /couleurface exch def
   } if
   /indice_a_chamfreiner exch def
   /i indice_a_chamfreiner def
   /coeff exch def
   /solid exch def
   solid issolid not {
      (Erreur : mauvais type d argument dans affine) ==
      quit
   } if
   /n solid solidnombresommets def
   /F solid i solidgetsommetsface def
   /Findex solid i solidgetface def
   /ni F length 3 idiv def
   /couleurfaceorigine solid i solidgetfcolor def
   F isobarycentre3d /G defpoint3d
   %% on ajoute les nouveaux sommets
   /Sindex [] def
   0 1 ni 1 sub {
      /j exch def
      /Sindex [ Sindex aload pop
         solid G F j getp3d vecteur3d coeff mulv3d G addv3d solidaddsommet
      ] store
   } for
   %% Sindex contient les indices des nouveaux sommets
   %% on prepare les faces a ajouter
   /facestoadd [] def
   /facestoadd [facestoadd aload pop
   0 1 ni 1 sub {
      /j exch def
      [Findex j get
      Findex j 1 add ni mod get
      Sindex j 1 add ni mod get
      Sindex j get]
   } for
   ] store
   0 1 ni 1 sub {
      /i exch def
      solid facestoadd i get solidaddface
   } for
   %% on enleve la face d origine
   solid indice_a_chamfreiner solidrmface
   %% on ajuste les couleurs des nouvelles faces
   /N solid solidnombrefaces def
   0 1 ni 1 sub {
      /i exch def
      solid N 1 sub i sub couleurfaceorigine solidputfcolor
   } for
   %% puis on ajoute eventuellement la face centrale
   rmfacecentrale not {
      solid
      [0 1 ni 1 sub {
         /j exch def
         Sindex j get
      } for]
      solidaddface
      %% en ajustant la couleur de cette derniere
      solid N
      currentdict /couleurface known {
            couleurface 
      } {
         couleurfaceorigine
      } ifelse
      solidputfcolor
   } if
end
} def

%%%%% ### solidtronque ###
%% syntaxe : solid indicesommet k solidtronque --> solid
%% syntaxe : solid array k solidtronque --> solid
%% syntaxe : solid k solidtronque --> solid
%% k entier > 0, array = tableau des indices des sommets
/solidtronque {
10 dict begin
   /coeff exch def
   dup issolid {
      dup solidnombresommets /N exch def
      /table [0 1 N 1 sub {} for] def
   } {
      dup isarray {
         /table exch def
      } {
         [ exch ] /table exch def
      } ifelse
   } ifelse
   /solid exch def
   solid dupsolid /result exch def pop
   /n solid solidnombrefaces def
   0 1 table length 1 sub {
      table exch get /no exch def
      result no solidgetsommet /sommetvise defpoint3d
      %% on recup les sommets adjacents au sommet vise
      /sommetsadj solid no solidsommetsadjsommet def
      %% on calcule les nouveaux sommets
      /nouveauxsommets [
         0 1 sommetsadj length 1 sub {
            /i exch def
            solid sommetsadj i get solidgetsommet
         } for
      ] {sommetvise exchp3d coeff ABpoint3d} papply3d def 
      %% on pose G = barycentre de ces points
      nouveauxsommets isobarycentre3d /G defpoint3d
      %% il faut ordonner ces sommets
      nouveauxsommets 0 getp3d /ptref defpoint3d
      G result no solidgetsommet vecteur3d /vecteurnormal defpoint3d
      %% on construit le tableau des angles ordonnes par rapport
      %% a la normale
      nouveauxsommets duparray exch pop
      {1 dict begin
         /M defpoint3d
         G ptref vecteur3d
         G M vecteur3d
         vecteurnormal angle3doriente
      end} papply3d
      doublebubblesort pop
      %% nos sommets sont tries
      /indicesommetstries exch def
      %% on rajoute les sommets au solide, et on note les nouveaux indices
      /nouveauxindices [
         0 1 nouveauxsommets length 3 idiv 1 sub {
            /k exch def
            result nouveauxsommets k getp3d solidaddsommet
         } for
      ] def
      %% on ajoute la face concernee
      result [
         0 1 indicesommetstries length 1 sub {
            /k exch def
         nouveauxindices indicesommetstries k get get
         } for 
      ] solidaddface
      result no solidfacesadjsommet /lesfaces exch def
      %% on examine la face d indice i, et on elimine le
      %% sommet vise
      0 1 lesfaces length 1 sub {
         /i exch def
         /j lesfaces i get def
         /F result j solidgetface def 
         result [
            0 1 F length 1 sub {
               /k exch def 
               F k get dup no eq {pop} if
            } for
         ] j exch solidputface 
      } for
   } for
   table bubblesort reverse {result exch solidrmsommet} apply
   result
end
} def

%%%%% ### dualpolyedre ###
%% syntaxe : solid dualpolyedreregulier --> solid
%% syntaxe : solid r dualpolyedreregulier --> solid
%% si le nombre r est present, projette les nouveaux sommets sur la sphere de centre O , de rayon r
/dualpolyedreregulier {
20 dict begin
   dup isnum {
      /r exch def
      /projection true def
   } {
      /projection false def
   } ifelse
   /solid exch def
   solid dupsolid /result exch def pop
   /n solid solidnombrefaces def
   /N solid solidnombresommets def
   /facesaenlever [] def
   %% pour chacun des sommets
   0 1 N 1 sub {
      %% sommet d indice i
      /i exch def
      %% indicesfacesadj = liste des indices des faces ou on trouve le sommet i
      /indicesfacesadj solid i solidfacesadjsommet def
      %% on recupere les centres des faces concernees
      /nouveauxsommets [
         0 1 indicesfacesadj length 1 sub {
            /k exch def 
            solid indicesfacesadj k get solidgetsommetsface isobarycentre3d
         } for
      ] def
      %% et on pose G = barycentre de ces points
      nouveauxsommets isobarycentre3d /G defpoint3d
      %% il faut ordonner ces sommets
      nouveauxsommets 0 getp3d /ptref defpoint3d
      G solid i solidgetsommet vecteur3d /vecteurnormal defpoint3d
      nouveauxsommets duparray exch pop
      {1 dict begin
         /M defpoint3d
         G ptref vecteur3d
         G M vecteur3d
         vecteurnormal angle3doriente
      end} papply3d
      doublebubblesort pop
      %% nos sommets sont tries
      /indicesommetstries exch def
      projection {
         %% on projette les sommets sur la sphere
         /nouveauxsommets [ nouveauxsommets {normalize3d r mulv3d} papply3d aload pop ] store
      } if
      %% puis on les rajoute au solide
      /nouveauxindices [
         0 1 nouveauxsommets length 3 idiv 1 sub {
            /k exch def
            result nouveauxsommets k getp3d solidaddsommet
         } for
      ] def
      %% ainsi que la face concernee
      result [
         0 1 indicesommetstries length 1 sub {
            /k exch def
         nouveauxindices indicesommetstries k get get
         } for 
      ] solidaddface
      /facesaenlever [ facesaenlever aload pop indicesfacesadj aload pop ] store
   } for
   result [0 1 n 1 sub {} for] solidrmfaces
   [N 1 sub -1 0 {} for] {result exch solidrmsommet} apply
   result
end
} def

%%%%% ### newgeode ###
%% syntaxe : solid r newgeode --> solid
%% syntaxe : N r newgeode --> solid
%% N in {3,4,5} -> polyhedre de depart, r = niveau de recursion
/newgeode {
2 dict begin
   /r exch def
   dup issolid not {
      /N exch def
      N 3 eq {
         1 newtetraedre
      } {
         N 4 eq {
            1 newoctaedre
         } {
            1 newicosaedre
         } ifelse
      } ifelse
   } if

   r {
      15 dict begin   
         /solid exch def
         solid dupsolid /result exch def pop
         /n solid solidnombrefaces def
         n 1 sub -1 0 {
            /i exch def
            %% la face d indice i
            solid i solidgetface /F exch def
            /i0 F 0 get def
            /i1 F 1 get def
            /i2 F 2 get def
            solid i0 solidgetsommet /A0 defpoint3d
            solid i1 solidgetsommet /A1 defpoint3d
            solid i2 solidgetsommet /A2 defpoint3d
            A0 A1 milieu3d normalize3d /A01 defpoint3d
            A1 A2 milieu3d normalize3d /A12 defpoint3d
            A2 A0 milieu3d normalize3d /A20 defpoint3d
            result A01 solidaddsommet /i01 exch def
            result A12 solidaddsommet /i12 exch def
            result A20 solidaddsommet /i20 exch def
            result i solidrmface
            result [i0 i01 i20] solidaddface
            result [i01 i1 i12] solidaddface
            result [i01 i12 i20] solidaddface
            result [i20 i12 i2] solidaddface
         } for
         result
      end
   } repeat
end
} def

%% syntaxe : N r newdualgeode --> solid
/newdualgeode {
   newgeode 1
   dualpolyedreregulier
} def

%%%%% ### fin insertion ###


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             quelques solides precalcules           %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%% ### newface ### 
%% syntaxe : array newmonoface -> solid
%% ou array = tableau de points 2d
/newmonoface {
4 dict begin
   /table exch def
   /n table length 2 idiv def
   /S table {0} papply def

   /F [
       [0 1 n 1 sub {} for]
   ] def
   S F generesolid
end
} def

%% syntaxe : array newbiface -> solid
%% ou array = tableau de points 2d
/newbiface {
   newmonoface
   dup videsolid
} def

%%%%% ### newpolreg ### 
%% syntaxe : r n newpolreg --> solid
/newpolreg {
5 dict begin
   /n exch def
   /r exch def
   /S [
       0 360 n div 360 360 n div sub {
           /theta exch def
           theta cos r mul
           theta sin r mul
           0
       } for
   ] def
   /F [
       [0 1 n 1 sub {} for]
   ] def

   S F generesolid
   dup videsolid
end
} def

%%%%% ### newgrille ### 
%% syntaxe : xmin xmax ymin ymax [dx dy] newgrille -> solid
%% syntaxe : xmin xmax ymin ymax [nx ny] newgrille -> solid
%% syntaxe : xmin xmax ymin ymax {mode} newgrille -> solid
%% syntaxe : xmin xmax ymin ymax newgrille -> solid
/newgrille {
10 dict begin
   [[/nx /ny] [1 1] [1. 1.] [1. 1.] [1. 1.] [.5 .5]] gestionsolidmode
   %% ny nb d etages en y
   %% nx nb d etages en x
   /biface false def
   [nx ny] {0} newsurfaceparametree
end
} def

%% %% syntaxe : xmin xmax ymin ymax [dx dy] {f} newsurface -> solid
%% %% f : R^2 -> R
/newsurface {
   true newsurfaceparametree
} def

/biface true def

/newsurfaceparametree {
10 dict begin
   dup isbool {
      pop /surfz true def
   } {
      /surfz false def
   } ifelse
   /f_surface exch def
   [[/nx /ny] [2 2] [4 4] [1. 1.] [1. 1.] [.25 .25]] gestionsolidmode
   %% ny nb d etages en y
   %% nx nb d etages en x
   /ymax exch def
   /ymin exch def
   /xmax exch def
   /xmin exch def

   nx isinteger not {
       %% alors nx est un dx
       /nx xmax xmin sub nx div cvi store
   } if
   ny isinteger not {
       %% alors ny est un dy
       /ny ymax ymin sub ny div cvi store
   } if
   /dy ymax ymin sub ny div def %% le pas sur y
   /dx xmax xmin sub nx div def %% le pas sur x

   /S [
       0 1 nx {
           /i exch def
           0 1 ny {
               /j exch def
               /u xmin i dx mul add def
               /v ymin j dy mul add def
               u v
               surfz {2 copy} if
               f_surface
               pstrickactionR3
           } for
       } for
   ] def

   /F [
       0 1 nx 1 sub {
          /i exch def
          0 1 ny 1 sub {
             /j exch def
             [
                j 1 add        i ny 1 add mul add
                j              i ny 1 add mul add
                j ny 1 add add i ny 1 add mul add
                j ny 2 add add i ny 1 add mul add
             ]
          } for
       } for
%%       0 1 0 {%nx 1 sub {
%%          /i exch def
%%          0 1 0 {%ny 2 sub {
%%             /j exch def
%%             [
%%             j 1 add        %% i ny mul add
%%             j              %% i ny mul add
%%             ny 1 add j add       %% i ny mul add
%%             ny 2 add j add     %% i ny mul add
%%             ]
%%          } for
%%       } for
   ] def
   S F generesolid
   biface pl@n-en-cours not and {dup videsolid} if
end
} def

%%%%% ### newgrillecirculaire ### 
%% syntaxe : r option newgrillecirculaire -> solid
/newgrillecirculaire {
6 dict begin
   [[/K /N] [6 6] [6 8] [10 8] [16 12] [16 36]] gestionsolidmode

   %% N = nb de meridiens (diviseur de 360 = 2^4 * 3^2 * 5)
   %% K = nb d horizontales (diviseur de 160 = 2^5 * 5)

   /r exch def
   /F [
       %% 1er etage
       1 1 N {
           /i exch def
           [0 i i N mod 1 add]
       } for
       %% etages suivants
       0 1 K 2 sub {
           /j exch def
           1 1 N {
               /i exch def
               [i      j N mul add
               i N add j N mul add
               i N mod N add 1 add j N mul add
               i N mod 1 add j N mul add]
           } for
      } for
   ] def

   %% tableau des sommets
   /S [
       0 0 0
       1 1 K {
           /j exch def
           1 1 N {
             /i exch def
             /theta i 360 mul N div def
             theta cos r j mul K div mul
             theta sin r j mul K div mul
             0 %2 copy f %exch atan 90 div
          } for
       } for
   ] def

   S F generesolid
end
} def

%% syntaxe : r [dx dy] {f} newsurface* -> solid
/newsurface* {
7 dict begin
   /f_surface exch def
   [[/nx /ny] [6 6] [6 8] [10 8] [16 12] [16 36]] gestionsolidmode

   nx isinteger not {
       %% alors nx est un dx
       /nx xmax xmin sub nx div cvi store
   } if
   ny isinteger not {
       %% alors ny est un dy
       /ny ymax ymin sub ny div cvi store
   } if
   /dy ymax ymin sub ny div def %% le pas sur y
   /dx xmax xmin sub nx div def %% le pas sur x

   %% ny = nb de meridiens
   %% nx = nb d horizontales

   /r exch def
   /F [
       %% 1er etage
       1 1 ny {
           /i exch def
           [0 i i ny mod 1 add]
       } for
       %% etages suivants
       0 1 nx 2 sub {
           /j exch def
           1 1 ny {
               /i exch def
               [i      j ny mul add
               i ny add j ny mul add
               i ny mod ny add 1 add j ny mul add
               i ny mod 1 add j ny mul add]
           } for
      } for
   ] def

   %% tableau des sommets
   /S [
       0 0 0
       1 1 nx {
           /j exch def
           1 1 ny {
             /i exch def
             /theta i 360 mul ny div def
             theta cos r j mul nx div mul
             theta sin r j mul nx div mul
             2 copy f_surface
          } for
       } for
   ] def

   S F generesolid
end
} def

%%%%% ### newruban ### 
%% syntaxe : array h u [n] newruban -> solid d axe (O, u), de maillage vertical n
%% syntaxe : array h u newruban -> solid d axe (O, u),
%% syntaxe : array h newruban -> solid d axe (O, k),
%% ou array tableau de points 2d
/newruban {
7 dict begin
   %% N = nb d etages
   [[/N] [1] [1] [1] [3] [4]] gestionsolidmode
   2 copy pop isarray {
      /u {0 0 1} def
   } {
      /u defpoint3d
   } ifelse
   u 0 eq {
      (Error : 3eme composante nulle dans le vecteur pour newruban) ==
      quit
   } if
   pop pop
   /h exch def
   /table exch def
   %% n = indice du dernier point
   /n table length 2 idiv 1 sub def
   %% vecteur de translation
   u
   h u norme3d div
   mulv3d /v defpoint3d

   %% tableau des sommets
   /S [
      0 1 N {
         /j exch def
         0 1 n {
             /i exch def
             table i getp
             0
             v N j sub N div mulv addv3d
         } for
      } for
   ] def

   /F [
      %% faces etage
      1 1 N {
         /j exch def
         1 1 n {
             /i exch def
             [i                   j 1 sub n 1 add mul add
              i 1 sub             j 1 sub n 1 add mul add
              n 1 add i add 1 sub j 1 sub n 1 add mul add
              n 1 add i add       j 1 sub n 1 add mul add]
         } for
     } for
   ] def

   S F generesolid
   dup videsolid
end
} def

%%%%% ### newicosaedre ### 
/newicosaedre {
3 dict begin
   /a exch def
   /S [
      0.8944271  0              0.4472137
      0.2763932  0.8506507      0.4472137
      -0.7236067 0.5257311      0.4472137
      -0.7236067 -0.5257311     0.4472137
      0.2763932  -0.8506507     0.4472137
      0          0              1
      0          0              -1
      -0.8944271 0              -0.4472137
      -0.2763932 -0.8506507     -0.4472137
      0.7236067  -0.5257311     -0.4472137
      0.7236067  0.5257311      -0.4472137
      -0.2763932 0.8506507      -0.4472137
   ] {a mulv3d} papply3d def

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

   S F generesolid
end
} def

%%%%% ### newdodecaedre ### 
/newdodecaedre {
3 dict begin
   /a exch def
   /S [
      0          0.607062   0.7946545
      -0.5773503 0.1875925  0.7946545
      -0.3568221 -0.4911235 0.7946545
      0.3568221  -0.4911235 0.7946545
      0.5773503  0.1875925  0.7946545
      0          0.982247   0.1875925
      -0.9341724 0.303531   0.1875925
      -0.5773503 -0.7946645 0.1875925
      0.5773503  -0.7946645 0.1875925
      0.9341724  0.303531   0.1875925
      0          -0.982247  -0.1875925
      0.9341724  -0.303531  -0.1875925
      0.5773503  0.7946545  -0.1875925
      -0.5773503 0.7946545  -0.1875925
      -0.9341724 -0.303531  -0.1875925
      -0.5773503 -0.1875925 -0.7946545
      -0.3568221 0.4911235  -0.7946545
      0.3568221  0.4911235  -0.7946545
      0.5773503  -0.1875925 -0.7946545
      0          -0.607062  -0.7946545
   ] {a mulv3d} papply3d def

   /F [
      [0 1 2 3 4]
      [4 3 8 11 9]
      [4 9 12 5 0]
      [0 5 13 6 1]
      [1 6 14 7 2]
      [2 7 10 8 3]
      [10 19 18 11 8]
      [11 18 17 12 9]
      [12 17 16 13 5]
      [13 16 15 14 6]
      [14 15 19 10 7]
      [15 16 17 18 19]
   ] def
   S F generesolid
end
} def

%%%%% ### newoctaedre ### 
/newoctaedre {
3 dict begin
   /a exch def
   %%Sommets
   /S [
      0  0  1
      1  0  0
      0  1  0
      -1 0  0
      0  -1 0
      0  0  -1
   ] {a mulv3d} papply3d def

   /F [
      [0 4 1]
      [1 2 0]
      [0 2 3]
      [3 4 0]
      [1 5 2]
      [2 5 3]
      [3 5 4]
      [4 5 1]
   ] def

   S F generesolid
end
} def

%%%%% ### newtetraedre ### 
/newtetraedre {
3 dict begin
   /r exch def
   %%Tetraedre
   /S [
      0          0          1
      -0.4714045 -0.8164965 -1 3 div
      0.942809   0          -1 3 div
      -0.4714045 0.8164965  -1 3 div
   ] {r mulv3d} papply3d def

   /F [
      [0 1 2]
      [0 2 3]
      [0 3 1]
      [1 3 2]
   ] def

   S F generesolid
end
} def

%%%%% ### newcube ### 
/newcube {
3 dict begin
   [[/n] [1] [1] [1] [3] [4]] gestionsolidmode
   /a exch 2 div def

   n 1 le {
      /F [
     [0 1 2 3]
     [0 4 5 1]
     [1 5 6 2]
     [2 6 7 3]
     [0 3 7 4]
     [4 7 6 5]
      ] def

      %% tableau des sommets
      /S [
      1  1  1 %% 0
     -1  1  1 %% 1
     -1 -1  1 %% 2
      1 -1  1 %% 3
      1  1 -1 %% 4
     -1  1 -1 %% 5
     -1 -1 -1 %% 6
      1 -1 -1 %% 7
      ] {a mulv3d} papply3d def
      S F generesolid
   } {
      /dl 2 n div def
      /N n dup mul n add 4 mul def
      /n1 n 1 sub dup mul def %% nb sommets centre d une face

      %% tableau des sommets
      /S1 [
     0 1 n 1 sub {
        /j exch def
        0 1 n {
           /i exch def
           -1 i dl mul add
           -1 j dl mul add
        1
        } for
     } for
      ] def

      /S2 S1 {-90 0 0 rotateOpoint3d} papply3d def
      /S3 S2 {-90 0 0 rotateOpoint3d} papply3d def
      /S4 S3 {-90 0 0 rotateOpoint3d} papply3d def

      /S5 [
     1 1 n 1 sub {
        /j exch def
        1 1 n 1 sub {
           /i exch def
        1
           -1 i dl mul add
           -1 j dl mul add
        } for
     } for
      ] def

      /S6 [
     1 1 n 1 sub {
        /j exch def
        1 1 n 1 sub {
           /i exch def
           -1
           -1 i dl mul add
           -1 j dl mul add
        } for
     } for
      ] def

      %% tableau des faces
      /F1 [
     0 1 n 1 sub {
        /j exch def
        0 1 n 1 sub {
           /i exch def
           [
          i n 1 add j mul add
          dup 1 add
          dup n 1 add add
          dup 1 sub
           ]
        } for
     } for
      ] def

      %% syntaxe : i sommettourgauche --> l indice du i-eme sommet du tour
      %% de la face gauche (en commencant par l indice 0). ATTENTION :
      %% utilise la variable globale n = nb d etages
      /sommettourgauche {
      1 dict begin
     /i exch def
     i 4 n mul ge {
        i
        (Error: indice trop grand dans sommettourgauche) ==
        exit
     } if
     n n 1 add i mul add
      end
      } def

      %% syntaxe : i sommetcentregauche --> l indice du i-eme sommet du centre
      %% de la face gauche (en commencant par l indice 0). ATTENTION :
      %% utilise les variables globales n = nb d etages, et N = nb sommets
      %% des 4 1eres faces
      /sommetcentregauche {
      1 dict begin
     /i exch def
     i n 1 sub dup mul ge {
        i
        (Error: indice trop grand dans sommetcentregauche) ==
        exit
     } if
     N i add
      end
      } def

      /F5 [
     %%%%% la face gauche %%%%%
     %% le coin superieur gauche
     [
        1 sommettourgauche
        0 sommettourgauche
        n 4 mul 1 sub sommettourgauche
        n1 n 1 sub sub sommetcentregauche
     ]

     %% la bande superieure (i from 1 to n-2)
     1 1 n 2 sub {
        /i exch def
        [
           i 1 add sommettourgauche
           i sommettourgauche
           n1 n sub i add sommetcentregauche
           n1 n sub i 1 add add sommetcentregauche
        ]
     } for

     %% le coin superieur droit
     [
        n sommettourgauche
        n 1 sub sommettourgauche
        n1 1 sub sommetcentregauche
        n 1 add sommettourgauche
     ]

     %% la descente gauche
     %% j from 1 to n-2
     1 1 n 2 sub {
        /j exch def
        [
           n1 n 1 sub j mul sub sommetcentregauche
           n 4 mul j sub sommettourgauche
           n 4 mul j 1 add sub sommettourgauche
           n1 n 1 sub j 1 add mul sub sommetcentregauche
        ]
     } for

     %% les bandes centrales (j from 1 to n-2 et i from 1 to n-2)
     1 1 n 2 sub {
        /j exch def
        1 1 n 2 sub {
           /i exch def
           [
          n1 i n 1 sub j 1 sub mul add sub sommetcentregauche
          n1 i 1 add n 1 sub j 1 sub mul add sub sommetcentregauche
          n1 i 1 add n 1 sub j mul add sub sommetcentregauche
          n1 i n 1 sub j mul add sub sommetcentregauche
           ]
        } for
     } for

     %% la descente droite
     1 1 n 2 sub {
        /j exch def
        [
           n j add sommettourgauche
           n1 1 sub j 1 sub n 1 sub mul sub sommetcentregauche
           n1 1 sub j n 1 sub mul sub sommetcentregauche
           n j 1 add add sommettourgauche
        ]
     } for

     %% le coin inferieur gauche
     [
        0 sommetcentregauche
        n 3 mul 1 add sommettourgauche
        n 3 mul sommettourgauche
        n 3 mul 1 sub sommettourgauche
     ]

     %% la bande inferieure (i from 1 to n-2)
     1 1 n 2 sub {
        /i exch def
        [
           i sommetcentregauche
           i 1 sub sommetcentregauche
           n 3 mul i sub sommettourgauche
           n 3 mul i sub 1 sub sommettourgauche
        ]
     } for

     %% le coin inferieur droit
     [
        n 2 mul 1 sub sommettourgauche
        n 2 sub sommetcentregauche
        n 2 mul 1 add sommettourgauche
        n 2 mul sommettourgauche
     ]
      ] def

      %% syntaxe : i sommettourdroit --> l indice du i-eme sommet du tour
      %% de la face droit (en commencant par l indice 0). ATTENTION :
      %% utilise la variable globale n = nb d etages
      /sommettourdroit {
      1 dict begin
     /i exch def
     i 4 n mul ge {
        i
        (Error: indice trop grand dans sommettourdroit) ==
        exit
     } if
     n 1 add i mul
      end
      } def

      %% syntaxe : i sommetcentredroit --> l indice du i-eme sommet du centre
      %% de la face droit (en commencant par l indice 0). ATTENTION :
      %% utilise les variables globales n = nb d etages, et N = nb sommets
      %% des 4 1eres faces
      /sommetcentredroit {
      1 dict begin
     /i exch def
     i n 1 sub dup mul ge {
        i
        (Error: indice trop grand dans sommetcentredroit) ==
        exit
     } if
     N n1 add i add
      end
      } def

      /F6 [
     %% coin superieur droit
     [
        0 sommettourdroit
        1 sommettourdroit
        n1 n 1 sub sub sommetcentredroit
        4 n mul 1 sub sommettourdroit
     ]
     %% coin superieur gauche
     [
        n 1 sub sommettourdroit
        n sommettourdroit
        n 1 add sommettourdroit
        n1 1 sub sommetcentredroit
     ]
     %% coin inferieur gauche
     [
        n 2 sub sommetcentredroit
        2 n mul 1 sub sommettourdroit
        2 n mul sommettourdroit
        2 n mul 1 add sommettourdroit
     ]
     %% coin inferieur droit
     [
        3 n mul 1 add sommettourdroit
        0 sommetcentredroit
        3 n mul 1 sub sommettourdroit
        3 n mul sommettourdroit
     ]
     %% bande superieure
     1 1 n 2 sub {
        /i exch def
        [
           i sommettourdroit
           i 1 add sommettourdroit
           n 1 sub n 2 sub mul i add sommetcentredroit
           n 1 sub n 2 sub mul i 1 sub add sommetcentredroit
        ]
     } for
     %% bande inferieure
     1 1 n 2 sub {
        /i exch def
        [
           i 1 sub sommetcentredroit
           i sommetcentredroit
           3 n mul 1 sub i sub sommettourdroit
           3 n mul i sub sommettourdroit
        ]
     } for
     %% descente gauche
     1 1 n 2 sub {
        /i exch def
        [
           n1 1 sub i 1 sub n 1 sub mul sub sommetcentredroit
           n i add sommettourdroit
           n i 1 add add sommettourdroit
           n1 1 sub i n 1 sub mul sub sommetcentredroit
        ]
     } for
     %% descente droite
     1 1 n 2 sub {
        /i exch def
        [
           4 n mul i sub sommettourdroit
           n 1 sub n 1 sub i sub mul sommetcentredroit
           n 1 sub n 2 sub i sub mul sommetcentredroit
           4 n mul i sub 1 sub sommettourdroit
        ]
     } for
     %% bandes interieures
     1 1 n 2 sub {
        /j exch def
        1 1 n 2 sub {
           /i exch def
           [
          n 1 sub j mul i 1 sub add sommetcentredroit
          n 1 sub j mul i add sommetcentredroit
          n 1 sub j 1 sub mul i add sommetcentredroit
          n 1 sub j 1 sub mul i 1 sub add sommetcentredroit
           ]
        } for
     } for

      ] def

      /F2 F1 {{n dup mul n add add} apply} apply def
      /F3 F2 {{n dup mul n add add} apply} apply def
      /F4 F3 {{n dup mul n add add} apply} apply def


      S1 S2 append S3 append S4 append S5 append S6 append {a mulv3d} papply3d
      F1 F2 append F3 append F4 append {{N mod} apply} apply F5 append F6 append
      generesolid
   } ifelse
end
} def

%%%%% ### newparallelepiped ### 
% 14 octobre 2006
/newparallelepiped {
2 dict begin
   /c exch 2 div def
   /b exch 2 div def
   /a exch 2 div def
   /F [
      [0 1 2 3]
      [0 4 5 1]
      [1 5 6 2]
      [2 6 7 3]
      [0 3 7 4]
      [4 7 6 5]
    ] def

    %% tableau des sommets
    /S [
       a     b     c %% 0
       a neg b     c %% 1
       a neg b neg c %% 2
       a     b neg c %% 3
       a     b     c neg %% 4
       a neg b     c neg %% 5
       a neg b neg c neg %% 6
       a     b neg c neg %% 7
    ] def
    S F generesolid
end
} def

%%%%% ### newcylindre ### 
%% syntaxe : z0 r0 z1 newcylindre -> solide
%% syntaxe : z0 r0 z1 {mode} newcylindre -> solide
%% syntaxe : z0 r0 z1 [n1 n2] newcylindre -> solide
%% syntaxe : a b {f} {u} h [n1 n2] newcylindre
/newcylindre {
2 dict begin
   [[/n2 /n1] [1 6] [1 8] [1 10] [3 12] [5 18]] gestionsolidmode
   2 copy pop xcheck {
      %% cylindre cas general
      /h exch def
      /U exch def
      U normalize3d /u defpoint3d
      /lafonction exch def
      /b exch def
      /a exch def
      /pas b a sub n1 div def
      /vpas h n2 div def
      /S [
         0 1 n2 {
            /j exch def
            0 1 n1 {
               /i exch def
               a i pas mul add lafonction
               u j vpas mul mulv3d addv3d
            } for
         } for
      ] def
      /F [
         0 1 n2 1 sub {
            /j exch def
            0 1 n1 1 sub {
               /i exch def
               [
                  i n1 1 add j mul add 
                  dup 1 add
                  dup n1 1 add add
                  dup 1 sub
               ]
            } for
         } for
      ] def
      
      S F generesolid
%      dup videsolid
   } {
      %% cylindre de revolution
      2 copy pop [n2 n1] newtronccone
   } ifelse
end
} def

%% syntaxe : z0 r0 z1 newcylindrecreux -> solide
/newcylindrecreux {
   newcylindre
   dup creusesolid
} def

%%%%% ### newtronccone ### 
%% syntaxe : z0 r0 z1 r1 newtronccone -> solid
/newtronccone {
11 dict begin
   [[/n /N] [1 6] [1 8] [1 10] [3 12] [5 18]] gestionsolidmode

   /r1 exch def
   /z1 exch def
   /r0 exch def
   /z0 exch def
   /dz z1 z0 sub n div def
   /dr r1 r0 sub n div def

   /FE [
      [0 1 N 1 sub {} for]
      [n 1 add N mul 1 sub -1 n N mul {} for]

      0 1 n 1 sub {
      /k exch def
         k N mul 1 add 1 k 1 add N mul 1 sub {
             /i exch def
             [i i 1 sub N i add 1 sub N i add]
         } for
         [k N mul k 1 add N mul 1 sub k 2 add N mul 1 sub k 1 add N mul]
      } for

   ] def

   %% tableau des sommets
   /S [
      n -1 0 {
         /k exch def
         0 1 N 1 sub {
             /i exch def
             360 N idiv i mul cos r0 dr k mul add mul
             360 N idiv i mul sin r0 dr k mul add mul
             z0 dz k mul add
         } for
      } for
   ] def
   S FE generesolid
end
} def

%% syntaxe : z0 r0 z1 r1 newtroncconecreux -> solid
/newtroncconecreux {
   newtronccone
   dup creusesolid
} def

%%%%% ### newcone ### 
%% syntaxe : z0 r0 z1 newcone -> solid
%% syntaxe : z0 r0 z1 {mode} newcone -> solid
%% syntaxe : z0 r0 z1 [n1 n2] newcone -> solid
%% syntaxe : a b {f} {sommet} [n1 n2] newcone -> solid
/newcone {
11 dict begin
   [ [/n /N] [1 6] [1 8] [1 10] [3 12] [5 18] ] gestionsolidmode
   dup xcheck {
      %% cas general
      /sommet exch def
      /lafonction exch def
      /b exch def
      /a exch def

      /pas b a sub N div def
      /S [
         sommet
         0 1 n 1 sub {
            /j exch def
            0 1 N {
               /i exch def
               a i pas mul add lafonction
               dupp3d sommet vecteur3d j n div mulv3d addv3d
            } for
         } for
         1 1 n {
            /j exch def
            0 1 N {
               /i exch def
               a i pas mul add lafonction
               sommet vecteur3d j n div mulv3d sommet addv3d
            } for
         } for
      ] def

      /F [
         %% les etages inferieurs
         0 1 n 2 sub {
            /j exch def
            1 1 N {
               /i exch def
               [
                  i j N 1 add mul add
                  dup 1 add
                  dup N add 1 add
                  dup 1 sub
               ]
            } for
         } for
         %% dernier etage inferieur
         1 1 N {
            /i exch def
            [
               i N 1 add n 1 sub mul add
               dup 1 add
               0
            ]
         } for
         %% premier etage superieur
         1 1 N {
            /i exch def
            [
               i N 1 add n mul add
               dup 1 add
               0
               exch
            ]
         } for
         %% les etages superieurs
         n 1 n 2 mul 2 sub {
            /j exch def
            1 1 N {
               /i exch def
               [
                  i j N 1 add mul add
                  dup 1 add
                  dup N add 1 add
                  dup 1 sub
               ]
            } for
         } for
      ] def

      S F generesolid
%      dup videsolid
   } {
      %% cylindre de revolution
      /z1 exch def
      /r0 exch def
      /z0 exch def
      /dz z1 z0 sub n div def
      /dr r0 n div def
   
      /F [
         %% la base
         [N 1 sub -1 0 {} for]
         %% le dernier etage
         n 1 sub N mul 1 add 1 n N mul 1 sub {
              /i exch def
              [i 1 sub i n N mul]
         } for
         [n N mul 1 sub n 1 sub N mul n N mul]
         %% les autres etages
         0 1 n 2 sub {
            /j exch def
            0 N j mul add 1 N N j mul add 2 sub {
               /i exch def
               [i i 1 add dup N add dup 1 sub]
            } for
            [N N j mul add 1 sub N j mul dup N add dup N add 1 sub]
         } for
      ] def
   
      %% tableau des sommets
      /S [
         %% etage no j (in [1; n])
         0 1 n 1 sub {
            /j exch def
            0 1 N 1 sub {
                /i exch def
                360 N idiv i mul cos r0 dr j mul sub mul
                360 N idiv i mul sin r0 dr j mul sub mul
                z0 dz j mul add
            } for
         } for
         0 0 z1
      ] def
      S F generesolid
   } ifelse
end
} def

%% %% syntaxe : z0 r0 z1 newconecreux -> solid
 /newconecreux {
    newcone
    dup 0 solidrmface
    dup videsolid
 } def

%%%%% ### newtore ### 
%% syntaxe : r R newtore -> solid
/newtore {
10 dict begin
   [[/n1 /n2] [4 5] [6 10] [8 12] [9 18] [18 36]] gestionsolidmode
   /n2 n2 3 max store
   /n1 n1 2 max store
   /R exch def
   /r exch def
   /S [
         0 1 n1 1 sub {
            /i exch def
            360 n1 div i mul cos r mul R add
            360 n1 div i mul sin r mul
         } for
      ]
   def
   S [n2] newanneau
end
} def

%%%%% ### newprisme ### 
%% syntaxe : array z0 z1 newprisme -> solid d axe (O, u),
/newprismedroit {
   [[/N] [1] [1] [1] [3] [6]] gestionsolidmode
   0 0 1 [N] newprisme
} def

%% syntaxe : array z0 z1 u newprisme -> solid d axe (O, u),
%% ou array tableau de points 2d
/newprisme {
7 dict begin
   [[/N] [1] [1] [1] [3] [6]] gestionsolidmode
   dup 0 eq {
      (Error : 3eme composante nulle dans le vecteur pour newprisme) ==
      quit
   } if
   /u defpoint3d
   /z1 exch def
   /z0 exch def
   %% N = nb d etages
   /table exch def
   %% n = indice du dernier point
   /n table length 2 idiv 1 sub def
   %% vecteur de translation
   u
   z1 z0 sub u norme3d div
   mulv3d /v defpoint3d

   %% tableau des sommets
   /S [
      0 1 N {
         /j exch def
         0 1 n {
             /i exch def
             table i getp
             z0
             v N j sub N div mulv addv3d
         } for
      } for
   ] def

   /F [ 
      %% face superieure
      [0 1 n {} for]
      %% base
      [N 1 add n 1 add mul 1 sub -1 N n 1 add mul {} for]
      %% faces etage
      1 1 N {
         /j exch def
         1 1 n {
             /i exch def
             [i                   j 1 sub n 1 add mul add
              i 1 sub             j 1 sub n 1 add mul add
              n 1 add i add 1 sub j 1 sub n 1 add mul add
              n 1 add i add       j 1 sub n 1 add mul add]
         } for
         [0            j 1 sub n 1 add mul add
         n             j 1 sub n 1 add mul add
         2 n mul 1 add j 1 sub n 1 add mul add
         n 1 add       j 1 sub n 1 add mul add]
     } for
   ] def

   S F generesolid
end
} def

%%%%% ### newsphere ### 
%% syntaxe : r option newsphere -> solid
/newsphere {
2 dict begin
   [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
   -90 90 [K N] newcalottesphere
end
} def

%% syntaxe : r phi theta option newcalottesphere -> solid
/newcalottesphere {
6 dict begin
   [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode

   %% test de beta (ex-theta)
   dup 90 eq {
      /beta exch def
      /idebut 1 def
   } {
      /beta exch 80 min -80 max def
      /idebut 0 def
   } ifelse
   %% test de alpha (ex-phi)
   dup -90 eq {
      /alpha exch def
   } {
      /alpha exch beta min -80 max def
   } ifelse
   /r exch def
   beta 90 eq {
       alpha -90 eq {
           /ifin K def
          /db alpha beta sub K 1 add div def
       } {
           /ifin K def
          /db alpha beta sub K div def
       } ifelse
   } {
       alpha -90 eq {
           /ifin K 1 sub def
          /db alpha beta sub K div def
       } {
           /ifin K 1 sub def
          /db alpha beta sub K 1 sub div def
       } ifelse
   } ifelse

   %% nombre de sommets -2
   /nb N K mul def

   %% tableau des sommets
   /S [
       idebut 1 ifin {
           /j exch def
           /phi beta j db mul add def
           phi cos r mul /r_tmp exch def
           0 1 N 1 sub {
                /i exch def
                360 N idiv i mul cos r_tmp mul
                360 N idiv i mul sin r_tmp mul
                phi sin r mul
            } for
       } for
      0 0 r neg
      0 0 r
   ] def

   /F [
     %% calotte inferieure
     alpha -90 eq {
         1 1 N 1 sub {
         /i exch def
            [
                nb
                nb i sub
                nb i 1 add sub
            ]
         } for
         [nb nb N sub nb 1 sub]
     } {
        [nb 1 sub -1 nb N sub {} for ]
     } ifelse

     %% calotte superieure
     beta 90 eq {
         0 1 N 1 sub {
            /i exch def
             [i i 1 add N mod N K mul 1 add]
         } for
      } {
         [0 1 N 1 sub {} for]
      } ifelse

     1 1 K 1 sub {
          /j exch def
       [
           j N mul
           j N mul 1 add
           j 1 sub N mul 1 add
           j 1 sub N mul
       ]
       N 2 sub {dup {1 add} apply} repeat
       [
           j 1 add N mul 1 sub
           j N mul
           j 1 sub N mul
           j N mul 1 sub
       ]
    } for
   ] def

   S F generesolid
end
} def

%% syntaxe : r phi theta option newcalottespherecreuse -> solid
/newcalottespherecreuse {
6 dict begin
   [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode

   %% test de beta (ex-theta)
   dup 90 eq {
      /beta exch def
      /idebut 1 def
   } {
      /beta exch 80 min -80 max def
      /idebut 0 def
   } ifelse
   %% test de alpha (ex-phi)
   dup -90 eq {
      /alpha exch def
   } {
      /alpha exch beta min -80 max def
   } ifelse
   /r exch def
   beta 90 eq {
       alpha -90 eq {
           /ifin K def
          /db alpha beta sub K 1 add div def
       } {
           /ifin K def
          /db alpha beta sub K div def
       } ifelse
   } {
       alpha -90 eq {
           /ifin K 1 sub def
          /db alpha beta sub K div def
       } {
           /ifin K 1 sub def
          /db alpha beta sub K 1 sub div def
       } ifelse
   } ifelse

   %% nombre de sommets -2
   /nb N K mul def

   %% tableau des sommets
   /S [
       idebut 1 ifin {
           /j exch def
           /phi beta j db mul add def
           phi cos r mul /r_tmp exch def
           0 1 N 1 sub {
                /i exch def
                360 N idiv i mul cos r_tmp mul
                360 N idiv i mul sin r_tmp mul
                phi sin r mul
            } for
       } for
      0 0 r neg
      0 0 r
   ] def

   /F [
     %% calotte inferieure
     alpha -90 eq {
         1 1 N 1 sub {
         /i exch def
            [
                nb
                nb i sub
                nb i 1 add sub
            ]
         } for
         [nb nb N sub nb 1 sub]
     } {
%        [nb 1 sub -1 nb N sub {} for ]
     } ifelse

     %% calotte superieure
     beta 90 eq {
         0 1 N 1 sub {
            /i exch def
             [i i 1 add N mod N K mul 1 add]
         } for
      } {
%         [0 1 N 1 sub {} for]
      } ifelse

     1 1 K 1 sub {
          /j exch def
       [
           j N mul
           j N mul 1 add
           j 1 sub N mul 1 add
           j 1 sub N mul
       ]
       N 2 sub {dup {1 add} apply} repeat
       [
           j 1 add N mul 1 sub
           j N mul
           j 1 sub N mul
           j N mul 1 sub
       ]
    } for
   ] def

   S F generesolid
   dup videsolid
end
} def

%%%%% ### newanneau ### 
%% syntaxe : array n newanneau --> solid
%% syntaxe : array {mode} newanneau --> solid
%% ou array est un tableau de points de R^2 et n un nombre entier positif
/newanneau {
10 dict begin
   dup isnum {
      /n exch def
      [n]
   } if
   [[/n2] [6] [12] [24] [32] [36]] gestionsolidmode
   /n2 n2 3 max store
   %% on plonge la section dans R^3 par projection sur yOz
   /S1 exch {0 3 1 roll} papply def
   %% nombre de sommets
   /n1 S1 length 3 idiv def

   /S S1
      n2 {
         duparray
         {0 0 360 n2 div rotateOpoint3d} papply3d
      } repeat
      n2 {append} repeat
   def

   /F [
      0 1 n2 1 sub {
         /j exch def
         n1 j mul 1 j 1 add n1 mul 2 sub {
            /i exch def
            [i 1 add i dup n1 add i n1 1 add add]
         } for
         [n1 j mul j 1 add n1 mul 1 sub j 2 add n1 mul 1 sub j 1 add n1 mul]
      } for
   ] def

   S F generesolid
end
} def

%%%%% ### newvecteur ### 
%% syntaxe : x y z newvecteur
%% syntaxe : x y z array newvecteur
/newvecteur {
4 dict begin
   dup isarray {
      /table exch def
      /h@uteur table 1 get def
      /r@y@n table 0 get def
   } {
      /h@uteur .3 def
      /r@y@n .1 def
   } ifelse
   /A defpoint3d
   %%Sommets
   /S [0 0 0 A] def
   /F [
      [0 1]
   ] def
   S F generesolid
   [ A ]
   normalvect_to_orthobase
   /imK defpoint3d
   /imJ defpoint3d
   /imI defpoint3d

   A norme3d /z exch h@uteur sub def 
   0 r@y@n h@uteur [1 8] newcone
   dup (noir) outputcolors
   {0 0 z translatepoint3d} solidtransform
   {imI imJ imK transformpoint3d} solidtransform
   solidfuz
end
} def

%%%%% ### readsolidfile ###
%% syntaxe : str readsolidfile -> solid
/readsolidfile {
1 dict begin
   /str exch def
   [str (-sommets.dat) append run] 
   [str (-faces.dat) append run]
   generesolid
   dup [str (-couleurs.dat) append run] solidputfcolors
   dup [str (-io.dat) append run] solidputinouttable
end
} def

%%%%% ### writesolidfile ###
%% syntaxe : solid str writesolidfile -> -
/writesolidfile {
10 dict begin
   /str exch def
   /solid exch def
   solid issolid not {
      (Error : mauvais type d argument dans writesolidfile) ==
      quit
   } if
   str (-sommets.dat) append (w) file /lefichiersommets exch def
   str (-faces.dat) append (w) file /lefichierfaces exch def
   str (-couleurs.dat) append (w) file /lefichiercouleurs exch def
   str (-io.dat) append (w) file /lefichierio exch def

   /S solid solidgetsommets def
   0 1 S length 3 idiv 1 sub {
      /i exch def
      solid i solidgetsommet
      /z exch def
      /y exch def
      /x exch def
      lefichiersommets x chaine cvs writestring
      lefichiersommets 32 write %% espace
      lefichiersommets y chaine cvs writestring
      lefichiersommets 32 write %% espace
      lefichiersommets z chaine cvs writestring
      lefichiersommets 10 write %% CR
   } for
   lefichiersommets closefile

   /F solid solidgetfaces def
   0 1 F length 1 sub {
      /i exch def
      /Fi solid i solidgetface def
      lefichierfaces 91 write %% [
      0 1 Fi length 1 sub {
         /j exch def
         lefichierfaces Fi j get chaine cvs writestring
         lefichierfaces 32 write %% espace
      } for
      lefichierfaces 93 write %% ]
      lefichierfaces 10 write %% CR
   } for
   lefichierfaces closefile

   /C solid solidgetfcolors def
   0 1 C length 1 sub {
      /i exch def
      lefichiercouleurs 40 write %% (
      lefichiercouleurs C i get writestring
      lefichiercouleurs 41 write %% )
      lefichiercouleurs 10 write %% CR
   } for
   lefichiercouleurs closefile

   /IO solid solidgetinouttable def
   0 1 3 {
      /i exch def
      lefichierio IO i get chaine cvs writestring
      lefichierio 32 write %% space
   } for
   lefichierio closefile
end
} def

%%%%% ### writeobjfile ###
%% syntaxe : solid str writeobjfile -> -
/writeobjfile {
10 dict begin
   /str exch (.obj) append def
   /solid exch def
   solid issolid not {
      (Erreur : mauvais type d argument dans writeobjfile) ==
      quit
   } if
   /n solid solidnombresommets def
   str (w) file /lefichier exch def
   0 1 n 1 sub {
      /i exch def
      solid i solidgetsommet
      /z exch def
      /y exch def
      /x exch def
      lefichier (v ) writestring
      lefichier x chaine cvs writestring
      lefichier 32 write %% espace
      lefichier y chaine cvs writestring
      lefichier 32 write %% espace
      lefichier z chaine cvs writestring
      lefichier 10 write %% CR
   } for
   /n solid solidnombrefaces def
   0 1 n 1 sub {
      /i exch def
      lefichier (f ) writestring
      /F solid i solidgetface {1 add} apply def
      F {
         lefichier exch
         chaine cvs writestring
         lefichier  32  write %% espace
      } apply
      lefichier  10  write %% CR
   } for
   lefichier closefile
end
} def

%%%%% ### writeofffile ###
%% syntaxe : solid str writeobjfile -> -
/writeofffile {
12 dict begin
   /str exch (.off) append def
   /solid exch def
   solid issolid not {
      (Erreur : mauvais type d argument dans writeofffile) ==
      quit
   } if
   /n solid solidnombresommets def
   /nf solid solidnombrefaces def
   str (w) file /lefichier exch def
   lefichier (OFF) writestring
   lefichier 10 write %% CR
   lefichier n chaine cvs writestring
   lefichier 32 write %% espace
   lefichier nf chaine cvs writestring
   lefichier 32 write %% espace
   lefichier 0 chaine cvs writestring
   lefichier 10 write %% CR
   0 1 n 1 sub {
      /i exch def
      solid i solidgetsommet
      /z exch def
      /y exch def
      /x exch def
      lefichier x chaine cvs writestring
      lefichier 32 write %% espace
      lefichier y chaine cvs writestring
      lefichier 32 write %% espace
      lefichier z chaine cvs writestring
      lefichier 10 write %% CR
   } for
   0 1 nf 1 sub {
      /i exch def
      /F solid i solidgetface def
      lefichier F length chaine cvs writestring
      lefichier 32 write %% espace
      F {
         lefichier exch
         chaine cvs writestring
         lefichier  32  write %% espace
      } apply
      lefichier  10  write %% CR
   } for
   lefichier closefile
end
} def

%%%%% ### newobjfile ###
/newobjfile {
3 dict begin
   /objfilename exch (.obj) append def
   /v {} def
   /ok true def
   /f {
       ok {
        %% 1ere fois
           ] %% ferme les sommets
        [ [ %% ouvre les faces
        /ok false store
       } {
        %% les autres fois
           ] %% ferme la face
        [ %% ouvre la nouvelle
       } ifelse
   } def
   [ 0 0 0 %% sommet fantome pour respecter l'indexation (a partir de l'indice 1)
   objfilename run
   ]]
   /F exch def
   /S exch def

   S F generesolid
%   dup videsolid
end
} def

%%%%% ### newofffile ###
/newofffile {
3 dict begin
   /str 35 string def
   /offfilename exch (.off) append def
   offfilename (r) file
   /offfile exch def
   offfile str readline pop pop
   offfile str readline pop
   numstr2array
   dup 0 get /ns exch def
   1 get /nf exch def
   [ns {
      offfile str readline pop numstr2array aload pop
%      3 1 roll
   } repeat]
   /S exch def
   [nf {
      [
      offfile str readline pop numstr2array
      /table exch def
      1 1 table length 1 sub {
         /i exch def
         table i get
      } for
      ]
   } repeat]
   /F exch def

   S F generesolid
%   dup videsolid
end
} def

%%%%% ### newtube ###
 /tub@dernierk1 [1 0 0] def
 /tub@dernierk2 [0 1 0] def
 /tub@dernierk3 [0 0 1] def

/inittube {
2 dict begin
   normalize3d /vect3 defpoint3d
   normalize3d /vect2 defpoint3d
   normalize3d /vect1 defpoint3d
   vect1 norme3d 0 eq {
      vect2 vect3 vectprod3d /vect1 defpoint3d
   } if
   vect2 norme3d 0 eq {
      vect3 vect1 vectprod3d /vect2 defpoint3d
   } if
   vect3 norme3d 0 eq {
      vect1 vect2 vectprod3d /vect3 defpoint3d
   } if
   /tub@dernierk1 [vect1] store
   /tub@dernierk2 [vect2] store
   /tub@dernierk3 [vect3] store
end
} def
 
%% syntaxe : tmin tmax (f) array r newtube -> solid
%% array = [K N]
/newtube {
10 dict begin
   /table exch def
   /K table 0 get def %% nb d etages
   /N table 1 get def %% nb de points sur le perimetre
   /@r exch def       %% le rayon du tube
   /str exch def
   /lafonction str cvx def
   /laderivee str (') append cvx def
%%   /laderivee2nd str ('') append cvx def
   /tmax exch def
   /tmin exch def
   /pas tmax tmin sub K 1 sub div def

   %% definition des sommets
   [
   /@k 0 def
   K {
      /a0 tmin @k pas mul add def
   
      %% definition du repere de Frenet (k1, k2, k3) au point f(a)
      a0 lafonction /M defpoint3d

      str (') append cvlit where {
         pop 
         a0 laderivee normalize3d /k1 defpoint3d
%         pop /avecderiv true def
      } {
         M a0 pas 100 div add lafonction vecteur3d normalize3d /k1 defpoint3d
%         /avecderiv false
      } ifelse

      k1 baseplannormal /K3 defpoint3d /K2 defpoint3d
%      a0 laderivee2nd normalize3d /k2 defpoint3d

      %% projete orthogonal du dernier rayon sur le plan actuel
      %% (normal a la vitesse)
      K2 tub@dernierk2 aload pop K2 scalprod3d mulv3d 
      K3 tub@dernierk2 aload pop K3 scalprod3d mulv3d addv3d /k2 defpoint3d
%      M k1 K2 K3 dessinebase
      k1 norme3d 0 eq {
         tub@dernierk1 aload pop /k1 defpoint3d
      } {
         /tub@dernierk1 [k1] store
      } ifelse
      k2 norme3d 0 eq {
         tub@dernierk2 aload pop /k2 defpoint3d
      } {
         /tub@dernierk2 [k2] store
      } ifelse
      k1 k2 vectprod3d normalize3d /k3 defpoint3d
      k3 norme3d 0 eq {
          tub@dernierk3 aload pop /k3 defpoint3d
      } {
         /tub@dernierk3 [k3] store
      } ifelse
      k3 k1 vectprod3d normalize3d /k2 defpoint3d
%%      M k1 k2 k3 dessinebase
      /tub@dernierk2 [k2] store
      /@n 360 N div def %% le pas angulaire
      0 @n 360 @n sub {
         /@i exch def
         M
         k2 @i cos @r mul mulv3d addv3d
         k3 @i sin @r mul mulv3d addv3d
      } for
      /@k @k 1 add store
   } repeat
   ]

   dup length 3 idiv /nb exch def
   %% definition des faces
   [
      %% face de depart
      [N 1 sub -1 0 {} for]
      %% face d arrivee
      [nb 1 sub N 1 sub {dup 1 sub} repeat] reverse
   
      %% les etages
      /j 0 def
      K 1 sub {
         0 1 N 1 sub {
            /i exch def
            [
               i                   N j mul add
               i 1 add N mod       N j mul add
               i 1 add N mod N add N j mul add
               i N add             N j mul add
            ]
         } for
         /j j 1 add store
      } repeat
   ]
   generesolid
end
} def

%%%%% ### newcourbe ###
%% syntaxe : a b {f} array newcourbe --> solid
/newcourbe {
10 dict begin
   dup xcheck not {
      0 get /n exch def
   } {
      /n 80 def
   } ifelse
   /l@f@nct exch def
   /b exch def
   /a exch def
   /pas b a sub n 1 sub div def
   /S [
   0 1 n 1 sub {
      /@i exch def
      a @i pas mul add
      l@f@nct
      pstrickactionR3
   } for
   ] def
   /@F [
      0 1 n 2 sub {
         /@i exch def
         [@i @i 1 add]
      } for
   ] def
   S @F generesolid
end
} def

%%%%% ### baseplannormal ###
%% syntaxe : x y z baseplannormal -> x1 y1 z1 x2 y2 z2
/baseplannormal {
5 dict begin
   /K defpoint3d
   1 0 0 K vectprod3d normalize3d /U defpoint3d
   U norme3d 0 eq {
      0 1 0 K vectprod3d normalize3d /U defpoint3d
   } if
   K U vectprod3d normalize3d /V defpoint3d
   U V
end
} def

%%%%% ### fin insertion ###

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%                                                    %%%%
%%%%      fin insertion librairie jps                   %%%%
%%%%                                                    %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%          gestion de chaine de caracteres           %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/Times-Roman findfont 
dup length dict begin
   {
   1 index /FID ne 
      {def}
      {pop pop} 
   ifelse
   } forall
   /Encoding ISOLatin1Encoding def
   currentdict
end
/Times-Roman-ISOLatin1 exch definefont pop

/setTimesRoman {
   /Times-Roman-ISOLatin1 findfont 
   fontsize scalefont 
   setfont
} def

/setTimes {
   setTimesRoman
} def

%% syntaxe : string x y cctext
/cctext {
5 dict begin
   /y exch def
   /x exch def
   /str exch def
   str stringwidth
   /wy exch def
   /wx exch def
   gsave
      x y smoveto
      wx -2 div wy -2 div rmoveto
      str show
   grestore
end
} def

/dbtext {gsave newpath dbtext_ Fill grestore} def
/dctext {gsave newpath dctext_ Fill grestore} def
/dltext {gsave newpath dltext_ Fill grestore} def
/drtext {gsave newpath drtext_ Fill grestore} def

/bbtext {gsave newpath bbtext_ Fill grestore} def
/bctext {gsave newpath bctext_ Fill grestore} def
/bltext {gsave newpath bltext_ Fill grestore} def
/brtext {gsave newpath brtext_ Fill grestore} def

/cbtext {gsave newpath cbtext_ Fill grestore} def
/cctext {gsave newpath cctext_ Fill grestore} def
/cltext {gsave newpath cltext_ Fill grestore} def
/crtext {gsave newpath crtext_ Fill grestore} def

/ubtext {gsave newpath ubtext_ Fill grestore} def
/uctext {gsave newpath uctext_ Fill grestore} def
/ultext {gsave newpath ultext_ Fill grestore} def
/urtext {gsave newpath urtext_ Fill grestore} def


%% syntaxe : str x y show_dim --> str x y llx lly wx wy 
%% attention, doit laisser la pile intacte
/show_dim {
   3 copy pop pop
   newpath
      0 0 moveto
      true charpath flattenpath pathbbox 
   closepath
   newpath
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             procedures pour PSTricks               %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% les 3 procedures utilisees pour transformer les depots de AlgToPs en nombres
/pstrickactionR3 { 
3 dict begin 
  /len@3 exch def 
  /len@2 exch def 
  /len@1 exch def 
  len@1 exec 
  len@2 exec 
  len@3 exec 
end 
} def 

/pstrickactionR2 {
   exec exch exec exch
} def

/pstrickactionR {
   exec
} def

/gere_pst-deffunction {
   counttomark
   dup 1 eq {
      pop
      pstrickactionR
      ] aload pop
   } {
      2 eq {
         pstrickactionR2
         ] aload pop
      } {
         pstrickactionR3
         ] aload pop
      } ifelse
   } ifelse
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%             procedures pour \psSolid               %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/all (all) def

/draw {drawsolid} def
/draw* {drawsolid*} def
/draw** {drawsolid**} def
/writeobj {solidfilename writeobjfile} def
/writesolid {solidfilename writesolidfile} def
/writeoff {solidfilename writeofffile} def
/none {pop} def
/vecteur_en_c@urs false def

/gere_pstricks_color_inout {
   gsave
      dup  [fillincolor] (setrgbcolor) astr2str
         [fillcolor] (setrgbcolor) astr2str inoutputcolors
   grestore
} def

/gere_pstricks_color_out {
   gsave
      dup  [fillcolor] (setrgbcolor) astr2str outputcolors
   grestore
} def

/gere_pstfont {
   fontsize mul setfontsize
   %setTimes
   PSfont dup /Symbol ne isolatin and {
      /ISO-Font ReEncode /ISO-Font
   } if
   findfont fontsize scalefont setfont
} def

/gere_pstricks_opt {
%   /CourbeR2 {CourbeR2+} def
   1 gere_pstfont
   linecolor
   linestyle
   solidlinewidth setlinewidth
   solidtrunc length 0 ne {
      solidtrunc 0 get isstring {
         dup trunccoeff solidtronque
      } {
         dup solidtrunc trunccoeff solidtronque
      } ifelse
   } if
   solidgeode {
      1 newgeode
   } if
   soliddualreg {
      dualpolyedreregulier
   } if
   chanfrein {
      dup chanfreincoeff solidchanfreine
   } if
   RotX 0 ne RotY 0 ne or RotZ 0 ne or {
      {RotX RotY RotZ rotateOpoint3d} solidtransform
   } if
   CX 0 ne CY 0 ne or CZ 0 ne or {
      {CX CY CZ translatepoint3d} solidtransform
   } if
   plansection length 0 gt {
      0 1 plansection length 1 sub {
         /i exch def
         plansection i get solidplansection
         dup 0 solidrmface
      } for
   } if
   /rmfaces rmfaces bubblesort reverse store
   0 1 rmfaces length 1 sub {
      /i exch def
      dup rmfaces i get solidrmface
   } for
   tx@Dict /pst-transformoption known {
      dup {pst-transformoption} solidtransform 
   } if
   solidaffinage length 0 ne {
      %% si on affine, il faut colorier avant
      activationgestioncouleurs {
         gere_pstricks_color_out
      } if
      solidaffinage 0 get isstring {
         dup affinagecoeff
         /solidfcolor where {
            pop
            solidfcolor
         } if
         affinagerm solidaffine
      } {
         dup affinagecoeff solidaffinage
         /solidfcolor where {
            pop
            solidfcolor
         } if
         affinagerm solidaffine
      } ifelse
      %% et il faut evider et coloriier l'interieur si necessaire
      solidhollow {
         dup videsolid
         activationgestioncouleurs {
            gsave
               dup  [fillincolor] (setrgbcolor) astr2str inputcolors
            grestore
         } if
      } if
      /activationgestioncouleurs false def
   } if
   tx@Dict /plansepare known {
      plansepare solidplansepare
      tx@Dict /plansepare undef
      tx@Dict /solidname known {
         solidname (1) append cvlit exch def
         dup solidname (0) append cvlit exch def
         %%
         solidname (1) append cvx exec
         solidhollow {
            dup videsolid
         } if
         activationgestioncouleurs {
            dup solidwithinfaces {
               gere_pstricks_color_inout 
            } {
               gere_pstricks_color_out
            } ifelse
         } if
         solidinouthue length 0 gt { 
            dup solidinouthue solidputinouthuecolors 
         } {
            solidhue length 0 gt {
               dup solidhue solidputhuecolors
            } if
            solidinhue length 0 gt {
               dup solidinhue solidputinhuecolors
            } if
         } ifelse
         pop
         tx@Dict /solidname undef
      } {
         /solid1 exch def
         /solid2 exch def
      } ifelse
   } if
   solidhollow {
      dup videsolid
   } if
   activationgestioncouleurs {
      zcolor length 0 ne {
         dup zcolor tablez solidcolorz 
      } {
         dup solidwithinfaces {
            gere_pstricks_color_inout 
         } {
            gere_pstricks_color_out
         } ifelse
         solidinouthue length 0 gt { 
            dup solidinouthue solidputinouthuecolors 
         } {
            solidhue length 0 gt {
               dup solidhue solidputhuecolors
            } if
            solidinhue length 0 gt {
               dup solidinhue solidputinhuecolors
            } if
         } ifelse
      } ifelse
   } {
      /activationgestioncouleurs true def
   } ifelse

   0 1 fcol length 2 idiv 1 sub {
      /i exch def 
      dup fcol 2 i mul get fcol 2 i mul 1 add get solidputfcolor
   } for
   vecteur_en_c@urs not {
      /lightsrc where {pop solidlightOn} if
   } {
      /vecteur_en_c@urs false def
   } ifelse
   dup action cvx exec
   noir
   solidnumf length 0 ne {
      solidnumf 0 get isstring {
         dup projectionsifacevisible solidnumfaces
      } {
         dup solidnumf projectionsifacevisible solidnumfaces
      } ifelse
   } if
   solidshow length 0 ne {
      solidshow 0 get isstring {
         dup solidshowsommets
      } {
         dup solidshow solidshowsommets
      } ifelse
   } if
   solidnum length 0 ne {
      solidnum 0 get isstring {
         .8 gere_pstfont
         dup solidnumsommets
      } {
         dup solidnum solidnumsommets
      } ifelse
   } {
      %% pop
   } ifelse
   tx@Dict /solidname known {
      solidname cvlit exch bind def
      tx@Dict /solidname undef
   } {
      pop
   } ifelse
} def

/pst-octahedron {
   a newoctaedre
   gere_pstricks_opt
} def

/pst-dodecahedron {
   a newdodecaedre
   gere_pstricks_opt
} def

/pst-icosahedron {
   a newicosaedre
   gere_pstricks_opt
} def

/pst-cube {
   a
   ngrid length 1 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newcube 
%%    solidhollow {
%%       dup videsolid
%%    } if
   gere_pstricks_opt
} def

/pst-parallelepiped {
   a b c
   newparallelepiped
   gere_pstricks_opt
} def

/pst-tetrahedron {
   r newtetraedre
   gere_pstricks_opt
} def

/pst-tore {
   r0 r1
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newtore
   gere_pstricks_opt
} def

/pst-sphere {
   % rayon
   % mode
  %   r {Mode} newsphere
   r
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newsphere
   gere_pstricks_opt
} def
%
/pst-cylindre {
   /save-cylinderhollow solidhollow def
   tx@Dict /function known {
      range aload pop function cvx {axe} h ngrid newcylindre
      tx@Dict /function undef
      /solidhollow true def
   } {
      % rayon
      % mode
      0 r h
      ngrid length 2 eq {
         ngrid
      } {
         {Mode}
      } ifelse
      newcylindre
      solidhollow {
         dup creusesolid
      } if
   } ifelse
   gere_pstricks_opt
   /solidhollow save-cylinderhollow store
} def
%
/pst-cylindrecreux {
   % rayon
   % mode
   0 r h
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newcylindre
   dup creusesolid
   gere_pstricks_opt
} def

/pst-cone {
   /save-conehollow solidhollow def
   tx@Dict /function known {
      range aload pop function cvx {origin} ngrid newcone
      tx@Dict /function undef
      /solidhollow true def
   } {
      % rayon
      % mode
      0 r h
      ngrid length 2 eq {
         ngrid
      } {
         {Mode}
      } ifelse
      solidhollow {
         newconecreux
      } {
         newcone
      } ifelse
   } ifelse
   gere_pstricks_opt
   /solidhollow save-conehollow store
} def

/pst-tronccone {
   % rayon
   % mode
   0 r0 h r1
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   solidhollow {
      newtroncconecreux
   } {
      newtronccone
   } ifelse
   gere_pstricks_opt
} def

/pst-troncconecreux {
   % rayon
   % mode
   0 r0 h r1
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newtroncconecreux
   gere_pstricks_opt
} def

/pst-conecreux {
   % rayon
   % mode
   0 r h
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newconecreux
   gere_pstricks_opt
} def

/pst-anneau {
   [ section ]
   ngrid length 1 ge {
      [ngrid 0 get]
   } {
      [24]
   } ifelse
   newanneau
   gere_pstricks_opt
} def


/pst-prisme {
   % tableau des points de la base
   % h hauteur du prisme
   % axe : vecteur direction de l axe
   base decal rollparray
   0 h axe
   ngrid length 1 ge {
      [ngrid 0 get]
   } if
   newprisme
   solidhollow {
      dup creusesolid
   } if
   gere_pstricks_opt
} def

/pst-prismecreux {
   % tableau des points de la base
   % h hauteur du prisme
   % axe : vecteur direction de l axe
   base
   0 h axe
   ngrid length 1 ge {
      [ngrid 0 get]
   } if
   newprisme
   dup creusesolid
   gere_pstricks_opt
} def

/pst-grille {
   base aload pop
   ngrid length 2 ge {
      [ngrid 0 get ngrid 1 get]
   } {
      ngrid length 1 eq {
         [ngrid 0 get dup]
      } if
   } ifelse
   newgrille
   gere_pstricks_opt
} def

%% syntaxe : array N h u newruban -> solid d axe (O, u),
/pst-ruban {
   % tableau des points de la base
   % h hauteur du prisme
   % axe : vecteur direction de l axe
   base
   h axe 
   ngrid length 1 ge {
      [ngrid 0 get]
   } if
   newruban
   gere_pstricks_opt
} def

%% syntaxe : r phi option newcalottesphere -> solid
/pst-calottesphere {
   % rayon
   % mode
   % r phi theta option newcalottesphere
   r
   phi theta
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   solidhollow {
      newcalottespherecreuse
   } {
      newcalottesphere
   } ifelse
   gere_pstricks_opt
} def

%% syntaxe : r phi option newcalottesphere -> solid
/pst-calottespherecreuse {
   % rayon
   % mode
   % r phi theta option newcalottespherecreuse
   r
   phi theta
   ngrid length 2 eq {
      ngrid
   } {
      {Mode}
   } ifelse
   newcalottespherecreuse
   gere_pstricks_opt
} def

/pointtest{2 2 2} def

/pst-face {
   % tableau des points de la base
   % h hauteur du prisme
   % axe : vecteur direction de l axe
   base
   solidbiface {
      newbiface
   } {
      newmonoface 
   } ifelse
   gere_pstricks_opt
} def

/pst-Surface {
   base
   base aload pop
   ngrid length 2 ge {
      [ngrid 0 get ngrid 1 get]
   } {
      ngrid length 1 eq {
         [ngrid 0 get dup]
      } ifelse
   } ifelse
   {f} newsurface
   solidbiface {
      dup videsolid
   } if
   gere_pstricks_opt
} def

/pst-surface {
   base
   base aload pop
   ngrid length 2 ge {
      [ngrid 0 get ngrid 1 get]
   } {
      ngrid length 1 eq {
         [ngrid 0 get dup]
      } ifelse
   } ifelse
   { function cvx exec } newsurface
   solidbiface {
      dup videsolid
   } if
   gere_pstricks_opt
} def

/pst-polygoneregulier {
   r ngrid 0 get
   newpolreg
   solidbiface {
   } {
      dup 1 solidrmface
   } ifelse
   gere_pstricks_opt
} def

/pst-fusion {
1 dict begin
   /activationgestioncouleurs false def
   /n base length def
   base aload pop n 1 sub {solidfuz} repeat
   gere_pstricks_opt
end
} def

/pst-new {
   sommets faces
   generesolid
%%    solidhollow {
%%       dup videsolid
%%    } if
   gere_pstricks_opt
} def

/pst-courbe {
   solidlinewidth setlinewidth
   r 0 eq {
      range aload pop function cvx [resolution] newcourbe
      gere_pstricks_opt
   } {
      range aload pop function r
      ngrid length 2 lt {
         [300 4]
      } {
         ngrid
      } ifelse
      newtube
      gere_pstricks_opt %% r function [36 12] newtube
   } ifelse
} def
%
/pst-surfaceparametree {
   base aload pop
   ngrid length 2 ge {
      [ngrid 0 get ngrid 1 get]
   } {
      ngrid length 1 eq {
         [ngrid 0 get dup]
      } if
   } ifelse
   { function cvx exec } newsurfaceparametree
   dup videsolid
   gere_pstricks_opt
   tx@Dict /function undef
} def
%
/pst-surface* {
   r
   ngrid length 2 ge {
      [ngrid 0 get ngrid 1 get]
   } {
      ngrid length 1 eq {
         [ngrid 0 get dup]
      } if
   } ifelse
   { function cvx exec } newsurface*
   dup videsolid
   gere_pstricks_opt
} def

/pst-vecteur {
gsave
   /activationgestioncouleurs false def
   /vecteur_en_c@urs true def
   solidlinewidth setlinewidth
   2 setlinejoin
   1 setlinecap
   linecolor
   linestyle
   tx@Dict /solidname known {
      args definition cvx exec
      solidname cvlit defpoint3d
      tx@Dict /solidname undef
   } if
   args definition cvx exec newvecteur
   dup
   gsave
      [linecolor currentrgbcolor] ( ) astr2str (setrgbcolor) append 
      outputcolors
   grestore
   gere_pstricks_opt
grestore
} def

%/pst-vect- {} def
%/pst-vect-2points {vecteur3d} def
/pst-line {
   gsave
      linestyle 
      linecolor
      [args] ligne3d
   grestore
} def

/pst-objfile {
   solidfilename newobjfile
   gere_pstricks_opt
} def

/pst-offfile {
   solidfilename newofffile
   gere_pstricks_opt
} def

/pst-datfile {
   solidfilename readsolidfile
%   /activationgestioncouleurs false def
   gere_pstricks_opt
} def

/pst-plantype {
%   args definition
   args (pst-plan-) definition append cvx exec
   dup phi rotateplan
   base length 4 eq {
      dup base planputrange
   } if
   origin eqpl@n pointeqplan 0 eq {
      dup origin planputorigine
   } if
   ngrid length 0 ne {
      dup ngrid planputngrid
   } if
   tx@Dict /solidname known {
      solidname cvlit exch bind def
      tx@Dict /solidname undef
   } {
      pop
   } ifelse
} def
/pst-plan- {pst-plan-plantype} def

%x0 y0 z0 [normalvect] norm2plan
/pst-plan-plantype {
   dup plan2eq /eqpl@n exch def
   /plan-@k true def
} def

/pst-plan {
%   args definition
   args (pst-plan-) definition append cvx exec
   /pl@n-en-cours true def
   definition length 0 ne {
%   plan-@k not {
      dup
      base 0 get base 1 get lt
      base 2 get base 3 get lt and {
         base
      } {
         [-3 3 -2 2] %pop base %aload pop boum
      } ifelse
      planputrange
      origin eqpl@n pointeqplan 0 eq {
         dup origin planputorigine
      } if
      CX isreal
      CX 0 eq and
      CY isreal and
      CY 0 eq and
      CZ isreal and
      CZ 0 eq and not {
         dup CX CY CZ planputorigine
      } if
      /CX 0. def
      /CY 0. def
      /CZ 0. def
      ngrid length 0 ne {
         dup ngrid planputngrid
      } if
   } if
%   dup RotX RotY RotZ rotateOplan
   dup phi rotateplan
   /l@pl@n exch def
   tx@Dict /solidname known {
      l@pl@n solidname cvlit exch bind def
      /solidname solidname (_s) append store
   } if
   l@pl@n newplan
   gere_pstricks_opt
   /pl@n-en-cours false def
%   action ==
%   noir
   l@pl@n RotX RotY RotZ rotateOplan
%   l@pl@n CX CY CZ plantranslate
%   fontsize setfontsize
%   setTimes
   1 gere_pstfont
   solidplanmarks {l@pl@n projectionsifacevisible planmarks} if
   solidplangrid {linecolor l@pl@n projectionsifacevisible planquadrillage} if
   solidshowbase {l@pl@n projectionsifacevisible planshowbase} if
   solidshowbase3d {l@pl@n projectionsifacevisible planshowbase3d} if
} def


/pst-plan-normalpoint {
   /plan-@k false def
   norm2plan
   dup plan2eq /eqpl@n exch def
} def

/pst-plan-equation {
   /plan-@k false def
   dup isarray {
      dup /eqpl@n exch def
   } {
      2 copy pop /eqpl@n exch def
   } ifelse
   eq2plan 
} def

/pst-plan-solidface {
   /plan-@k false def
   solidface2plan
   CX isreal
   CX 0 eq and
   CY isreal and
   CY 0 eq and
   CZ isreal and
   CZ 0 eq and not {
      dup CX CY CZ planputorigine
   } if
   
%   dup plangetrange aload pop boum
%   dup origin planputorigine
   dup plan2eq /eqpl@n exch def
} def

/pst-geode {
   ngrid aload pop newgeode
   gere_pstricks_opt
} def

/pst-load {
   solidloadname 
%   /activationgestioncouleurs false def
   gere_pstricks_opt
} def

/pst-point {
gsave
   linecolor
   1 gere_pstfont
   action (none) eqstring not {
      args definition cvx exec point3d
   } if
   texte args definition cvx exec pos (text3d) append cvx exec
   tx@Dict /solidname known {
      args definition cvx exec
      solidname cvlit defpoint3d
      tx@Dict /solidname undef
   } if
grestore
} def

%% syntaxe : alpha beta r h newpie --> solid
/pst-pie {
   phi theta r h 
   ngrid length 2 ge {
      [ngrid 0 get ngrid 1 get]
   } if
   newpie
   gere_pstricks_opt
} def

/pst-trigospherique {
3 dict begin
gsave
   solidlinewidth setlinewidth
   linecolor
   linestyle
   args definition cvx exec
grestore
end
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%         procedures pour \psProjection              %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/gere_pstricks_proj_opt {
      /planprojpst where {
         pop
         planprojpst projectionsifacevisible projpath
%        /planprojpst where pop /planprojpst undef
      } {
         /solidprojname where {
            /solidprojname get noface phi  
            xorigine 0 eq
            yorigine 0 eq and
            zorigine 0 eq and 
            xorigine isinteger not and
            yorigine isinteger not and
            yorigine isinteger not and {
            } {
               [xorigine yorigine zorigine] (                 ) astr2str 
            } ifelse
            projectionsifacevisible solidprojpath
         } {
            xorigine yorigine zorigine [ normale ] projectionsifacevisible planprojpath
         } ifelse
      } ifelse
} def

/proj-pst-chemin {
   solidlinewidth setlinewidth
   1 dict begin
   newpath
      /cercle {cercle_} def
      path
      linecolor
      gere_pstricks_proj_opt
   end
} def

/proj-pst-courbeR2 {
   l@pl@n plangetrange aload pop 
   setyrange setxrange
   newpath
      xmin ymin l@pl@n pointplan smoveto
      xmin ymax l@pl@n pointplan slineto
      xmax ymax l@pl@n pointplan slineto
      xmax ymin l@pl@n pointplan slineto
      xmin ymin l@pl@n pointplan slineto
      planprojpst projpath
   clip
   solidlinewidth setlinewidth
   newpath
      linecolor
      range aload pop { function cvx exec } CourbeR2_
      gere_pstricks_proj_opt
} def

/proj-pst-courbe {
   l@pl@n plangetrange aload pop 
   setyrange setxrange
   newpath
      xmin ymin l@pl@n pointplan smoveto
      xmin ymax l@pl@n pointplan slineto
      xmax ymax l@pl@n pointplan slineto
      xmax ymin l@pl@n pointplan slineto
      xmin ymin l@pl@n pointplan slineto
      planprojpst projpath
   clip
   solidlinewidth setlinewidth
   newpath
      linecolor
      range aload pop {} { function cvx exec } Courbeparam_
      gere_pstricks_proj_opt
} def

/proj-pst-point {
   [proj-args] length 0 eq {
      xorigine yorigine /proj-args defpoint
   } if
   /projname where {
      pop
      [proj-args proj-definition cvx exec]
      dup 0 getp projname cvlit defpoint
      dup length 2 gt {
         1 getp projname (0) append cvlit defpoint
      } if
      /projname where pop /projname undef
   } if
   proj-action (none) eqstring not {
      solidlinewidth setlinewidth
      linecolor
      [proj-args proj-definition cvx exec] 0 getp point_
      gere_pstricks_proj_opt
      Stroke
   } if
%   1 1 0 0 1 1 Diamond
   texte length 0 gt {
      proj-fontsize setfontsize
      %setTimes 
      solidlinewidth setlinewidth
      newpath
      linecolor
      texte [proj-args proj-definition cvx exec 0 0 phi neg rotatepoint] 0 getp 
      pos (text_) append cvx exec
%%    /planprojpst where {
%%       planprojpst dupplan dup phi rotateplan /planprojpst exch def
%%       pop
%%       xorigine yorigine
%%       0 0 phi neg rotatepoint
%%    } {
%%       0 0
%%    } ifelse
      %gere_pstricks_proj_opt
      planprojpst dupplan dup phi rotateplan projectionsifacevisible projpath
      Fill
   } if
} def

/proj-pst-vecteur {
   proj-action (none) eqstring not {
      planprojpst bprojscene
      solidlinewidth setlinewidth
      linestyle
      linecolor
      xorigine yorigine 2 copy proj-args proj-definition cvx exec addv drawvecteur
      eprojscene
   } if
   /projname where {
      pop
      proj-args proj-definition cvx exec projname cvlit defpoint
      /projname where pop /projname undef
   } if
} def

/proj-pst-droite {
   proj-action (none) eqstring not {
      l@pl@n plangetrange aload pop 
      setyrange setxrange
%%       newpath
%%          xmin ymin l@pl@n pointplan smoveto
%%          xmin ymax l@pl@n pointplan slineto
%%          xmax ymax l@pl@n pointplan slineto
%%          xmax ymin l@pl@n pointplan slineto
%%          xmin ymin l@pl@n pointplan smoveto
%%       planprojpst projpath
%%       clip
      planprojpst bprojscene
      solidlinewidth setlinewidth
      linestyle
      linecolor
      proj-args proj-definition cvx exec droite
      eprojscene
   } if
   /projname where {
      pop
      proj-args proj-definition cvx exec projname cvlit defdroite
      /projname where pop /projname undef
   } if
} def

/proj-pst-polygone {
   proj-action (none) eqstring not {
      l@pl@n plangetrange aload pop 
      setyrange setxrange
      newpath
         xmin ymin l@pl@n pointplan smoveto
         xmin ymax l@pl@n pointplan slineto
         xmax ymax l@pl@n pointplan slineto
         xmax ymin l@pl@n pointplan slineto
         xmin ymin l@pl@n pointplan slineto
         planprojpst projpath
      clip
      solidlinewidth setlinewidth
      linestyle
      linecolor
      proj-definition length 0 eq {
         [proj-args]
      } {
         proj-args 
      } ifelse
      proj-definition cvx exec polygone_
      planprojpst projectionsifacevisible projpath
   } if
   /projname where {
      pop
      proj-definition length 0 eq {
         [proj-args]
      } {
         proj-args 
      } ifelse
      proj-definition cvx exec projname cvlit exch def
      /projname where pop /projname undef
   } if
} def

/proj-pst-cercle {
   /projname where {
      pop
      proj-args proj-definition cvx exec projname cvlit defcercle
      /projname where pop /projname undef
   } if
   proj-action (none) eqstring not {
      l@pl@n plangetrange aload pop 
      setyrange setxrange
%%       newpath
%%          xmin ymin l@pl@n pointplan smoveto
%%          xmin ymax l@pl@n pointplan slineto
%%          xmax ymax l@pl@n pointplan slineto
%%          xmax ymin l@pl@n pointplan slineto
%%          xmin ymin l@pl@n pointplan slineto
%%       planprojpst projpath
%%       clip
      solidlinewidth setlinewidth
      linestyle
      linecolor
      newpath
      range aload pop proj-args
      proj-definition cvx exec Cercle_
      planprojpst projectionsifacevisible projpath
   } if
} def

/proj-pst-line {
   proj-action (none) eqstring not {
      l@pl@n plangetrange aload pop 
      setyrange setxrange
%%       newpath
%%          xmin ymin l@pl@n pointplan smoveto
%%          xmin ymax l@pl@n pointplan slineto
%%          xmax ymax l@pl@n pointplan slineto
%%          xmax ymin l@pl@n pointplan slineto
%%          xmin ymin l@pl@n pointplan slineto
%%          planprojpst projpath
%%       clip
      planprojpst bprojscene
      solidlinewidth setlinewidth
      linestyle
      linecolor
      proj-definition length 0 eq {
         [proj-args]
      } {
         proj-args 
      } ifelse
      proj-definition cvx exec ligne
      eprojscene
   } if
   /projname where {
      pop
      proj-definition length 0 eq {
         [proj-args]
      } {
         proj-args 
      } ifelse
      proj-definition cvx exec projname cvlit exch def
      /projname where pop /projname undef
   } if
} def

/proj-pst-rightangle {
   proj-action (none) eqstring not {
      planprojpst bprojscene
      solidlinewidth setlinewidth
      linestyle
      linecolor
      proj-args proj-definition cvx exec angledroit
      eprojscene
   } if
} def

/proj-pst-texte {
2 dict begin
   proj-fontsize setfontsize
   %setTimes
   1 gere_pstfont
   solidlinewidth setlinewidth
   newpath
   linecolor
   texte 
   /planprojpst where {
      planprojpst dupplan dup phi rotateplan /planprojpst exch def
      pop
      xorigine yorigine
      0 0 phi neg rotatepoint
   } {
      0 0
   } ifelse
   pos (text_) append cvx exec
   gere_pstricks_proj_opt
Fill
end
} def

% END solides.pro