Documentation : section Objectif plus couleurs
[mp-gdd.git] / gdd.mp
1 input graph;
2
3 %%% ----------------------------------------------------------------------------
4 %%% Déclarations
5 %%% ----------------------------------------------------------------------------
6
7 numeric gddA[];
8 numeric gddB[];
9 numeric gddC[];
10 numeric gddD[];
11 numeric gddE[];
12 numeric gddF[];
13 picture gddL[];         % Table des labels TeX (btex .. etex)
14 numeric gddO;           % Compteur des objets
15 path    gddP[];         % Table des chemins (paths internes)
16 string  gddS[];         % Table des chaînes (noms de fichiers)
17 string  gddT[];         % Table des types
18 numeric gddU;           % Unité graphique
19 string  gddW;           % Chaîne spécifiant le placement des objets
20
21 %%% ----------------------------------------------------------------------------
22 %%% Initialisations
23 %%% ----------------------------------------------------------------------------
24
25 % Initialisation de gddO -------------------------------------------------------
26 gddO := 0;
27
28 % Valeur par défaut de gddU ----------------------------------------------------
29 gddU := 1cm;
30
31 % Initialisation de gddW et procédure associée ---------------------------------
32 gddW = "scaled gddU";
33 def gddEnPlace = scantokens gddW enddef;
34
35 %%% ----------------------------------------------------------------------------
36 %%% Définition des objets
37 %%% ----------------------------------------------------------------------------
38
39 % Point ------------------------------------------------------------------------
40 vardef Point(expr a,b) =
41   gddT[incr gddO] = "point";
42   gddA[gddO] = a; gddB[gddO] = b; gddO
43 enddef;
44
45 vardef PointDansRepere(expr x,y,o,i,j) =
46   gddT[incr gddO] = "point";
47   gddA[gddO] = gddA[o] + x*(gddA[i]-gddA[o]) + y*(gddA[j]-gddA[o]);
48   gddB[gddO] = gddB[o] + x*(gddB[i]-gddB[o]) + y*(gddB[j]-gddB[o]);
49   gddO
50 enddef;
51
52 vardef CoordonneesRepere(expr m,o,i,j) =
53   save x,y; numeric x,y;
54   gddA[m] = (gddA[i]-gddA[o])*x + (gddA[j]-gddA[o])*y + gddA[o];
55   gddB[m] = (gddB[i]-gddB[o])*x + (gddB[j]-gddB[o])*y + gddB[o];
56   (x,y)
57 enddef;
58
59 vardef Milieu(expr a,b) =
60   gddT[incr gddO] = "point";
61   gddA[gddO] = 0.5*(gddA[a]+gddA[b]);
62   gddB[gddO] = 0.5*(gddB[a]+gddB[b]);
63   gddO
64 enddef;
65
66 % Transformations pair <-> Point -----------------------------------------------
67 def PointTOPair(expr a) = (gddA[a],gddB[a]) enddef;
68 def PairTOPoint(expr p) = Point(xpart p,ypart p) enddef;
69 def PairImp(expr a) = if pair a: a else: PointTOPair(a) fi enddef;
70 def PointImp(expr a) = if pair a: PairTOPoint(a) else: a fi enddef;
71 def Pt(expr a) = (gddA[a],gddB[a]) enddef;
72 def PtR(expr a) = (gddA[a],gddB[a]) gddEnPlace enddef;
73
74
75 % Addition ---------------------------------------------------------------------
76 vardef AdditionAbscisses(expr a,b) = if pair a: xpart a else: gddA[a] fi + if pair b: xpart b else: gddA[b] fi enddef;
77 vardef AdditionOrdonnees(expr a,b) = if pair a: ypart a else: gddB[a] fi + if pair b: ypart b else: gddB[b] fi enddef;
78 vardef Addition(expr a,b) =
79   gddT[incr gddO] = "paire";
80   gddA[gddO] = AdditionAbscisses(a,b);
81   gddB[gddO] = AdditionOrdonnees(a,b);
82   gddO
83 enddef;
84
85 % Vecteur ----------------------------------------------------------------------
86 vardef Vecteur (expr a,b) =
87   save n; n = incr gddO;
88   gddT[n] = "vecteur"; gddA[n] = PointImp(a); gddB[n] = PointImp(b); n
89 enddef;
90
91
92 % Segment ----------------------------------------------------------------------
93 vardef Segment (expr a,b) =
94   save n; n = incr gddO;
95   gddT[n] = "segment"; gddA[n] = PointImp(a); gddB[n] = PointImp(b); n
96 enddef;
97
98 % Triangle ---------------------------------------------------------------------
99 vardef Triangle (expr a,b,c) =
100   save n; n = incr gddO; gddT[n] = "triangle";
101   gddA[n] = PointImp(a); gddB[n] = PointImp(b); gddC[n] = PointImp(c); n
102 enddef;
103
104 % Droite -----------------------------------------------------------------------
105 vardef Droite (expr a,b) =
106   save n; n = incr gddO;
107   gddT[n] = "droite"; gddA[n] = PointImp(a); gddB[n] = PointImp(b); n
108 enddef;
109
110 % Équation de droite : triplet (u,v,w) tel que ux+vy+w=0 -----------------------
111 % L'équation rendue est normalisée !
112 vardef EquationDroite(expr d) =
113   save u, v, w, n;
114   u := gddB[gddB[d]] - gddB[gddA[d]];
115   v := gddA[gddA[d]] - gddA[gddB[d]];
116   w := - u * gddA[gddA[d]] - v * gddB[gddA[d]];
117   n := u ++ v;
118   (u/n,v/n,w/n)
119 enddef;
120
121 % Ordonnée relative à une droite orientée --------------------------------------
122 vardef OrdonneeRelativePointDroite(expr p, d) =
123   savec u, v, w;
124   (u,v,w) = EquationDroite(d);
125   u * gddA[p] + v * gddB[p] + w
126 enddef;
127
128 % Distance d'un point à une droite ---------------------------------------------
129 def DistancePointDroite(expr p, d) =
130   abs(OrdonneeRelativePointDroite(p, d))
131 enddef;
132
133 % Projection d'un point sur une droite -----------------------------------------
134 vardef ProjectionPointSurDroite(expr p, d) =
135   save u,v,w, l;
136   (u,v,w) = EquationDroite(d);
137   l := - u * gddA[p] - v * gddB[p] - w;
138   Point(gddA[p] + l * u, gddB[p] + l * v)
139 enddef;
140
141 % Cercles ----------------------------------------------------------------------
142 vardef Cercle (expr a,b) =
143     save n; n = incr gddO;
144     gddT[n] = "cercle"; gddA[n] = PointImp(a); gddB[n] = b; n
145 enddef;
146
147 vardef CercleCP(expr a,b) = Cercle(a,abs(Pt(a)-Pt(b))) enddef;
148 vardef CercleD(expr a,b) = CercleCP(Milieu(a,b),a) enddef;
149
150 % Tangente commune extérieure à deux cercles -----------------------------------
151 vardef TangenteCommuneExterieure(expr a, b) =
152   save O, A, d, f; pair O, A;
153   O = (gddB[a]/(gddB[a]-gddB[b]))[Pt(gddA[a]),Pt(gddA[b])]; % Centre de l'homothétie
154   d = abs(O-Pt(gddA[a]));
155   f := if gddA[a] < gddA[b] : 1 else: -1 fi;
156   A = Pt(gddA[a]) rotatedaround(O,angle(d+-+gddB[a],f*gddB[a]));
157   Droite(O,A)
158 enddef;
159
160 % Intersection de deux cercles -------------------------------------------------
161 vardef IntersectionCercles(expr a, b) =
162   save d, x, y, u; pair u;
163   u = unitvector(Pt(gddA[b])-Pt(gddA[a]));
164   d = abs(Pt(gddA[a])-Pt(gddA[b]));
165   x = (gddB[a]**2-gddB[b]**2+d**2)/(2d);
166   y = gddB[a]+-+x;
167   PairTOPoint(Pt(gddA[a])+x*u+y*(u rotated 90))
168 enddef;
169
170
171 % Chemin -----------------------------------------------------------------------
172 vardef Chemin (expr p) =
173     gddT[incr gddO] = "chemin"; gddP[gddO] = p; gddO
174 enddef;
175
176 % Courbe -----------------------------------------------------------------------
177 vardef Courbe (expr s) =
178     gddT[incr gddO] = "courbe"; gddS[gddO] = s; gddO
179 enddef;
180
181 %%% ----------------------------------------------------------------------------
182 %%% Définitions liées au repère
183 %%% ----------------------------------------------------------------------------
184
185 % Définition de l'origine ------------------------------------------------------
186 origine = Point(0,0);
187
188 % Définition des axes ----------------------------------------------------------
189 AxeOx = Droite(origin,right);
190 AxeOy = Droite(origin,up);
191
192 %%% ----------------------------------------------------------------------------
193 %%% Calculs MetaPost
194 %%% ----------------------------------------------------------------------------
195
196 vardef mpIntersectionDroites (expr a,b,c,d) =
197     save t; pair t; t = whatever [a,b]; t = whatever [c,d]; t
198 enddef;
199
200 %%% --------------------------------------------------------------------------
201 %%% Tracés des courbes
202 %%% --------------------------------------------------------------------------
203 vardef gddTraceCourbe (expr f) =
204     save s; gdata(f, s, if i>1:..fi (scantokens s1,scantokens s2))
205 enddef;
206
207 %%% ----------------------------------------------------------------------------
208 %%% Tracés des objets
209 %%% ----------------------------------------------------------------------------
210
211 gddExtensionDroite := 10;
212
213 def gddTraceObjet expr o =
214   if gddT[o] = "triangle":
215     PointTOPair(gddA[o])--PointTOPair(gddB[o])--
216     PointTOPair(gddC[o])--cycle
217   elseif (gddT[o] = "segment") or (gddT[o] = "vecteur"):
218     PointTOPair(gddA[o])--PointTOPair(gddB[o])
219   elseif gddT[o] = "droite":
220     (gddExtensionDroite [ PointTOPair(gddA[o]), PointTOPair(gddB[o]) ]) --
221     (gddExtensionDroite [ PointTOPair(gddB[o]), PointTOPair(gddA[o]) ])
222   elseif gddT[o] = "cercle":
223     fullcircle scaled (gddB[o]*2) shifted PointTOPair(gddA[o])
224   elseif gddT[o] = "chemin":
225     gddP[o]
226   elseif gddT[o] = "courbe":
227     gddTraceCourbe (gddS[o] & ".dta")
228   fi
229 enddef;
230
231 def trace expr p =
232   if path p or picture p or pair p: draw (p)
233   elseif gddT[p] = "vecteur": drawarrow (gddTraceObjet p)
234   else: draw (gddTraceObjet p)
235   fi gddEnPlace
236 enddef;
237
238 def fleche expr p =
239   if path p or picture p: drawarrow (p)
240   elseif gddT[p] = "vecteur": drawarrow (gddTraceObjet p)
241   else: drawarrow (gddTraceObjet p)
242   fi gddEnPlace
243 enddef;
244
245 def colorie expr p =
246   if path p: fill p else: fill (gddTraceObjet p) fi gddEnPlace
247 enddef;
248
249 def fermeture expr p =
250   if path p: p else: (gddTraceObjet p) fi -- cycle
251 enddef;
252
253
254 %%% --------------------------------------------------------------------------
255 %%% Marque et label des points
256 %%% --------------------------------------------------------------------------
257 gddTaillePoint  := 3;                % Diamètre des cercles marquant un point.
258 color gddCouleurPoint;               % Couleur de fond de la marque d'un point.
259 gddCouleurPoint := white;
260 gddTailleLabel  := 1.5;              % Taille d'un label.
261
262
263 def gddPointe(expr p) =
264   fill (fullcircle scaled gddTaillePoint) shifted (p gddEnPlace) 
265     withcolor gddCouleurPoint;
266   draw (fullcircle scaled gddTaillePoint) shifted (p gddEnPlace)
267 enddef;
268
269 def pointe expr p = gddPointe(if pair p: p else: PointTOPair(p) fi) enddef;
270
271 vardef m_arque.@# expr p =
272     pointe p;
273     label.@#(gddL[p] scaled gddTailleLabel,PointTOPair(p) gddEnPlace);
274 enddef;
275
276 vardef m_a_rque.@# expr p = 
277     pointe(scantokens p);
278     label.@#(lTEX(p),PointTOPair(scantokens p) gddEnPlace);
279 enddef;
280
281 vardef marque.@# expr p =
282    if string p: m_a_rque.@# p else: m_arque.@# p fi
283 enddef;
284
285 %%% --------------------------------------------------------------------------
286 %%% Signes
287 %%% --------------------------------------------------------------------------
288 def SigneOrtho(expr a,b,c,x) =
289   (_point_(b) + x * unitvector(_point_(a)-_point_(b)))
290    -- (_point_(b) + x * unitvector(_point_(a) - _point_(b)) 
291    + x * unitvector(_point_(c) - _point_(b)))
292    -- (_point_(b) + x * unitvector(_point_(c) - _point_(b)))
293 enddef;
294
295 picture gdd_marque[];
296 gdd_marque1 = image(draw (-7,-7)--(7,7));
297 gdd_marque2 = image(draw (-7,-7)--(7,7); draw (-7,7)--(7,-7));
298 gdd_marque3 = image(draw (-9,-7)--(5,7); draw (-5,-7)--(9,7);
299   draw (-7,7)--(7,-7));
300 gdd_marque4 = image(draw (-9,-7)--(5,7); draw (-5,-7)--(9,7);
301   draw (-9,7)--(5,-7); draw (-5,7)--(9,-7));
302
303 def Marque(expr a,b,n) =
304   gdd_marque[n] rotated angle(PairImp(b)-PairImp(a)) scaled (0.5/gddU)
305    shifted 0.5[PairImp(a),PairImp(b)]
306 enddef;
307
308 %%% --------------------------------------------------------------------------
309 %%% Fenêtrage
310 %%% --------------------------------------------------------------------------
311
312 def Fenetre(expr xg,yg,xd,yd) =
313   gddXG := xg;
314   gddYB := yg;
315   gddXD := xd;
316   gddYH := yd;
317   extra_endfig := "gddFenetre;" & extra_endfig;
318 enddef;
319
320 def gddFenetre =
321   clip currentpicture to
322    ((gddXG,gddYB)--(gddXG,gddYH)--(gddXD,gddYH)--(gddXD,gddYB)--cycle)
323    gddEnPlace;
324   draw ((gddXG,gddYB)--(gddXG,gddYH)--(gddXD,gddYH)--(gddXD,gddYB)--cycle)
325    gddEnPlace withpen pencircle scaled 1 withcolor white;
326 enddef;
327
328 endinput

Licence Creative Commons Les fichiers de Syracuse sont mis à disposition (sauf mention contraire) selon les termes de la
Licence Creative Commons Attribution - Pas d’Utilisation Commerciale - Partage dans les Mêmes Conditions 4.0 International.