old/PAS/!SPbSTU/Springs/SPRING.BAK

{$N+}
Uses Graph,CRT;

type
 float = double;
 tVec = record
  x,y,z : float;
 end;

const
 ZeroVec : tVec = (X:0.0;Y:0.0;Z:0.0);
 MaxSpr  = 250;
 Distance_Thresh = 1e-5;
 CurID   : word = 1;

type
 tID     = 1..MaxSpr;

 pDistArr = ^tDistArr;
 tDistArr = array [1..10] of float;

 pSpring = ^tSpring;
 pSprArr = ^tSprArr;
 tSpring = record
  ID            : tID;
  Already       : array [1..MaxSpr] of boolean;
  pos,vel,Force : tVec;
  mass          : float;
  dists         : pDistArr;
  Ks            : pDistArr;
  neibs         : pSprArr;
  neib_count    : word;
 end;
 tSprArr = array [1..10] of pSpring;

 pAnchor = ^tAnchor;
 tAnchor = record
  pos  : tVec;
  Node : pSpring;
 end;

 tAnchArr = array [1..10] of pAnchor;
 pAnchArr = ^tAnchArr;

 pModel = ^tModel;
 tModel = record
  Springs : pSprArr;
  SprNum  : tID;
  Anchors : pAnchArr;
  AnchNum : tID;
  Glob_Force : tVec;
  Gravity : tVec;
  Pos     : tVec;
  energy_loss : float;
 end;

{----------------------------------------}
Procedure VecAdd(var aC:tVec;aA,aB:tVec);
begin
 aC.x := aA.x + aB.x;
 aC.y := aA.y + aB.y;
 aC.z := aA.z + aB.z;
end;{VecAdd}
{-------------------------------}
Procedure VecSub(var aC:tVec;aA,aB:tVec);
begin
 aC.x := aA.x - aB.x;
 aC.y := aA.y - aB.y;
 aC.z := aA.z - aB.z;
end;{VecAdd}
{-------------------------------}
Procedure VecNeg(var aV:tVec);
begin
 aV.X := -aV.x;
 aV.y := -aV.y;
 aV.z := -aV.z;
end;{NegVec}
{-------------------------------}
Procedure VecMul(var aV:tVec;aC:float);
begin
 aV.x := aV.x * aC;
 aV.y := aV.y * aC;
 aV.z := aV.z * aC;
end;{MulScal}
{-------------------------------}
Function NewSpring(ax,ay,az:float;aNeib_count:word):pSpring;
var
 mNew : pSpring;
begin
 New(mNew);
 with mNew^ do begin
  ID := CurID;Inc(CurID);
  Pos.x := ax;
  Pos.y := ay;
  Pos.z := aZ;
  Vel := ZeroVec; Force := ZeroVec;
  neib_Count := aNeib_Count;
  GetMem(neibs,neib_Count*SizeOf(pSpring));
  GetMem(dists,neib_Count*SizeOf(float));
  GetMem(ks,neib_Count*SizeOf(float));
  FillChar(neibs^,neib_Count*SizeOf(pSpring),0);
  FillChar(dists^,neib_Count*SizeOf(float),0);
  FillChar(ks^,neib_Count*SizeOf(float),0);
 end;
 NewSpring := mNew;
end;{NewSpring}
{----------------------------------------}
Procedure DelSpring(var aSpr:pSpring);
begin
 if aSpr = nil then exit;
 FreeMem(aSpr^.Dists,aSpr^.neib_count*sizeof(float));
 FreeMem(aSpr^.Ks,aSpr^.neib_count*sizeof(float));
 FreeMem(aSpr^.neibs,aSpr^.neib_count*sizeof(pSpring));
 Dispose(aSpr);
 aSpr := nil;
end;{DelSpring}
{----------------------------------------}
Procedure CalcSingleSpring(aA:pSpring);
var
 mDist : float;
 mB    : pSpring;
 mForce: tVec;
 i     : word;
begin
 for i := 1 to aA^.neib_count do
 begin
  mB := aA^.neibs^[i];                     {Get cur neigbour}
  if aA^.Already[mB^.ID] then continue;   {If we calculated force, in B's loop
                                           so do next :) }
  aA^.Already[mB^.ID] := true;            {Just for US}
  VecSub(mForce,mB^.pos,aA^.pos);         {Calculate delta vector}
  with mForce do mDist := sqrt(x*x+y*y+z*z); {Calc distance}
  if mDist <  Distance_Thresh then        {Why so close ?}
   mForce := ZeroVec    {This is'n true, but don't creates errornous effects}
  else
  begin
   VecMul(mForce,1/mDist);                 {Normalize force}
   mDist := mDist - aA^.dists^[i];         {Calc dX in F=k*dX}
   VecMul(mForce,mDist*aA^.kS^[i]);        {Calc force}
  end;

  VecAdd(aA^.Force,aA^.Force,mForce);     {Add our force}
  mB^.Already[aA^.ID] := true;            {So we calc-ed 2 forces}
  VecNeg(mForce);                         {differs by sign}
  VecAdd(mB^.Force,mB^.Force,mForce);     {so add it too}
 end;
end;{CalcSingleSpring}
{-----------------------------------}
Procedure ModelCalcForces(aM:pModel);
var
 i : tID;
begin
 for i := 1 to aM^.SprNum do
 begin
  aM^.Springs^[i]^.Force := ZeroVec;
  FillChar(aM^.Springs^[i]^.Already,MaxSpr*SizeOf(Boolean),0);
 end;
 for i := 1 to aM^.SprNum do CalcSingleSpring(aM^.Springs^[i]);
end;{ModelCalcForces}
{----------------------------------}
Procedure ModelApplyForces(aM:pModel;aTime:float);
var
 mAccel : tVec;
 mC     : pSpring;
 dX     : tVec;
 i      : tID;
begin
 for i := 1 to aM^.SprNum do
 begin
  mC := aM^.Springs^[i];
  mAccel := mC^.Force;          {So our new acceleration is formed from force}
  VecMul(mAccel,1/mC^.Mass);    {dividing by mass}
  VecAdd(mAccel,mAccel,aM^.Gravity); {Add the 'g'}
  VecMul(mAccel,aTime);         {For modeling time}
  VecAdd(mC^.Vel,mC^.Vel,mAccel);
  dX := mC^.Vel;                {delta X is Speed}
  VecMul(dx,aTime);             {multiplyed by time}
  VecAdd(mC^.Pos,mC^.Pos,dx);   {That's all with pos folks}
  if mC^.Pos.X < 0 then
  begin
   mC^.Vel.X := -mC^.Vel.X;
   mC^.Pos.X := 1;
  end;
  if mC^.Pos.Y < 0 then begin
   mC^.Vel.Y := -mC^.Vel.Y;
   mC^.Pos.Y := 1;
  end;
  if mC^.Pos.X > 638 then
  begin
   mC^.Vel.X := -mC^.Vel.X;
   mC^.Pos.X := 637;
  end;
  if mC^.Pos.Y > 478 then
  begin
   mC^.Vel.Y := -mC^.Vel.Y;
   mC^.Pos.Y := 477;
  end;
  VecMul(mC^.Vel,aM^.Energy_Loss); {Loss some speed in time}
 end;
end;{ModelApplyForces}
{----------------------------------}
Procedure ModelCheckAnchors(aM:pModel);
var
 i : tID;
begin
 for i := 1 to aM^.AnchNum do 
  aM^.Anchors^[i]^.Node^.Pos := aM^.Anchors^[i]^.Pos;
end;{ModelCheckAnchors}
{----------------------------------}
Procedure RenderStringSpring(aM:pModel);
var
 i : tID;
 gx,gy : float;

Procedure LineCross(aV:tVec);
begin
 Line(round(aV.x+gx)-3,
      round(aV.y+gy),
      round(aV.x+gx)+3,
      round(aV.y+gy));
 Line(round(aV.x+gx),
      round(aV.y+gy)-3,
      round(aV.x+gx),
      round(aV.y+gy)+3);
end;

begin
 gx := aM^.Pos.X;
 gy := aM^.Pos.Y;
 for i := 1 to aM^.SprNum-1 do
  begin
    SetColor(Green);
    Line(round(gx+aM^.Springs^[i]^.pos.x),
         round(gy+aM^.Springs^[i]^.pos.y),
         round(gx+aM^.Springs^[i+1]^.pos.x),
         round(gy+aM^.Springs^[i+1]^.pos.y));
    SetColor(Red);
    LineCross(aM^.Springs^[i]^.pos);
  end;
 LineCross(aM^.Springs^[i+1]^.Pos);
end;{RenderStringSpring}
{----------------------------------}
Function InitMouse:boolean;assembler;
asm
 mov ax, 00
 int 33h
 cmp ax, 0ffffh
 jnz @@1
 mov ax, 7
 mov cx, 0
 mov dx, 639
 int 33h
 mov ax, 08
 mov cx, 0
 mov dx, 479
 int 33h
 mov ax, 1
@@1:
 ret
end;{InitMouse}
Procedure MoveMouse(x,y:word);assembler;
asm
 mov cx, x
 mov dx, y
 mov ax, 4
 int 33h
end;{ModeMouse}
Procedure MousePosition(var x,y:word);assembler;
asm
 mov ax, 3
 int 33h
 les di, x
 mov es:[di], cx
 les di, y
 mov es:[di], dx
end;{MousePosition}
Procedure HideMouse;assembler;
asm
 mov ax, 2
 int 33h
end;
{-------------------------}
var
 mString : pModel;
 i       : tID;
 mx,my   : word;
 j       : longint;
 gD,gM   : integer;
 SizeX   : float;
BEGIN
 New(mString);
 with mString^ do begin
   SprNum := 15;
   AnchNum := 1;
   SizeX := 600;
   GetMem(Springs,SprNum*SizeOf(pSpring));
   GetMem(Anchors,AnchNum*SizeOf(pAnchor));

   Springs^[1]      := NewSpring(0,0,0,1);
   Springs^[SprNum] := NewSpring(SizeX*0.9,0,0,1);

   for i := 1 to SprNum-2 do
    Springs^[i+1] := NewSpring(i*SizeX/SprNum,0,0,2);

   Springs^[1]^.Neibs^[1] := Springs^[2];
   Springs^[1]^.Dists^[1] := SizeX/SprNum;
   Springs^[1]^.Mass := 1;
   Springs^[1]^.Ks^[1] := 0.25;

   Springs^[SprNum]^.Neibs^[1] := Springs^[SprNum-1];
   Springs^[SprNum]^.Dists^[1] := 0.5*SizeX/SprNum;
   Springs^[SprNum]^.Mass := 1;
   Springs^[SprNum]^.Ks^[1] := 0.25;

   for i := 2 to SprNum-1 do begin
    Springs^[i]^.Neibs^[1] := Springs^[i-1];
    Springs^[i]^.Neibs^[2] := Springs^[i+1];
    Springs^[i]^.Dists^[1] := 0.5*SizeX/SprNum;
    Springs^[i]^.Dists^[2] := 0.5*SizeX/SprNum;
    Springs^[i]^.Ks^[1] := 0.08;
    Springs^[i]^.Ks^[2] := 0.08;
    Springs^[i]^.Mass := 1;
   end;

   New(Anchors^[1]);
   Anchors^[1]^.Node := Springs^[1];
   Anchors^[1]^.Pos := ZeroVec;
{
   New(Anchors^[2]);
   Anchors^[2]^.Node := Springs^[SprNum];
   Anchors^[2]^.Pos.X := 600;
   Anchors^[2]^.Pos.Y := 100;
   Anchors^[2]^.Pos.Z := 0;
}
   Pos.x := 0;
   pos.y := 0;
   pos.z := 0;
   Gravity := ZeroVec;
   Gravity.Y := 0.09;
   Energy_Loss := 0.98;

   gD:=Detect;
   InitGraph(gD,gM,'');
   InitMouse;
   MoveMouse(10,5);

   while not keypressed do
    begin
     MousePosition(mx,my);
     Anchors^[1]^.pos.x := mx;
     Anchors^[1]^.pos.y := my;
     ModelCalcForces(mString);
     ModelApplyForces(mString,1);
     ModelCheckAnchors(mString);
     repeat until (Port[$03DA] and 8) <> 8;
     repeat until (Port[$03DA] and 8) =  8;
     ClearDevice;
     RenderStringSpring(mString);
    end;

   Dispose(Anchors^[1]);
   For i := 1 To SprNum Do DelSpring(Springs^[i]);

   FreeMem(Springs, SprNum*SizeOf(pSpring));
   FreeMem(Anchors,AnchNum*SizeOf(pAnchor));
   CloseGraph;
 end;
END.