Post by ubi44 on Jul 20, 2024 15:58:33 GMT
PARIS 2024 (1day before...
Type vec3
x As _Float
y As _Float
z As _Float
End Type
Type mass
m As _Float
memkdo As _Float
Po As vec3
Vel As vec3
Force As vec3
End Type
Type spring
m1 As Integer
m2 As Integer
sC As _Float
sL As _Float
frt As _Float
End Type
ReDim Shared NBCorde, NBM, MAXFire
NBM = 8
M = .15F
sC = 2000.0F ' springconstant
dL = 0.055F ' springlenght
sL = Sqr(dL * dL + dL * dL)
sFrt = 1.0F ' springfrictionconstant
NBCorde = 2
MAXFire = 3
ReDim Shared Mass(MAXFire, NBCorde, NBM) As mass
ReDim Shared Spring(MAXFire, NBCorde, NBM - 1) As spring
For j = 0 To MAXFire
For b = 0 To NBCorde
For A = 0 To NBM
Mass(j, b, A).Po.y = A * -dL
Mass(j, b, A).m = M
Mass(j, b, A).Po.z = 0 ' a * dL
Next A
For p = 1 To NBM
A = p - 1
Spring(j, b, A).m1 = (p)
Spring(j, b, A).m2 = (p - 1)
Spring(j, b, A).sC = sC '+ (RND - RND) * 500
Spring(j, b, A).sL = sL
Spring(j, b, A).frt = sFrt
Next p
Next b
Next j
Type artifice
P As _Float
Vx As _Float
Vy As _Float
pX As _Float
pY As _Float
r As Single
g As Single
b As Single
End Type
ReDim Shared NBArtif, NBPArtif
NBPArtif = 150
NBArtif = 10
ReDim Shared maxCercle
maxCercle = 60
ReDim Shared Artif(NBArtif, NBPArtif) As artifice
ReDim Shared ActiF(NBArtif)
ReDim Shared maCv(maxCercle, maxCercle * 2, maxCercle * 2) As Single
precalcus
FPS = 60
before = Timer + 1
Type anneaux
px As _Float
py As _Float
End Type
Type partic
x As _Float
y As _Float
vx As _Float
vy As _Float
P As _Float
End Type
D = Val(Mid$(Date$, 4, 2)) '+ 1
M = Val(Left$(Date$, 2))
Y = Val(Right$(Date$, 4))
If M <> 7 Or Y > 2024 Then
_Title "Olympics PARIS 2024"
Q = -1
Else
Q = 26 - D
If Q <= 0 Then
_Title "Olympics PARIS 2024"
Q = -1
Else
_Title "Olympics PARIS 2024 __ D-" + Str$(Q)
End If
End If
Randomize Timer
Screen _NewImage(768 * 16 / 9, 768, 32)
Print "PARIS 2024"
w = 8 * Len("PARIS 2024"): h = 16
Dim pt(w, h) As _Byte
black&& = Point(0, 10)
For Y = 0 To h
For X = 0 To w
If Point(X, Y) <> black&& Then
pt(X, Y) = 1
End If
Next
Next
Cls
If Q <> -1 Then
Print "D -"; Q
w2 = 8 * Len("D -" + Str$(Q)): h2 = 16
Dim pt2(w2, h2) As _Byte
For Y = 0 To h2
For X = 0 To w2
If Point(X, Y) <> black&& Then
pt2(X, Y) = 1
End If
Next
Next
End If
xoo = _Width / 2 - (w / 2) * 6: yoo = _Height - 250: M = 6
xoo2 = _Width / 2 - (w2 / 2) * 3: yoo2 = _Height - 150: M2 = 3
Dim P(5, Int(_Pi * 20)) As partic
Dim mP(5, Int(_Pi * 20)) As partic
Dim A(5) As anneaux
Dim B(5) As anneaux
R = 100
A(1).px = _Width / 2: A(2).px = A(1).px - R * 2: A(3).px = A(1).px + R * 2
A(1).py = _Height: A(2).py = _Height: A(3).py = _Height
A(4).px = A(1).px - R: A(5).px = A(1).px + R
A(4).py = A(1).py + R: A(5).py = A(1).py + R
B(1).px = _Width / 2: B(2).px = B(1).px - R * 2 - R / 4: B(3).px = B(1).px + R * 2 + R / 4
B(1).py = _Height: B(2).py = _Height: B(3).py = _Height
B(4).px = B(1).px - R - R / 4: B(5).px = B(1).px + R + R / 4
B(4).py = B(1).py + R: B(5).py = B(1).py + R
For i = 1 To 5
For t = 0 To _Pi * 20
mP(i, t).x = B(i).px - _Width / 2 + Cos(t * .1) * R: mP(i, t).y = B(i).py - _Height - R * 1.5 + Sin(t * .1) * R: mP(i, t).P = 0
'mP(i, t).vx = Cos(t * .1): mP(i, t).vy = Sin(t * .1)
Next t
Next i
Do
ReDim Shared Artif(NBArtif, NBPArtif) As artifice
ReDim Shared ActiF(NBArtif)
For i = 1 To 5
For t = 0 To _Pi * 20
P(i, t).x = A(i).px: P(i, t).y = A(i).py: P(i, t).P = 0
P(i, t).vx = Cos(t * .1): P(i, t).vy = Sin(t * .1)
Next t
Next i
ptr = 0: bl = -0.127: bot = 2
td = 0
tim! = Timer + .1
trace:
bl = bl + .002: Aa = ((R * 2 - ptr) / (R * 2)) * 255: dd = ptr / (R * 2)
For i = 1 To 5
Select Case i
Case 1
Rr = 255 * dd: Gg = 255 * dd: Bb = 255 * dd
Case 2
Rr = 0: Gg = 134 * dd: Bb = 195 * dd
Case 3
Rr = 224 * dd: Gg = 0: Bb = 36 * dd
Case 4
Rr = 243 * dd: Gg = 195 * dd: Bb = 0
Case 5
Rr = 2 * dd: Gg = 158 * dd: Bb = 57 * dd
End Select
For t = 0 To _Pi * 20 '
P(i, t).x = P(i, t).x + P(i, t).vx * .3 * bot
P(i, t).y = P(i, t).y + P(i, t).vy * .3 * bot
If ptr > R * 1.5 And Rnd < .1 Then P(i, t).P = 1
If P(i, t).P = 1 Then cerclefumee 0, 0, (ptr / (R * 2)) * 25, 0, 0, 0, 0: _Continue
If ptr = ptr + fg Then Circle (P(i, t).x, P(i, t).y), 10 - (ptr / (R * 2 - 30)) * 10, _RGBA(Rr, Gg, Bb, (255 - Aa))
cerclefumee P(i, t).x, P(i, t).y, (ptr / (R * 2)) * 25, Aa, Rr, Gg, Bb
P(i, t).vy = P(i, t).vy + bl * 1.5 * bot
Next t, i
If bot = 2 Then
td = td + 1.5
For Y = 0 To h - 1
For X = 0 To w - 1
If pt(X, Y) Then
cerclefumee xoo + X * M, yoo + Y * M, M * 1.5, td * .8, td * .8, td * .8, td * .8
cerclefumee xoo + X * M, yoo + Y * M, M * .5, td, td, td, 0
End If
Next
Next
If Q <> -1 Then
For Y = 0 To h2 - 1
For X = 0 To w2 - 1
If pt2(X, Y) Then
cerclefumee xoo2 + X * M2, yoo2 + Y * M2, M2 * 2, td * .8, td * .8, td * .8, td * .8
cerclefumee xoo2 + X * M2, yoo2 + Y * M2, M2 * .5, td, td, td, 0
End If
Next
Next
End If
End If
_Display
_Limit 60 + ptr
ptr = ptr + 1
If ptr < R * 1.5 Then Cls Else bot = .5
If ptr < R * 2.5 Then GoTo trace
Sleep 2
For i = 1 To 50
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, i), BF
For Y = 0 To h - 1
For X = 0 To w - 1
If pt(X, Y) Then
cerclefumee xoo + X * M, yoo + Y * M, M * 1, td * .8, td * .8, td * .8, td * .8
cerclefumee xoo + X * M, yoo + Y * M, M * .5, td, td, td, 0
End If
Next
Next
_Limit 50
_Display
Next i
before = Timer + 1
FPS = 60
If Q = -1 Then
maxb = 1500
dd = 0: pp = 0
ReDim xx(maxb), yy(maxb), zz(maxb)
For i = 1 To maxb
zz(i) = Rnd * maxb
xx(i) = (Rnd - Rnd) * _Width * (zz(i) / 200)
yy(i) = (Rnd - Rnd) * _Height * (zz(i) / 200)
Next i
Do
For i = 1 To maxb
Randomize Timer
zz(i) = zz(i) - (.05 / 60) * FPS
If zz(i) < 0 Then
zz(i) = maxb
xx(i) = (Rnd - Rnd) * _Width * (zz(i) / 200)
yy(i) = (Rnd - Rnd) * _Height * (zz(i) / 200)
End If
ax = _Width / 2 + 200 * xx(i) / zz(i)
ay = _Height / 2 + 200 * yy(i) / zz(i)
If ax < 0 Or ax > _Width Or ay < 0 Or ay > _Height Then
xx(i) = (Rnd - Rnd) * _Width
yy(i) = (Rnd - Rnd) * _Height
zz(i) = maxb
End If
ttz = ((maxb - zz(i)) / maxb) * 5
cc = (maxb - zz(i)) / maxb
cerclefumee ax, ay, ttz, cc * 155, 155 * cc, 155 * cc, 155 * cc
cerclefumee ax, ay, ttz * .33, cc * 255, 255 * cc, 255 * cc, 255 * cc
Next i
updateFire
db = 5
Y = _Height - M * 18 + 4: y2 = _Height - M * 18 + 50
For cy = Y To y2
X = _Width / 2 - db: x2 = _Width / 2 + db
db = db - .1
For cx = X To x2
qc = (db - Abs((cx - X) - db)) / db
PSet (cx - 280, cy), _RGBA(205, 100 + qc * 105, 50 + qc * 100, 205 * pp * qc)
PSet (cx + 280, cy), _RGBA(205, 100 + qc * 105, 50 + qc * 100, 205 * pp * qc)
Next cx, cy
If pp >= .5 Then
prepaFire _Width / 2 - 280, _Height - M * 18, 0
prepaFire _Width / 2 + 280, _Height - M * 18, 2
cerclefumee _Width / 2 - 280, _Height - M * (20 + Rnd * 1.5), 15 + Rnd * 20, 55 * Rnd, 255, 255, 190
cerclefumee _Width / 2 + 280, _Height - M * (20 + Rnd * 1.5), 15 + Rnd * 20, 55 * Rnd, 255, 255, 190
End If
dd = dd + .005: alp = -.97 * pp '+ grad
If dd > 1 Then dd = 1: pp = pp + .005
If pp > 1 Then pp = 1
For i = 1 To 5
Select Case i
Case 1
Rr = 255 * dd: Gg = 255 * dd: Bb = 255 * dd
Case 2
Rr = 0: Gg = 134 * dd: Bb = 195 * dd
Case 3
Rr = 224 * dd: Gg = 0: Bb = 36 * dd
Case 4
Rr = 243 * dd: Gg = 195 * dd: Bb = 0
Case 5
Rr = 2 * dd: Gg = 158 * dd: Bb = 57 * dd
End Select
For t = 0 To _Pi * 20 '
zz = mP(i, t).P
dy = mP(i, t).y * Cos(alp) - zz * Sin(alp)
dz = mP(i, t).y * Sin(alp) + zz * Cos(alp)
'mP(i, t).P = dz + 200
ax = _Width / 2 + 200 * mP(i, t).x / (dz + 500 + (1 - dd) * 500)
ay = _Height / 2 + 200 * dy / (dz + 500 + (1 - dd) * 500) + 277
cerclefumee ax, ay, 5, 255 * dd, Rr, Gg, Bb
Next t, i
For i = 0 To NBArtif
If ActiF(i) = 0 And gotime < Timer(.01) Then
mfx = _Width / 2 + (Rnd - Rnd) * (_Width / 3)
mfy = (_Height / 1.2) - _Height / 6.5 - (Rnd) * (_Height / 5)
initARTIF i, mfx, mfy
gotime = Timer(.01) + .1 + Rnd * .1
End If
Next i
For i = 0 To NBArtif
If ActiF(i) = 1 Then updateArtif i, FPS
Next i
_Limit FPS
totfps = totfps + 1
If before < Timer Then
before = Timer + 1
FPS = totfps
totfps = 0
End If
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 45), BF
For Y = 0 To h - 1
For X = 0 To w - 1
If pt(X, Y) Then
cerclefumee xoo + X * M, yoo + Y * M, M * 1, td * .8, td * .8, td * .8, td * .8
cerclefumee xoo + X * M, yoo + Y * M, M * .5, td, td, td, 0
End If
Next
Next
yoo = yoo + 1
If yoo > _Height - 16 * M Then yoo = _Height - 16 * M
_Display
Loop Until _KeyDown(27)
End If
yoo = _Height - 250
For i = 1 To 50
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, i), BF
_Limit 50
_Display
Next i
Loop
Sub precalcus
For r = 0 To maxCercle
diam = (r * r + r * r)
a = 0: b = 0
For i% = -r To r
For j% = -r To r
maCv(r, a, b) = 1 - (Sqr((i% * i%) + (j% * j%)) / r)
b = b + 1
Next j%
b = 0: a = a + 1
Next i%
Next r
End Sub
Sub cerclefumee (afx, afy, r, aaa, hr, hg, hb)
For aa = 0 To r * 2 Step 2
For bb = 0 To r * 2 Step 2
cl = (maCv(r, aa, bb))
i% = aa - r
j% = bb - r
alpha = cl * aaa
PSet (afx + i%, afy + j%), _RGBA((hr), (hg), (hb), alpha)
Next bb, aa
End Sub
Sub updateArtif (i, tfps)
HIGH = _Height
If tfps < 10 Then tfps = 10
hp = Rnd
tic = 0
If hp < .1 Then tic = 1
If hp > .9 Then tic = 2
For j = 0 To NBPArtif
Select Case Artif(i, j).P
Case Is <= 0
Artif(i, j).P = 0
Artif(i, j).Vx = 0
Artif(i, j).Vy = 0
Artif(i, j).pX = 0
Artif(i, j).pY = 500
Case Is > .5
Artif(i, j).P = Artif(i, j).P - (.3 + .3 * Rnd) / tfps
Artif(i, j).Vy = Artif(i, j).Vy + (1.2 / tfps)
Artif(i, j).pX = Artif(i, j).pX + Artif(i, j).Vx * ((600) / tfps) * (HIGH / 1080)
Artif(i, j).pY = Artif(i, j).pY + Artif(i, j).Vy * ((600) / tfps) * (HIGH / 1080)
If tic = 0 Then
If Artif(i, j).P < .5 Then
Artif(i, j).Vy = Cos(j + Timer(.0001))
Artif(i, j).Vx = Sin(j + Timer(.0001))
Artif(i, j).P = .1 + Rnd * .39
End If
End If
If tic = 1 Then
If Artif(i, j).P < .5 Then
Artif(i, j).Vy = (-Rnd)
Artif(i, j).Vx = (Rnd - Rnd)
Artif(i, j).P = .1 + Rnd * .39
End If
End If
If tic = 2 Then
If Artif(i, j).P < .5 Then
Artif(i, j).Vy = Cos(j * _Pi + Timer)
Artif(i, j).Vx = Sin(j * _Pi + Timer)
Artif(i, j).P = .1 + Rnd * .39
End If
End If
If j = Int(NBPArtif / 2) Then
hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228
hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228
hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 50), (1 - Artif(i, j).P) * 128, hr, hg, hb, 2, 4
End If
If j Then
hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228
hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228
hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228
PSet (Artif(i, j).pX, Artif(i, j).pY), _RGBA(hr, hg, hb, (1 - Artif(i, j).P) * 255)
If j = NBArtif Then
cl = Artif(i, j).P * 255 * (1.5 - (Artif(i, j).pY / _Height))
hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228
hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228
hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, ((1.5 - Artif(i, j).P)) * 25, cl * .75, hr, hg, hb, 2, 4
If hr > hg And hr > hb Then cr = 255 Else cr = 0
If hg > hb And hg > hr Then cg = 255 Else cg = 0
If hb > hg And hb > hr Then cb = 255 Else cb = 0
Circle (Artif(i, j).pX, Artif(i, j).pY), .5, _RGBA(255, 255, 255, (.5 * Rnd + Artif(i, j).P) * (155))
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, ((1.5 - Artif(i, j).P)) * 10, cl * 2, cr, cg, cb, 1, 2
End If
End If
Case Is < .5
PSet (Artif(i, j).pX, Artif(i, j).pY), _RGBA(255, 255, 255, (.2 + Artif(i, j).P) * (255))
Artif(i, j).P = Artif(i, j).P - ((_Height - Artif(i, j).pY) / _Height) * ((.65 + .55 * Rnd) / tfps)
Artif(i, j).Vy = Artif(i, j).Vy + (.5 - Artif(i, j).P) * (Artif(i, j).pY / _Height) * (5 / tfps)
Artif(i, j).pX = Artif(i, j).pX + Artif(i, j).Vx * (.015 - Rnd * .01 + Artif(i, j).P / 5) * (6000 / tfps) * (HIGH / 1080)
Artif(i, j).pY = Artif(i, j).pY + Artif(i, j).Vy * (.015 - Rnd * .01 + Artif(i, j).P / 5) * (6000 / tfps) * (HIGH / 1080)
cl = Artif(i, j).P * 255 * (1.5 - (Artif(i, j).pY / _Height))
hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228
hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228
hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 28), cl * .75, hr, hg, hb, 2, 4
If hr > hg And hr > hb Then cr = 255 Else cr = 0
If hg > hb And hg > hr Then cg = 255 Else cg = 0
If hb > hg And hb > hr Then cb = 255 Else cb = 0
Circle (Artif(i, j).pX, Artif(i, j).pY), .5, _RGBA(255, 255, 255, (.5 * Rnd + Artif(i, j).P) * (155))
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 42), cl * 2, cr, cg, cb, 1, 2
End Select
Next j
q = 0
For j = 0 To NBPArtif
If Artif(i, j).P = 0 Or Artif(i, j).pX < 0 Or Artif(i, j).pX > _Width Or Artif(i, j).pY < 0 Or Artif(i, j).pY > _Height Then q = q + 1
Next j
If j = q Then ActiF(i) = 0
End Sub
Sub initARTIF (I, x, y)
pot = Sgn(Rnd - Rnd) * .5 * (Rnd * .5 + .5)
rr = Rnd * 155
gg = Rnd * 155
bb = Rnd * 155
For j = 0 To NBPArtif - Rnd * 150
Artif(I, j).P = 1
Artif(I, j).Vx = (pot * .1)
Artif(I, j).Vy = (-.95 - .05 * Rnd * (j / NBPArtif))
Artif(I, j).pX = x
Artif(I, j).pY = y
Artif(I, j).r = rr
Artif(I, j).g = gg
Artif(I, j).b = bb
Next j
ActiF(I) = 1
End Sub
Sub cercleSUN3 (afx, afy, r, Kalpha, hr, hg, hb, ut1, ut2)
Static ut
If ut = 0 Then ut = ut1
For aa = 0 To r * 2 Step ut
For bb = 0 To r * 2 Step ut
cl = (maCv(r, aa, bb))
i% = aa - r
j% = bb - r
alpha = cl
If cl > .3 Then PSet (afx + i%, afy + j%), _RGBA(cl * hr, cl * hg, cl * hb, Kalpha * alpha)
Next bb
Next aa
If ut = ut2 Then ut = ut1 Else ut = ut2
End Sub
Sub updateFire
DT = .008F
For j = 0 To MAXFire
For a = 0 To 10
solveRope DT, NBM, Spring(), Mass(), j
Next a, j
End Sub
Sub prepaFire (vax, vay, ttf)
dL = 0.04F
sL = Sqr(dL * dL + dL * dL)
gamma = 1: frt = 1
bdr = .6 + Rnd * .3
bbdr = (1 - bdr)
oj = 50
For j = ttf To ttf + 1
jk0 = 2 + Int(Rnd * 2)
ReDim mul(_Width / jk0, _Height / jk0)
If j = ttf Then vax = vax - 1 Else vax = vax + 2
For b = 0 To NBCorde
i = 0
x = Mass(j, b, i).Po.x: y = Mass(j, b, i).Po.y: z = Mass(j, b, i).Po.z + 10
axb = 40 * x / z * 13 + vax
ayb = 40 * y / z * 13 + vay
For i = 1 To NBM
x = Mass(j, b, i).Po.x: y = Mass(j, b, i).Po.y: z = Mass(j, b, i).Po.z + 10
ax = 40 * x / z * 13 + vax
ay = 40 * y / z * 13 + vay
kdo = Mass(j, b, i).memkdo
If ax / jk0 > 0 And ax / jk0 < _Width / jk0 And ay / jk0 > 0 And ay / jk0 < _Height / jk0 Then
mul(ax / jk0, ay / jk0) = mul(ax / jk0, ay / jk0) + .25 + .25 * (i / NBM)
cl = 255 * mul(ax / jk0, ay / jk0)
qdo = mul(ax / jk0, ay / jk0)
kdo = (kdo + qdo) * .5
End If
top = (3 - (i / NBM) * 3)
If kdo > .1 Then
top = top * 1.5
croud = (bdr + Rnd * bbdr) * frt
Line (ax + top, ay + top)-(ax - top, ay - top), _RGBA(128 * croud, 75 * kdo * croud, 12 * croud, 75 * (kdo) * gamma * ((NBM + Rnd * 3 - i) / NBM)), BF
top = top * .5
croud = (bdr + Rnd * bbdr) * frt
Line (ax + top, ay + top)-(ax - top, ay - top), _RGBA(128 * croud, 75 * kdo * croud, 12 * croud, 175 * (kdo) * gamma * ((NBM + Rnd * 2 - i) / NBM)), BF
End If
If kdo < 2 And qdo > .5 Then
croud = (bdr + Rnd * bbdr) * frt
Line (ax, ay)-(axb, ayb), _RGBA(cl * ((NBM - i) / NBM) * croud, cl * ((NBM - i) / NBM) * croud, cl * croud / 1.2, (((NBM - i) / NBM) * 175 - Abs(x) * 125) * gamma)
croud = (bdr + Rnd * bbdr) * frt
Line (ax + 1, ay)-(axb + 1, ayb), _RGBA(cl * ((NBM - i) / NBM) * croud, cl * ((NBM - i) / NBM) * croud, cl * croud / 1.2, (((NBM - i) / NBM) * 105 - Abs(x) * 125) * gamma)
croud = (bdr + Rnd * bbdr) * frt
Line (ax - 1, ay)-(axb - 1, ayb), _RGBA(cl * ((NBM - i) / NBM) * croud, cl * ((NBM - i) / NBM) * croud, cl * croud / 1.2, (((NBM - i) / NBM) * 105 - Abs(x) * 125) * gamma)
End If
If kdo > 1. And i < NBM / 1.5 Then
croud = (bdr + Rnd * bbdr) * frt
Line (ax, ay)-(axb, ayb), _RGBA(cl * croud, (cl - (2 - kdo) * 65) * croud, 0, (kdo) * 75 * ((NBM - i) / NBM) * gamma)
croud = (bdr + Rnd * bbdr) * frt
Line (ax + 1, ay)-(axb + 1, ayb), _RGBA(cl * croud, (cl - (2 - kdo) * 5) * croud, 0, (kdo) * 45 * ((NBM - i) / NBM) * gamma)
croud = (bdr + Rnd * bbdr) * frt
Line (ax - 1, ay)-(axb - 1, ayb), _RGBA(cl * croud, (cl - (2 - kdo) * 5) * croud, 0, (kdo) * 45 * ((NBM - i) / NBM) * gamma)
End If
Mass(j, b, i).memkdo = qdo
axb = ax: ayb = ay
Next i
Next b
Next j
End Sub
Sub solveRope (dt As _Float, NB As Integer, s() As spring, m() As mass, J)
ReDim Grav As vec3
'Do: Loop While _MouseInput
dx = 0
Grav.x = dx + 0.0F: Grav.y = -.75F - Rnd * 5: Grav.z = Abs(dx + 0.0F)
airFrt = 0.002F * Rnd
ReDim gr As vec3
For b = 0 To NBCorde
For A = 0 To NB
initM m(J, b, A)
Next A
For A = 0 To NB - 1
solveS s(J, b, A), m(), b, J
Next A
For A = 0 To NB
gr.x = Grav.x * m(J, b, A).m: gr.y = Grav.y * m(J, b, A).m: gr.z = Grav.z * m(J, b, A).m
apF m(J, b, A), gr
gr.x = -m(J, b, A).Vel.x * airFrt: gr.y = -m(J, b, A).Vel.y * airFrt: gr.z = -m(J, b, A).Vel.z * airFrt
apF m(J, b, A), gr
Next A
For i = 1 To NB
simuM dt, m(J, b, i)
Next i
Next b
End Sub
Sub solveS (s As spring, m() As mass, B, J)
ReDim F As vec3
sx = m(J, B, s.m1).Po.x - m(J, B, s.m2).Po.x
sy = m(J, B, s.m1).Po.y - m(J, B, s.m2).Po.y
sz = m(J, B, s.m1).Po.z - m(J, B, s.m2).Po.z
r = Sqr(sx * sx + sy * sy + sz * sz)
If r <> 0 Then
F.x = -(sx / r) * (r - s.sL) * s.sC
F.y = -(sy / r) * (r - s.sL) * s.sC
F.z = -(sz / r) * (r - s.sL) * s.sC
F.x = F.x + -(m(J, B, s.m1).Vel.x - m(J, B, s.m2).Vel.x) * s.frt
F.y = F.y + -(m(J, B, s.m1).Vel.y - m(J, B, s.m2).Vel.y) * s.frt
F.z = F.z + -(m(J, B, s.m1).Vel.z - m(J, B, s.m2).Vel.z) * s.frt
End If
apF m(J, B, s.m1), F
F.x = -F.x: F.y = -F.y: F.z = -F.z
apF m(J, B, s.m2), F
End Sub
Sub apF (a As mass, F As vec3)
a.Force.x = a.Force.x + F.x: a.Force.y = a.Force.y + F.y: a.Force.z = a.Force.z + F.z
End Sub
Sub simuM (dt, m As mass)
m.Vel.x = m.Vel.x + (m.Force.x / m.m) * dt
m.Vel.y = m.Vel.y + (m.Force.y / m.m) * dt
m.Vel.z = m.Vel.z + (m.Force.z / m.m) * dt
m.Po.x = m.Po.x + m.Vel.x * dt
m.Po.y = m.Po.y + m.Vel.y * dt
m.Po.z = m.Po.z + m.Vel.z * dt
End Sub
Sub initM (m As mass)
m.Force.x = (Rnd - Rnd) * 2: m.Force.y = (Rnd - Rnd) * 3:: m.Force.z = 0:
End Sub