Jakiś czas temu przetłumaczyłem kod programu do znajdowania otoczki wypukłej z C++ na Pascala
program MonotoneChain;
uses crt;
type TPoint = record
x,y:Real;
end;
TFunc = function (a,b:TPoint):integer;
TArray = array of TPoint;
function signedAreaOfParallelogram(O,A,B:TPoint):Real;
begin
signedAreaOfParallelogram := (A.x - O.x)*(B.y - O.y) - (A.y - O.y)*(B.x - O.x);
end;
function monotoneChain(P:TArray;n:integer;var H:TArray):integer;
var k,i,t:integer;
begin
if n > 3 then
begin
k := 0;
for i := 0 to n - 1 do
begin
while (k >= 2)and(signedAreaOfParallelogram(H[k-2],H[k-1],P[i]) <= 0)do
k := k - 1;
H[k] := P[i];
k := k + 1;
end;
t := k + 1;
for i := n - 1 downto 1 do
begin
while(k >= t)and(signedAreaOfParallelogram(H[k-2],H[k-1],P[i-1]) <= 0)do
k := k - 1;
H[k] := P[i-1];
k := k + 1;
end;
monotoneChain := k - 1;
end
else
monotoneChain := n;
end;
function comparePoints(a,b:TPoint):integer;
var t:integer;
begin
t := 1;
if(a.x < b.x)or((a.x = b.x)and(a.y < b.y))then
t := -1;
if(a.x = b.x)and(a.y = b.y)then
t := 0;
comparePoints := t;
end;
procedure quicksort(var A:TArray;l,r:integer;cmp:TFunc);
var i,j:integer;
x,w:TPoint;
begin
i := l;
j := r;
x := A[(l+r)div 2];
repeat
while cmp(A[i],x) < 0 do i := i + 1;
while cmp(x,A[j]) < 0 do j := j - 1;
if i <= j then
begin
w := A[i];
A[i] := A[j];
A[j] := w;
i := i + 1;
j := j - 1;
end
until i > j;
if l < j then quicksort(A,l,j,cmp);
if i < r then quicksort(A,i,r,cmp)
end;
var esc:char;
k,m,n:integer;
P,H:TArray;
BEGIN
clrscr;
repeat
writeln('How many points you want to read');
readln(n);
SetLength(P,n);
SetLength(H,n);
for k := 0 to n-1 do
begin
write('P[',k,']=');
readln(P[k].x,P[k].y);
end;
writeln;
quicksort(P,0,n-1,@comparePoints);
m := monotoneChain(P,n,H);
writeln('Array of sorted points');
for k := 0 to n-1 do
write('(',P[k].x:1:6,',',P[k].y:1:6,') ');
writeln;
writeln;
writeln('Points on the hull');
for k := 0 to m-1 do
write('(',H[k].x:1:6,',',H[k].y:1:6,') ');
writeln;
writeln;
esc := readkey;
until esc = #27;
END.
Kod ten jest niestety zgodny tylko z Free Pascalem
więc ciekaw jestem jak go przepisać używając listy