-----------------------------------

Homer_simpson

Wed Dec 24, 2008 1:02 am


Physics simulation of an elastic band

-----------------------------------

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


-----------------------------------

Zren

Tue Dec 30, 2008 2:44 am


Re: Physics simulation of an elastic band

-----------------------------------

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


-----------------------------------

SNIPERDUDE

Tue Dec 30, 2008 5:29 pm


RE:Physics simulation of an elastic band

-----------------------------------

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


-----------------------------------

Homer_simpson

Wed Dec 31, 2008 5:19 pm


Re: Physics simulation of an elastic band

-----------------------------------

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


-----------------------------------

SNIPERDUDE

Thu Jan 01, 2009 11:51 am


RE:Physics simulation of an elastic band

-----------------------------------

Cool, would be interesting to see

Happy New Year to you


-----------------------------------

Homer_simpson

Mon Jan 05, 2009 11:49 pm


Re: Physics simulation of an elastic band

-----------------------------------

source:
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