2 % PostScript prologue for pst-solides3d.tex.
3 % Version 4.20, 2010/04/27
5 %% COPYRIGHT 2008 by Jean-Paul Vignault
7 %% This program can be redistributed and/or modified under the terms
8 %% of the LaTeX Project Public License Distributed from CTAN
9 %% archives in directory macros/latex/base/lppl.txt.
11 /SolidesDict 100 dict def
12 /SolidesbisDict 100 dict def
15 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
16 %% %% les variables globales gerees par PSTricks %%
17 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
18 %% %% les lignes dessous sont a decommenter si l on veut utiliser le
19 %% %% fichier solides.pro independamment du package PSTricks
24 %% /XpointVue {Dobs Cos1Cos2 mul} def
25 %% /YpointVue {Dobs Sin1Cos2 mul} def
26 %% /ZpointVue {Dobs Sin2 mul} def
28 %% /solidhollow false def
29 %% /solidbiface false def
31 %% /tracelignedeniveau? true def
32 %% /hauteurlignedeniveau 1 def
33 %% /couleurlignedeniveau {rouge} def
34 %% /linewidthlignedeniveau 4 def
35 %% /solidgrid true def
36 /aretescachees true def
37 /defaultsolidmode 2 def
39 %% variables globales specifiques a PSTricks
40 %% /activationgestioncouleurs true def
55 /pl@n-en-cours false def
58 [6.25 3.75] 1.25 setdash
60 /stockcurrentcpath {} def
64 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
65 %% choix d une fonte accentuee pour le .ps %%
66 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
67 /ReEncode { exch findfont
68 dup length dict begin { 1 index /FID eq {pop pop} {def} ifelse
69 }forall /Encoding ISOLatin1Encoding def currentdict end definefont
71 /Font /Times-Roman /ISOfont ReEncode /ISOfont def
72 %Font findfont 10 scalefont setfont
74 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75 %% extrait de color.pro pour pouvoir recuperer ses couleurs %%
76 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 /GreenYellow{0.15 0 0.69 0 setcmykcolor}def
78 /Yellow{0 0 1 0 setcmykcolor}def
79 /Goldenrod{0 0.10 0.84 0 setcmykcolor}def
80 /Dandelion{0 0.29 0.84 0 setcmykcolor}def
81 /Apricotq{0 0.32 0.52 0 setcmykcolor}def
82 /Peach{0 0.50 0.70 0 setcmykcolor}def
83 /Melon{0 0.46 0.50 0 setcmykcolor}def
84 /YellowOrange{0 0.42 1 0 setcmykcolor}def
85 /Orange{0 0.61 0.87 0 setcmykcolor}def
86 /BurntOrange{0 0.51 1 0 setcmykcolor}def
87 /Bittersweet{0 0.75 1 0.24 setcmykcolor}def
88 /RedOrange{0 0.77 0.87 0 setcmykcolor}def
89 /Mahogany{0 0.85 0.87 0.35 setcmykcolor}def
90 /Maroon{0 0.87 0.68 0.32 setcmykcolor}def
91 /BrickRed{0 0.89 0.94 0.28 setcmykcolor}def
92 /Red{0 1 1 0 setcmykcolor}def
93 /OrangeRed{0 1 0.50 0 setcmykcolor}def
94 /RubineRed{0 1 0.13 0 setcmykcolor}def
95 /WildStrawberry{0 0.96 0.39 0 setcmykcolor}def
96 /Salmon{0 0.53 0.38 0 setcmykcolor}def
97 /CarnationPink{0 0.63 0 0 setcmykcolor}def
98 /Magenta{0 1 0 0 setcmykcolor}def
99 /VioletRed{0 0.81 0 0 setcmykcolor}def
100 /Rhodamine{0 0.82 0 0 setcmykcolor}def
101 /Mulberry{0.34 0.90 0 0.02 setcmykcolor}def
102 /RedViolet{0.07 0.90 0 0.34 setcmykcolor}def
103 /Fuchsia{0.47 0.91 0 0.08 setcmykcolor}def
104 /Lavender{0 0.48 0 0 setcmykcolor}def
105 /Thistle{0.12 0.59 0 0 setcmykcolor}def
106 /Orchid{0.32 0.64 0 0 setcmykcolor}def
107 /DarkOrchid{0.40 0.80 0.20 0 setcmykcolor}def
108 /Purple{0.45 0.86 0 0 setcmykcolor}def
109 /Plum{0.50 1 0 0 setcmykcolor}def
110 /Violet{0.79 0.88 0 0 setcmykcolor}def
111 /RoyalPurple{0.75 0.90 0 0 setcmykcolor}def
112 /BlueViolet{0.86 0.91 0 0.04 setcmykcolor}def
113 /Periwinkle{0.57 0.55 0 0 setcmykcolor}def
114 /CadetBlue{0.62 0.57 0.23 0 setcmykcolor}def
115 /CornflowerBlue{0.65 0.13 0 0 setcmykcolor}def
116 /MidnightBlue{0.98 0.13 0 0.43 setcmykcolor}def
117 /NavyBlue{0.94 0.54 0 0 setcmykcolor}def
118 /RoyalBlue{1 0.50 0 0 setcmykcolor}def
119 /Blue{1 1 0 0 setcmykcolor}def
120 /Cerulean{0.94 0.11 0 0 setcmykcolor}def
121 /Cyan{1 0 0 0 setcmykcolor}def
122 /ProcessBlue{0.96 0 0 0 setcmykcolor}def
123 /SkyBlue{0.62 0 0.12 0 setcmykcolor}def
124 /Turquoise{0.85 0 0.20 0 setcmykcolor}def
125 /TealBlue{0.86 0 0.34 0.02 setcmykcolor}def
126 /Aquamarine{0.82 0 0.30 0 setcmykcolor}def
127 /BlueGreen{0.85 0 0.33 0 setcmykcolor}def
128 /Emerald{1 0 0.50 0 setcmykcolor}def
129 /JungleGreen{0.99 0 0.52 0 setcmykcolor}def
130 /SeaGreen{0.69 0 0.50 0 setcmykcolor}def
131 /Green{1 0 1 0 setcmykcolor}def
132 /ForestGreen{0.91 0 0.88 0.12 setcmykcolor}def
133 /PineGreen{0.92 0 0.59 0.25 setcmykcolor}def
134 /LimeGreen{0.50 0 1 0 setcmykcolor}def
135 /YellowGreen{0.44 0 0.74 0 setcmykcolor}def
136 /SpringGreen{0.26 0 0.76 0 setcmykcolor}def
137 /OliveGreen{0.64 0 0.95 0.40 setcmykcolor}def
138 /RawSienna{0 0.72 1 0.45 setcmykcolor}def
139 /Sepia{0 0.83 1 0.70 setcmykcolor}def
140 /Brown{0 0.81 1 0.60 setcmykcolor}def
141 /Tan{0.14 0.42 0.56 0 setcmykcolor}def
142 /Gray{0 0 0 0.50 setcmykcolor}def
143 /Black{0 0 0 1 setcmykcolor}def
144 /White{0 0 0 0 setcmykcolor}def
145 %% fin de l extrait color.pro
147 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
148 %%%% autres couleurs %%%%
149 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
151 /bleu {0 0 1 setrgbcolor} def
152 /rouge {1 0 0 setrgbcolor} def
153 /vert {0 .5 0 setrgbcolor} def
154 /gris {.4 .4 .4 setrgbcolor} def
155 /jaune {1 1 0 setrgbcolor} def
156 /noir {0 0 0 setrgbcolor} def
157 /blanc {1 1 1 setrgbcolor} def
158 /orange {1 .65 0 setrgbcolor} def
159 /rose {1 .01 .58 setrgbcolor} def
160 /cyan {1 0 0 0 setcmykcolor} def
161 /magenta {0 1 0 0 setcmykcolor} def
163 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
164 %%%% definition du point de vue %%%%
165 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
166 %% pour la 3D conventionnelle
167 %% Dony : graphisme scientifique : page 187
170 %% calcul des coefficients de la matrice
172 /Sin1 {THETA sin} def
174 /Cos1 {THETA cos} def
176 /Cos1Sin2 {Cos1 Sin2 mul} def
177 /Sin1Sin2 {Sin1 Sin2 mul} def
178 /Cos1Cos2 {Cos1 Cos2 mul} def
179 /Sin1Cos2 {Sin1 Cos2 mul} def
187 Xabscisse Sin1 mul neg Yordonnee Cos1 mul add
190 Xabscisse Cos1Sin2 mul neg Yordonnee Sin1Sin2 mul sub Zcote Cos2
194 Xabscisse neg Cos1Cos2 mul Yordonnee Sin1Cos2 mul sub Zcote Sin2
197 %% maintenant on depose les resultats sur la pile
198 Decran xObservateur mul zObservateur div cm
199 Decran yObservateur mul zObservateur div cm
213 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
214 %%%% jps modifie pour PSTricks %%%%
215 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
218 /dashed {pointilles} def
220 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
221 %%%% geometrie basique %%%%
222 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
224 %% syntaxe~: [x1 y1 ... xn yn] ligne
235 %% syntaxe~: [x1 y1 ... xn yn] ligne_
244 %% syntaxe~: [x1 y1 ... xn yn] polygone
267 currentlinewidth 0 eq {} {stroke} ifelse
271 %% syntaxe : x y point
290 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
291 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
293 %%%% insertion librairie jps %%%%
295 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
296 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
298 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
299 %%%% le repere jps %%%%
300 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
302 %%%%% ### AAAopacity ###
303 %% les parametres pour la gestion de la transparence
305 /strokeopacity exch def
308 /fillopacity exch def
310 %% d apres un code de Jean-Michel Sarlat
311 %% http://melusine.eu.org/syracuse/swf/pdf2swf/setdash/
312 %% Mise en reserve de la procedure stroke originelle.
313 /sysstroke {systemdict /stroke get exec} def
314 /sysfill {systemdict /fill get exec} def
315 /sysatan {systemdict /atan get exec} def
316 /atan {2 copy 0 0 eqp {pop pop 0} {sysatan} ifelse} def
317 % Mise en place de la nouvelle procedure
319 /strokeopacity where {
324 .setopacityalpha sysstroke
332 .setopacityalpha sysfill
335 %%%%% ### AAAscale ###
336 %%%%%%%%%%%%%%%% les deplacements a l echelle %%%%%%%%%%%%%%%%%%%
338 /v@ct_I {xunit 0} def
339 /v@ct_J {angle_repere cos yunit mul angle_repere sin yunit mul} def
362 xtranslate ytranslate
363 3 1 roll %% xA yB yA xB
364 4 1 roll %% xB xA yB yA
365 sub neg 3 1 roll %% yB-yA xB xA
371 xtranslate ytranslate
372 3 1 roll %% xA yB yA xB
373 4 1 roll %% xB xA yB yA
374 sub neg 3 1 roll %% yB-yA xB xA
382 /y Y yunit angle_repere sin mul div def
383 /x X y yunit mul angle_repere cos mul sub xunit div def
414 %%%%% ### fin insertion ###
416 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
417 %%%% methodes numeriques %%%%
418 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
420 %%%%% ### solve2nddegre ###
421 %% syntaxe : a b c solve2nddegre --> x1 x2
427 /delt@ @b dup mul 4 @a mul @c mul sub def
428 @b neg delt@ sqrt sub 2 @a mul div
429 @b neg delt@ sqrt add 2 @a mul div
433 %%%%% ### fin insertion ###
435 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
437 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
439 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
441 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
443 %%%%% ### tripointangle ###
444 %% syntaxe : A B C tripointangle --> angle ABC
463 %% syntaxe : A B angle
464 %% --> num, l'angle defini par le vecteur AB dans le repere orthonorme jps
472 %% syntaxe : A B pangle
473 %% --> num, l'angle defini par le vecteur AB dans le repere postscript
475 jtoppoint exchp jtoppoint exchp vecteur exch atan
481 %%%%% ### setxrange ###
487 %%%%% ### setyrange ###
493 %%%%% ### defpoint ###
494 %% syntaxe : xA yA /A defpoint
498 [ 3 1 roll ] cvx t@mp@r@ire exch
503 %% syntaxe~: A B milieu
506 3 -1 roll %% xA xB yB yA
507 add 2 div %% xA xB yM
513 %%%%% ### parallelopoint ###
514 %% syntaxe : A B C parallelopoint --> point D, tel que ABCD parallelogramme
526 /d1 {A B C paral} def
527 /d2 {B C A paral} def
532 %%%%% ### translatepoint ###
533 %% syntaxe : A u translatepoint --> B image de A par la translation de vecteur u
538 %%%%% ### rotatepoint ###
539 %% syntaxe : B A r rotatepoint --> C image de B par la rotation de centre A,
540 %% d'angle r (en degre)
541 %% En prenant les affixes des pts associes, il vient
542 %% (zC - zA) = (zB-zA) e^(ir)
544 %% zC = (zB-zA) e^(ir) + zA
545 /rotatepoint { %% B, A, r
546 5 copy %% B, A, r, B, A, r
547 cos 5 1 roll %% B, A, r, cos r, B, A
548 4 1 roll %% B, A, r, cos r, yA, B, xA
549 4 1 roll %% B, A, r, cos r, A, B
550 vecteur %% B, A, r, cos r, xB-xA, yB-yA
551 4 -1 roll sin %% B, A, cos r, xB-xA, yB-yA, sin r
552 4 copy mul %% B, A, cos r, xB-xA, yB-yA, sin r, cos r, xB-xA, (yB-yA) sin r
553 7 1 roll mul %% B, A, (yB-yA) sin r, cos r, xB-xA, yB-yA, sin r, cos r (xB-xA)
554 5 1 roll %% B, A, (yB-yA) sin r, cos r (xB-xA), cos r, xB-xA, yB-yA, sin r
555 exch %% B, A, (yB-yA) sin r, cos r (xB-xA), cos r, xB-xA, sin r, yB-yA
556 4 -1 roll mul %% B, A, (yB-yA) sin r, cos r (xB-xA), xB-xA, sin r, (yB-yA)cos r
557 3 1 roll mul %% B, A, (yB-yA) sin r, cos r (xB-xA), (yB-yA) cos r, (xB-xA) sin r
558 add %% B, A, (yB-yA) sin r, cos r (xB-xA), (yB-yA) cos r +(xB-xA) sin r
559 3 1 roll %% B, A, (yB-yA) cos r + (xB-xA) sin r, (yB-yA) sin r, cos r (xB-xA),
560 exch sub %% B, A, (yB-yA) cos r + (xB-xA) sin r, cos r (xB-xA)-(yB-yA) sin r
561 exch %% B, zA, (zB-zA) e^(ir)
567 %%%%% ### hompoint ###
568 %% syntaxe : B A alpha hompoint -> le point A' tel que AA' = alpha AB
572 vecteur %% vecteur BA
575 mulv %% alpha x vecteur AB
582 %%%%% ### orthoproj ###
583 %% syntaxe : A D orthoproj --> B, le projete orthogonal de A sur D
589 7 -1 roll pop %% D D A
594 %% syntaxe : A projx --> le projete orthogonal de A sur Ox
599 %% syntaxe : A projy --> le projete orthogonal de A sur Oy
604 %%%%% ### sympoint ###
605 %% syntaxe : A I sympoint --> point A', le symetrique de A par rapport
615 %%%%% ### axesympoint ###
616 %% syntaxe : A D axesympoint --> point B, le symetrique de A par rapport
632 %% syntaxe : alpha C cpoint -> M, le point du cercle C correspondant a
634 /cpoint { %% a, xI, yI, r
636 dup %% a, xI, yI, r, r
637 5 -1 roll %% xI, yI, r, r, a
639 alpha cos mul %% xI, yI, r, r cos a
641 alpha sin mul %% xI, yI, r cos a, r sin a
642 3 -1 roll add %% xI, r cos a, yI + r sin a
643 3 1 roll %% yI + r sin a, xI, r cos a,
644 add exch %% xI + r cos a, yI + r sin a
648 %%%%% ### xdpoint ###
649 %% x A B xdpoint : le point de la droite (AB) d'abscisse x
655 /a pt1 pt2 coeffdir def
656 /b pt1 pt2 ordorig def
661 %%%%% ### ydpoint ###
662 %% y A B ydpoint : le point de la droite (AB) d'ordonnee y
673 /a pt1 pt2 coeffdir def
674 /b pt1 pt2 ordorig def
681 %%%%% ### ordonnepoints ###
682 %% syntaxe : xA yA xB yB ordonnepoints --> idem si yB>yA ou si yB=yA
683 %% avec xB>xA, sinon xB yB xA yA
686 exch pop %% ... xA, yA, yB
688 {pop} %% oui, c'est fini
691 exch pop %% ... xA, yA, yB
694 3 copy %% oui, yA = yB
695 pop pop %% ... xA, xB
697 {} %% oui, c'est fini
698 { %% non, on echange A et B
704 { %% non : yA < yB => on echange A et B
714 %%%%% ### distance ###
715 %% syntaxe~: A B distance
716 /distance { %% xA yA xB yB
718 dup mul exch %% y^2 x
729 %%%%% ### fin insertion ###
730 /interdroites {interdroite} def
732 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
734 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
736 %%%%% ### vecteur ###
737 %% syntaxe~: A B vecteur
740 3 -1 roll %% xA xB yB yA
742 3 1 roll %% yB-yA xA xB
743 exch sub %% yB-yA xB-xA
747 %%%%% ### normalize ###
748 %% syntaxe : u normalize -> u / ||u||
758 %% syntaxe : u v addv --> u+v
759 /addv { %% xA yA xB yB
760 3 1 roll %% xA yB yA xB
761 4 1 roll %% xB xA yB yA
762 add 3 1 roll %% yB+yA xB xA
767 %% syntaxe : u v subv --> u - v
768 /subv { %% xA yA xB yB
774 %% syntaxe : u a mulv --> au
777 3 1 roll %% xA, a, yA, a
778 mul 3 1 roll %% ayA, xA, a
782 %%%%% ### scalprod ###
783 %% syntaxe : u v scalprod --> le produit scalaire de u par v
794 %% syntaxe : u normal --> v tel u.v = 0
800 %% syntaxe : u norme --> |u|
808 %%%%% ### oldarrow ###
809 %% syntaxe : A B oldarrow --> trace fleche en B, direction AB
819 A B vecteur normalize /u defpoint
820 u neg exch /v defpoint
821 u oldarrowpointe neg mulv rmoveto %% ainsi c'est la pointe qui est en (0, 0)
822 %% le pt extremal arriere haut
823 u oldarrowplume neg mulv %% l'abscisse
824 v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul mulv addv %% l'ordonnee
826 u oldarrowplume oldarrowpointe add mulv
827 v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul neg mulv addv
829 u oldarrowplume oldarrowpointe add neg mulv
830 v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul neg mulv addv
837 /oldarrowpointe {xunit 5 div} def
838 /oldarrowplume {xunit 10 div} def
839 /oldarrow@ngle 45 def
840 /oldarrowscale {1 1} def
841 /oldarrowangle 0 def %% pour l'utilisateur
843 %%%%% ### drawvecteur ###
844 %% syntaxe : A B drawvecteur
854 %%%%% ### orthovecteur ###
855 %% syntaxe : u orthovecteur --> v, vecteur orthogonal a u
860 %%%%% ### fin insertion ###
862 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
864 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
866 %%%%% ### defcercle ###
867 %% syntaxe : A r /d defcercle
871 [ 4 1 roll ] cvx t@mp@r@ire exch
875 %%%%% ### interdroitecercle ###
876 %% intersection de la droite y = ax+b avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
878 %% { | x = - -----, y = (b + a x0 + a y0 + (2 a b y0 - 2 a b x0 +
881 %% 3 2 2 2 2 4 2 2 2 4 2 2
882 %% 2 a x0 y0 - a b + a r + a r - a y0 - a x0 )^(1/2)) / (a + 1)
889 %% | x = - -----, y = (b + a x0 + a y0 - (2 a b y0 - 2 a b x0 +
892 %% 3 2 2 2 2 4 2 2 2 4 2 2
893 %% 2 a x0 y0 - a b + a r + a r - a y0 - a x0 )^(1/2)) / (a + 1)
899 %% intersection de la droite x = a avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
901 %% {[x = a, y = y0 + (2 a x0 - a + r - x0 ) ],
904 %% [x = a, y = y0 - (2 a x0 - a + r - x0 ) ]}
906 %% intersection de la droite y = b avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
908 %% {[y = b, x = x0 + (2 b y0 - b + r - y0 ) ],
911 %% [y = b, x = x0 - (2 b y0 - b + r - y0 ) ]}
913 %% syntaxe : D I r interdroitecercle
924 xA yA xB yB verticale?
926 %% la droite est verticale
931 2 xA mul x0 mul xA dup mul sub r dup mul add x0 dup mul sub sqrt
941 %% la droite n'est pas verticale
943 /a xA yA xB yB coeffdir def
944 /b xA yA xB yB ordorig def
947 %% la droite est horizontale
966 %% la droite n'est pas horizontale
974 2 a dup mul mul b mul y0 mul
975 2 a 3 exp mul b mul x0 mul sub
976 2 a 3 exp mul x0 mul y0 mul add
977 a dup mul b dup mul mul sub
978 a dup mul r dup mul mul add
979 a 4 exp r dup mul mul add
980 a dup mul y0 dup mul mul sub
981 a 4 exp x0 dup mul mul sub
988 quantite1 quantite2 add quantite3 div
994 quantite1 quantite2 sub quantite3 div
1010 %%%%% ### intercercle ###
1011 %% syntaxe : cerc1 cerc2 intercercle --> A B les points d'intersection
1012 %% des 2 cercles, tries par 'ordonnepoints'
1022 %% on translate pour se ramener a (x1, y1) = (0, 0)
1027 %% on prepare l'equation du 2nd degre
1030 %% {y = RootOf((4 x2 + 4 y2 ) _Z
1033 %% + (-4 y2 - 4 r1~ y2 + 4 y2 r2~ - 4 x2 y2) _Z + x2
1035 %% 4 2 2 2 2 2 2 2 2
1036 %% + r2~ - 2 y2 r2~ + 2 x2 y2 - 2 x2 r2~ - 2 r1~ x2
1039 %% + r1~ + y2 + 2 r1~ y2 - 2 r1~ r2~ ), x = 1/2 (-2 y2
1042 %% RootOf((4 x2 + 4 y2 ) _Z
1045 %% + (-4 y2 - 4 r1~ y2 + 4 y2 r2~ - 4 x2 y2) _Z + x2
1047 %% 4 2 2 2 2 2 2 2 2
1048 %% + r2~ - 2 y2 r2~ + 2 x2 y2 - 2 x2 r2~ - 2 r1~ x2
1050 %% 4 4 2 2 2 2 2 2 2
1051 %% + r1~ + y2 + 2 r1~ y2 - 2 r1~ r2~ ) + r1~ + x2 + y2
1056 %% coeff pour le degre 2
1059 %% {y = RootOf((4 x2 + 4 y2 ) _Z
1061 4 y2 dup mul mul add
1064 %% coeff pour le degre 1
1068 %% + (-4 y2 - 4 r1~ y2 + 4 y2 r2~ - 4 x2 y2) _Z
1070 4 r1 dup mul mul y2 mul sub
1071 4 r2 dup mul mul y2 mul add
1072 4 x2 dup mul mul y2 mul sub
1075 %% coeff pour le degre 0
1082 %% 4 2 2 2 2 2 2 2 2
1083 %% + r2~ - 2 y2 r2~ + 2 x2 y2 - 2 x2 r2~ - 2 r1~ x2
1085 2 y2 dup mul mul r2 dup mul mul sub
1086 2 x2 dup mul mul y2 dup mul mul add
1087 2 x2 dup mul mul r2 dup mul mul sub
1088 2 x2 dup mul mul r1 dup mul mul sub
1091 %% + r1~ + y2 + 2 r1~ y2 - 2 r1~ r2~ )
1094 2 r1 dup mul mul y2 dup mul mul add
1095 2 r1 dup mul mul r2 dup mul mul sub
1136 %% on depose le resultat, en n'oubliant pas de retranslater en sens
1145 %%%%% ### ABcercle ###
1146 %% syntaxe : A B C ABcercle --> le cercle passant par A, B, C
1160 %%%%% ### diamcercle ###
1161 %% syntaxe : A B diamcercle --> le cercle de diametre [AB]
1170 %%%%% ### fin insertion ###
1172 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1174 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1176 %%%%% ### horizontale ###
1177 %% syntaxe : y horizontale
1185 %%%%% ### coeffdir ###
1186 %% syntaxe~: A B coeffdir
1191 %%%%% ### ordorig ###
1192 %% syntaxe : A B ordorig
1193 %% attention, la droite est supposee ne pas etre verticale
1196 dr@ite 3 3 -1 roll put
1197 dr@ite 2 3 -1 roll put
1198 dr@ite 1 3 -1 roll put
1199 dr@ite 0 3 -1 roll put
1200 dr@ite aload pop coeffdir /c@eff exch def
1201 dr@ite aload pop pop pop %% xA yA
1206 %%%%% ### verticale ###
1207 %% syntaxe~: A B verticale?
1213 %% syntaxe : x verticale
1221 %%%%% ### droite ###
1222 %% %% syntaxe : A B droite
1240 %% stockcurrentcpath
1245 %% /alpha xA yA xB yB coeffdir def
1246 %% /beta xA yA xB yB ordorig def
1247 %% xmin dup alpha mul beta add smoveto
1248 %% xmax dup alpha mul beta add slineto
1249 %% stockcurrentcpath
1259 %% syntaxe : A B droite
1273 %% on cherche le point le + a gauche
1274 xmin A B xdpoint /C defpoint
1275 C exch pop ymin lt {
1277 ymin A B ydpoint /C defpoint
1279 C exch pop ymax gt {
1281 ymax A B ydpoint /C defpoint
1283 %% on cherche le point le + a droite
1284 xmax A B xdpoint /D defpoint
1285 D exch pop ymin lt {
1287 ymin A B ydpoint /D defpoint
1289 D exch pop ymax gt {
1291 ymax A B ydpoint /D defpoint
1303 %%%%% ### defdroite ###
1304 %% syntaxe : A B /d defdroite
1307 /t@mp@r@ire exch def
1308 [ 5 1 roll ] cvx t@mp@r@ire exch
1313 %% syntaxe : D A paral --> droite parallele a D passant par A
1323 u1 u2 translatepoint
1327 %%%%% ### interdroite ###
1330 /dr@ite2 4 array def
1331 dr@ite2 3 3 -1 roll put
1332 dr@ite2 2 3 -1 roll put
1333 dr@ite2 1 3 -1 roll put
1334 dr@ite2 0 3 -1 roll put
1335 /dr@ite1 4 array def
1336 dr@ite1 3 3 -1 roll put
1337 dr@ite1 2 3 -1 roll put
1338 dr@ite1 1 3 -1 roll put
1339 dr@ite1 0 3 -1 roll put
1341 %%% %% trace pour deboguage
1342 %%% dr@ite1 aload pop droite
1343 %%% dr@ite2 aload pop droite
1345 %%% Dans tous les cas, on suppose que l'intersection existe
1347 %%% * la 1ere droite est verticale. les equations reduites sont
1348 %%% x = a1 et y = a2 x + b2
1349 %%% Le point d'intersection est :
1350 %%% {{x = a1, y = b2 + a1 a2}}
1352 %%% * la 2eme droite est verticale. les equations reduites sont
1353 %%% x = a1 x+ b1 et x = a2
1354 %%% Le point d'intersection est :
1355 %%% {{x = a2, y = b1 + a1 a2}}
1357 %%% * aucune n'est verticale. Les equations reduites sont
1358 %%% y = a1 x + b1 et y = a2 x + b2
1359 %%% Le point d'intersection est :
1360 %%% { { b2 - b1 a1 b2 - a2 b1 } }
1361 %%% { { x = -------, y = ------------- } }
1362 %%% { { a1 - a2 a1 - a2 } }
1364 %%% remarque : pour le moment, je n'arrive pas a rendre mes variables
1365 %%% locales : elle restent globales. Pour que cela ne soit pas trop
1366 %%% genant, je les note respectivement @1, @@1, @2 et @@2 au lieu de a1,
1369 dr@ite1 aload pop verticale?
1371 /@1 {dr@ite1 aload pop pop pop pop} def
1372 /@2 {dr@ite2 aload pop coeffdir} def
1373 /@@2 {dr@ite2 aload pop ordorig} def
1378 dr@ite2 aload pop verticale?
1380 /@1 {dr@ite1 aload pop coeffdir} def
1381 /@@1 {dr@ite1 aload pop ordorig} def
1382 /@2 {dr@ite2 aload pop pop pop pop} def
1387 /@1 {dr@ite1 aload pop coeffdir} def
1388 /@@1 {dr@ite1 aload pop ordorig} def
1389 /@2 {dr@ite2 aload pop coeffdir} def
1390 /@@2 {dr@ite2 aload pop ordorig} def
1391 @@2 @@1 sub @1 @2 sub div
1392 @1 @@2 mul @2 @@1 mul sub
1401 %% syntaxe : D A perp --> droite perpendiculaire a D passant par A
1406 vecteur orthovecteur
1411 u1 u2 translatepoint
1415 %%%%% ### mediatrice ###
1416 %% synaxe : A B mediatrice --> droite
1423 %%%%% ### bissectrice ###
1424 %% syntaxe : A B C bissectrice --> B E ou E est un point de la bissectrice
1436 /alpha {A B C tripointangle} def
1438 A B alpha rotatepoint
1443 %%%%% ### angledroit ###
1444 /widthangledroit 5 def
1446 %% syntaxe : A B C angledroit --> dessine un angle droit en B
1450 /widthangledroit exch def
1455 B C vecteur normalize widthangledroit 20 div mulv /u defpoint
1456 B A vecteur normalize widthangledroit 20 div mulv /v defpoint
1457 [B u addv dupp v addv B v addv] ligne
1461 %%%%% ### translatedroite ###
1462 %% syntaxe : A B u translatedroite --> C D images resp de A et B par la translation de vecteur u
1463 /translatedroite { %% A B u
1475 %%%%% ### rotatedroite ###
1476 %% syntaxe : A B O r rotatedroite --> C D images resp de A et B par la
1477 %% rotation de centre O et d'angle r (en degre)
1479 5 copy rotatepoint %% A B O r D
1480 6 -1 roll pop %% A xB O r D
1481 6 -1 roll pop %% A O r D
1483 7 1 roll rotatepoint %% D C
1495 %%%%% ### axesymdroite ###
1496 %% syntaxe : d D axesymdroite --> droite d', symetrique de la droite d par rapport
1507 %%%%% ### fin insertion ###
1509 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1511 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1513 %%%%% ### poltransformfile ###
1514 %% syntaxe : pol u translatepol --> pol'
1519 {ux uy translatepoint} papply
1523 %% syntaxe : pol u rotatepol --> pol'
1528 {I alpha rotatepoint} papply
1532 %% syntaxe : pol I alpha hompol --> pol'
1537 {I alpha hompoint} papply
1541 %% syntaxe : pol I sympol --> pol'
1549 %% syntaxe : pol D axesympol --> pol'
1553 {D axesympoint} papply
1557 %%%%% ### fin insertion ###
1559 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1561 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1563 %%%%% ### isbool ###
1564 %% syntaxe : any isbool --> booleen
1566 type (booleantype) cvn eq
1569 %%%%% ### isarray ###
1570 %% syntaxe : any isarray --> booleen
1572 type (arraytype) cvn eq
1575 %%%%% ### isstring ###
1576 %% syntaxe : any isstring --> booleen
1578 type (stringtype) cvn eq
1581 %%%%% ### isinteger ###
1582 %% syntaxe : any isinteger --> booleen
1584 type (integertype) cvn eq
1588 %% syntaxe : any isnum --> booleen
1594 %%%%% ### isreal ###
1595 %% syntaxe : any isreal --> booleen
1597 type (realtype) cvn eq
1601 %% syntaxe : A B eqp3d --> booleen = true si les points A et B sont identiques
1603 %% x1 y1 z1 x2 y2 z2
1604 4 -1 roll %% x1 y1 x2 y2 z2 z1
1608 pop pop pop pop false
1612 %% syntaxe : A B eqp --> booleen = true si les points A et B sont identiques
1626 %% syntaxe : z z' eqc --> true si z = z', false sinon
1631 %%%%% ### eqstring ###
1636 str1 length str2 length eq {
1640 str1 i get str2 i get eq and
1649 %%%%% ### fin insertion ###
1651 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1652 %%%% conversions de types %%%%
1653 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1655 %%%%% ### astr2str ###
1656 %% syntaxe : array str astr2str --> str
1657 %% convertit le contenu de array en chaines de caracteres puis les
1658 %% concatene avec str, en inserant un caractere "space" apres chaque
1659 %% element du tableau array
1668 table 0 n 1 sub getinterval
1669 table n 1 sub get ( ) cvs
1677 %%%%% ### numstr2array ###
1678 %% syntaxe : str str2num --> num
1702 i 1 ge signnum 0 ge and i 2 ge or {
1703 exch 10 mul 48 sub add
1719 /str2num {cvx exec} def
1721 %% syntaxe : str numstr2array -> array
1722 %% ou str est une chaine de nombres reels separes par des espaces
1723 %% et array est constitue des elements numeriques de string.
1725 %% (0 -12 .234 54) --> [0 -12 0.234 54]
1736 /separateurs [separateurs aload pop i] def
1741 0 1 separateurs length 1 sub {
1743 str j separateurs i get oldsep sub getinterval str2num
1744 /j separateurs i get 1 add def
1745 /oldsep separateurs i get 1 add def
1747 str j n oldsep sub getinterval str2num
1752 %% syntaxe : array numstr2array -> array
1753 /arraynumstr2arrayarray {
1754 {numstr2array} apply
1757 %%%%% ### fin insertion ###
1759 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1760 %%%% macros de projection %%%%
1761 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1763 %%%%% ### projtext ###
1764 %% syntaxe : str x0 y0 z0 [normal_vect] ultextp3d --> -
1765 %% syntaxe : str x0 y0 z0 [normal_vect] bool ultextp3d --> -
1766 %% syntaxe : str x0 y0 plantype ultextp3d --> -
1767 %% syntaxe : str x0 y0 plantype bool ultextp3d --> -
1768 %% syntaxe : str1 solid i str2 ultextp3d --> -
1769 %% syntaxe : str1 solid i str2 bool ultextp3d --> -
1770 %% syntaxe : str1 solid i alpha str2 bool ultextp3d --> -
1779 /type_plan_proj true def
1781 lepl@n plangetbase aload pop
1784 lepl@n plangetorigine
1788 /table [@U @U @V vectprod3d] def
1791 %% c est un planprojpath
1792 /type_plan_proj true def
1799 %% c est un solidprojpath
1800 /type_plan_proj false def
1807 %% y a-t-il un alpha
1808 2 copy pop issolid {
1821 x0 y0 z0 table mybool projpath
1823 solid i alpha str2 mybool projpath
1830 %% syntaxe : str x0 y0 z0 [normal_vect] ultextp3d --> -
1831 %% syntaxe : str x0 y0 z0 [normal_vect] bool ultextp3d --> -
1832 %% syntaxe : str1 solid i str2 ultextp3d --> -
1833 %% syntaxe : str1 solid i str2 bool ultextp3d --> -
1834 %% syntaxe : str1 solid i alpha str2 bool ultextp3d --> -
1835 /ultextp3d {initpr@jtext ultext_ closepr@jtext} def
1836 /cltextp3d {initpr@jtext cltext_ closepr@jtext} def
1837 /bltextp3d {initpr@jtext bltext_ closepr@jtext} def
1838 /dltextp3d {initpr@jtext dltext_ closepr@jtext} def
1839 /ubtextp3d {initpr@jtext ubtext_ closepr@jtext} def
1840 /cbtextp3d {initpr@jtext cbtext_ closepr@jtext} def
1841 /bbtextp3d {initpr@jtext bbtext_ closepr@jtext} def
1842 /dbtextp3d {initpr@jtext dbtext_ closepr@jtext} def
1843 /uctextp3d {initpr@jtext uctext_ closepr@jtext} def
1844 /cctextp3d {initpr@jtext cctext_ closepr@jtext} def
1845 /bctextp3d {initpr@jtext bctext_ closepr@jtext} def
1846 /dctextp3d {initpr@jtext dctext_ closepr@jtext} def
1847 /urtextp3d {initpr@jtext urtext_ closepr@jtext} def
1848 /crtextp3d {initpr@jtext crtext_ closepr@jtext} def
1849 /brtextp3d {initpr@jtext brtext_ closepr@jtext} def
1850 /drtextp3d {initpr@jtext drtext_ closepr@jtext} def
1852 %%%%% ### currentppathtransform ###
1853 %% syntaxe : {f} currentppathtransform --> applique la transformation f
1854 %% au chemin courant
1855 /currentppathtransform {
1858 %% pour remplacer 'move'
1867 %% pour remplacer 'lineto'
1872 %% pour remplacer 'curveto'
1881 { warpmove } { warpline } { warpcurve } { closepath } pathforall
1886 %% syntaxe : {f} currentpathtransform --> applique la transformation f
1887 %% au chemin courant
1888 /currentpathtransform {
1891 /warp {ptojpoint transform} def
1892 %% pour remplacer 'move'
1901 %% pour remplacer 'lineto'
1906 %% pour remplacer 'curveto'
1915 { warpmove } { warpline } { warpcurve } { closepath } pathforall
1920 %%%%% ### normalvect_to_orthobase ###
1921 %% syntaxe : [normal_vect] normalvect_to_orthobase
1923 /normalvect_to_orthobase {
1926 aload pop normalize3d /normal_vect defpoint3d
1927 normal_vect -1 0 0 eqp3d {
1928 /imageI {0 -1 0} def
1929 /imageK {-1 0 0} def
1932 %% on calcule l image de la base (I,J,K)
1933 /imageJ {normal_vect 1 0 0 vectprod3d normalize3d} def
1934 /imageK {normal_vect} def
1935 /imageI {imageJ imageK vectprod3d} def
1936 1 0 0 imageK angle3d 0 eq {
1937 0 1 0 normal_vect vectprod3d /imageI defpoint3d
1939 normal_vect /imageK defpoint3d
1945 normalize3d /imageK defpoint3d
1946 normalize3d /imageI defpoint3d
1947 imageK imageI vectprod3d /imageJ defpoint3d
1951 /alpha exch 2 div def
1952 normalize3d /imageK defpoint3d
1953 normalize3d /imageI defpoint3d
1954 imageK imageI vectprod3d /imageJ defpoint3d
1955 %% et ensuite, on fait tourner la base autour de imageK
1956 imageI alpha cos mulv3d
1957 imageJ alpha sin mulv3d
1960 imageI alpha sin neg mulv3d
1961 imageJ alpha cos mulv3d
1970 normalize3d /normal_vect defpoint3d
1972 normal_vect -1 0 0 eqp3d {
1973 /imageI {0 -1 0} def
1974 /imageK {-1 0 0} def
1977 %% on calcule l image de la base (I,J,K)
1978 /imageJ {normal_vect 1 0 0 vectprod3d normalize3d} def
1979 /imageK {normal_vect} def
1980 /imageI {imageJ imageK vectprod3d} def
1981 1 0 0 imageK angle3d 0 eq {
1982 0 1 0 normal_vect vectprod3d /imageI defpoint3d
1984 normal_vect /imageK defpoint3d
1989 %% et ensuite, on fait tourner la base autour de imageK
1990 imageI alpha cos mulv3d
1991 imageJ alpha sin mulv3d
1994 imageI alpha sin neg mulv3d
1995 imageJ alpha cos mulv3d
2008 %%%%% ### projpath ###
2009 %% syntaxe : x y z [normal] projpath --> planprojpath
2010 %% syntaxe : x y z [normal] bool projpath --> planprojpath
2011 %% syntaxe : solid i projpath --> solidprojpath
2012 %% syntaxe : solid i bool projpath --> solidprojpath
2013 %% syntaxe : solid i str bool projpath --> solidprojpath
2014 %% syntaxe : solid i alpha str bool projpath --> solidprojpath
2025 lepl@n plangetbase aload pop
2028 lepl@n plangetorigine
2029 [@U @U @V vectprod3d] mybool planprojpath
2035 mybool solidprojpath
2042 %% %% syntaxe : x y z [normal] projpath --> planprojpath
2043 %% %% syntaxe : x y z [normal] bool projpath --> planprojpath
2044 %% %% syntaxe : solid i projpath --> solidprojpath
2045 %% %% syntaxe : solid i bool projpath --> solidprojpath
2046 %% %% syntaxe : solid i str bool projpath --> solidprojpath
2047 %% %% syntaxe : solid i alpha str bool projpath --> solidprojpath
2056 %% mybool planprojpath
2058 %% mybool solidprojpath
2063 %% syntaxe : solid i str bool solidprojpath --> -
2065 %% syntaxe : solid i alpha str bool solidprojpath --> -
2066 %% projette le chemin courant sur la face i du solide, apres
2067 %% eventuellement une rotation d angle alpha autour de la normale
2068 %% bool : pour savoir si on tient compte de la visibilite
2071 /visibility exch def
2084 (Error : mauvais type d argument dans solidprojpath) ==
2086 /n solid solidnombrefaces def
2088 visibility not solid i solidfacevisible? or {
2089 currentdict /option known {
2092 solid i solidcentreface
2095 solid 0 i solidgetsommetface
2096 solid 1 i solidgetsommetface
2097 vecteur3d normalize3d
2098 solid i solidnormaleface alpha
2099 ] false planprojpath
2104 (Error : indice trop grand dans solidprojpath) ==
2110 %% syntaxe : x y z [normal] bool planprojpath
2113 /visibility exch def
2114 %% on calcule l image de la base (I,J,K)
2115 normalvect_to_orthobase
2123 visibility not x y z imageK planvisible? or {
2130 3dto2d jtoppoint} currentppathtransform
2137 %%%%% ### projscene ###
2138 %% syntaxe : plantype bool bprojscene ... eprojscene
2148 /savestroke {SolidesDict /stroke get exec} def
2149 /stroke {l@pl@n mybool projpath savestroke} def
2150 /savefill {SolidesDict /fill get exec} def
2151 /fill {l@pl@n mybool projpath savefill} def
2153 l@pl@n plangetrange aload pop
2156 %% xmin ymin l@pl@n pointplan smoveto
2157 %% xmin ymax l@pl@n pointplan slineto
2158 %% xmax ymax l@pl@n pointplan slineto
2159 %% xmax ymin l@pl@n pointplan slineto
2160 %% xmin ymin l@pl@n pointplan smoveto
2162 %% %gsave orange fill grestore
2170 %%%%% ### fin insertion ###
2172 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2173 %%%% fonctions numeriques %%%%
2174 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2176 %%%%% ### courbeparam ###
2178 /resolution exch def
2182 /courbe_dic 2 dict def
2183 courbe_dic /X {} put
2184 courbe_dic /Y {} put
2186 %% syntaxe : tmin tmax C@urbeparam_
2192 /dt tmax@ tmin@ sub resolution 1 sub div def
2193 tmin@ courbe_dic /X get exec
2195 tmin@ courbe_dic /Y get exec
2200 t courbe_dic /X get exec
2202 t courbe_dic /Y get exec
2206 /t t dt add store %% on incremente
2209 tmax@ courbe_dic /X get exec
2211 tmax@ courbe_dic /Y get exec
2217 %% syntaxe : tmin tmax {X} {Y} Courbeparam_
2219 courbe_dic exch /Y exch put
2220 courbe_dic exch /X exch put
2224 %% syntaxe : {X} {Y} courbeparam_
2232 %% syntaxe : tmin tmax {X} {Y} Courbeparam
2241 courbe_dic exch /Y exch put
2242 courbe_dic exch /X exch put
2247 tmin courbe_dic /X get exec
2249 tmin courbe_dic /Y get exec
2251 smoveto %% on commence le chemin
2252 tmin tmax C@urbeparam_
2257 currentdict /option known
2259 /dt tmax tmin sub resolution 1 sub div def
2260 tmin dt add courbe_dic /X get exec
2261 tmin dt add courbe_dic /Y get exec
2262 tmin courbe_dic /X get exec
2263 tmin courbe_dic /Y get exec
2265 tmax dt sub courbe_dic /X get exec
2266 tmax dt sub courbe_dic /Y get exec
2267 tmax courbe_dic /X get exec
2268 tmax courbe_dic /Y get exec
2269 currentdict /dt undef
2276 currentlinewidth 0 eq {} {stroke} ifelse
2282 %% syntaxe : {X} {Y} courbeparam
2300 %% syntaxe : tmin tmax {X} {Y} Courbeparam*
2303 /startest {true} def
2308 %% syntaxe : {X} {Y} courbeparam*
2311 /startest {true} def
2316 %%%%% ### courbe ###
2317 %% syntaxe : {f} courbe
2319 dup isstring %% y a-t-il une option de fin de ligne ?
2335 %% syntaxe : mini maxi {f} Courbe
2348 %% syntaxe : {f} courbe_
2356 %% syntaxe : mini maxi {f} Courbe_
2363 %% syntaxe : mini maxi {f} Courbe*
2366 /startest {true} def
2371 %% syntaxe : {f} courbe*
2374 /startest {true} def
2379 %%%%% ### courbeR2 ###
2380 %% syntaxe : tmin tmax C@urbeR2_
2386 /dt tmax@ tmin@ sub resolution 1 sub div def
2387 tmin@ courbe_dic /X get exec
2393 t courbe_dic /X get exec
2396 /t t dt add store %% on incremente
2399 tmax@ courbe_dic /X get exec
2405 %% syntaxe : tmin tmax {X} CourbeR2_
2407 courbe_dic exch /X exch put
2411 %% syntaxe : {X} courbeR2_
2419 %% syntaxe : tmin tmax {X} CourbeR2
2436 courbe_dic exch /X exch put
2443 currentlinewidth 0 eq {} {stroke} ifelse
2449 %% syntaxe : {X} courbeR2
2456 %% syntaxe : tmin tmax {X} CourbeR2*
2459 /startest {true} def
2464 %% syntaxe : {X} {Y} courbeR2*
2467 /startest {true} def
2472 %%%%% ### courbeR3 ###
2473 %% syntaxe : t1 t2 {f} (option) CourbeR3
2479 /lafonction exch def
2481 currentdict /option known
2488 %% syntaxe : {f} (option) CourbeR3
2490 tmin tmax 3 -1 roll CourbeR3
2493 %%%%% ### cercle ###
2494 %% syntaxe : x0 y0 r cercle
2500 0 360 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam
2504 %% syntaxe : x0 y0 r cercle_
2510 x@ r@y@n add y@ smoveto
2511 0 360 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
2515 %% syntaxe : x0 y0 r cercle-_
2521 x@ r@y@n add y@ smoveto
2522 360 0 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
2526 %% syntaxe : x0 y0 r cercle*
2534 %% syntaxe : alpha beta x0 y0 r Cercle
2543 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add}
2544 currentdict /option known
2551 %% syntaxe : alpha beta x0 y0 r Cercle_
2557 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
2561 %% syntaxe : alpha beta x0 y0 r Cercle
2564 /startest {true} def
2569 %%%%% ### fin insertion ###
2571 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2572 %%%% fonctions et constantes mathematiques %%%%
2573 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2576 %%%%%%%%%%% constantes mathematiques %%%%%%%%%%%%%%
2581 %%%%%%%%%%% fonctions mathematiques %%%%%%%%%%%%%%%
2583 /rd {180 pi div mul} def %% transforme des rd en degres
2584 /deg {pi mul 180 div} def %% transforme des degres en rd
2585 /log {ln 10 ln div} def
2586 /Exp {e exch exp} def
2589 /tan {dup sin exch cos div} def
2590 /cotan {dup cos exch sin div} def
2591 /Tan {dup Sin exch Cos div} def
2592 /Cotan {dup Cos exch Sin div} def
2600 /Arctan {arctan deg} def
2603 dup mul neg 1 add sqrt
2607 /Arccos {arccos deg} def
2613 dup mul neg 1 add sqrt
2621 /Arcsin {arcsin deg} def
2622 /cosh {dup Exp exch neg Exp add 2 div} def
2623 /sinh {dup Exp exch neg Exp sub 2 div} def
2624 /tanh {dup sinh exch cosh div} def
2625 /cotanh {dup cosh exch sinh div} def
2626 /argcosh {dup dup mul 1 sub sqrt add ln} def
2627 /argsinh {dup dup mul 1 add sqrt add ln} def
2639 {dup 1 sub factorielle mul}
2647 x m sub dup mul sigma dup mul 2 mul div neg Exp
2648 2 pi mul sigma dup mul mul sqrt div
2651 %% syntaxe : a n modulo
2678 duparray /table exch def pop
2680 1 1 table length 1 sub {
2693 %%%%% ### setcolor ###
2694 %% syntaxe : tableau setcolor
2697 {aload pop setcmykcolor}
2698 {aload pop setrgbcolor}
2703 %% cherche si un elt donne appartient au tableau donne
2704 %% rque : utilise 3 variables locales
2705 %% syntaxe : elt array in --> index boolean
2711 false %% la reponse a priori
2713 liste i get elt eq {
2714 pop %% en enleve la reponse
2715 i true %% pour mettre la bonne
2723 %% cherche si un elt donne appartient au tableau donne
2724 %% syntaxe : elt array in --> boolean
2730 false %% la reponse a priori
2732 liste i get elt eq {
2733 pop %% en enleve la reponse
2734 true %% pour mettre la bonne
2742 %%%%% ### starfill ###
2743 %% la procedure pour les objets "star"
2744 %% si c est "star" on fait le fillstyle, sinon non
2756 %% syntaxe : u v addv --> u+v
2757 /addv { %% xA yA xB yB
2758 3 1 roll %% xA yB yA xB
2759 4 1 roll %% xB xA yB yA
2760 add 3 1 roll %% yB+yA xB xA
2764 %%%%% ### continu ###
2769 %%%%% ### trigospherique ###
2770 %% passage spherique --> cartesiennes
2771 %% les formules de passage ont été récupérées ici :
2772 %% http://fr.wikipedia.org/wiki/Coordonn%C3%A9es_polaires
2773 %% syntaxe : r theta phi rtp2xyz -> x y z
2779 /x phi cos theta cos mul r mul def
2780 /y phi cos theta sin mul r mul def
2781 /z phi sin r mul def
2786 %% trace d'un arc sur une sphere de centre O
2787 %% syntaxe : r theta1 phi1 r theta2 phi2 arcspherique
2801 1 theta1 phi1 rtp2xyz /u defpoint3d
2802 1 theta2 phi2 rtp2xyz /v defpoint3d
2803 u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d
2805 /sinalpha u v vectprod3d norme3d def
2806 /cosalpha u v scalprod3d def
2807 /alpha sinalpha cosalpha atan def
2809 /pas alpha n div def
2816 u t cos r mul mulv3d
2817 w t sin r mul mulv3d
2821 currentdict /option known {
2829 %% trace d'un arc sur une sphere de centre O
2830 %% syntaxe : r theta1 phi1 r theta2 phi2 arcspherique
2841 1 theta1 phi1 rtp2xyz /u defpoint3d
2842 1 theta2 phi2 rtp2xyz /v defpoint3d
2843 u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d
2845 /sinalpha u v vectprod3d norme3d def
2846 /cosalpha u v scalprod3d def
2847 /alpha sinalpha cosalpha atan def
2849 /pas alpha n div def
2855 u t cos r mul mulv3d
2856 w t sin r mul mulv3d
2863 %% trace d'une geodesique sur une sphere de centre O
2864 %% syntaxe : r theta1 phi1 r theta2 phi2 geodesique_sphere
2865 /geodesique_sphere {
2875 1 theta1 phi1 rtp2xyz /u defpoint3d
2876 1 theta2 phi2 rtp2xyz /v defpoint3d
2877 u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d
2879 /sinalpha u v vectprod3d norme3d def
2880 /cosalpha u v scalprod3d def
2881 /alpha sinalpha cosalpha atan def
2889 u t cos r mul mulv3d
2890 w t sin r mul mulv3d
2899 %% syntaxe : A B C trianglespherique --> trace le rtiangle ABC
2900 %% (coordonnees spheriques)
2901 /trianglespherique* {
2903 /startest {true} def
2908 /trianglespherique {
2915 A rtp2xyz 3dto2d smoveto
2921 currentlinewidth 0 eq {} {stroke} ifelse
2926 %%%%% ### fin insertion ###
2928 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2929 %%%% operations sur les tableaux %%%%
2930 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2932 %%%%% ### duparray ###
2941 %%%%% ### append ###
2942 %% syntaxe : string1 string2 append --> concatene les 2 chaines ou fusionne 2 tableaux
2948 [ tab1 aload pop tab2 aload pop ]
2952 /result str1 length str2 length add string def
2953 str1 result copy pop
2954 result str1 length str2 putinterval
2960 %%%%% ### rollparray ###
2961 %% syntaxe : array n rollparray -> array
2962 %% opere une rotation de n sur les couplets du tableau array
2972 [ table aload pop 2 {n 1 roll} repeat ]
2975 [ table aload pop 2 {n -1 roll} repeat ]
2983 %%%%% ### bubblesort ###
2984 %% syntaxe : array bubblesort --> array2 trie par ordre croissant
2985 %% code de Bill Casselman
2986 %% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
2990 /n a length 1 sub def
2992 % at this point only the n+1 items in the bottom of a remain to
2993 % the sorted largest item in that blocks is to be moved up into
2998 a i get a i 1 add get gt {
2999 % if a[i] > a[i+1] swap a[i] and a[i+1]
3003 % set new a[i] = old a[i+1]
3005 % set new a[i+1] = old a[i]
3016 %% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
3017 %% trie par ordre croissant et array2 correspond a la position des
3018 %% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
3019 %% code de Bill Casselman, modifie par jpv, 15/08/2006
3020 %% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
3024 /n table length 1 sub def
3025 /indices [ 0 1 n {} for ] def
3027 % at this point only the n+1 items in the bottom of a remain to
3028 % the sorted largest item in that blocks is to be moved up into
3033 table i get table i 1 add get gt {
3034 % if a[i] > a[i+1] swap a[i] and a[i+1]
3037 table i table i 1 add get
3038 % set new a[i] = old a[i+1]
3040 % set new a[i+1] = old a[i]
3045 indices i indices i 1 add get
3046 % set new a[i] = old a[i+1]
3048 % set new a[i+1] = old a[i]
3059 %%%%% ### quicksort ###
3060 %% src : http://www.math.ubc.ca/~cass/graphics/text/www/code/sort.inc
3061 %% code de Bill Casselman, modifie par jpv, 18/10/2007
3063 /qsortdict 8 dict def
3067 % args: /comp a L R x
3068 % effect: effects a partition into two pieces [L j] [i R]
3069 % leaves i j on stack
3071 /partition { 8 dict begin
3079 a i get x comp exec not {
3085 x a j get comp exec not {
3096 indices j indices i get
3097 indices i indices j get
3110 % effect: sorts a[L .. R] according to comp
3115 % /c a [L R] /c a [L R]
3117 % /c a [L R] /c a L R L R
3119 % /c a [L R] /c a L R (L+R)/2
3121 % /c a [L R] /c a L R x
3124 % if j > L subsort(a, L, j)
3130 % /c a [L R] i j /c a [L R] i j
3132 % /c a [L R] i j /c a [L R] j
3140 % if i < R subsort(a, i, R)
3154 % effect: sorts the array a
3155 % comp returns truth of x < y for entries in a
3157 /quicksort { qsortdict begin
3170 % ----------------------------------------
3172 %% fin du code de Bill Casselman
3174 %% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
3175 %% trie par ordre croissant et array2 correspond a la position des
3176 %% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
3177 %% code de Bill Casselman, modifie par jpv, 18/10/2007
3178 %% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
3183 a dup length /n exch def
3184 /indices [0 1 n 1 sub {} for ] def
3202 %% syntaxe : [x1 ... xn] (f) apply --> [f(x1) ... f(xn)]
3206 {/fonction exch cvx def}
3207 {/fonction exch def}
3213 liste @i get fonction
3224 %% syntaxe : [x1 ... xn] (f) papply
3228 {/fonction exch cvx def}
3229 {/fonction exch def}
3234 liste length 2 idiv {
3248 %% syntaxe : [x1 ... xn] (f) capply
3252 {/fonction exch cvx def}
3253 {/fonction exch def}
3258 liste length 3 idiv {
3273 %%%%% ### reverse ###
3274 %% syntaxe : array reverse --> inverse l ordre des items dans
3278 /le_tableau exch def
3279 /n le_tableau length def
3290 %% syntaxe : array_points reversep --> inverse l ordre des points dans
3294 /le_tableau exch def
3295 /n le_tableau length 2 idiv def
3307 %% syntaxe : array_points n getp --> le n-ieme point du tableau de
3308 %% points array_points
3316 %%%%% ### fin insertion ###
3318 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3320 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3322 %%%%% ### linear ###
3323 %% syntaxe : M i j any --> depose any dans M en a_ij
3336 %% syntaxe : M i j get_ij --> le coeff c_ij
3343 %% syntaxe : M i L put_Li --> remplace dans M la ligne Li par L
3348 %% syntaxe : M i get_Li --> la ligne Li de M
3353 %%%%% ### fin insertion ###
3355 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3356 %%%% geometrie 3d (calculs) %%%%
3357 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3359 %%%%% ### p3dtoplane ###
3360 %% syntaxe : x y z P p3dtoplane --> X Y
3365 leplan plangetbase 0 getp3d /U defpoint3d
3366 leplan plangetbase 1 getp3d /V defpoint3d
3367 leplan plangetorigine /I defpoint3d
3368 I M vecteur3d U scalprod3d
3369 I M vecteur3d V scalprod3d
3373 %%%%% ### pplaneto3d ###
3374 %% syntaxe : x y P pplaneto3d --> X Y Z
3380 leplan plangetbase 0 getp3d /U defpoint3d
3381 leplan plangetbase 1 getp3d /V defpoint3d
3382 leplan plangetorigine /I defpoint3d
3389 %%%%% ### orthoprojplane3d ###
3390 %% Projection orthogonale d'un point 3d sur un plan
3391 %% Mx My Mz (=le point a projeter)
3392 %% Ax Ay Az (=un point du plan)
3393 %% Vx Vy Vz (un vecteur normal au plan)
3398 monplan plangetorigine
3399 monplan plangetbase aload pop vectprod3d
3404 /VN {V unitaire3d} def
3405 VN M A vecteur3d VN scalprod3d mulv3d
3410 %%%%% ### sortp3d ###
3447 %%%%% ### dupp3d ###
3448 %% duplique le vecteur 3d
3452 /dupv3d {dupp3d} def
3454 %%%%% ### angle3d ###
3455 %% syntaxe : vect1 vect2 angle3d
3458 normalize3d /vect2 defpoint3d
3459 normalize3d /vect1 defpoint3d
3460 /cosalpha vect1 vect2 scalprod3d def
3461 /sinalpha vect1 vect2 vectprod3d norme3d def
3462 sinalpha cosalpha atan
3466 %%%%% ### transformpoint3d ###
3467 %% syntaxe : x y z a11 a21 a31 a12 a22 a32 a13 a23 a33
3468 %% transformpoint3d -> X Y Z
3483 a11 x mul a12 y mul add a13 z mul add
3484 a21 x mul a22 y mul add a23 z mul add
3485 a31 x mul a32 y mul add a33 z mul add
3489 %%%%% ### normalize3d ###
3490 %% rend le vecteur 3d unitaire. Ne fait rien si u=0
3491 /unitaire3d { %% x y z
3494 /norme u norme3d def
3498 u 1 norme div mulv3d
3502 /normalize3d {unitaire3d} def
3504 %%%%% ### geom3d ###
3505 %% syntaxe : A k1 B k2 barycentre3d -> G, barycentre du systeme
3506 %% [(A, k1) (B, k2)]
3516 1 k1 k2 add div mulv3d
3520 %% syntaxe : array isobarycentre3d --> G
3524 /n table length 3 idiv def
3534 %% syntaxe : M A alpha hompoint3d -> le point M' tel que AM' = alpha AM
3540 A M vecteur3d alpha mulv3d A addv3d
3544 %% syntaxe : M A sympoint3d -> le point M' tel que AM' = -AM
3549 A M vecteur3d -1 mulv3d A addv3d
3553 %% syntaxe : A u translatepoint3d --> B image de A par la translation de vecteur u
3572 % syntaxe : M alpha_x alpha_y alpha_z rotateOpoint3d --> M'
3581 /c1 {RotX cos} bind def
3582 /c2 {RotY cos} bind def
3583 /c3 {RotZ cos} bind def
3584 /s1 {RotX sin} bind def
3585 /s2 {RotY sin} bind def
3586 /s3 {RotZ sin} bind def
3587 /M11 {c2 c3 mul} bind def
3588 /M12 {c3 s1 mul s2 mul c1 s3 mul sub} bind def
3589 /M13 {c1 c3 mul s2 mul s1 s3 mul add} bind def
3590 /M21 {c2 s3 mul} bind def
3591 /M22 {s1 s2 mul s3 mul c1 c3 mul add} bind def
3592 /M23 {s3 s2 mul c1 mul c3 s1 mul sub} bind def
3593 /M31 {s2 neg} bind def
3594 /M32 {s1 c2 mul} bind def
3595 /M33 {c1 c2 mul} bind def
3596 M11 Xpoint mul M12 Ypoint mul add M13 Zpoint mul add
3597 M21 Xpoint mul M22 Ypoint mul add M23 Zpoint mul add
3598 M31 Xpoint mul M32 Ypoint mul add M33 Zpoint mul add
3602 %%%%% ### symplan3d ###
3603 %% syntaxe : M eqplan/plantype symplan3d --> M'
3604 %% ou M' symetrique de M par rapport au plan P defini par eqplan/plantype
3608 plan2eq /args exch def
3620 /n_U a1 dup mul b1 dup mul add c1 dup mul add sqrt def
3625 /u a x mul b y mul add c z mul add d add def
3632 %%%%% ### vecteur3d ###
3633 %% creation du vecteur AB a partir de A et B
3634 /vecteur3d { %% xA yA zA xB yB zB
3648 %%%%% ### vectprod3d ###
3649 %% produit vectoriel de deux vecteurs 3d
3650 /vectprod3d { %% x1 y1 z1 x2 y2 z2
3658 y zp mul z yp mul sub
3659 z xp mul x zp mul sub
3660 x yp mul y xp mul sub
3664 %%%%% ### scalprod3d ###
3665 %% produit scalaire de deux vecteurs 3d
3666 /scalprod3d { %% x1 y1 z1 x2 y2 z2
3674 x xp mul y yp mul add z zp mul add
3678 %%%%% ### papply3d ###
3679 %% syntaxe : [A1 ... An] (f) papply3d --> [f(A1) ... f(An)]
3686 liste length 3 idiv {
3701 %%%%% ### defpoint3d ###
3702 %% creation du point A a partir de xA yA yB et du nom /A
3703 /defpoint3d { %% xA yA zA /nom
3706 [ 4 1 roll ] cvx memo exch
3710 %%%%% ### distance3d ###
3711 /distance3d { %% A B
3716 /getp3d { %% [tableau de points 3d] i --> donne le ieme point du tableau
3725 %%%%% ### norme3d ###
3726 %% norme d un vecteur 3d
3732 x dup mul y dup mul add z dup mul add sqrt
3736 %%%%% ### mulv3d ###
3737 %% (scalaire)*(vecteur 3d) Attention : dans l autre sens !
3738 /mulv3d { %% x y z lambda
3750 %%%%% ### addv3d ###
3751 %% addition de deux vecteurs 3d
3752 /addv3d { %% x1 y1 z1 x2 y2 z2
3766 %%%%% ### milieu3d ###
3767 /milieu3d { %% A B --> I le milieu de [AB]
3782 4 {8 -1 roll} repeat
3790 %%%%% ### ABpoint3d ###
3791 %% syntaxe : A B k ABpoint3d --> M
3792 %% M tel que vect(AM) = k vect (AB)
3804 %%%%% ### angle3doriente ###
3805 %% syntaxe : vect1 vect2 vect3 angle3d
3806 %% vect3 est la normale au plan (vect1, vect2)
3809 normalize3d /vect3 defpoint3d
3810 normalize3d /vect2 defpoint3d
3811 normalize3d /vect1 defpoint3d
3812 /cosalpha vect1 vect2 scalprod3d def
3813 /sinalpha vect1 vect2 vectprod3d vect3 scalprod3d def
3814 sinalpha cosalpha atan
3818 %%%%% ### points3dalignes ###
3819 %% syntaxe : A B C points3dalignes -> bool
3825 A B vecteur3d /u defpoint3d
3826 A C vecteur3d /v defpoint3d
3827 u v vectprod3d norme3d 1E-7 lt
3831 %% syntaxe : M A B point3dsursegment --> true si M in [AB], false sinon
3832 /point3dsursegment {
3837 M A B points3dalignes {
3851 %%%%% ### fin insertion ###
3853 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3854 %%%% geometrie 3d (dessins) %%%%
3855 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3857 %%%%% ### point3d ###
3862 /points3d { %% tableau de points3d
3866 %%%%% ### ligne3d ###
3867 %% [tableau de points3d] option --> trace la ligne brisee
3874 currentdict /option known
3881 %% [tableau de points3d] option --> trace la ligne brisee
3888 currentdict /option known
3895 %%%%% ### tab3dto2d ###
3896 %% transforme un tableau de points 3d en tableau de points 2d
3902 n 1 sub -1 n 3 idiv 2 mul
3910 %%%%% ### polygone3d ###
3911 /polygone3d { %% tableau de points3d
3915 /polygone3d* { %% tableau de points3d
3919 %%%%% ### fin insertion ###
3921 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3922 %%%% gestion du texte %%%%
3923 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3926 /xmkstep 1 def % les marques sur Ox
3927 /xmarkstyle {dctext} def
3928 /ymarkstyle {(-1 0) bltext} def
3934 /Courier findfont .8 fontsize mul scalefont setfont
3935 dup dup truncate eq {
3936 cvi dup chaine cvs exch
3944 /n xmax xmax xmin sub 1000 div sub xmkstep div truncate cvi
3945 xmkstep mul def % mark max
3946 /i xmin xmkstep div truncate cvi
3947 xmkstep mul def % la 1ere
3948 i xmin lt {/i i xmkstep add store} if
3951 /i i xmkstep abs add store
3957 /ymkstep 1 def % les marques sur Oy
3963 /Courier findfont .8 fontsize mul scalefont setfont
3969 /n ymax ymax ymin sub 1000 div sub ymkstep div truncate cvi
3970 ymkstep mul def % mark max
3971 /i ymin ymkstep div truncate cvi
3972 ymkstep mul def % la 1ere
3975 /i i ymkstep abs add store
3990 %%%%% ### setfontsize ###
3995 %%%%% ### setCourrier ###
3997 dup length dict begin
4004 /Encoding ISOLatin1Encoding def
4008 /Courier-ISOLatin1 exch definefont pop
4011 /Courier-ISOLatin1 findfont
4016 %%%%% ### pathtext ###
4017 %% syntaxe : string x y initp@thtext
4037 %% syntaxe : string x y cctext_
4040 llx wx add lly wy add -.5 mulv rmoveto
4060 hadjust neg 0 rmoveto
4068 wx llx add -.5 mul 0 rmoveto
4081 hadjust vadjust rmoveto
4082 llx neg lly neg rmoveto
4088 hadjust neg vadjust rmoveto
4089 wx neg lly neg rmoveto
4096 llx wx add -.5 mul lly neg rmoveto
4102 hadjust vadjust neg rmoveto
4103 llx neg wy neg rmoveto
4109 0 vadjust neg rmoveto
4116 hadjust neg vadjust neg rmoveto
4117 wx neg wy neg rmoveto
4123 0 vadjust neg rmoveto
4124 llx wx add -2 div wy neg rmoveto
4131 llx neg lly wy add -2 div rmoveto
4138 0 lly wy add -2 div rmoveto
4144 hadjust neg 0 rmoveto
4145 wx neg lly wy add -2 div rmoveto
4152 llx wx add lly wy add -.5 mulv rmoveto
4156 %%%%% ### text3d ###
4157 %%%% Version 3d des commandes jps TEXTE
4160 % /vect_echelle [1 1] def
4161 % /angle_de_rot {0} def
4163 % {/angle_de_rot exch def}
4166 % {/vect_echelle exch def}
4167 % if% CamView vect_echelle {angle_de_rot}
4363 %%%%% ### fin insertion ###
4365 %% La macro provisoire de developpement (27/01/2009)
4366 %% syntaxe : solid table tablez --> -
4374 %% a-t-on des couleurs nommees ?
4375 usertable 0 get isstring {
4376 %% oui, et autant que d etages
4377 usertable length 1 sub tablez length eq {
4378 /table usertable def
4380 %% oui, mais moins que d etages
4381 %% ==> on definit les 2 premieres en RGB
4382 /a0 usertable 0 get def
4383 /a1 usertable 1 get def
4386 [a0 cvx exec] length 0 eq {
4387 a0 cvx exec currentrgbcolor
4395 [a1 cvx exec] length 0 eq {
4396 a1 cvx exec currentrgbcolor
4402 /usertable [lacouleurdepart lacouleurarrivee] def
4405 usertable 0 get isnum {
4406 %% c est un degrade : nb de couleurs a definir
4407 /n tablez length 1 add def
4409 usertable length 4 eq {
4410 /a0 usertable 0 get def
4411 /a1 usertable 1 get def
4412 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4413 /B usertable 2 get def
4414 /C usertable 3 get def
4416 /espacedecouleurs (sethsbcolor) def
4419 usertable length 6 eq {
4420 /a0 usertable 0 get def
4421 /b0 usertable 1 get def
4422 /c0 usertable 2 get def
4423 /a1 usertable 3 get def
4424 /b1 usertable 4 get def
4425 /c1 usertable 5 get def
4426 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4427 /B {b0 i b1 b0 sub mul n 1 sub div add} def
4428 /C {c0 i c1 c0 sub mul n 1 sub div add} def
4430 /espacedecouleurs (setrgbcolor) def
4433 usertable length 7 eq {
4434 /a0 usertable 0 get def
4435 /b0 usertable 1 get def
4436 /c0 usertable 2 get def
4437 /a1 usertable 3 get def
4438 /b1 usertable 4 get def
4439 /c1 usertable 5 get def
4440 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4441 /B {b0 i b1 b0 sub mul n 1 sub div add} def
4442 /C {c0 i c1 c0 sub mul n 1 sub div add} def
4444 /espacedecouleurs (sethsbcolor) def
4447 usertable length 8 eq {
4448 /a0 usertable 0 get def
4449 /b0 usertable 1 get def
4450 /c0 usertable 2 get def
4451 /d0 usertable 3 get def
4452 /a1 usertable 4 get def
4453 /b1 usertable 5 get def
4454 /c1 usertable 6 get def
4455 /d1 usertable 7 get def
4456 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4457 /B {b0 i b1 b0 sub mul n 1 sub div add} def
4458 /C {c0 i c1 c0 sub mul n 1 sub div add} def
4459 /D {d0 i d1 d0 sub mul n 1 sub div add} def
4460 /espacedecouleurs (setcmykcolor) def
4463 usertable length 2 eq {
4464 /a0 usertable 0 get def
4465 /a1 usertable 1 get def
4468 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4472 /espacedecouleurs (sethsbcolor) def
4476 %% on affecte la table des couleurs
4480 [A B C D] espacedecouleurs astr2str
4485 /n solid solidnombrefaces def
4488 solid i solidcentreface /z exch def pop pop
4490 0 1 tablez length 1 sub {
4492 /ztest tablez j get def
4497 /resultat j 1 add store
4500 solid i table resultat get solidputfcolor
4506 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4507 %%%% bibliotheque sur les solides %%%%
4508 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4510 %%%%% ### solide ###
4511 %% solid = [Sommets Faces Colors_Faces InOut_Table]
4515 /solidgetpointstable {solidgetsommets} def
4532 %% syntaxe : solid i solidgetfcolor --> str
4536 solidgetfcolors i get
4540 %% syntaxe : solid i str solidputfcolor --> -
4545 solidgetfcolors i str put
4549 /solidgetinouttable {
4556 /solidputpointstable {solidputsommets} def
4562 %% syntaxe : solid solidfacesreverse -> -
4563 /solidfacesreverse {
4566 /n solid solidnombrefaces def
4569 /F solid i solidgetface reverse def
4571 solid i [F aload pop m 0 roll ] solidputface
4580 /solidputinouttable {
4584 %% syntaxe : any issolid --> booleen, vrai si any est de type solid
4589 candidat length 4 eq {
4590 candidat 0 get isarray
4591 candidat 1 get isarray and
4592 candidat 2 get isarray and
4593 candidat 3 get isarray and {
4594 /IO candidat 3 get def
4615 /S solid solidgetsommets def
4616 /F solid solidgetfaces def
4617 /FC solid solidgetfcolors def
4618 /IO solid solidgetinouttable def
4623 FC duparray exch pop
4624 IO duparray exch pop
4629 %% syntaxe : solid array solidputinfaces --> -
4632 /facesinternes exch def
4634 /n2 facesinternes length def
4635 /IO solid solidgetinouttable def
4636 /facesexternes solid solidgetoutfaces def
4637 /n1 facesexternes length def
4639 [facesexternes aload pop facesinternes aload pop]
4644 IO 3 n1 n2 add 1 sub put
4648 %% syntaxe : solid array solidputoutfaces --> -
4651 /facesexternes exch def
4653 /n1 facesexternes length def
4654 /IO solid solidgetinouttable def
4655 /facesinternes solid solidgetinfaces def
4656 /n2 facesinternes length def
4658 [facesexternes aload pop facesinternes aload pop]
4663 IO 3 n1 n2 add 1 sub put
4667 /solidnombreinfaces {
4670 solid solidwithinfaces {
4671 /IO solid solidgetinouttable def
4672 IO 3 get IO 2 get sub 1 add
4679 /solidnombreoutfaces {
4682 /IO solid solidgetinouttable def
4683 IO 1 get IO 0 get sub 1 add
4687 %% syntaxe : solid solidgetinfaces --> array
4692 (Error : mauvais type d argument dans solidgetinfaces) ==
4695 solid solidwithinfaces {
4696 /IO solid solidgetinouttable def
4697 /F solid solidgetfaces def
4700 /n n2 n1 sub 1 add def
4708 %% syntaxe : solid solidgetoutfaces --> array
4713 (Error : mauvais type d argument dans solidgetoutfaces) ==
4716 /IO solid solidgetinouttable def
4717 /F solid solidgetfaces def
4720 /n n2 n1 sub 1 add def
4725 %% /tracelignedeniveau? false def
4726 %% /hauteurlignedeniveau 1 def
4727 %% /couleurlignedeniveau {rouge} def
4728 %% /linewidthlignedeniveau 4 def
4734 /solidgrid false def
4737 %% syntaxe : solid i string solidputfcolor
4738 %% syntaxe : solid str outputcolors
4739 %% syntaxe : solid str1 str2 inoutputcolors
4740 %% syntaxe : solid string n solidputncolors
4741 %% syntaxe : solid array solidputincolors --> -
4742 %% syntaxe : solid array solidputoutcolors --> -
4743 %% syntaxe : solid solidgetincolors --> array
4744 %% syntaxe : solid solidgetoutcolors --> array
4746 %% syntaxe : solid array solidputinfaces --> -
4747 %% syntaxe : solid array solidputoutfaces --> -
4748 %% syntaxe : solid solidgetinfaces --> array
4749 %% syntaxe : solid solidgetoutfaces --> array
4751 %% syntaxe : solid1 solid2 solidfuz -> solid
4753 %% syntaxe : solid i solidgetsommetsface -> array
4754 %% array = tableau de points 3d
4755 /solidgetsommetsface {
4759 /F solid i solidgetface def
4761 0 1 F length 1 sub {
4763 solid F k get solidgetsommet
4769 %% syntaxe : solid index table solidputface -> -
4774 solidgetfaces i table put
4778 %% syntaxe : solid table solidaddface -> -
4779 %% syntaxe : solid table (couleur) solidaddface -> -
4780 %% on ne se preoccupe pas des faces internes
4790 /IO solid solidgetinouttable def
4792 /FC solid solidgetoutcolors def
4794 solid [ solid solidgetfaces aload pop table ] solidputfaces
4795 solid IO solidputinouttable
4796 % solid solidnombrefaces
4798 FC aload pop lac@uleur
4806 solid solidnombreinfaces
4807 solid solidnombreoutfaces
4812 %% syntaxe : solid M solidaddsommetexterne -> -
4813 %% on ajoute le sommet sans se preoccuper de rien
4814 /solidaddsommetexterne {
4819 [ solid solidgetsommets aload pop M ]
4824 %% syntaxe : solid array solidaddsommets -> -
4829 /n table length 3 idiv def
4832 solid table i getp3d solidaddsommet pop
4837 %% syntaxe : solid M solidaddsommet -> k
4838 %% on ajoute le sommet M. Si il est deja sur une arete,
4839 %% on l incorpore a la face concernee
4840 %% s il est deja present, on ne le rajoute pas.
4841 %% Renvoie l indice du sommet rajoute.
4846 /nbf solid solidnombrefaces def
4847 /N solid solidnombresommets def
4849 %% le sommet est-il deja dans la structure
4853 %% solid i solidgetsommet == == ==
4855 %% solid i solidgetsommet M eqp3d ==
4857 % solid i solidgetsommet M eqp3d {
4858 solid i solidgetsommet M distance3d 1e-5 le {
4859 %% oui => c est fini
4864 %% non => on le rajoute
4866 solid M solidaddsommetexterne
4867 %% est il sur une arete deja codee
4871 solid i solidgetface /F exch def
4876 solid j i solidgetsommetface
4877 solid j 1 add nbsf mod i solidgetsommetface
4879 %% il est sur l arete concernee
4886 j 1 add nbsf mod dup 0 eq {
4904 %%%%% ### solidrmsommet ###
4905 %% syntaxe : solid i solidrmsommet -> -
4911 (Erreur : mauvais type d argument dans solidrmsommet) ==
4914 solid i solidsommetsadjsommet length 0 gt {
4915 (Erreur : sommet non isole dans solidrmsommet) ==
4919 %% on s occupe des sommets
4920 /n solid solidnombresommets def
4925 solid j solidgetsommet
4929 solid S solidputsommets
4930 %% on s occupe des faces
4931 /n solid solidnombrefaces def
4936 /Fj solid j solidgetface def
4937 [0 1 Fj length 1 sub {
4938 %% sommet d indice k de la face Fj
4946 solid F solidputfaces
4950 %%%%% ### solidsommetsadjsommet ###
4951 %% syntaxe : solid i solidsommetsadjsommet --> array
4952 %% array est le tableau des indices des sommets adjacents au
4953 %% sommet d indice i
4954 /solidsommetsadjsommet {
4958 solid no solidfacesadjsommet /facesadj exch def
4960 /nbadj facesadj length def
4963 %% examen de la jieme face
4965 /F solid facesadj j get solidgetface def
4966 /nbsommetsface F length def
4969 /i1 F index 1 sub nbsommetsface modulo get def
4970 /i2 F index 1 add nbsommetsface mod get def
4971 %% si i1 n est pas deja note, on le rajoute
4975 /sommetsadj [ sommetsadj aload pop i1 ] store
4977 %% si i2 n est pas deja note, on le rajoute
4981 /sommetsadj [ sommetsadj aload pop i2 ] store
4984 (Error : bug dans solidsommetsadjsommet) ==
4992 %%%%% ### solidfacesadjsommet ###
4993 %% syntaxe : solid i solidfacesadjsommet --> array
4994 %% array est le tableau des indices des faces adjacentes au
4995 %% sommet d indice i
4996 /solidfacesadjsommet {
5000 /n solid solidnombrefaces def
5001 /indicesfacesadj [] def
5004 /F solid j solidgetface def
5007 /indicesfacesadj [ indicesfacesadj aload pop j ] store
5014 %%%%% ### ordonnepoints3d ###
5015 %% syntaxe : array1 M ordonnepoints3d --> array2
5016 %% array1 = tableau de points 3d coplanaires (plan P)
5017 %% M = point3d indiquant la direction de la normale a P
5018 %% array2 = les indices des points de depart, ranges dans le
5019 %% sens trigo par rapport a la normale
5024 table isobarycentre3d /G defpoint3d
5025 %% calcul de la normale
5026 table 0 getp3d /ptref defpoint3d
5027 table 1 getp3d /A defpoint3d
5030 vectprod3d /vecteurnormal defpoint3d
5031 vecteurnormal G M vecteur3d scalprod3d 0 lt {
5032 vecteurnormal -1 mulv3d /vecteurnormal defpoint3d
5034 %% la table des angles
5035 table duparray exch pop
5040 vecteurnormal angle3doriente
5042 % [0 1 table length 3 idiv 1 sub {} for]
5044 doublebubblesort pop
5048 %%%%% ### fin insertion ###
5050 %% /tracelignedeniveau? false def
5051 %% /hauteurlignedeniveau 1 def
5052 %% /couleurlignedeniveau {rouge} def
5053 %% /linewidthlignedeniveau 4 def
5055 %% /solidgrid true def
5056 %% /aretescachees true def
5057 %% /defaultsolidmode 2 def
5059 %% syntaxe : alpha beta r h newpie --> solid
5062 [[/resolution /nbetages] [8 1] [10 1] [12 1] [18 3] [36 5]] gestionsolidmode
5069 % alpha cos r mul alpha sin r mul
5070 alpha beta {1 dict begin /t exch def t cos r mul t sin r mul end} CourbeR2+
5071 ] 0 h [nbetages] newprismedroit
5075 %%%%% ### newsolid ###
5076 %% syntaxe : newsolid --> depose le solide nul sur la pile
5081 %%%%% ### generesolid ###
5086 [S F [F length {()} repeat] [0 F length 1 sub -1 -1]]
5090 %%%%% ### nullsolid ###
5091 %% syntaxe : solide nullsolid -> booleen, vrai si le solide est nul
5095 candidat issolid not {
5096 (Error type argument dans "nullsolid") ==
5099 candidat solidgetsommets length 0 eq {
5107 %%%%% ### solidnombreoutfaces ###
5108 /solidnombreoutfaces {
5112 (Error : mauvais type d argument dans solidnombreoutfaces) ==
5118 /IO solid solidgetinouttable def
5126 %%%%% ### solidnombreinfaces ###
5127 /solidnombreinfaces {
5131 (Error : mauvais type d argument dans solidnombreinfaces) ==
5134 solid solidwithinfaces {
5135 /IO solid solidgetinouttable def
5145 %%%%% ### solidtests ###
5146 %% syntaxe : solid solidwithinfaces --> bool, true si le solide est vide
5151 (Error : mauvais type d argument dans solidwithinfaces) ==
5154 /table solid solidgetinouttable def
5163 %%%%% ### solidgetsommet ###
5164 %% syntaxe : solid i j solidgetsommetface --> sommet i de la face j
5165 /solidgetsommetface {
5171 (Error : mauvais type d argument dans solidgetsommetface) ==
5174 /table_faces solid solidgetfaces def
5175 /table_sommets solid solidgetsommets def
5176 /k table_faces j get i get def
5177 table_sommets k getp3d
5181 %% syntaxe : solid i solidgetsommetsface --> array, tableau des
5182 %% sommets de la face i du solide
5183 /solidgetsommetsface {
5188 (Error : mauvais type d argument dans solidgetsommetsface) ==
5191 /table_faces solid solidgetfaces def
5192 /table_sommets solid solidgetsommets def
5193 /table_indices table_faces i get def
5195 0 1 table_indices length 1 sub {
5197 table_sommets table_indices j get getp3d
5203 %% syntaxe : solid i solidgetsommet --> sommet i du solide
5209 (Error : mauvais type d argument dans solidgetsommet) ==
5212 /table_sommets solid solidgetsommets def
5213 table_sommets i getp3d
5217 %%%%% ### solidcentreface ###
5218 %% syntaxe : solid i solidcentreface --> M
5220 solidgetsommetsface isobarycentre3d
5223 %%%%% ### solidnombre ###
5224 /solidnombresommets {
5225 solidgetsommets length 3 idiv
5228 /solidfacenombresommets {
5233 solidgetfaces length
5236 %%%%% ### solidshowsommets ###
5244 /n sol solidnombresommets def
5245 /m sol solidnombrefaces def
5246 currentdict /option known not {
5247 /option [0 1 n 1 sub {} for] def
5249 0 1 option length 1 sub {
5251 option k get /i exch def %% indice du sommet examine
5252 sol i solidgetsommet point3d
5257 %%%%% ### solidnumsommets ###
5261 % Font findfont 10 scalefont setfont
5267 /n sol solidnombresommets def
5268 /m sol solidnombrefaces def
5269 currentdict /option known not {
5270 /option [0 1 n 1 sub {} for] def
5275 0 1 option length 1 sub {
5277 option k get /i exch def %% indice du sommet examine
5279 /j exch def %% indice de la face examinee
5280 i sol j solidgetface in {
5281 %% le sommet i est dans la face j
5286 sol i solidgetsommet /S defpoint3d
5289 %% le sommet i est dans la face j
5290 sol j solidcentreface /G defpoint3d
5291 G S vecteur3d normalize3d
5292 solidnumcoeff dup ptojpoint pop
5303 %%%%% ### gestionsolidmode ###
5304 %% table = [ [vars] [mode0] [mode1] [mode2] [mode3] [mode4] ]
5312 /tableaffectation exch def
5315 /mode defaultsolidmode def
5318 /vars table 0 get def
5319 /nbvars vars length def
5321 /tableaffectation table mode 1 add 5 min get def
5326 tableaffectation i get
5333 %%%%% ### solidfuz ###
5334 %% syntaxe : solid1 solid2 solidfuz -> solid
5339 /S1 solid1 solidgetsommets def
5340 /S2 solid2 solidgetsommets def
5341 /n S1 length 3 idiv def
5346 %% les faces internes et leurs couleurs
5347 /FI1 solid1 solidgetinfaces def
5348 /FIC1 solid1 solidgetincolors def
5349 solid2 solidnombreinfaces 0 eq {
5353 /FI2 solid2 solidgetinfaces {{n add} apply} apply def
5354 /FIC2 solid2 solidgetincolors def
5356 /FI [FI1 aload pop FI2 aload pop] def
5357 /FIC [FIC1 aload pop FIC2 aload pop] def
5359 %% les faces externes et leurs couleurs
5360 /FO1 solid1 solidgetoutfaces def
5361 /FOC1 solid1 solidgetoutcolors def
5362 /FO2 solid2 solidgetoutfaces {{n add} apply} apply def
5363 /FOC2 solid2 solidgetoutcolors def
5364 /FO [FO1 aload pop FO2 aload pop] def
5365 /FOC [FOC1 aload pop FOC2 aload pop] def
5367 /F [FO aload pop FI aload pop] def
5368 /FC [FOC aload pop FIC aload pop] def
5372 dup 1 add dup FI length add 1 sub
5379 dup FC solidputfcolors
5380 dup IO solidputinouttable
5384 %%%%% ### solidnormaleface ###
5385 %% syntaxe : solid i solidnormaleface --> u, vecteur normale a la
5386 %% face d indice i du solide
5392 (Error : mauvais type d argument dans solidgetsommetface) ==
5395 %% solid 0 i solidgetsommetface /G defpoint3d
5397 %% solid 1 i solidgetsommetface
5400 %% solid 2 i solidgetsommetface
5403 /n solid i solidfacenombresommets def
5406 solid 0 i solidgetsommetface
5407 solid 1 i solidgetsommetface
5408 solid 2 i solidgetsommetface
5409 ] isobarycentre3d /G defpoint3d
5411 solid i solidcentreface /G defpoint3d
5413 %% debug %% G 3dto2d point
5415 solid 0 i solidgetsommetface
5417 % gsave bleu A point3d grestore
5419 vecteur3d normalize3d
5421 solid 1 i solidgetsommetface
5423 % gsave orange A point3d grestore
5425 vecteur3d normalize3d
5427 /resultat defpoint3d
5428 resultat normalize3d
5432 %%%%% ### solidtransform ###
5433 %% syntaxe : solid1 {f} solidtransform --> solid2, solid2 est le
5434 %% transforme de solid1 par la transformation f : R^3 -> R^3
5440 (Error : mauvais type d argument dans solidtransform) ==
5444 solid solidgetsommets {@f} papply3d
5446 solid les_sommets solidputsommets
5451 %%%%% ### solidputcolor ###
5452 %% syntaxe : solid i string solidputfcolor
5458 /FC solid solidgetfcolors def
5465 %% syntaxe : solid solidgetincolors --> array
5470 (Error : mauvais type d argument dans solidgetincolors) ==
5473 solid solidwithinfaces {
5474 /fcol solid solidgetfcolors def
5475 /IO solid solidgetinouttable def
5478 /n n2 n1 sub 1 add def
5479 fcol n1 n getinterval
5486 %% syntaxe : solid solidgetoutcolors --> array
5487 /solidgetoutcolors {
5491 (Error : mauvais type d argument dans solidgetoutcolors) ==
5494 /fcol solid solidgetfcolors def
5495 /IO solid solidgetinouttable def
5498 /n n2 n1 sub 1 add def
5499 fcol n1 n getinterval
5503 %% syntaxe : solid array solidputincolors --> -
5506 /newcolorstable exch def
5509 (Error : mauvais type d argument dans solidputincolors) ==
5512 /n newcolorstable length def
5513 n solid solidnombreinfaces ne {
5514 (Error : mauvaise longueur de tableau dans solidputincolors) ==
5518 /FC solid solidgetfcolors def
5519 /IO solid solidgetinouttable def
5521 FC n1 newcolorstable putinterval
5526 %% syntaxe : solid array solidputoutcolors --> -
5527 /solidputoutcolors {
5529 /newcolorstable exch def
5532 (Error : mauvais type d argument dans solidputoutcolors) ==
5535 /n newcolorstable length def
5536 n solid solidnombreoutfaces ne {
5537 (Error : mauvaise longueur de tableau dans solidputoutcolors) ==
5541 /FC solid solidgetfcolors def
5542 /IO solid solidgetinouttable def
5544 FC n1 newcolorstable putinterval
5549 %% syntaxe : solid str outputcolors
5555 (Error : mauvais type d argument dans inoutputcolors) ==
5558 /n solid solidnombreoutfaces def
5559 solid [ n {color} repeat ] solidputoutcolors
5563 %% syntaxe : solid str inputcolors
5569 (Error : mauvais type d argument dans inoutputcolors) ==
5572 /n solid solidnombreinfaces def
5573 solid [ n {color} repeat ] solidputincolors
5577 %% syntaxe : solid str1 str2 inoutputcolors
5583 solid colin inputcolors
5584 solid colout outputcolors
5588 %% syntaxe : solid array solidputoutcolors --> -
5589 /solidputoutcolors {
5591 /newcolorstable exch def
5594 (Error : mauvais type d argument dans solidputoutcolors) ==
5597 /n newcolorstable length def
5598 n solid solidnombreoutfaces ne {
5599 (Error : mauvaise longueur de tableau dans solidputoutcolors) ==
5603 /FC solid solidgetfcolors def
5604 /IO solid solidgetinouttable def
5606 FC length n n1 add lt {
5607 solid newcolorstable solidputfcolors
5609 FC n1 newcolorstable putinterval
5626 %%%%% ### solidputhuecolors ###
5627 %% syntaxe : solid table solidputhuecolors --> -
5628 /solidputhuecolors {
5631 solidgetinouttable /IO exch def
5638 /solidputinhuecolors {
5642 solid solidgetinouttable /IO exch def
5643 solid solidwithinfaces {
5652 /solidputinouthuecolors {
5655 solidgetinouttable /IO exch def
5657 IO 3 get IO 1 get max
5662 %% syntaxe : solid table n1 n2 s@lidputhuec@l@rs --> -
5663 %% affecte les couleurs des faces d indice n1 a n2 du solid solid, par
5664 %% un degrade defini par la table.
5665 /s@lidputhuec@l@rs {
5679 [a0 cvx exec] length 0 eq {
5680 a0 cvx exec currentrgbcolor
5688 [a1 cvx exec] length 0 eq {
5689 a1 cvx exec currentrgbcolor
5695 /table [lacouleurdepart lacouleurarrivee] def
5697 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5701 /espacedecouleurs (sethsbcolor) def
5708 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5712 /espacedecouleurs (sethsbcolor) def
5722 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5723 /B {b0 i b1 b0 sub mul n 1 sub div add} def
5724 /C {c0 i c1 c0 sub mul n 1 sub div add} def
5726 /espacedecouleurs (setrgbcolor) def
5736 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5737 /B {b0 i b1 b0 sub mul n 1 sub div add} def
5738 /C {c0 i c1 c0 sub mul n 1 sub div add} def
5740 /espacedecouleurs (sethsbcolor) def
5752 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5753 /B {b0 i b1 b0 sub mul n 1 sub div add} def
5754 /C {c0 i c1 c0 sub mul n 1 sub div add} def
5755 /D {d0 i d1 d0 sub mul n 1 sub div add} def
5756 /espacedecouleurs (setcmykcolor) def
5762 [A B C D] espacedecouleurs astr2str
5769 %%%%% ### solidrmface ###
5770 %% syntaxe : solid i solidrmface -> -
5776 (Error : mauvais type d argument dans solidrmface) ==
5779 %% on enleve la face
5780 /F solid solidgetfaces def
5781 F length 1 sub i lt {
5782 (Error : indice trop grand dans solidrmface) ==
5786 0 1 F length 1 sub {
5794 solid NF solidputfaces
5795 %% on enleve la couleur correspondante
5796 /FC solid solidgetfcolors def
5798 0 1 FC length 1 sub {
5806 solid NFC solidputfcolors
5807 %% on ajuste la table inout
5808 /IO solid solidgetinouttable def
5809 solid i solidisoutface {
5810 IO 1 IO 1 get 1 sub put
5811 solid solidwithinfaces {
5812 IO 2 IO 2 get 1 sub put
5813 IO 3 IO 3 get 1 sub put
5816 solid i solidisinface {
5817 IO 1 IO 1 get 1 sub put
5818 IO 2 IO 2 get 1 sub put
5819 IO 3 IO 3 get 1 sub put
5821 solid IO solidputinouttable
5825 %% syntaxe : solid table solidrmfaces --> -
5828 /table exch bubblesort reverse def
5830 table {solid exch solidrmface} apply
5834 %%%%% ### videsolid ###
5835 %% syntaxe : solid videsolid -> -
5840 (Error : mauvais type d argument dans videsolid) ==
5843 solid solidwithinfaces not {
5844 /IO solid solidgetinouttable def
5845 /FE solid solidgetfaces def
5848 IO 3 2 n mul 1 sub put
5849 solid IO solidputinouttable
5850 %% on inverse chaque face
5851 /FI FE {reverse} apply def
5852 solid FE FI append solidputfaces
5853 %% et on rajoute autant de couleurs vides que de faces
5854 /FEC solid solidgetfcolors def
5855 % /FIC [FI length {()} repeat] def
5856 % solid FEC FIC append solidputfcolors
5857 solid FEC duparray append solidputfcolors
5862 %%%%% ### solidnumfaces ###
5863 %% syntaxe : solid array solidnumfaces
5864 %% syntaxe : solid array bool solidnumfaces
5865 %% array, le tableau des indices des faces a numeroter, est optionnel
5866 %% si bool=true, on ne numerote que les faces visibles
5880 /n sol solidnombrefaces def
5881 currentdict /option known not {
5882 /option [0 1 n 1 sub {} for] def
5885 0 1 option length 1 sub {
5888 j ( ) cvs sol j bool cctextp3d
5893 %%%%% ### creusesolid ###
5894 %% syntaxe : solid creusesolid -> -
5899 (Error : mauvais type d argument dans creusesolid) ==
5902 %% on enleve le fond et le chapeau
5905 %% on inverse chaque face
5910 %%%%% ### fin insertion ###
5912 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5913 %%%% dessin des solides %%%%
5914 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5916 %%%%% ### solidisinface ###
5917 %% syntaxe : solid i solidisinface --> bool
5918 %% true si i est l indice d une face interne, false sinon
5922 solidgetinouttable /IO exch def
5930 %%%%% ### solidisoutface ###
5931 %% syntaxe : solid i solidisoutface --> bool
5932 %% true si i est l indice d une face externe, false sinon
5936 solidgetinouttable /IO exch def
5944 %%%%% ### planvisible ###
5945 %% syntaxe : A k planvisible? --> true si le plan est visible
5948 /normale_plan defpoint3d
5955 ligne_de_vue normale_plan scalprod3d 0 gt
5959 %%%%% ### solidlight ###
5960 /setlightintensity {
5961 /lightintensity exch def
5965 /lightsrc defpoint3d
5972 [ currentrgbcolor ] /lightcolor exch
5978 %%%%% ### drawsolid ###
5980 /s@lidlight true def
5983 /s@lidlight false def
5987 %% syntaxe : solid i solidfacevisible? --> true si la face est visible
5988 /solidfacevisible? {
5993 (Error : mauvais type d argument dans solidgetsommetface) ==
5996 solid i solidgetface length 2 le {
6000 solid i solidcentreface
6006 solid i solidnormaleface
6008 ligne_de_vue normale_face scalprod3d 0 gt
6013 %% syntaxe : solid i affectecouleursolid_facei --> si la couleur de
6014 %% la face i est definie, affecte fillstyle a cette couleur
6015 /affectecouleursolid_facei {
6019 solid solidgetfcolors /FC exch def
6020 FC length 1 sub i ge {
6021 FC i get length 1 ge {
6022 /fillstyle FC i get ( fill) append cvx
6037 %% syntaxe : solid i dessinefacecachee
6038 /dessinefacecachee {
6043 (Error : mauvais type d argument dans dessinefacecachee) ==
6047 /F solid solidgetfaces def
6048 /S solid solidgetsommets def
6050 %% face cachee => on prend chacune des aretes de la face et on
6053 /n F i get length def %% nb de sommets de la face
6056 /k1 F i k get_ij def %% indice sommet1
6057 /k2 F i k 1 add n mod get_ij def %% indice sommet2
6059 currentlinewidth .5 mul setlinewidth
6062 S k2 getp3d sortp3d] ligne3d
6066 %% trace de la ligne de niveau
6067 solidintersectiontype 0 ge {
6068 /face_a_dessiner [ %% face visible : F [i]
6071 solid j i solidgetsommetface
6074 0 1 solidintersectionplan length 1 sub {
6076 /lignedeniveau [] def
6078 solidintersectiontype 0 eq {
6083 k solidintersectionlinewidth length lt {
6084 solidintersectionlinewidth k get setlinewidth
6086 solidintersectionlinewidth 0 get setlinewidth
6088 k solidintersectioncolor length lt {
6089 solidintersectioncolor k get cvx exec
6091 solidintersectioncolor 0 get cvx exec
6095 face_a_dessiner j getp3d
6096 face_a_dessiner j 1 add n mod getp3d
6097 solidintersectionplan k get
6106 /lignedeniveau table store
6110 lignedeniveau aload pop
6118 %% dessin de la ligne
6119 lignedeniveau length 4 ge {
6120 [lignedeniveau aload pop sortp3d] ligne3d
6130 %% syntaxe : solid i dessinefacevisible
6131 /dessinefacevisible {
6136 (Error : mauvais type d argument dans dessinefacevisible) ==
6139 /F solid solidgetfaces def
6140 /S solid solidgetsommets def
6142 /n F i get length def %% nb de sommets de la face
6148 solid i solidnormaleface normalize3d
6149 solid i solidcentreface lightsrc vecteur3d normalize3d
6155 /lacouleur lightcolor def
6159 solid solidgetfcolors i get cvx exec currentrgbcolor
6164 lacouleur {coeff mul} apply setcolor fill
6167 lacouleur {coeff mul} apply setcolor
6173 solid i affectecouleursolid_facei
6176 solid i affectecouleursolid_facei
6181 /face_a_dessiner [ %% face visible : F [i]
6184 solid j i solidgetsommetface
6187 face_a_dessiner polygone3d
6189 %% trace de la ligne de niveau
6190 solidintersectiontype 0 ge {
6191 0 1 solidintersectionplan length 1 sub {
6193 /lignedeniveau [] def
6195 k solidintersectionlinewidth length lt {
6196 solidintersectionlinewidth k get setlinewidth
6198 solidintersectionlinewidth 0 get setlinewidth
6200 k solidintersectioncolor length lt {
6201 solidintersectioncolor k get cvx exec
6203 solidintersectioncolor 0 get cvx exec
6207 face_a_dessiner j getp3d
6208 face_a_dessiner j 1 add n mod getp3d
6209 solidintersectionplan k get
6218 lignedeniveau aload pop
6228 %% dessin de la ligne
6229 lignedeniveau length 4 ge {
6230 solid i solidisinface solidintersectiontype 0 eq and {
6233 lignedeniveau ligne3d
6244 /startest {true} def
6249 /peintrealgorithme false def
6253 /aretescachees false def
6254 /peintrealgorithme true def
6259 %% syntaxe : solid array drawsolid
6260 %% array est en option, il indique les faces triees
6268 (Error : mauvais type d argument dans drawsolid) ==
6271 solid nullsolid not {
6274 solid solidgetsommets
6276 /n S length 3 idiv def
6278 currentdict /ordre known not {
6280 %% tri des indices des faces par distance decroissante
6282 0 1 F length 1 sub {
6284 solid i solidcentreface
6288 ] doublequicksort pop reverse
6291 0 1 F length 1 sub {
6298 0 1 F length 1 sub {
6302 solid i solidfacevisible? {
6303 solid i dessinefacevisible
6308 0 1 F length 1 sub {
6312 solid i solidfacevisible? not {
6313 solid i dessinefacecachee
6319 %% %% si on veut repasser les traits des faces visibles
6320 %% 0 1 F length 1 sub {
6322 %% /i ordre k get def
6325 %% /startest false def
6326 %% solid i solidfacevisible? {
6327 %% solid i dessinefacevisible
6336 %%%%% ### segment_inter_planz ###
6337 %% syntaxe : A B k segment_inter_planz --> array true ou false
6338 /segment_inter_planz {
6343 A /zA exch def pop pop
6344 B /zB exch def pop pop
6345 zA k sub zB k sub mul dup 0 gt {
6346 %% pas d intersection
6351 %% intersection en A ou en B
6357 %% intersection entre A et B
6360 k zA sub zB zA sub div mulv3d
6368 %%%%% ### fin insertion ###
6370 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
6371 %%%% plans affines %%%%
6372 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
6374 %%%%% ### planaffine ###
6375 %% plan : origine, base, range, ngrid
6376 %% [0 0 0 [1 0 0 0 1 0] [-3 3 -2 2] [1. 1.] ]
6378 /explan [0 0 0 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1. 1.] ] def
6380 %% syntaxe : any isplan --> bool
6385 candidat length 6 eq {
6386 candidat 3 get isarray {
6387 candidat 4 get isarray {
6388 candidat 5 get isarray
6405 [0 0 0 [1 0 0 0 1 0] [-3 3 -2 2] [1 1]]
6411 /result newplanaffine def
6412 result leplan plangetorigine planputorigine
6413 result leplan plangetbase planputbase
6414 result leplan plangetrange planputrange
6415 result leplan plangetngrid planputngrid
6420 %% syntaxe : plantype getorigine --> x y z
6425 (Erreur : mauvais type d argument dans plangetorigine) ==
6434 %% syntaxe : plantype getbase --> [u v]
6435 %% ou u, v et w vecteurs de R^3
6440 (Erreur : mauvais type d argument dans plangetbase) ==
6447 %% syntaxe : plantype getrange --> array
6448 %% ou array = [xmin xmax ymin ymax]
6453 (Erreur : mauvais type d argument dans plangetrange) ==
6460 %% syntaxe : plantype getngrid --> array
6461 %% ou array = [n1 n2]
6466 (Erreur : mauvais type d argument dans plangetngrid) ==
6473 %% ===================
6475 %% syntaxe : plantype x y z putorigine --> -
6483 (Erreur : mauvais type d argument dans planputorigine) ==
6492 %% syntaxe : plantype [u v w] putbase --> -
6493 %% ou u, v et w vecteurs de R^3
6499 (Erreur : mauvais type d argument dans planputbase) ==
6506 %% syntaxe : plantype array putrange --> -
6507 %% ou array = [xmin xmax ymin ymax]
6513 (Erreur : mauvais type d argument dans planputrange) ==
6520 %% syntaxe : plantype array putngrid --> -
6521 %% ou array = [n1 n2]
6527 (Erreur : mauvais type d argument dans planputngrid) ==
6534 %% -3 3 -2 2 1. 1. newgrille
6539 %% plan : origine, base, range, ngrid
6541 %% syntaxe : plantype drawplanaffine --> -
6551 plan plangetrange plan plangetngrid aload pop quadrillagexOy_
6552 plan plangetorigine [imI imK] false planprojpath
6558 %% %% syntaxe : [a b c d] (x0 y0 z0) alpha defeqplanaffine --> plantype
6559 %% %% plan defini par l equation ax+by+cz+d=0,
6560 %% %% rotation de alpha autour de la normale (alpha est optionnel)
6561 %% %% origine (x0, y0, z0). l origine est optionnelle
6562 %% /defeqplanaffine {
6574 %% cvx /origine exch def
6577 %% table length 4 ne {
6578 %% (Erreur : mauvais type d argument dans defeqplanaffine) ==
6581 %% table 0 get /a exch def
6582 %% table 1 get /b exch def
6583 %% table 2 get /c exch def
6584 %% table 3 get /d exch def
6585 %% /resultat newplanaffine def
6586 %% [a b c alpha] normalvect_to_orthobase
6590 %% resultat [imI imJ imK] planputbase
6591 %% currentdict /origine known {
6592 %% origine /z exch def /y exch def /x exch def
6593 %% a x mul b y mul add c z mul add d add 0 ne {
6594 %% (Erreur : mauvaise origine dans defeqplanaffine) ==
6597 %% resultat origine planputorigine
6600 %% resultat 0 0 d neg c div planputorigine
6603 %% resultat d neg a div 0 0 planputorigine
6605 %% resultat 0 d neg b div 0 planputorigine
6613 %% /explan [0 0 0 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1 1] ] def
6614 %% explan drawplanaffine
6616 %% /explan [0 0 2 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1 .5] ] def
6617 %% explan drawplanaffine
6620 %% [0 0 1 -2] defeqplanaffine
6623 %% [0 0 1 0] defeqplanaffine
6626 %% [1 1 1 0] (1 -1 0) defeqplanaffine
6639 {M0 translatepoint3d} solidtransform
6643 {M0 translatepoint3d} solidtransform
6647 {M0 translatepoint3d} solidtransform
6653 %% syntaxe : solid i solidface2eqplan --> [a b c d]
6654 %% equation cartesienne de la face d'indice i du solide solid
6659 solid i solidnormaleface
6663 solid 0 i solidgetsommetface
6667 [a b c a x mul b y mul add c z mul add neg]
6672 %% syntaxe : plantype newplan --> solid
6676 lepl@n plangetbase /@base exch def
6677 @base 0 getp3d /@U defpoint3d
6678 @base 1 getp3d /@V defpoint3d
6679 lepl@n plangetorigine /@M defpoint3d
6680 lepl@n plangetrange /@range exch def
6681 lepl@n plangetngrid /@ngrid exch def
6692 @range aload pop @ngrid {@F} newsurfaceparametree
6696 %% syntaxe : M eqplan --> real
6697 %% image de M par la fonction definie par l equation eqplan
6704 /@a eqplan 0 get def
6705 /@b eqplan 1 get def
6706 /@c eqplan 2 get def
6707 /@d eqplan 3 get def
6708 @a @x mul @b @y mul add @c @z mul add @d add
6715 leplan plangetbase aload pop vectprod3d
6719 leplan plangetorigine
6723 [a b c a x0 mul b y0 mul add c z0 mul add neg]
6727 %% syntaxe : [a b c d] (x0 y0 z0) alpha defeqplanaffine --> plantype
6728 %% plan defini par l equation ax+by+cz+d=0,
6729 %% rotation de alpha autour de la normale (alpha est optionnel)
6730 %% origine (x0, y0, z0). l origine est optionnelle
6743 cvx /origine exch def
6747 (Erreur : mauvais type d argument dans eq2plan) ==
6750 table 0 get /a exch def
6751 table 1 get /b exch def
6752 table 2 get /c exch def
6753 table 3 get /d exch def
6754 /resultat newplanaffine def
6755 [a b c alpha] normalvect_to_orthobase
6759 resultat [imI imJ] planputbase
6760 currentdict /origine known {
6761 origine /z exch def /y exch def /x exch def
6762 a x mul b y mul add c z mul add d add 0 ne {
6763 (Erreur : mauvaise origine dans eq2plan) ==
6766 resultat origine planputorigine
6769 resultat 0 0 d neg c div planputorigine
6772 resultat d neg a div 0 0 planputorigine
6775 resultat 0 d neg b div 0 planputorigine
6777 (Error dans eq2plan : (a,b,c) = (0,0,0)) ==
6802 [a b c a xA mul b yA mul add c zA mul add neg]
6807 %% %[0 0 -2 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1. 1.]]
6808 %% [0 0 1 1] 30 eq2plan
6811 %% [0 0 1 -2] eq2plan newplan
6812 %% dup (blanc) outputcolors
6814 %% dup (blanc) outputcolors
6817 %% monplan plangetorigine
6818 %% monplan plangetbase aload pop dessinebase
6820 %% syntaxe : x0 y0 z0 [normalvect] norm2plan
6823 normalvect_to_orthobase
6834 [a b c a x0 mul b y0 mul add c z0 mul add neg] eq2plan
6835 dup x0 y0 z0 planputorigine
6836 dup [imI imJ] planputbase
6840 %% syntaxe : plantype planxmarks
6849 leplan plangetrange aload pop
6855 xmin truncate cvi 0 smoveto
6856 xmax truncate cvi 0 slineto
6857 leplan mybool projpath
6859 xmin truncate cvi xmkstep xmax truncate cvi {
6866 dup chaine cvs exch 0 leplan mybool dctextp3d
6871 leplan mybool projpath
6874 pop (0) 0 0 leplan mybool dltextp3d
6880 %% syntaxe : plantype planymarks
6889 leplan plangetrange aload pop
6895 0 ymin truncate cvi smoveto
6896 0 ymax truncate cvi slineto
6897 leplan mybool projpath
6899 ymin truncate cvi ymkstep ymax truncate cvi {
6906 dup chaine cvs exch 0 exch leplan mybool cltextp3d
6911 leplan mybool projpath
6914 pop (0) 0 0 leplan mybool dltextp3d
6920 %% syntaxe : plantype planmarks
6928 dup mybool planxmarks mybool planymarks
6933 %% [-3 3 -2 2] quadrillagexOy_
6937 %% syntaxe : [xmin xmax ymin ymax] dx dy quadrillagexOy_
6952 table 0 get /xmin exch def
6953 table 1 get /xmax exch def
6954 table 2 get /ymin exch def
6955 table 3 get /ymax exch def
6969 %% syntaxe : plan [ngrid] planquadrillage
6985 /table leplan plangetrange def
6986 table 0 get cvi truncate /xmin exch def
6987 table 1 get cvi truncate /xmax exch def
6988 table 2 get cvi truncate /ymin exch def
6989 table 3 get cvi truncate /ymax exch def
7001 leplan mybool projpath
7006 %% syntaxe : plantype str1 str2 planshowbase -> -
7007 %% syntaxe : plantype str2 planshowbase -> -
7008 %% syntaxe : plantype planshowbase -> -
7021 /couleur1 (rouge) def
7024 /couleur1 (rouge) def
7025 /couleur2 (vert) def
7044 %% syntaxe : plantype str1 str2 str3 planshowbase3d -> -
7045 %% syntaxe : plantype str2 str3 planshowbase3d -> -
7046 %% syntaxe : plantype str3 planshowbase3d -> -
7047 %% syntaxe : plantype planshowbase3d -> -
7048 %% syntaxe : plantype str1 str2 str3 array planshowbase3d -> -
7049 %% syntaxe : plantype str2 str3 array planshowbase3d -> -
7050 %% syntaxe : plantype str3 array planshowbase3d -> -
7051 %% syntaxe : plantype array planshowbase3d -> -
7059 dup dup isarray exch isplan not and {
7071 /couleur1 (rouge) def
7074 /couleur2 (vert) def
7075 /couleur1 (rouge) def
7078 /couleur1 (rouge) def
7079 /couleur2 (vert) def
7080 /couleur3 (bleu) def
7083 plan couleur1 couleur2 mybool planshowbase
7084 plan plangetorigine /I defpoint3d
7086 dup 0 getp3d /u defpoint3d
7087 1 getp3d /v defpoint3d
7088 u v vectprod3d table newvecteur
7089 {I addv3d} solidtransform
7090 dup couleur3 solidputcolors
7096 %% syntaxe : plantype x y z plantranslate --> -
7102 (Erreur : mauvais type d argument dans plantranslate) ==
7105 plan plan plangetorigine M addv3d planputorigine
7109 % syntaxe : alpha_x alpha_y alpha_z rotateOpplan --> -
7115 (Erreur : mauvais type d argument dans rotateOplan) ==
7118 plan plan plangetorigine Rxyz rotateOpoint3d planputorigine
7120 plan plangetbase 0 getp3d /U defpoint3d
7121 plan plangetbase 1 getp3d /V defpoint3d
7123 U Rxyz rotateOpoint3d
7124 V Rxyz rotateOpoint3d
7129 %% syntaxe : plantype phi rotateplan --> -
7134 leplan plangetbase 0 getp3d /U defpoint3d
7135 leplan plangetbase 1 getp3d /V defpoint3d
7137 V phi sin mulv3d addv3d /U0 defpoint3d
7138 U phi sin neg mulv3d
7139 V phi cos mulv3d addv3d /V0 defpoint3d
7140 leplan [U0 V0] planputbase
7144 %% syntaxe : solid i solidface2plan --> plantype
7145 %% syntaxe : solid i I solidface2plan --> plantype
7148 2 copy pop issolid {
7151 solid i solidcentreface /I defpoint3d
7157 /result newplanaffine def
7158 solid i solidcentreface /G defpoint3d
7159 solid i solidnormaleface /K defpoint3d
7160 solid 0 i solidgetsommetface
7161 solid 1 i solidgetsommetface
7162 milieu3d /A defpoint3d
7163 G A vecteur3d normalize3d /U defpoint3d
7164 K U vectprod3d /V defpoint3d
7165 result [U V] planputbase
7166 result I planputorigine
7171 %%%%% ### fin insertion ###
7172 %% syntaxe : x y plantype pointplan --> X Y Z
7178 leplan plangetbase 0 getp3d /U defpoint3d
7179 leplan plangetbase 1 getp3d /V defpoint3d
7180 U x mulv3d V y mulv3d addv3d
7184 %%%%% ### fin insertion ###
7187 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7188 %%%% operations sur des solides particuliers %%%%
7189 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7194 mypie 0 solidgetface length /n exch def
7195 mypie n 2 idiv solidgetsommet /A defpoint3d
7196 mypie n 2 idiv 1 add solidgetsommet /B defpoint3d
7197 A B milieu3d GetCamPos distance3d
7208 0 1 table length 1 sub {
7213 doublequicksort pop reverse
7216 0 1 result length 1 sub {
7218 table result i get get
7227 sortpieset dup {drawsolid**} apply {0 dessinefacevisible} apply
7231 %%%%% ### solidchanfreine ###
7232 %% syntaxe : solid coeff solidchanfreine --> solid
7237 /result newsolid def
7239 (Erreur : mauvais type d argument dans solidchanfreine) ==
7242 /n solid solidnombresommets def
7243 /nf solid solidnombrefaces def
7245 %% ajout des faces reduites
7248 /Fsommets solid i solidgetsommetsface def
7249 /Findex solid i solidgetface def
7250 /ns Fsommets length 3 idiv def
7251 /couleurfaceorigine solid i solidgetfcolor def
7252 Fsommets isobarycentre3d /G defpoint3d
7253 %% on ajoute les nouveaux sommets
7257 /Sindex [ Sindex aload pop
7258 Fsommets j getp3d /M defpoint3d
7259 result M G coeff hompoint3d solidaddsommet
7262 %% Sindex contient les indices des nouveaux sommets
7263 result Sindex couleurfaceorigine solidaddface
7266 %% ajout des faces rectangulaires entre faces d'origines adjacentes
7267 %% pour chaque face de depart
7270 /F solid i solidgetface def
7271 /couleurfaceorigine solid i solidgetfcolor def
7272 /Fres result i solidgetface def
7273 %% pour chaque arete de la face
7274 0 1 F length 1 sub {
7277 /indice1 F j get def
7278 /indice2 F j 1 add F length mod get def
7280 /a2 j 1 add F length mod def
7281 %% on regarde toutes les autres faces
7282 i 1 add 1 nf 1 sub {
7284 /Ftest solid k solidgetface def
7285 indice1 Ftest in {pop true} {false} ifelse
7286 indice2 Ftest in {pop true} {false} ifelse
7289 indice1 Ftest in pop /k1 exch def
7290 indice2 Ftest in pop /k2 exch def
7296 /Fadj solid indiceFadj solidgetface def
7299 result indiceFadj solidgetface k1 get
7300 result indiceFadj solidgetface k2 get
7302 ] couleurfaceorigine solidaddface
7310 /F solid i solidgetface def
7311 /couleurfaceorigine solid i solidgetfcolor def
7312 %% et pour chaque sommet de cette face
7313 0 1 F length 1 sub {
7316 solid k solidfacesadjsommet /adj exch def
7317 %% adj est le tableau des indices des faces adjacentes
7318 %% au sommet d'indice k
7319 %% rque : toutes les faces d'indice strict inferieur a i
7320 %% sont deja traitees
7321 %% Pour chaque face adjacente, on repere l'indice du sommet concerne dans
7325 0 1 adj length 1 sub {
7327 k solid adj m get solidgetface in {
7329 /indadj [indadj aload pop ok] store
7334 0 1 adj length 1 sub {
7336 result adj m get solidgetface indadj m get get
7340 %% la table des sommets
7341 [0 1 aajouter length 1 sub {
7343 result aajouter m get solidgetsommet
7345 solid k solidgetsommet %% le point indiquant la direction de la normale
7347 /indicestries exch def
7350 0 1 indicestries length 1 sub {
7352 aajouter indicestries m get get
7354 ] couleurfaceorigine solidaddface
7363 %%%%% ### solidplansection ###
7364 %% syntaxe : M eqplan --> real
7365 %% image de M par la fonction definie par l equation eqplan
7372 /@a @qplan 0 get def
7373 /@b @qplan 1 get def
7374 /@c @qplan 2 get def
7375 /@d @qplan 3 get def
7376 @a @x mul @b @y mul add @c @z mul add @d add
7380 %% syntaxe : A B eqplan segment_inter_plan --> array true ou false
7381 %% array contient 1 point M si [AB] inter plan = {M}
7382 %% array contient les 2 points A et B si [AB] inter plan = [AB]
7383 /segment_inter_plan {
7385 dup isplan {plan2eq} if
7402 /imA a xA mul b yA mul add c zA mul add d add def
7403 /imB a xB mul b yB mul add c zB mul add d add def
7404 imA imB mul dup 0 gt {
7405 %% pas d intersection
7410 %% intersection en A ou en B
7416 %% intersection entre A et B
7423 (Error dans segment_inter_plan) ==
7438 %% syntaxe : solid i solidface2eqplan --> [a b c d]
7439 %% equation cartesienne de la face d'indice i du solide solid
7444 solid i solidnormaleface
7448 solid 0 i solidgetsommetface
7452 [a b c a x mul b y mul add c z mul add neg]
7456 %% syntaxe : array1 arrayrmdouble --> array2
7457 %% remplace 2 elts identiques consecutifs par 1 elt
7461 /result [table 0 get] def
7463 1 1 table length 1 sub {
7468 /result [result aload pop table i get] store
7476 %% syntaxe : solid eqplan/plantype solidplansection --> solid2
7490 dupsolid /result exch def
7493 /indnouveauxsommets [] def
7494 /nouvellesaretes [] def
7496 %% pour chaque face d'indice i
7497 0 1 solid solidnombrefaces 1 sub {
7499 /lacouleur solid i solidgetfcolor def
7500 /F solid i solidgetface def %% table des indices des sommets
7501 /n F length def %% nb d'aretes
7508 %% pour chaque arete [AB]
7511 %% arete testee : [j, j+1 mod n] (indices relatifs a la face i)
7512 solid j i solidgetsommetface /A defpoint3d
7513 solid j 1 add n mod i solidgetsommetface /B defpoint3d
7514 %% y a-t-il intersection
7515 A B eqplan segment_inter_plan {
7516 %% il y a intersection
7518 %% l'intersection, c'est [AB]
7525 dup 0 getp3d /A defpoint3d
7526 1 getp3d /B defpoint3d
7527 result A solidaddsommet /a1 exch def
7528 result B solidaddsommet /a2 exch def
7529 /indnouveauxsommets [
7530 indnouveauxsommets aload pop a1 a2
7534 nouvellesaretes aload pop
7536 exit %% c est deja scinde
7538 %% il y a intersection <> [AB]
7540 %% 1ere intersection de la face
7541 /k1 j def %% sommet precedent intersection 1
7542 result exch aload pop solidaddsommet
7543 /k1a exch def %% sommet intersection 1
7546 %% 2eme intersection de la face
7547 /k2 j def %% sommet precedent intersection 2
7548 result exch aload pop solidaddsommet
7549 /k2a exch def %% sommet intersection 2
7552 %% 3eme intersection de la face
7553 /k3 j def %% sommet precedent intersection 3
7554 result exch aload pop solidaddsommet
7555 /k3a exch def %% sommet intersection 3
7557 %% 4eme intersection de la face
7558 /k4 j def %% sommet precedent intersection 4
7559 result exch aload pop solidaddsommet
7560 /k4a exch def %% sommet intersection 4
7567 %% y a-t-il eu une coupe ?
7568 %% si oui, il faut scinder la face d'indice i en cours
7572 %% k1 == k2 == k3 == k4 ==
7574 %% k1a == k2a == k3a == k4a ==
7575 k1a k2a eq k3 0 lt and {
7576 %% 1 pt d'intersection
7578 %% il y a coupe, on cherche a eliminer les
7579 %% doublons dans {k1a, k2a, k3a, k4a}
7580 k1a k2a eq k3 0 ge and {
7581 %% 2 pts d'intersection
7585 k1a k3a eq k4 0 ge and {
7586 %% 2 pts d'intersection
7592 nouvellesaretes aload pop
7595 k1a F k1 1 add n mod get ne {
7598 k1 1 add n mod 1 k2 {F exch get} for
7603 result exch lacouleur solidaddface
7604 /indnouveauxsommets [indnouveauxsommets aload pop k1a k2a] store
7606 k2a F k2 1 add n mod get ne {
7610 k2 1 add n mod 1 n 1 sub {F exch get} for
7612 0 1 k1 {F exch get} for
7617 result exch lacouleur solidaddface
7618 /aenlever [aenlever aload pop i] store
7622 result aenlever solidrmfaces
7624 nouvellesaretes separe_composantes
7625 /composantes exch def
7627 %% pour chacune des composantes
7628 0 1 composantes length 1 sub {
7629 %% on oriente et on ajoute la face
7631 %indnouveauxsommets bubblesort arrayrmdouble
7632 /indnouveauxsommets composantes icomp get def
7633 %% maintenant, on ajoute la face de plan de coupe
7635 0 1 indnouveauxsommets length 1 sub {
7637 result indnouveauxsommets i get solidgetsommet
7641 0 0 0 eqplan pointeqplan 0 eq {
7647 %% restera a traiter le cas limite ou la nouvelle face existe deja
7648 %% tester si max(indicestries) < nb sommets avant section
7649 nouveauxsommets ptref ordonnepoints3d
7650 /indicestries exch def
7652 0 1 indicestries length 1 sub {
7654 indnouveauxsommets indicestries m get get
7657 /F result solidgetfaces def
7658 /FC result solidgetfcolors def
7659 /IO result solidgetinouttable def
7662 result IO solidputinouttable
7663 result [nvelleface F aload pop] solidputfaces
7664 result [lacouleur FC aload pop] solidputfcolors
7673 %% syntaxe : elt array compteoccurences
7674 %% ou array est un tableau du type [ [a1 a2] [b1 b2] [c1 c2] ... ]
7680 0 1 table length 1 sub {
7682 elt table i get in {
7691 /separe_composantes {
7693 /result [] def %% les composantes deja faites
7694 /table exch def %% ce qui reste a faire
7696 % (recu) == table {==} apply
7698 /ext1 table 0 get 1 get def
7699 /ext0 table 0 get 0 get def
7702 { %% maintenant on suit les extremites et on epluche une composante
7705 0 1 table length 1 sub {
7708 ext0 table i get In or {
7709 /aenlever [aenlever aload pop i] store
7711 %% l'arete i contient l'extremite ext0 ou ext1
7712 ext0 table i get in {
7714 neg 1 add table i get exch get
7716 ext0 composante In not {
7717 /composante [composante aload pop ext0] store
7719 %% on verifie que ext0 est legitime
7720 ext0 table compteoccurences 2 gt {
7724 ext1 table i get in {
7726 neg 1 add table i get exch get
7728 ext1 composante In not {
7729 /composante [composante aload pop ext1] store
7731 %% on verifie que ext1 est legitime
7732 ext1 table compteoccurences 2 gt {
7738 %% il faut reconstruire table
7740 0 1 table length 1 sub {
7749 change not {exit} if
7751 %% on vient de finir une composante
7752 /result [result aload pop composante] store
7753 %% (nouvelle comp) == composante {==} apply
7754 table length 0 eq {exit} if
7757 % (renvoie) == result {==} apply
7761 /solideqplansepare {solidplansepare} def
7763 %% syntaxe : solid eqplan/plantype solidplansepare --> solid1 solid2
7772 eqplan true solidplansection
7773 /nbcomposantes exch def
7775 /n solid solidnombrefaces def
7779 %% on retire les faces de coupe
7780 0 1 nbcomposantes 1 sub {
7782 /F [F aload pop solid i solidgetface] store
7783 /FC [FC aload pop solid i solidgetfcolor] store
7785 solid [0 1 nbcomposantes 1 sub {} for] solidrmfaces
7786 /n n nbcomposantes sub store
7788 %% on separe les autres faces en 2 parties
7789 /lesneg [] def %% indices des faces "positives"
7790 /lespos [] def %% indices des faces negatives"
7793 solid i solidcentreface /G defpoint3d
7794 G eqplan pointeqplan dup 0 gt {
7796 /lespos [lespos aload pop i] store
7799 /lesneg [lesneg aload pop i] store
7801 % /lesneg [lesneg aload pop i] store
7802 % /lespos [lespos aload pop i] store
7807 dupsolid dup lesneg solidrmfaces
7809 dupsolid dup lespos solidrmfaces
7813 0 1 nbcomposantes 1 sub {
7815 /facecoupe F i get def
7816 /couleurfacecoupe FC i get def
7817 /lesfaces1 result1 solidgetfaces def
7818 /lescouleurs1 result1 solidgetfcolors def
7819 /IO1 result1 solidgetinouttable def
7820 /lesfaces2 result2 solidgetfaces def
7821 /lescouleurs2 result2 solidgetfcolors def
7822 /IO2 result2 solidgetinouttable def
7823 %% on rajoute maintenant la face du plan de coupe
7824 % result1 facecoupe couleurfacecoupe solidaddface
7825 result1 [facecoupe lesfaces1 aload pop] solidputfaces
7826 result1 [couleurfacecoupe lescouleurs1 aload pop] solidputfcolors
7827 result1 IO1 dup dup 1 get 1 add 1 exch put solidputinouttable
7828 %% et on verifie l'orientation
7829 % result1 dup solidnombrefaces 1 sub solidnormaleface
7830 % result1 dup solidnombrefaces 1 sub solidcentreface addv3d
7831 result1 0 solidnormaleface
7832 result1 0 solidcentreface addv3d
7833 eqplan pointeqplan 0 gt {
7834 %% l'orientation est mauvaise
7835 result1 0 solidrmface
7836 result2 [facecoupe lesfaces2 aload pop] solidputfaces
7837 result2 [couleurfacecoupe lescouleurs2 aload pop] solidputfcolors
7838 result2 IO2 dup dup 1 get 1 add 1 exch put solidputinouttable
7839 result1 [facecoupe reverse lesfaces1 aload pop] solidputfaces
7840 result1 [couleurfacecoupe lescouleurs1 aload pop] solidputfcolors
7841 result1 dup solidgetinouttable dup dup 1 get 1 add 1 exch put solidputinouttable
7843 %% l'orientation est ok
7844 result2 IO2 dup dup 1 get 1 add 1 exch put solidputinouttable
7845 result2 [facecoupe reverse lesfaces2 aload pop] solidputfaces
7846 result2 [couleurfacecoupe lescouleurs2 aload pop] solidputfcolors
7850 %% maintenant on enleve les sommets isoles
7853 %% pour chaque face du cote negatif
7854 0 1 lesneg length 1 sub {
7855 lesneg exch get /i exch def
7856 /F solid i solidgetface def
7857 %% pour chaque sommet de cette face
7858 0 1 F length 1 sub {
7861 %% si le sommet n'est pas encore note
7862 sommet sommetsneg in not {
7863 %% et s'il est isole, on peut l'enlever
7864 result1 sommet solidsommetsadjsommet length 0 eq {
7865 /sommetsneg [sommetsneg aload pop sommet] store
7872 sommetsneg bubblesort reverse {result1 exch solidrmsommet} apply
7874 %% pour chaque face du cote positif
7875 0 1 lespos length 1 sub {
7876 lespos exch get /i exch def
7877 /F solid i solidgetface def
7878 %% pour chaque sommet de cette face
7879 0 1 F length 1 sub {
7882 %% si le sommet n'est pas encore note
7883 sommet sommetspos in not {
7884 %% et s'il est isole, on peut l'enlever
7885 result2 sommet solidsommetsadjsommet length 0 eq {
7886 /sommetspos [sommetspos aload pop sommet] store
7893 sommetspos bubblesort reverse {result2 exch solidrmsommet} apply
7899 %%%%% ### solidaffine ###
7900 %% syntaxe : solid coeff i solidaffine -> -
7901 %% syntaxe : solid coeff array solidaffine -> -
7902 %% syntaxe : solid coeff solidaffine -> -
7903 %% syntaxe : solid coeff str solidaffine -> -
7904 %% syntaxe : solid coeff bool solidaffine -> -
7908 /rmfacecentrale exch def
7910 /rmfacecentrale true def
7913 /couleurface exch def
7915 2 copy pop issolid {
7916 %% 2 arguments --> on affine tout
7917 2 copy pop solidnombrefaces /n exch def
7918 /table [n 1 sub -1 0 {} for] def
7920 %% 1 tableau --> il donne les faces a enlever
7922 /table exch bubblesort reverse def
7924 %% 1 seule face a enlever
7925 [ exch ] /table exch def
7930 0 1 table length 1 sub {
7932 solid coeff table i get
7933 currentdict /couleurface known {
7936 rmfacecentrale s@lidaffineface
7941 %% syntaxe : solid coeff i s@lidaffineface
7944 /rmfacecentrale exch def
7946 /couleurface exch def
7948 /indice_a_chamfreiner exch def
7949 /i indice_a_chamfreiner def
7953 (Erreur : mauvais type d argument dans affine) ==
7956 /n solid solidnombresommets def
7957 /F solid i solidgetsommetsface def
7958 /Findex solid i solidgetface def
7959 /ni F length 3 idiv def
7960 /couleurfaceorigine solid i solidgetfcolor def
7961 F isobarycentre3d /G defpoint3d
7962 %% on ajoute les nouveaux sommets
7966 /Sindex [ Sindex aload pop
7967 solid G F j getp3d vecteur3d coeff mulv3d G addv3d solidaddsommet
7970 %% Sindex contient les indices des nouveaux sommets
7971 %% on prepare les faces a ajouter
7973 /facestoadd [facestoadd aload pop
7977 Findex j 1 add ni mod get
7978 Sindex j 1 add ni mod get
7984 solid facestoadd i get solidaddface
7986 %% on enleve la face d origine
7987 solid indice_a_chamfreiner solidrmface
7988 %% on ajuste les couleurs des nouvelles faces
7989 /N solid solidnombrefaces def
7992 solid N 1 sub i sub couleurfaceorigine solidputfcolor
7994 %% puis on ajoute eventuellement la face centrale
7995 rmfacecentrale not {
8002 %% en ajustant la couleur de cette derniere
8004 currentdict /couleurface known {
8014 %%%%% ### solidtronque ###
8015 %% syntaxe : solid indicesommet k solidtronque --> solid
8016 %% syntaxe : solid array k solidtronque --> solid
8017 %% syntaxe : solid k solidtronque --> solid
8018 %% k entier > 0, array = tableau des indices des sommets
8023 dup solidnombresommets /N exch def
8024 /table [0 1 N 1 sub {} for] def
8029 [ exch ] /table exch def
8033 solid dupsolid /result exch def pop
8034 /n solid solidnombrefaces def
8035 0 1 table length 1 sub {
8036 table exch get /no exch def
8037 result no solidgetsommet /sommetvise defpoint3d
8038 %% on recup les sommets adjacents au sommet vise
8039 /sommetsadj solid no solidsommetsadjsommet def
8040 %% on calcule les nouveaux sommets
8042 0 1 sommetsadj length 1 sub {
8044 solid sommetsadj i get solidgetsommet
8046 ] {sommetvise exchp3d coeff ABpoint3d} papply3d def
8047 %% on pose G = barycentre de ces points
8048 nouveauxsommets isobarycentre3d /G defpoint3d
8049 %% il faut ordonner ces sommets
8050 nouveauxsommets 0 getp3d /ptref defpoint3d
8051 G result no solidgetsommet vecteur3d /vecteurnormal defpoint3d
8052 %% on construit le tableau des angles ordonnes par rapport
8054 nouveauxsommets duparray exch pop
8059 vecteurnormal angle3doriente
8061 doublebubblesort pop
8062 %% nos sommets sont tries
8063 /indicesommetstries exch def
8064 %% on rajoute les sommets au solide, et on note les nouveaux indices
8066 0 1 nouveauxsommets length 3 idiv 1 sub {
8068 result nouveauxsommets k getp3d solidaddsommet
8071 %% on ajoute la face concernee
8073 0 1 indicesommetstries length 1 sub {
8075 nouveauxindices indicesommetstries k get get
8078 result no solidfacesadjsommet /lesfaces exch def
8079 %% on examine la face d indice i, et on elimine le
8081 0 1 lesfaces length 1 sub {
8083 /j lesfaces i get def
8084 /F result j solidgetface def
8086 0 1 F length 1 sub {
8088 F k get dup no eq {pop} if
8090 ] j exch solidputface
8093 table bubblesort reverse {result exch solidrmsommet} apply
8098 %%%%% ### dualpolyedre ###
8099 %% syntaxe : solid dualpolyedreregulier --> solid
8100 %% syntaxe : solid r dualpolyedreregulier --> solid
8101 %% si le nombre r est present, projette les nouveaux sommets sur la sphere de centre O , de rayon r
8102 /dualpolyedreregulier {
8106 /projection true def
8108 /projection false def
8111 solid dupsolid /result exch def pop
8112 /n solid solidnombrefaces def
8113 /N solid solidnombresommets def
8114 /facesaenlever [] def
8115 %% pour chacun des sommets
8117 %% sommet d indice i
8119 %% indicesfacesadj = liste des indices des faces ou on trouve le sommet i
8120 /indicesfacesadj solid i solidfacesadjsommet def
8121 %% on recupere les centres des faces concernees
8123 0 1 indicesfacesadj length 1 sub {
8125 solid indicesfacesadj k get solidgetsommetsface isobarycentre3d
8128 %% et on pose G = barycentre de ces points
8129 nouveauxsommets isobarycentre3d /G defpoint3d
8130 %% il faut ordonner ces sommets
8131 nouveauxsommets 0 getp3d /ptref defpoint3d
8132 G solid i solidgetsommet vecteur3d /vecteurnormal defpoint3d
8133 nouveauxsommets duparray exch pop
8138 vecteurnormal angle3doriente
8140 doublebubblesort pop
8141 %% nos sommets sont tries
8142 /indicesommetstries exch def
8144 %% on projette les sommets sur la sphere
8145 /nouveauxsommets [ nouveauxsommets {normalize3d r mulv3d} papply3d aload pop ] store
8147 %% puis on les rajoute au solide
8149 0 1 nouveauxsommets length 3 idiv 1 sub {
8151 result nouveauxsommets k getp3d solidaddsommet
8154 %% ainsi que la face concernee
8156 0 1 indicesommetstries length 1 sub {
8158 nouveauxindices indicesommetstries k get get
8161 /facesaenlever [ facesaenlever aload pop indicesfacesadj aload pop ] store
8163 result [0 1 n 1 sub {} for] solidrmfaces
8164 [N 1 sub -1 0 {} for] {result exch solidrmsommet} apply
8169 %%%%% ### newgeode ###
8170 %% syntaxe : solid r newgeode --> solid
8171 %% syntaxe : N r newgeode --> solid
8172 %% N in {3,4,5} -> polyhedre de depart, r = niveau de recursion
8192 solid dupsolid /result exch def pop
8193 /n solid solidnombrefaces def
8196 %% la face d indice i
8197 solid i solidgetface /F exch def
8201 solid i0 solidgetsommet /A0 defpoint3d
8202 solid i1 solidgetsommet /A1 defpoint3d
8203 solid i2 solidgetsommet /A2 defpoint3d
8204 A0 A1 milieu3d normalize3d /A01 defpoint3d
8205 A1 A2 milieu3d normalize3d /A12 defpoint3d
8206 A2 A0 milieu3d normalize3d /A20 defpoint3d
8207 result A01 solidaddsommet /i01 exch def
8208 result A12 solidaddsommet /i12 exch def
8209 result A20 solidaddsommet /i20 exch def
8210 result i solidrmface
8211 result [i0 i01 i20] solidaddface
8212 result [i01 i1 i12] solidaddface
8213 result [i01 i12 i20] solidaddface
8214 result [i20 i12 i2] solidaddface
8222 %% syntaxe : N r newdualgeode --> solid
8225 dualpolyedreregulier
8228 %%%%% ### fin insertion ###
8231 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
8232 %%%% quelques solides precalcules %%%%
8233 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
8235 %%%%% ### newface ###
8236 %% syntaxe : array newmonoface -> solid
8237 %% ou array = tableau de points 2d
8241 /n table length 2 idiv def
8242 /S table {0} papply def
8245 [0 1 n 1 sub {} for]
8251 %% syntaxe : array newbiface -> solid
8252 %% ou array = tableau de points 2d
8258 %%%%% ### newpolreg ###
8259 %% syntaxe : r n newpolreg --> solid
8265 0 360 n div 360 360 n div sub {
8273 [0 1 n 1 sub {} for]
8281 %%%%% ### newgrille ###
8282 %% syntaxe : xmin xmax ymin ymax [dx dy] newgrille -> solid
8283 %% syntaxe : xmin xmax ymin ymax [nx ny] newgrille -> solid
8284 %% syntaxe : xmin xmax ymin ymax {mode} newgrille -> solid
8285 %% syntaxe : xmin xmax ymin ymax newgrille -> solid
8288 [[/nx /ny] [1 1] [1. 1.] [1. 1.] [1. 1.] [.5 .5]] gestionsolidmode
8289 %% ny nb d etages en y
8290 %% nx nb d etages en x
8292 [nx ny] {0} newsurfaceparametree
8296 %% %% syntaxe : xmin xmax ymin ymax [dx dy] {f} newsurface -> solid
8299 true newsurfaceparametree
8304 /newsurfaceparametree {
8312 [[/nx /ny] [2 2] [4 4] [1. 1.] [1. 1.] [.25 .25]] gestionsolidmode
8313 %% ny nb d etages en y
8314 %% nx nb d etages en x
8321 %% alors nx est un dx
8322 /nx xmax xmin sub nx div cvi store
8325 %% alors ny est un dy
8326 /ny ymax ymin sub ny div cvi store
8328 /dy ymax ymin sub ny div def %% le pas sur y
8329 /dx xmax xmin sub nx div def %% le pas sur x
8336 /u xmin i dx mul add def
8337 /v ymin j dy mul add def
8352 j 1 add i ny 1 add mul add
8353 j i ny 1 add mul add
8354 j ny 1 add add i ny 1 add mul add
8355 j ny 2 add add i ny 1 add mul add
8359 %% 0 1 0 {%nx 1 sub {
8361 %% 0 1 0 {%ny 2 sub {
8364 %% j 1 add %% i ny mul add
8365 %% j %% i ny mul add
8366 %% ny 1 add j add %% i ny mul add
8367 %% ny 2 add j add %% i ny mul add
8373 biface pl@n-en-cours not and {dup videsolid} if
8377 %%%%% ### newgrillecirculaire ###
8378 %% syntaxe : r option newgrillecirculaire -> solid
8379 /newgrillecirculaire {
8381 [[/K /N] [6 6] [6 8] [10 8] [16 12] [16 36]] gestionsolidmode
8383 %% N = nb de meridiens (diviseur de 360 = 2^4 * 3^2 * 5)
8384 %% K = nb d horizontales (diviseur de 160 = 2^5 * 5)
8400 i N mod N add 1 add j N mul add
8401 i N mod 1 add j N mul add]
8406 %% tableau des sommets
8413 /theta i 360 mul N div def
8414 theta cos r j mul K div mul
8415 theta sin r j mul K div mul
8416 0 %2 copy f %exch atan 90 div
8425 %% syntaxe : r [dx dy] {f} newsurface* -> solid
8429 [[/nx /ny] [6 6] [6 8] [10 8] [16 12] [16 36]] gestionsolidmode
8432 %% alors nx est un dx
8433 /nx xmax xmin sub nx div cvi store
8436 %% alors ny est un dy
8437 /ny ymax ymin sub ny div cvi store
8439 /dy ymax ymin sub ny div def %% le pas sur y
8440 /dx xmax xmin sub nx div def %% le pas sur x
8442 %% ny = nb de meridiens
8443 %% nx = nb d horizontales
8450 [0 i i ny mod 1 add]
8458 i ny add j ny mul add
8459 i ny mod ny add 1 add j ny mul add
8460 i ny mod 1 add j ny mul add]
8465 %% tableau des sommets
8472 /theta i 360 mul ny div def
8473 theta cos r j mul nx div mul
8474 theta sin r j mul nx div mul
8484 %%%%% ### newruban ###
8485 %% syntaxe : array h u [n] newruban -> solid d axe (O, u), de maillage vertical n
8486 %% syntaxe : array h u newruban -> solid d axe (O, u),
8487 %% syntaxe : array h newruban -> solid d axe (O, k),
8488 %% ou array tableau de points 2d
8492 [[/N] [1] [1] [1] [3] [4]] gestionsolidmode
8493 2 copy pop isarray {
8499 (Error : 3eme composante nulle dans le vecteur pour newruban) ==
8505 %% n = indice du dernier point
8506 /n table length 2 idiv 1 sub def
8507 %% vecteur de translation
8510 mulv3d /v defpoint3d
8512 %% tableau des sommets
8520 v N j sub N div mulv addv3d
8531 [i j 1 sub n 1 add mul add
8532 i 1 sub j 1 sub n 1 add mul add
8533 n 1 add i add 1 sub j 1 sub n 1 add mul add
8534 n 1 add i add j 1 sub n 1 add mul add]
8544 %%%%% ### newicosaedre ###
8549 0.8944271 0 0.4472137
8550 0.2763932 0.8506507 0.4472137
8551 -0.7236067 0.5257311 0.4472137
8552 -0.7236067 -0.5257311 0.4472137
8553 0.2763932 -0.8506507 0.4472137
8556 -0.8944271 0 -0.4472137
8557 -0.2763932 -0.8506507 -0.4472137
8558 0.7236067 -0.5257311 -0.4472137
8559 0.7236067 0.5257311 -0.4472137
8560 -0.2763932 0.8506507 -0.4472137
8561 ] {a mulv3d} papply3d def
8570 [0 9 10] %% 1 10 11]
8571 [10 1 0] %% 11 2 1 ]
8572 [1 10 11] %% 2 11 12]
8573 [11 2 1] %% 12 3 2 ]
8574 [2 11 7] %% 3 12 8 ]
8579 [6 7 11] %% 7 8 12 ]
8582 [6 10 9] %% 7 11 10]
8583 [6 11 10] %% 7 12 11]
8590 %%%%% ### newdodecaedre ###
8595 0 0.607062 0.7946545
8596 -0.5773503 0.1875925 0.7946545
8597 -0.3568221 -0.4911235 0.7946545
8598 0.3568221 -0.4911235 0.7946545
8599 0.5773503 0.1875925 0.7946545
8600 0 0.982247 0.1875925
8601 -0.9341724 0.303531 0.1875925
8602 -0.5773503 -0.7946645 0.1875925
8603 0.5773503 -0.7946645 0.1875925
8604 0.9341724 0.303531 0.1875925
8605 0 -0.982247 -0.1875925
8606 0.9341724 -0.303531 -0.1875925
8607 0.5773503 0.7946545 -0.1875925
8608 -0.5773503 0.7946545 -0.1875925
8609 -0.9341724 -0.303531 -0.1875925
8610 -0.5773503 -0.1875925 -0.7946545
8611 -0.3568221 0.4911235 -0.7946545
8612 0.3568221 0.4911235 -0.7946545
8613 0.5773503 -0.1875925 -0.7946545
8614 0 -0.607062 -0.7946545
8615 ] {a mulv3d} papply3d def
8635 %%%%% ### newoctaedre ###
8647 ] {a mulv3d} papply3d def
8664 %%%%% ### newtetraedre ###
8671 -0.4714045 -0.8164965 -1 3 div
8673 -0.4714045 0.8164965 -1 3 div
8674 ] {r mulv3d} papply3d def
8687 %%%%% ### newcube ###
8690 [[/n] [1] [1] [1] [3] [4]] gestionsolidmode
8703 %% tableau des sommets
8713 ] {a mulv3d} papply3d def
8717 /N n dup mul n add 4 mul def
8718 /n1 n 1 sub dup mul def %% nb sommets centre d une face
8720 %% tableau des sommets
8733 /S2 S1 {-90 0 0 rotateOpoint3d} papply3d def
8734 /S3 S2 {-90 0 0 rotateOpoint3d} papply3d def
8735 /S4 S3 {-90 0 0 rotateOpoint3d} papply3d def
8761 %% tableau des faces
8777 %% syntaxe : i sommettourgauche --> l indice du i-eme sommet du tour
8778 %% de la face gauche (en commencant par l indice 0). ATTENTION :
8779 %% utilise la variable globale n = nb d etages
8785 (Error: indice trop grand dans sommettourgauche) ==
8792 %% syntaxe : i sommetcentregauche --> l indice du i-eme sommet du centre
8793 %% de la face gauche (en commencant par l indice 0). ATTENTION :
8794 %% utilise les variables globales n = nb d etages, et N = nb sommets
8795 %% des 4 1eres faces
8796 /sommetcentregauche {
8799 i n 1 sub dup mul ge {
8801 (Error: indice trop grand dans sommetcentregauche) ==
8809 %%%%% la face gauche %%%%%
8810 %% le coin superieur gauche
8814 n 4 mul 1 sub sommettourgauche
8815 n1 n 1 sub sub sommetcentregauche
8818 %% la bande superieure (i from 1 to n-2)
8822 i 1 add sommettourgauche
8824 n1 n sub i add sommetcentregauche
8825 n1 n sub i 1 add add sommetcentregauche
8829 %% le coin superieur droit
8832 n 1 sub sommettourgauche
8833 n1 1 sub sommetcentregauche
8834 n 1 add sommettourgauche
8837 %% la descente gauche
8842 n1 n 1 sub j mul sub sommetcentregauche
8843 n 4 mul j sub sommettourgauche
8844 n 4 mul j 1 add sub sommettourgauche
8845 n1 n 1 sub j 1 add mul sub sommetcentregauche
8849 %% les bandes centrales (j from 1 to n-2 et i from 1 to n-2)
8855 n1 i n 1 sub j 1 sub mul add sub sommetcentregauche
8856 n1 i 1 add n 1 sub j 1 sub mul add sub sommetcentregauche
8857 n1 i 1 add n 1 sub j mul add sub sommetcentregauche
8858 n1 i n 1 sub j mul add sub sommetcentregauche
8863 %% la descente droite
8867 n j add sommettourgauche
8868 n1 1 sub j 1 sub n 1 sub mul sub sommetcentregauche
8869 n1 1 sub j n 1 sub mul sub sommetcentregauche
8870 n j 1 add add sommettourgauche
8874 %% le coin inferieur gauche
8876 0 sommetcentregauche
8877 n 3 mul 1 add sommettourgauche
8878 n 3 mul sommettourgauche
8879 n 3 mul 1 sub sommettourgauche
8882 %% la bande inferieure (i from 1 to n-2)
8886 i sommetcentregauche
8887 i 1 sub sommetcentregauche
8888 n 3 mul i sub sommettourgauche
8889 n 3 mul i sub 1 sub sommettourgauche
8893 %% le coin inferieur droit
8895 n 2 mul 1 sub sommettourgauche
8896 n 2 sub sommetcentregauche
8897 n 2 mul 1 add sommettourgauche
8898 n 2 mul sommettourgauche
8902 %% syntaxe : i sommettourdroit --> l indice du i-eme sommet du tour
8903 %% de la face droit (en commencant par l indice 0). ATTENTION :
8904 %% utilise la variable globale n = nb d etages
8910 (Error: indice trop grand dans sommettourdroit) ==
8917 %% syntaxe : i sommetcentredroit --> l indice du i-eme sommet du centre
8918 %% de la face droit (en commencant par l indice 0). ATTENTION :
8919 %% utilise les variables globales n = nb d etages, et N = nb sommets
8920 %% des 4 1eres faces
8921 /sommetcentredroit {
8924 i n 1 sub dup mul ge {
8926 (Error: indice trop grand dans sommetcentredroit) ==
8934 %% coin superieur droit
8938 n1 n 1 sub sub sommetcentredroit
8939 4 n mul 1 sub sommettourdroit
8941 %% coin superieur gauche
8943 n 1 sub sommettourdroit
8945 n 1 add sommettourdroit
8946 n1 1 sub sommetcentredroit
8948 %% coin inferieur gauche
8950 n 2 sub sommetcentredroit
8951 2 n mul 1 sub sommettourdroit
8952 2 n mul sommettourdroit
8953 2 n mul 1 add sommettourdroit
8955 %% coin inferieur droit
8957 3 n mul 1 add sommettourdroit
8959 3 n mul 1 sub sommettourdroit
8960 3 n mul sommettourdroit
8967 i 1 add sommettourdroit
8968 n 1 sub n 2 sub mul i add sommetcentredroit
8969 n 1 sub n 2 sub mul i 1 sub add sommetcentredroit
8976 i 1 sub sommetcentredroit
8978 3 n mul 1 sub i sub sommettourdroit
8979 3 n mul i sub sommettourdroit
8986 n1 1 sub i 1 sub n 1 sub mul sub sommetcentredroit
8987 n i add sommettourdroit
8988 n i 1 add add sommettourdroit
8989 n1 1 sub i n 1 sub mul sub sommetcentredroit
8996 4 n mul i sub sommettourdroit
8997 n 1 sub n 1 sub i sub mul sommetcentredroit
8998 n 1 sub n 2 sub i sub mul sommetcentredroit
8999 4 n mul i sub 1 sub sommettourdroit
9002 %% bandes interieures
9008 n 1 sub j mul i 1 sub add sommetcentredroit
9009 n 1 sub j mul i add sommetcentredroit
9010 n 1 sub j 1 sub mul i add sommetcentredroit
9011 n 1 sub j 1 sub mul i 1 sub add sommetcentredroit
9018 /F2 F1 {{n dup mul n add add} apply} apply def
9019 /F3 F2 {{n dup mul n add add} apply} apply def
9020 /F4 F3 {{n dup mul n add add} apply} apply def
9023 S1 S2 append S3 append S4 append S5 append S6 append {a mulv3d} papply3d
9024 F1 F2 append F3 append F4 append {{N mod} apply} apply F5 append F6 append
9030 %%%%% ### newparallelepiped ###
9032 /newparallelepiped {
9046 %% tableau des sommets
9054 a neg b neg c neg %% 6
9061 %%%%% ### newcylindre ###
9062 %% syntaxe : z0 r0 z1 newcylindre -> solide
9063 %% syntaxe : z0 r0 z1 {mode} newcylindre -> solide
9064 %% syntaxe : z0 r0 z1 [n1 n2] newcylindre -> solide
9065 %% syntaxe : a b {f} {u} h [n1 n2] newcylindre
9068 [[/n2 /n1] [1 6] [1 8] [1 10] [3 12] [5 18]] gestionsolidmode
9070 %% cylindre cas general
9073 U normalize3d /u defpoint3d
9074 /lafonction exch def
9077 /pas b a sub n1 div def
9084 a i pas mul add lafonction
9085 u j vpas mul mulv3d addv3d
9095 i n1 1 add j mul add
9107 %% cylindre de revolution
9108 2 copy pop [n2 n1] newtronccone
9113 %% syntaxe : z0 r0 z1 newcylindrecreux -> solide
9119 %%%%% ### newtronccone ###
9120 %% syntaxe : z0 r0 z1 r1 newtronccone -> solid
9123 [[/n /N] [1 6] [1 8] [1 10] [3 12] [5 18]] gestionsolidmode
9129 /dz z1 z0 sub n div def
9130 /dr r1 r0 sub n div def
9133 [0 1 N 1 sub {} for]
9134 [n 1 add N mul 1 sub -1 n N mul {} for]
9138 k N mul 1 add 1 k 1 add N mul 1 sub {
9140 [i i 1 sub N i add 1 sub N i add]
9142 [k N mul k 1 add N mul 1 sub k 2 add N mul 1 sub k 1 add N mul]
9147 %% tableau des sommets
9153 360 N idiv i mul cos r0 dr k mul add mul
9154 360 N idiv i mul sin r0 dr k mul add mul
9163 %% syntaxe : z0 r0 z1 r1 newtroncconecreux -> solid
9164 /newtroncconecreux {
9169 %%%%% ### newcone ###
9170 %% syntaxe : z0 r0 z1 newcone -> solid
9171 %% syntaxe : z0 r0 z1 {mode} newcone -> solid
9172 %% syntaxe : z0 r0 z1 [n1 n2] newcone -> solid
9173 %% syntaxe : a b {f} {sommet} [n1 n2] newcone -> solid
9176 [ [/n /N] [1 6] [1 8] [1 10] [3 12] [5 18] ] gestionsolidmode
9180 /lafonction exch def
9184 /pas b a sub N div def
9191 a i pas mul add lafonction
9192 dupp3d sommet vecteur3d j n div mulv3d addv3d
9199 a i pas mul add lafonction
9200 sommet vecteur3d j n div mulv3d sommet addv3d
9206 %% les etages inferieurs
9219 %% dernier etage inferieur
9223 i N 1 add n 1 sub mul add
9228 %% premier etage superieur
9238 %% les etages superieurs
9256 %% cylindre de revolution
9260 /dz z1 z0 sub n div def
9265 [N 1 sub -1 0 {} for]
9267 n 1 sub N mul 1 add 1 n N mul 1 sub {
9271 [n N mul 1 sub n 1 sub N mul n N mul]
9272 %% les autres etages
9275 0 N j mul add 1 N N j mul add 2 sub {
9277 [i i 1 add dup N add dup 1 sub]
9279 [N N j mul add 1 sub N j mul dup N add dup N add 1 sub]
9283 %% tableau des sommets
9285 %% etage no j (in [1; n])
9290 360 N idiv i mul cos r0 dr j mul sub mul
9291 360 N idiv i mul sin r0 dr j mul sub mul
9302 %% %% syntaxe : z0 r0 z1 newconecreux -> solid
9309 %%%%% ### newtore ###
9310 %% syntaxe : r R newtore -> solid
9313 [[/n1 /n2] [4 5] [6 10] [8 12] [9 18] [18 36]] gestionsolidmode
9321 360 n1 div i mul cos r mul R add
9322 360 n1 div i mul sin r mul
9330 %%%%% ### newprisme ###
9331 %% syntaxe : array z0 z1 newprisme -> solid d axe (O, u),
9333 [[/N] [1] [1] [1] [3] [6]] gestionsolidmode
9337 %% syntaxe : array z0 z1 u newprisme -> solid d axe (O, u),
9338 %% ou array tableau de points 2d
9341 [[/N] [1] [1] [1] [3] [6]] gestionsolidmode
9343 (Error : 3eme composante nulle dans le vecteur pour newprisme) ==
9351 %% n = indice du dernier point
9352 /n table length 2 idiv 1 sub def
9353 %% vecteur de translation
9355 z1 z0 sub u norme3d div
9356 mulv3d /v defpoint3d
9358 %% tableau des sommets
9366 v N j sub N div mulv addv3d
9375 [N 1 add n 1 add mul 1 sub -1 N n 1 add mul {} for]
9381 [i j 1 sub n 1 add mul add
9382 i 1 sub j 1 sub n 1 add mul add
9383 n 1 add i add 1 sub j 1 sub n 1 add mul add
9384 n 1 add i add j 1 sub n 1 add mul add]
9386 [0 j 1 sub n 1 add mul add
9387 n j 1 sub n 1 add mul add
9388 2 n mul 1 add j 1 sub n 1 add mul add
9389 n 1 add j 1 sub n 1 add mul add]
9397 %%%%% ### newsphere ###
9398 %% syntaxe : r option newsphere -> solid
9401 [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
9402 -90 90 [K N] newcalottesphere
9406 %% syntaxe : r phi theta option newcalottesphere -> solid
9409 [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
9411 %% test de beta (ex-theta)
9416 /beta exch 80 min -80 max def
9419 %% test de alpha (ex-phi)
9423 /alpha exch beta min -80 max def
9429 /db alpha beta sub K 1 add div def
9432 /db alpha beta sub K div def
9437 /db alpha beta sub K div def
9440 /db alpha beta sub K 1 sub div def
9444 %% nombre de sommets -2
9447 %% tableau des sommets
9451 /phi beta j db mul add def
9452 phi cos r mul /r_tmp exch def
9455 360 N idiv i mul cos r_tmp mul
9456 360 N idiv i mul sin r_tmp mul
9465 %% calotte inferieure
9475 [nb nb N sub nb 1 sub]
9477 [nb 1 sub -1 nb N sub {} for ]
9480 %% calotte superieure
9484 [i i 1 add N mod N K mul 1 add]
9487 [0 1 N 1 sub {} for]
9498 N 2 sub {dup {1 add} apply} repeat
9512 %% syntaxe : r phi theta option newcalottespherecreuse -> solid
9513 /newcalottespherecreuse {
9515 [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
9517 %% test de beta (ex-theta)
9522 /beta exch 80 min -80 max def
9525 %% test de alpha (ex-phi)
9529 /alpha exch beta min -80 max def
9535 /db alpha beta sub K 1 add div def
9538 /db alpha beta sub K div def
9543 /db alpha beta sub K div def
9546 /db alpha beta sub K 1 sub div def
9550 %% nombre de sommets -2
9553 %% tableau des sommets
9557 /phi beta j db mul add def
9558 phi cos r mul /r_tmp exch def
9561 360 N idiv i mul cos r_tmp mul
9562 360 N idiv i mul sin r_tmp mul
9571 %% calotte inferieure
9581 [nb nb N sub nb 1 sub]
9583 % [nb 1 sub -1 nb N sub {} for ]
9586 %% calotte superieure
9590 [i i 1 add N mod N K mul 1 add]
9593 % [0 1 N 1 sub {} for]
9604 N 2 sub {dup {1 add} apply} repeat
9619 %%%%% ### newanneau ###
9620 %% syntaxe : array n newanneau --> solid
9621 %% syntaxe : array {mode} newanneau --> solid
9622 %% ou array est un tableau de points de R^2 et n un nombre entier positif
9629 [[/n2] [6] [12] [24] [32] [36]] gestionsolidmode
9631 %% on plonge la section dans R^3 par projection sur yOz
9632 /S1 exch {0 3 1 roll} papply def
9633 %% nombre de sommets
9634 /n1 S1 length 3 idiv def
9639 {0 0 360 n2 div rotateOpoint3d} papply3d
9647 n1 j mul 1 j 1 add n1 mul 2 sub {
9649 [i 1 add i dup n1 add i n1 1 add add]
9651 [n1 j mul j 1 add n1 mul 1 sub j 2 add n1 mul 1 sub j 1 add n1 mul]
9659 %%%%% ### newvecteur ###
9660 %% syntaxe : x y z newvecteur
9661 %% syntaxe : x y z array newvecteur
9666 /h@uteur table 1 get def
9667 /r@y@n table 0 get def
9680 normalvect_to_orthobase
9685 A norme3d /z exch h@uteur sub def
9686 0 r@y@n h@uteur [1 8] newcone
9687 dup (noir) outputcolors
9688 {0 0 z translatepoint3d} solidtransform
9689 {imI imJ imK transformpoint3d} solidtransform
9694 %%%%% ### readsolidfile ###
9695 %% syntaxe : str readsolidfile -> solid
9699 [str (-sommets.dat) append run]
9700 [str (-faces.dat) append run]
9702 dup [str (-couleurs.dat) append run] solidputfcolors
9703 dup [str (-io.dat) append run] solidputinouttable
9707 %%%%% ### writesolidfile ###
9708 %% syntaxe : solid str writesolidfile -> -
9714 (Error : mauvais type d argument dans writesolidfile) ==
9717 str (-sommets.dat) append (w) file /lefichiersommets exch def
9718 str (-faces.dat) append (w) file /lefichierfaces exch def
9719 str (-couleurs.dat) append (w) file /lefichiercouleurs exch def
9720 str (-io.dat) append (w) file /lefichierio exch def
9722 /S solid solidgetsommets def
9723 0 1 S length 3 idiv 1 sub {
9725 solid i solidgetsommet
9729 lefichiersommets x chaine cvs writestring
9730 lefichiersommets 32 write %% espace
9731 lefichiersommets y chaine cvs writestring
9732 lefichiersommets 32 write %% espace
9733 lefichiersommets z chaine cvs writestring
9734 lefichiersommets 10 write %% CR
9736 lefichiersommets closefile
9738 /F solid solidgetfaces def
9739 0 1 F length 1 sub {
9741 /Fi solid i solidgetface def
9742 lefichierfaces 91 write %% [
9743 0 1 Fi length 1 sub {
9745 lefichierfaces Fi j get chaine cvs writestring
9746 lefichierfaces 32 write %% espace
9748 lefichierfaces 93 write %% ]
9749 lefichierfaces 10 write %% CR
9751 lefichierfaces closefile
9753 /C solid solidgetfcolors def
9754 0 1 C length 1 sub {
9756 lefichiercouleurs 40 write %% (
9757 lefichiercouleurs C i get writestring
9758 lefichiercouleurs 41 write %% )
9759 lefichiercouleurs 10 write %% CR
9761 lefichiercouleurs closefile
9763 /IO solid solidgetinouttable def
9766 lefichierio IO i get chaine cvs writestring
9767 lefichierio 32 write %% space
9769 lefichierio closefile
9773 %%%%% ### writeobjfile ###
9774 %% syntaxe : solid str writeobjfile -> -
9777 /str exch (.obj) append def
9780 (Erreur : mauvais type d argument dans writeobjfile) ==
9783 /n solid solidnombresommets def
9784 str (w) file /lefichier exch def
9787 solid i solidgetsommet
9791 lefichier (v ) writestring
9792 lefichier x chaine cvs writestring
9793 lefichier 32 write %% espace
9794 lefichier y chaine cvs writestring
9795 lefichier 32 write %% espace
9796 lefichier z chaine cvs writestring
9797 lefichier 10 write %% CR
9799 /n solid solidnombrefaces def
9802 lefichier (f ) writestring
9803 /F solid i solidgetface {1 add} apply def
9806 chaine cvs writestring
9807 lefichier 32 write %% espace
9809 lefichier 10 write %% CR
9815 %%%%% ### writeofffile ###
9816 %% syntaxe : solid str writeobjfile -> -
9819 /str exch (.off) append def
9822 (Erreur : mauvais type d argument dans writeofffile) ==
9825 /n solid solidnombresommets def
9826 /nf solid solidnombrefaces def
9827 str (w) file /lefichier exch def
9828 lefichier (OFF) writestring
9829 lefichier 10 write %% CR
9830 lefichier n chaine cvs writestring
9831 lefichier 32 write %% espace
9832 lefichier nf chaine cvs writestring
9833 lefichier 32 write %% espace
9834 lefichier 0 chaine cvs writestring
9835 lefichier 10 write %% CR
9838 solid i solidgetsommet
9842 lefichier x chaine cvs writestring
9843 lefichier 32 write %% espace
9844 lefichier y chaine cvs writestring
9845 lefichier 32 write %% espace
9846 lefichier z chaine cvs writestring
9847 lefichier 10 write %% CR
9851 /F solid i solidgetface def
9852 lefichier F length chaine cvs writestring
9853 lefichier 32 write %% espace
9856 chaine cvs writestring
9857 lefichier 32 write %% espace
9859 lefichier 10 write %% CR
9865 %%%%% ### newobjfile ###
9868 /objfilename exch (.obj) append def
9874 ] %% ferme les sommets
9875 [ [ %% ouvre les faces
9880 [ %% ouvre la nouvelle
9883 [ 0 0 0 %% sommet fantome pour respecter l'indexation (a partir de l'indice 1)
9894 %%%%% ### newofffile ###
9898 /offfilename exch (.off) append def
9899 offfilename (r) file
9901 offfile str readline pop pop
9902 offfile str readline pop
9904 dup 0 get /ns exch def
9907 offfile str readline pop numstr2array aload pop
9913 offfile str readline pop numstr2array
9915 1 1 table length 1 sub {
9928 %%%%% ### newtube ###
9929 /tub@dernierk1 [1 0 0] def
9930 /tub@dernierk2 [0 1 0] def
9931 /tub@dernierk3 [0 0 1] def
9935 normalize3d /vect3 defpoint3d
9936 normalize3d /vect2 defpoint3d
9937 normalize3d /vect1 defpoint3d
9938 vect1 norme3d 0 eq {
9939 vect2 vect3 vectprod3d /vect1 defpoint3d
9941 vect2 norme3d 0 eq {
9942 vect3 vect1 vectprod3d /vect2 defpoint3d
9944 vect3 norme3d 0 eq {
9945 vect1 vect2 vectprod3d /vect3 defpoint3d
9947 /tub@dernierk1 [vect1] store
9948 /tub@dernierk2 [vect2] store
9949 /tub@dernierk3 [vect3] store
9953 %% syntaxe : tmin tmax (f) array r newtube -> solid
9958 /K table 0 get def %% nb d etages
9959 /N table 1 get def %% nb de points sur le perimetre
9960 /@r exch def %% le rayon du tube
9962 /lafonction str cvx def
9963 /laderivee str (') append cvx def
9964 %% /laderivee2nd str ('') append cvx def
9967 /pas tmax tmin sub K 1 sub div def
9969 %% definition des sommets
9973 /a0 tmin @k pas mul add def
9975 %% definition du repere de Frenet (k1, k2, k3) au point f(a)
9976 a0 lafonction /M defpoint3d
9978 str (') append cvlit where {
9980 a0 laderivee normalize3d /k1 defpoint3d
9981 % pop /avecderiv true def
9983 M a0 pas 100 div add lafonction vecteur3d normalize3d /k1 defpoint3d
9987 k1 baseplannormal /K3 defpoint3d /K2 defpoint3d
9988 % a0 laderivee2nd normalize3d /k2 defpoint3d
9990 %% projete orthogonal du dernier rayon sur le plan actuel
9991 %% (normal a la vitesse)
9992 K2 tub@dernierk2 aload pop K2 scalprod3d mulv3d
9993 K3 tub@dernierk2 aload pop K3 scalprod3d mulv3d addv3d /k2 defpoint3d
9994 % M k1 K2 K3 dessinebase
9996 tub@dernierk1 aload pop /k1 defpoint3d
9998 /tub@dernierk1 [k1] store
10001 tub@dernierk2 aload pop /k2 defpoint3d
10003 /tub@dernierk2 [k2] store
10005 k1 k2 vectprod3d normalize3d /k3 defpoint3d
10007 tub@dernierk3 aload pop /k3 defpoint3d
10009 /tub@dernierk3 [k3] store
10011 k3 k1 vectprod3d normalize3d /k2 defpoint3d
10012 %% M k1 k2 k3 dessinebase
10013 /tub@dernierk2 [k2] store
10014 /@n 360 N div def %% le pas angulaire
10018 k2 @i cos @r mul mulv3d addv3d
10019 k3 @i sin @r mul mulv3d addv3d
10025 dup length 3 idiv /nb exch def
10026 %% definition des faces
10029 [N 1 sub -1 0 {} for]
10031 [nb 1 sub N 1 sub {dup 1 sub} repeat] reverse
10040 i 1 add N mod N j mul add
10041 i 1 add N mod N add N j mul add
10042 i N add N j mul add
10052 %%%%% ### newcourbe ###
10053 %% syntaxe : a b {f} array newcourbe --> solid
10064 /pas b a sub n 1 sub div def
10083 %%%%% ### baseplannormal ###
10084 %% syntaxe : x y z baseplannormal -> x1 y1 z1 x2 y2 z2
10088 1 0 0 K vectprod3d normalize3d /U defpoint3d
10090 0 1 0 K vectprod3d normalize3d /U defpoint3d
10092 K U vectprod3d normalize3d /V defpoint3d
10097 %%%%% ### fin insertion ###
10099 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10100 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10102 %%%% fin insertion librairie jps %%%%
10104 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10105 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10107 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10108 %%%% gestion de chaine de caracteres %%%%
10109 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10111 /Times-Roman findfont
10112 dup length dict begin
10119 /Encoding ISOLatin1Encoding def
10122 /Times-Roman-ISOLatin1 exch definefont pop
10125 /Times-Roman-ISOLatin1 findfont
10134 %% syntaxe : string x y cctext
10145 wx -2 div wy -2 div rmoveto
10151 /dbtext {gsave newpath dbtext_ fill grestore} def
10152 /dctext {gsave newpath dctext_ fill grestore} def
10153 /dltext {gsave newpath dltext_ fill grestore} def
10154 /drtext {gsave newpath drtext_ fill grestore} def
10156 /bbtext {gsave newpath bbtext_ fill grestore} def
10157 /bctext {gsave newpath bctext_ fill grestore} def
10158 /bltext {gsave newpath bltext_ fill grestore} def
10159 /brtext {gsave newpath brtext_ fill grestore} def
10161 /cbtext {gsave newpath cbtext_ fill grestore} def
10162 /cctext {gsave newpath cctext_ fill grestore} def
10163 /cltext {gsave newpath cltext_ fill grestore} def
10164 /crtext {gsave newpath crtext_ fill grestore} def
10166 /ubtext {gsave newpath ubtext_ fill grestore} def
10167 /uctext {gsave newpath uctext_ fill grestore} def
10168 /ultext {gsave newpath ultext_ fill grestore} def
10169 /urtext {gsave newpath urtext_ fill grestore} def
10172 %% syntaxe : str x y show_dim --> str x y llx lly wx wy
10173 %% attention, doit laisser la pile intacte
10178 true charpath flattenpath pathbbox
10183 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10184 %%%% procedures pour PSTricks %%%%
10185 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10187 %%% les 3 procedures utilisees pour transformer les depots de AlgToPs en nombres
10200 exec exch exec exch
10207 /gere_pst-deffunction {
10224 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10225 %%%% procedures pour \psSolid %%%%
10226 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10230 /draw {drawsolid} def
10231 /draw* {drawsolid*} def
10232 /draw** {drawsolid**} def
10233 /writeobj {solidfilename writeobjfile} def
10234 /writesolid {solidfilename writesolidfile} def
10235 /writeoff {solidfilename writeofffile} def
10237 /vecteur_en_c@urs false def
10239 /gere_pstricks_color_inout {
10241 dup [fillincolor] (setrgbcolor) astr2str
10242 [fillcolor] (setrgbcolor) astr2str inoutputcolors
10246 /gere_pstricks_color_out {
10248 dup [fillcolor] (setrgbcolor) astr2str outputcolors
10253 fontsize mul setfontsize
10255 PSfont dup /Symbol ne isolatin and {
10256 /ISO-Font ReEncode /ISO-Font
10258 findfont fontsize scalefont setfont
10261 /gere_pstricks_opt {
10262 % /CourbeR2 {CourbeR2+} def
10266 solidlinewidth setlinewidth
10267 solidtrunc length 0 ne {
10268 solidtrunc 0 get isstring {
10269 dup trunccoeff solidtronque
10271 dup solidtrunc trunccoeff solidtronque
10278 dualpolyedreregulier
10281 dup chanfreincoeff solidchanfreine
10283 RotX 0 ne RotY 0 ne or RotZ 0 ne or {
10284 {RotX RotY RotZ rotateOpoint3d} solidtransform
10286 CX 0 ne CY 0 ne or CZ 0 ne or {
10287 {CX CY CZ translatepoint3d} solidtransform
10289 plansection length 0 gt {
10290 0 1 plansection length 1 sub {
10292 plansection i get solidplansection
10296 /rmfaces rmfaces bubblesort reverse store
10297 0 1 rmfaces length 1 sub {
10299 dup rmfaces i get solidrmface
10301 tx@Dict /pst-transformoption known {
10302 dup {pst-transformoption} solidtransform
10304 solidaffinage length 0 ne {
10305 %% si on affine, il faut colorier avant
10306 activationgestioncouleurs {
10307 gere_pstricks_color_out
10309 solidaffinage 0 get isstring {
10311 /solidfcolor where {
10315 affinagerm solidaffine
10317 dup affinagecoeff solidaffinage
10318 /solidfcolor where {
10322 affinagerm solidaffine
10324 %% et il faut evider et coloriier l'interieur si necessaire
10327 activationgestioncouleurs {
10329 dup [fillincolor] (setrgbcolor) astr2str inputcolors
10333 /activationgestioncouleurs false def
10335 tx@Dict /plansepare known {
10336 plansepare solidplansepare
10337 tx@Dict /plansepare undef
10338 tx@Dict /solidname known {
10339 solidname (1) append cvlit exch def
10340 dup solidname (0) append cvlit exch def
10342 solidname (1) append cvx exec
10346 activationgestioncouleurs {
10347 dup solidwithinfaces {
10348 gere_pstricks_color_inout
10350 gere_pstricks_color_out
10353 solidinouthue length 0 gt {
10354 dup solidinouthue solidputinouthuecolors
10356 solidhue length 0 gt {
10357 dup solidhue solidputhuecolors
10359 solidinhue length 0 gt {
10360 dup solidinhue solidputinhuecolors
10364 tx@Dict /solidname undef
10373 activationgestioncouleurs {
10374 zcolor length 0 ne {
10375 dup zcolor tablez solidcolorz
10377 dup solidwithinfaces {
10378 gere_pstricks_color_inout
10380 gere_pstricks_color_out
10382 solidinouthue length 0 gt {
10383 dup solidinouthue solidputinouthuecolors
10385 solidhue length 0 gt {
10386 dup solidhue solidputhuecolors
10388 solidinhue length 0 gt {
10389 dup solidinhue solidputinhuecolors
10394 /activationgestioncouleurs true def
10397 0 1 fcol length 2 idiv 1 sub {
10399 dup fcol 2 i mul get fcol 2 i mul 1 add get solidputfcolor
10401 vecteur_en_c@urs not {
10402 /lightsrc where {pop solidlightOn} if
10404 /vecteur_en_c@urs false def
10406 dup action cvx exec
10408 solidnumf length 0 ne {
10409 solidnumf 0 get isstring {
10410 dup projectionsifacevisible solidnumfaces
10412 dup solidnumf projectionsifacevisible solidnumfaces
10415 solidshow length 0 ne {
10416 solidshow 0 get isstring {
10417 dup solidshowsommets
10419 dup solidshow solidshowsommets
10422 solidnum length 0 ne {
10423 solidnum 0 get isstring {
10425 dup solidnumsommets
10427 dup solidnum solidnumsommets
10432 tx@Dict /solidname known {
10433 solidname cvlit exch bind def
10434 tx@Dict /solidname undef
10445 /pst-dodecahedron {
10457 ngrid length 1 eq {
10469 /pst-parallelepiped {
10482 ngrid length 2 eq {
10494 % r {Mode} newsphere
10496 ngrid length 2 eq {
10506 /save-cylinderhollow solidhollow def
10507 tx@Dict /function known {
10508 range aload pop function cvx {axe} h ngrid newcylindre
10509 tx@Dict /function undef
10510 /solidhollow true def
10515 ngrid length 2 eq {
10526 /solidhollow save-cylinderhollow store
10529 /pst-cylindrecreux {
10533 ngrid length 2 eq {
10544 /save-conehollow solidhollow def
10545 tx@Dict /function known {
10546 range aload pop function cvx {origin} ngrid newcone
10547 tx@Dict /function undef
10548 /solidhollow true def
10553 ngrid length 2 eq {
10565 /solidhollow save-conehollow store
10572 ngrid length 2 eq {
10585 /pst-troncconecreux {
10589 ngrid length 2 eq {
10602 ngrid length 2 eq {
10613 ngrid length 1 ge {
10624 % tableau des points de la base
10625 % h hauteur du prisme
10626 % axe : vecteur direction de l axe
10627 base decal rollparray
10629 ngrid length 1 ge {
10640 % tableau des points de la base
10641 % h hauteur du prisme
10642 % axe : vecteur direction de l axe
10645 ngrid length 1 ge {
10655 ngrid length 2 ge {
10656 [ngrid 0 get ngrid 1 get]
10658 ngrid length 1 eq {
10666 %% syntaxe : array N h u newruban -> solid d axe (O, u),
10668 % tableau des points de la base
10669 % h hauteur du prisme
10670 % axe : vecteur direction de l axe
10673 ngrid length 1 ge {
10680 %% syntaxe : r phi option newcalottesphere -> solid
10681 /pst-calottesphere {
10684 % r phi theta option newcalottesphere
10687 ngrid length 2 eq {
10693 newcalottespherecreuse
10700 %% syntaxe : r phi option newcalottesphere -> solid
10701 /pst-calottespherecreuse {
10704 % r phi theta option newcalottespherecreuse
10707 ngrid length 2 eq {
10712 newcalottespherecreuse
10716 /pointtest{2 2 2} def
10719 % tableau des points de la base
10720 % h hauteur du prisme
10721 % axe : vecteur direction de l axe
10734 ngrid length 2 ge {
10735 [ngrid 0 get ngrid 1 get]
10737 ngrid length 1 eq {
10751 ngrid length 2 ge {
10752 [ngrid 0 get ngrid 1 get]
10754 ngrid length 1 eq {
10768 ngrid length 2 ge {
10769 [ngrid 0 get ngrid 1 get]
10771 ngrid length 1 eq {
10775 { function cvx exec } newsurface
10782 /pst-polygoneregulier {
10794 /activationgestioncouleurs false def
10796 base aload pop n 1 sub {solidfuz} repeat
10811 solidlinewidth setlinewidth
10813 range aload pop function cvx [resolution] newcourbe
10816 range aload pop function r
10817 ngrid length 2 lt {
10823 gere_pstricks_opt %% r function [36 12] newtube
10827 /pst-surfaceparametree {
10829 ngrid length 2 ge {
10830 [ngrid 0 get ngrid 1 get]
10832 ngrid length 1 eq {
10836 { function cvx exec } newsurfaceparametree
10839 tx@Dict /function undef
10844 ngrid length 2 ge {
10845 [ngrid 0 get ngrid 1 get]
10847 ngrid length 1 eq {
10851 { function cvx exec } newsurface*
10858 /activationgestioncouleurs false def
10859 /vecteur_en_c@urs true def
10860 solidlinewidth setlinewidth
10865 tx@Dict /solidname known {
10866 args definition cvx exec
10867 solidname cvlit defpoint3d
10868 tx@Dict /solidname undef
10870 args definition cvx exec newvecteur
10873 [linecolor currentrgbcolor] ( ) astr2str (setrgbcolor) append
10881 %/pst-vect-2points {vecteur3d} def
10891 solidfilename newobjfile
10896 solidfilename newofffile
10901 solidfilename readsolidfile
10902 % /activationgestioncouleurs false def
10908 args (pst-plan-) definition append cvx exec
10911 dup base planputrange
10913 origin eqpl@n pointeqplan 0 eq {
10914 dup origin planputorigine
10916 ngrid length 0 ne {
10917 dup ngrid planputngrid
10919 tx@Dict /solidname known {
10920 solidname cvlit exch bind def
10921 tx@Dict /solidname undef
10926 /pst-plan- {pst-plan-plantype} def
10928 %x0 y0 z0 [normalvect] norm2plan
10929 /pst-plan-plantype {
10930 dup plan2eq /eqpl@n exch def
10936 args (pst-plan-) definition append cvx exec
10937 /pl@n-en-cours true def
10938 definition length 0 ne {
10941 base 0 get base 1 get lt
10942 base 2 get base 3 get lt and {
10945 [-3 3 -2 2] %pop base %aload pop boum
10948 origin eqpl@n pointeqplan 0 eq {
10949 dup origin planputorigine
10957 dup CX CY CZ planputorigine
10962 ngrid length 0 ne {
10963 dup ngrid planputngrid
10966 % dup RotX RotY RotZ rotateOplan
10969 tx@Dict /solidname known {
10970 l@pl@n solidname cvlit exch bind def
10971 /solidname solidname (_s) append store
10975 /pl@n-en-cours false def
10978 l@pl@n RotX RotY RotZ rotateOplan
10979 % l@pl@n CX CY CZ plantranslate
10980 % fontsize setfontsize
10983 solidplanmarks {l@pl@n projectionsifacevisible planmarks} if
10984 solidplangrid {linecolor l@pl@n projectionsifacevisible planquadrillage} if
10985 solidshowbase {l@pl@n projectionsifacevisible planshowbase} if
10986 solidshowbase3d {l@pl@n projectionsifacevisible planshowbase3d} if
10990 /pst-plan-normalpoint {
10993 dup plan2eq /eqpl@n exch def
10996 /pst-plan-equation {
10999 dup /eqpl@n exch def
11001 2 copy pop /eqpl@n exch def
11006 /pst-plan-solidface {
11015 dup CX CY CZ planputorigine
11018 % dup plangetrange aload pop boum
11019 % dup origin planputorigine
11020 dup plan2eq /eqpl@n exch def
11024 ngrid aload pop newgeode
11030 % /activationgestioncouleurs false def
11038 action (none) eqstring not {
11039 args definition cvx exec point3d
11041 texte args definition cvx exec pos (text3d) append cvx exec
11042 tx@Dict /solidname known {
11043 args definition cvx exec
11044 solidname cvlit defpoint3d
11045 tx@Dict /solidname undef
11050 %% syntaxe : alpha beta r h newpie --> solid
11053 ngrid length 2 ge {
11054 [ngrid 0 get ngrid 1 get]
11060 /pst-trigospherique {
11063 solidlinewidth setlinewidth
11066 args definition cvx exec
11071 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
11072 %%%% procedures pour \psProjection %%%%
11073 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
11075 /gere_pstricks_proj_opt {
11076 /planprojpst where {
11078 planprojpst projectionsifacevisible projpath
11079 % /planprojpst where pop /planprojpst undef
11081 /solidprojname where {
11082 /solidprojname get noface phi
11086 xorigine isinteger not and
11087 yorigine isinteger not and
11088 yorigine isinteger not and {
11090 [xorigine yorigine zorigine] ( ) astr2str
11092 projectionsifacevisible solidprojpath
11094 xorigine yorigine zorigine [ normale ] projectionsifacevisible planprojpath
11100 solidlinewidth setlinewidth
11103 /cercle {cercle_} def
11106 gere_pstricks_proj_opt
11110 /proj-pst-courbeR2 {
11111 l@pl@n plangetrange aload pop
11112 setyrange setxrange
11114 xmin ymin l@pl@n pointplan smoveto
11115 xmin ymax l@pl@n pointplan slineto
11116 xmax ymax l@pl@n pointplan slineto
11117 xmax ymin l@pl@n pointplan slineto
11118 xmin ymin l@pl@n pointplan slineto
11119 planprojpst projpath
11121 solidlinewidth setlinewidth
11124 range aload pop { function cvx exec } CourbeR2_
11125 gere_pstricks_proj_opt
11129 l@pl@n plangetrange aload pop
11130 setyrange setxrange
11132 xmin ymin l@pl@n pointplan smoveto
11133 xmin ymax l@pl@n pointplan slineto
11134 xmax ymax l@pl@n pointplan slineto
11135 xmax ymin l@pl@n pointplan slineto
11136 xmin ymin l@pl@n pointplan slineto
11137 planprojpst projpath
11139 solidlinewidth setlinewidth
11142 range aload pop {} { function cvx exec } Courbeparam_
11143 gere_pstricks_proj_opt
11147 [proj-args] length 0 eq {
11148 xorigine yorigine /proj-args defpoint
11152 [proj-args proj-definition cvx exec]
11153 dup 0 getp projname cvlit defpoint
11155 1 getp projname (0) append cvlit defpoint
11157 /projname where pop /projname undef
11159 proj-action (none) eqstring not {
11160 solidlinewidth setlinewidth
11162 [proj-args proj-definition cvx exec] 0 getp point_
11163 gere_pstricks_proj_opt
11166 % 1 1 0 0 1 1 Diamond
11167 texte length 0 gt {
11168 proj-fontsize setfontsize
11170 solidlinewidth setlinewidth
11173 texte [proj-args proj-definition cvx exec 0 0 phi neg rotatepoint] 0 getp
11174 pos (text_) append cvx exec
11175 %% /planprojpst where {
11176 %% planprojpst dupplan dup phi rotateplan /planprojpst exch def
11178 %% xorigine yorigine
11179 %% 0 0 phi neg rotatepoint
11183 %gere_pstricks_proj_opt
11184 planprojpst dupplan dup phi rotateplan projectionsifacevisible projpath
11189 /proj-pst-vecteur {
11190 proj-action (none) eqstring not {
11191 planprojpst bprojscene
11192 solidlinewidth setlinewidth
11195 xorigine yorigine 2 copy proj-args proj-definition cvx exec addv drawvecteur
11200 proj-args proj-definition cvx exec projname cvlit defpoint
11201 /projname where pop /projname undef
11206 proj-action (none) eqstring not {
11207 l@pl@n plangetrange aload pop
11208 setyrange setxrange
11210 %% xmin ymin l@pl@n pointplan smoveto
11211 %% xmin ymax l@pl@n pointplan slineto
11212 %% xmax ymax l@pl@n pointplan slineto
11213 %% xmax ymin l@pl@n pointplan slineto
11214 %% xmin ymin l@pl@n pointplan smoveto
11215 %% planprojpst projpath
11217 planprojpst bprojscene
11218 solidlinewidth setlinewidth
11221 proj-args proj-definition cvx exec droite
11226 proj-args proj-definition cvx exec projname cvlit defdroite
11227 /projname where pop /projname undef
11231 /proj-pst-polygone {
11232 proj-action (none) eqstring not {
11233 l@pl@n plangetrange aload pop
11234 setyrange setxrange
11236 xmin ymin l@pl@n pointplan smoveto
11237 xmin ymax l@pl@n pointplan slineto
11238 xmax ymax l@pl@n pointplan slineto
11239 xmax ymin l@pl@n pointplan slineto
11240 xmin ymin l@pl@n pointplan slineto
11241 planprojpst projpath
11243 solidlinewidth setlinewidth
11246 proj-definition length 0 eq {
11251 proj-definition cvx exec polygone_
11252 planprojpst projectionsifacevisible projpath
11256 proj-definition length 0 eq {
11261 proj-definition cvx exec projname cvlit exch def
11262 /projname where pop /projname undef
11269 proj-args proj-definition cvx exec projname cvlit defcercle
11270 /projname where pop /projname undef
11272 proj-action (none) eqstring not {
11273 l@pl@n plangetrange aload pop
11274 setyrange setxrange
11276 %% xmin ymin l@pl@n pointplan smoveto
11277 %% xmin ymax l@pl@n pointplan slineto
11278 %% xmax ymax l@pl@n pointplan slineto
11279 %% xmax ymin l@pl@n pointplan slineto
11280 %% xmin ymin l@pl@n pointplan slineto
11281 %% planprojpst projpath
11283 solidlinewidth setlinewidth
11287 range aload pop proj-args
11288 proj-definition cvx exec Cercle_
11289 planprojpst projectionsifacevisible projpath
11294 proj-action (none) eqstring not {
11295 l@pl@n plangetrange aload pop
11296 setyrange setxrange
11298 %% xmin ymin l@pl@n pointplan smoveto
11299 %% xmin ymax l@pl@n pointplan slineto
11300 %% xmax ymax l@pl@n pointplan slineto
11301 %% xmax ymin l@pl@n pointplan slineto
11302 %% xmin ymin l@pl@n pointplan slineto
11303 %% planprojpst projpath
11305 planprojpst bprojscene
11306 solidlinewidth setlinewidth
11309 proj-definition length 0 eq {
11314 proj-definition cvx exec ligne
11319 proj-definition length 0 eq {
11324 proj-definition cvx exec projname cvlit exch def
11325 /projname where pop /projname undef
11329 /proj-pst-rightangle {
11330 proj-action (none) eqstring not {
11331 planprojpst bprojscene
11332 solidlinewidth setlinewidth
11335 proj-args proj-definition cvx exec angledroit
11342 proj-fontsize setfontsize
11345 solidlinewidth setlinewidth
11349 /planprojpst where {
11350 planprojpst dupplan dup phi rotateplan /planprojpst exch def
11353 0 0 phi neg rotatepoint
11357 pos (text_) append cvx exec
11358 gere_pstricks_proj_opt