program grafische_Algorithmen;
uses crt,graph,dos;

const max_punkte                  = 2000;
      x_koo: array[1..16] of byte = (3,11,6,4,5,8,1,7,9,14,10,16,15,13,3,12);
      y_koo: array[1..16] of byte = (9,1,8,3,15,11,6,4,7,5,13,14,2,16,12,10);

type  punkt = record
                name  : char;
                x,y   : integer;
              end;

      line  = record
                p1,p2 : punkt;
              end;

      punktmenge = array[0..max_punkte] of punkt;

var   pm      : punktmenge;
      A       : punkt;           (* 'Anker' fr GrahamScan *)
      N,CN    : integer;



procedure lies_punkte;
var i : integer;
    p : punkt;
begin
 N:=16;
 for i:=1 to N do
  begin
    p.name:=chr(64+i);
    p.x:=x_koo[i]*20;
    p.y:=319-y_koo[i]*15 -40;
    pm[i]:=p;
  end;
end;

procedure lies_zufaellige_punkte( Anzahl : integer);
var i : integer;
    p : punkt;
begin
 randomize;
 for i:=1 to Anzahl do
  begin
   p.name:=' ';
   p.x:=random(360)+20;
   p.y:=random(260)+20;
   pm[i]:=p;
  end;
 N:=Anzahl;
end;


function init_grafik_modus : boolean;
var gd,gm,ercode : integer;
begin
 gd:=detect;
 initGraph(gd,gm,'');
 if GraphResult<>grOK then init_grafik_modus:=false
                      else init_grafik_modus:=true;
end;


procedure plot_frame;
begin
 rectangle(0,0,400,300);
end;

procedure plot_punktmenge(max : integer);
var i  : integer;
begin
 for i:=1 to max do
   begin
     putpixel(pm[i].x , pm[i].y , 11);
     outtextxy(pm[i].x+4 , pm[i].y-10 ,pm[i].name );
   end;
end;

procedure plot_polygon(max : integer);
var i : integer;
begin
 for i:=1 to max-1 do
   begin
     graph.line(pm[i].x , pm[i].y , pm[i+1].x , pm[i+1].y );
     delay(200);
   end;
end;


function ccw(p0,p1,p2 : punkt) : integer;
var dx1,dx2,dy1,dy2 : integer;
begin
 dx1:=p1.x-p0.x;
 dy1:=p1.y-p0.y;
 dx2:=p2.x-p0.x;
 dy2:=p2.y-p0.y;

 if dx1*dy2 > dy1*dx2 then ccw:=1;
 if dx1*dy2 < dy1*dx2 then ccw:=-1;
 if dx1*dy2 = dy1*dx2 then
  begin
   if (dx1*dx2 < 0) or (dy1*dy2 < 0) then ccw:=-1   else
   if (dx1*dx1 + dy1*dy1) >= (dx2*dx2 + dy2*dy2) then ccw:=0
   else ccw:=1;
  end;
end;


function intersect(l1,l2 : line) : boolean;
begin
 intersect:=((ccw(l1.p1,l1.p2,l2.p1)*ccw(l1.p1,l1.p2,l2.p2)) <= 0)  and
            ((ccw(l2.p1,l2.p2,l1.p1)*ccw(l2.p1,l2.p2,l1.p2)) <= 0) ;
end;


function theta(p1,p2 : punkt) : 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);
 if dx<0 then t:=2-t  else
 if dy<0 then t:=4+t;
 theta:=t*90.0;
end;


function wrap(max : integer) : integer;
(* Ermittlung der konvexen Hlle von p *)
var i,min,M    : integer;
    minangle,v : real;
    t          : punkt;
begin
 min:=1;
 for i:=2 to max do  if pm[i].y < pm[min].y  then min:=i;
 M:=0;
 pm[max+1]:=pm[min];
 minangle:=0.0;

 repeat
   M:=M+1;
   t:=pm[M];  pm[M]:=pm[min];  pm[min]:=t;
   min:=max+1;
   v:=minangle;
   minangle:=360.0;
   for i:=M+1 to max+1 do
     if theta(pm[M],pm[i]) > v then
       if theta(pm[M],pm[i]) < minangle then
         begin
           min:=i;
           minangle:=theta(pm[M],pm[min]);
         end;
 until min=max+1;
 wrap:=M;
end;


(* Modifiziertes Sortierverfahren, welches die Punktmenge PM in der Gre *)
(* ihrer polaren Winkel in Bezug auf den Punkt p1 mit der kleinsten       *)
(* Y-Koordinate ordnet, so da ein einfacher geschlossener Pfad entsteht  *)
(* ---> von GrahamScan bentigt                                           *)



procedure qsort_modified(L,R :integer);
var i,j       : integer;
    t,v       : punkt;        (* v ist der knstliche Median *)
begin
if L<R then
 begin
   v:=pm[R];
   i:=L-1;
   j:=R;
   repeat
     repeat  i:=i+1  until theta(A,pm[i]) >= theta(A,v);
     repeat  j:=j-1  until theta(A,pm[j]) <= theta(A,v);
     t:=pm[i];  pm[i]:=pm[j];  pm[j]:=t;
   until j<=i;
   pm[j]:=pm[i];
   pm[i]:=pm[R];
   pm[R]:=t;
   qsort_modified(L,i-1);
   qsort_modified(i+1,R);
 end;
end;

function grahamscan(max : integer) : integer;
(* Ermittlung der konvexen Hlle von p *)
var i,j,min,M   : integer;
    l           : line;
    t           : punkt;
begin
 min:=1;
 for i:=2 to max do
  if pm[i].y < pm[min].y  then min:=i;
 for i:=1 to max do
  if (pm[i].y = pm[min].y) and (pm[i].x > pm[min].x)  then min:=i;
 A:=pm[min];
 t:=pm[1]; pm[1]:=pm[min]; pm[min]:=t;

 qsort_modified(1,max);



{
 setLineStyle(dottedln ,0, normWidth );
 plot_polygon(max);                  (* Anzeigen des einfach geschlossenen *)
 graph.line(pm[1].x,pm[1].y,pm[max].x,pm[max].y);
 setLineStyle(solidln,0,normWidth ); (* Pfades nach dem Sortieren          *)
}


 pm[0]:=pm[max];          
 M:=3;
 for i:=4 to max do
  begin
    while ccw(pm[M],pm[M-1],pm[i]) >= 0  do M:=M-1;
    M:=M+1;
    t:=pm[M]; pm[M]:=pm[i]; pm[i]:=t;
  end;
 grahamscan:=M;
end;


procedure show_convex_hull(max : integer);
begin
 plot_polygon(max);
 graph.line(pm[1].x , pm[1].y , pm[max].x , pm[max].y );
end;

procedure write_time( welches_mal : integer);
var h,m,s,s1 : word;
    zeit,t   : string;
begin
 gettime(h,m,s,s1);
 zeit:=' ';
 str(h,t);
 zeit:=zeit + t + ':' ;
 str(m,t);
 zeit:=zeit + t + ':' ;
 str(s,t);
 zeit:=zeit + t + '.' ;
 str(s1,t);
 zeit:=zeit + t;

 if welches_mal = 1 then  begin
                             outtextxy(450,100,'Beginn: ');
                             outtextxy(520,100,zeit);
                          end

                    else  begin
                             outtextxy(450,150,'Ende: ');
                             outtextxy(520,150,zeit);
                          end;
end;



        (**************************** Main ************************)

var Anzahl : integer;
begin
 clrscr;
 writeln('          ********** Geometrische Algorithmen ************* ');
 writeln; writeln;
 write('  Anzahl der darzustellenden Punkte ?   '); readln(Anzahl);
 lies_zufaellige_punkte(Anzahl);

 if init_grafik_modus then
   begin
     (* Teil 1 : Wrap *)
     plot_frame;
     plot_punktmenge(N);
     outtextxy(465,40,'WRAP-ALGORITHMUS');

     write_time(1);
     CN:=wrap(N);
     write_time(2);

     show_convex_hull(CN);
     readln;

     (* Teil 2 : Graham-Scan *)
     cleardevice;
     lies_zufaellige_punkte(Anzahl);
     plot_frame;
     plot_punktmenge(N);
     outtextxy(480,40,'GRAHAM-SCAN');

     write_time(1);
     CN:=GrahamScan(N);
     write_time(2);

     show_convex_hull(CN);
     readln;

     closeGraph;
   end

 else  writeln('Fehler bei Grafik-Karten-Initialisierung !!! ');
end.