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

const gconst := .005
var bgrav := true
var dampening := 3.0
var springconst := .5
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


procedure DrawSpring (x1, y1, x2, y2, k : real)
var tx, ty : real := 0
var tx2, ty2 : real
tx2 := x1
ty2 := y1
var i : real := 0
var td := round (distance (x1, y1, x2, y2))
if td = 0 then
td := 1
end if
var Rotaion := -findangle (x1, y1, x2, y2)
if round (90 / (3600 / td)) > 0 then
loop
i += 90 / (3600 / td)

exit when i >= td
tx := i
ty := (20 * sind ((i * (3600)) / td))
% drawdot (round (- (((0 - tx) * cosd (Rotaion)) + ((0 - ty) * sind (Rotaion))) + x1),
% round (- (((0 - ty) * cosd (Rotaion)) - ((0 - tx) * sind (Rotaion))) + y1), black)

Draw.ThickLine (round (- (((0 - tx) * cosd (Rotaion)) + ((0 - ty) * sind (Rotaion))) + x1),
round (- (((0 - ty) * cosd (Rotaion)) - ((0 - tx) * sind (Rotaion))) + y1), round (tx2), round (ty2), 3, 14)
tx2 := - (((0 - tx) * cosd (Rotaion)) + ((0 - ty) * sind (Rotaion))) + x1
ty2 := - (((0 - ty) * cosd (Rotaion)) - ((0 - tx) * sind (Rotaion))) + y1

end loop
Draw.ThickLine (round (x2), round (y2), round (tx2), round (ty2), 3, 14)
end if
end DrawSpring

/*
* ? = angle (0 = vertical, increases counter-clockwise)
* S = spring stretch (displacement from rest length)
* L = length of spring
* u = position of bob
* v = u'= velocity of bob
* a = u''= acceleration of bob

Define some constants:

* R = rest length of spring
* T = position of anchor point
* m = mass of bob
* k = spring constant
* b = damping constant
* g = gravitational constant*/
const grav := 2.8
type Spring_Type :
record
stretch, len, vel, acc, restlen, springconst, damp : real
x, y : real
end record

type Vector_Type :
record
x, y : real
end record

const MaxParticles := 6


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 fspring : Vector_Type
var fdamp : Vector_Type
var anglespring := findangle (p.x, p.y, s.x, s.y)
fspring.x := springconst * (distance (p.x, p.y, s.x, s.y) - s.restlen) * cosd (anglespring)
fspring.y := springconst * (distance (p.x, p.y, s.x, s.y) - s.restlen) * sind (anglespring)

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

end if

p.vx += (fnet.x) / p.weight
p.vy += (fnet.y) / p.weight
if p.y < 0 then
p.vy := .6 * 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), 200)
end for
colorback (black)
cls

RenewParticle (Particles (1), 610, 700, 0, 0, 30)
RenewSpring (Springs (5), 400, 700, 500)
bgrav := false

var chars : array char of boolean

var gx, gy := 40
var forceg : real
color (white)
var mx, my, mb : int


loop

Input.KeyDown (chars)
if chars (' ') then
bgrav := not bgrav
delay (100)
end if
if chars ('q') then
springconst += .1
end if
if chars ('a') then
springconst -= .1
end if
if chars ('w') then
dampening += .1
end if
if chars ('s') then
dampening -= .1
end if

for i : 1 .. MaxParticles
Mouse.Where (mx, my, mb)
if mb not= 0 then
if distance (mx, my, Particles (i).x, Particles (i).y) < 100 then
Particles (i).x := mx
Particles (i).y := my
Particles (i).vx := 0
Particles (i).vy := 0

elsif distance (mx, my, Springs (i).x, Springs (i).y) < 100 then
Springs (i).x := mx
Springs (i).y := my
% applyforces (Particles (i), Springs (i))
end if
else

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

Springs (1).x := Particles (2).x
Springs (1).y := Particles (2).y
Springs (2).x := Particles (3).x
Springs (2).y := Particles (3).y
Springs (3).x := Particles (4).x
Springs (3).y := Particles (4).y
Springs (4).x := Particles (1).x
Springs (4).y := Particles (1).y
Springs (5).x := Particles (2).x
Springs (5).y := Particles (2).y
Particles (5).x := Particles (4).x
Particles (5).y := Particles (4).y

Springs (6).x := Particles (1).x
Springs (6).y := Particles (1).y
Particles (6).x := Particles (3).x
Particles (6).y := Particles (3).y


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 spring, Gravity On : ", bgrav
locate (2, 1)
put "Dampening : ", dampening, " Spring constant : ", springconst
%drawline (round (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
View.Update
cls
end loop