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.