PROGRAM OTOCZKA;
 
(*Program znajduje najmniejszy wypukly wielokat zawierajacy zadany zbior*)
(* punktow.                                                             *)
(* autor: Joanna Hybel                                                  *)
(*program nr 5 jest przedmiotem zal. PP II                              *)
 
VAR i,j,k,licz,ix:integer,
    pom:punkt,
    punkty:arrayof punkt; (*zbior punktow*)
 
UNIT punkt:class;
 var
  x,y:integer,
  theta:real;
end punkt;
 
 
begin
 pref iiuwgraph block
 
 UNIT hframe:procedure(x,y,length,width:integer);
 (*---------------------------------------------*)
 begin
   call move(x,y);
   call draw(x+width,y);
   call draw(x+width,y+length);
   call draw(x,y+length);
   call draw(x,y);
 end hframe;
 
 UNIT hwrite:procedure(tekst:string;x,y:integer);
  (*---------------------------------------------*)
 var i:integer,
 tab:arrayof char;
 begin
     tab:=unpack(tekst);
     call move(x,y);
     for i:=lower(tab) to upper(tab)
     do
        call hascii(ord(tab(i)));
     od;
 end;
 
UNIT inchar:function:integer;
 (*---------------------------------------------*)
var ii:integer;
begin
do
  ii:=inkey;
  if ii<>0 then exit fi;
od;
result:=ii;
end inchar;
 
 UNIT zmaz :procedure(x,y,dl,sz:integer);
  (*---------------------------------------------*)
 begin
   dl:=dl div 8;
   sz:=sz div 8;
   for i:=1 to dl do
     for j:=1 to sz do
       call move(x+(j-1)*8,y+(i-1)*8);
       call hascii(0);
     od;
   od;
   end zmaz;
 
UNIT wpisz_theta:procedure;
 (*---------------------------------------------*)
 
 UNIT uzup_theta:function(p:punkt):real;
  var dx,dy:integer,
    th:real;
begin
   dx:=p.x-punkty(1).x;
   dy:=p.y-punkty(1).y;
   if dx=0 and dy=0 then th:=0
   else
       th:=dy/(abs(dx)+abs(dy));
   fi;
   if dx<0 then th:=2-th
   else
      if dy<0 then th:=th+4 fi;
   fi;
   result:=th*90.0;
end uzup_theta;
begin
  for i:=1 to licz  do
             punkty(i).theta:=uzup_theta(punkty(i));
  od;
end wpisz_theta;
 
UNIT rys_otocz:procedure;
 (*---------------------------------------------*)
 UNIT czysc:procedure(p1,p2:punkt);
  begin
  call move(p2.x,p2.y);
  call color(0);
  call draw(p1.x,p1.y);
  call color(1);
  call cirb(p2.x,p2.y,2,3,3,1,1,2,2);
  call cirb(p1.x,p1.y,2,3,3,1,1,2,2);
  end czysc;
 
 UNIT rys:procedure(p1,p2:punkt);
  begin
    call color(11);
    call move(p2.x,p2.y);
    call draw(p1.x,p1.y);
  end rys;
 
UNIT po_tej_samej_str: function(p1,p2,p3:punkt):boolean;
   (*Czy punkty punkty(1),p3 leza po tej samej stronie prostej p1,p2?*)
  var dx1,dx2,dx3,dy1,dy2,dy3,k,l:real;
  begin
   dx1:=p2.x-p1.x;
   dy1:=p2.y-p1.y;
   dx2:=p3.x-p1.x;
   dy2:=p3.y-p1.y;
   dx3:=punkty(1).x-p1.x;
   dy3:=punkty(1).y-p1.y;
   k:=(dy2*dx1-dy1*dx2);
   l:=(dy3*dx1-dy1*dx3);
   if k=0 orif l=0 then result:=true;
   else
     if k>0 then result:=(l>0);
     else result:=(l<0);
     fi;
   fi;
  end po_tej_samej_str;
begin
    call hwrite("press any key to draw a CONVEX HULL",24,316);
    i:=2; k:=3;
    call rys(punkty(1),punkty(2));
    for j:=3 to licz
    do
       ix:=inchar;
       k:=j;
       do
          if po_tej_samej_str(punkty(i-1),punkty(i),punkty(k)) then
             i:=i+1; exit;
          else
              call czysc(punkty(i-1),punkty(i));
              i:=i-1;
          fi;
       od;
       pom:=punkty(i);
       punkty(i):=punkty(k);
       punkty(k):=pom;
       call rys(punkty(i-1),punkty(i));
    od;
   call rys(punkty(i),punkty(1));
   call zmaz(24,304,32,580);
end rys_otocz;
 
UNIT dane :procedure;
 (*---------------------------------------------*)
 UNIT los_gen:procedure;
  var x1,y1:integer;
  begin
   for i:=1 to licz do
     do
      x1:=random*400+100;
      if x1>5 andif x1<614 then
                           punkty(i).x:=x1;
                           exit;
      fi;
     od;
     do
      y1:=random*200+50;
      if y1>35 andif y1<300 then
                             punkty(i).y:=y1;
                             exit;
      fi;
     od;
     call cirb(x1,y1,2,3,3,11,1,2,2);
   od;
 end los_gen;
 
 UNIT uzyt_gen :procedure;
  begin
    call hwrite("USE ARROWS  TO MOVE THE CURSOR",24,308);
    call hwrite("END - finishes",24,320);
 
    call track(300,150);
    k:=0;
    do
     if inxpos>5 andif inxpos<514 then
      if inypos>35 andif inypos<287 then
       k:=k+1;
       punkty(k).x:=inxpos;
       punkty(k).y:=inypos;
       call cirb(inxpos,inypos,2,3,3,11,1,2,2);
      fi
     fi;
       if k=licz then exit fi;
       call track(inxpos+3,inypos)
    od;
    call zmaz(24,304,32,580);
  end uzyt_gen;
begin
  call zmaz(24,304,32,580);
  call hwrite("the number of points  3",20,291);
  call hwrite("1 - if you would like less points ",20,303);
  call hwrite("2 - if you would like more points ",20,315);
  call hwrite("ENTER - to continue execution",20,327);
 licz:=3;
do
 ix:=inchar;
 case ix
     when 50 : if licz<99 then licz:=licz+1 ;
                             call move(252,291);
                             call hascii(0);
                             call move(260,291);
                             call hascii(0);
                             call move(252,291);
                             if licz>9 then call hascii(licz div 10+48) fi;
                             call hascii(licz mod 10 +48);
               fi;
     when 49 : if licz>3 then licz:=licz-1 ;
                             call move(252,291);
                             call hascii(0);
                             call move(260,291);
                             call hascii(0);
                             call move(252,291);
                             if licz>9 then call hascii(licz div 10+48) fi;
                             call hascii(licz mod 10 +48);
 
               fi;
      when 13 : exit;
      otherwise;
 esac;
od;
array punkty dim (1:licz);
for i:=1 to licz do
  punkty(i):=new punkt;
od;
call zmaz(20,291,48,580);
call hwrite("M E N U :",20,291);
call hwrite("1 - random generation of points",20,303);
call hwrite("2 - points given by user",20,315);
do
  ix:=inchar;
  if ix=49 orif ix=50 then exit fi;
od;
  call zmaz(20,291,48,580);
  case ix
       when 49:call los_gen;
       when 50:call uzyt_gen;
       otherwise;
  esac;
end dane;
 
  UNIT znajdz_max_y:procedure;
   (*---------------------------------------------*)
   begin
     pom:=punkty(1);
     j:=1;
     for i:=1 to licz do
       if pom.y> punkty(i).y then(*bylo <*)
                 pom:=punkty(i);
                 j:=i;
       else
            if pom.y=punkty(i).y then
              if pom.x> punkty(i).x then
                 pom:=punkty(i);
                 j:=i;
              fi;
            fi;
       fi;
     od;
     pom:=punkty(1);
     punkty(1):=punkty(j);
     punkty(j):=pom;
   end znajdz_max_y;
 
   (*funkcje okreslajace wzgl. czego sortujemy : *)
 
    unit  l1 :function(p1,p2:punkt):boolean;
    begin
         result:=(p1.theta<p2.theta);
    end l1;
     unit l2:function(p1,p2:punkt):boolean;
     begin
       result:=(p1.y<p2.y);
     end l2;
     unit  l3:function(p1,p2:punkt):boolean;
     begin
       result:=(p1.x <p2.x);
     end l3;
 
 
  UNIT posortuj:procedure;
   (*---------------------------------------------*)
 
  (* Sortowanie punktow wzgledem kata jaki tworza z prosta pozioma, *)
  (*  przechodzaca przez punkt o najmniejszej wspolrz.y i x        *)
  var kon,pocz:integer,
      lg,lg1:boolean;
 
   UNIT sort:procedure (function log(p1,p2:punkt):boolean);
 
    unit quicksort:procedure(l,p:integer);
     var i,j:integer,
         x,w:punkt;
     begin
       i:=l; j:=p;
       x:=punkty((l+p) div 2);
       do
        while log(punkty(i),x) do
        i:=i+1  od;
        while log(x,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(pocz,kon);
     end sort;
 
     begin (*posortuj*)
     kon:=licz;
     pocz:=1;
     call sort(l1);
     k:=1;
     i:=1;
     while i<licz do
          j:=i;
          if punkty(i).theta=0  then  lg1:=true fi;
          do
             lg:=(punkty(i).theta=punkty(i+1).theta);
             if lg then i:=i+1 ;
             else
                        exit;
             fi;
             if i=licz then exit fi;
          od;
          if lg1 and i=j then lg1:=false fi;
          if i<>j then
                  kon:=i;
                  pocz:=j;
                  if lg1 then  lg1:=false;
    (*porzadkowanie punktow lezacych na prostej poziomej,przechodzacych przez*)
    (*punkt zaczepienia - punkty(1) ;tj.tworza kat zerowy z punktem zaczepienia   *)
                               call sort(l3) ;
                  else
    (*porzadkowanie punktow tworzacych ten sam kat rozny od zerowego*)
                               call sort(l2);
                  fi;
          fi;
          i:=i+1;
     od;
    end posortuj;
(*---------------------------------------------------------------------------*)
begin (*PROGRAM GLOWNY*)
   call gron(1);
   call color(14);
   call hframe(5,3,342,610);
   call hframe(4,2,340,612);
   call hframe(5,287,54,610);
   call hframe(5,7,28,610);
   call color(15);
   call hwrite("CONVEX HULL  by  Joanna Hybel",185,17);
   do
     call dane;
     call znajdz_max_y;
     call wpisz_theta;
     call posortuj;
     call rys_otocz;
     call hwrite("ESC - end of program execution",24,308);
     call hwrite("ENTER - continue ",24,320);
     do
       ix:=inchar;
       case ix
          when 13:call zmaz(6,37,246,608);
                  exit;
          when 27:exit exit;
          otherwise;
       esac;
     od;
   od;
    call groff;
end;
end;