PROGRAM OT;
(* Program zaliczeniowy Joanny Chromiec. Rysowanie otoczki wypuklej. *)
BEGIN
 
pref IIUWgraph block
 
(* procedury i funkcje EKPAKU i funkcja wsp - pomagajace organizowac ekran *)
 
unit inchar: function:integer;
 var ii:integer;
 begin
   do
     ii:=inkey;
     if ii<>0 then exit fi;
   od;
   result:=ii;
end inchar;
 
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  wsp:function(arg:real;czy_x:boolean):integer;
begin
  result:= arg+5;
  if czy_x then
    result:=5+result
  fi
end wsp;
 
(* rysowanie strony tytulowej *)
 
unit tytul:procedure;
begin
  call newpage;
  call setcursor(5,20);
  writeln(" C O N V E X     H U L L ");
  call setcursor(10,10);
  writeln(" written by    JOANNA CHROMIEC ");
  call setcursor(11,10);
  WRITELN(" in LOGLAN programming language");
  call setcursor(25,26);
  WRITE ("press  any key ");
  control:=INCHAR
end tytul;
 
(* wczytanie ilosci punktow, wylosowanie ich inarysowanie na ekranie *)
 
unit menu:procedure;
 unit ramka : procedure;
   var i:integer;
 begin
    call gron(0);        call move(0,0);        call draw(0,347);
    call draw(719,347);  call draw(719,0);      call draw(0,0);
    call move(0,310);    call draw(719,310);    call move(9,6);
    call draw(11,6);     call move(8,7);        call draw(12,7);
    call move(7,8);      call draw(13,8);       call move(10,5);
    call draw(10,305);   call draw(710,305);    call move(709,304);
    call draw(709,306);  call move(708,304);    call draw(708,306);
    call move(707,303);  call draw(707,307);    call move(706,303);
    call draw(706,307);  call move(8,105);      call draw(12,105);
    call move(8,205);    call draw(12,205);     call move(109,304);
    call draw(109,306);  call move(110,304);    call draw(110,306);
    call move(209,304);  call draw(209,306);    call move(210,304);
    call draw(210,306);  call move(309,304);    call draw(309,306);
    call move(310,304);  call draw(310,306);    call move(409,304);
    call draw(409,306);  call move(410,304);    call draw(410,306);
    call move(509,304);  call draw(509,306);    call move(510,304);
    call draw(510,306);  call move(609,304);    call draw(609,306);
    call move(610,304);  call draw(610,306);
 end ramka;
 
 unit losowo:procedure;
 begin
   for i:=1 to n
    do
      punkty(i):=new punkt;
      punkty(i).y:=(entier(random*1000)) mod 300;
      punkty(i).x:=(entier(random*1000)+350) mod 700;
    od;
   for i:=1 to n
    do
      call cirb(wsp(punkty(i).x,true),wsp(punkty(i).y,false),2,2,2,1,1,5,5)
    od
 end losowo;
 
begin
  CALL NEWPAGE;
  CAll setcursor(5,5);
  write("give a number of points : ");
  readln(n);
  array punkty dim(1:n);
  call gron(0);
  call ramka;
  call losowo;
end menu;
 
(* wybor punktu poczatkowego, wyliczenie thety dla reszty i posortowanie ich *)
 
unit przygotowanie : procedure;
 
 unit poy : function(p1,p2:punkt):boolean;
 begin
   result:=(p1.y>p2.y);
 end poy;
 
 unit poth : function(p1,p2:punkt):boolean;
 begin
   result:=(p1.theta<p2.theta);
 end poth;
 
 unit pox : function(p1,p2:punkt):boolean;
 begin
   result:=(p1.x<p2.x);
 end pox;
 
 unit sort : procedure(poc,kon:integer;function porzadek(p1,p2:punkt):boolean);
 
  unit quicksort:procedure(l,p:integer);
  var i,j:integer,
      sr,w:punkt;
  begin
    i:=l; j:=p;
    sr:=punkty((l+p) div 2);
    do
      while porzadek(punkty(i),sr) do i:=i+1  od;
      while porzadek(sr,punkty(j)) do j:=j-1  od;
      if i<=j then
        w:=punkty(i);
        punkty(i):=punkty(j);
        punkty(j):=w;
        i:=i+1;
        j:=j-1;
      fi;
      if i>j then exit fi;
    od;
    if l<j then call quicksort(l,j) fi;
     if i<p then call quicksort(i,p) fi;
  end quicksort;
 
 begin
   call quicksort(poc,kon);
 end sort;
 
 unit wpisztheta : procedure;
  unit licztheta : function (p:punkt):real;
  var a, b, dx,dy:integer,
     th:real;
  begin
    dx:=p.x-punkty(1).x;
    dy:=p.y-punkty(1).y;
    a:=abs (dx);
    b:=abs (dy);
    if dx=0 and dy=0 then th:=0
    else
        th:=dy/(a+b);
    fi;
    if dx<0 then th:=2-th
    else
       if dy<0 then th:=th+4 fi;
    fi;
    result:=th*90;
  end licztheta;
 
 var i:integer;
 
 begin
   for i:=2 to n
    do
      punkty(i).theta:=licztheta(punkty(i));
    od;
 end wpisztheta;
 
 unit znajdzdobry : procedure;
 var pom:punkt,
      tu:integer;
 begin
   tu:=1;
   for i:=2 to n
    do
      if punkty(tu).y<punkty(i).y then
        tu:=i
      else
        if punkty(tu).y=punkty(i).y then
          if punkty(tu).x>punkty(i).x then tu:=i fi
        fi
      fi;
    od;
   pom:=punkty(tu);
   punkty(tu):=punkty(1);
   punkty(1):=pom
 end znajdzdobry;
 
var i1, j1 :integer;
 
begin (* przygotowanie *)
  call znajdzdobry;
  call wpisztheta;
  call sort(2,n,poth);
  i1:=1;
  do
    if punkty(i1+1).theta=0 then i1:=i1+1 else exit fi;
    if i1=n then exit fi;
  od;
  call sort(1,i1,pox);
  i1:=i1+1;
  j1:=i1;
  while i1<n
   do
     do
       if punkty(i1+1).theta=punkty(j1).theta then i1:=i1+1 else exit fi;
       if i1=n then exit fi;
     od;
     call sort(j1,i1,poy);
     i1:=i1+1;
     j1:=i1
   od;
end przygotowanie;
 
(* procedura, szukajaca punktow otoczki za pomoca stosu *)
 
unit dzialaj:procedure;
 
var ind:integer,
    pom:punkt;
 
 unit dobrze:function:boolean;
 var dx,dx1,dx2,dy,dy1,dy2:real;
 begin
   dx:=stos.topd qua punkt.x-stos.topg qua punkt.x;
   dy:=stos.topd qua punkt.y-stos.topg qua punkt.y;
   dx1:=punkty(1).x-stos.topg qua punkt.x;
   dy1:=punkty(1).y-stos.topg qua punkt.y;
   dx2:=punkty(ind+1).x-stos.topd qua punkt.x;
   dy2:=punkty(ind+1).y-stos.topd qua punkt.y;
   result:=(dx*dy1-dy*dx1)*(dx*dy2-dy*dx2)>=0
 end dobrze;
 
 unit rysodc: procedure;
 begin
   call move(wsp(stos.topg qua punkt.x,true),wsp(stos.topg qua punkt.y,false));
   call draw(wsp(stos.topd qua punkt.x,true),wsp(stos.topd qua punkt.y,false));
 end rysodc;
 
 unit zmazodc: procedure;
 begin
   call color(0);
   call move(wsp(stos.topg qua punkt.x,true),wsp(stos.topg qua punkt.y,false));
   call draw(wsp(stos.topd qua punkt.x,true),wsp(stos.topd qua punkt.y,false));
   call color(1);
 end zmazodc;
 
 unit typstos:class;
 
  var szczytg, szczytd : elstosu;
 
  unit topg : function : elstosu;
  begin
    result:=szczytg;
  end topg;
 
  unit topd : function : elstosu;
  begin
    result:=szczytd;
  end topd;
 
  unit usun:procedure;
  begin
    if szczytg<> none then
      szczytg:=szczytd;
      if szczytd<>none then szczytd:=szczytd.dowiazanie fi;
    fi
  end usun;
 
  unit wloz : procedure (el:elstosu);
  begin
    el.dowiazanie:=szczytg;
    szczytd:=szczytg;
    szczytg:=el;
  end wloz;
 
 end typstos;
 
 var stos:typstos;
 
begin
  stos:=new typstos;
  for i:=1 to 2
   do
     pom:=copy(punkty(i));
     call stos.wloz(pom);
   od;
  call rysodc;
  for j:=1 to 200 do od;
  for ind:=3 to n-1
   do
     pom:=copy(punkty(ind));
     call stos.wloz(pom);
     call rysodc;
     for j:=1 to 200 do od;
     while not dobrze
      do
        call zmazodc;
        for j:=1 to 200 do od;
        call stos.usun
      od;
      call rysodc
    od;
   pom:=copy(punkty(n));
   call stos.wloz(pom)  ;
   call rysodc;
   for j:=1 to 200 do od;
   pom:=copy(punkty(1));
   call stos.wloz(pom);
   call rysodc;
   for j:=1 to 200 do od;
   (* tutaj rysowanie napisu czy chcesz dzialac dalej *)
   call move(30,325);
   call hascii(ord('r')); call hascii(ord('e')); 
   call hascii(ord('p')); call hascii(ord('e')); call hascii(ord('a')); 
   call hascii(ord('t')); call hascii(ord('?')); call  hascii(ord('('));
   call hascii(ord('y')); call hascii(ord('/'));
   call hascii(ord('n'));
   call hascii(ord(')'));
 
   control:=inchar;
     
end dzialaj;
 
 
unit elstosu:class;
 var dowiazanie:elstosu;
end elstosu;
 
 
unit punkt : elstosu class;
 var
  x,y:integer,
  theta:real;
end punkt;
 
var punkty:arrayof punkt;
 
var n,control,i,j:integer;
 
begin  (* bloku *)
  call tytul;
  control:=ord('y');
  while control=ord('y')
   do
     call menu;
     call przygotowanie;
     call dzialaj;
     call groff
   od
end;
END;