3 (* BAYEUL St
\82phane Licence Informatique Groupe 1 *)
\r
5 VAR p : ARRAYOF points,
\r
6 taille,i,j,n,O12,guziki,c : INTEGER,
\r
7 choix,souris,valeur,chaine : ARRAYOF CHAR,
\r
9 inst,quitter : BOOLEAN;
\r
12 (***********************************************************************)
\r
13 UNIT POINTS : CLASS;
\r
14 (***********************************************************************)
\r
19 (***********************************************************************)
\r
21 (***********************************************************************)
\r
25 (***********************************************************************)
\r
26 UNIT NEWPAGE : PROCEDURE;
\r
27 (***********************************************************************)
\r
29 WRITE ( CHR (27), "[2J");
\r
32 (***********************************************************************)
\r
33 UNIT SETCURSOR : PROCEDURE (ROW,COLUMN : INTEGER);
\r
34 (***********************************************************************)
\r
46 WRITE ( CHR (27), "[", c, d, ";", e, f, "H");
\r
49 (***********************************************************************)
\r
50 UNIT TRANSENTIER : PROCEDURE (INPUT chaine : ARRAYOF char;
\r
51 OUTPUT nbr : INTEGER);
\r
52 (***********************************************************************)
\r
54 (* TRANSFORME UNE CHAINE DE CARACTERES EN UN ENTIER *)
\r
59 FOR i := 1 to UPPER (chaine) DO
\r
61 WHEN '0','1','2','3','4','5','6','7','8','9' :
\r
62 nbr := (nbr*10)+(ord(chaine(i))-48);
\r
67 (***********************************************************************)
\r
68 UNIT FILL : PROCEDURE (X,Y,Large,Haut,Col:INTEGER) ;
\r
69 (***********************************************************************)
\r
73 PREF IIUWGRAPH BLOCK
\r
79 CALL DRAW(X+Large,I) ;
\r
84 (***********************************************************************)
\r
85 UNIT TEXTE : PROCEDURE (X,Y : INTEGER;
\r
87 (***********************************************************************)
\r
89 (* Saisie d'un string en colonne X et ligne Y *)
\r
92 PREF IIUWGRAPH BLOCK
\r
99 (***********************************************************************)
\r
100 UNIT SAISIECHAINE : PROCEDURE (INPUT Col,Lig : INTEGER;
\r
101 OUTPUT Valeur : ARRAYOF CHAR);
\r
102 (***********************************************************************)
\r
104 (* Saisie d'une chaine de caract
\8ares en graphique *)
\r
106 VAR C,I,X : INTEGER;
\r
109 PREF IIUWGRAPH BLOCK
\r
111 ARRAY VALEUR DIM (1:5);
\r
120 CALL TEXTE (X,LIG-4," ");
\r
122 CALL TEXTE (X,LIG,"-");
\r
124 CALL MOVE (X,LIG-4) ;
\r
125 IF (C=13) THEN CALL MOVE (X,LIG-4);CALL HASCII(0);EXIT; FI;
\r
130 CALL MOVE (X,LIG-4);
\r
132 CALL TEXTE (X,LIG," ");
\r
133 CALL MOVE (X,LIG-4);
\r
139 VALEUR (i) := CHR (C);
\r
144 CALL TEXTE(105,258,"Chaine trop longue ");
\r
145 CALL TEXTE(105,274,"Appuyez sur une touche pour continuer");
\r
146 WHILE INKEY=0 DO OD;
\r
147 CALL FILL (101,251,398,58,0) ;
\r
154 (***********************************************************************)
\r
155 UNIT TAB_PREDEFINI : PROCEDURE;
\r
156 (***********************************************************************)
\r
158 (******************************************************)
\r
159 (* 0 <= X >= 52 et 0 <= Y >= 26 *)
\r
160 (******************************************************)
\r
162 ARRAY p DIM (0:taille+1);
\r
163 FOR i:=0 TO taille+1 DO
\r
164 p(i) := NEW points;
\r
166 p(1).x:=3 ;p(1).y:=9 ;p(1).z:='A' ;p(2).x:=11 ;p(2).y:=1 ;p(2).z:='B' ;
\r
167 p(3).x:=6 ;p(3).y:=8 ;p(3).z:='C' ;p(4).x:=4 ;p(4).y:=3 ;p(4).z:='D' ;
\r
168 p(5).x:=5 ;p(5).y:=15 ;p(5).z:='E' ;p(6).x:=8 ;p(6).y:=11 ;p(6).z:='F' ;
\r
169 p(7).x:=1 ;p(7).y:=6 ;p(7).z:='G' ;p(8).x:=7 ;p(8).y:=4 ;p(8).z:='H' ;
\r
170 p(9).x:=9 ;p(9).y:=7 ;p(9).z:='I' ;p(10).x:=14;p(10).y:=5 ;p(10).z:='J';
\r
171 p(11).x:=10;p(11).y:=13;p(11).z:='K';p(12).x:=15;p(12).y:=14;p(12).z:='L';
\r
172 p(13).x:=15;p(13).y:=2 ;p(13).z:='M';p(14).x:=13;p(14).y:=16;p(14).z:='N';
\r
173 p(15).x:=2 ;p(15).y:=12;p(15).z:='O';p(16).x:=12;p(16).y:=10;p(16).z:='P';
\r
174 p(0):=p(16);p(17):=p(1);
\r
177 (***********************************************************************)
\r
178 UNIT SAISIE_SOURIS : MOUSE PROCEDURE;
\r
179 (***********************************************************************)
\r
180 VAR h,v,t,b,nbr : INTEGER,
\r
181 l,r,c,fin : BOOLEAN;
\r
183 PREF IIUWgraph BLOCK
\r
185 CALL cls; CALL affiche_grille;
\r
187 inst := INIT (guziki);
\r
189 CALL TEXTE(100,100,"Erreur d'installation de la souris");EXIT;
\r
191 CALL DEFCURSOR (1,11,12);
\r
193 CALL STATUS (h,v,l,r,c);
\r
196 WHILE NOT fin AND nbr<=taille DO
\r
197 CALL GETPRESS (b,h,v,t,l,r,c);
\r
199 IF 0 <= h DIV 012 ANDIF h DIV O12 <= (640-11) DIV O12 ANDIF
\r
200 0 <= (316-v) DIV O12 ANDIF (316-v) DIV O12 <= 319 DIV O12 THEN
\r
201 (* COORDONNEES VALABLES *);
\r
202 p(nbr) := NEW points;
\r
203 p(nbr).x := h DIV O12;
\r
204 p(nbr).y := (316-v) DIV O12;
\r
205 p(nbr).z := CHR (64+nbr);
\r
207 CALL MOVE (p(nbr).x*O12+9,316-(p(nbr).y*O12));
\r
208 CALL HIDECURSOR ; CALL COLOR (2);
\r
209 CALL HASCII (ord(p(nbr).z));
\r
210 CALL SHOWCURSOR ; CALL COLOR (3);
\r
211 FOR i:=1 TO 3000 DO OD;
\r
213 ELSE (* COORDONNEES NON VALABLES *);
\r
214 CALL GETPRESS (b,h,v,t,l,r,c);
\r
218 p(0) := p(taille); p(taille+1) := p(1);
\r
223 (***********************************************************************)
\r
224 UNIT SAISIE_POINTS : IIUWgraph PROCEDURE;
\r
225 (***********************************************************************)
\r
230 CALL TEXTE (100,230," 0 <= X >= 52 et 0 <= Y >= 26 ");
\r
231 FOR i:=1 TO taille DO
\r
232 p(i) := NEW points;
\r
234 WHILE NOT valable DO
\r
236 CALL TEXTE (100,240,"Abscisses du point nø : ");
\r
237 CALL TEXTE (100,250,"Ordonn
\82es du point nø : ");
\r
239 CALL MOVE (290,240);CALL HASCII (64+i);
\r
240 CALL MOVE (290,250);CALL HASCII (64+i);
\r
242 CALL SAISIECHAINE (350,244,chaine);
\r
243 CALL TRANSENTIER (chaine,p(i).x);
\r
244 CALL SAISIECHAINE (350,254,chaine);
\r
245 CALL TRANSENTIER (chaine,p(i).y);
\r
246 IF p(i).x<0 ORIF p(i).x > ((640-11) DIV O12) THEN
\r
248 ELSE IF p(i).y<0 ORIF p(i).y > (319 DIV O12) THEN
\r
250 ELSE valable := TRUE;
\r
253 p(i).z := CHR (64+i);
\r
254 CALL TEXTE (290,254," ");
\r
255 CALL TEXTE (290,244," ");
\r
258 p(0) := p(taille); p(taille+1) := p(1);
\r
261 (***********************************************************************)
\r
262 UNIT AFFICHE_GRILLE : mouse PROCEDURE;
\r
263 (***********************************************************************)
\r
266 PREF IIUWgraph BLOCK
\r
267 BEGIN (* Graduations *)
\r
269 FOR i := 11 STEP O12 TO 640 DO
\r
270 CALL TEXTE (i,314,".");
\r
272 FOR i := 315 STEP O12 DOWNTO 0 DO
\r
273 CALL TEXTE (11,i,".");
\r
275 CALL TEXTE (8,16,"Y");
\r
276 CALL TEXTE (8,26,"^");
\r
277 CALL TEXTE (614,316,"> X");
\r
278 CALL MOVE (618,319);
\r
279 CALL DRAW (11,319); (* Ligne horizontale *)
\r
280 CALL DRAW (11,26); (* Ligne verticale *)
\r
282 END affiche_grille;
\r
284 (***********************************************************************)
\r
285 UNIT THETA : FUNCTION(P1,P2 : POINTS): REAL;
\r
286 (***********************************************************************)
\r
287 VAR dx,dy,ax,ay : INTEGER,
\r
290 dx := p2.x - p1.x; ax := ABS (dx);
\r
291 dy := p2.y - p1.y; ay := ABS (dy);
\r
292 IF (dx=0) AND (dy=0) THEN
\r
294 ELSE t := dy/(ax+ay);
\r
305 (***********************************************************************)
\r
306 UNIT WRAP : PROCEDURE (INOUT N : INTEGER);
\r
307 (***********************************************************************)
\r
308 VAR j,i,min,m : INTEGER,
\r
310 t,tb,p1,p2,prec : points,
\r
313 min :=1 ; tb := NEW points; t := NEW points;
\r
314 p1 := NEW points; p2 := NEW points;
\r
315 ligne := NEW line ; prec := NEW points;
\r
316 (* Choix du premier point *)
\r
317 FOR i := 2 TO taille DO
\r
318 IF p(i).y<p(min).y THEN
\r
320 ELSE IF p(i).y=p(min).y THEN
\r
321 IF p(i).x>p(min).x THEN
\r
327 (* Initialisations *)
\r
328 m := 0; p(taille+1) := p(min); minangle := 0.0;
\r
329 (* Boucle de Recherche *)
\r
331 m:=m+1 ; t:=p(m) ; p(m):=p(min) ;p(min):=t;
\r
332 min:=taille+1; v:=minangle; minangle:=360.0;
\r
333 FOR i:=m+1 TO taille+1 DO
\r
334 (* Recherche du plus petit angle *)
\r
335 IF theta (p(m),p(i))>v THEN
\r
336 (* Recherche du point suivant *)
\r
337 IF theta (p(m),p(i)) < minangle THEN
\r
338 min := i; minangle := theta (p(m),p(min));
\r
340 (* Cas ou plusieurs points sont alignes *)
\r
341 IF theta (p(m),p(i)) = minangle ANDIF p(min)<>p(i) THEN
\r
342 ligne.p1 := p(m); ligne.p2 := p(min);
\r
343 IF NOT on (ligne,p(i)) THEN
\r
344 min := i; minangle := theta (p(m),p(min));
\r
349 IF min = taille+1 THEN EXIT;
\r
355 (***********************************************************************)
\r
356 UNIT ON : FUNCTION (L:LINE;P1:POINTS):BOOLEAN;
\r
357 (***********************************************************************)
\r
360 IF (l.p1.x=p1.x) THEN
\r
361 IF l.p1.y>=p1.y ANDIF p1.y>=l.p2.y THEN
\r
363 ELSE IF l.p2.y>=p1.Y ANDIF p1.Y>=l.p1.y THEN
\r
368 IF (l.p1.y=p1.Y) THEN
\r
369 IF l.p1.x<=p1.x ANDIF p1.x<=l.p2.x THEN
\r
371 ELSE IF l.p2.x<=p1.x ANDIF p1.X<=l.p1.x THEN
\r
379 (***********************************************************************)
\r
380 UNIT AFFICHE_ENVELOPPE : IIUWgraph PROCEDURE;
\r
381 (***********************************************************************)
\r
388 CALL MOVE ((p(i).x*O12)+ O12,316-(p(i).y*O12)+O12 DIV 4);
\r
389 CALL DRAW ((p(i+1).x*O12)+ O12,316-(p(i+1).y*O12)+O12 DIV 4);
\r
391 CALL MOVE ((p(n).x*O12)+ O12,316-(p(n).y*O12)+O12 DIV 4);
\r
392 CALL DRAW ((p(1).x*O12)+ O12,316-(p(1).y*O12)+O12 DIV 4);
\r
396 CALL TEXTE (50,335,"L'enveloppe convexe est :");
\r
398 CALL MOVE (300+(i*10),335);
\r
399 CALL HASCII (ord(p(i).z));
\r
402 CALL TEXTE (150,325,"Appuyez sur ENTREE pour continuer");
\r
407 END affiche_enveloppe;
\r
409 (***********************************************************************)
\r
410 (* Programme principal *)
\r
411 (***********************************************************************)
\r
413 PREF IIUWgraph BLOCK
\r
418 WHILE NOT quitter DO
\r
419 CALL CLS; CALL COLOR (1);
\r
420 CALL TEXTE (100,10,"ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");
\r
421 CALL TEXTE (100,20,"³ Enveloppe convexe ³");
\r
422 CALL TEXTE (100,30,"ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ");
\r
424 CALL TEXTE (80,100,"Voulez_vous : aisir des points");
\r
425 CALL TEXTE (80,110," tiliser des points pr
\82d
\82finis");
\r
426 CALL TEXTE (80,120," uitter");
\r
428 CALL MOVE (192,100);CALL OUTSTRING("S");
\r
429 CALL MOVE (192,110);CALL OUTSTRING("U");
\r
430 CALL MOVE (192,120);CALL OUTSTRING("Q");
\r
432 CALL TEXTE (80,140,"Votre choix : ");
\r
433 CALL SAISIECHAINE (190,144,choix);
\r
435 WHILE choix(1)<>'u' AND choix(1)<>'s' AND choix(1)<>'q' AND
\r
436 choix(1)<>'U' AND choix(1)<>'S' AND choix(1)<>'Q' DO
\r
437 CALL SAISIECHAINE (190,144,choix);
\r
440 WHEN 'u','U' : CALL tab_predefini;
\r
441 WHEN 's','S' : CALL TEXTE (100,200,
\r
442 "Combien de points voulez_vous saisir :");
\r
443 CALL SAISIECHAINE (420,204,chaine);
\r
444 CALL TRANSENTIER (chaine,taille);
\r
445 ARRAY p DIM (0:taille+1);
\r
446 CALL TEXTE (100,210,
\r
447 "Voulez-vous utiliser la souris (o/n) ?");
\r
448 CALL SAISIECHAINE (410,214,souris);
\r
449 WHILE souris(1)<>'O' AND souris(1)<>'N'
\r
450 AND souris(1)<>'o' AND souris(1)<>'n' DO
\r
451 CALL SAISIECHAINE (410,214,souris);
\r
453 IF souris(1)='N' ORIF souris(1)='n' THEN
\r
454 CALL saisie_points;
\r
455 ELSE CALL saisie_souris;
\r
457 WHEN 'q','Q' : quitter:=TRUE;CALL GROFF; EXIT;
\r
461 FOR i:=1 TO taille DO
\r
462 CALL MOVE (p(i).x*O12+9,316-(p(i).y*O12));
\r
463 CALL HASCII (ord(p(i).z));
\r
465 CALL affiche_grille;
\r
467 CALL affiche_enveloppe;
\r
468 FOR i:=0 TO taille+1 DO KILL (p(i));OD;
\r