4 (* Les variables h et v sont utilis
\82es pour comparer le sens des segments*)
\r
7 (************************************************************)
\r
8 h:='h';(* Initialisation des variables h et v *)
\r
10 pref iiuwgraph block
\r
11 var t,tab:arrayof segment;(* Le tableau tab contient les segments saisis soit
\r
12 au clavier, soit
\85 l'aide de la souris ou soit cr
\82er al
\82atoirement, et le
\r
13 tableau t est le r
\82sultat du tri de tab suivant les ordonn
\82es (et les abscisses
\r
14 si les ordonn
\82es sont
\82gales *)
\r
16 (************************************************************)
\r
17 (* Les fonctions de convertion des abscisses et des ordonn
\82es
\r
18 en entier(pixel) (xconv_en_entier,yconx_en_entier) ou en r
\82el
\r
19 (yconv_en_reel,xconv_en_reel) *)
\r
21 unit xconv_en_entier:function(x:real):integer;
\r
23 result:=entier(40+20*x);
\r
24 end xconv_en_entier;
\r
26 unit yconv_en_entier:function(y:real):integer;
\r
28 result:=entier(210-20*y);
\r
29 end yconv_en_entier;
\r
31 unit xconv_en_reel:function(x:integer):real;
\r
36 unit yconv_en_reel:function(y:integer):real;
\r
41 (************************************************************)
\r
42 (* La structure de la classe segment, la procedure saisie utile pour
\r
43 la procedure clavier *)
\r
48 (* La procedure saisie n'est utilis
\82e que si les segments sont saisis
\r
50 unit saisie:procedure(input sens:char;inout x1,y1,x2,y2:real);
\r
51 var i,k:integer,j:real,
\r
56 call outstring("entrer la valeur de l'ordonn
\82e : Y= ");
\r
57 i:=inkey;j:=1.0;k:=0;y1:=0.0;b:=false;
\r
61 call move(350+7*k,290);
\r
66 if b then j:=j/10.0 fi;
\r
67 if i=46 then b:=true fi;
\r
70 y1:=y1*j;if y1>10.0 then y1:=10.0 fi;
\r
72 call outstring("entrer la valeur de l'abscisse1 : X1= ");
\r
73 i:=inkey;j:=1.0;k:=0;x1:=0.0;b:=false;
\r
77 call move(350+7*k,310);
\r
82 if b then j:=j/10.0 fi;
\r
83 if i=46 then b:=true fi;
\r
88 call outstring("entrer la valeur de l'abscisse2 : X2= ");
\r
89 i:=inkey;j:=1.0;k:=0;x2:=0.0;b:=false;
\r
93 call move(350+7*k,330);
\r
98 if b then j:=j/10.0 fi;
\r
99 if i=46 then b:=true fi;
\r
104 y2:=x1;x1:=x2;x2:=y2;
\r
106 y2:=y1;if x2>28.0 then x2:=28.0 fi;if x1>28.0 then x1:=28 fi;
\r
107 call move(xconv_en_entier(x1),yconv_en_entier(y1));
\r
108 call draw(xconv_en_entier(x2),yconv_en_entier(y2));
\r
112 call outstring("entrer la valeur de l'abscisse : X= ");
\r
113 i:=inkey;j:=1.0;k:=0;x1:=0.0;b:=false;
\r
117 call move(350+7*k,290);
\r
122 if b then j:=j/10.0 fi;
\r
123 if i=46 then b:=true fi;
\r
126 x1:=x1*j;if x1>28 then x1:=28 fi;
\r
128 call outstring("entrer la valeur de l'ordonn
\82e1 : Y1= ");
\r
129 i:=inkey;j:=1.0;k:=0;y1:=0.0;b:=false;
\r
133 call move(350+7*k,310);
\r
138 if b then j:=j/10.0 fi;
\r
139 if i=46 then b:=true fi;
\r
144 call outstring("entrer la valeur de l'ordonn
\82e2 : Y2= ");
\r
145 i:=inkey;j:=1.0;k:=0;y2:=0.0;b:=false;
\r
149 call move(350+7*k,330);
\r
154 if b then j:=j/10.0 fi;
\r
155 if i=46 then b:=true fi;
\r
160 x2:=y1;y1:=y2;y2:=x2;
\r
162 x2:=x1;if y2>10 then y2:=10 fi;if y1>10 then y1:=10 fi;
\r
163 call move(xconv_en_entier(x1),yconv_en_entier(y1));
\r
164 call draw(xconv_en_entier(x2),yconv_en_entier(y2));
\r
168 call outstring(" ");
\r
170 call outstring(" ");
\r
172 call outstring(" ");
\r
174 call outstring(" ");
\r
178 (*************************************************************)
\r
179 (* La procedure tri, comme son nom l'indique, trie le tableau contenant
\r
180 tous les segments(tab) et met le r
\82sultat dans un autre tableau(t) *)
\r
182 unit tri:procedure(tb:arrayof segment;output ta:arrayof segment);
\r
183 var i,j,k,n:integer,t:arrayof integer;
\r
188 for i:=1 to n do t(i):=i od;
\r
193 if tb(i).y1>tb(j).y1 then
\r
198 if tb(i).y1=tb(j).y1 then
\r
199 if tb(i).x1>tb(j).x1 then
\r
208 ta(i):=new segment;
\r
211 call move(60,295);call color(9);
\r
212 call outstring("Fin du tri.");
\r
213 call move(60,310);call color(5);
\r
214 call outstring("Appuyer sur une touche pour voir ");call color(14);
\r
215 call outstring("les intersections
\82ventuelles. ");
\r
216 call move(60,325);call color(15);
\r
217 call outstring("Pour revenir au menu pr
\82c
\82dent, taper sur une nouvelle touche");
\r
220 (*************************************************************)
\r
221 (* Cette procedure est appel
\82\82e par la procedure intersection, si les conditions
\r
222 pour une intersection sont r
\82alis
\82es, pour tracer l'intersection *)
\r
224 unit trace:procedure(c:char,x,y,z:real);
\r
227 call point(xconv_en_entier(x),yconv_en_entier(y));
\r
230 call move(xconv_en_entier(x),yconv_en_entier(y));
\r
231 call draw(xconv_en_entier(z),yconv_en_entier(y));
\r
234 call move(xconv_en_entier(x),yconv_en_entier(y));
\r
235 call draw(xconv_en_entier(x),yconv_en_entier(z));
\r
239 (*************************************************************)
\r
240 (* La procedure parcours a pour but de traiter le tableau tri
\82 et si n
\82cessaire
\r
241 faire appel
\85 une de ses procedures(traitement, intersection) ou classe(arb) pour
\r
242 trouver toutes les intersections existantes *)
\r
244 unit parcours:procedure(tab:arrayof segment);
\r
245 (* La classe arb va servir
\85 traiter uniquement les segments verticaux *)
\r
247 var nb:integer,tv:arrayof segment;
\r
249 unit insertion:procedure(tab:arrayof segment,nb:integer;inout tv:arrayof segment);
\r
252 array tv dim(1:nb);j:=0;
\r
253 for i:=1 to upper(tab)
\r
255 if tab(i).sens=v then
\r
257 tv(j):=new segment;tv(j).sens:=v;
\r
258 tv(j).x1:=tab(i).x1;tv(j).y1:=tab(i).y1;
\r
259 tv(j).x2:=tab(i).x2;tv(j).y2:=tab(i).y2;
\r
264 unit Arb_parcours:procedure(vertical:arrayof segment);
\r
266 for i:=1 to upper(vertical)
\r
268 for j:=i+1 to upper(vertical)
\r
270 call intersection(vertical(i),vertical(j));
\r
276 (* La procedure intersection permet de v
\82rifier si les conditions d'intersection
\r
277 entre deux segments sont r
\82alis
\82es *)
\r
279 unit intersection:procedure(s1,s2:segment);
\r
282 if s1.sens=s2.sens then
\r
284 if s1.y1=s2.y1 then
\r
285 if s2.x2<=s1.x2 then
\r
286 call trace(h,s2.x1,s1.y1,s2.x2);
\r
288 call trace(h,s2.x1,s1.y1,s1.x2);
\r
291 if s1.x1=s2.x1 then
\r
292 if s2.y1<=s1.y2 then
\r
293 if s2.y2<=s1.y2 then
\r
294 call trace(v,s2.x1,s2.y1,s2.y2);
\r
296 call trace(v,s2.x1,s2.y1,s1.y2);
\r
299 if s1.y1>=s2.y1 and s1.y2<=s2.y2 then
\r
300 call trace('p',s2.x1,s1.y1,0);
\r
305 (* La procedure traitement parcours le tableau tri
\82 et r
\82alise un traitement
\r
306 diff
\82rent selon s'il s'agit d'un segment horizontal ou d'un segment vertical *)
\r
307 unit traitement: procedure(tab:arrayof segment);
\r
308 var i,j:integer,b:boolean;
\r
311 bst:=new arb;b:=false;bst.nb:=0;
\r
312 for i:=1 to upper(tab)
\r
314 if tab(i).sens=h then
\r
315 for j:=1 to upper(tab)
\r
318 if tab(i).x1<=tab(j).x1 then
\r
319 if tab(i).x2>=tab(j).x2 or tab(i).x2>=tab(j).x1 then
\r
320 call intersection(tab(i),tab(j));
\r
325 bst.nb:=bst.nb+1;b:=true;
\r
328 call bst.insertion(tab,bst.nb,bst.tv);
\r
329 if b then call bst.Arb_parcours(bst.tv) fi;
\r
332 call traitement(tab);
\r
335 (*************************************************************)
\r
336 (* Cette procedure r
\82alise le cadre dans lequel les segments,les intersections
\r
337 de segments et le dialogue avec l'utilisateur sont
\82cris *)
\r
338 unit graphisme:procedure;
\r
341 call color(10);call move(0,0);
\r
342 call hfill(640);call draw(0,250);
\r
343 call hfill(640);call move(639,0);
\r
344 call draw(639,349);call draw(0,349);
\r
345 call draw(0,250);call color(15);
\r
346 call move(40,10);call draw(40,210);
\r
350 call move(38,210-20*i);
\r
351 call draw(42,210-20*i);
\r
352 call move(28,210-i*20);
\r
356 call move(20,210-i*20);
\r
357 call hascii(48+i/10);
\r
358 call move(28,210-i*20);
\r
359 call hascii(i-entier(i/10)*10+48);
\r
362 call move(10,8);call outstring("Y");
\r
363 call move(26,215);call outstring("0");
\r
366 call move(40+i*20,212);
\r
367 call draw(40+i*20,208);
\r
368 call move(33+i*20,218);
\r
372 call hascii(48+i/10);
\r
373 call move(40+i*20,218);
\r
374 call hascii(i-entier(i/10)*10+48);
\r
377 call move(620,210);call outstring("X");
\r
380 (*************************************************************)
\r
381 (* La procedure souris permet la saisie des segments
\85 l'aide de la souris *)
\r
382 unit souris:procedure(output tab:arrayof segment);
\r
383 var i,j,n,h1,h2,v1,v2:integer,
\r
387 call move(40,260);call color(15);
\r
388 call outstring("Appuyer sur le bouton de gauche pour la premi
\8are coordonn
\82es");
\r
390 call outstring("puis sur le bouton de droite pour la seconde coordonn
\82es.");
\r
391 call move (40,300);
\r
392 call outstring("Appuyer sur entr
\82e pour continuer.");
\r
394 call move(40,260);call color(15);
\r
395 call outstring(" ");
\r
397 call outstring(" ");
\r
398 call move (40,300);
\r
399 call outstring(" ");
\r
401 unit click:procedure (output x,y,z,t:integer);
\r
402 var p:integer,l,r,c:boolean;
\r
404 call status(x,y,l,r,c);
\r
406 call getpress(0,x,y,p,l,r,c);
\r
408 call move(x,y);x:=inxpos;y:=inypos;call point(x,y);
\r
412 call status(z,t,l,r,c);
\r
414 call getpress(1,z,t,p,l,r,c);
\r
416 call move(z,t);z:=inxpos;t:=inypos;call point(z,t);
\r
425 call showcursor;call setwindow(40,600,10,210);
\r
426 call defcursor(1,12,13);call move(40,260);
\r
427 call outstring("Entrer le nombre de segments(12 au maximum) : ");
\r
428 i:=inkey;call hascii(i);n:=i-48;
\r
435 array tab dim(1:n);
\r
438 tab(i):=new segment;
\r
439 call move(40,280);call color(i);
\r
440 call outstring("Entrer le sens du segment (h/v) : ");
\r
441 j:=inkey;tab(i).sens:=chr(j);call hascii(0);
\r
442 if tab(i).sens=h then
\r
444 call click(tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
\r
445 tab(i).x1:=xconv_en_reel(tab(i).x1);
\r
446 tab(i).x2:=xconv_en_reel(tab(i).x2);
\r
447 tab(i).y1:=yconv_en_reel(tab(i).y1);
\r
448 tab(i).y2:=yconv_en_reel(tab(i).y2);
\r
449 tab(i).y2:=tab(i).y1;
\r
450 if tab(i).x1>tab(i).x2 then
\r
452 tab(i).x1:=tab(i).x2;
\r
455 call move(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));
\r
456 call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y2));
\r
459 call click(tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
\r
460 tab(i).x1:=xconv_en_reel(tab(i).x1);
\r
461 tab(i).x2:=xconv_en_reel(tab(i).x2);
\r
462 tab(i).y1:=yconv_en_reel(tab(i).y1);
\r
463 tab(i).y2:=yconv_en_reel(tab(i).y2);
\r
464 tab(i).x2:=tab(i).x1;
\r
465 if tab(i).y1>tab(i).y2 then
\r
467 tab(i).y1:=tab(i).y2;
\r
470 call move(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));
\r
471 call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y2));
\r
475 call move(100,200);call outstring(" NO M O U S E ");
\r
480 (*************************************************************)
\r
481 (* La procedure clavier est appel
\82e si le choix "saisie au clavier" est s
\82lectionner". *)
\r
483 unit clavier:procedure(output tab:arrayof segment);
\r
486 call graphisme;call move(40,260);
\r
487 call outstring("Entrer le nombre de segments(12 au maximum) : ");
\r
488 n:=inkey;call hascii(n);n:=n-48;
\r
489 j:=inkey;if j<>13 then
\r
493 array tab dim(1:n);
\r
496 tab(i):=new segment;
\r
497 call move(40,275);call color(i);
\r
498 call outstring("Entrer le sens du segment (h/v) : ");
\r
499 j:=inkey;tab(i).sens:=chr(j);call hascii(0);
\r
500 if tab(i).sens=h then
\r
502 call tab(i).saisie(tab(i).sens,tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
\r
505 call tab(i).saisie(tab(i).sens,tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);
\r
510 (*************************************************************)
\r
511 (* Menu principal *)
\r
512 unit menu:procedure;
\r
514 (* Sous-menu du choix num
\82ro 2 du menu principal *)
\r
515 unit menu2:procedure;
\r
519 call move(40,260);call outstring(" Choix du mode de saisie :");
\r
520 call move(80,275);call outstring("1- au clavier.");
\r
521 call move(80,290);call outstring("2- avec la souris.");
\r
522 call move(80,305);call outstring("3- retour au menu principal");
\r
523 call move(40,325);call outstring("Votre choix : ");
\r
524 choix:=inkey;call hascii(choix);choix:=choix-48;
\r
541 call move(150,325);
\r
542 call outstring("retour au menu principal");
\r
546 otherwise call menu2;
\r
550 unit choix_alea : procedure(output tab:arrayof segment);
\r
551 var nb_seg,nb_segh,nb_segv,i,j,k:integer,x1,x2,y1,y2:real;
\r
555 nb_seg:=2+entier(10*random);
\r
556 array tab dim (1:nb_seg);
\r
558 nb_segh:=entier(nb_seg*random);
\r
559 (* nombre de segments horizontaux *)
\r
560 for i:=1 to nb_segh
\r
562 y1:=10*random;y2:=y1;j:=j+1;call color(j);
\r
563 x1:=28*random;x2:=28*random;
\r
564 tab(j):=new segment;tab(j).sens:=h;
\r
565 tab(j).x1:=x1;tab(j).x2:=x2;
\r
566 tab(j).y1:=y1;tab(j).y2:=y2;
\r
567 if tab(i).x1>tab(i).x2 then
\r
568 k:=tab(i).x1;tab(i).x1:=tab(i).x2;tab(i).x2:=k;
\r
570 if tab(i).y1>tab(i).y2 then
\r
571 k:=tab(i).y1;tab(i).y1:=tab(i).y2;tab(i).y2:=k;
\r
573 call point(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));
\r
574 call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y1));
\r
576 nb_segv:=nb_seg-nb_segh;
\r
577 for i:=1 to nb_segv
\r
579 x1:=28*random;x2:=x1;j:=j+1;call color(j);
\r
580 y1:=10*random;y2:=10*random;
\r
581 tab(j):=new segment;tab(j).sens:=v;
\r
582 tab(j).x1:=x1;tab(j).x2:=x2;
\r
583 tab(j).y1:=y1;tab(j).y2:=y2;
\r
584 if tab(j).x1>tab(j).x2 then
\r
585 k:=tab(j).x1;tab(j).x1:=tab(j).x2;tab(j).x2:=k;
\r
587 if tab(j).y1>tab(j).y2 then
\r
588 k:=tab(j).y1;tab(j).y1:=tab(j).y2;tab(j).y2:=k;
\r
590 call point(xconv_en_entier(tab(j).x1),yconv_en_entier(tab(j).y1));
\r
591 call draw(xconv_en_entier(tab(j).x1),yconv_en_entier(tab(j).y2));
\r
596 call move(300,0);call color(10);call outstring("MENU");
\r
597 call move(60,60);call color(15);
\r
598 call outstring("1- choix al
\82atoire de segments.");
\r
600 call outstring("2- choix des segments par l'utilisateur.");
\r
601 call move(60,140);call outstring("3- fin du programme.");
\r
602 call move(60,220);call outstring("Votre choix :");
\r
603 choix:=inkey;call hascii(choix);choix:=choix-48;
\r
607 call choix_alea(tab);
\r
620 call outstring("FIN DU PROGRAMME");
\r
623 otherwise call menu;
\r
627 (*************************************************************)
\r
628 (* Programme principal *)
\r