Group: alt.sci.physics.new-theories
From: dedanoe
Date: Friday, February 22, 2008 7:42 AM
Subject: lever sim of large family of weights

---location of the sim---

/
!i!% safe to download!i!

---the source code---

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TVector = array[1..3] of Real;
TMatrix = array[1..2, 1..2] of Real;
VVector = array[1..2] of TVector;
VMatrix = array[1..2] of VVector;

PTeg = ^TTeg;
TTeg = object
ExtremeSila, ExtremeKrak, AnySila, AnyKrak: TVector;
Alpha, Delta: Real;
Brat, Sin1: PTeg;
function Init(Braka, Generacia: Byte): PTeg;
procedure Pomor(T: PTeg);
end;

TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Timer1: TTimer;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Origin, Orient: TVector;
Teg: PTeg;
procedure ClrImage;
procedure Spinning(T: PTeg);
procedure CalcAny(T: PTeg);
procedure Draw(AbsKrak: TVector; T: PTeg);
end;

const Focus = 3000;
var
Form1: TForm1;
Vkupno: Integer;

implementation

{$R *.dfm}

function Ort: TVector;
begin
Result[1]:= 0; Result[2]:= 0; Result[3]:= 0;
end;

function Norm(x: TVector): Real;
begin
Result:= Sqrt(Sqr(x[1])+Sqr(x[2])+Sqr(x[3]));
end;

function Sum(x, y: TVector): TVector;
begin
Result[1]:= x[1]+y[1];
Result[2]:= x[2]+y[2];
Result[3]:= x[3]+y[3];
end;

function Ext(x: Real; y: TVector): TVector;
begin
Result[1]:= x*y[1];
Result[2]:= x*y[2];
Result[3]:= x*y[3];
end;

function CentralF(F1, F2, D1, D2: TVector): TVector;
var k1, k2: Real;
begin
if Norm(Sum(D1, D2)) <> 0 then begin
k1:= Norm(D1)/Norm(Sum(D1, D2));
k2:= Norm(D2)/Norm(Sum(D1, D2));
end else begin
k1:= Random; k2:= Random;
end;
Result:= Sum(Ext(k1, F1), Ext(k2, F2));
end;

function CentralD(F1, F2, D1, D2: TVector): TVector;
var k1, k2: Real;
begin
if Norm(Sum(F1, F2)) <> 0 then begin
k1:= Norm(F1)/Norm(Sum(F1, F2));
k2:= Norm(F2)/Norm(Sum(F1, F2));
end else begin
k1:= Random; k2:= Random;
end;
Result:= Sum(Ext(k1, D1), Ext(k2, D2));
end;

function SpinA(A: Real; F, D: TVector): VVector;
begin
Result[1]:= Sum(Ext(Cos(A), F), Ext(Sin(-A), D));
Result[2]:= Sum(Ext(Sin(A), F), Ext(Cos(-A), D));
end;

procedure SpinAB(x, y: PTeg);
begin
:= Sum(Ext(Cos( ), ),
Ext(Sin(-), ));
:= Sum(Ext(Cos( ), ),
Ext(Sin(-), ));
:= Sum(Ext(Sin( ), ),
Ext(Cos(-), ));
:= Sum(Ext(Sin( ), ),
Ext(Cos(-), ));
end;

function (Braka, Generacia: Byte): PTeg;
begin
New(Result); Vkupno:= Vkupno + 1;
if Generacia > 0 then begin
:= Init(Random(5) + 2, Generacia - 1);
if Braka > 0 then begin
:= Init(Braka - 1, Generacia);
:= Ort; := Ort;
[1]:= 20*Generacia*();
[2]:= 20*Generacia*();
[3]:= 20*Generacia*();
[1]:= 20*Generacia*();
[2]:= 20*Generacia*();
[3]:= 20*Generacia*();
:= 0;
:= 10*()*pi/180;
end else Result:= nil;
end else Result:= nil;
end;

procedure (Sender: TObject);
begin
Vkupno:= 0;
if Teg <> nil then begin
();
Dispose(Teg);
end;
New(Teg);
Origin[1]:= /2;
Origin[2]:= /2;
Origin[3]:= 200;
Orient:= Ort;
:= Ort;
:= Ort;
:= Ort;
:= Ort;
:= 0;
:= 0;
:= nil;
Randomize;
:= (Random(5) + 2, Random(5) + 2);
:= False;
:= True;
:= 'Weights total = ' + IntToStr(Vkupno);
:= True;
:= True;
end;

procedure (Sender: TObject);
begin
:= True;
:= False;
:= False;
:= False;
end;

procedure (Sender: TObject);
begin
ClrImage;
Spinning();
CalcAny();
Draw(Sum(Orient, ), );
end;

procedure ;
begin
:= clWhite;
:= clBlack;
(0, 0, , );
end;

procedure (T: PTeg);
begin
if T <> nil then begin
Spinning();
Spinning();
:= + ;
end;
end;

procedure (T: PTeg);
var x: PTeg; F, D: TVector;
begin
if T <> nil then begin
CalcAny();
CalcAny();
x:= ;
while x <> nil do begin
F:= CentralF(, , ,
);
D:= CentralD(, , ,
);
SpinA(( + )/2, F, D);
SpinAB(T, x);
:= Sum(, Ext(-1, D));
:= Sum(, Ext(-1, D));
x:= ;
end;
end;
end;

procedure (AbsKrak: TVector; T: PTeg);
var x, y: Integer; Krak: TVector;
begin
if T <> nil then begin
Draw(Sum(AbsKrak, ), );
Draw(AbsKrak, );
if Abs(AbsKrak[3]) < Focus then begin
x:= div 2 + Round(AbsKrak[1]*Focus/(Focus -
AbsKrak[3]));
y:= div 2 + Round(AbsKrak[2]*Focus/(Focus -
AbsKrak[3]));
(x, y);
Krak:= Sum(AbsKrak, );
if Abs(Krak[3]) < Focus then begin
x:= div 2 + Round(Krak[1]*Focus/(Focus -
Krak[3]));
y:= div 2 + Round(Krak[2]*Focus/(Focus -
Krak[3]));
(x, y);
end;
end;
end;
end;

procedure T(T: PTeg);
begin
if T <> nil then begin
Pomor();
Pomor();
Dispose(T);
end;
end;

procedure (Sender: TObject; var Action: TCloseAction);
begin
if Teg <> nil then begin
();
Dispose(Teg);
end;
end;

end.