Blame lazarus/magic-marker/unit1.pas

7d0db5
unit Unit1;
7d0db5
7d0db5
{$mode objfpc}{$H+}
7d0db5
7d0db5
interface
7d0db5
7d0db5
uses
7d0db5
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
7d0db5
7d0db5
type
7d0db5
7d0db5
  { TForm1 }
7d0db5
7d0db5
  TForm1 = class(TForm)
7d0db5
    Timer1: TTimer;
7d0db5
    Timer2: TTimer;
7d0db5
    procedure FormCreate(Sender: TObject);
7d0db5
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
7d0db5
    procedure FormPaint(Sender: TObject);
7d0db5
    procedure Timer1Timer(Sender: TObject);
7d0db5
    procedure Timer2Timer(Sender: TObject);
7d0db5
  private
7d0db5
    { private declarations }
7d0db5
  public
7d0db5
    { public declarations }
7d0db5
  end;
7d0db5
7d0db5
const
7d0db5
  pointR = 5;
7d0db5
  ballR = 40;
7d0db5
  g = 0.002;
7d0db5
7d0db5
var
7d0db5
  Form1: TForm1;
7d0db5
  maxPoints: integer = 100;
7d0db5
  points: array of TPoint;
7d0db5
  bx, by, vx, vy: single;
7d0db5
7d0db5
implementation
7d0db5
7d0db5
{$R *.lfm}
7d0db5
7d0db5
procedure addPoint(x, y: integer);
7d0db5
var
7d0db5
  i, l: integer;
7d0db5
begin
7d0db5
  if maxPoints <= 0 then exit;
7d0db5
  l := Length(points);
7d0db5
  if l < maxPoints then begin
7d0db5
    SetLength(points, l+1);
7d0db5
    points[l].X := x;
7d0db5
    points[l].Y := y;
7d0db5
  end else begin
7d0db5
    for i:=1 to l-1 do begin
7d0db5
      points[i-1] := points[i];
7d0db5
    end;
7d0db5
    points[l-1].X := x;
7d0db5
    points[l-1].Y := y;
7d0db5
  end;
7d0db5
end;
7d0db5
7d0db5
procedure TForm1.FormCreate(Sender: TObject);
7d0db5
begin
7d0db5
  bx := 200;
7d0db5
  by := 100;
7d0db5
  vx := 0.1;
7d0db5
  vy := 0;
7d0db5
end;
7d0db5
7d0db5
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
7d0db5
  Y: Integer);
7d0db5
begin
7d0db5
  if ssLeft in Shift then begin
7d0db5
    addPoint(x, y);
7d0db5
    // todo: addPointChain
7d0db5
  end;
7d0db5
end;
7d0db5
7d0db5
procedure TForm1.FormPaint(Sender: TObject);
7d0db5
var
7d0db5
  i: integer;
7d0db5
begin
7d0db5
  Canvas.Pen.Color := clBlack;
7d0db5
  Canvas.Pen.Width := pointR * 2;
7d0db5
  for i:=0 to length(points)-1 do begin
7d0db5
    Canvas.MoveTo(points[i].x, points[i].y);
7d0db5
    Canvas.LineTo(points[i].x, points[i].y);
7d0db5
  end;
7d0db5
7d0db5
  Canvas.Pen.Color := clBlue;
7d0db5
  Canvas.Pen.Width := ballR * 2;
7d0db5
  Canvas.MoveTo(round(bx), round(by));
7d0db5
  Canvas.LineTo(round(bx), round(by));
7d0db5
end;
7d0db5
7d0db5
procedure TForm1.Timer1Timer(Sender: TObject);
7d0db5
var
7d0db5
  i: integer;
7d0db5
  dx, dy, sqlen, minSqlen, dv: single;
7d0db5
  collision: boolean;
7d0db5
begin
7d0db5
  collision := false;
7d0db5
7d0db5
  bx := bx + vx;
7d0db5
  by := by + vy;
7d0db5
7d0db5
  if bx > ClientWidth  - ballR then begin vx := -abs(vx); collision := true; end;
7d0db5
  if by > ClientHeight - ballR then begin vy := -abs(vy); collision := true; end;
7d0db5
  if bx < ballR                then begin vx :=  abs(vx); collision := true; end;
7d0db5
  if by < ballR                then begin vy :=  abs(vy); collision := true; end;
7d0db5
7d0db5
  minSqlen := sqr(ballR + pointR);
7d0db5
  for i := 0 to length(points)-1 do begin
7d0db5
    dx := points[i].X-bx;
7d0db5
    dy := points[i].Y-by;
7d0db5
    sqlen := sqr(dx) + sqr(dy);
7d0db5
    if (sqlen > 0.1*minSqlen) and (minSqlen > sqlen) then begin
7d0db5
      dv := -2*(dx*vx + dy*vy)/sqlen;
7d0db5
      if dv < 0 then begin
7d0db5
        vx := vx + dv*dx;
7d0db5
        vy := vy + dv*dy;
7d0db5
        collision := true;
7d0db5
      end;
7d0db5
    end;
7d0db5
  end;
7d0db5
7d0db5
  if not collision then vy := vy + g;
7d0db5
  if collision then refresh;
7d0db5
end;
7d0db5
7d0db5
procedure TForm1.Timer2Timer(Sender: TObject);
7d0db5
begin
7d0db5
  Refresh;
7d0db5
end;
7d0db5
7d0db5
end.
7d0db5