2 % PostScript prologue for pst-solides3d.tex.
3 % Version 4.21, 2011/07/13
5 %% COPYRIGHT 2009/10 by Jean-Paul Vignault
6 %% opacity changes by Herbert Voss
8 %% This program can be redistributed and/or modified under the terms
9 %% of the LaTeX Project Public License Distributed from CTAN
10 %% archives in directory macros/latex/base/lppl.txt.
12 /SolidesDict 100 dict def
13 /SolidesbisDict 100 dict def
16 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
17 %% %% les variables globales gerees par PSTricks %%
18 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
19 %% %% les lignes dessous sont a decommenter si l on veut utiliser le
20 %% %% fichier solides.pro independamment du package PSTricks
25 %% /XpointVue {Dobs Cos1Cos2 mul} def
26 %% /YpointVue {Dobs Sin1Cos2 mul} def
27 %% /ZpointVue {Dobs Sin2 mul} def
29 %% /solidhollow false def
30 %% /solidbiface false def
32 %% /tracelignedeniveau? true def
33 %% /hauteurlignedeniveau 1 def
34 %% /couleurlignedeniveau {rouge} def
35 %% /linewidthlignedeniveau 4 def
36 %% /solidgrid true def
37 /aretescachees true def
38 /defaultsolidmode 2 def
40 /Stroke { strokeopacity .setopacityalpha stroke } def
41 /Fill { fillopacity .setopacityalpha fill } def
43 %% variables globales specifiques a PSTricks
44 %% /activationgestioncouleurs true def
59 /pl@n-en-cours false def
61 /pointilles { [6.25 3.75] 1.25 setdash } def
62 /stockcurrentcpath {} def
66 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
67 %% choix d une fonte accentuee pour le .ps %%
68 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
69 /ReEncode { exch findfont
70 dup length dict begin { 1 index /FID eq {pop pop} {def} ifelse
71 }forall /Encoding ISOLatin1Encoding def currentdict end definefont
73 /Font /Times-Roman /ISOfont ReEncode /ISOfont def
74 %Font findfont 10 scalefont setfont
76 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 %% extrait de color.pro pour pouvoir recuperer ses couleurs %%
78 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79 /GreenYellow{0.15 0 0.69 0 setcmykcolor}def
80 /Yellow{0 0 1 0 setcmykcolor}def
81 /Goldenrod{0 0.10 0.84 0 setcmykcolor}def
82 /Dandelion{0 0.29 0.84 0 setcmykcolor}def
83 /Apricotq{0 0.32 0.52 0 setcmykcolor}def
84 /Peach{0 0.50 0.70 0 setcmykcolor}def
85 /Melon{0 0.46 0.50 0 setcmykcolor}def
86 /YellowOrange{0 0.42 1 0 setcmykcolor}def
87 /Orange{0 0.61 0.87 0 setcmykcolor}def
88 /BurntOrange{0 0.51 1 0 setcmykcolor}def
89 /Bittersweet{0 0.75 1 0.24 setcmykcolor}def
90 /RedOrange{0 0.77 0.87 0 setcmykcolor}def
91 /Mahogany{0 0.85 0.87 0.35 setcmykcolor}def
92 /Maroon{0 0.87 0.68 0.32 setcmykcolor}def
93 /BrickRed{0 0.89 0.94 0.28 setcmykcolor}def
94 /Red{0 1 1 0 setcmykcolor}def
95 /OrangeRed{0 1 0.50 0 setcmykcolor}def
96 /RubineRed{0 1 0.13 0 setcmykcolor}def
97 /WildStrawberry{0 0.96 0.39 0 setcmykcolor}def
98 /Salmon{0 0.53 0.38 0 setcmykcolor}def
99 /CarnationPink{0 0.63 0 0 setcmykcolor}def
100 /Magenta{0 1 0 0 setcmykcolor}def
101 /VioletRed{0 0.81 0 0 setcmykcolor}def
102 /Rhodamine{0 0.82 0 0 setcmykcolor}def
103 /Mulberry{0.34 0.90 0 0.02 setcmykcolor}def
104 /RedViolet{0.07 0.90 0 0.34 setcmykcolor}def
105 /Fuchsia{0.47 0.91 0 0.08 setcmykcolor}def
106 /Lavender{0 0.48 0 0 setcmykcolor}def
107 /Thistle{0.12 0.59 0 0 setcmykcolor}def
108 /Orchid{0.32 0.64 0 0 setcmykcolor}def
109 /DarkOrchid{0.40 0.80 0.20 0 setcmykcolor}def
110 /Purple{0.45 0.86 0 0 setcmykcolor}def
111 /Plum{0.50 1 0 0 setcmykcolor}def
112 /Violet{0.79 0.88 0 0 setcmykcolor}def
113 /RoyalPurple{0.75 0.90 0 0 setcmykcolor}def
114 /BlueViolet{0.86 0.91 0 0.04 setcmykcolor}def
115 /Periwinkle{0.57 0.55 0 0 setcmykcolor}def
116 /CadetBlue{0.62 0.57 0.23 0 setcmykcolor}def
117 /CornflowerBlue{0.65 0.13 0 0 setcmykcolor}def
118 /MidnightBlue{0.98 0.13 0 0.43 setcmykcolor}def
119 /NavyBlue{0.94 0.54 0 0 setcmykcolor}def
120 /RoyalBlue{1 0.50 0 0 setcmykcolor}def
121 /Blue{1 1 0 0 setcmykcolor}def
122 /Cerulean{0.94 0.11 0 0 setcmykcolor}def
123 /Cyan{1 0 0 0 setcmykcolor}def
124 /ProcessBlue{0.96 0 0 0 setcmykcolor}def
125 /SkyBlue{0.62 0 0.12 0 setcmykcolor}def
126 /Turquoise{0.85 0 0.20 0 setcmykcolor}def
127 /TealBlue{0.86 0 0.34 0.02 setcmykcolor}def
128 /Aquamarine{0.82 0 0.30 0 setcmykcolor}def
129 /BlueGreen{0.85 0 0.33 0 setcmykcolor}def
130 /Emerald{1 0 0.50 0 setcmykcolor}def
131 /JungleGreen{0.99 0 0.52 0 setcmykcolor}def
132 /SeaGreen{0.69 0 0.50 0 setcmykcolor}def
133 /Green{1 0 1 0 setcmykcolor}def
134 /ForestGreen{0.91 0 0.88 0.12 setcmykcolor}def
135 /PineGreen{0.92 0 0.59 0.25 setcmykcolor}def
136 /LimeGreen{0.50 0 1 0 setcmykcolor}def
137 /YellowGreen{0.44 0 0.74 0 setcmykcolor}def
138 /SpringGreen{0.26 0 0.76 0 setcmykcolor}def
139 /OliveGreen{0.64 0 0.95 0.40 setcmykcolor}def
140 /RawSienna{0 0.72 1 0.45 setcmykcolor}def
141 /Sepia{0 0.83 1 0.70 setcmykcolor}def
142 /Brown{0 0.81 1 0.60 setcmykcolor}def
143 /Tan{0.14 0.42 0.56 0 setcmykcolor}def
144 /Gray{0 0 0 0.50 setcmykcolor}def
145 /Black{0 0 0 1 setcmykcolor}def
146 /White{0 0 0 0 setcmykcolor}def
147 %% fin de l extrait color.pro
149 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
150 %%%% autres couleurs %%%%
151 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
153 /bleu {0 0 1 setrgbcolor} def
154 /rouge {1 0 0 setrgbcolor} def
155 /vert {0 .5 0 setrgbcolor} def
156 /gris {.4 .4 .4 setrgbcolor} def
157 /jaune {1 1 0 setrgbcolor} def
158 /noir {0 0 0 setrgbcolor} def
159 /blanc {1 1 1 setrgbcolor} def
160 /orange {1 .65 0 setrgbcolor} def
161 /rose {1 .01 .58 setrgbcolor} def
162 /cyan {1 0 0 0 setcmykcolor} def
163 /magenta {0 1 0 0 setcmykcolor} def
165 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
166 %%%% definition du point de vue %%%%
167 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
168 %% pour la 3D conventionnelle
169 %% Dony : graphisme scientifique : page 187
172 %% calcul des coefficients de la matrice
174 /Sin1 {THETA sin} def
176 /Cos1 {THETA cos} def
178 /Cos1Sin2 {Cos1 Sin2 mul} def
179 /Sin1Sin2 {Sin1 Sin2 mul} def
180 /Cos1Cos2 {Cos1 Cos2 mul} def
181 /Sin1Cos2 {Sin1 Cos2 mul} def
189 Xabscisse Sin1 mul neg Yordonnee Cos1 mul add
192 Xabscisse Cos1Sin2 mul neg Yordonnee Sin1Sin2 mul sub Zcote Cos2
196 Xabscisse neg Cos1Cos2 mul Yordonnee Sin1Cos2 mul sub Zcote Sin2
199 %% maintenant on depose les resultats sur la pile
200 Decran xObservateur mul zObservateur div cm
201 Decran yObservateur mul zObservateur div cm
215 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
216 %%%% jps modifie pour PSTricks %%%%
217 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
220 /dashed {pointilles} def
221 /dotted { [2] 0 setdash } def
223 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
224 %%%% geometrie basique %%%%
225 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
227 %% syntaxe~: [x1 y1 ... xn yn] ligne
238 %% syntaxe~: [x1 y1 ... xn yn] ligne_
247 %% syntaxe~: [x1 y1 ... xn yn] polygone
270 currentlinewidth 0 eq {} { Stroke } ifelse
274 %% syntaxe : x y point
293 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
294 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
296 %%%% insertion librairie jps %%%%
298 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
299 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
301 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
302 %%%% le repere jps %%%%
303 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
305 %%%%% ### AAAopacity ###
307 %% les parametres pour la gestion de la transparence
309 /setstrokeopacity { /strokeopacity exch def } def
310 /setfillopacity { /fillopacity exch def } def
312 %% d apres un code de Jean-Michel Sarlat
313 %% http://melusine.eu.org/syracuse/swf/pdf2swf/setdash/
314 %% Mise en reserve de la procedure stroke originelle.
315 /sysstroke {systemdict /stroke get exec} def
316 /sysfill {systemdict /fill get exec} def
317 /sysatan {systemdict /atan get exec} def
318 /atan {2 copy 0 0 eqp {pop pop 0} {sysatan} ifelse} def
319 % Mise en place de la nouvelle procedure
320 /Stroke { /strokeopacity where { /strokeopacity get }{ 1 } ifelse
321 .setopacityalpha sysstroke
323 /Fill { /fillopacity where { /fillopacity get }{ 1 } ifelse
324 .setopacityalpha sysfill
327 %%%%% ### AAAscale ###
328 %%%%%%%%%%%%%%%% les deplacements a l echelle %%%%%%%%%%%%%%%%%%%
330 /v@ct_I {xunit 0} def
331 /v@ct_J {angle_repere cos yunit mul angle_repere sin yunit mul} def
354 xtranslate ytranslate
355 3 1 roll %% xA yB yA xB
356 4 1 roll %% xB xA yB yA
357 sub neg 3 1 roll %% yB-yA xB xA
363 xtranslate ytranslate
364 3 1 roll %% xA yB yA xB
365 4 1 roll %% xB xA yB yA
366 sub neg 3 1 roll %% yB-yA xB xA
374 /y Y yunit angle_repere sin mul div def
375 /x X y yunit mul angle_repere cos mul sub xunit div def
406 %%%%% ### fin insertion ###
408 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
409 %%%% methodes numeriques %%%%
410 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
412 %%%%% ### solve2nddegre ###
413 %% syntaxe : a b c solve2nddegre --> x1 x2
419 /delt@ @b dup mul 4 @a mul @c mul sub def
420 @b neg delt@ sqrt sub 2 @a mul div
421 @b neg delt@ sqrt add 2 @a mul div
425 %%%%% ### fin insertion ###
427 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
429 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
431 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
433 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
435 %%%%% ### tripointangle ###
436 %% syntaxe : A B C tripointangle --> angle ABC
455 %% syntaxe : A B angle
456 %% --> num, l'angle defini par le vecteur AB dans le repere orthonorme jps
464 %% syntaxe : A B pangle
465 %% --> num, l'angle defini par le vecteur AB dans le repere postscript
467 jtoppoint exchp jtoppoint exchp vecteur exch atan
473 %%%%% ### setxrange ###
479 %%%%% ### setyrange ###
485 %%%%% ### defpoint ###
486 %% syntaxe : xA yA /A defpoint
490 [ 3 1 roll ] cvx t@mp@r@ire exch
495 %% syntaxe~: A B milieu
498 3 -1 roll %% xA xB yB yA
499 add 2 div %% xA xB yM
505 %%%%% ### parallelopoint ###
506 %% syntaxe : A B C parallelopoint --> point D, tel que ABCD parallelogramme
518 /d1 {A B C paral} def
519 /d2 {B C A paral} def
524 %%%%% ### translatepoint ###
525 %% syntaxe : A u translatepoint --> B image de A par la translation de vecteur u
530 %%%%% ### rotatepoint ###
531 %% syntaxe : B A r rotatepoint --> C image de B par la rotation de centre A,
532 %% d'angle r (en degre)
533 %% En prenant les affixes des pts associes, il vient
534 %% (zC - zA) = (zB-zA) e^(ir)
536 %% zC = (zB-zA) e^(ir) + zA
537 /rotatepoint { %% B, A, r
538 5 copy %% B, A, r, B, A, r
539 cos 5 1 roll %% B, A, r, cos r, B, A
540 4 1 roll %% B, A, r, cos r, yA, B, xA
541 4 1 roll %% B, A, r, cos r, A, B
542 vecteur %% B, A, r, cos r, xB-xA, yB-yA
543 4 -1 roll sin %% B, A, cos r, xB-xA, yB-yA, sin r
544 4 copy mul %% B, A, cos r, xB-xA, yB-yA, sin r, cos r, xB-xA, (yB-yA) sin r
545 7 1 roll mul %% B, A, (yB-yA) sin r, cos r, xB-xA, yB-yA, sin r, cos r (xB-xA)
546 5 1 roll %% B, A, (yB-yA) sin r, cos r (xB-xA), cos r, xB-xA, yB-yA, sin r
547 exch %% B, A, (yB-yA) sin r, cos r (xB-xA), cos r, xB-xA, sin r, yB-yA
548 4 -1 roll mul %% B, A, (yB-yA) sin r, cos r (xB-xA), xB-xA, sin r, (yB-yA)cos r
549 3 1 roll mul %% B, A, (yB-yA) sin r, cos r (xB-xA), (yB-yA) cos r, (xB-xA) sin r
550 add %% B, A, (yB-yA) sin r, cos r (xB-xA), (yB-yA) cos r +(xB-xA) sin r
551 3 1 roll %% B, A, (yB-yA) cos r + (xB-xA) sin r, (yB-yA) sin r, cos r (xB-xA),
552 exch sub %% B, A, (yB-yA) cos r + (xB-xA) sin r, cos r (xB-xA)-(yB-yA) sin r
553 exch %% B, zA, (zB-zA) e^(ir)
559 %%%%% ### hompoint ###
560 %% syntaxe : B A alpha hompoint -> le point A' tel que AA' = alpha AB
564 vecteur %% vecteur BA
567 mulv %% alpha x vecteur AB
574 %%%%% ### orthoproj ###
575 %% syntaxe : A D orthoproj --> B, le projete orthogonal de A sur D
581 7 -1 roll pop %% D D A
586 %% syntaxe : A projx --> le projete orthogonal de A sur Ox
591 %% syntaxe : A projy --> le projete orthogonal de A sur Oy
596 %%%%% ### sympoint ###
597 %% syntaxe : A I sympoint --> point A', le symetrique de A par rapport
607 %%%%% ### axesympoint ###
608 %% syntaxe : A D axesympoint --> point B, le symetrique de A par rapport
624 %% syntaxe : alpha C cpoint -> M, le point du cercle C correspondant a
626 /cpoint { %% a, xI, yI, r
628 dup %% a, xI, yI, r, r
629 5 -1 roll %% xI, yI, r, r, a
631 alpha cos mul %% xI, yI, r, r cos a
633 alpha sin mul %% xI, yI, r cos a, r sin a
634 3 -1 roll add %% xI, r cos a, yI + r sin a
635 3 1 roll %% yI + r sin a, xI, r cos a,
636 add exch %% xI + r cos a, yI + r sin a
640 %%%%% ### xdpoint ###
641 %% x A B xdpoint : le point de la droite (AB) d'abscisse x
647 /a pt1 pt2 coeffdir def
648 /b pt1 pt2 ordorig def
653 %%%%% ### ydpoint ###
654 %% y A B ydpoint : le point de la droite (AB) d'ordonnee y
665 /a pt1 pt2 coeffdir def
666 /b pt1 pt2 ordorig def
673 %%%%% ### ordonnepoints ###
674 %% syntaxe : xA yA xB yB ordonnepoints --> idem si yB>yA ou si yB=yA
675 %% avec xB>xA, sinon xB yB xA yA
678 exch pop %% ... xA, yA, yB
680 {pop} %% oui, c'est fini
683 exch pop %% ... xA, yA, yB
686 3 copy %% oui, yA = yB
687 pop pop %% ... xA, xB
689 {} %% oui, c'est fini
690 { %% non, on echange A et B
696 { %% non : yA < yB => on echange A et B
706 %%%%% ### distance ###
707 %% syntaxe~: A B distance
708 /distance { %% xA yA xB yB
710 dup mul exch %% y^2 x
721 %%%%% ### fin insertion ###
722 /interdroites {interdroite} def
724 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
726 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
728 %%%%% ### vecteur ###
729 %% syntaxe~: A B vecteur
732 3 -1 roll %% xA xB yB yA
734 3 1 roll %% yB-yA xA xB
735 exch sub %% yB-yA xB-xA
739 %%%%% ### normalize ###
740 %% syntaxe : u normalize -> u / ||u||
750 %% syntaxe : u v addv --> u+v
751 /addv { %% xA yA xB yB
752 3 1 roll %% xA yB yA xB
753 4 1 roll %% xB xA yB yA
754 add 3 1 roll %% yB+yA xB xA
759 %% syntaxe : u v subv --> u - v
760 /subv { %% xA yA xB yB
766 %% syntaxe : u a mulv --> au
769 3 1 roll %% xA, a, yA, a
770 mul 3 1 roll %% ayA, xA, a
774 %%%%% ### scalprod ###
775 %% syntaxe : u v scalprod --> le produit scalaire de u par v
786 %% syntaxe : u normal --> v tel u.v = 0
792 %% syntaxe : u norme --> |u|
800 %%%%% ### oldarrow ###
801 %% syntaxe : A B oldarrow --> trace fleche en B, direction AB
811 A B vecteur normalize /u defpoint
812 u neg exch /v defpoint
813 u oldarrowpointe neg mulv rmoveto %% ainsi c'est la pointe qui est en (0, 0)
814 %% le pt extremal arriere haut
815 u oldarrowplume neg mulv %% l'abscisse
816 v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul mulv addv %% l'ordonnee
818 u oldarrowplume oldarrowpointe add mulv
819 v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul neg mulv addv
821 u oldarrowplume oldarrowpointe add neg mulv
822 v oldarrow@ngle sin oldarrow@ngle cos div oldarrowplume mul neg mulv addv
829 /oldarrowpointe {xunit 5 div} def
830 /oldarrowplume {xunit 10 div} def
831 /oldarrow@ngle 45 def
832 /oldarrowscale {1 1} def
833 /oldarrowangle 0 def %% pour l'utilisateur
835 %%%%% ### drawvecteur ###
836 %% syntaxe : A B drawvecteur
846 %%%%% ### orthovecteur ###
847 %% syntaxe : u orthovecteur --> v, vecteur orthogonal a u
852 %%%%% ### fin insertion ###
854 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
856 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
858 %%%%% ### defcercle ###
859 %% syntaxe : A r /d defcercle
863 [ 4 1 roll ] cvx t@mp@r@ire exch
867 %%%%% ### interdroitecercle ###
868 %% intersection de la droite y = ax+b avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
870 %% { | x = - -----, y = (b + a x0 + a y0 + (2 a b y0 - 2 a b x0 +
873 %% 3 2 2 2 2 4 2 2 2 4 2 2
874 %% 2 a x0 y0 - a b + a r + a r - a y0 - a x0 )^(1/2)) / (a + 1)
881 %% | x = - -----, y = (b + a x0 + a y0 - (2 a b y0 - 2 a b x0 +
884 %% 3 2 2 2 2 4 2 2 2 4 2 2
885 %% 2 a x0 y0 - a b + a r + a r - a y0 - a x0 )^(1/2)) / (a + 1)
891 %% intersection de la droite x = a avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
893 %% {[x = a, y = y0 + (2 a x0 - a + r - x0 ) ],
896 %% [x = a, y = y0 - (2 a x0 - a + r - x0 ) ]}
898 %% intersection de la droite y = b avec le cercle (x-x0)^2 + (y-y0)^2 = r^2
900 %% {[y = b, x = x0 + (2 b y0 - b + r - y0 ) ],
903 %% [y = b, x = x0 - (2 b y0 - b + r - y0 ) ]}
905 %% syntaxe : D I r interdroitecercle
916 xA yA xB yB verticale?
918 %% la droite est verticale
923 2 xA mul x0 mul xA dup mul sub r dup mul add x0 dup mul sub sqrt
933 %% la droite n'est pas verticale
935 /a xA yA xB yB coeffdir def
936 /b xA yA xB yB ordorig def
939 %% la droite est horizontale
958 %% la droite n'est pas horizontale
966 2 a dup mul mul b mul y0 mul
967 2 a 3 exp mul b mul x0 mul sub
968 2 a 3 exp mul x0 mul y0 mul add
969 a dup mul b dup mul mul sub
970 a dup mul r dup mul mul add
971 a 4 exp r dup mul mul add
972 a dup mul y0 dup mul mul sub
973 a 4 exp x0 dup mul mul sub
980 quantite1 quantite2 add quantite3 div
986 quantite1 quantite2 sub quantite3 div
1002 %%%%% ### intercercle ###
1003 %% syntaxe : cerc1 cerc2 intercercle --> A B les points d'intersection
1004 %% des 2 cercles, tries par 'ordonnepoints'
1014 %% on translate pour se ramener a (x1, y1) = (0, 0)
1019 %% on prepare l'equation du 2nd degre
1022 %% {y = RootOf((4 x2 + 4 y2 ) _Z
1025 %% + (-4 y2 - 4 r1~ y2 + 4 y2 r2~ - 4 x2 y2) _Z + x2
1027 %% 4 2 2 2 2 2 2 2 2
1028 %% + r2~ - 2 y2 r2~ + 2 x2 y2 - 2 x2 r2~ - 2 r1~ x2
1031 %% + r1~ + y2 + 2 r1~ y2 - 2 r1~ r2~ ), x = 1/2 (-2 y2
1034 %% RootOf((4 x2 + 4 y2 ) _Z
1037 %% + (-4 y2 - 4 r1~ y2 + 4 y2 r2~ - 4 x2 y2) _Z + x2
1039 %% 4 2 2 2 2 2 2 2 2
1040 %% + r2~ - 2 y2 r2~ + 2 x2 y2 - 2 x2 r2~ - 2 r1~ x2
1042 %% 4 4 2 2 2 2 2 2 2
1043 %% + r1~ + y2 + 2 r1~ y2 - 2 r1~ r2~ ) + r1~ + x2 + y2
1048 %% coeff pour le degre 2
1051 %% {y = RootOf((4 x2 + 4 y2 ) _Z
1053 4 y2 dup mul mul add
1056 %% coeff pour le degre 1
1060 %% + (-4 y2 - 4 r1~ y2 + 4 y2 r2~ - 4 x2 y2) _Z
1062 4 r1 dup mul mul y2 mul sub
1063 4 r2 dup mul mul y2 mul add
1064 4 x2 dup mul mul y2 mul sub
1067 %% coeff pour le degre 0
1074 %% 4 2 2 2 2 2 2 2 2
1075 %% + r2~ - 2 y2 r2~ + 2 x2 y2 - 2 x2 r2~ - 2 r1~ x2
1077 2 y2 dup mul mul r2 dup mul mul sub
1078 2 x2 dup mul mul y2 dup mul mul add
1079 2 x2 dup mul mul r2 dup mul mul sub
1080 2 x2 dup mul mul r1 dup mul mul sub
1083 %% + r1~ + y2 + 2 r1~ y2 - 2 r1~ r2~ )
1086 2 r1 dup mul mul y2 dup mul mul add
1087 2 r1 dup mul mul r2 dup mul mul sub
1128 %% on depose le resultat, en n'oubliant pas de retranslater en sens
1137 %%%%% ### ABcercle ###
1138 %% syntaxe : A B C ABcercle --> le cercle passant par A, B, C
1152 %%%%% ### diamcercle ###
1153 %% syntaxe : A B diamcercle --> le cercle de diametre [AB]
1162 %%%%% ### fin insertion ###
1164 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1166 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1168 %%%%% ### horizontale ###
1169 %% syntaxe : y horizontale
1177 %%%%% ### coeffdir ###
1178 %% syntaxe~: A B coeffdir
1183 %%%%% ### ordorig ###
1184 %% syntaxe : A B ordorig
1185 %% attention, la droite est supposee ne pas etre verticale
1188 dr@ite 3 3 -1 roll put
1189 dr@ite 2 3 -1 roll put
1190 dr@ite 1 3 -1 roll put
1191 dr@ite 0 3 -1 roll put
1192 dr@ite aload pop coeffdir /c@eff exch def
1193 dr@ite aload pop pop pop %% xA yA
1198 %%%%% ### verticale ###
1199 %% syntaxe~: A B verticale?
1205 %% syntaxe : x verticale
1213 %%%%% ### droite ###
1214 %% %% syntaxe : A B droite
1232 %% stockcurrentcpath
1237 %% /alpha xA yA xB yB coeffdir def
1238 %% /beta xA yA xB yB ordorig def
1239 %% xmin dup alpha mul beta add smoveto
1240 %% xmax dup alpha mul beta add slineto
1241 %% stockcurrentcpath
1251 %% syntaxe : A B droite
1265 %% on cherche le point le + a gauche
1266 xmin A B xdpoint /C defpoint
1267 C exch pop ymin lt {
1269 ymin A B ydpoint /C defpoint
1271 C exch pop ymax gt {
1273 ymax A B ydpoint /C defpoint
1275 %% on cherche le point le + a droite
1276 xmax A B xdpoint /D defpoint
1277 D exch pop ymin lt {
1279 ymin A B ydpoint /D defpoint
1281 D exch pop ymax gt {
1283 ymax A B ydpoint /D defpoint
1295 %%%%% ### defdroite ###
1296 %% syntaxe : A B /d defdroite
1299 /t@mp@r@ire exch def
1300 [ 5 1 roll ] cvx t@mp@r@ire exch
1305 %% syntaxe : D A paral --> droite parallele a D passant par A
1315 u1 u2 translatepoint
1319 %%%%% ### interdroite ###
1322 /dr@ite2 4 array def
1323 dr@ite2 3 3 -1 roll put
1324 dr@ite2 2 3 -1 roll put
1325 dr@ite2 1 3 -1 roll put
1326 dr@ite2 0 3 -1 roll put
1327 /dr@ite1 4 array def
1328 dr@ite1 3 3 -1 roll put
1329 dr@ite1 2 3 -1 roll put
1330 dr@ite1 1 3 -1 roll put
1331 dr@ite1 0 3 -1 roll put
1333 %%% %% trace pour deboguage
1334 %%% dr@ite1 aload pop droite
1335 %%% dr@ite2 aload pop droite
1337 %%% Dans tous les cas, on suppose que l'intersection existe
1339 %%% * la 1ere droite est verticale. les equations reduites sont
1340 %%% x = a1 et y = a2 x + b2
1341 %%% Le point d'intersection est :
1342 %%% {{x = a1, y = b2 + a1 a2}}
1344 %%% * la 2eme droite est verticale. les equations reduites sont
1345 %%% x = a1 x+ b1 et x = a2
1346 %%% Le point d'intersection est :
1347 %%% {{x = a2, y = b1 + a1 a2}}
1349 %%% * aucune n'est verticale. Les equations reduites sont
1350 %%% y = a1 x + b1 et y = a2 x + b2
1351 %%% Le point d'intersection est :
1352 %%% { { b2 - b1 a1 b2 - a2 b1 } }
1353 %%% { { x = -------, y = ------------- } }
1354 %%% { { a1 - a2 a1 - a2 } }
1356 %%% remarque : pour le moment, je n'arrive pas a rendre mes variables
1357 %%% locales : elle restent globales. Pour que cela ne soit pas trop
1358 %%% genant, je les note respectivement @1, @@1, @2 et @@2 au lieu de a1,
1361 dr@ite1 aload pop verticale?
1363 /@1 {dr@ite1 aload pop pop pop pop} def
1364 /@2 {dr@ite2 aload pop coeffdir} def
1365 /@@2 {dr@ite2 aload pop ordorig} def
1370 dr@ite2 aload pop verticale?
1372 /@1 {dr@ite1 aload pop coeffdir} def
1373 /@@1 {dr@ite1 aload pop ordorig} def
1374 /@2 {dr@ite2 aload pop pop pop pop} def
1379 /@1 {dr@ite1 aload pop coeffdir} def
1380 /@@1 {dr@ite1 aload pop ordorig} def
1381 /@2 {dr@ite2 aload pop coeffdir} def
1382 /@@2 {dr@ite2 aload pop ordorig} def
1383 @@2 @@1 sub @1 @2 sub div
1384 @1 @@2 mul @2 @@1 mul sub
1393 %% syntaxe : D A perp --> droite perpendiculaire a D passant par A
1398 vecteur orthovecteur
1403 u1 u2 translatepoint
1407 %%%%% ### mediatrice ###
1408 %% synaxe : A B mediatrice --> droite
1415 %%%%% ### bissectrice ###
1416 %% syntaxe : A B C bissectrice --> B E ou E est un point de la bissectrice
1428 /alpha {A B C tripointangle} def
1430 A B alpha rotatepoint
1435 %%%%% ### angledroit ###
1436 /widthangledroit 5 def
1438 %% syntaxe : A B C angledroit --> dessine un angle droit en B
1442 /widthangledroit exch def
1447 B C vecteur normalize widthangledroit 20 div mulv /u defpoint
1448 B A vecteur normalize widthangledroit 20 div mulv /v defpoint
1449 [B u addv dupp v addv B v addv] ligne
1453 %%%%% ### translatedroite ###
1454 %% syntaxe : A B u translatedroite --> C D images resp de A et B par la translation de vecteur u
1455 /translatedroite { %% A B u
1467 %%%%% ### rotatedroite ###
1468 %% syntaxe : A B O r rotatedroite --> C D images resp de A et B par la
1469 %% rotation de centre O et d'angle r (en degre)
1471 5 copy rotatepoint %% A B O r D
1472 6 -1 roll pop %% A xB O r D
1473 6 -1 roll pop %% A O r D
1475 7 1 roll rotatepoint %% D C
1487 %%%%% ### axesymdroite ###
1488 %% syntaxe : d D axesymdroite --> droite d', symetrique de la droite d par rapport
1499 %%%%% ### fin insertion ###
1501 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1503 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1505 %%%%% ### poltransformfile ###
1506 %% syntaxe : pol u translatepol --> pol'
1511 {ux uy translatepoint} papply
1515 %% syntaxe : pol u rotatepol --> pol'
1520 {I alpha rotatepoint} papply
1524 %% syntaxe : pol I alpha hompol --> pol'
1529 {I alpha hompoint} papply
1533 %% syntaxe : pol I sympol --> pol'
1541 %% syntaxe : pol D axesympol --> pol'
1545 {D axesympoint} papply
1549 %%%%% ### fin insertion ###
1551 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1553 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1555 %%%%% ### isbool ###
1556 %% syntaxe : any isbool --> booleen
1558 type (booleantype) cvn eq
1561 %%%%% ### isarray ###
1562 %% syntaxe : any isarray --> booleen
1564 type (arraytype) cvn eq
1567 %%%%% ### isstring ###
1568 %% syntaxe : any isstring --> booleen
1570 type (stringtype) cvn eq
1573 %%%%% ### isinteger ###
1574 %% syntaxe : any isinteger --> booleen
1576 type (integertype) cvn eq
1580 %% syntaxe : any isnum --> booleen
1586 %%%%% ### isreal ###
1587 %% syntaxe : any isreal --> booleen
1589 type (realtype) cvn eq
1593 %% syntaxe : A B eqp3d --> booleen = true si les points A et B sont identiques
1595 %% x1 y1 z1 x2 y2 z2
1596 4 -1 roll %% x1 y1 x2 y2 z2 z1
1600 pop pop pop pop false
1604 %% syntaxe : A B eqp --> booleen = true si les points A et B sont identiques
1618 %% syntaxe : z z' eqc --> true si z = z', false sinon
1623 %%%%% ### eqstring ###
1628 str1 length str2 length eq {
1632 str1 i get str2 i get eq and
1641 %%%%% ### fin insertion ###
1643 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1644 %%%% conversions de types %%%%
1645 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1647 %%%%% ### astr2str ###
1648 %% syntaxe : array str astr2str --> str
1649 %% convertit le contenu de array en chaines de caracteres puis les
1650 %% concatene avec str, en inserant un caractere "space" apres chaque
1651 %% element du tableau array
1660 table 0 n 1 sub getinterval
1661 table n 1 sub get ( ) cvs
1669 %%%%% ### numstr2array ###
1670 %% syntaxe : str str2num --> num
1694 i 1 ge signnum 0 ge and i 2 ge or {
1695 exch 10 mul 48 sub add
1711 /str2num {cvx exec} def
1713 %% syntaxe : str numstr2array -> array
1714 %% ou str est une chaine de nombres reels separes par des espaces
1715 %% et array est constitue des elements numeriques de string.
1717 %% (0 -12 .234 54) --> [0 -12 0.234 54]
1728 /separateurs [separateurs aload pop i] def
1733 0 1 separateurs length 1 sub {
1735 str j separateurs i get oldsep sub getinterval str2num
1736 /j separateurs i get 1 add def
1737 /oldsep separateurs i get 1 add def
1739 str j n oldsep sub getinterval str2num
1744 %% syntaxe : array numstr2array -> array
1745 /arraynumstr2arrayarray {
1746 {numstr2array} apply
1749 %%%%% ### fin insertion ###
1751 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1752 %%%% macros de projection %%%%
1753 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1755 %%%%% ### projtext ###
1756 %% syntaxe : str x0 y0 z0 [normal_vect] ultextp3d --> -
1757 %% syntaxe : str x0 y0 z0 [normal_vect] bool ultextp3d --> -
1758 %% syntaxe : str x0 y0 plantype ultextp3d --> -
1759 %% syntaxe : str x0 y0 plantype bool ultextp3d --> -
1760 %% syntaxe : str1 solid i str2 ultextp3d --> -
1761 %% syntaxe : str1 solid i str2 bool ultextp3d --> -
1762 %% syntaxe : str1 solid i alpha str2 bool ultextp3d --> -
1771 /type_plan_proj true def
1773 lepl@n plangetbase aload pop
1776 lepl@n plangetorigine
1780 /table [@U @U @V vectprod3d] def
1783 %% c est un planprojpath
1784 /type_plan_proj true def
1791 %% c est un solidprojpath
1792 /type_plan_proj false def
1799 %% y a-t-il un alpha
1800 2 copy pop issolid {
1813 x0 y0 z0 table mybool projpath
1815 solid i alpha str2 mybool projpath
1822 %% syntaxe : str x0 y0 z0 [normal_vect] ultextp3d --> -
1823 %% syntaxe : str x0 y0 z0 [normal_vect] bool ultextp3d --> -
1824 %% syntaxe : str1 solid i str2 ultextp3d --> -
1825 %% syntaxe : str1 solid i str2 bool ultextp3d --> -
1826 %% syntaxe : str1 solid i alpha str2 bool ultextp3d --> -
1827 /ultextp3d {initpr@jtext ultext_ closepr@jtext} def
1828 /cltextp3d {initpr@jtext cltext_ closepr@jtext} def
1829 /bltextp3d {initpr@jtext bltext_ closepr@jtext} def
1830 /dltextp3d {initpr@jtext dltext_ closepr@jtext} def
1831 /ubtextp3d {initpr@jtext ubtext_ closepr@jtext} def
1832 /cbtextp3d {initpr@jtext cbtext_ closepr@jtext} def
1833 /bbtextp3d {initpr@jtext bbtext_ closepr@jtext} def
1834 /dbtextp3d {initpr@jtext dbtext_ closepr@jtext} def
1835 /uctextp3d {initpr@jtext uctext_ closepr@jtext} def
1836 /cctextp3d {initpr@jtext cctext_ closepr@jtext} def
1837 /bctextp3d {initpr@jtext bctext_ closepr@jtext} def
1838 /dctextp3d {initpr@jtext dctext_ closepr@jtext} def
1839 /urtextp3d {initpr@jtext urtext_ closepr@jtext} def
1840 /crtextp3d {initpr@jtext crtext_ closepr@jtext} def
1841 /brtextp3d {initpr@jtext brtext_ closepr@jtext} def
1842 /drtextp3d {initpr@jtext drtext_ closepr@jtext} def
1844 %%%%% ### currentppathtransform ###
1845 %% syntaxe : {f} currentppathtransform --> applique la transformation f
1846 %% au chemin courant
1847 /currentppathtransform {
1850 %% pour remplacer 'move'
1859 %% pour remplacer 'lineto'
1864 %% pour remplacer 'curveto'
1873 { warpmove } { warpline } { warpcurve } { closepath } pathforall
1878 %% syntaxe : {f} currentpathtransform --> applique la transformation f
1879 %% au chemin courant
1880 /currentpathtransform {
1883 /warp {ptojpoint transform} def
1884 %% pour remplacer 'move'
1893 %% pour remplacer 'lineto'
1898 %% pour remplacer 'curveto'
1907 { warpmove } { warpline } { warpcurve } { closepath } pathforall
1912 %%%%% ### normalvect_to_orthobase ###
1913 %% syntaxe : [normal_vect] normalvect_to_orthobase
1915 /normalvect_to_orthobase {
1918 aload pop normalize3d /normal_vect defpoint3d
1919 normal_vect -1 0 0 eqp3d {
1920 /imageI {0 -1 0} def
1921 /imageK {-1 0 0} def
1924 %% on calcule l image de la base (I,J,K)
1925 /imageJ {normal_vect 1 0 0 vectprod3d normalize3d} def
1926 /imageK {normal_vect} def
1927 /imageI {imageJ imageK vectprod3d} def
1928 1 0 0 imageK angle3d 0 eq {
1929 0 1 0 normal_vect vectprod3d /imageI defpoint3d
1931 normal_vect /imageK defpoint3d
1937 normalize3d /imageK defpoint3d
1938 normalize3d /imageI defpoint3d
1939 imageK imageI vectprod3d /imageJ defpoint3d
1943 /alpha exch 2 div def
1944 normalize3d /imageK defpoint3d
1945 normalize3d /imageI defpoint3d
1946 imageK imageI vectprod3d /imageJ defpoint3d
1947 %% et ensuite, on fait tourner la base autour de imageK
1948 imageI alpha cos mulv3d
1949 imageJ alpha sin mulv3d
1952 imageI alpha sin neg mulv3d
1953 imageJ alpha cos mulv3d
1962 normalize3d /normal_vect defpoint3d
1964 normal_vect -1 0 0 eqp3d {
1965 /imageI {0 -1 0} def
1966 /imageK {-1 0 0} def
1969 %% on calcule l image de la base (I,J,K)
1970 /imageJ {normal_vect 1 0 0 vectprod3d normalize3d} def
1971 /imageK {normal_vect} def
1972 /imageI {imageJ imageK vectprod3d} def
1973 1 0 0 imageK angle3d 0 eq {
1974 0 1 0 normal_vect vectprod3d /imageI defpoint3d
1976 normal_vect /imageK defpoint3d
1981 %% et ensuite, on fait tourner la base autour de imageK
1982 imageI alpha cos mulv3d
1983 imageJ alpha sin mulv3d
1986 imageI alpha sin neg mulv3d
1987 imageJ alpha cos mulv3d
2000 %%%%% ### projpath ###
2001 %% syntaxe : x y z [normal] projpath --> planprojpath
2002 %% syntaxe : x y z [normal] bool projpath --> planprojpath
2003 %% syntaxe : solid i projpath --> solidprojpath
2004 %% syntaxe : solid i bool projpath --> solidprojpath
2005 %% syntaxe : solid i str bool projpath --> solidprojpath
2006 %% syntaxe : solid i alpha str bool projpath --> solidprojpath
2017 lepl@n plangetbase aload pop
2020 lepl@n plangetorigine
2021 [@U @U @V vectprod3d] mybool planprojpath
2027 mybool solidprojpath
2034 %% %% syntaxe : x y z [normal] projpath --> planprojpath
2035 %% %% syntaxe : x y z [normal] bool projpath --> planprojpath
2036 %% %% syntaxe : solid i projpath --> solidprojpath
2037 %% %% syntaxe : solid i bool projpath --> solidprojpath
2038 %% %% syntaxe : solid i str bool projpath --> solidprojpath
2039 %% %% syntaxe : solid i alpha str bool projpath --> solidprojpath
2048 %% mybool planprojpath
2050 %% mybool solidprojpath
2055 %% syntaxe : solid i str bool solidprojpath --> -
2057 %% syntaxe : solid i alpha str bool solidprojpath --> -
2058 %% projette le chemin courant sur la face i du solide, apres
2059 %% eventuellement une rotation d angle alpha autour de la normale
2060 %% bool : pour savoir si on tient compte de la visibilite
2063 /visibility exch def
2076 (Error : mauvais type d argument dans solidprojpath) ==
2078 /n solid solidnombrefaces def
2080 visibility not solid i solidfacevisible? or {
2081 currentdict /option known {
2084 solid i solidcentreface
2087 solid 0 i solidgetsommetface
2088 solid 1 i solidgetsommetface
2089 vecteur3d normalize3d
2090 solid i solidnormaleface alpha
2091 ] false planprojpath
2096 (Error : indice trop grand dans solidprojpath) ==
2102 %% syntaxe : x y z [normal] bool planprojpath
2105 /visibility exch def
2106 %% on calcule l image de la base (I,J,K)
2107 normalvect_to_orthobase
2115 visibility not x y z imageK planvisible? or {
2122 3dto2d jtoppoint} currentppathtransform
2129 %%%%% ### projscene ###
2130 %% syntaxe : plantype bool bprojscene ... eprojscene
2140 /saveStroke {SolidesDict /Stroke get exec} def
2141 /Stroke {l@pl@n mybool projpath saveStroke} def
2142 /savefill {SolidesDict /Fill get exec} def
2143 /Fill {l@pl@n mybool projpath savefill} def
2145 l@pl@n plangetrange aload pop
2148 %% xmin ymin l@pl@n pointplan smoveto
2149 %% xmin ymax l@pl@n pointplan slineto
2150 %% xmax ymax l@pl@n pointplan slineto
2151 %% xmax ymin l@pl@n pointplan slineto
2152 %% xmin ymin l@pl@n pointplan smoveto
2154 %% %gsave orange Fill grestore
2162 %%%%% ### fin insertion ###
2164 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2165 %%%% fonctions numeriques %%%%
2166 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2168 %%%%% ### courbeparam ###
2170 /resolution exch def
2172 %/resolution 200 def % ---- hv 20110713
2174 /courbe_dic 2 dict def
2175 courbe_dic /X {} put
2176 courbe_dic /Y {} put
2178 %% syntaxe : tmin tmax C@urbeparam_
2184 /dt tmax@ tmin@ sub resolution 1 sub div def
2185 tmin@ courbe_dic /X get exec
2187 tmin@ courbe_dic /Y get exec
2192 t courbe_dic /X get exec
2194 t courbe_dic /Y get exec
2198 /t t dt add store %% on incremente
2201 tmax@ courbe_dic /X get exec
2203 tmax@ courbe_dic /Y get exec
2209 %% syntaxe : tmin tmax {X} {Y} Courbeparam_
2211 courbe_dic exch /Y exch put
2212 courbe_dic exch /X exch put
2216 %% syntaxe : {X} {Y} courbeparam_
2224 %% syntaxe : tmin tmax {X} {Y} Courbeparam
2233 courbe_dic exch /Y exch put
2234 courbe_dic exch /X exch put
2239 tmin courbe_dic /X get exec
2241 tmin courbe_dic /Y get exec
2243 smoveto %% on commence le chemin
2244 tmin tmax C@urbeparam_
2249 currentdict /option known
2251 /dt tmax tmin sub resolution 1 sub div def
2252 tmin dt add courbe_dic /X get exec
2253 tmin dt add courbe_dic /Y get exec
2254 tmin courbe_dic /X get exec
2255 tmin courbe_dic /Y get exec
2257 tmax dt sub courbe_dic /X get exec
2258 tmax dt sub courbe_dic /Y get exec
2259 tmax courbe_dic /X get exec
2260 tmax courbe_dic /Y get exec
2261 currentdict /dt undef
2268 currentlinewidth 0 eq {} { Stroke } ifelse
2274 %% syntaxe : {X} {Y} courbeparam
2292 %% syntaxe : tmin tmax {X} {Y} Courbeparam*
2295 /startest {true} def
2300 %% syntaxe : {X} {Y} courbeparam*
2303 /startest {true} def
2308 %%%%% ### courbe ###
2309 %% syntaxe : {f} courbe
2311 dup isstring %% y a-t-il une option de fin de ligne ?
2327 %% syntaxe : mini maxi {f} Courbe
2340 %% syntaxe : {f} courbe_
2348 %% syntaxe : mini maxi {f} Courbe_
2355 %% syntaxe : mini maxi {f} Courbe*
2358 /startest {true} def
2363 %% syntaxe : {f} courbe*
2366 /startest {true} def
2371 %%%%% ### courbeR2 ###
2372 %% syntaxe : tmin tmax C@urbeR2_
2378 /dt tmax@ tmin@ sub resolution 1 sub div def
2379 tmin@ courbe_dic /X get exec
2385 t courbe_dic /X get exec
2388 /t t dt add store %% on incremente
2391 tmax@ courbe_dic /X get exec
2397 %% syntaxe : tmin tmax {X} CourbeR2_
2399 courbe_dic exch /X exch put
2403 %% syntaxe : {X} courbeR2_
2411 %% syntaxe : tmin tmax {X} CourbeR2
2428 courbe_dic exch /X exch put
2435 currentlinewidth 0 eq {} { Stroke } ifelse
2441 %% syntaxe : {X} courbeR2
2448 %% syntaxe : tmin tmax {X} CourbeR2*
2451 /startest {true} def
2456 %% syntaxe : {X} {Y} courbeR2*
2459 /startest {true} def
2464 %%%%% ### courbeR3 ###
2465 %% syntaxe : t1 t2 {f} (option) CourbeR3
2471 /lafonction exch def
2473 currentdict /option known
2480 %% syntaxe : {f} (option) CourbeR3
2482 tmin tmax 3 -1 roll CourbeR3
2485 %%%%% ### cercle ###
2486 %% syntaxe : x0 y0 r cercle
2492 0 360 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam
2496 %% syntaxe : x0 y0 r cercle_
2502 x@ r@y@n add y@ smoveto
2503 0 360 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
2507 %% syntaxe : x0 y0 r cercle-_
2513 x@ r@y@n add y@ smoveto
2514 360 0 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
2518 %% syntaxe : x0 y0 r cercle*
2526 %% syntaxe : alpha beta x0 y0 r Cercle
2535 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add}
2536 currentdict /option known
2543 %% syntaxe : alpha beta x0 y0 r Cercle_
2549 {cos r@y@n mul x@ add} {sin r@y@n mul y@ add} Courbeparam_
2553 %% syntaxe : alpha beta x0 y0 r Cercle
2556 /startest {true} def
2561 %%%%% ### fin insertion ###
2563 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2564 %%%% fonctions et constantes mathematiques %%%%
2565 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2568 %%%%%%%%%%% constantes mathematiques %%%%%%%%%%%%%%
2573 %%%%%%%%%%% fonctions mathematiques %%%%%%%%%%%%%%%
2575 /rd {180 pi div mul} def %% transforme des rd en degres
2576 /deg {pi mul 180 div} def %% transforme des degres en rd
2577 /log {ln 10 ln div} def
2578 /Exp {e exch exp} def
2581 /tan {dup sin exch cos div} def
2582 /cotan {dup cos exch sin div} def
2583 /Tan {dup Sin exch Cos div} def
2584 /Cotan {dup Cos exch Sin div} def
2592 /Arctan {arctan deg} def
2595 dup mul neg 1 add sqrt
2599 /Arccos {arccos deg} def
2605 dup mul neg 1 add sqrt
2613 /Arcsin {arcsin deg} def
2614 /cosh {dup Exp exch neg Exp add 2 div} def
2615 /sinh {dup Exp exch neg Exp sub 2 div} def
2616 /tanh {dup sinh exch cosh div} def
2617 /cotanh {dup cosh exch sinh div} def
2618 /argcosh {dup dup mul 1 sub sqrt add ln} def
2619 /argsinh {dup dup mul 1 add sqrt add ln} def
2631 {dup 1 sub factorielle mul}
2639 x m sub dup mul sigma dup mul 2 mul div neg Exp
2640 2 pi mul sigma dup mul mul sqrt div
2643 %% syntaxe : a n modulo
2670 duparray /table exch def pop
2672 1 1 table length 1 sub {
2685 %%%%% ### setcolor ###
2686 %% syntaxe : tableau setcolor
2689 {aload pop setcmykcolor}
2690 {aload pop setrgbcolor}
2695 %% cherche si un elt donne appartient au tableau donne
2696 %% rque : utilise 3 variables locales
2697 %% syntaxe : elt array in --> index boolean
2703 false %% la reponse a priori
2705 liste i get elt eq {
2706 pop %% en enleve la reponse
2707 i true %% pour mettre la bonne
2715 %% cherche si un elt donne appartient au tableau donne
2716 %% syntaxe : elt array in --> boolean
2722 false %% la reponse a priori
2724 liste i get elt eq {
2725 pop %% en enleve la reponse
2726 true %% pour mettre la bonne
2734 %%%%% ### starfill ###
2735 %% la procedure pour les objets "star"
2736 %% si c est "star" on fait le fillstyle, sinon non
2748 %% syntaxe : u v addv --> u+v
2749 /addv { %% xA yA xB yB
2750 3 1 roll %% xA yB yA xB
2751 4 1 roll %% xB xA yB yA
2752 add 3 1 roll %% yB+yA xB xA
2756 %%%%% ### continu ###
2761 %%%%% ### trigospherique ###
2762 %% passage spherique --> cartesiennes
2763 %% les formules de passage ont été récupérées ici :
2764 %% http://fr.wikipedia.org/wiki/Coordonn%C3%A9es_polaires
2765 %% syntaxe : r theta phi rtp2xyz -> x y z
2771 /x phi cos theta cos mul r mul def
2772 /y phi cos theta sin mul r mul def
2773 /z phi sin r mul def
2778 %% trace d'un arc sur une sphere de centre O
2779 %% syntaxe : r theta1 phi1 r theta2 phi2 arcspherique
2793 1 theta1 phi1 rtp2xyz /u defpoint3d
2794 1 theta2 phi2 rtp2xyz /v defpoint3d
2795 u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d
2797 /sinalpha u v vectprod3d norme3d def
2798 /cosalpha u v scalprod3d def
2799 /alpha sinalpha cosalpha atan def
2801 /pas alpha n div def
2808 u t cos r mul mulv3d
2809 w t sin r mul mulv3d
2813 currentdict /option known {
2821 %% trace d'un arc sur une sphere de centre O
2822 %% syntaxe : r theta1 phi1 r theta2 phi2 arcspherique
2833 1 theta1 phi1 rtp2xyz /u defpoint3d
2834 1 theta2 phi2 rtp2xyz /v defpoint3d
2835 u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d
2837 /sinalpha u v vectprod3d norme3d def
2838 /cosalpha u v scalprod3d def
2839 /alpha sinalpha cosalpha atan def
2841 /pas alpha n div def
2847 u t cos r mul mulv3d
2848 w t sin r mul mulv3d
2855 %% trace d'une geodesique sur une sphere de centre O
2856 %% syntaxe : r theta1 phi1 r theta2 phi2 geodesique_sphere
2857 /geodesique_sphere {
2867 1 theta1 phi1 rtp2xyz /u defpoint3d
2868 1 theta2 phi2 rtp2xyz /v defpoint3d
2869 u v vectprod3d u vectprod3d dupp3d norme3d 1 exch div mulv3d /w defpoint3d
2871 /sinalpha u v vectprod3d norme3d def
2872 /cosalpha u v scalprod3d def
2873 /alpha sinalpha cosalpha atan def
2881 u t cos r mul mulv3d
2882 w t sin r mul mulv3d
2891 %% syntaxe : A B C trianglespherique --> trace le rtiangle ABC
2892 %% (coordonnees spheriques)
2893 /trianglespherique* {
2895 /startest {true} def
2900 /trianglespherique {
2907 A rtp2xyz 3dto2d smoveto
2913 currentlinewidth 0 eq {} { Stroke } ifelse
2918 %%%%% ### fin insertion ###
2920 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2921 %%%% operations sur les tableaux %%%%
2922 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2924 %%%%% ### duparray ###
2933 %%%%% ### append ###
2934 %% syntaxe : string1 string2 append --> concatene les 2 chaines ou fusionne 2 tableaux
2940 [ tab1 aload pop tab2 aload pop ]
2944 /result str1 length str2 length add string def
2945 str1 result copy pop
2946 result str1 length str2 putinterval
2952 %%%%% ### rollparray ###
2953 %% syntaxe : array n rollparray -> array
2954 %% opere une rotation de n sur les couplets du tableau array
2964 [ table aload pop 2 {n 1 roll} repeat ]
2967 [ table aload pop 2 {n -1 roll} repeat ]
2975 %%%%% ### bubblesort ###
2976 %% syntaxe : array bubblesort --> array2 trie par ordre croissant
2977 %% code de Bill Casselman
2978 %% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
2982 /n a length 1 sub def
2984 % at this point only the n+1 items in the bottom of a remain to
2985 % the sorted largest item in that blocks is to be moved up into
2990 a i get a i 1 add get gt {
2991 % if a[i] > a[i+1] swap a[i] and a[i+1]
2995 % set new a[i] = old a[i+1]
2997 % set new a[i+1] = old a[i]
3008 %% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
3009 %% trie par ordre croissant et array2 correspond a la position des
3010 %% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
3011 %% code de Bill Casselman, modifie par jpv, 15/08/2006
3012 %% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
3016 /n table length 1 sub def
3017 /indices [ 0 1 n {} for ] def
3019 % at this point only the n+1 items in the bottom of a remain to
3020 % the sorted largest item in that blocks is to be moved up into
3025 table i get table i 1 add get gt {
3026 % if a[i] > a[i+1] swap a[i] and a[i+1]
3029 table i table i 1 add get
3030 % set new a[i] = old a[i+1]
3032 % set new a[i+1] = old a[i]
3037 indices i indices i 1 add get
3038 % set new a[i] = old a[i+1]
3040 % set new a[i+1] = old a[i]
3051 %%%%% ### quicksort ###
3052 %% src : http://www.math.ubc.ca/~cass/graphics/text/www/code/sort.inc
3053 %% code de Bill Casselman, modifie par jpv, 18/10/2007
3055 /qsortdict 8 dict def
3059 % args: /comp a L R x
3060 % effect: effects a partition into two pieces [L j] [i R]
3061 % leaves i j on stack
3063 /partition { 8 dict begin
3071 a i get x comp exec not {
3077 x a j get comp exec not {
3088 indices j indices i get
3089 indices i indices j get
3102 % effect: sorts a[L .. R] according to comp
3107 % /c a [L R] /c a [L R]
3109 % /c a [L R] /c a L R L R
3111 % /c a [L R] /c a L R (L+R)/2
3113 % /c a [L R] /c a L R x
3116 % if j > L subsort(a, L, j)
3122 % /c a [L R] i j /c a [L R] i j
3124 % /c a [L R] i j /c a [L R] j
3132 % if i < R subsort(a, i, R)
3146 % effect: sorts the array a
3147 % comp returns truth of x < y for entries in a
3149 /quicksort { qsortdict begin
3162 % ----------------------------------------
3164 %% fin du code de Bill Casselman
3166 %% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
3167 %% trie par ordre croissant et array2 correspond a la position des
3168 %% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
3169 %% code de Bill Casselman, modifie par jpv, 18/10/2007
3170 %% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
3175 a dup length /n exch def
3176 /indices [0 1 n 1 sub {} for ] def
3194 %% syntaxe : [x1 ... xn] (f) apply --> [f(x1) ... f(xn)]
3198 {/fonction exch cvx def}
3199 {/fonction exch def}
3205 liste @i get fonction
3216 %% syntaxe : [x1 ... xn] (f) papply
3220 {/fonction exch cvx def}
3221 {/fonction exch def}
3226 liste length 2 idiv {
3240 %% syntaxe : [x1 ... xn] (f) capply
3244 {/fonction exch cvx def}
3245 {/fonction exch def}
3250 liste length 3 idiv {
3265 %%%%% ### reverse ###
3266 %% syntaxe : array reverse --> inverse l ordre des items dans
3270 /le_tableau exch def
3271 /n le_tableau length def
3282 %% syntaxe : array_points reversep --> inverse l ordre des points dans
3286 /le_tableau exch def
3287 /n le_tableau length 2 idiv def
3299 %% syntaxe : array_points n getp --> le n-ieme point du tableau de
3300 %% points array_points
3308 %%%%% ### fin insertion ###
3310 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3312 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3314 %%%%% ### linear ###
3315 %% syntaxe : M i j any --> depose any dans M en a_ij
3328 %% syntaxe : M i j get_ij --> le coeff c_ij
3335 %% syntaxe : M i L put_Li --> remplace dans M la ligne Li par L
3340 %% syntaxe : M i get_Li --> la ligne Li de M
3345 %%%%% ### fin insertion ###
3347 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3348 %%%% geometrie 3d (calculs) %%%%
3349 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3351 %%%%% ### p3dtoplane ###
3352 %% syntaxe : x y z P p3dtoplane --> X Y
3357 leplan plangetbase 0 getp3d /U defpoint3d
3358 leplan plangetbase 1 getp3d /V defpoint3d
3359 leplan plangetorigine /I defpoint3d
3360 I M vecteur3d U scalprod3d
3361 I M vecteur3d V scalprod3d
3365 %%%%% ### pplaneto3d ###
3366 %% syntaxe : x y P pplaneto3d --> X Y Z
3372 leplan plangetbase 0 getp3d /U defpoint3d
3373 leplan plangetbase 1 getp3d /V defpoint3d
3374 leplan plangetorigine /I defpoint3d
3381 %%%%% ### orthoprojplane3d ###
3382 %% Projection orthogonale d'un point 3d sur un plan
3383 %% Mx My Mz (=le point a projeter)
3384 %% Ax Ay Az (=un point du plan)
3385 %% Vx Vy Vz (un vecteur normal au plan)
3390 monplan plangetorigine
3391 monplan plangetbase aload pop vectprod3d
3396 /VN {V unitaire3d} def
3397 VN M A vecteur3d VN scalprod3d mulv3d
3402 %%%%% ### sortp3d ###
3439 %%%%% ### dupp3d ###
3440 %% duplique le vecteur 3d
3444 /dupv3d {dupp3d} def
3446 %%%%% ### angle3d ###
3447 %% syntaxe : vect1 vect2 angle3d
3450 normalize3d /vect2 defpoint3d
3451 normalize3d /vect1 defpoint3d
3452 /cosalpha vect1 vect2 scalprod3d def
3453 /sinalpha vect1 vect2 vectprod3d norme3d def
3454 sinalpha cosalpha atan
3458 %%%%% ### transformpoint3d ###
3459 %% syntaxe : x y z a11 a21 a31 a12 a22 a32 a13 a23 a33
3460 %% transformpoint3d -> X Y Z
3475 a11 x mul a12 y mul add a13 z mul add
3476 a21 x mul a22 y mul add a23 z mul add
3477 a31 x mul a32 y mul add a33 z mul add
3481 %%%%% ### normalize3d ###
3482 %% rend le vecteur 3d unitaire. Ne fait rien si u=0
3483 /unitaire3d { %% x y z
3486 /norme u norme3d def
3490 u 1 norme div mulv3d
3494 /normalize3d {unitaire3d} def
3496 %%%%% ### geom3d ###
3497 %% syntaxe : A k1 B k2 barycentre3d -> G, barycentre du systeme
3498 %% [(A, k1) (B, k2)]
3508 1 k1 k2 add div mulv3d
3512 %% syntaxe : array isobarycentre3d --> G
3516 /n table length 3 idiv def
3526 %% syntaxe : M A alpha hompoint3d -> le point M' tel que AM' = alpha AM
3532 A M vecteur3d alpha mulv3d A addv3d
3536 %% syntaxe : M A sympoint3d -> le point M' tel que AM' = -AM
3541 A M vecteur3d -1 mulv3d A addv3d
3545 %% syntaxe : A u translatepoint3d --> B image de A par la translation de vecteur u
3564 % syntaxe : M alpha_x alpha_y alpha_z rotateOpoint3d --> M'
3573 /c1 {RotX cos} bind def
3574 /c2 {RotY cos} bind def
3575 /c3 {RotZ cos} bind def
3576 /s1 {RotX sin} bind def
3577 /s2 {RotY sin} bind def
3578 /s3 {RotZ sin} bind def
3579 /M11 {c2 c3 mul} bind def
3580 /M12 {c3 s1 mul s2 mul c1 s3 mul sub} bind def
3581 /M13 {c1 c3 mul s2 mul s1 s3 mul add} bind def
3582 /M21 {c2 s3 mul} bind def
3583 /M22 {s1 s2 mul s3 mul c1 c3 mul add} bind def
3584 /M23 {s3 s2 mul c1 mul c3 s1 mul sub} bind def
3585 /M31 {s2 neg} bind def
3586 /M32 {s1 c2 mul} bind def
3587 /M33 {c1 c2 mul} bind def
3588 M11 Xpoint mul M12 Ypoint mul add M13 Zpoint mul add
3589 M21 Xpoint mul M22 Ypoint mul add M23 Zpoint mul add
3590 M31 Xpoint mul M32 Ypoint mul add M33 Zpoint mul add
3594 %%%%% ### symplan3d ###
3595 %% syntaxe : M eqplan/plantype symplan3d --> M'
3596 %% ou M' symetrique de M par rapport au plan P defini par eqplan/plantype
3600 plan2eq /args exch def
3612 /n_U a1 dup mul b1 dup mul add c1 dup mul add sqrt def
3617 /u a x mul b y mul add c z mul add d add def
3624 %%%%% ### vecteur3d ###
3625 %% creation du vecteur AB a partir de A et B
3626 /vecteur3d { %% xA yA zA xB yB zB
3640 %%%%% ### vectprod3d ###
3641 %% produit vectoriel de deux vecteurs 3d
3642 /vectprod3d { %% x1 y1 z1 x2 y2 z2
3650 y zp mul z yp mul sub
3651 z xp mul x zp mul sub
3652 x yp mul y xp mul sub
3656 %%%%% ### scalprod3d ###
3657 %% produit scalaire de deux vecteurs 3d
3658 /scalprod3d { %% x1 y1 z1 x2 y2 z2
3666 x xp mul y yp mul add z zp mul add
3670 %%%%% ### papply3d ###
3671 %% syntaxe : [A1 ... An] (f) papply3d --> [f(A1) ... f(An)]
3678 liste length 3 idiv {
3693 %%%%% ### defpoint3d ###
3694 %% creation du point A a partir de xA yA yB et du nom /A
3695 /defpoint3d { %% xA yA zA /nom
3698 [ 4 1 roll ] cvx memo exch
3702 %%%%% ### distance3d ###
3703 /distance3d { %% A B
3708 /getp3d { %% [tableau de points 3d] i --> donne le ieme point du tableau
3717 %%%%% ### norme3d ###
3718 %% norme d un vecteur 3d
3724 x dup mul y dup mul add z dup mul add sqrt
3728 %%%%% ### mulv3d ###
3729 %% (scalaire)*(vecteur 3d) Attention : dans l autre sens !
3730 /mulv3d { %% x y z lambda
3742 %%%%% ### addv3d ###
3743 %% addition de deux vecteurs 3d
3744 /addv3d { %% x1 y1 z1 x2 y2 z2
3758 %%%%% ### milieu3d ###
3759 /milieu3d { %% A B --> I le milieu de [AB]
3774 4 {8 -1 roll} repeat
3782 %%%%% ### ABpoint3d ###
3783 %% syntaxe : A B k ABpoint3d --> M
3784 %% M tel que vect(AM) = k vect (AB)
3796 %%%%% ### angle3doriente ###
3797 %% syntaxe : vect1 vect2 vect3 angle3d
3798 %% vect3 est la normale au plan (vect1, vect2)
3801 normalize3d /vect3 defpoint3d
3802 normalize3d /vect2 defpoint3d
3803 normalize3d /vect1 defpoint3d
3804 /cosalpha vect1 vect2 scalprod3d def
3805 /sinalpha vect1 vect2 vectprod3d vect3 scalprod3d def
3806 sinalpha cosalpha atan
3810 %%%%% ### points3dalignes ###
3811 %% syntaxe : A B C points3dalignes -> bool
3817 A B vecteur3d /u defpoint3d
3818 A C vecteur3d /v defpoint3d
3819 u v vectprod3d norme3d 1E-7 lt
3823 %% syntaxe : M A B point3dsursegment --> true si M in [AB], false sinon
3824 /point3dsursegment {
3829 M A B points3dalignes {
3843 %%%%% ### fin insertion ###
3845 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3846 %%%% geometrie 3d (dessins) %%%%
3847 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3849 %%%%% ### point3d ###
3854 /points3d { %% tableau de points3d
3858 %%%%% ### ligne3d ###
3859 %% [tableau de points3d] option --> trace la ligne brisee
3866 currentdict /option known
3873 %% [tableau de points3d] option --> trace la ligne brisee
3880 currentdict /option known
3887 %%%%% ### tab3dto2d ###
3888 %% transforme un tableau de points 3d en tableau de points 2d
3894 n 1 sub -1 n 3 idiv 2 mul
3902 %%%%% ### polygone3d ###
3903 /polygone3d { %% tableau de points3d
3907 /polygone3d* { %% tableau de points3d
3911 %%%%% ### fin insertion ###
3913 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3914 %%%% gestion du texte %%%%
3915 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3918 /xmkstep 1 def % les marques sur Ox
3919 /xmarkstyle {dctext} def
3920 /ymarkstyle {(-1 0) bltext} def
3926 /Courier findfont .8 fontsize mul scalefont setfont
3927 dup dup truncate eq {
3928 cvi dup chaine cvs exch
3936 /n xmax xmax xmin sub 1000 div sub xmkstep div truncate cvi
3937 xmkstep mul def % mark max
3938 /i xmin xmkstep div truncate cvi
3939 xmkstep mul def % la 1ere
3940 i xmin lt {/i i xmkstep add store} if
3943 /i i xmkstep abs add store
3949 /ymkstep 1 def % les marques sur Oy
3955 /Courier findfont .8 fontsize mul scalefont setfont
3961 /n ymax ymax ymin sub 1000 div sub ymkstep div truncate cvi
3962 ymkstep mul def % mark max
3963 /i ymin ymkstep div truncate cvi
3964 ymkstep mul def % la 1ere
3967 /i i ymkstep abs add store
3982 %%%%% ### setfontsize ###
3987 %%%%% ### setCourrier ###
3989 dup length dict begin
3996 /Encoding ISOLatin1Encoding def
4000 /Courier-ISOLatin1 exch definefont pop
4003 /Courier-ISOLatin1 findfont
4008 %%%%% ### pathtext ###
4009 %% syntaxe : string x y initp@thtext
4029 %% syntaxe : string x y cctext_
4032 llx wx add lly wy add -.5 mulv rmoveto
4052 hadjust neg 0 rmoveto
4060 wx llx add -.5 mul 0 rmoveto
4073 hadjust vadjust rmoveto
4074 llx neg lly neg rmoveto
4080 hadjust neg vadjust rmoveto
4081 wx neg lly neg rmoveto
4088 llx wx add -.5 mul lly neg rmoveto
4094 hadjust vadjust neg rmoveto
4095 llx neg wy neg rmoveto
4101 0 vadjust neg rmoveto
4108 hadjust neg vadjust neg rmoveto
4109 wx neg wy neg rmoveto
4115 0 vadjust neg rmoveto
4116 llx wx add -2 div wy neg rmoveto
4123 llx neg lly wy add -2 div rmoveto
4130 0 lly wy add -2 div rmoveto
4136 hadjust neg 0 rmoveto
4137 wx neg lly wy add -2 div rmoveto
4144 llx wx add lly wy add -.5 mulv rmoveto
4148 %%%%% ### text3d ###
4149 %%%% Version 3d des commandes jps TEXTE
4152 % /vect_echelle [1 1] def
4153 % /angle_de_rot {0} def
4155 % {/angle_de_rot exch def}
4158 % {/vect_echelle exch def}
4159 % if% CamView vect_echelle {angle_de_rot}
4355 %%%%% ### fin insertion ###
4357 %% La macro provisoire de developpement (27/01/2009)
4358 %% syntaxe : solid table tablez --> -
4366 %% a-t-on des couleurs nommees ?
4367 usertable 0 get isstring {
4368 %% oui, et autant que d etages
4369 usertable length 1 sub tablez length eq {
4370 /table usertable def
4372 %% oui, mais moins que d etages
4373 %% ==> on definit les 2 premieres en RGB
4374 /a0 usertable 0 get def
4375 /a1 usertable 1 get def
4378 [a0 cvx exec] length 0 eq {
4379 a0 cvx exec currentrgbcolor
4387 [a1 cvx exec] length 0 eq {
4388 a1 cvx exec currentrgbcolor
4394 /usertable [lacouleurdepart lacouleurarrivee] def
4397 usertable 0 get isnum {
4398 %% c est un degrade : nb de couleurs a definir
4399 /n tablez length 1 add def
4401 usertable length 4 eq {
4402 /a0 usertable 0 get def
4403 /a1 usertable 1 get def
4404 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4405 /B usertable 2 get def
4406 /C usertable 3 get def
4408 /espacedecouleurs (sethsbcolor) def
4411 usertable length 6 eq {
4412 /a0 usertable 0 get def
4413 /b0 usertable 1 get def
4414 /c0 usertable 2 get def
4415 /a1 usertable 3 get def
4416 /b1 usertable 4 get def
4417 /c1 usertable 5 get def
4418 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4419 /B {b0 i b1 b0 sub mul n 1 sub div add} def
4420 /C {c0 i c1 c0 sub mul n 1 sub div add} def
4422 /espacedecouleurs (setrgbcolor) def
4425 usertable length 7 eq {
4426 /a0 usertable 0 get def
4427 /b0 usertable 1 get def
4428 /c0 usertable 2 get def
4429 /a1 usertable 3 get def
4430 /b1 usertable 4 get def
4431 /c1 usertable 5 get def
4432 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4433 /B {b0 i b1 b0 sub mul n 1 sub div add} def
4434 /C {c0 i c1 c0 sub mul n 1 sub div add} def
4436 /espacedecouleurs (sethsbcolor) def
4439 usertable length 8 eq {
4440 /a0 usertable 0 get def
4441 /b0 usertable 1 get def
4442 /c0 usertable 2 get def
4443 /d0 usertable 3 get def
4444 /a1 usertable 4 get def
4445 /b1 usertable 5 get def
4446 /c1 usertable 6 get def
4447 /d1 usertable 7 get def
4448 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4449 /B {b0 i b1 b0 sub mul n 1 sub div add} def
4450 /C {c0 i c1 c0 sub mul n 1 sub div add} def
4451 /D {d0 i d1 d0 sub mul n 1 sub div add} def
4452 /espacedecouleurs (setcmykcolor) def
4455 usertable length 2 eq {
4456 /a0 usertable 0 get def
4457 /a1 usertable 1 get def
4460 /A {a0 i a1 a0 sub mul n 1 sub div add} def
4464 /espacedecouleurs (sethsbcolor) def
4468 %% on affecte la table des couleurs
4472 [A B C D] espacedecouleurs astr2str
4477 /n solid solidnombrefaces def
4480 solid i solidcentreface /z exch def pop pop
4482 0 1 tablez length 1 sub {
4484 /ztest tablez j get def
4489 /resultat j 1 add store
4492 solid i table resultat get solidputfcolor
4498 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4499 %%%% bibliotheque sur les solides %%%%
4500 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4502 %%%%% ### solide ###
4503 %% solid = [Sommets Faces Colors_Faces InOut_Table]
4507 /solidgetpointstable {solidgetsommets} def
4524 %% syntaxe : solid i solidgetfcolor --> str
4528 solidgetfcolors i get
4532 %% syntaxe : solid i str solidputfcolor --> -
4537 solidgetfcolors i str put
4541 /solidgetinouttable {
4548 /solidputpointstable {solidputsommets} def
4554 %% syntaxe : solid solidfacesreverse -> -
4555 /solidfacesreverse {
4558 /n solid solidnombrefaces def
4561 /F solid i solidgetface reverse def
4563 solid i [F aload pop m 0 roll ] solidputface
4572 /solidputinouttable {
4576 %% syntaxe : any issolid --> booleen, vrai si any est de type solid
4581 candidat length 4 eq {
4582 candidat 0 get isarray
4583 candidat 1 get isarray and
4584 candidat 2 get isarray and
4585 candidat 3 get isarray and {
4586 /IO candidat 3 get def
4607 /S solid solidgetsommets def
4608 /F solid solidgetfaces def
4609 /FC solid solidgetfcolors def
4610 /IO solid solidgetinouttable def
4615 FC duparray exch pop
4616 IO duparray exch pop
4621 %% syntaxe : solid array solidputinfaces --> -
4624 /facesinternes exch def
4626 /n2 facesinternes length def
4627 /IO solid solidgetinouttable def
4628 /facesexternes solid solidgetoutfaces def
4629 /n1 facesexternes length def
4631 [facesexternes aload pop facesinternes aload pop]
4636 IO 3 n1 n2 add 1 sub put
4640 %% syntaxe : solid array solidputoutfaces --> -
4643 /facesexternes exch def
4645 /n1 facesexternes length def
4646 /IO solid solidgetinouttable def
4647 /facesinternes solid solidgetinfaces def
4648 /n2 facesinternes length def
4650 [facesexternes aload pop facesinternes aload pop]
4655 IO 3 n1 n2 add 1 sub put
4659 /solidnombreinfaces {
4662 solid solidwithinfaces {
4663 /IO solid solidgetinouttable def
4664 IO 3 get IO 2 get sub 1 add
4671 /solidnombreoutfaces {
4674 /IO solid solidgetinouttable def
4675 IO 1 get IO 0 get sub 1 add
4679 %% syntaxe : solid solidgetinfaces --> array
4684 (Error : mauvais type d argument dans solidgetinfaces) ==
4687 solid solidwithinfaces {
4688 /IO solid solidgetinouttable def
4689 /F solid solidgetfaces def
4692 /n n2 n1 sub 1 add def
4700 %% syntaxe : solid solidgetoutfaces --> array
4705 (Error : mauvais type d argument dans solidgetoutfaces) ==
4708 /IO solid solidgetinouttable def
4709 /F solid solidgetfaces def
4712 /n n2 n1 sub 1 add def
4717 %% /tracelignedeniveau? false def
4718 %% /hauteurlignedeniveau 1 def
4719 %% /couleurlignedeniveau {rouge} def
4720 %% /linewidthlignedeniveau 4 def
4726 /solidgrid false def
4729 %% syntaxe : solid i string solidputfcolor
4730 %% syntaxe : solid str outputcolors
4731 %% syntaxe : solid str1 str2 inoutputcolors
4732 %% syntaxe : solid string n solidputncolors
4733 %% syntaxe : solid array solidputincolors --> -
4734 %% syntaxe : solid array solidputoutcolors --> -
4735 %% syntaxe : solid solidgetincolors --> array
4736 %% syntaxe : solid solidgetoutcolors --> array
4738 %% syntaxe : solid array solidputinfaces --> -
4739 %% syntaxe : solid array solidputoutfaces --> -
4740 %% syntaxe : solid solidgetinfaces --> array
4741 %% syntaxe : solid solidgetoutfaces --> array
4743 %% syntaxe : solid1 solid2 solidfuz -> solid
4745 %% syntaxe : solid i solidgetsommetsface -> array
4746 %% array = tableau de points 3d
4747 /solidgetsommetsface {
4751 /F solid i solidgetface def
4753 0 1 F length 1 sub {
4755 solid F k get solidgetsommet
4761 %% syntaxe : solid index table solidputface -> -
4766 solidgetfaces i table put
4770 %% syntaxe : solid table solidaddface -> -
4771 %% syntaxe : solid table (couleur) solidaddface -> -
4772 %% on ne se preoccupe pas des faces internes
4782 /IO solid solidgetinouttable def
4784 /FC solid solidgetoutcolors def
4786 solid [ solid solidgetfaces aload pop table ] solidputfaces
4787 solid IO solidputinouttable
4788 % solid solidnombrefaces
4790 FC aload pop lac@uleur
4798 solid solidnombreinfaces
4799 solid solidnombreoutfaces
4804 %% syntaxe : solid M solidaddsommetexterne -> -
4805 %% on ajoute le sommet sans se preoccuper de rien
4806 /solidaddsommetexterne {
4811 [ solid solidgetsommets aload pop M ]
4816 %% syntaxe : solid array solidaddsommets -> -
4821 /n table length 3 idiv def
4824 solid table i getp3d solidaddsommet pop
4829 %% syntaxe : solid M solidaddsommet -> k
4830 %% on ajoute le sommet M. Si il est deja sur une arete,
4831 %% on l incorpore a la face concernee
4832 %% s il est deja present, on ne le rajoute pas.
4833 %% Renvoie l indice du sommet rajoute.
4838 /nbf solid solidnombrefaces def
4839 /N solid solidnombresommets def
4841 %% le sommet est-il deja dans la structure
4845 %% solid i solidgetsommet == == ==
4847 %% solid i solidgetsommet M eqp3d ==
4849 % solid i solidgetsommet M eqp3d {
4850 solid i solidgetsommet M distance3d 1e-5 le {
4851 %% oui => c est fini
4856 %% non => on le rajoute
4858 solid M solidaddsommetexterne
4859 %% est il sur une arete deja codee
4863 solid i solidgetface /F exch def
4868 solid j i solidgetsommetface
4869 solid j 1 add nbsf mod i solidgetsommetface
4871 %% il est sur l arete concernee
4878 j 1 add nbsf mod dup 0 eq {
4896 %%%%% ### solidrmsommet ###
4897 %% syntaxe : solid i solidrmsommet -> -
4903 (Erreur : mauvais type d argument dans solidrmsommet) ==
4906 solid i solidsommetsadjsommet length 0 gt {
4907 (Erreur : sommet non isole dans solidrmsommet) ==
4911 %% on s occupe des sommets
4912 /n solid solidnombresommets def
4917 solid j solidgetsommet
4921 solid S solidputsommets
4922 %% on s occupe des faces
4923 /n solid solidnombrefaces def
4928 /Fj solid j solidgetface def
4929 [0 1 Fj length 1 sub {
4930 %% sommet d indice k de la face Fj
4938 solid F solidputfaces
4942 %%%%% ### solidsommetsadjsommet ###
4943 %% syntaxe : solid i solidsommetsadjsommet --> array
4944 %% array est le tableau des indices des sommets adjacents au
4945 %% sommet d indice i
4946 /solidsommetsadjsommet {
4950 solid no solidfacesadjsommet /facesadj exch def
4952 /nbadj facesadj length def
4955 %% examen de la jieme face
4957 /F solid facesadj j get solidgetface def
4958 /nbsommetsface F length def
4961 /i1 F index 1 sub nbsommetsface modulo get def
4962 /i2 F index 1 add nbsommetsface mod get def
4963 %% si i1 n est pas deja note, on le rajoute
4967 /sommetsadj [ sommetsadj aload pop i1 ] store
4969 %% si i2 n est pas deja note, on le rajoute
4973 /sommetsadj [ sommetsadj aload pop i2 ] store
4976 (Error : bug dans solidsommetsadjsommet) ==
4984 %%%%% ### solidfacesadjsommet ###
4985 %% syntaxe : solid i solidfacesadjsommet --> array
4986 %% array est le tableau des indices des faces adjacentes au
4987 %% sommet d indice i
4988 /solidfacesadjsommet {
4992 /n solid solidnombrefaces def
4993 /indicesfacesadj [] def
4996 /F solid j solidgetface def
4999 /indicesfacesadj [ indicesfacesadj aload pop j ] store
5006 %%%%% ### ordonnepoints3d ###
5007 %% syntaxe : array1 M ordonnepoints3d --> array2
5008 %% array1 = tableau de points 3d coplanaires (plan P)
5009 %% M = point3d indiquant la direction de la normale a P
5010 %% array2 = les indices des points de depart, ranges dans le
5011 %% sens trigo par rapport a la normale
5016 table isobarycentre3d /G defpoint3d
5017 %% calcul de la normale
5018 table 0 getp3d /ptref defpoint3d
5019 table 1 getp3d /A defpoint3d
5022 vectprod3d /vecteurnormal defpoint3d
5023 vecteurnormal G M vecteur3d scalprod3d 0 lt {
5024 vecteurnormal -1 mulv3d /vecteurnormal defpoint3d
5026 %% la table des angles
5027 table duparray exch pop
5032 vecteurnormal angle3doriente
5034 % [0 1 table length 3 idiv 1 sub {} for]
5036 doublebubblesort pop
5040 %%%%% ### fin insertion ###
5042 %% /tracelignedeniveau? false def
5043 %% /hauteurlignedeniveau 1 def
5044 %% /couleurlignedeniveau {rouge} def
5045 %% /linewidthlignedeniveau 4 def
5047 %% /solidgrid true def
5048 %% /aretescachees true def
5049 %% /defaultsolidmode 2 def
5051 %% syntaxe : alpha beta r h newpie --> solid
5054 [[/resolution /nbetages] [8 1] [10 1] [12 1] [18 3] [36 5]] gestionsolidmode
5061 % alpha cos r mul alpha sin r mul
5062 alpha beta {1 dict begin /t exch def t cos r mul t sin r mul end} CourbeR2+
5063 ] 0 h [nbetages] newprismedroit
5067 %%%%% ### newsolid ###
5068 %% syntaxe : newsolid --> depose le solide nul sur la pile
5073 %%%%% ### generesolid ###
5078 [S F [F length {()} repeat] [0 F length 1 sub -1 -1]]
5082 %%%%% ### nullsolid ###
5083 %% syntaxe : solide nullsolid -> booleen, vrai si le solide est nul
5087 candidat issolid not {
5088 (Error type argument dans "nullsolid") ==
5091 candidat solidgetsommets length 0 eq {
5099 %%%%% ### solidnombreoutfaces ###
5100 /solidnombreoutfaces {
5104 (Error : mauvais type d argument dans solidnombreoutfaces) ==
5110 /IO solid solidgetinouttable def
5118 %%%%% ### solidnombreinfaces ###
5119 /solidnombreinfaces {
5123 (Error : mauvais type d argument dans solidnombreinfaces) ==
5126 solid solidwithinfaces {
5127 /IO solid solidgetinouttable def
5137 %%%%% ### solidtests ###
5138 %% syntaxe : solid solidwithinfaces --> bool, true si le solide est vide
5143 (Error : mauvais type d argument dans solidwithinfaces) ==
5146 /table solid solidgetinouttable def
5155 %%%%% ### solidgetsommet ###
5156 %% syntaxe : solid i j solidgetsommetface --> sommet i de la face j
5157 /solidgetsommetface {
5163 (Error : mauvais type d argument dans solidgetsommetface) ==
5166 /table_faces solid solidgetfaces def
5167 /table_sommets solid solidgetsommets def
5168 /k table_faces j get i get def
5169 table_sommets k getp3d
5173 %% syntaxe : solid i solidgetsommetsface --> array, tableau des
5174 %% sommets de la face i du solide
5175 /solidgetsommetsface {
5180 (Error : mauvais type d argument dans solidgetsommetsface) ==
5183 /table_faces solid solidgetfaces def
5184 /table_sommets solid solidgetsommets def
5185 /table_indices table_faces i get def
5187 0 1 table_indices length 1 sub {
5189 table_sommets table_indices j get getp3d
5195 %% syntaxe : solid i solidgetsommet --> sommet i du solide
5201 (Error : mauvais type d argument dans solidgetsommet) ==
5204 /table_sommets solid solidgetsommets def
5205 table_sommets i getp3d
5209 %%%%% ### solidcentreface ###
5210 %% syntaxe : solid i solidcentreface --> M
5212 solidgetsommetsface isobarycentre3d
5215 %%%%% ### solidnombre ###
5216 /solidnombresommets {
5217 solidgetsommets length 3 idiv
5220 /solidfacenombresommets {
5225 solidgetfaces length
5228 %%%%% ### solidshowsommets ###
5236 /n sol solidnombresommets def
5237 /m sol solidnombrefaces def
5238 currentdict /option known not {
5239 /option [0 1 n 1 sub {} for] def
5241 0 1 option length 1 sub {
5243 option k get /i exch def %% indice du sommet examine
5244 sol i solidgetsommet point3d
5249 %%%%% ### solidnumsommets ###
5253 % Font findfont 10 scalefont setfont
5259 /n sol solidnombresommets def
5260 /m sol solidnombrefaces def
5261 currentdict /option known not {
5262 /option [0 1 n 1 sub {} for] def
5267 0 1 option length 1 sub {
5269 option k get /i exch def %% indice du sommet examine
5271 /j exch def %% indice de la face examinee
5272 i sol j solidgetface in {
5273 %% le sommet i est dans la face j
5278 sol i solidgetsommet /S defpoint3d
5281 %% le sommet i est dans la face j
5282 sol j solidcentreface /G defpoint3d
5283 G S vecteur3d normalize3d
5284 solidnumsep dup ptojpoint pop
5295 %%%%% ### gestionsolidmode ###
5296 %% table = [ [vars] [mode0] [mode1] [mode2] [mode3] [mode4] ]
5304 /tableaffectation exch def
5307 /mode defaultsolidmode def
5310 /vars table 0 get def
5311 /nbvars vars length def
5313 /tableaffectation table mode 1 add 5 min get def
5318 tableaffectation i get
5325 %%%%% ### solidfuz ###
5326 %% syntaxe : solid1 solid2 solidfuz -> solid
5331 /S1 solid1 solidgetsommets def
5332 /S2 solid2 solidgetsommets def
5333 /n S1 length 3 idiv def
5338 %% les faces internes et leurs couleurs
5339 /FI1 solid1 solidgetinfaces def
5340 /FIC1 solid1 solidgetincolors def
5341 solid2 solidnombreinfaces 0 eq {
5345 /FI2 solid2 solidgetinfaces {{n add} apply} apply def
5346 /FIC2 solid2 solidgetincolors def
5348 /FI [FI1 aload pop FI2 aload pop] def
5349 /FIC [FIC1 aload pop FIC2 aload pop] def
5351 %% les faces externes et leurs couleurs
5352 /FO1 solid1 solidgetoutfaces def
5353 /FOC1 solid1 solidgetoutcolors def
5354 /FO2 solid2 solidgetoutfaces {{n add} apply} apply def
5355 /FOC2 solid2 solidgetoutcolors def
5356 /FO [FO1 aload pop FO2 aload pop] def
5357 /FOC [FOC1 aload pop FOC2 aload pop] def
5359 /F [FO aload pop FI aload pop] def
5360 /FC [FOC aload pop FIC aload pop] def
5364 dup 1 add dup FI length add 1 sub
5371 dup FC solidputfcolors
5372 dup IO solidputinouttable
5376 %%%%% ### solidnormaleface ###
5377 %% syntaxe : solid i solidnormaleface --> u, vecteur normale a la
5378 %% face d indice i du solide
5384 (Error : mauvais type d argument dans solidgetsommetface) ==
5387 %% solid 0 i solidgetsommetface /G defpoint3d
5389 %% solid 1 i solidgetsommetface
5392 %% solid 2 i solidgetsommetface
5395 /n solid i solidfacenombresommets def
5398 solid 0 i solidgetsommetface
5399 solid 1 i solidgetsommetface
5400 solid 2 i solidgetsommetface
5401 ] isobarycentre3d /G defpoint3d
5403 solid i solidcentreface /G defpoint3d
5405 %% debug %% G 3dto2d point
5407 solid 0 i solidgetsommetface
5409 % gsave bleu A point3d grestore
5411 vecteur3d normalize3d
5413 solid 1 i solidgetsommetface
5415 % gsave orange A point3d grestore
5417 vecteur3d normalize3d
5419 /resultat defpoint3d
5420 resultat normalize3d
5424 %%%%% ### solidtransform ###
5425 %% syntaxe : solid1 {f} solidtransform --> solid2, solid2 est le
5426 %% transforme de solid1 par la transformation f : R^3 -> R^3
5432 (Error : mauvais type d argument dans solidtransform) ==
5436 solid solidgetsommets {@f} papply3d
5438 solid les_sommets solidputsommets
5443 %%%%% ### solidputcolor ###
5444 %% syntaxe : solid i string solidputfcolor
5450 /FC solid solidgetfcolors def
5457 %% syntaxe : solid solidgetincolors --> array
5462 (Error : mauvais type d argument dans solidgetincolors) ==
5465 solid solidwithinfaces {
5466 /fcol solid solidgetfcolors def
5467 /IO solid solidgetinouttable def
5470 /n n2 n1 sub 1 add def
5471 fcol n1 n getinterval
5478 %% syntaxe : solid solidgetoutcolors --> array
5479 /solidgetoutcolors {
5483 (Error : mauvais type d argument dans solidgetoutcolors) ==
5486 /fcol solid solidgetfcolors def
5487 /IO solid solidgetinouttable def
5490 /n n2 n1 sub 1 add def
5491 fcol n1 n getinterval
5495 %% syntaxe : solid array solidputincolors --> -
5498 /newcolorstable exch def
5501 (Error : mauvais type d argument dans solidputincolors) ==
5504 /n newcolorstable length def
5505 n solid solidnombreinfaces ne {
5506 (Error : mauvaise longueur de tableau dans solidputincolors) ==
5510 /FC solid solidgetfcolors def
5511 /IO solid solidgetinouttable def
5513 FC n1 newcolorstable putinterval
5518 %% syntaxe : solid array solidputoutcolors --> -
5519 /solidputoutcolors {
5521 /newcolorstable exch def
5524 (Error : mauvais type d argument dans solidputoutcolors) ==
5527 /n newcolorstable length def
5528 n solid solidnombreoutfaces ne {
5529 (Error : mauvaise longueur de tableau dans solidputoutcolors) ==
5533 /FC solid solidgetfcolors def
5534 /IO solid solidgetinouttable def
5536 FC n1 newcolorstable putinterval
5541 %% syntaxe : solid str outputcolors
5547 (Error : mauvais type d argument dans inoutputcolors) ==
5550 /n solid solidnombreoutfaces def
5551 solid [ n {color} repeat ] solidputoutcolors
5555 %% syntaxe : solid str inputcolors
5561 (Error : mauvais type d argument dans inoutputcolors) ==
5564 /n solid solidnombreinfaces def
5565 solid [ n {color} repeat ] solidputincolors
5569 %% syntaxe : solid str1 str2 inoutputcolors
5575 solid colin inputcolors
5576 solid colout outputcolors
5580 %% syntaxe : solid array solidputoutcolors --> -
5581 /solidputoutcolors {
5583 /newcolorstable exch def
5586 (Error : mauvais type d argument dans solidputoutcolors) ==
5589 /n newcolorstable length def
5590 n solid solidnombreoutfaces ne {
5591 (Error : mauvaise longueur de tableau dans solidputoutcolors) ==
5595 /FC solid solidgetfcolors def
5596 /IO solid solidgetinouttable def
5598 FC length n n1 add lt {
5599 solid newcolorstable solidputfcolors
5601 FC n1 newcolorstable putinterval
5618 %%%%% ### solidputhuecolors ###
5619 %% syntaxe : solid table solidputhuecolors --> -
5620 /solidputhuecolors {
5623 solidgetinouttable /IO exch def
5630 /solidputinhuecolors {
5634 solid solidgetinouttable /IO exch def
5635 solid solidwithinfaces {
5644 /solidputinouthuecolors {
5647 solidgetinouttable /IO exch def
5649 IO 3 get IO 1 get max
5654 %% syntaxe : solid table n1 n2 s@lidputhuec@l@rs --> -
5655 %% affecte les couleurs des faces d indice n1 a n2 du solid solid, par
5656 %% un degrade defini par la table.
5657 /s@lidputhuec@l@rs {
5671 [a0 cvx exec] length 0 eq {
5672 a0 cvx exec currentrgbcolor
5680 [a1 cvx exec] length 0 eq {
5681 a1 cvx exec currentrgbcolor
5687 /table [lacouleurdepart lacouleurarrivee] def
5689 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5693 /espacedecouleurs (sethsbcolor) def
5700 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5704 /espacedecouleurs (sethsbcolor) def
5714 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5715 /B {b0 i b1 b0 sub mul n 1 sub div add} def
5716 /C {c0 i c1 c0 sub mul n 1 sub div add} def
5718 /espacedecouleurs (setrgbcolor) def
5728 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5729 /B {b0 i b1 b0 sub mul n 1 sub div add} def
5730 /C {c0 i c1 c0 sub mul n 1 sub div add} def
5732 /espacedecouleurs (sethsbcolor) def
5744 /A {a0 i a1 a0 sub mul n 1 sub div add} def
5745 /B {b0 i b1 b0 sub mul n 1 sub div add} def
5746 /C {c0 i c1 c0 sub mul n 1 sub div add} def
5747 /D {d0 i d1 d0 sub mul n 1 sub div add} def
5748 /espacedecouleurs (setcmykcolor) def
5754 [A B C D] espacedecouleurs astr2str
5761 %%%%% ### solidrmface ###
5762 %% syntaxe : solid i solidrmface -> -
5768 (Error : mauvais type d argument dans solidrmface) ==
5771 %% on enleve la face
5772 /F solid solidgetfaces def
5773 F length 1 sub i lt {
5774 (Error : indice trop grand dans solidrmface) ==
5778 0 1 F length 1 sub {
5786 solid NF solidputfaces
5787 %% on enleve la couleur correspondante
5788 /FC solid solidgetfcolors def
5790 0 1 FC length 1 sub {
5798 solid NFC solidputfcolors
5799 %% on ajuste la table inout
5800 /IO solid solidgetinouttable def
5801 solid i solidisoutface {
5802 IO 1 IO 1 get 1 sub put
5803 solid solidwithinfaces {
5804 IO 2 IO 2 get 1 sub put
5805 IO 3 IO 3 get 1 sub put
5808 solid i solidisinface {
5809 IO 1 IO 1 get 1 sub put
5810 IO 2 IO 2 get 1 sub put
5811 IO 3 IO 3 get 1 sub put
5813 solid IO solidputinouttable
5817 %% syntaxe : solid table solidrmfaces --> -
5820 /table exch bubblesort reverse def
5822 table {solid exch solidrmface} apply
5826 %%%%% ### videsolid ###
5827 %% syntaxe : solid videsolid -> -
5832 (Error : mauvais type d argument dans videsolid) ==
5835 solid solidwithinfaces not {
5836 /IO solid solidgetinouttable def
5837 /FE solid solidgetfaces def
5840 IO 3 2 n mul 1 sub put
5841 solid IO solidputinouttable
5842 %% on inverse chaque face
5843 /FI FE {reverse} apply def
5844 solid FE FI append solidputfaces
5845 %% et on rajoute autant de couleurs vides que de faces
5846 /FEC solid solidgetfcolors def
5847 % /FIC [FI length {()} repeat] def
5848 % solid FEC FIC append solidputfcolors
5849 solid FEC duparray append solidputfcolors
5854 %%%%% ### solidnumfaces ###
5855 %% syntaxe : solid array solidnumfaces
5856 %% syntaxe : solid array bool solidnumfaces
5857 %% array, le tableau des indices des faces a numeroter, est optionnel
5858 %% si bool=true, on ne numerote que les faces visibles
5872 /n sol solidnombrefaces def
5873 currentdict /option known not {
5874 /option [0 1 n 1 sub {} for] def
5877 0 1 option length 1 sub {
5880 j ( ) cvs sol j bool cctextp3d
5885 %%%%% ### creusesolid ###
5886 %% syntaxe : solid creusesolid -> -
5891 (Error : mauvais type d argument dans creusesolid) ==
5894 %% on enleve le fond et le chapeau
5897 %% on inverse chaque face
5902 %%%%% ### fin insertion ###
5904 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5905 %%%% dessin des solides %%%%
5906 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5908 %%%%% ### solidisinface ###
5909 %% syntaxe : solid i solidisinface --> bool
5910 %% true si i est l indice d une face interne, false sinon
5914 solidgetinouttable /IO exch def
5922 %%%%% ### solidisoutface ###
5923 %% syntaxe : solid i solidisoutface --> bool
5924 %% true si i est l indice d une face externe, false sinon
5928 solidgetinouttable /IO exch def
5936 %%%%% ### planvisible ###
5937 %% syntaxe : A k planvisible? --> true si le plan est visible
5940 /normale_plan defpoint3d
5947 ligne_de_vue normale_plan scalprod3d 0 gt
5951 %%%%% ### solidlight ###
5952 /setlightintensity {
5953 /lightintensity exch def
5957 /lightsrc defpoint3d
5964 [ currentrgbcolor ] /lightcolor exch
5970 %%%%% ### drawsolid ###
5972 /s@lidlight true def
5975 /s@lidlight false def
5979 %% syntaxe : solid i solidfacevisible? --> true si la face est visible
5980 /solidfacevisible? {
5985 (Error : mauvais type d argument dans solidgetsommetface) ==
5988 solid i solidgetface length 2 le {
5992 solid i solidcentreface
5998 solid i solidnormaleface
6000 ligne_de_vue normale_face scalprod3d 0 gt
6005 %% syntaxe : solid i affectecouleursolid_facei --> si la couleur de
6006 %% la face i est definie, affecte fillstyle a cette couleur
6007 /affectecouleursolid_facei {
6011 solid solidgetfcolors /FC exch def
6012 FC length 1 sub i ge {
6013 FC i get length 1 ge {
6014 /fillstyle FC i get ( Fill) append cvx
6029 %% syntaxe : solid i dessinefacecachee
6030 /dessinefacecachee {
6035 (Error : mauvais type d argument dans dessinefacecachee) ==
6039 /F solid solidgetfaces def
6040 /S solid solidgetsommets def
6042 %% face cachee => on prend chacune des aretes de la face et on
6045 /n F i get length def %% nb de sommets de la face
6048 /k1 F i k get_ij def %% indice sommet1
6049 /k2 F i k 1 add n mod get_ij def %% indice sommet2
6051 currentlinewidth .5 mul setlinewidth
6054 S k2 getp3d sortp3d] ligne3d
6058 %% trace de la ligne de niveau
6059 solidintersectiontype 0 ge {
6060 /face_a_dessiner [ %% face visible : F [i]
6063 solid j i solidgetsommetface
6066 0 1 solidintersectionplan length 1 sub {
6068 /lignedeniveau [] def
6070 solidintersectiontype 0 eq {
6075 k solidintersectionlinewidth length lt {
6076 solidintersectionlinewidth k get setlinewidth
6078 solidintersectionlinewidth 0 get setlinewidth
6080 k solidintersectioncolor length lt {
6081 solidintersectioncolor k get cvx exec
6083 solidintersectioncolor 0 get cvx exec
6087 face_a_dessiner j getp3d
6088 face_a_dessiner j 1 add n mod getp3d
6089 solidintersectionplan k get
6098 /lignedeniveau table store
6102 lignedeniveau aload pop
6110 %% dessin de la ligne
6111 lignedeniveau length 4 ge {
6112 [lignedeniveau aload pop sortp3d] ligne3d
6122 %% syntaxe : solid i dessinefacevisible
6123 /dessinefacevisible {
6128 (Error : mauvais type d argument dans dessinefacevisible) ==
6131 /F solid solidgetfaces def
6132 /S solid solidgetsommets def
6134 /n F i get length def %% nb de sommets de la face
6140 solid i solidnormaleface normalize3d
6141 solid i solidcentreface lightsrc vecteur3d normalize3d
6147 /lacouleur lightcolor def
6151 solid solidgetfcolors i get cvx exec currentrgbcolor
6156 lacouleur {coeff mul} apply setcolor Fill
6159 lacouleur {coeff mul} apply setcolor
6165 solid i affectecouleursolid_facei
6168 solid i affectecouleursolid_facei
6173 /face_a_dessiner [ %% face visible : F [i]
6176 solid j i solidgetsommetface
6179 face_a_dessiner polygone3d
6181 %% trace de la ligne de niveau
6182 solidintersectiontype 0 ge {
6183 0 1 solidintersectionplan length 1 sub {
6185 /lignedeniveau [] def
6187 k solidintersectionlinewidth length lt {
6188 solidintersectionlinewidth k get setlinewidth
6190 solidintersectionlinewidth 0 get setlinewidth
6192 k solidintersectioncolor length lt {
6193 solidintersectioncolor k get cvx exec
6195 solidintersectioncolor 0 get cvx exec
6199 face_a_dessiner j getp3d
6200 face_a_dessiner j 1 add n mod getp3d
6201 solidintersectionplan k get
6210 lignedeniveau aload pop
6220 %% dessin de la ligne
6221 lignedeniveau length 4 ge {
6222 solid i solidisinface solidintersectiontype 0 eq and {
6225 lignedeniveau ligne3d
6236 /startest {true} def
6241 /peintrealgorithme false def
6245 /aretescachees false def
6246 /peintrealgorithme true def
6251 %% syntaxe : solid array drawsolid
6252 %% array est en option, il indique les faces triees
6260 (Error : mauvais type d argument dans drawsolid) ==
6263 solid nullsolid not {
6266 solid solidgetsommets
6268 /n S length 3 idiv def
6270 currentdict /ordre known not {
6272 %% tri des indices des faces par distance decroissante
6274 0 1 F length 1 sub {
6276 solid i solidcentreface
6280 ] doublequicksort pop reverse
6283 0 1 F length 1 sub {
6290 0 1 F length 1 sub {
6294 solid i solidfacevisible? {
6295 solid i dessinefacevisible
6300 0 1 F length 1 sub {
6304 solid i solidfacevisible? not {
6305 solid i dessinefacecachee
6311 %% %% si on veut repasser les traits des faces visibles
6312 %% 0 1 F length 1 sub {
6314 %% /i ordre k get def
6317 %% /startest false def
6318 %% solid i solidfacevisible? {
6319 %% solid i dessinefacevisible
6328 %%%%% ### segment_inter_planz ###
6329 %% syntaxe : A B k segment_inter_planz --> array true ou false
6330 /segment_inter_planz {
6335 A /zA exch def pop pop
6336 B /zB exch def pop pop
6337 zA k sub zB k sub mul dup 0 gt {
6338 %% pas d intersection
6343 %% intersection en A ou en B
6349 %% intersection entre A et B
6352 k zA sub zB zA sub div mulv3d
6360 %%%%% ### fin insertion ###
6362 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
6363 %%%% plans affines %%%%
6364 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
6366 %%%%% ### planaffine ###
6367 %% plan : origine, base, range, ngrid
6368 %% [0 0 0 [1 0 0 0 1 0] [-3 3 -2 2] [1. 1.] ]
6370 /explan [0 0 0 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1. 1.] ] def
6372 %% syntaxe : any isplan --> bool
6377 candidat length 6 eq {
6378 candidat 3 get isarray {
6379 candidat 4 get isarray {
6380 candidat 5 get isarray
6397 [0 0 0 [1 0 0 0 1 0] [-3 3 -2 2] [1 1]]
6403 /result newplanaffine def
6404 result leplan plangetorigine planputorigine
6405 result leplan plangetbase planputbase
6406 result leplan plangetrange planputrange
6407 result leplan plangetngrid planputngrid
6412 %% syntaxe : plantype getorigine --> x y z
6417 (Erreur : mauvais type d argument dans plangetorigine) ==
6426 %% syntaxe : plantype getbase --> [u v]
6427 %% ou u, v et w vecteurs de R^3
6432 (Erreur : mauvais type d argument dans plangetbase) ==
6439 %% syntaxe : plantype getrange --> array
6440 %% ou array = [xmin xmax ymin ymax]
6445 (Erreur : mauvais type d argument dans plangetrange) ==
6452 %% syntaxe : plantype getngrid --> array
6453 %% ou array = [n1 n2]
6458 (Erreur : mauvais type d argument dans plangetngrid) ==
6465 %% ===================
6467 %% syntaxe : plantype x y z putorigine --> -
6475 (Erreur : mauvais type d argument dans planputorigine) ==
6484 %% syntaxe : plantype [u v w] putbase --> -
6485 %% ou u, v et w vecteurs de R^3
6491 (Erreur : mauvais type d argument dans planputbase) ==
6498 %% syntaxe : plantype array putrange --> -
6499 %% ou array = [xmin xmax ymin ymax]
6505 (Erreur : mauvais type d argument dans planputrange) ==
6512 %% syntaxe : plantype array putngrid --> -
6513 %% ou array = [n1 n2]
6519 (Erreur : mauvais type d argument dans planputngrid) ==
6526 %% -3 3 -2 2 1. 1. newgrille
6531 %% plan : origine, base, range, ngrid
6533 %% syntaxe : plantype drawplanaffine --> -
6543 plan plangetrange plan plangetngrid aload pop quadrillagexOy_
6544 plan plangetorigine [imI imK] false planprojpath
6550 %% %% syntaxe : [a b c d] (x0 y0 z0) alpha defeqplanaffine --> plantype
6551 %% %% plan defini par l equation ax+by+cz+d=0,
6552 %% %% rotation de alpha autour de la normale (alpha est optionnel)
6553 %% %% origine (x0, y0, z0). l origine est optionnelle
6554 %% /defeqplanaffine {
6566 %% cvx /origine exch def
6569 %% table length 4 ne {
6570 %% (Erreur : mauvais type d argument dans defeqplanaffine) ==
6573 %% table 0 get /a exch def
6574 %% table 1 get /b exch def
6575 %% table 2 get /c exch def
6576 %% table 3 get /d exch def
6577 %% /resultat newplanaffine def
6578 %% [a b c alpha] normalvect_to_orthobase
6582 %% resultat [imI imJ imK] planputbase
6583 %% currentdict /origine known {
6584 %% origine /z exch def /y exch def /x exch def
6585 %% a x mul b y mul add c z mul add d add 0 ne {
6586 %% (Erreur : mauvaise origine dans defeqplanaffine) ==
6589 %% resultat origine planputorigine
6592 %% resultat 0 0 d neg c div planputorigine
6595 %% resultat d neg a div 0 0 planputorigine
6597 %% resultat 0 d neg b div 0 planputorigine
6605 %% /explan [0 0 0 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1 1] ] def
6606 %% explan drawplanaffine
6608 %% /explan [0 0 2 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1 .5] ] def
6609 %% explan drawplanaffine
6612 %% [0 0 1 -2] defeqplanaffine
6615 %% [0 0 1 0] defeqplanaffine
6618 %% [1 1 1 0] (1 -1 0) defeqplanaffine
6631 {M0 translatepoint3d} solidtransform
6635 {M0 translatepoint3d} solidtransform
6639 {M0 translatepoint3d} solidtransform
6645 %% syntaxe : solid i solidface2eqplan --> [a b c d]
6646 %% equation cartesienne de la face d'indice i du solide solid
6651 solid i solidnormaleface
6655 solid 0 i solidgetsommetface
6659 [a b c a x mul b y mul add c z mul add neg]
6664 %% syntaxe : plantype newplan --> solid
6668 lepl@n plangetbase /@base exch def
6669 @base 0 getp3d /@U defpoint3d
6670 @base 1 getp3d /@V defpoint3d
6671 lepl@n plangetorigine /@M defpoint3d
6672 lepl@n plangetrange /@range exch def
6673 lepl@n plangetngrid /@ngrid exch def
6684 @range aload pop @ngrid {@F} newsurfaceparametree
6688 %% syntaxe : M eqplan --> real
6689 %% image de M par la fonction definie par l equation eqplan
6696 /@a eqplan 0 get def
6697 /@b eqplan 1 get def
6698 /@c eqplan 2 get def
6699 /@d eqplan 3 get def
6700 @a @x mul @b @y mul add @c @z mul add @d add
6707 leplan plangetbase aload pop vectprod3d
6711 leplan plangetorigine
6715 [a b c a x0 mul b y0 mul add c z0 mul add neg]
6719 %% syntaxe : [a b c d] (x0 y0 z0) alpha defeqplanaffine --> plantype
6720 %% plan defini par l equation ax+by+cz+d=0,
6721 %% rotation de alpha autour de la normale (alpha est optionnel)
6722 %% origine (x0, y0, z0). l origine est optionnelle
6735 cvx /origine exch def
6739 (Erreur : mauvais type d argument dans eq2plan) ==
6742 table 0 get /a exch def
6743 table 1 get /b exch def
6744 table 2 get /c exch def
6745 table 3 get /d exch def
6746 /resultat newplanaffine def
6747 [a b c alpha] normalvect_to_orthobase
6751 resultat [imI imJ] planputbase
6752 currentdict /origine known {
6753 origine /z exch def /y exch def /x exch def
6754 a x mul b y mul add c z mul add d add 0 ne {
6755 (Erreur : mauvaise origine dans eq2plan) ==
6758 resultat origine planputorigine
6761 resultat 0 0 d neg c div planputorigine
6764 resultat d neg a div 0 0 planputorigine
6767 resultat 0 d neg b div 0 planputorigine
6769 (Error dans eq2plan : (a,b,c) = (0,0,0)) ==
6794 [a b c a xA mul b yA mul add c zA mul add neg]
6799 %% %[0 0 -2 [1 0 0 0 1 0 0 0 1] [-3 3 -2 2] [1. 1.]]
6800 %% [0 0 1 1] 30 eq2plan
6803 %% [0 0 1 -2] eq2plan newplan
6804 %% dup (blanc) outputcolors
6806 %% dup (blanc) outputcolors
6809 %% monplan plangetorigine
6810 %% monplan plangetbase aload pop dessinebase
6812 %% syntaxe : x0 y0 z0 [normalvect] norm2plan
6815 normalvect_to_orthobase
6826 [a b c a x0 mul b y0 mul add c z0 mul add neg] eq2plan
6827 dup x0 y0 z0 planputorigine
6828 dup [imI imJ] planputbase
6832 %% syntaxe : plantype planxmarks
6841 leplan plangetrange aload pop
6847 xmin truncate cvi 0 smoveto
6848 xmax truncate cvi 0 slineto
6849 leplan mybool projpath
6851 xmin truncate cvi xmkstep xmax truncate cvi {
6858 dup chaine cvs exch 0 leplan mybool dctextp3d
6863 leplan mybool projpath
6866 pop (0) 0 0 leplan mybool dltextp3d
6872 %% syntaxe : plantype planymarks
6881 leplan plangetrange aload pop
6887 0 ymin truncate cvi smoveto
6888 0 ymax truncate cvi slineto
6889 leplan mybool projpath
6891 ymin truncate cvi ymkstep ymax truncate cvi {
6898 dup chaine cvs exch 0 exch leplan mybool cltextp3d
6903 leplan mybool projpath
6906 pop (0) 0 0 leplan mybool dltextp3d
6912 %% syntaxe : plantype planmarks
6920 dup mybool planxmarks mybool planymarks
6925 %% [-3 3 -2 2] quadrillagexOy_
6929 %% syntaxe : [xmin xmax ymin ymax] dx dy quadrillagexOy_
6944 table 0 get /xmin exch def
6945 table 1 get /xmax exch def
6946 table 2 get /ymin exch def
6947 table 3 get /ymax exch def
6961 %% syntaxe : plan [ngrid] planquadrillage
6977 /table leplan plangetrange def
6978 table 0 get cvi truncate /xmin exch def
6979 table 1 get cvi truncate /xmax exch def
6980 table 2 get cvi truncate /ymin exch def
6981 table 3 get cvi truncate /ymax exch def
6993 leplan mybool projpath
6998 %% syntaxe : plantype str1 str2 planshowbase -> -
6999 %% syntaxe : plantype str2 planshowbase -> -
7000 %% syntaxe : plantype planshowbase -> -
7013 /couleur1 (rouge) def
7016 /couleur1 (rouge) def
7017 /couleur2 (vert) def
7036 %% syntaxe : plantype str1 str2 str3 planshowbase3d -> -
7037 %% syntaxe : plantype str2 str3 planshowbase3d -> -
7038 %% syntaxe : plantype str3 planshowbase3d -> -
7039 %% syntaxe : plantype planshowbase3d -> -
7040 %% syntaxe : plantype str1 str2 str3 array planshowbase3d -> -
7041 %% syntaxe : plantype str2 str3 array planshowbase3d -> -
7042 %% syntaxe : plantype str3 array planshowbase3d -> -
7043 %% syntaxe : plantype array planshowbase3d -> -
7051 dup dup isarray exch isplan not and {
7063 /couleur1 (rouge) def
7066 /couleur2 (vert) def
7067 /couleur1 (rouge) def
7070 /couleur1 (rouge) def
7071 /couleur2 (vert) def
7072 /couleur3 (bleu) def
7075 plan couleur1 couleur2 mybool planshowbase
7076 plan plangetorigine /I defpoint3d
7078 dup 0 getp3d /u defpoint3d
7079 1 getp3d /v defpoint3d
7080 u v vectprod3d table newvecteur
7081 {I addv3d} solidtransform
7082 dup couleur3 solidputcolors
7088 %% syntaxe : plantype x y z plantranslate --> -
7094 (Erreur : mauvais type d argument dans plantranslate) ==
7097 plan plan plangetorigine M addv3d planputorigine
7101 % syntaxe : alpha_x alpha_y alpha_z rotateOpplan --> -
7107 (Erreur : mauvais type d argument dans rotateOplan) ==
7110 plan plan plangetorigine Rxyz rotateOpoint3d planputorigine
7112 plan plangetbase 0 getp3d /U defpoint3d
7113 plan plangetbase 1 getp3d /V defpoint3d
7115 U Rxyz rotateOpoint3d
7116 V Rxyz rotateOpoint3d
7121 %% syntaxe : plantype phi rotateplan --> -
7126 leplan plangetbase 0 getp3d /U defpoint3d
7127 leplan plangetbase 1 getp3d /V defpoint3d
7129 V phi sin mulv3d addv3d /U0 defpoint3d
7130 U phi sin neg mulv3d
7131 V phi cos mulv3d addv3d /V0 defpoint3d
7132 leplan [U0 V0] planputbase
7136 %% syntaxe : solid i solidface2plan --> plantype
7137 %% syntaxe : solid i I solidface2plan --> plantype
7140 2 copy pop issolid {
7143 solid i solidcentreface /I defpoint3d
7149 /result newplanaffine def
7150 solid i solidcentreface /G defpoint3d
7151 solid i solidnormaleface /K defpoint3d
7152 solid 0 i solidgetsommetface
7153 solid 1 i solidgetsommetface
7154 milieu3d /A defpoint3d
7155 G A vecteur3d normalize3d /U defpoint3d
7156 K U vectprod3d /V defpoint3d
7157 result [U V] planputbase
7158 result I planputorigine
7163 %%%%% ### fin insertion ###
7164 %% syntaxe : x y plantype pointplan --> X Y Z
7170 leplan plangetbase 0 getp3d /U defpoint3d
7171 leplan plangetbase 1 getp3d /V defpoint3d
7172 U x mulv3d V y mulv3d addv3d
7176 %%%%% ### fin insertion ###
7179 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7180 %%%% operations sur des solides particuliers %%%%
7181 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7186 mypie 0 solidgetface length /n exch def
7187 mypie n 2 idiv solidgetsommet /A defpoint3d
7188 mypie n 2 idiv 1 add solidgetsommet /B defpoint3d
7189 A B milieu3d GetCamPos distance3d
7200 0 1 table length 1 sub {
7205 doublequicksort pop reverse
7208 0 1 result length 1 sub {
7210 table result i get get
7219 sortpieset dup {drawsolid**} apply {0 dessinefacevisible} apply
7223 %%%%% ### solidchanfreine ###
7224 %% syntaxe : solid coeff solidchanfreine --> solid
7229 /result newsolid def
7231 (Erreur : mauvais type d argument dans solidchanfreine) ==
7234 /n solid solidnombresommets def
7235 /nf solid solidnombrefaces def
7237 %% ajout des faces reduites
7240 /Fsommets solid i solidgetsommetsface def
7241 /Findex solid i solidgetface def
7242 /ns Fsommets length 3 idiv def
7243 /couleurfaceorigine solid i solidgetfcolor def
7244 Fsommets isobarycentre3d /G defpoint3d
7245 %% on ajoute les nouveaux sommets
7249 /Sindex [ Sindex aload pop
7250 Fsommets j getp3d /M defpoint3d
7251 result M G coeff hompoint3d solidaddsommet
7254 %% Sindex contient les indices des nouveaux sommets
7255 result Sindex couleurfaceorigine solidaddface
7258 %% ajout des faces rectangulaires entre faces d'origines adjacentes
7259 %% pour chaque face de depart
7262 /F solid i solidgetface def
7263 /couleurfaceorigine solid i solidgetfcolor def
7264 /Fres result i solidgetface def
7265 %% pour chaque arete de la face
7266 0 1 F length 1 sub {
7269 /indice1 F j get def
7270 /indice2 F j 1 add F length mod get def
7272 /a2 j 1 add F length mod def
7273 %% on regarde toutes les autres faces
7274 i 1 add 1 nf 1 sub {
7276 /Ftest solid k solidgetface def
7277 indice1 Ftest in {pop true} {false} ifelse
7278 indice2 Ftest in {pop true} {false} ifelse
7281 indice1 Ftest in pop /k1 exch def
7282 indice2 Ftest in pop /k2 exch def
7288 /Fadj solid indiceFadj solidgetface def
7291 result indiceFadj solidgetface k1 get
7292 result indiceFadj solidgetface k2 get
7294 ] couleurfaceorigine solidaddface
7302 /F solid i solidgetface def
7303 /couleurfaceorigine solid i solidgetfcolor def
7304 %% et pour chaque sommet de cette face
7305 0 1 F length 1 sub {
7308 solid k solidfacesadjsommet /adj exch def
7309 %% adj est le tableau des indices des faces adjacentes
7310 %% au sommet d'indice k
7311 %% rque : toutes les faces d'indice strict inferieur a i
7312 %% sont deja traitees
7313 %% Pour chaque face adjacente, on repere l'indice du sommet concerne dans
7317 0 1 adj length 1 sub {
7319 k solid adj m get solidgetface in {
7321 /indadj [indadj aload pop ok] store
7326 0 1 adj length 1 sub {
7328 result adj m get solidgetface indadj m get get
7332 %% la table des sommets
7333 [0 1 aajouter length 1 sub {
7335 result aajouter m get solidgetsommet
7337 solid k solidgetsommet %% le point indiquant la direction de la normale
7339 /indicestries exch def
7342 0 1 indicestries length 1 sub {
7344 aajouter indicestries m get get
7346 ] couleurfaceorigine solidaddface
7355 %%%%% ### solidplansection ###
7356 %% syntaxe : M eqplan --> real
7357 %% image de M par la fonction definie par l equation eqplan
7364 /@a @qplan 0 get def
7365 /@b @qplan 1 get def
7366 /@c @qplan 2 get def
7367 /@d @qplan 3 get def
7368 @a @x mul @b @y mul add @c @z mul add @d add
7372 %% syntaxe : A B eqplan segment_inter_plan --> array true ou false
7373 %% array contient 1 point M si [AB] inter plan = {M}
7374 %% array contient les 2 points A et B si [AB] inter plan = [AB]
7375 /segment_inter_plan {
7377 dup isplan {plan2eq} if
7394 /imA a xA mul b yA mul add c zA mul add d add def
7395 /imB a xB mul b yB mul add c zB mul add d add def
7396 imA imB mul dup 0 gt {
7397 %% pas d intersection
7402 %% intersection en A ou en B
7408 %% intersection entre A et B
7415 (Error dans segment_inter_plan) ==
7430 %% syntaxe : solid i solidface2eqplan --> [a b c d]
7431 %% equation cartesienne de la face d'indice i du solide solid
7436 solid i solidnormaleface
7440 solid 0 i solidgetsommetface
7444 [a b c a x mul b y mul add c z mul add neg]
7448 %% syntaxe : array1 arrayrmdouble --> array2
7449 %% remplace 2 elts identiques consecutifs par 1 elt
7453 /result [table 0 get] def
7455 1 1 table length 1 sub {
7460 /result [result aload pop table i get] store
7468 %% syntaxe : solid eqplan/plantype solidplansection --> solid2
7482 dupsolid /result exch def
7485 /indnouveauxsommets [] def
7486 /nouvellesaretes [] def
7488 %% pour chaque face d'indice i
7489 0 1 solid solidnombrefaces 1 sub {
7491 /lacouleur solid i solidgetfcolor def
7492 /F solid i solidgetface def %% table des indices des sommets
7493 /n F length def %% nb d'aretes
7500 %% pour chaque arete [AB]
7503 %% arete testee : [j, j+1 mod n] (indices relatifs a la face i)
7504 solid j i solidgetsommetface /A defpoint3d
7505 solid j 1 add n mod i solidgetsommetface /B defpoint3d
7506 %% y a-t-il intersection
7507 A B eqplan segment_inter_plan {
7508 %% il y a intersection
7510 %% l'intersection, c'est [AB]
7517 dup 0 getp3d /A defpoint3d
7518 1 getp3d /B defpoint3d
7519 result A solidaddsommet /a1 exch def
7520 result B solidaddsommet /a2 exch def
7521 /indnouveauxsommets [
7522 indnouveauxsommets aload pop a1 a2
7526 nouvellesaretes aload pop
7528 exit %% c est deja scinde
7530 %% il y a intersection <> [AB]
7532 %% 1ere intersection de la face
7533 /k1 j def %% sommet precedent intersection 1
7534 result exch aload pop solidaddsommet
7535 /k1a exch def %% sommet intersection 1
7538 %% 2eme intersection de la face
7539 /k2 j def %% sommet precedent intersection 2
7540 result exch aload pop solidaddsommet
7541 /k2a exch def %% sommet intersection 2
7544 %% 3eme intersection de la face
7545 /k3 j def %% sommet precedent intersection 3
7546 result exch aload pop solidaddsommet
7547 /k3a exch def %% sommet intersection 3
7549 %% 4eme intersection de la face
7550 /k4 j def %% sommet precedent intersection 4
7551 result exch aload pop solidaddsommet
7552 /k4a exch def %% sommet intersection 4
7559 %% y a-t-il eu une coupe ?
7560 %% si oui, il faut scinder la face d'indice i en cours
7564 %% k1 == k2 == k3 == k4 ==
7566 %% k1a == k2a == k3a == k4a ==
7567 k1a k2a eq k3 0 lt and {
7568 %% 1 pt d'intersection
7570 %% il y a coupe, on cherche a eliminer les
7571 %% doublons dans {k1a, k2a, k3a, k4a}
7572 k1a k2a eq k3 0 ge and {
7573 %% 2 pts d'intersection
7577 k1a k3a eq k4 0 ge and {
7578 %% 2 pts d'intersection
7584 nouvellesaretes aload pop
7587 k1a F k1 1 add n mod get ne {
7590 k1 1 add n mod 1 k2 {F exch get} for
7595 result exch lacouleur solidaddface
7596 /indnouveauxsommets [indnouveauxsommets aload pop k1a k2a] store
7598 k2a F k2 1 add n mod get ne {
7602 k2 1 add n mod 1 n 1 sub {F exch get} for
7604 0 1 k1 {F exch get} for
7609 result exch lacouleur solidaddface
7610 /aenlever [aenlever aload pop i] store
7614 result aenlever solidrmfaces
7616 nouvellesaretes separe_composantes
7617 /composantes exch def
7619 %% pour chacune des composantes
7620 0 1 composantes length 1 sub {
7621 %% on oriente et on ajoute la face
7623 %indnouveauxsommets bubblesort arrayrmdouble
7624 /indnouveauxsommets composantes icomp get def
7625 %% maintenant, on ajoute la face de plan de coupe
7627 0 1 indnouveauxsommets length 1 sub {
7629 result indnouveauxsommets i get solidgetsommet
7633 0 0 0 eqplan pointeqplan 0 eq {
7639 %% restera a traiter le cas limite ou la nouvelle face existe deja
7640 %% tester si max(indicestries) < nb sommets avant section
7641 nouveauxsommets ptref ordonnepoints3d
7642 /indicestries exch def
7644 0 1 indicestries length 1 sub {
7646 indnouveauxsommets indicestries m get get
7649 /F result solidgetfaces def
7650 /FC result solidgetfcolors def
7651 /IO result solidgetinouttable def
7654 result IO solidputinouttable
7655 result [nvelleface F aload pop] solidputfaces
7656 result [lacouleur FC aload pop] solidputfcolors
7665 %% syntaxe : elt array compteoccurences
7666 %% ou array est un tableau du type [ [a1 a2] [b1 b2] [c1 c2] ... ]
7672 0 1 table length 1 sub {
7674 elt table i get in {
7683 /separe_composantes {
7685 /result [] def %% les composantes deja faites
7686 /table exch def %% ce qui reste a faire
7688 % (recu) == table {==} apply
7690 /ext1 table 0 get 1 get def
7691 /ext0 table 0 get 0 get def
7694 { %% maintenant on suit les extremites et on epluche une composante
7697 0 1 table length 1 sub {
7700 ext0 table i get In or {
7701 /aenlever [aenlever aload pop i] store
7703 %% l'arete i contient l'extremite ext0 ou ext1
7704 ext0 table i get in {
7706 neg 1 add table i get exch get
7708 ext0 composante In not {
7709 /composante [composante aload pop ext0] store
7711 %% on verifie que ext0 est legitime
7712 ext0 table compteoccurences 2 gt {
7716 ext1 table i get in {
7718 neg 1 add table i get exch get
7720 ext1 composante In not {
7721 /composante [composante aload pop ext1] store
7723 %% on verifie que ext1 est legitime
7724 ext1 table compteoccurences 2 gt {
7730 %% il faut reconstruire table
7732 0 1 table length 1 sub {
7741 change not {exit} if
7743 %% on vient de finir une composante
7744 /result [result aload pop composante] store
7745 %% (nouvelle comp) == composante {==} apply
7746 table length 0 eq {exit} if
7749 % (renvoie) == result {==} apply
7753 /solideqplansepare {solidplansepare} def
7755 %% syntaxe : solid eqplan/plantype solidplansepare --> solid1 solid2
7764 eqplan true solidplansection
7765 /nbcomposantes exch def
7767 /n solid solidnombrefaces def
7771 %% on retire les faces de coupe
7772 0 1 nbcomposantes 1 sub {
7774 /F [F aload pop solid i solidgetface] store
7775 /FC [FC aload pop solid i solidgetfcolor] store
7777 solid [0 1 nbcomposantes 1 sub {} for] solidrmfaces
7778 /n n nbcomposantes sub store
7780 %% on separe les autres faces en 2 parties
7781 /lesneg [] def %% indices des faces "positives"
7782 /lespos [] def %% indices des faces negatives"
7785 solid i solidcentreface /G defpoint3d
7786 G eqplan pointeqplan dup 0 gt {
7788 /lespos [lespos aload pop i] store
7791 /lesneg [lesneg aload pop i] store
7793 % /lesneg [lesneg aload pop i] store
7794 % /lespos [lespos aload pop i] store
7799 dupsolid dup lesneg solidrmfaces
7801 dupsolid dup lespos solidrmfaces
7805 0 1 nbcomposantes 1 sub {
7807 /facecoupe F i get def
7808 /couleurfacecoupe FC i get def
7809 /lesfaces1 result1 solidgetfaces def
7810 /lescouleurs1 result1 solidgetfcolors def
7811 /IO1 result1 solidgetinouttable def
7812 /lesfaces2 result2 solidgetfaces def
7813 /lescouleurs2 result2 solidgetfcolors def
7814 /IO2 result2 solidgetinouttable def
7815 %% on rajoute maintenant la face du plan de coupe
7816 % result1 facecoupe couleurfacecoupe solidaddface
7817 result1 [facecoupe lesfaces1 aload pop] solidputfaces
7818 result1 [couleurfacecoupe lescouleurs1 aload pop] solidputfcolors
7819 result1 IO1 dup dup 1 get 1 add 1 exch put solidputinouttable
7820 %% et on verifie l'orientation
7821 % result1 dup solidnombrefaces 1 sub solidnormaleface
7822 % result1 dup solidnombrefaces 1 sub solidcentreface addv3d
7823 result1 0 solidnormaleface
7824 result1 0 solidcentreface addv3d
7825 eqplan pointeqplan 0 gt {
7826 %% l'orientation est mauvaise
7827 result1 0 solidrmface
7828 result2 [facecoupe lesfaces2 aload pop] solidputfaces
7829 result2 [couleurfacecoupe lescouleurs2 aload pop] solidputfcolors
7830 result2 IO2 dup dup 1 get 1 add 1 exch put solidputinouttable
7831 result1 [facecoupe reverse lesfaces1 aload pop] solidputfaces
7832 result1 [couleurfacecoupe lescouleurs1 aload pop] solidputfcolors
7833 result1 dup solidgetinouttable dup dup 1 get 1 add 1 exch put solidputinouttable
7835 %% l'orientation est ok
7836 result2 IO2 dup dup 1 get 1 add 1 exch put solidputinouttable
7837 result2 [facecoupe reverse lesfaces2 aload pop] solidputfaces
7838 result2 [couleurfacecoupe lescouleurs2 aload pop] solidputfcolors
7842 %% maintenant on enleve les sommets isoles
7845 %% pour chaque face du cote negatif
7846 0 1 lesneg length 1 sub {
7847 lesneg exch get /i exch def
7848 /F solid i solidgetface def
7849 %% pour chaque sommet de cette face
7850 0 1 F length 1 sub {
7853 %% si le sommet n'est pas encore note
7854 sommet sommetsneg in not {
7855 %% et s'il est isole, on peut l'enlever
7856 result1 sommet solidsommetsadjsommet length 0 eq {
7857 /sommetsneg [sommetsneg aload pop sommet] store
7864 sommetsneg bubblesort reverse {result1 exch solidrmsommet} apply
7866 %% pour chaque face du cote positif
7867 0 1 lespos length 1 sub {
7868 lespos exch get /i exch def
7869 /F solid i solidgetface def
7870 %% pour chaque sommet de cette face
7871 0 1 F length 1 sub {
7874 %% si le sommet n'est pas encore note
7875 sommet sommetspos in not {
7876 %% et s'il est isole, on peut l'enlever
7877 result2 sommet solidsommetsadjsommet length 0 eq {
7878 /sommetspos [sommetspos aload pop sommet] store
7885 sommetspos bubblesort reverse {result2 exch solidrmsommet} apply
7891 %%%%% ### solidaffine ###
7892 %% syntaxe : solid coeff i solidaffine -> -
7893 %% syntaxe : solid coeff array solidaffine -> -
7894 %% syntaxe : solid coeff solidaffine -> -
7895 %% syntaxe : solid coeff str solidaffine -> -
7896 %% syntaxe : solid coeff bool solidaffine -> -
7900 /rmfacecentrale exch def
7902 /rmfacecentrale true def
7905 /couleurface exch def
7907 2 copy pop issolid {
7908 %% 2 arguments --> on affine tout
7909 2 copy pop solidnombrefaces /n exch def
7910 /table [n 1 sub -1 0 {} for] def
7912 %% 1 tableau --> il donne les faces a enlever
7914 /table exch bubblesort reverse def
7916 %% 1 seule face a enlever
7917 [ exch ] /table exch def
7922 0 1 table length 1 sub {
7924 solid coeff table i get
7925 currentdict /couleurface known {
7928 rmfacecentrale s@lidaffineface
7933 %% syntaxe : solid coeff i s@lidaffineface
7936 /rmfacecentrale exch def
7938 /couleurface exch def
7940 /indice_a_chamfreiner exch def
7941 /i indice_a_chamfreiner def
7945 (Erreur : mauvais type d argument dans affine) ==
7948 /n solid solidnombresommets def
7949 /F solid i solidgetsommetsface def
7950 /Findex solid i solidgetface def
7951 /ni F length 3 idiv def
7952 /couleurfaceorigine solid i solidgetfcolor def
7953 F isobarycentre3d /G defpoint3d
7954 %% on ajoute les nouveaux sommets
7958 /Sindex [ Sindex aload pop
7959 solid G F j getp3d vecteur3d coeff mulv3d G addv3d solidaddsommet
7962 %% Sindex contient les indices des nouveaux sommets
7963 %% on prepare les faces a ajouter
7965 /facestoadd [facestoadd aload pop
7969 Findex j 1 add ni mod get
7970 Sindex j 1 add ni mod get
7976 solid facestoadd i get solidaddface
7978 %% on enleve la face d origine
7979 solid indice_a_chamfreiner solidrmface
7980 %% on ajuste les couleurs des nouvelles faces
7981 /N solid solidnombrefaces def
7984 solid N 1 sub i sub couleurfaceorigine solidputfcolor
7986 %% puis on ajoute eventuellement la face centrale
7987 rmfacecentrale not {
7994 %% en ajustant la couleur de cette derniere
7996 currentdict /couleurface known {
8006 %%%%% ### solidtronque ###
8007 %% syntaxe : solid indicesommet k solidtronque --> solid
8008 %% syntaxe : solid array k solidtronque --> solid
8009 %% syntaxe : solid k solidtronque --> solid
8010 %% k entier > 0, array = tableau des indices des sommets
8015 dup solidnombresommets /N exch def
8016 /table [0 1 N 1 sub {} for] def
8021 [ exch ] /table exch def
8025 solid dupsolid /result exch def pop
8026 /n solid solidnombrefaces def
8027 0 1 table length 1 sub {
8028 table exch get /no exch def
8029 result no solidgetsommet /sommetvise defpoint3d
8030 %% on recup les sommets adjacents au sommet vise
8031 /sommetsadj solid no solidsommetsadjsommet def
8032 %% on calcule les nouveaux sommets
8034 0 1 sommetsadj length 1 sub {
8036 solid sommetsadj i get solidgetsommet
8038 ] {sommetvise exchp3d coeff ABpoint3d} papply3d def
8039 %% on pose G = barycentre de ces points
8040 nouveauxsommets isobarycentre3d /G defpoint3d
8041 %% il faut ordonner ces sommets
8042 nouveauxsommets 0 getp3d /ptref defpoint3d
8043 G result no solidgetsommet vecteur3d /vecteurnormal defpoint3d
8044 %% on construit le tableau des angles ordonnes par rapport
8046 nouveauxsommets duparray exch pop
8051 vecteurnormal angle3doriente
8053 doublebubblesort pop
8054 %% nos sommets sont tries
8055 /indicesommetstries exch def
8056 %% on rajoute les sommets au solide, et on note les nouveaux indices
8058 0 1 nouveauxsommets length 3 idiv 1 sub {
8060 result nouveauxsommets k getp3d solidaddsommet
8063 %% on ajoute la face concernee
8065 0 1 indicesommetstries length 1 sub {
8067 nouveauxindices indicesommetstries k get get
8070 result no solidfacesadjsommet /lesfaces exch def
8071 %% on examine la face d indice i, et on elimine le
8073 0 1 lesfaces length 1 sub {
8075 /j lesfaces i get def
8076 /F result j solidgetface def
8078 0 1 F length 1 sub {
8080 F k get dup no eq {pop} if
8082 ] j exch solidputface
8085 table bubblesort reverse {result exch solidrmsommet} apply
8090 %%%%% ### dualpolyedre ###
8091 %% syntaxe : solid dualpolyedreregulier --> solid
8092 %% syntaxe : solid r dualpolyedreregulier --> solid
8093 %% si le nombre r est present, projette les nouveaux sommets sur la sphere de centre O , de rayon r
8094 /dualpolyedreregulier {
8098 /projection true def
8100 /projection false def
8103 solid dupsolid /result exch def pop
8104 /n solid solidnombrefaces def
8105 /N solid solidnombresommets def
8106 /facesaenlever [] def
8107 %% pour chacun des sommets
8109 %% sommet d indice i
8111 %% indicesfacesadj = liste des indices des faces ou on trouve le sommet i
8112 /indicesfacesadj solid i solidfacesadjsommet def
8113 %% on recupere les centres des faces concernees
8115 0 1 indicesfacesadj length 1 sub {
8117 solid indicesfacesadj k get solidgetsommetsface isobarycentre3d
8120 %% et on pose G = barycentre de ces points
8121 nouveauxsommets isobarycentre3d /G defpoint3d
8122 %% il faut ordonner ces sommets
8123 nouveauxsommets 0 getp3d /ptref defpoint3d
8124 G solid i solidgetsommet vecteur3d /vecteurnormal defpoint3d
8125 nouveauxsommets duparray exch pop
8130 vecteurnormal angle3doriente
8132 doublebubblesort pop
8133 %% nos sommets sont tries
8134 /indicesommetstries exch def
8136 %% on projette les sommets sur la sphere
8137 /nouveauxsommets [ nouveauxsommets {normalize3d r mulv3d} papply3d aload pop ] store
8139 %% puis on les rajoute au solide
8141 0 1 nouveauxsommets length 3 idiv 1 sub {
8143 result nouveauxsommets k getp3d solidaddsommet
8146 %% ainsi que la face concernee
8148 0 1 indicesommetstries length 1 sub {
8150 nouveauxindices indicesommetstries k get get
8153 /facesaenlever [ facesaenlever aload pop indicesfacesadj aload pop ] store
8155 result [0 1 n 1 sub {} for] solidrmfaces
8156 [N 1 sub -1 0 {} for] {result exch solidrmsommet} apply
8161 %%%%% ### newgeode ###
8162 %% syntaxe : solid r newgeode --> solid
8163 %% syntaxe : N r newgeode --> solid
8164 %% N in {3,4,5} -> polyhedre de depart, r = niveau de recursion
8184 solid dupsolid /result exch def pop
8185 /n solid solidnombrefaces def
8188 %% la face d indice i
8189 solid i solidgetface /F exch def
8193 solid i0 solidgetsommet /A0 defpoint3d
8194 solid i1 solidgetsommet /A1 defpoint3d
8195 solid i2 solidgetsommet /A2 defpoint3d
8196 A0 A1 milieu3d normalize3d /A01 defpoint3d
8197 A1 A2 milieu3d normalize3d /A12 defpoint3d
8198 A2 A0 milieu3d normalize3d /A20 defpoint3d
8199 result A01 solidaddsommet /i01 exch def
8200 result A12 solidaddsommet /i12 exch def
8201 result A20 solidaddsommet /i20 exch def
8202 result i solidrmface
8203 result [i0 i01 i20] solidaddface
8204 result [i01 i1 i12] solidaddface
8205 result [i01 i12 i20] solidaddface
8206 result [i20 i12 i2] solidaddface
8214 %% syntaxe : N r newdualgeode --> solid
8217 dualpolyedreregulier
8220 %%%%% ### fin insertion ###
8223 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
8224 %%%% quelques solides precalcules %%%%
8225 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
8227 %%%%% ### newface ###
8228 %% syntaxe : array newmonoface -> solid
8229 %% ou array = tableau de points 2d
8233 /n table length 2 idiv def
8234 /S table {0} papply def
8237 [0 1 n 1 sub {} for]
8243 %% syntaxe : array newbiface -> solid
8244 %% ou array = tableau de points 2d
8250 %%%%% ### newpolreg ###
8251 %% syntaxe : r n newpolreg --> solid
8257 0 360 n div 360 360 n div sub {
8265 [0 1 n 1 sub {} for]
8273 %%%%% ### newgrille ###
8274 %% syntaxe : xmin xmax ymin ymax [dx dy] newgrille -> solid
8275 %% syntaxe : xmin xmax ymin ymax [nx ny] newgrille -> solid
8276 %% syntaxe : xmin xmax ymin ymax {mode} newgrille -> solid
8277 %% syntaxe : xmin xmax ymin ymax newgrille -> solid
8280 [[/nx /ny] [1 1] [1. 1.] [1. 1.] [1. 1.] [.5 .5]] gestionsolidmode
8281 %% ny nb d etages en y
8282 %% nx nb d etages en x
8284 [nx ny] {0} newsurfaceparametree
8288 %% %% syntaxe : xmin xmax ymin ymax [dx dy] {f} newsurface -> solid
8291 true newsurfaceparametree
8296 /newsurfaceparametree {
8304 [[/nx /ny] [2 2] [4 4] [1. 1.] [1. 1.] [.25 .25]] gestionsolidmode
8305 %% ny nb d etages en y
8306 %% nx nb d etages en x
8313 %% alors nx est un dx
8314 /nx xmax xmin sub nx div cvi store
8317 %% alors ny est un dy
8318 /ny ymax ymin sub ny div cvi store
8320 /dy ymax ymin sub ny div def %% le pas sur y
8321 /dx xmax xmin sub nx div def %% le pas sur x
8328 /u xmin i dx mul add def
8329 /v ymin j dy mul add def
8344 j 1 add i ny 1 add mul add
8345 j i ny 1 add mul add
8346 j ny 1 add add i ny 1 add mul add
8347 j ny 2 add add i ny 1 add mul add
8351 %% 0 1 0 {%nx 1 sub {
8353 %% 0 1 0 {%ny 2 sub {
8356 %% j 1 add %% i ny mul add
8357 %% j %% i ny mul add
8358 %% ny 1 add j add %% i ny mul add
8359 %% ny 2 add j add %% i ny mul add
8365 biface pl@n-en-cours not and {dup videsolid} if
8369 %%%%% ### newgrillecirculaire ###
8370 %% syntaxe : r option newgrillecirculaire -> solid
8371 /newgrillecirculaire {
8373 [[/K /N] [6 6] [6 8] [10 8] [16 12] [16 36]] gestionsolidmode
8375 %% N = nb de meridiens (diviseur de 360 = 2^4 * 3^2 * 5)
8376 %% K = nb d horizontales (diviseur de 160 = 2^5 * 5)
8392 i N mod N add 1 add j N mul add
8393 i N mod 1 add j N mul add]
8398 %% tableau des sommets
8405 /theta i 360 mul N div def
8406 theta cos r j mul K div mul
8407 theta sin r j mul K div mul
8408 0 %2 copy f %exch atan 90 div
8417 %% syntaxe : r [dx dy] {f} newsurface* -> solid
8421 [[/nx /ny] [6 6] [6 8] [10 8] [16 12] [16 36]] gestionsolidmode
8424 %% alors nx est un dx
8425 /nx xmax xmin sub nx div cvi store
8428 %% alors ny est un dy
8429 /ny ymax ymin sub ny div cvi store
8431 /dy ymax ymin sub ny div def %% le pas sur y
8432 /dx xmax xmin sub nx div def %% le pas sur x
8434 %% ny = nb de meridiens
8435 %% nx = nb d horizontales
8442 [0 i i ny mod 1 add]
8450 i ny add j ny mul add
8451 i ny mod ny add 1 add j ny mul add
8452 i ny mod 1 add j ny mul add]
8457 %% tableau des sommets
8464 /theta i 360 mul ny div def
8465 theta cos r j mul nx div mul
8466 theta sin r j mul nx div mul
8476 %%%%% ### newruban ###
8477 %% syntaxe : array h u [n] newruban -> solid d axe (O, u), de maillage vertical n
8478 %% syntaxe : array h u newruban -> solid d axe (O, u),
8479 %% syntaxe : array h newruban -> solid d axe (O, k),
8480 %% ou array tableau de points 2d
8484 [[/N] [1] [1] [1] [3] [4]] gestionsolidmode
8485 2 copy pop isarray {
8491 (Error : 3eme composante nulle dans le vecteur pour newruban) ==
8497 %% n = indice du dernier point
8498 /n table length 2 idiv 1 sub def
8499 %% vecteur de translation
8502 mulv3d /v defpoint3d
8504 %% tableau des sommets
8512 v N j sub N div mulv addv3d
8523 [i j 1 sub n 1 add mul add
8524 i 1 sub j 1 sub n 1 add mul add
8525 n 1 add i add 1 sub j 1 sub n 1 add mul add
8526 n 1 add i add j 1 sub n 1 add mul add]
8536 %%%%% ### newicosaedre ###
8541 0.8944271 0 0.4472137
8542 0.2763932 0.8506507 0.4472137
8543 -0.7236067 0.5257311 0.4472137
8544 -0.7236067 -0.5257311 0.4472137
8545 0.2763932 -0.8506507 0.4472137
8548 -0.8944271 0 -0.4472137
8549 -0.2763932 -0.8506507 -0.4472137
8550 0.7236067 -0.5257311 -0.4472137
8551 0.7236067 0.5257311 -0.4472137
8552 -0.2763932 0.8506507 -0.4472137
8553 ] {a mulv3d} papply3d def
8562 [0 9 10] %% 1 10 11]
8563 [10 1 0] %% 11 2 1 ]
8564 [1 10 11] %% 2 11 12]
8565 [11 2 1] %% 12 3 2 ]
8566 [2 11 7] %% 3 12 8 ]
8571 [6 7 11] %% 7 8 12 ]
8574 [6 10 9] %% 7 11 10]
8575 [6 11 10] %% 7 12 11]
8582 %%%%% ### newdodecaedre ###
8587 0 0.607062 0.7946545
8588 -0.5773503 0.1875925 0.7946545
8589 -0.3568221 -0.4911235 0.7946545
8590 0.3568221 -0.4911235 0.7946545
8591 0.5773503 0.1875925 0.7946545
8592 0 0.982247 0.1875925
8593 -0.9341724 0.303531 0.1875925
8594 -0.5773503 -0.7946645 0.1875925
8595 0.5773503 -0.7946645 0.1875925
8596 0.9341724 0.303531 0.1875925
8597 0 -0.982247 -0.1875925
8598 0.9341724 -0.303531 -0.1875925
8599 0.5773503 0.7946545 -0.1875925
8600 -0.5773503 0.7946545 -0.1875925
8601 -0.9341724 -0.303531 -0.1875925
8602 -0.5773503 -0.1875925 -0.7946545
8603 -0.3568221 0.4911235 -0.7946545
8604 0.3568221 0.4911235 -0.7946545
8605 0.5773503 -0.1875925 -0.7946545
8606 0 -0.607062 -0.7946545
8607 ] {a mulv3d} papply3d def
8627 %%%%% ### newoctaedre ###
8639 ] {a mulv3d} papply3d def
8656 %%%%% ### newtetraedre ###
8663 -0.4714045 -0.8164965 -1 3 div
8665 -0.4714045 0.8164965 -1 3 div
8666 ] {r mulv3d} papply3d def
8679 %%%%% ### newcube ###
8682 [[/n] [1] [1] [1] [3] [4]] gestionsolidmode
8695 %% tableau des sommets
8705 ] {a mulv3d} papply3d def
8709 /N n dup mul n add 4 mul def
8710 /n1 n 1 sub dup mul def %% nb sommets centre d une face
8712 %% tableau des sommets
8725 /S2 S1 {-90 0 0 rotateOpoint3d} papply3d def
8726 /S3 S2 {-90 0 0 rotateOpoint3d} papply3d def
8727 /S4 S3 {-90 0 0 rotateOpoint3d} papply3d def
8753 %% tableau des faces
8769 %% syntaxe : i sommettourgauche --> l indice du i-eme sommet du tour
8770 %% de la face gauche (en commencant par l indice 0). ATTENTION :
8771 %% utilise la variable globale n = nb d etages
8777 (Error: indice trop grand dans sommettourgauche) ==
8784 %% syntaxe : i sommetcentregauche --> l indice du i-eme sommet du centre
8785 %% de la face gauche (en commencant par l indice 0). ATTENTION :
8786 %% utilise les variables globales n = nb d etages, et N = nb sommets
8787 %% des 4 1eres faces
8788 /sommetcentregauche {
8791 i n 1 sub dup mul ge {
8793 (Error: indice trop grand dans sommetcentregauche) ==
8801 %%%%% la face gauche %%%%%
8802 %% le coin superieur gauche
8806 n 4 mul 1 sub sommettourgauche
8807 n1 n 1 sub sub sommetcentregauche
8810 %% la bande superieure (i from 1 to n-2)
8814 i 1 add sommettourgauche
8816 n1 n sub i add sommetcentregauche
8817 n1 n sub i 1 add add sommetcentregauche
8821 %% le coin superieur droit
8824 n 1 sub sommettourgauche
8825 n1 1 sub sommetcentregauche
8826 n 1 add sommettourgauche
8829 %% la descente gauche
8834 n1 n 1 sub j mul sub sommetcentregauche
8835 n 4 mul j sub sommettourgauche
8836 n 4 mul j 1 add sub sommettourgauche
8837 n1 n 1 sub j 1 add mul sub sommetcentregauche
8841 %% les bandes centrales (j from 1 to n-2 et i from 1 to n-2)
8847 n1 i n 1 sub j 1 sub mul add sub sommetcentregauche
8848 n1 i 1 add n 1 sub j 1 sub mul add sub sommetcentregauche
8849 n1 i 1 add n 1 sub j mul add sub sommetcentregauche
8850 n1 i n 1 sub j mul add sub sommetcentregauche
8855 %% la descente droite
8859 n j add sommettourgauche
8860 n1 1 sub j 1 sub n 1 sub mul sub sommetcentregauche
8861 n1 1 sub j n 1 sub mul sub sommetcentregauche
8862 n j 1 add add sommettourgauche
8866 %% le coin inferieur gauche
8868 0 sommetcentregauche
8869 n 3 mul 1 add sommettourgauche
8870 n 3 mul sommettourgauche
8871 n 3 mul 1 sub sommettourgauche
8874 %% la bande inferieure (i from 1 to n-2)
8878 i sommetcentregauche
8879 i 1 sub sommetcentregauche
8880 n 3 mul i sub sommettourgauche
8881 n 3 mul i sub 1 sub sommettourgauche
8885 %% le coin inferieur droit
8887 n 2 mul 1 sub sommettourgauche
8888 n 2 sub sommetcentregauche
8889 n 2 mul 1 add sommettourgauche
8890 n 2 mul sommettourgauche
8894 %% syntaxe : i sommettourdroit --> l indice du i-eme sommet du tour
8895 %% de la face droit (en commencant par l indice 0). ATTENTION :
8896 %% utilise la variable globale n = nb d etages
8902 (Error: indice trop grand dans sommettourdroit) ==
8909 %% syntaxe : i sommetcentredroit --> l indice du i-eme sommet du centre
8910 %% de la face droit (en commencant par l indice 0). ATTENTION :
8911 %% utilise les variables globales n = nb d etages, et N = nb sommets
8912 %% des 4 1eres faces
8913 /sommetcentredroit {
8916 i n 1 sub dup mul ge {
8918 (Error: indice trop grand dans sommetcentredroit) ==
8926 %% coin superieur droit
8930 n1 n 1 sub sub sommetcentredroit
8931 4 n mul 1 sub sommettourdroit
8933 %% coin superieur gauche
8935 n 1 sub sommettourdroit
8937 n 1 add sommettourdroit
8938 n1 1 sub sommetcentredroit
8940 %% coin inferieur gauche
8942 n 2 sub sommetcentredroit
8943 2 n mul 1 sub sommettourdroit
8944 2 n mul sommettourdroit
8945 2 n mul 1 add sommettourdroit
8947 %% coin inferieur droit
8949 3 n mul 1 add sommettourdroit
8951 3 n mul 1 sub sommettourdroit
8952 3 n mul sommettourdroit
8959 i 1 add sommettourdroit
8960 n 1 sub n 2 sub mul i add sommetcentredroit
8961 n 1 sub n 2 sub mul i 1 sub add sommetcentredroit
8968 i 1 sub sommetcentredroit
8970 3 n mul 1 sub i sub sommettourdroit
8971 3 n mul i sub sommettourdroit
8978 n1 1 sub i 1 sub n 1 sub mul sub sommetcentredroit
8979 n i add sommettourdroit
8980 n i 1 add add sommettourdroit
8981 n1 1 sub i n 1 sub mul sub sommetcentredroit
8988 4 n mul i sub sommettourdroit
8989 n 1 sub n 1 sub i sub mul sommetcentredroit
8990 n 1 sub n 2 sub i sub mul sommetcentredroit
8991 4 n mul i sub 1 sub sommettourdroit
8994 %% bandes interieures
9000 n 1 sub j mul i 1 sub add sommetcentredroit
9001 n 1 sub j mul i add sommetcentredroit
9002 n 1 sub j 1 sub mul i add sommetcentredroit
9003 n 1 sub j 1 sub mul i 1 sub add sommetcentredroit
9010 /F2 F1 {{n dup mul n add add} apply} apply def
9011 /F3 F2 {{n dup mul n add add} apply} apply def
9012 /F4 F3 {{n dup mul n add add} apply} apply def
9015 S1 S2 append S3 append S4 append S5 append S6 append {a mulv3d} papply3d
9016 F1 F2 append F3 append F4 append {{N mod} apply} apply F5 append F6 append
9022 %%%%% ### newparallelepiped ###
9024 /newparallelepiped {
9038 %% tableau des sommets
9046 a neg b neg c neg %% 6
9053 %%%%% ### newcylindre ###
9054 %% syntaxe : z0 r0 z1 newcylindre -> solide
9055 %% syntaxe : z0 r0 z1 {mode} newcylindre -> solide
9056 %% syntaxe : z0 r0 z1 [n1 n2] newcylindre -> solide
9057 %% syntaxe : a b {f} {u} h [n1 n2] newcylindre
9060 [[/n2 /n1] [1 6] [1 8] [1 10] [3 12] [5 18]] gestionsolidmode
9062 %% cylindre cas general
9065 U normalize3d /u defpoint3d
9066 /lafonction exch def
9069 /pas b a sub n1 div def
9076 a i pas mul add lafonction
9077 u j vpas mul mulv3d addv3d
9087 i n1 1 add j mul add
9099 %% cylindre de revolution
9100 2 copy pop [n2 n1] newtronccone
9105 %% syntaxe : z0 r0 z1 newcylindrecreux -> solide
9111 %%%%% ### newtronccone ###
9112 %% syntaxe : z0 r0 z1 r1 newtronccone -> solid
9115 [[/n /N] [1 6] [1 8] [1 10] [3 12] [5 18]] gestionsolidmode
9121 /dz z1 z0 sub n div def
9122 /dr r1 r0 sub n div def
9125 [0 1 N 1 sub {} for]
9126 [n 1 add N mul 1 sub -1 n N mul {} for]
9130 k N mul 1 add 1 k 1 add N mul 1 sub {
9132 [i i 1 sub N i add 1 sub N i add]
9134 [k N mul k 1 add N mul 1 sub k 2 add N mul 1 sub k 1 add N mul]
9139 %% tableau des sommets
9145 360 N idiv i mul cos r0 dr k mul add mul
9146 360 N idiv i mul sin r0 dr k mul add mul
9155 %% syntaxe : z0 r0 z1 r1 newtroncconecreux -> solid
9156 /newtroncconecreux {
9161 %%%%% ### newcone ###
9162 %% syntaxe : z0 r0 z1 newcone -> solid
9163 %% syntaxe : z0 r0 z1 {mode} newcone -> solid
9164 %% syntaxe : z0 r0 z1 [n1 n2] newcone -> solid
9165 %% syntaxe : a b {f} {sommet} [n1 n2] newcone -> solid
9168 [ [/n /N] [1 6] [1 8] [1 10] [3 12] [5 18] ] gestionsolidmode
9172 /lafonction exch def
9176 /pas b a sub N div def
9183 a i pas mul add lafonction
9184 dupp3d sommet vecteur3d j n div mulv3d addv3d
9191 a i pas mul add lafonction
9192 sommet vecteur3d j n div mulv3d sommet addv3d
9198 %% les etages inferieurs
9211 %% dernier etage inferieur
9215 i N 1 add n 1 sub mul add
9220 %% premier etage superieur
9230 %% les etages superieurs
9248 %% cylindre de revolution
9252 /dz z1 z0 sub n div def
9257 [N 1 sub -1 0 {} for]
9259 n 1 sub N mul 1 add 1 n N mul 1 sub {
9263 [n N mul 1 sub n 1 sub N mul n N mul]
9264 %% les autres etages
9267 0 N j mul add 1 N N j mul add 2 sub {
9269 [i i 1 add dup N add dup 1 sub]
9271 [N N j mul add 1 sub N j mul dup N add dup N add 1 sub]
9275 %% tableau des sommets
9277 %% etage no j (in [1; n])
9282 360 N idiv i mul cos r0 dr j mul sub mul
9283 360 N idiv i mul sin r0 dr j mul sub mul
9294 %% %% syntaxe : z0 r0 z1 newconecreux -> solid
9301 %%%%% ### newtore ###
9302 %% syntaxe : r R newtore -> solid
9305 [[/n1 /n2] [4 5] [6 10] [8 12] [9 18] [18 36]] gestionsolidmode
9313 360 n1 div i mul cos r mul R add
9314 360 n1 div i mul sin r mul
9322 %%%%% ### newprisme ###
9323 %% syntaxe : array z0 z1 newprisme -> solid d axe (O, u),
9325 [[/N] [1] [1] [1] [3] [6]] gestionsolidmode
9329 %% syntaxe : array z0 z1 u newprisme -> solid d axe (O, u),
9330 %% ou array tableau de points 2d
9333 [[/N] [1] [1] [1] [3] [6]] gestionsolidmode
9335 (Error : 3eme composante nulle dans le vecteur pour newprisme) ==
9343 %% n = indice du dernier point
9344 /n table length 2 idiv 1 sub def
9345 %% vecteur de translation
9347 z1 z0 sub u norme3d div
9348 mulv3d /v defpoint3d
9350 %% tableau des sommets
9358 v N j sub N div mulv addv3d
9367 [N 1 add n 1 add mul 1 sub -1 N n 1 add mul {} for]
9373 [i j 1 sub n 1 add mul add
9374 i 1 sub j 1 sub n 1 add mul add
9375 n 1 add i add 1 sub j 1 sub n 1 add mul add
9376 n 1 add i add j 1 sub n 1 add mul add]
9378 [0 j 1 sub n 1 add mul add
9379 n j 1 sub n 1 add mul add
9380 2 n mul 1 add j 1 sub n 1 add mul add
9381 n 1 add j 1 sub n 1 add mul add]
9389 %%%%% ### newsphere ###
9390 %% syntaxe : r option newsphere -> solid
9393 [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
9394 -90 90 [K N] newcalottesphere
9398 %% syntaxe : r phi theta option newcalottesphere -> solid
9401 [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
9403 %% test de beta (ex-theta)
9408 /beta exch 80 min -80 max def
9411 %% test de alpha (ex-phi)
9415 /alpha exch beta min -80 max def
9421 /db alpha beta sub K 1 add div def
9424 /db alpha beta sub K div def
9429 /db alpha beta sub K div def
9432 /db alpha beta sub K 1 sub div def
9436 %% nombre de sommets -2
9439 %% tableau des sommets
9443 /phi beta j db mul add def
9444 phi cos r mul /r_tmp exch def
9447 360 N idiv i mul cos r_tmp mul
9448 360 N idiv i mul sin r_tmp mul
9457 %% calotte inferieure
9467 [nb nb N sub nb 1 sub]
9469 [nb 1 sub -1 nb N sub {} for ]
9472 %% calotte superieure
9476 [i i 1 add N mod N K mul 1 add]
9479 [0 1 N 1 sub {} for]
9490 N 2 sub {dup {1 add} apply} repeat
9504 %% syntaxe : r phi theta option newcalottespherecreuse -> solid
9505 /newcalottespherecreuse {
9507 [[/K /N] [6 6] [8 8] [10 12] [16 12] [16 36]] gestionsolidmode
9509 %% test de beta (ex-theta)
9514 /beta exch 80 min -80 max def
9517 %% test de alpha (ex-phi)
9521 /alpha exch beta min -80 max def
9527 /db alpha beta sub K 1 add div def
9530 /db alpha beta sub K div def
9535 /db alpha beta sub K div def
9538 /db alpha beta sub K 1 sub div def
9542 %% nombre de sommets -2
9545 %% tableau des sommets
9549 /phi beta j db mul add def
9550 phi cos r mul /r_tmp exch def
9553 360 N idiv i mul cos r_tmp mul
9554 360 N idiv i mul sin r_tmp mul
9563 %% calotte inferieure
9573 [nb nb N sub nb 1 sub]
9575 % [nb 1 sub -1 nb N sub {} for ]
9578 %% calotte superieure
9582 [i i 1 add N mod N K mul 1 add]
9585 % [0 1 N 1 sub {} for]
9596 N 2 sub {dup {1 add} apply} repeat
9611 %%%%% ### newanneau ###
9612 %% syntaxe : array n newanneau --> solid
9613 %% syntaxe : array {mode} newanneau --> solid
9614 %% ou array est un tableau de points de R^2 et n un nombre entier positif
9621 [[/n2] [6] [12] [24] [32] [36]] gestionsolidmode
9623 %% on plonge la section dans R^3 par projection sur yOz
9624 /S1 exch {0 3 1 roll} papply def
9625 %% nombre de sommets
9626 /n1 S1 length 3 idiv def
9631 {0 0 360 n2 div rotateOpoint3d} papply3d
9639 n1 j mul 1 j 1 add n1 mul 2 sub {
9641 [i 1 add i dup n1 add i n1 1 add add]
9643 [n1 j mul j 1 add n1 mul 1 sub j 2 add n1 mul 1 sub j 1 add n1 mul]
9651 %%%%% ### newvecteur ###
9652 %% syntaxe : x y z newvecteur
9653 %% syntaxe : x y z array newvecteur
9658 /h@uteur table 1 get def
9659 /r@y@n table 0 get def
9672 normalvect_to_orthobase
9677 A norme3d /z exch h@uteur sub def
9678 0 r@y@n h@uteur [1 8] newcone
9679 dup (noir) outputcolors
9680 {0 0 z translatepoint3d} solidtransform
9681 {imI imJ imK transformpoint3d} solidtransform
9686 %%%%% ### readsolidfile ###
9687 %% syntaxe : str readsolidfile -> solid
9691 [str (-sommets.dat) append run]
9692 [str (-faces.dat) append run]
9694 dup [str (-couleurs.dat) append run] solidputfcolors
9695 dup [str (-io.dat) append run] solidputinouttable
9699 %%%%% ### writesolidfile ###
9700 %% syntaxe : solid str writesolidfile -> -
9706 (Error : mauvais type d argument dans writesolidfile) ==
9709 str (-sommets.dat) append (w) file /lefichiersommets exch def
9710 str (-faces.dat) append (w) file /lefichierfaces exch def
9711 str (-couleurs.dat) append (w) file /lefichiercouleurs exch def
9712 str (-io.dat) append (w) file /lefichierio exch def
9714 /S solid solidgetsommets def
9715 0 1 S length 3 idiv 1 sub {
9717 solid i solidgetsommet
9721 lefichiersommets x chaine cvs writestring
9722 lefichiersommets 32 write %% espace
9723 lefichiersommets y chaine cvs writestring
9724 lefichiersommets 32 write %% espace
9725 lefichiersommets z chaine cvs writestring
9726 lefichiersommets 10 write %% CR
9728 lefichiersommets closefile
9730 /F solid solidgetfaces def
9731 0 1 F length 1 sub {
9733 /Fi solid i solidgetface def
9734 lefichierfaces 91 write %% [
9735 0 1 Fi length 1 sub {
9737 lefichierfaces Fi j get chaine cvs writestring
9738 lefichierfaces 32 write %% espace
9740 lefichierfaces 93 write %% ]
9741 lefichierfaces 10 write %% CR
9743 lefichierfaces closefile
9745 /C solid solidgetfcolors def
9746 0 1 C length 1 sub {
9748 lefichiercouleurs 40 write %% (
9749 lefichiercouleurs C i get writestring
9750 lefichiercouleurs 41 write %% )
9751 lefichiercouleurs 10 write %% CR
9753 lefichiercouleurs closefile
9755 /IO solid solidgetinouttable def
9758 lefichierio IO i get chaine cvs writestring
9759 lefichierio 32 write %% space
9761 lefichierio closefile
9765 %%%%% ### writeobjfile ###
9766 %% syntaxe : solid str writeobjfile -> -
9769 /str exch (.obj) append def
9772 (Erreur : mauvais type d argument dans writeobjfile) ==
9775 /n solid solidnombresommets def
9776 str (w) file /lefichier exch def
9779 solid i solidgetsommet
9783 lefichier (v ) writestring
9784 lefichier x chaine cvs writestring
9785 lefichier 32 write %% espace
9786 lefichier y chaine cvs writestring
9787 lefichier 32 write %% espace
9788 lefichier z chaine cvs writestring
9789 lefichier 10 write %% CR
9791 /n solid solidnombrefaces def
9794 lefichier (f ) writestring
9795 /F solid i solidgetface {1 add} apply def
9798 chaine cvs writestring
9799 lefichier 32 write %% espace
9801 lefichier 10 write %% CR
9807 %%%%% ### writeofffile ###
9808 %% syntaxe : solid str writeobjfile -> -
9811 /str exch (.off) append def
9814 (Erreur : mauvais type d argument dans writeofffile) ==
9817 /n solid solidnombresommets def
9818 /nf solid solidnombrefaces def
9819 str (w) file /lefichier exch def
9820 lefichier (OFF) writestring
9821 lefichier 10 write %% CR
9822 lefichier n chaine cvs writestring
9823 lefichier 32 write %% espace
9824 lefichier nf chaine cvs writestring
9825 lefichier 32 write %% espace
9826 lefichier 0 chaine cvs writestring
9827 lefichier 10 write %% CR
9830 solid i solidgetsommet
9834 lefichier x chaine cvs writestring
9835 lefichier 32 write %% espace
9836 lefichier y chaine cvs writestring
9837 lefichier 32 write %% espace
9838 lefichier z chaine cvs writestring
9839 lefichier 10 write %% CR
9843 /F solid i solidgetface def
9844 lefichier F length chaine cvs writestring
9845 lefichier 32 write %% espace
9848 chaine cvs writestring
9849 lefichier 32 write %% espace
9851 lefichier 10 write %% CR
9857 %%%%% ### newobjfile ###
9860 /objfilename exch (.obj) append def
9866 ] %% ferme les sommets
9867 [ [ %% ouvre les faces
9872 [ %% ouvre la nouvelle
9875 [ 0 0 0 %% sommet fantome pour respecter l'indexation (a partir de l'indice 1)
9886 %%%%% ### newofffile ###
9890 /offfilename exch (.off) append def
9891 offfilename (r) file
9893 offfile str readline pop pop
9894 offfile str readline pop
9896 dup 0 get /ns exch def
9899 offfile str readline pop numstr2array aload pop
9905 offfile str readline pop numstr2array
9907 1 1 table length 1 sub {
9920 %%%%% ### newtube ###
9921 /tub@dernierk1 [1 0 0] def
9922 /tub@dernierk2 [0 1 0] def
9923 /tub@dernierk3 [0 0 1] def
9927 normalize3d /vect3 defpoint3d
9928 normalize3d /vect2 defpoint3d
9929 normalize3d /vect1 defpoint3d
9930 vect1 norme3d 0 eq {
9931 vect2 vect3 vectprod3d /vect1 defpoint3d
9933 vect2 norme3d 0 eq {
9934 vect3 vect1 vectprod3d /vect2 defpoint3d
9936 vect3 norme3d 0 eq {
9937 vect1 vect2 vectprod3d /vect3 defpoint3d
9939 /tub@dernierk1 [vect1] store
9940 /tub@dernierk2 [vect2] store
9941 /tub@dernierk3 [vect3] store
9945 %% syntaxe : tmin tmax (f) array r newtube -> solid
9950 /K table 0 get def %% nb d etages
9951 /N table 1 get def %% nb de points sur le perimetre
9952 /@r exch def %% le rayon du tube
9954 /lafonction str cvx def
9955 /laderivee str (') append cvx def
9956 %% /laderivee2nd str ('') append cvx def
9959 /pas tmax tmin sub K 1 sub div def
9961 %% definition des sommets
9965 /a0 tmin @k pas mul add def
9967 %% definition du repere de Frenet (k1, k2, k3) au point f(a)
9968 a0 lafonction /M defpoint3d
9970 str (') append cvlit where {
9972 a0 laderivee normalize3d /k1 defpoint3d
9973 % pop /avecderiv true def
9975 M a0 pas 100 div add lafonction vecteur3d normalize3d /k1 defpoint3d
9979 k1 baseplannormal /K3 defpoint3d /K2 defpoint3d
9980 % a0 laderivee2nd normalize3d /k2 defpoint3d
9982 %% projete orthogonal du dernier rayon sur le plan actuel
9983 %% (normal a la vitesse)
9984 K2 tub@dernierk2 aload pop K2 scalprod3d mulv3d
9985 K3 tub@dernierk2 aload pop K3 scalprod3d mulv3d addv3d /k2 defpoint3d
9986 % M k1 K2 K3 dessinebase
9988 tub@dernierk1 aload pop /k1 defpoint3d
9990 /tub@dernierk1 [k1] store
9993 tub@dernierk2 aload pop /k2 defpoint3d
9995 /tub@dernierk2 [k2] store
9997 k1 k2 vectprod3d normalize3d /k3 defpoint3d
9999 tub@dernierk3 aload pop /k3 defpoint3d
10001 /tub@dernierk3 [k3] store
10003 k3 k1 vectprod3d normalize3d /k2 defpoint3d
10004 %% M k1 k2 k3 dessinebase
10005 /tub@dernierk2 [k2] store
10006 /@n 360 N div def %% le pas angulaire
10010 k2 @i cos @r mul mulv3d addv3d
10011 k3 @i sin @r mul mulv3d addv3d
10017 dup length 3 idiv /nb exch def
10018 %% definition des faces
10021 [N 1 sub -1 0 {} for]
10023 [nb 1 sub N 1 sub {dup 1 sub} repeat] reverse
10032 i 1 add N mod N j mul add
10033 i 1 add N mod N add N j mul add
10034 i N add N j mul add
10044 %%%%% ### newcourbe ###
10045 %% syntaxe : a b {f} array newcourbe --> solid
10056 /pas b a sub n 1 sub div def
10075 %%%%% ### baseplannormal ###
10076 %% syntaxe : x y z baseplannormal -> x1 y1 z1 x2 y2 z2
10080 1 0 0 K vectprod3d normalize3d /U defpoint3d
10082 0 1 0 K vectprod3d normalize3d /U defpoint3d
10084 K U vectprod3d normalize3d /V defpoint3d
10089 %%%%% ### fin insertion ###
10091 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10092 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10094 %%%% fin insertion librairie jps %%%%
10096 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10097 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10099 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10100 %%%% gestion de chaine de caracteres %%%%
10101 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10103 /Times-Roman findfont
10104 dup length dict begin
10111 /Encoding ISOLatin1Encoding def
10114 /Times-Roman-ISOLatin1 exch definefont pop
10117 /Times-Roman-ISOLatin1 findfont
10126 %% syntaxe : string x y cctext
10137 wx -2 div wy -2 div rmoveto
10143 /dbtext {gsave newpath dbtext_ Fill grestore} def
10144 /dctext {gsave newpath dctext_ Fill grestore} def
10145 /dltext {gsave newpath dltext_ Fill grestore} def
10146 /drtext {gsave newpath drtext_ Fill grestore} def
10148 /bbtext {gsave newpath bbtext_ Fill grestore} def
10149 /bctext {gsave newpath bctext_ Fill grestore} def
10150 /bltext {gsave newpath bltext_ Fill grestore} def
10151 /brtext {gsave newpath brtext_ Fill grestore} def
10153 /cbtext {gsave newpath cbtext_ Fill grestore} def
10154 /cctext {gsave newpath cctext_ Fill grestore} def
10155 /cltext {gsave newpath cltext_ Fill grestore} def
10156 /crtext {gsave newpath crtext_ Fill grestore} def
10158 /ubtext {gsave newpath ubtext_ Fill grestore} def
10159 /uctext {gsave newpath uctext_ Fill grestore} def
10160 /ultext {gsave newpath ultext_ Fill grestore} def
10161 /urtext {gsave newpath urtext_ Fill grestore} def
10164 %% syntaxe : str x y show_dim --> str x y llx lly wx wy
10165 %% attention, doit laisser la pile intacte
10170 true charpath flattenpath pathbbox
10175 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10176 %%%% procedures pour PSTricks %%%%
10177 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10179 %%% les 3 procedures utilisees pour transformer les depots de AlgToPs en nombres
10192 exec exch exec exch
10199 /gere_pst-deffunction {
10216 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10217 %%%% procedures pour \psSolid %%%%
10218 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10222 /draw {drawsolid} def
10223 /draw* {drawsolid*} def
10224 /draw** {drawsolid**} def
10225 /writeobj {solidfilename writeobjfile} def
10226 /writesolid {solidfilename writesolidfile} def
10227 /writeoff {solidfilename writeofffile} def
10229 /vecteur_en_c@urs false def
10231 /gere_pstricks_color_inout {
10233 dup [fillincolor] (setrgbcolor) astr2str
10234 [fillcolor] (setrgbcolor) astr2str inoutputcolors
10238 /gere_pstricks_color_out {
10240 dup [fillcolor] (setrgbcolor) astr2str outputcolors
10245 fontsize mul setfontsize
10247 PSfont dup /Symbol ne isolatin and {
10248 /ISO-Font ReEncode /ISO-Font
10250 findfont fontsize scalefont setfont
10253 /gere_pstricks_opt {
10254 % /CourbeR2 {CourbeR2+} def
10258 solidlinewidth setlinewidth
10259 solidtrunc length 0 ne {
10260 solidtrunc 0 get isstring {
10261 dup trunccoeff solidtronque
10263 dup solidtrunc trunccoeff solidtronque
10270 dualpolyedreregulier
10273 dup chanfreincoeff solidchanfreine
10275 RotX 0 ne RotY 0 ne or RotZ 0 ne or {
10276 {RotX RotY RotZ rotateOpoint3d} solidtransform
10278 CX 0 ne CY 0 ne or CZ 0 ne or {
10279 {CX CY CZ translatepoint3d} solidtransform
10281 plansection length 0 gt {
10282 0 1 plansection length 1 sub {
10284 plansection i get solidplansection
10288 /rmfaces rmfaces bubblesort reverse store
10289 0 1 rmfaces length 1 sub {
10291 dup rmfaces i get solidrmface
10293 tx@Dict /pst-transformoption known {
10294 dup {pst-transformoption} solidtransform
10296 solidaffinage length 0 ne {
10297 %% si on affine, il faut colorier avant
10298 activationgestioncouleurs {
10299 gere_pstricks_color_out
10301 solidaffinage 0 get isstring {
10303 /solidfcolor where {
10307 affinagerm solidaffine
10309 dup affinagecoeff solidaffinage
10310 /solidfcolor where {
10314 affinagerm solidaffine
10316 %% et il faut evider et coloriier l'interieur si necessaire
10319 activationgestioncouleurs {
10321 dup [fillincolor] (setrgbcolor) astr2str inputcolors
10325 /activationgestioncouleurs false def
10327 tx@Dict /plansepare known {
10328 plansepare solidplansepare
10329 tx@Dict /plansepare undef
10330 tx@Dict /solidname known {
10331 solidname (1) append cvlit exch def
10332 dup solidname (0) append cvlit exch def
10334 solidname (1) append cvx exec
10338 activationgestioncouleurs {
10339 dup solidwithinfaces {
10340 gere_pstricks_color_inout
10342 gere_pstricks_color_out
10345 solidinouthue length 0 gt {
10346 dup solidinouthue solidputinouthuecolors
10348 solidhue length 0 gt {
10349 dup solidhue solidputhuecolors
10351 solidinhue length 0 gt {
10352 dup solidinhue solidputinhuecolors
10356 tx@Dict /solidname undef
10365 activationgestioncouleurs {
10366 zcolor length 0 ne {
10367 dup zcolor tablez solidcolorz
10369 dup solidwithinfaces {
10370 gere_pstricks_color_inout
10372 gere_pstricks_color_out
10374 solidinouthue length 0 gt {
10375 dup solidinouthue solidputinouthuecolors
10377 solidhue length 0 gt {
10378 dup solidhue solidputhuecolors
10380 solidinhue length 0 gt {
10381 dup solidinhue solidputinhuecolors
10386 /activationgestioncouleurs true def
10389 0 1 fcol length 2 idiv 1 sub {
10391 dup fcol 2 i mul get fcol 2 i mul 1 add get solidputfcolor
10393 vecteur_en_c@urs not {
10394 /lightsrc where {pop solidlightOn} if
10396 /vecteur_en_c@urs false def
10398 dup action cvx exec
10400 solidnumf length 0 ne {
10401 solidnumf 0 get isstring {
10402 dup projectionsifacevisible solidnumfaces
10404 dup solidnumf projectionsifacevisible solidnumfaces
10407 solidshow length 0 ne {
10408 solidshow 0 get isstring {
10409 dup solidshowsommets
10411 dup solidshow solidshowsommets
10414 solidnum length 0 ne {
10415 solidnum 0 get isstring {
10417 dup solidnumsommets
10419 dup solidnum solidnumsommets
10424 tx@Dict /solidname known {
10425 solidname cvlit exch bind def
10426 tx@Dict /solidname undef
10437 /pst-dodecahedron {
10449 ngrid length 1 eq {
10461 /pst-parallelepiped {
10474 ngrid length 2 eq {
10486 % r {Mode} newsphere
10488 ngrid length 2 eq {
10498 /save-cylinderhollow solidhollow def
10499 tx@Dict /function known {
10500 range aload pop function cvx {axe} h ngrid newcylindre
10501 tx@Dict /function undef
10502 /solidhollow true def
10507 ngrid length 2 eq {
10518 /solidhollow save-cylinderhollow store
10521 /pst-cylindrecreux {
10525 ngrid length 2 eq {
10536 /save-conehollow solidhollow def
10537 tx@Dict /function known {
10538 range aload pop function cvx {origin} ngrid newcone
10539 tx@Dict /function undef
10540 /solidhollow true def
10545 ngrid length 2 eq {
10557 /solidhollow save-conehollow store
10564 ngrid length 2 eq {
10577 /pst-troncconecreux {
10581 ngrid length 2 eq {
10594 ngrid length 2 eq {
10605 ngrid length 1 ge {
10616 % tableau des points de la base
10617 % h hauteur du prisme
10618 % axe : vecteur direction de l axe
10619 base decal rollparray
10621 ngrid length 1 ge {
10632 % tableau des points de la base
10633 % h hauteur du prisme
10634 % axe : vecteur direction de l axe
10637 ngrid length 1 ge {
10647 ngrid length 2 ge {
10648 [ngrid 0 get ngrid 1 get]
10650 ngrid length 1 eq {
10658 %% syntaxe : array N h u newruban -> solid d axe (O, u),
10660 % tableau des points de la base
10661 % h hauteur du prisme
10662 % axe : vecteur direction de l axe
10665 ngrid length 1 ge {
10672 %% syntaxe : r phi option newcalottesphere -> solid
10673 /pst-calottesphere {
10676 % r phi theta option newcalottesphere
10679 ngrid length 2 eq {
10685 newcalottespherecreuse
10692 %% syntaxe : r phi option newcalottesphere -> solid
10693 /pst-calottespherecreuse {
10696 % r phi theta option newcalottespherecreuse
10699 ngrid length 2 eq {
10704 newcalottespherecreuse
10708 /pointtest{2 2 2} def
10711 % tableau des points de la base
10712 % h hauteur du prisme
10713 % axe : vecteur direction de l axe
10726 ngrid length 2 ge {
10727 [ngrid 0 get ngrid 1 get]
10729 ngrid length 1 eq {
10742 ngrid length 2 ge {
10743 [ngrid 0 get ngrid 1 get]
10745 ngrid length 1 eq {
10759 ngrid length 2 ge {
10760 [ngrid 0 get ngrid 1 get]
10762 ngrid length 1 eq {
10766 { function cvx exec } newsurface
10773 /pst-polygoneregulier {
10785 /activationgestioncouleurs false def
10787 base aload pop n 1 sub {solidfuz} repeat
10802 solidlinewidth setlinewidth
10804 range aload pop function cvx [resolution] newcourbe
10807 range aload pop function r
10808 ngrid length 2 lt {
10814 gere_pstricks_opt %% r function [36 12] newtube
10818 /pst-surfaceparametree {
10820 ngrid length 2 ge {
10821 [ngrid 0 get ngrid 1 get]
10823 ngrid length 1 eq {
10827 { function cvx exec } newsurfaceparametree
10830 tx@Dict /function undef
10835 ngrid length 2 ge {
10836 [ngrid 0 get ngrid 1 get]
10838 ngrid length 1 eq {
10842 { function cvx exec } newsurface*
10849 /activationgestioncouleurs false def
10850 /vecteur_en_c@urs true def
10851 solidlinewidth setlinewidth
10856 tx@Dict /solidname known {
10857 args definition cvx exec
10858 solidname cvlit defpoint3d
10859 tx@Dict /solidname undef
10861 args definition cvx exec newvecteur
10864 [linecolor currentrgbcolor] ( ) astr2str (setrgbcolor) append
10872 %/pst-vect-2points {vecteur3d} def
10882 solidfilename newobjfile
10887 solidfilename newofffile
10892 solidfilename readsolidfile
10893 % /activationgestioncouleurs false def
10899 args (pst-plan-) definition append cvx exec
10902 dup base planputrange
10904 origin eqpl@n pointeqplan 0 eq {
10905 dup origin planputorigine
10907 ngrid length 0 ne {
10908 dup ngrid planputngrid
10910 tx@Dict /solidname known {
10911 solidname cvlit exch bind def
10912 tx@Dict /solidname undef
10917 /pst-plan- {pst-plan-plantype} def
10919 %x0 y0 z0 [normalvect] norm2plan
10920 /pst-plan-plantype {
10921 dup plan2eq /eqpl@n exch def
10927 args (pst-plan-) definition append cvx exec
10928 /pl@n-en-cours true def
10929 definition length 0 ne {
10932 base 0 get base 1 get lt
10933 base 2 get base 3 get lt and {
10936 [-3 3 -2 2] %pop base %aload pop boum
10939 origin eqpl@n pointeqplan 0 eq {
10940 dup origin planputorigine
10948 dup CX CY CZ planputorigine
10953 ngrid length 0 ne {
10954 dup ngrid planputngrid
10957 % dup RotX RotY RotZ rotateOplan
10960 tx@Dict /solidname known {
10961 l@pl@n solidname cvlit exch bind def
10962 /solidname solidname (_s) append store
10966 /pl@n-en-cours false def
10969 l@pl@n RotX RotY RotZ rotateOplan
10970 % l@pl@n CX CY CZ plantranslate
10971 % fontsize setfontsize
10974 solidplanmarks {l@pl@n projectionsifacevisible planmarks} if
10975 solidplangrid {linecolor l@pl@n projectionsifacevisible planquadrillage} if
10976 solidshowbase {l@pl@n projectionsifacevisible planshowbase} if
10977 solidshowbase3d {l@pl@n projectionsifacevisible planshowbase3d} if
10981 /pst-plan-normalpoint {
10984 dup plan2eq /eqpl@n exch def
10987 /pst-plan-equation {
10990 dup /eqpl@n exch def
10992 2 copy pop /eqpl@n exch def
10997 /pst-plan-solidface {
11006 dup CX CY CZ planputorigine
11009 % dup plangetrange aload pop boum
11010 % dup origin planputorigine
11011 dup plan2eq /eqpl@n exch def
11015 ngrid aload pop newgeode
11021 % /activationgestioncouleurs false def
11029 action (none) eqstring not {
11030 args definition cvx exec point3d
11032 texte args definition cvx exec pos (text3d) append cvx exec
11033 tx@Dict /solidname known {
11034 args definition cvx exec
11035 solidname cvlit defpoint3d
11036 tx@Dict /solidname undef
11041 %% syntaxe : alpha beta r h newpie --> solid
11044 ngrid length 2 ge {
11045 [ngrid 0 get ngrid 1 get]
11051 /pst-trigospherique {
11054 solidlinewidth setlinewidth
11057 args definition cvx exec
11062 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
11063 %%%% procedures pour \psProjection %%%%
11064 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
11066 /gere_pstricks_proj_opt {
11067 /planprojpst where {
11069 planprojpst projectionsifacevisible projpath
11070 % /planprojpst where pop /planprojpst undef
11072 /solidprojname where {
11073 /solidprojname get noface phi
11077 xorigine isinteger not and
11078 yorigine isinteger not and
11079 yorigine isinteger not and {
11081 [xorigine yorigine zorigine] ( ) astr2str
11083 projectionsifacevisible solidprojpath
11085 xorigine yorigine zorigine [ normale ] projectionsifacevisible planprojpath
11091 solidlinewidth setlinewidth
11094 /cercle {cercle_} def
11097 gere_pstricks_proj_opt
11101 /proj-pst-courbeR2 {
11102 l@pl@n plangetrange aload pop
11103 setyrange setxrange
11105 xmin ymin l@pl@n pointplan smoveto
11106 xmin ymax l@pl@n pointplan slineto
11107 xmax ymax l@pl@n pointplan slineto
11108 xmax ymin l@pl@n pointplan slineto
11109 xmin ymin l@pl@n pointplan slineto
11110 planprojpst projpath
11112 solidlinewidth setlinewidth
11115 range aload pop { function cvx exec } CourbeR2_
11116 gere_pstricks_proj_opt
11120 l@pl@n plangetrange aload pop
11121 setyrange setxrange
11123 xmin ymin l@pl@n pointplan smoveto
11124 xmin ymax l@pl@n pointplan slineto
11125 xmax ymax l@pl@n pointplan slineto
11126 xmax ymin l@pl@n pointplan slineto
11127 xmin ymin l@pl@n pointplan slineto
11128 planprojpst projpath
11130 solidlinewidth setlinewidth
11133 range aload pop {} { function cvx exec } Courbeparam_
11134 gere_pstricks_proj_opt
11138 [proj-args] length 0 eq {
11139 xorigine yorigine /proj-args defpoint
11143 [proj-args proj-definition cvx exec]
11144 dup 0 getp projname cvlit defpoint
11146 1 getp projname (0) append cvlit defpoint
11148 /projname where pop /projname undef
11150 proj-action (none) eqstring not {
11151 solidlinewidth setlinewidth
11153 [proj-args proj-definition cvx exec] 0 getp point_
11154 gere_pstricks_proj_opt
11157 % 1 1 0 0 1 1 Diamond
11158 texte length 0 gt {
11159 proj-fontsize setfontsize
11161 solidlinewidth setlinewidth
11164 texte [proj-args proj-definition cvx exec 0 0 phi neg rotatepoint] 0 getp
11165 pos (text_) append cvx exec
11166 %% /planprojpst where {
11167 %% planprojpst dupplan dup phi rotateplan /planprojpst exch def
11169 %% xorigine yorigine
11170 %% 0 0 phi neg rotatepoint
11174 %gere_pstricks_proj_opt
11175 planprojpst dupplan dup phi rotateplan projectionsifacevisible projpath
11180 /proj-pst-vecteur {
11181 proj-action (none) eqstring not {
11182 planprojpst bprojscene
11183 solidlinewidth setlinewidth
11186 xorigine yorigine 2 copy proj-args proj-definition cvx exec addv drawvecteur
11191 proj-args proj-definition cvx exec projname cvlit defpoint
11192 /projname where pop /projname undef
11197 proj-action (none) eqstring not {
11198 l@pl@n plangetrange aload pop
11199 setyrange setxrange
11201 %% xmin ymin l@pl@n pointplan smoveto
11202 %% xmin ymax l@pl@n pointplan slineto
11203 %% xmax ymax l@pl@n pointplan slineto
11204 %% xmax ymin l@pl@n pointplan slineto
11205 %% xmin ymin l@pl@n pointplan smoveto
11206 %% planprojpst projpath
11208 planprojpst bprojscene
11209 solidlinewidth setlinewidth
11212 proj-args proj-definition cvx exec droite
11217 proj-args proj-definition cvx exec projname cvlit defdroite
11218 /projname where pop /projname undef
11222 /proj-pst-polygone {
11223 proj-action (none) eqstring not {
11224 l@pl@n plangetrange aload pop
11225 setyrange setxrange
11227 xmin ymin l@pl@n pointplan smoveto
11228 xmin ymax l@pl@n pointplan slineto
11229 xmax ymax l@pl@n pointplan slineto
11230 xmax ymin l@pl@n pointplan slineto
11231 xmin ymin l@pl@n pointplan slineto
11232 planprojpst projpath
11234 solidlinewidth setlinewidth
11237 proj-definition length 0 eq {
11242 proj-definition cvx exec polygone_
11243 planprojpst projectionsifacevisible projpath
11247 proj-definition length 0 eq {
11252 proj-definition cvx exec projname cvlit exch def
11253 /projname where pop /projname undef
11260 proj-args proj-definition cvx exec projname cvlit defcercle
11261 /projname where pop /projname undef
11263 proj-action (none) eqstring not {
11264 l@pl@n plangetrange aload pop
11265 setyrange setxrange
11267 %% xmin ymin l@pl@n pointplan smoveto
11268 %% xmin ymax l@pl@n pointplan slineto
11269 %% xmax ymax l@pl@n pointplan slineto
11270 %% xmax ymin l@pl@n pointplan slineto
11271 %% xmin ymin l@pl@n pointplan slineto
11272 %% planprojpst projpath
11274 solidlinewidth setlinewidth
11278 range aload pop proj-args
11279 proj-definition cvx exec Cercle_
11280 planprojpst projectionsifacevisible projpath
11285 proj-action (none) eqstring not {
11286 l@pl@n plangetrange aload pop
11287 setyrange setxrange
11289 %% xmin ymin l@pl@n pointplan smoveto
11290 %% xmin ymax l@pl@n pointplan slineto
11291 %% xmax ymax l@pl@n pointplan slineto
11292 %% xmax ymin l@pl@n pointplan slineto
11293 %% xmin ymin l@pl@n pointplan slineto
11294 %% planprojpst projpath
11296 planprojpst bprojscene
11297 solidlinewidth setlinewidth
11300 proj-definition length 0 eq {
11305 proj-definition cvx exec ligne
11310 proj-definition length 0 eq {
11315 proj-definition cvx exec projname cvlit exch def
11316 /projname where pop /projname undef
11320 /proj-pst-rightangle {
11321 proj-action (none) eqstring not {
11322 planprojpst bprojscene
11323 solidlinewidth setlinewidth
11326 proj-args proj-definition cvx exec angledroit
11333 proj-fontsize setfontsize
11336 solidlinewidth setlinewidth
11340 /planprojpst where {
11341 planprojpst dupplan dup phi rotateplan /planprojpst exch def
11344 0 0 phi neg rotatepoint
11348 pos (text_) append cvx exec
11349 gere_pstricks_proj_opt