Physics simulation of an elastic band

[Homer_simpson]

Controls:
space bar : toggle gravity
m: normal settings
n: ultra elastic fun settings
mouse to move the rope

[Zren]

Cool. It's fun shaking the mouse on anything past 20. 15 for that matter. Chaotic.

[SNIPERDUDE]

You seem to have fun making physics engines.
Real nice work as usual.

[Homer_simpson]

thanx,
i'll open source all the simulations soon i just have to rewrite a few things

[SNIPERDUDE]

Cool, would be interesting to see

Happy New Year to you

[Homer_simpson]

source:

Quote:

View.Set ("offscreenonly,graphics:1000;800")

const gconst := .005
const grav := 5.8

var bgrav := true
var dampening := 30.0
var elasticity := 24.0
function distance (x1, y1, x2, y2 : real) : real
result sqrt (((x2 - x1) ** 2) + ((y2 - y1) ** 2)) %y

end distance
type Particle_Type :
record
x, y, vx, vy, weight, t : real
end record


function findangle (x1, y1, x2, y2 : real) : real
var ang, slope : real
if not (x2 = x1) then
slope := (y2 - y1) / (x2 - x1)
else
slope := 999999999
end if
ang := arctand (slope)
if slope > 0 then
if y2 < y1 then
ang := 180 + ang
end if
end if
if slope < 0 then
if x2 < x1 then
ang := 180 + ang
end if
if x2 > x1 then
ang := 360 + ang
end if
end if
if slope = 0 then
if x2 > x1 then
ang := 0
end if
if x2 < x1 then
ang := 180
end if
end if
result ang
end findangle
type Spring_Type :
record
stretch, len, vel, acc, restlen, elasticity, damp : real
x, y : real
end record

type Vector_Type :
record
x, y : real
end record

const MaxParticles := 30


var Particles : array 1 .. MaxParticles of Particle_Type

var Springs : array 1 .. MaxParticles of Spring_Type


procedure applyforces (var p : Particle_Type, var s : Spring_Type)

var fgrav : Vector_Type
fgrav.x := 0
fgrav.y := -grav * p.weight
var felastic : Vector_Type
var fdamp : Vector_Type
var angleelastic := findangle (p.x, p.y, s.x, s.y)
felastic.x := elasticity * (distance (p.x, p.y, s.x, s.y) - s.restlen) * cosd (angleelastic)
felastic.y := elasticity * (distance (p.x, p.y, s.x, s.y) - s.restlen) * sind (angleelastic)

fdamp.x := -dampening * (p.vx)
fdamp.y := -dampening * (p.vy)
var fnet : Vector_Type
fnet.x := felastic.x + fdamp.x
if bgrav then
fnet.y := (felastic.y + fgrav.y) + fdamp.y
else
fnet.y := felastic.y + fdamp.y

end if

p.vx += (fnet.x) / p.weight
p.vy += (fnet.y) / p.weight
if p.y < 0 then
p.vy := .06 * abs (p.vy)
end if
if p.y > maxy then
p.vy := -.6 * abs (p.vy)
end if
if p.x < 0 then
p.vx := .6 * abs (p.vy)
end if
if p.x > maxx then
p.vx := -.6 * abs (p.vy)
end if
p.x += p.vx
p.y += p.vy
p.t += .01
end applyforces

procedure RenewParticle (var p : Particle_Type, x, y : int, a, r, w : real)
p.x := x
p.y := y
p.vx := a
p.vy := r
p.weight := w
p.t := 0
end RenewParticle

procedure RenewSpring (var s : Spring_Type, x, y, len : int)
s.x := x
s.y := y
s.restlen := len
end RenewSpring



for i : 1 .. MaxParticles
RenewParticle (Particles (i), Rand.Int (0, 1000), 500, 0, 0, 30)
RenewSpring (Springs (i), Rand.Int (0, 1000), Rand.Int (400, 700), 10)
end for
colorback (black)
cls
RenewSpring (Springs (MaxParticles), 200, 750, 10)

%RenewParticle (Particles (1), 610, 700, 0, 0, 60)
%RenewSpring (Springs (5), 400, 700, 500)

var chars : array char of boolean

var gx, gy := 40
var forceg : real
color (white)
var mx, my, mb : int
var ParticleSelected := false
var SpringSelected := false
var ParticleSelNum := 0

loop

Input.KeyDown (chars)
if chars (' ') then
bgrav := not bgrav
delay (100)
end if
if chars ('q') then
elasticity += .1
end if
if chars ('a') then
elasticity -= .1
end if
if chars ('w') then
dampening += .1
end if
if chars ('s') then
dampening -= .1
end if
if chars ('m') then
dampening := 30.0
elasticity := 24.0
end if
if chars ('n') then
dampening := 16.2
elasticity := 8.7
bgrav := false

end if

for i : 1 .. MaxParticles
for ii : 1 .. MaxParticles - 1
Springs (ii).x := Particles (ii + 1).x
Springs (ii).y := Particles (ii + 1).y

end for

applyforces (Particles (i), Springs (i))
for ii : 1 .. MaxParticles - 1
Springs (ii).x := Particles (ii + 1).x
Springs (ii).y := Particles (ii + 1).y

end for


Mouse.Where (mx, my, mb)
if mb not= 0 then
if not ParticleSelected then
if distance (mx, my, Particles (i).x, Particles (i).y) < 40 then
ParticleSelected := true
ParticleSelNum := i

elsif distance (mx, my, Springs (i).x, Springs (i).y) < 40 then
SpringSelected := true
ParticleSelNum := i
% applyforces (Particles (i), Springs (i))
end if
end if
else
ParticleSelected := false
SpringSelected := false

% applyforces (Particles (i), Springs (i))
end if

if ParticleSelected then
if ParticleSelNum < (MaxParticles - 4) then

Particles (ParticleSelNum).x := mx
Particles (ParticleSelNum).y := my
Particles (ParticleSelNum).vx := 0
Particles (ParticleSelNum).vy := 0
end if
end if
if SpringSelected then
if ParticleSelNum < (MaxParticles - 4) then
Springs (ParticleSelNum).x := mx
Springs (ParticleSelNum).y := my
else
Springs (MaxParticles).x := mx
Springs (MaxParticles).y := my
end if
end if

locate (1, 1)
for ii : 1 .. MaxParticles - 1
Springs (ii).x := Particles (ii + 1).x
Springs (ii).y := Particles (ii + 1).y

end for

%drawfilloval (round (Particles (6).x), round (Particles (6).y), round (Particles (6).weight / 5), round (Particles (6).weight / 5), 13)
%drawfilloval (round (Springs (6).x), round (Springs (6).y), round (Particles (6).weight / 5), round (Particles (6).weight / 5), 11)

%Springs (MaxParticles).x := Particles (1).x
%Springs (MaxParticles).y := Particles (1).y

put "Press Space bar To activate or deactivate gravity or use mouse to move ball or elastic, Gravity On : ", bgrav
locate (2, 1)
put "Dampening : ", dampening, " Spring constant : ", elasticity
%drawline (roun1d (Particles (i).x), round (Particles (i).y), Springs (i).x, Springs (i).y, 14)
%drawfillbox (round (Springs (i).x) - 10, round (Springs (i).y) - 10, round (Springs (i).x) + 10, round (Springs (i).y) + 10, 12)
%DrawSpring (round (Particles (i).x), round (Particles (i).y), Springs (i).x, Springs (i).y, 10)

%drawfilloval (round (Particles (i).x), round (Particles (i).y), round (Particles (i).weight / 5), round (Particles (i).weight / 5), 12)

end for
for ii : 2 .. MaxParticles
Draw.ThickLine (round (Particles (ii).x), round (Particles (ii).y), round (Particles (ii - 1).x), round (Particles (ii - 1).y), 4, yellow)
drawline (round (Particles (ii).x), round (Particles (ii).y), round (Particles (ii - 1).x), round (Particles (ii - 1).y), 67)
end for
View.Update
cls
end loop