 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).ordo<g(min).ordo then
     min:=i;
    fi;
   od;
   for i:=2 to n do    
    if g(i).ordo>g(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).ordo<ge(min).ordo then
   min:=i;
   fi;
   od;
   t:=ge(1);ge(1):=ge(min);ge(min):=t;
    gtr(1):=new point(ge(1),0);
   for i:=2 to n do  (* calcul de l'angle associe a chaque point *)
    variable:=new pixl (ge(i).ab-ge(1).ab,ge(i).ordo-ge(1).ordo);
    elem:=angle_montant(variable);
    gtr(i):=new point (ge(i),elem); (* tous les points sont maintenant dans 
                                       un tableau pour chacun nous possedons 
                                       un angle avec l'horizontale.        *)
   od; 
   end recuperer; 

   (*******************************************************************)
   (* function associe au tri par insertion dichotomique elle renvoie *)
   (* l'indice ou l'on inserera les valeurs a leur juste place.       *)
   (*******************************************************************) 
   unit rang:function(input gtr:arrayof point,p,q:integer,x:point):integer;
    var 
      mil:integer; 
    begin
     if p=q then 
       result:=p; 
     else
      mil:=(p+q) div 2;
      if x.teta<gtr(mil).teta then
         result:=rang(gtr,p,mil,x);
      else
         result:=rang(gtr,mil+1,q,x);
      fi;
     fi;
    end rang; 
   (*********************************************************************)
   (* fonction effectuant un tri par insertion dichotomique nous        *)
   (* obtiendrons ainsi un tableau trie sur la valeur de l'angle associe*)
   (* a chaque point et cela dans le sens croissant.                    *)
   (*********************************************************************)
   unit tri_insert_dicho:procedure(inout gtr:arrayof point;input i:integer);
    var j,k:integer,x:point;
     begin
      if  i>1 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.





