program hull; (*******************************************************************) (* OUTILS CONCERNANT L'AFFICHAGE DU TEXTE A L'ECRAN *) (*******************************************************************) (* Efface l'ecran et positionne le curseur en haut a gauche *) UNIT CLS : PROCEDURE; BEGIN WRITE( chr(27), "[2J"); END CLS; (* Affiche du texte en video inverse *) UNIT Reverse : PROCEDURE; BEGIN WRITE( chr(27), "[7m"); END Reverse; (* Affiche du texte en clignotant *) UNIT Blink : PROCEDURE; BEGIN WRITE( chr(27), "[5m"); END Blink; (* Affiche le texte de maniere normale *) UNIT Normal : PROCEDURE; BEGIN WRITE( chr(27), "[0m") END Normal; (* Positionne le curseur sur un emplacement de l'ecran *) UNIT Setcursor : PROCEDURE (row,column : INTEGER); VAR c,d,e,f : CHAR, i,j : INTEGER; BEGIN i:=row div 10; j:=row mod 10; c:=chr(48+i); d:=chr(48+j); i:=column div 10; j:=column mod 10; e:=chr(48+i); f:=chr(48+j); Write(chr(27), "[",c,d, ";",e,f, "H"); END Setcursor; (* Unite qui sert a tracer un cadre *) unit cadre: procedure (x1,y1,x2,y2 : integer); var i , j : integer; Begin for i := x1 to x2 do call setcursor(i,y1); write("*"); od; for i := x1 to x2 do call setcursor(i,y2); write ("*"); od; for i := y1 to y2 do call setcursor(x1,i); write ("*"); od; for i := y1 to y2 do call setcursor(x2,i); write ("*"); od; End cadre; (**************************** CADRE_T **********************************************) unit cadre_t : procedure; begin call cls; call cadre (1,1,30,85); call cadre (2,20,4,70); call setcursor (3,40); CALL reverse; write ("ENVELOPPE CONVEXE "); CALL normal; end cadre_t; (************************** FIN CADRE_T *********************************************) (*************************** PRESENTS_1*********************************************) unit presents_1 : procedure; begin call cadre_t; call setcursor (10,40); write (" projet realise par : "); call setcursor (10,60); Write (" JOUANNY jean-pierre "); call setcursor(14,40); Write (" LICENCE INFORMATIQUE "); end presents_1; (************************** FIN PRESENTS_1 *****************************************) (***************************** MENU *************************************************) unit menu : procedure; begin call cls; call setcursor(10,30); write("1 : PACKED WRAPPING"); CALL SETCURSOR(12,30); WRITE("2 : GRAHAM_SCAN"); CALL SETCURSOR(14,30); WRITE("3 : SORTIR"); CALL CADRE(30,1,32,80); CALL SETCURSOR(34,30); WRITE("ACTION : ") END MENU; (************************** FIN MENU **********************************************) (* unit exprimant un point en coordonnees cartesiennes*) unit pixl:class(ab,ordo:real);end pixl; (* unit exprimant un point en coordonnees polaires *) unit point:class(p:pixl,teta:real); end point; (***********************************************************) (* unit qui permettra a l utilisateur de saisir des points *) (***********************************************************) unit lecture:function(i:integer):pixl; begin result:=new pixl(0,0); call cls; call setcursor(10,30); write("entrez l'abcisse n:",i,":" ); read (result.ab); call setcursor(15,30); write("entrez l'ordonnee n:",i,":" ); read(result.ordo); end lecture; (***********************************************************) (*unit graphe est une classe qui contiendra les procedures *) (* et les fonctions destinees dans le cadre de la methode *) (* de "package wrapping" ou enveloppe a calculer les points*) (* de l'enveloppe convexe *) (***********************************************************) unit graphe:class(function readelem(i:integer):pixl); (***********************************************************) (* unit lire est destinee a initialiser le tableau qui *) (* contiendra les points du nuage. *) (***********************************************************) unit lire:procedure(output g:arrayof pixl;input n:integer); var i:integer; begin array g dim(1:100); (* initialisation du tableau de sortie *) for i:=1 to n do g(i):=readelem(i); (* utilisation de la fonction readelem passee comme parametre d'entree dans la classe graphe. *) od; end lire; (******************************************************************) (* cette fonction est destinee a convertir les gradients en degre *) (******************************************************************) unit degre:function(x:real):real; begin result:=(x/3.14)*180; end degre; (******************************************************************) (* cette fonction appelee "angle_montant" calcule a partir des *) (* coordonnees d'un point l'angle que ce dernier formera avec *) (* l'horizontale. *) (******************************************************************) unit angle_montant:function(variable:pixl):real; var distance:integer,pi,teta:real; begin pi:=3.14; if variable.ab=0 then result:=degre(pi/2); else teta:=atan((variable.ordo)/(variable.ab)); (*la fonction arc tangente permet a partir du rapport cote oppose sur cote adjacent de donner l'angle en radient. *) if variable.ordo>0 then if (variable.ab <0) then result:=degre(pi+teta); (*transformation de l'angle negatif en sa valeur positive d'angle obtus. *) else result:=degre(teta); fi; else if variable.ab<0 then result:=degre(pi+teta); else result:=degre(2*pi+teta); fi; fi fi; end angle_montant; (********************************************************************) (* cette fonction determine de bas en haut les points appartenant a *) (* l'enveloppe convexe. *) (********************************************************************) unit calcul_montant:procedure(output gt:arrayof pixl;inout cpt:integer, fini:boolean,h:integer;input n:integer;inout g:arrayof pixl); var max,lowest,pi:real,min,i,value,p,maxi:integer,variable,pas:pixl; begin array gt dim(1:100); (* initialisation des tableaux de sortie *) h:=1; min:=1; max:=1; fini:=false; for i:=2 to n do (*recherche du point d'ordonnee minimal a partir duquel s'effectuera la recherche des autres points de la partie montante de l'enveloppe convexe. *) if g(i).ordog(max).ordo then max:=i; fi; od; pas:=g(max); gt(h):=g(min); while not fini do maxi:=360; if n<=1 then exit; fi; for i:=1 to n do variable:=new pixl (g(i).ab-gt(h).ab,g(i).ordo-gt(h).ordo); lowest:=angle_montant(variable); if maxi>lowest then maxi:=lowest; value:=i; fi; od; h:=h+1; (* on enregistre dans gt les points qui formeront l'enveloppe convexe.*) min:=value; gt(h):=g(min); g(min):=g(n); n:=n-1; if gt(h)=pas then cpt:=n; fini:=true; exit; fi; od; end calcul_montant; (***********************************************************************) (*cette fonction permet de calculer a partir des coordonnees d'un point*) (* l'angle que ce dernier formera avec l'horizontale. *) (***********************************************************************) unit angle_descendant:function(variable:pixl):real; var pi,teta:real; begin pi:=3.14; if variable.ab=0 then if variable.ordo>0 then result:=400; else result:=degre(3*pi/2); fi; else teta:=atan((variable.ordo)/(variable.ab)); if variable.ordo>0 then result:=400; (* afin de ne pas selectionner un point qui serait responsable d'une concavite. *) else if variable.ab<0 then result:=degre(teta+pi); else result:=degre(2*pi+teta); fi; fi; fi; end angle_descendant; (*********************************************************************) (* cette fonction determine de haut en bas les points appartenant a *) (* l'enveloppe convexe. *) (*********************************************************************) unit calcul_descendant:procedure(inout gt:arrayof pixl;input g:arrayof pixl, n:integer;inout h:integer); var p,i,max,value:integer,lowest:real,termine:boolean,variable:pixl; begin termine:=false; if n<1 then exit fi; while not termine do max:=720; for i:=1 to n do (*les points qui seront sur l'enveloppe convexe de la partie descendante devront avoir l'angle compris entre le segment joignant la base a eux memes et l'horizontale passant par la base ,le plus petit qui soit dans l'intervalle [180,360]. *) variable:=new pixl(g(i).ab-gt(h).ab,g(i).ordo-gt(h).ordo); lowest:=angle_descendant(variable); if max>lowest then max:=lowest; value:=i; fi; od; h:=h+1; (* on enregistre dans gt les nouveaux points de l'enveloppe *) gt(h):=g(value); g(value):=g(n); n:=n-1; if n<1 then (* si nous n'avons plus qu'un point dans le tableau d'entree nous avons termine*) termine:=true; else if gt(h)=gt(1) then (* si nous retombons sur le premier point cela est fini. *) exit; fi; fi; od; end calcul_descendant; unit dessin:procedure(input gt:arrayof pixl,h:integer, gu:arrayof pixl,nb:integer,vrai:boolean); var i:integer; begin pref iiuwgraph block begin call hpage(0,0,0); call hpage(0,1000,500); call gron(0); call move(0,250); call draw(1000,250); call move(500,0); call draw(500,500); for i:=1 to nb do call point(gu(i).ab,gu(i).ordo); od; call move(10*gt(1).ab+500,10*(-gt(1).ordo)+250); for i:=2 to h do call draw(10*(gt(i).ab)+500,10*(-gt(i).ordo)+250); od; if vrai then call draw(10*(gt(1).ab)+500,10*(-gt(1).ordo)+250); fi; readln; end; end dessin; end graphe; (******************************************************************************) (* unit graphe2 est une classe qui herite de la classe graphe ,elle contiendra*) (* les procedures et les fonctions destinees dans le cadre de la methode dite *) (* de Graham_scan a calculer les points constituant l'enveloppe convexe d'un *) (* nuage de points donnes en entree. *) (******************************************************************************) unit graphe2: graphe class; (* classe qui permet de definir une droite c'est a dire deux points *) unit line:class(p1:pixl,p2:pixl); end line; (*******************************************************************************) (* procedure qui en entree recoit des points en coordonnees cartesiennes et qui*) (* leur associe un angle en plus en sortie,nous avons donc des coordonnees *) (* polaires. *) (*******************************************************************************) unit recuperer:procedure(input ge:arrayof pixl;inout gtr:arrayof point;n:integer); var variable,t:pixl,min,i:integer,elem:real; begin min:=1; for i:=2 to n do (* recherche du point d'ordonnee minimal,qui desormais sera la base du nouveau repere. *) if ge(i).ordo1 then call tri_insert_dicho(gtr,i-1); if gtr(i-1).teta>gtr(i).teta then k:=rang(gtr,1,i-1,gtr(i)); x:=gtr(i); for j:=i-1 downto k do gtr(j+1):=gtr(j); od; gtr(k):=x; fi; fi; end tri_insert_dicho; (**********************************************************************) (* fonction qui calcule un double determinant cela afin de savoir si *) (* deux droites se trouvent ou non de part et d'autre d'une premiere *) (* droite. *) (**********************************************************************) unit same:function (l:line;p1,p2:pixl):real; var dx,dy,dx1,dx2,dy1,dy2:integer; begin dx:=l.p2.ab-l.p1.ab; dy:=l.p2.ordo-l.p1.ordo; dx1:=p1.ab-l.p1.ab; dy1:=p1.ordo-l.p1.ordo; dx2:=p2.ab-l.p2.ab; dy2:=p2.ordo-l.p2.ordo; result:=(dx*dy1-dy*dx1)*(dx*dy2-dy*dx2); end same; (***********************************************************************) (* Graham scan determine ou non si un point appartient a l'enveloppe *) (* convexe cela a l'aide du resultat de same.Si same est positif p[k] *) (* appartient a l'enveloppe car la droite (p[k],p[k-1]) ne coupe pas *) (* la droite (p[1],p[i]) ou p[i] est le point nouveau de l'enveloppe *) (* et p[1] la base du repere ici,le point d'ordonnee le plus bas. *) (***********************************************************************) unit graham_scan:procedure(ge:arrayof pixl,n:integer;output gtr:arrayof point; output m:integer); var cpt,i,j:integer,l:line,t:point; begin array gtr dim(1:n); call recuperer(ge,gtr,n); call tri_insert_dicho(gtr,n); m:=2; for i:=4 to n do m:=m+2; do m:=m-1; l:=new line(gtr(m).p,gtr(m-1).p); cpt:=same(l,gtr(1).p,gtr(i).p); if cpt>=0 then exit; fi; od; t:=gtr(m+1); gtr(m+1):=gtr(i); gtr(i):=t; od; end graham_scan; end graphe2; (* fin de la classe graphe2 et de la partie programmation *) (**** PROGRAMME PRINCIPAL ****) var gt,g,genv,ge,gen,gu:arrayof pixl,nuage:graphe,nuage1:graphe2,n,cpt,h, m:integer, fini,vrai:boolean,toucher,ch:char, gtr:arrayof point,rep,rep_1,rep_3,i,j,nb:integer,rep_2:char; begin array gu dim(1:100); array genv dim(1:100); call presents_1; read(toucher); call cls; h:=0; nb:=0; cpt:=0; do call menu; read(rep); case rep when 1: call cls; vrai:=false; call setcursor(6,40); write(" PACKAGE WRAPPED "); call setcursor(34,20); write ("indiquez le nombre de points a saisir:"); read(n); nb:=n; nuage:=new graphe(lecture); call nuage.lire(g,n); for i:=1 to nb do gu(i):=g(i); gu(i):=new pixl(10*(gu(i).ab)+500,10*(-gu(i).ordo)+250); od; call nuage.calcul_montant(gt,cpt,fini,h,n,g); if fini then call nuage.calcul_descendant(gt,g,cpt,h); fi; writeln("POINTS QUI COMPOSENT L'ENVELOPPE"); for i:=1 to h do writeln(gt(i).ab,gt(i).ordo); od; writeln("tapez entree pour en voir la representation graphique"); readln; call nuage.dessin(gt,h,gu,nb,vrai); readln; call setcursor(34,20); write("tapez entree pour la suite"); read(rep_1); exit; when 2: call cls; vrai:=true; call setcursor(6,40); write (" GRAHAM_SCAN "); call cadre (33,1,35,99); call setcursor (34,20); write ("Nombre de points du nuage "); read(n); nb:=n; nuage1:=new graphe2(lecture); call nuage1.lire(ge,n); for i:=1 to nb do gu(i):=ge(i); gu(i):=new pixl(10*(gu(i).ab)+500,10*(-gu(i).ordo)+250); od; call nuage1.graham_scan(ge,n,gtr,m); writeln("POINTS QUI COMPOSENT L'ENVELOPPE"); for i:=1 to m do writeln(gtr(i).p.ab,gtr(i).p.ordo); genv(i):=new pixl(gtr(i).p.ab,gtr(i).p.ordo); od; writeln("tapez entree pour en voir la representation graphique"); call nuage1.dessin(genv,m,gu,nb,vrai); call setcursor(34,20); write ("tapez entree pour revenir au sommaire"); read(rep_3); while rep_3 =/=13 do read(rep_3); od; exit; when 3: call cadre_t; call setcursor(6,40); write("Adieu a l'enveloppe convexe"); call cadre (33,1,35,99); call setcursor(13,25); write ("Etes vous decides"); read (rep_2); while (rep_2=/='o') and (rep_2=/='O') do call setcursor(13,50); read(rep_2); od; call cls; exit; esac; od; end.