unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Math;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

const
  ballR = 20;
  pointR = 5;

var
  Form1: TForm1;
  points: array of TPoint;
  count: integer;
  ball: TPoint;
  maxLen: single = 200;
  len: single;

  lenLabel, maxlenLabel: integer;

implementation

{$R *.lfm}

function getLen: single;
var
  i: integer;
begin
  Result := 0;
  for i:=1 to count-1 do
    Result := Result + sqrt(sqr(points[i].x-points[i-1].x) + sqr(points[i].y-points[i-1].y));
  len := Result;
end;

function IntersectsCircles(p1, p2: TPoint; r1, r2: single): boolean;
begin
  Result := sqr(p1.x-p2.x) + sqr(p1.Y-p2.y) < sqr(r1+r2);
end;

function IntersectsLines(a1, a2, b1, b2: TPoint): boolean;
var
  x1, y1, x2, y2, r, d2, d1: single;
begin
  Result := false;

  r := sqr(a2.x-a1.x) + sqr(a2.y-a1.y);
  if r = 0 then exit;
  x1 := ((a2.x-a1.x)*(b1.x-a1.x) + (a2.y-a1.y)*(b1.y-a1.y))/r;
  y1 := ((a1.y-a2.y)*(b1.x-a1.x) + (a2.x-a1.x)*(b1.y-a1.y))/r;
  x2 := ((a2.x-a1.x)*(b2.x-a1.x) + (a2.y-a1.y)*(b2.y-a1.y))/r;
  y2 := ((a1.y-a2.y)*(b2.x-a1.x) + (a2.x-a1.x)*(b2.y-a1.y))/r;

  if y1 = y2 then exit;

  d2 := y1/(y1-y2);
  if (d2 <= 0) or (d2 > 1) then exit;
  d1 := d2*(x2-x1) + x1;
  if (d1 <= 0) or (d1 > 1) then exit;
  Result := true;
end;

procedure GenerateBall;
var
  i: integer;
  retry: boolean;
begin
  retry := true;
  while retry do begin
    ball.x := RandomRange(ballR, Form1.ClientWidth-ballR);
    ball.y := RandomRange(ballR, Form1.ClientHeight-ballR);
    retry := false;
    for i := 0 to count - 1 do
      if IntersectsCircles(ball, points[i], ballR, pointR) then
        retry := true;
  end;
end;

procedure RemovePoints(cnt: integer);
var
  i: integer;
begin
  with Form1 do begin
    Canvas.Pen.Color := Color;
    Canvas.Pen.Width := 2*pointR;
    Canvas.MoveTo(points[0].x, points[0].y);
    for i := 0 to min(cnt, count-1) do Canvas.LineTo(points[i].x, points[i].y);
    for i := cnt to count-1 do points[i-cnt] := points[i];
    count := count - cnt;
    setLength(points, count);
    FormPaint(nil);
  end;
end;

procedure AddPoint(p: TPoint);
var
  i: integer;
  len: single;
begin
  if count > 0 then begin
    len := sqrt(sqr(points[count-1].x-p.x) + sqr(points[count-1].y-p.y));
    if len < pointR then exit;
  end;

  while getLen > maxLen do RemovePoints(1);

  count := count + 1;
  setLength(points, count);
  points[count-1] := p;

  for i := count-10 downto 1 do begin
    if IntersectsLines(points[count-1], points[count-2], points[i], points[i-1]) then begin
      RemovePoints(i);
      maxLen := getLen;
      break;
    end;
  end;

  if IntersectsCircles(p, ball, pointR, ballR) then begin
    GenerateBall;
    maxLen := maxLen + 2*ballR;
  end;

  Form1.Refresh();
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  GenerateBall;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  AddPoint(Point(x, y));
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := 2*pointR;
  Canvas.Polyline(points);

  Canvas.Pen.Color := clRed;
  Canvas.Pen.Width := 2*ballR;
  Canvas.MoveTo(round(ball.x), round(ball.y));
  Canvas.LineTo(round(ball.x), round(ball.y));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if round(len) <> lenLabel then begin
    lenLabel := round(len);
    Label1.Caption := 'length ' + IntToStr(lenLabel);
    Label2.Caption := 'max length ' + IntToStr(maxlenLabel);
  end;
  if round(len) > maxlenLabel then begin
    maxlenLabel := round(len);
    Label2.Caption := 'max length ' + IntToStr(maxlenLabel);
  end;
end;

end.