PROGRAM convexhull;

            (* BAYEUL St‚phane Licence Informatique Groupe 1 *)

VAR p                          : ARRAYOF points,
    taille,i,j,n,O12,guziki,c  : INTEGER,
    choix,souris,valeur,chaine : ARRAYOF CHAR,
    ligne                      : LINE,
    inst,quitter               : BOOLEAN;


(***********************************************************************)
           UNIT POINTS : CLASS;
(***********************************************************************)
VAR x,y : INTEGER,
      z : CHAR;
END points;

(***********************************************************************)
           UNIT LINE : CLASS;
(***********************************************************************)
VAR p1,p2 : points;
END line;

(***********************************************************************)
           UNIT NEWPAGE : PROCEDURE;
(***********************************************************************)
BEGIN
   WRITE ( CHR (27), "[2J");
END newpage;

(***********************************************************************)
           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;

(***********************************************************************)
            UNIT TRANSENTIER : PROCEDURE (INPUT  chaine : ARRAYOF char;
                                          OUTPUT nbr    : INTEGER);
(***********************************************************************)

            (* TRANSFORME UNE CHAINE DE CARACTERES EN UN ENTIER *)

VAR i : INTEGER;
BEGIN
  nbr := 0;
  FOR i := 1 to UPPER (chaine) DO
    CASE chaine(i)
    WHEN '0','1','2','3','4','5','6','7','8','9' :
                        nbr := (nbr*10)+(ord(chaine(i))-48);
    ESAC;
  OD;
END transentier;

(***********************************************************************)
           UNIT FILL : PROCEDURE (X,Y,Large,Haut,Col:INTEGER) ;
(***********************************************************************)

VAR I : INTEGER ;
BEGIN
  PREF IIUWGRAPH BLOCK
       BEGIN
            CALL COLOR (Col) ;
            FOR I:=Y TO Y+Haut
            DO
              CALL MOVE(X,I) ;
              CALL DRAW(X+Large,I) ;
            OD ;
       END ;
END FILL;

(***********************************************************************)
           UNIT TEXTE : PROCEDURE (X,Y : INTEGER;
                                   S   : STRING);
(***********************************************************************)

           (*  Saisie d'un string en colonne X et ligne Y  *)

BEGIN
   PREF IIUWGRAPH BLOCK
   BEGIN
        CALL MOVE (X,Y);
        CALL OUTSTRING(s);
   END ;
END Texte;

(***********************************************************************)
           UNIT SAISIECHAINE : PROCEDURE (INPUT Col,Lig : INTEGER;
                                          OUTPUT Valeur : ARRAYOF CHAR);
(***********************************************************************)

         (*  Saisie d'une chaine de caractŠres en graphique  *)

VAR C,I,X   : INTEGER;

BEGIN
PREF IIUWGRAPH BLOCK
BEGIN
    ARRAY VALEUR DIM (1:5);
    X := COL;
    C := 0;
    I := 1;
    DO
      C := 0 ;
      WHILE C = 0
      DO
        CALL COLOR (12) ;
        CALL TEXTE (X,LIG-4," ");
        C := INKEY;
        CALL TEXTE (X,LIG,"-");
      OD;
      CALL MOVE (X,LIG-4) ;
      IF (C=13) THEN CALL MOVE (X,LIG-4);CALL HASCII(0);EXIT; FI;
      IF (C=8) THEN
        IF X > COL THEN
              I := I-1;
              X := X-8;
              CALL MOVE (X,LIG-4);
              CALL HASCII (0);
              CALL TEXTE (X,LIG,"  ");
              CALL MOVE (X,LIG-4);
        FI;
      ELSE
        IF I <= 5 THEN
              CALL HASCII (0) ;
              CALL HASCII (c);
              VALEUR (i) := CHR (C);
              I:=I+1;
              X:=X+8;
        ELSE
              CALL COLOR(11);
              CALL TEXTE(105,258,"Chaine trop longue ");
              CALL TEXTE(105,274,"Appuyez sur une touche pour continuer");
              WHILE INKEY=0 DO OD;
              CALL FILL (101,251,398,58,0) ;
        FI;
      FI;
    OD;
END;
END SAISIECHAINE;

(***********************************************************************)
           UNIT TAB_PREDEFINI : PROCEDURE;
(***********************************************************************)
BEGIN
          (******************************************************)
          (*             0 <= X >= 52    et    0 <= Y >= 26     *)
          (******************************************************)
  taille := 16;
  ARRAY p DIM (0:taille+1);
  FOR i:=0 TO taille+1 DO
      p(i) := NEW points;
  OD;
  p(1).x:=3  ;p(1).y:=9  ;p(1).z:='A' ;p(2).x:=11 ;p(2).y:=1  ;p(2).z:='B' ;
  p(3).x:=6  ;p(3).y:=8  ;p(3).z:='C' ;p(4).x:=4  ;p(4).y:=3  ;p(4).z:='D' ;
  p(5).x:=5  ;p(5).y:=15 ;p(5).z:='E' ;p(6).x:=8  ;p(6).y:=11 ;p(6).z:='F' ;
  p(7).x:=1  ;p(7).y:=6  ;p(7).z:='G' ;p(8).x:=7  ;p(8).y:=4  ;p(8).z:='H' ;
  p(9).x:=9  ;p(9).y:=7  ;p(9).z:='I' ;p(10).x:=14;p(10).y:=5 ;p(10).z:='J';
  p(11).x:=10;p(11).y:=13;p(11).z:='K';p(12).x:=15;p(12).y:=14;p(12).z:='L';
  p(13).x:=15;p(13).y:=2 ;p(13).z:='M';p(14).x:=13;p(14).y:=16;p(14).z:='N';
  p(15).x:=2 ;p(15).y:=12;p(15).z:='O';p(16).x:=12;p(16).y:=10;p(16).z:='P';
  p(0):=p(16);p(17):=p(1);
END tab_predefini;

(***********************************************************************)
           UNIT SAISIE_SOURIS : MOUSE PROCEDURE;
(***********************************************************************)
  VAR h,v,t,b,nbr : INTEGER,
      l,r,c,fin   : BOOLEAN;
  BEGIN
    PREF IIUWgraph BLOCK
    BEGIN
         CALL cls; CALL affiche_grille;
         b:=0;
         inst := INIT (guziki);
         IF NOT inst THEN
            CALL TEXTE(100,100,"Erreur d'installation de la souris");EXIT;
         FI;
         CALL DEFCURSOR (1,11,12);
         CALL SHOWCURSOR;
         CALL STATUS (h,v,l,r,c);
         nbr := 1;
         fin := FALSE;
         WHILE NOT fin AND nbr<=taille DO
               CALL GETPRESS (b,h,v,t,l,r,c);
               IF l THEN
                 IF 0 <= h DIV 012 ANDIF h DIV O12 <= (640-11) DIV O12 ANDIF
                    0 <= (316-v) DIV O12 ANDIF (316-v) DIV O12 <= 319 DIV O12 THEN
                    (* COORDONNEES VALABLES *);
                    p(nbr)   := NEW points;
                    p(nbr).x := h DIV O12;
                    p(nbr).y := (316-v) DIV O12;
                    p(nbr).z := CHR (64+nbr);
                    CALL MOVE (h,v) ;
                    CALL MOVE (p(nbr).x*O12+9,316-(p(nbr).y*O12));
                    CALL HIDECURSOR ; CALL COLOR (2);
                    CALL HASCII (ord(p(nbr).z));
                    CALL SHOWCURSOR ; CALL COLOR (3);
                    FOR i:=1 TO 3000 DO OD;
                    nbr:=nbr+1;
                 ELSE (* COORDONNEES NON VALABLES *);
                    CALL GETPRESS (b,h,v,t,l,r,c);
                 FI;
               FI;
         OD;
         p(0) := p(taille); p(taille+1) := p(1);
         CALL HIDECURSOR;
    END;
END saisie_souris;

(***********************************************************************)
           UNIT SAISIE_POINTS : IIUWgraph PROCEDURE;
(***********************************************************************)
VAR
    size,i  : INTEGER,
    valable : BOOLEAN;
BEGIN
     CALL TEXTE (100,230,"  0 <= X >= 52   et  0 <= Y >= 26  ");
     FOR i:=1 TO taille DO
         p(i)    := NEW points;
         valable := FALSE;
         WHILE NOT valable DO
              CALL COLOR (7);
              CALL TEXTE (100,240,"Abscisses du point nø      :      ");
              CALL TEXTE (100,250,"Ordonn‚es du point nø      :      ");
              CALL COLOR (10);
              CALL MOVE (290,240);CALL HASCII (64+i);
              CALL MOVE (290,250);CALL HASCII (64+i);
              CALL COLOR (4);
              CALL SAISIECHAINE (350,244,chaine);
              CALL TRANSENTIER (chaine,p(i).x);
              CALL SAISIECHAINE (350,254,chaine);
              CALL TRANSENTIER (chaine,p(i).y);
              IF p(i).x<0 ORIF p(i).x > ((640-11) DIV O12) THEN
                          valable:=FALSE;
              ELSE IF p(i).y<0 ORIF p(i).y > (319 DIV O12) THEN
                          valable:=FALSE;
                   ELSE valable := TRUE;
                   FI;
              FI;
              p(i).z := CHR (64+i);
              CALL TEXTE (290,254,"            ");
              CALL TEXTE (290,244,"            ");
         OD;
     OD;
     p(0) := p(taille); p(taille+1) := p(1);
END saisie_points;

(***********************************************************************)
           UNIT AFFICHE_GRILLE : mouse PROCEDURE;
(***********************************************************************)
VAR i : INTEGER;
BEGIN
   PREF IIUWgraph BLOCK
   BEGIN                   (* Graduations *)
        CALL COLOR (7);
        FOR i := 11 STEP O12 TO 640 DO
	      CALL TEXTE (i,314,".");
        OD;
        FOR i := 315 STEP O12 DOWNTO 0 DO
	      CALL TEXTE (11,i,".");
        OD;                  (* Reperes *)
        CALL TEXTE (8,16,"Y");
        CALL TEXTE (8,26,"^");
        CALL TEXTE (614,316,"> X");
        CALL MOVE (618,319);
        CALL DRAW (11,319);     (* Ligne horizontale *)
        CALL DRAW (11,26);      (* Ligne verticale   *)
   END;
END affiche_grille;

(***********************************************************************)
           UNIT THETA : FUNCTION(P1,P2 : POINTS): REAL;
(***********************************************************************)
VAR dx,dy,ax,ay : INTEGER,
    t           : REAL;
BEGIN
    dx := p2.x - p1.x;   ax := ABS (dx);
    dy := p2.y - p1.y;   ay := ABS (dy);
    IF (dx=0) AND (dy=0) THEN
              t := 0;
    ELSE t := dy/(ax+ay);
    FI;
    IF dx<0 THEN
            t := 2-t;
    ELSE IF dy<0 THEN
            t := 4+t;
         FI;
    FI;
    result := t*90.0;
END theta;

(***********************************************************************)
           UNIT WRAP : PROCEDURE (INOUT N : INTEGER);
(***********************************************************************)
VAR j,i,min,m       : INTEGER,
    minangle,v      : REAL,
    t,tb,p1,p2,prec : points,
    ligne           : line;
BEGIN
    min :=1 ; tb := NEW points; t := NEW points;
    p1    := NEW points; p2   := NEW points;
    ligne := NEW line  ; prec := NEW points;
          (* Choix du premier point *)
    FOR i := 2 TO taille DO
       IF p(i).y<p(min).y THEN
                          min := i;
       ELSE IF p(i).y=p(min).y THEN
                 IF p(i).x>p(min).x THEN
                                    min := i;
                 FI;
            FI;
       FI;
    OD;
          (*    Initialisations     *)
    m := 0; p(taille+1) := p(min); minangle := 0.0;
          (*  Boucle de Recherche   *)
    DO
      m:=m+1       ; t:=p(m)    ; p(m):=p(min)     ;p(min):=t;
      min:=taille+1; v:=minangle; minangle:=360.0;
      FOR i:=m+1 TO taille+1 DO
                 (* Recherche du plus petit angle *)
          IF theta (p(m),p(i))>v THEN
                 (* Recherche du point suivant *)
             IF theta (p(m),p(i)) < minangle THEN
                   min := i; minangle := theta (p(m),p(min));
             FI;
                 (* Cas ou plusieurs points sont alignes *)
             IF theta (p(m),p(i)) = minangle ANDIF p(min)<>p(i) THEN
                   ligne.p1 := p(m); ligne.p2 := p(min);
                   IF NOT on (ligne,p(i)) THEN
                         min := i; minangle := theta (p(m),p(min));
                   FI;
             FI;
          FI;
      OD;
      IF min = taille+1 THEN EXIT;
      FI;
    OD;
    n:=M;
END wrap;

(***********************************************************************)
           UNIT ON : FUNCTION (L:LINE;P1:POINTS):BOOLEAN;
(***********************************************************************)
BEGIN
   result := FALSE;
   IF (l.p1.x=p1.x) THEN
       IF l.p1.y>=p1.y ANDIF p1.y>=l.p2.y THEN
                       result:=TRUE
       ELSE IF l.p2.y>=p1.Y ANDIF p1.Y>=l.p1.y THEN
                            result:=TRUE;
            FI;
       FI;
   ELSE
      IF (l.p1.y=p1.Y) THEN
         IF l.p1.x<=p1.x ANDIF p1.x<=l.p2.x THEN
                         result:=TRUE
         ELSE IF l.p2.x<=p1.x ANDIF p1.X<=l.p1.x THEN
                              result:=TRUE;
              FI;
         FI;
      FI;
   FI;
END on;

(***********************************************************************)
           UNIT AFFICHE_ENVELOPPE :  IIUWgraph PROCEDURE;
(***********************************************************************)
BEGIN
   PREF mouse BLOCK
   BEGIN
        CALL COLOR(8);
        CALL HIDECURSOR;
        FOR i:=1 TO n-1 DO
            CALL MOVE ((p(i).x*O12)+ O12,316-(p(i).y*O12)+O12 DIV 4);
            CALL DRAW ((p(i+1).x*O12)+ O12,316-(p(i+1).y*O12)+O12 DIV 4);
        OD;
        CALL MOVE ((p(n).x*O12)+ O12,316-(p(n).y*O12)+O12 DIV 4);
        CALL DRAW ((p(1).x*O12)+ O12,316-(p(1).y*O12)+O12 DIV 4);
        CALL SHOWCURSOR;
   END;
  CALL COLOR (6);
  CALL TEXTE (50,335,"L'enveloppe convexe est :");
  FOR i:=1 TO n DO
        CALL MOVE (300+(i*10),335);
        CALL HASCII (ord(p(i).z));
  OD;
  CALL COLOR (5);
  CALL TEXTE (150,325,"Appuyez sur ENTREE pour continuer");
  C := 0;
  WHILE C <> 13 DO
     C := INKEY;
  OD;
END affiche_enveloppe;

(***********************************************************************)
(*                     Programme principal                             *)
(***********************************************************************)
BEGIN
  PREF IIUWgraph BLOCK
  BEGIN
    O12:=12;
    CALL GRON(nocard);
    quitter:=FALSE;
    WHILE NOT quitter DO
        CALL CLS; CALL COLOR (1);
        CALL TEXTE (100,10,"ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");
        CALL TEXTE (100,20,"³      Enveloppe convexe      ³");
        CALL TEXTE (100,30,"ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ");
	CALL COLOR (2);
        CALL TEXTE (80,100,"Voulez_vous :  aisir des points");
        CALL TEXTE (80,110,"               tiliser des points pr‚d‚finis");
        CALL TEXTE (80,120,"               uitter");
        CALL COLOR (14);
        CALL MOVE (192,100);CALL OUTSTRING("S");
        CALL MOVE (192,110);CALL OUTSTRING("U");
        CALL MOVE (192,120);CALL OUTSTRING("Q");
	CALL COLOR (5);
        CALL TEXTE (80,140,"Votre choix : ");
        CALL SAISIECHAINE (190,144,choix);
	CALL COLOR (3);
        WHILE choix(1)<>'u' AND choix(1)<>'s' AND choix(1)<>'q' AND
                 choix(1)<>'U' AND choix(1)<>'S' AND choix(1)<>'Q' DO
                 CALL SAISIECHAINE (190,144,choix);
        OD;
        CASE choix(1)
           WHEN 'u','U' : CALL tab_predefini;
           WHEN 's','S' : CALL TEXTE (100,200,
                                 "Combien de points voulez_vous saisir :");
                          CALL  SAISIECHAINE (420,204,chaine);
                          CALL TRANSENTIER (chaine,taille);
                          ARRAY p DIM (0:taille+1);
                          CALL TEXTE (100,210,
                             "Voulez-vous utiliser la souris (o/n) ?");
                          CALL SAISIECHAINE (410,214,souris);
                          WHILE souris(1)<>'O' AND souris(1)<>'N'
                                   AND souris(1)<>'o' AND souris(1)<>'n' DO
                             CALL SAISIECHAINE (410,214,souris);
                          OD;
                          IF souris(1)='N' ORIF souris(1)='n' THEN
                                 CALL saisie_points;
                          ELSE   CALL saisie_souris;
                          FI;
           WHEN 'q','Q' : quitter:=TRUE;CALL GROFF; EXIT;
        ESAC;
        CALL CLS;
	CALL COLOR (9);
        FOR i:=1 TO taille DO
            CALL MOVE (p(i).x*O12+9,316-(p(i).y*O12));
            CALL HASCII (ord(p(i).z));
        OD;
        CALL affiche_grille;
        CALL wrap(n);
        CALL affiche_enveloppe;
        FOR i:=0 TO taille+1 DO KILL (p(i));OD;
    OD;
  END; (*block*)

END convex_hull;