procedure TfrmMain.cmdPulleysClick(Sender: TObject);
var
H, W, nCount, k, n: integer;
c, r, g, b: TColor;
cA, cB: TPoint; // centre
rA, rB: Integer; // radii
I, PI, J, M: Integer;
LSide, ASide: Boolean;
tng: array of array of TPoint;
function OnSegment(p, q, r: TPoint): Boolean;
begin
Result := (q.x <= Max(p.x, r.x)) and (q.x >= Min(p.x, r.x)) and
(q.y <= Max(p.y, r.y)) and (q.y >= Min(p.y, r.y));
end;
function Orientation(p, q, r: TPoint): Integer; // sideOfPoint()?
var
V: LongInt;
begin
V := (q.y - p.y) * (r.x - q.x) - (q.x - p.x) * (r.y - q.y);
if V = 0 then
Result := 0 // on a line
else if V > 0 then
Result := 1 // clock wise
else
Result := -1; // counterclock wise
end;
function Intersects(p1, q1, p2, q2: TPoint): Boolean;
var
o1, o2, o3, o4: Integer;
begin
o1 := Orientation(p1, q1, p2);
o2 := Orientation(p1, q1, q2);
o3 := Orientation(p2, q2, p1);
o4 := Orientation(p2, q2, q1);
if (o1 <> o2) and (o3 <> o4) then
Result := True
else if
((o1 = 0) and onSegment(p1, p2, q1)) or
((o2 = 0) and onSegment(p1, q2, q1)) or
((o3 = 0) and onSegment(p2, p1, q2)) or
((o4 = 0) and onSegment(p2, q1, q2))
then
Result := True
else
Result := False;
end;
procedure LoadCircle(I: Integer; out C: TPoint; out R: Integer);
var IM: Integer;
begin
IM := I mod nPoints;
C := Point(Round(points[IM].X), Round(points[IM].Y));
R := Round(yarichaps[IM]);
end;
procedure ShowPulley(ACenter: TPoint; ARadii: Integer; ALabel: String; WithColor: TColor);
begin
imgInput.Canvas.Pen.Color := WithColor;
imgInput.Canvas.Pen.Width := 2;
imgInput.Canvas.Ellipse(ACenter.X - ARadii, ACenter.Y - ARadii,
ACenter.X + ARadii, ACenter.Y + ARadii);
imgInput.Canvas.TextOut(ACenter.X - 5, ACenter.Y - 5, ALabel);
end;
procedure SelTangent(I: Integer; ATangent: Integer);
var
J: Integer;
begin
for J := 0 to 3 do
if J <> ATangent then
tng[I, J] := Point(-1, -1)
else if tng[I, J].X <> -1 then
begin
pout[I * 2] := tng[I, J];
pout[I * 2 + 1] := tng[I, J + 4];
end;
end;
begin
cmdResetClick(Sender);
lastAction := cmdPulleysClick;
Screen.Cursor := crHourGlass;
STOP := False;
memoDebug.Clear;
H := 500; W := 500;
imgInput.Picture.Bitmap.Height := H;
imgInput.Picture.Bitmap.Width := W;
imgInput.Canvas.Brush.Color := clWhite;
imgInput.Canvas.FillRect(imgInput.ClientRect);
imgInput.Canvas.Pen.Mode := pmCopy;
imgInput.Canvas.Brush.Style := bsClear;
//==================================
SetLength(tng, nPoints, 8);
// Calculate tangents
PI := Pred(nPoints);
LoadCircle(PI, cA, rA);
for I := 0 to Pred(nPoints) do
begin
LoadCircle(I, cB, rB);
N_2CExtTangents(cA, rA, cB, rB, tng[I, 0], tng[I, 1], tng[I, 4], tng[I, 5]);
_2CIntTangents(cA, rA, cB, rB, tng[I, 2], tng[I, 3], tng[I, 6], tng[I, 7]);
ShowPulley(cB, rB, I.ToString, clLtGray);
cA := cB; rA := rB;
PI := I;
end;
// Remove intersecting tangents
for I := Pred(nPoints) downto 0 do
begin
PI := Pred(I); if PI < 0 then PI := Pred(nPoints);
for J := 0 to 3 do
begin
M := 0;
while (M < 4) and not
Intersects(tng[I, J], tng[I, J + 4], tng[PI, M], tng[PI, M + 4])
do
Inc(M);
if M < 4 then
tng[I, J] := Point(-1, -1); // mark deleted
end;
end;
// Select a tangent for drawing
ASide := False;
PI := Pred(nPoints);
for I := 0 to Pred(nPoints) do
begin
J := 0; M := 0;
J := J + IfThen(tng[I, 0].X <> -1, 1); // left ext
J := J + IfThen(tng[I, 2].X <> -1, 1); // left int
M := M + IfThen(tng[I, 1].X <> -1, 1); // right ext
M := M + IfThen(tng[I, 3].X <> -1, 1); // right int
if J = M then
begin
LSide := ASide;
ASide := not ASide;
end
else
LSide := J > M;
if LSide then // left side
begin
if (tng[PI, 3].X <> -1) then
SelTangent(PI, 3) else
SelTangent(PI, 0);
tng[I, 1] := Point(-1, -1);
tng[I, 3] := Point(-1, -1);
end
else // right side
begin
if (tng[PI, 2].X <> -1) then
SelTangent(PI, 2) else
SelTangent(PI, 1);
tng[I, 0] := Point(-1, -1);
tng[I, 2] := Point(-1, -1);
end;
PI := I;
end;
nCount := nPoints;
//=============================
//////////////////
imgInput.Canvas.Pen.Color := clBlue;
imgInput.Canvas.Pen.Width := 2;
//if False then
for k:=0 to nCount-1 do
begin
r := random(255); g := random(255); b := random(255);
if (r < 32) then r := 32; if (r > 240) then r := 240;
if (g < 32) then g := 32; if (g > 240) then g := 240;
if (b < 32) then b := 32; if (b > 240) then b := 240;
c := RGB(r, g, b);
imgInput.Canvas.Pen.Color := c;
n := 2*k + 0;
imgInput.Canvas.Ellipse(pout[n].X-2, pout[n].Y-2, pout[n].X+2, pout[n].Y+2);
imgInput.Canvas.MoveTo(pout[n].X, pout[n].Y);
n := 2*k + 1;
imgInput.Canvas.LineTo(pout[n].X, pout[n].Y);
imgInput.Canvas.Ellipse(pout[n].X-2, pout[n].Y-2, pout[n].X+2, pout[n].Y+2);
end;
if chkFileOutput.Checked then
imgInput.Picture.Bitmap.SaveToFile(ExtractFilePath(Application.ExeName) + 'zzzPulleys-' + IntToHex(RandSeed, 8) + '.bmp');
Screen.Cursor := crDefault;
STOP := True;
end;