Blame lazarus/gravity/unit1.pas

1beac4
unit Unit1;
1beac4
1beac4
{$mode objfpc}{$H+}
1beac4
1beac4
interface
1beac4
1beac4
uses
1beac4
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
1beac4
1beac4
type
1beac4
1beac4
  { TForm1 }
1beac4
1beac4
  TForm1 = class(TForm)
1beac4
    Timer1: TTimer;
1beac4
    procedure FormCreate(Sender: TObject);
1beac4
    procedure FormPaint(Sender: TObject);
1beac4
    procedure Timer1Timer(Sender: TObject);
1beac4
  private
1beac4
    { private declarations }
1beac4
  public
1beac4
    { public declarations }
1beac4
  end;
1beac4
1beac4
  TBall = record
1beac4
    x, y, vx, vy, ax, ay, r, m: double;
1beac4
  end;
1beac4
1beac4
const
1beac4
  ballsCount = 5;
1beac4
  g = 100;
1beac4
1beac4
var
1beac4
  Form1: TForm1;
1beac4
  balls: array[0..ballsCount] of TBall;
1beac4
  ringX: double = 500;
1beac4
  ringY: double = 500;
1beac4
1beac4
implementation
1beac4
1beac4
uses Math;
1beac4
1beac4
{$R *.lfm}
1beac4
1beac4
function RingNormalize(a, ringSize: double): double;
1beac4
begin
1beac4
  if ringSize = 0 then Result := a else
1beac4
    Result := a - ringSize*Floor(a/ringSize);
1beac4
end;
1beac4
1beac4
function RingDelta(a, b, ringSize: double): double;
1beac4
begin
1beac4
  if ringSize = 0 then Result := a - b else begin
1beac4
    Result := RingNormalize(a - b, ringSize);
1beac4
    if Result > ringSize/2 then Result := Result - ringSize;
1beac4
  end;
1beac4
end;
1beac4
1beac4
{ TForm1 }
1beac4
1beac4
procedure TForm1.FormCreate(Sender: TObject);
1beac4
var
1beac4
  i: integer;
1beac4
  r: double;
1beac4
begin
1beac4
  ringX := ClientWidth;
1beac4
  ringY := ClientHeight;
1beac4
  Randomize;
1beac4
  for i := 0 to ballsCount-1 do begin
1beac4
    r := 10 + 30*Random;
1beac4
    balls[i].x := ringX * Random;
1beac4
    balls[i].y := ringY * Random;
1beac4
    balls[i].vx := 0;
1beac4
    balls[i].vy := 0;
1beac4
    balls[i].r := r;
1beac4
    balls[i].m := r*r*r;
1beac4
  end;
1beac4
end;
1beac4
1beac4
procedure TForm1.FormPaint(Sender: TObject);
1beac4
var
1beac4
  i, j, k: integer;
1beac4
  x, y, r: double;
1beac4
begin
1beac4
  for i := 0 to ballsCount-1 do begin
1beac4
    r := balls[i].r;
1beac4
    for j := -1 to 1 do for k := -1 to 1 do begin
1beac4
      x := balls[i].x + ringX * j;
1beac4
      y := balls[i].y + ringY * k;
1beac4
      Canvas.Ellipse(round(x-r), round(y-r), round(x+r), round(y+r));
1beac4
    end;
1beac4
  end;
1beac4
end;
1beac4
1beac4
procedure TForm1.Timer1Timer(Sender: TObject);
1beac4
var
1beac4
  t, i, j: integer;
1beac4
  dx, dy, d, nx, ny, ax, ay, dt, dvx, dvy, dv
1beac4
  , v0, v1: double;
1beac4
begin
1beac4
  dt := Timer1.Interval/1000/1000;
1beac4
1beac4
  for t := 1 to 1000 do begin
1beac4
  for i := 0 to ballsCount-1 do begin
1beac4
    balls[i].ax := 0;
1beac4
    balls[i].ay := 0;
1beac4
  end;
1beac4
1beac4
  for i := 0 to ballsCount-1 do begin
1beac4
    for j := i+1 to ballsCount-1 do begin
1beac4
      dx := RingDelta(balls[j].x, balls[i].x, ringX);
1beac4
      dy := RingDelta(balls[j].y, balls[i].y, ringY);
1beac4
      d := sqrt(dx*dx + dy*dy);
1beac4
      nx := dx / d;
1beac4
      ny := dy / d;
1beac4
      if d > balls[i].r + balls[j].r then begin
1beac4
        ax := g*balls[i].m*balls[j].m*nx/(d*d);
1beac4
        ay := g*balls[i].m*balls[j].m*ny/(d*d);
1beac4
        balls[i].ax := balls[i].ax + ax;
1beac4
        balls[i].ay := balls[i].ay + ay;
1beac4
        balls[j].ax := balls[j].ax - ax;
1beac4
        balls[j].ay := balls[j].ay - ay;
1beac4
      end else begin
1beac4
        dvx := balls[j].vx - balls[i].vx;
1beac4
        dvy := balls[j].vy - balls[i].vy;
1beac4
        dv := dvx*nx + dvy*ny;
1beac4
        if dv<0 then begin
1beac4
          v0 :=  2*dv*balls[j].m/(balls[i].m + balls[j].m);
1beac4
          v1 := -2*dv*balls[i].m/(balls[i].m + balls[j].m);
1beac4
          balls[i].vx := balls[i].vx + v0*nx;
1beac4
          balls[i].vy := balls[i].vy + v0*ny;
1beac4
          balls[j].vx := balls[j].vx + v1*nx;
1beac4
          balls[j].vy := balls[j].vy + v1*ny;
1beac4
        end;
1beac4
      end;
1beac4
    end;
1beac4
  end;
1beac4
1beac4
  for i := 0 to ballsCount-1 do begin
1beac4
    balls[i].vx := balls[i].vx + balls[i].ax*dt/balls[i].m;
1beac4
    balls[i].vy := balls[i].vy + balls[i].ay*dt/balls[i].m;
1beac4
    balls[i].x := RingNormalize(balls[i].x + balls[i].vx*dt, ringX);
1beac4
    balls[i].y := RingNormalize(balls[i].y + balls[i].vy*dt, ringY);
1beac4
  end;
1beac4
  end;
1beac4
1beac4
  Refresh;
1beac4
end;
1beac4
1beac4
1beac4
end.
1beac4