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 Gr÷e *)
(* ihrer polaren Winkel in Bezug auf den Punkt p1 mit der kleinsten *)
(* Y-Koordinate ordnet, so da ein einfacher geschlossener Pfad entsteht *)
(* ---> von GrahamScan ben÷tigt *)
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.