Blob Blame Raw
unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

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

const
  pointR = 5;
  ballR = 40;
  g = 0.002;

var
  Form1: TForm1;
  maxPoints: integer = 100;
  points: array of TPoint;
  bx, by, vx, vy: single;

implementation

{$R *.lfm}

procedure addPoint(x, y: integer);
var
  i, l: integer;
begin
  if maxPoints <= 0 then exit;
  l := Length(points);
  if l < maxPoints then begin
    SetLength(points, l+1);
    points[l].X := x;
    points[l].Y := y;
  end else begin
    for i:=1 to l-1 do begin
      points[i-1] := points[i];
    end;
    points[l-1].X := x;
    points[l-1].Y := y;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bx := 200;
  by := 100;
  vx := 0.1;
  vy := 0;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then begin
    addPoint(x, y);
    // todo: addPointChain
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i: integer;
begin
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := pointR * 2;
  for i:=0 to length(points)-1 do begin
    Canvas.MoveTo(points[i].x, points[i].y);
    Canvas.LineTo(points[i].x, points[i].y);
  end;

  Canvas.Pen.Color := clBlue;
  Canvas.Pen.Width := ballR * 2;
  Canvas.MoveTo(round(bx), round(by));
  Canvas.LineTo(round(bx), round(by));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
  dx, dy, sqlen, minSqlen, dv: single;
  collision: boolean;
begin
  collision := false;

  bx := bx + vx;
  by := by + vy;

  if bx > ClientWidth  - ballR then begin vx := -abs(vx); collision := true; end;
  if by > ClientHeight - ballR then begin vy := -abs(vy); collision := true; end;
  if bx < ballR                then begin vx :=  abs(vx); collision := true; end;
  if by < ballR                then begin vy :=  abs(vy); collision := true; end;

  minSqlen := sqr(ballR + pointR);
  for i := 0 to length(points)-1 do begin
    dx := points[i].X-bx;
    dy := points[i].Y-by;
    sqlen := sqr(dx) + sqr(dy);
    if (sqlen > 0.1*minSqlen) and (minSqlen > sqlen) then begin
      dv := -2*(dx*vx + dy*vy)/sqlen;
      if dv < 0 then begin
        vx := vx + dv*dx;
        vy := vy + dv*dy;
        collision := true;
      end;
    end;
  end;

  if not collision then vy := vy + g;
  if collision then refresh;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Refresh;
end;

end.