programmiert. Dort kann man zwischen beliebig vielen Punkten beliebig
viele Federn spannen und auch die Werte anpassen. Das geschieht hier
allerdings nur im Code, also es ist kein Editor dabei oder ähnliches.
Benötigt wird meine "Convert3Dto2D.pbi"-Include von meiner Seite:
Convert3Dto2D.pbi
Hier die Steuerung:
Rechte Maustaste: wechselt zwischen Fixpunkt-Bewegmodus und Kamera-Modus
Linke Maustaste: Lässt Fixpunkt frei schwingen
Fixpunkt-Bewegmodus:
Mausbewegung: Fixpunkt wird in x- und y-Richtung bewegt, aber nicht relativ zur Kamera
Kamera-Modus:
Mausbewegung: Kamera schwenkt um x- und y-Achse
Weitere Kamera-Steuerungstasten:
Cursor Hoch: Kamera fliegt in Blickrichtung
Cusor Runter: Kamera fliegt gegen Blickrichtung
Cursor Rechts: Kamera bewegt sich nach rechts
Cursor Links: Kamera bewegt sich nach links
STRG + Cursor Hoch: Kamera bewegt sich nach oben
STRG + Cursor Runter: Kamera bewegt sich nach unten
STRG + Cursor Rechts: Kamera dreht sich nach rechts
STRG + Cursor Links: Kamera dreht sich nach links
Sonstige Tasten:
+: Schwerkraft nimmt zu
-:Schwerkraft nimmt ab
Bild hoch: Reibung nimmt ab
Bild runter: Reibung nimmt zu
Vorprogrammierte Szenarien:
F1: Kette von Punkten, die mit Federn verbunden sind
F2: Zufällige Punkte im Raum, die zufällig verbunden sind
F3: Ebene Fläche aus Punkten, die untereinander verbunden sind
Wenn man von Anfang an nichts sieht, einfach mal mit der Kamera
rückwärts fliegen. Aber davor nicht vergessen, F1, F2 oder F3 zu drücken.
Aber jetzt erstmal der
Code: Alles auswählen
EnableExplicit
Global width.l = 800, height.l = 600
Global *Camera.Camera, MouseFocus.l
; Structure V3D
; x.d
; y.d
; z.d
; EndStructure
Macro SetV3D(Var, inx, iny, inz)
Var\x = inx
Var\y = iny
Var\z = inz
EndMacro
Structure C3F
R.f
g.f
b.f
EndStructure
Structure Spring
length.d ;Normallänge der Feder bei F=0
nLength.d ;Momentante Länge der Feder
d.d ;Federkonstante
F.d
maxF.d ;Maximale Kraft, die sie auf Zug aushält
maxLength.d
broken.l ;#True, wenn Feder gerissen
EndStructure
Structure Node
m.d
p.V3D
v.V3D
a.V3D
F.V3D
Fixed.l
cNodes.l
*pNodes
*pSpring
EndStructure
Procedure.d Distance(*a.V3D, *b.V3D)
Protected x.d = *b\x - *a\x, y.d = *b\y - *a\y, z.d = *b\z - *a\z
ProcedureReturn Sqr(x * x + y * y + z * z)
EndProcedure
Global NewList Nodes.Node()
Procedure NewNode(x.d, y.d, z.d, m.d, Fixed.l = #False)
If AddElement(Nodes())
Nodes()\m = m
Nodes()\p\x = x
Nodes()\p\y = y
Nodes()\p\z = z
Nodes()\Fixed = Fixed
ProcedureReturn @Nodes()
EndIf
ProcedureReturn #False
EndProcedure
Procedure ClearNodes()
ForEach Nodes()
If Nodes()\pNodes : FreeMemory(Nodes()\pNodes) : EndIf
If Nodes()\pSpring : FreeMemory(Nodes()\pSpring) : EndIf
Next
ClearList(Nodes())
EndProcedure
Global NewList Springs.Spring()
Procedure NewSpring(length.d, d.d)
If AddElement(Springs())
Springs()\length = length
Springs()\d = d
ProcedureReturn @Springs()
EndIf
ProcedureReturn #False
EndProcedure
Procedure ClearSprings()
ClearList(Springs())
EndProcedure
Procedure SetSpring(*Spring.Spring, maxF.d = 0, maxLength.d = 0, LengthMult.d = 0)
If maxF > 0
*Spring\maxF = maxF
*Spring\maxLength = maxF / *Spring\d
ElseIf maxLength > 0
*Spring\maxLength = maxLength
*Spring\maxF = maxLength * *Spring\d
ElseIf LengthMult > 0
*Spring\maxLength = *Spring\length * LengthMult
*Spring\maxF = *Spring\maxLength * *Spring\d
EndIf
EndProcedure
Procedure LinkNodes(*Node1.Node, *Node2.Node, d.d = 1, SpringPercent.d = 1)
Protected a.l, new.l, *pNode.Long, *tmp1, *tmp2, *tmp3, *tmp4, *Spring.Spring
If *Node1 = *Node2 : ProcedureReturn #False : EndIf
new = #True
*pNode = *Node1\pNodes
For a = 1 To *Node1\cNodes
If *pNode\l = *Node2 : new = #False : Break : EndIf
*pNode + SizeOf(Long)
Next
If new
*Spring = NewSpring(Distance(*Node1\p, *Node2\p) * SpringPercent, d)
If *Spring = 0 : ProcedureReturn #False : EndIf
*tmp1 = ReAllocateMemory(*Node1\pNodes, (*Node1\cNodes + 1) * SizeOf(Long))
*tmp2 = ReAllocateMemory(*Node1\pSpring, (*Node1\cNodes + 1) * SizeOf(Long))
*tmp3 = ReAllocateMemory(*Node2\pNodes, (*Node2\cNodes + 1) * SizeOf(Long))
*tmp4 = ReAllocateMemory(*Node2\pSpring, (*Node2\cNodes + 1) * SizeOf(Long))
If *tmp1 : *Node1\pNodes = *tmp1 : EndIf
If *tmp2 : *Node1\pSpring = *tmp2 : EndIf
If *tmp3 : *Node2\pNodes = *tmp3 : EndIf
If *tmp4 : *Node2\pSpring = *tmp4 : EndIf
If *tmp1 And *tmp2 And *tmp3 And *tmp4
PokeL(*Node1\pNodes + *Node1\cNodes * SizeOf(Long), *Node2)
PokeL(*Node1\pSpring + *Node1\cNodes * SizeOf(Long), *Spring)
PokeL(*Node2\pNodes + *Node2\cNodes * SizeOf(Long), *Node1)
PokeL(*Node2\pSpring + *Node2\cNodes * SizeOf(Long), *Spring)
*Node1\cNodes + 1
*Node2\cNodes + 1
ProcedureReturn *Spring
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Global Friction.d = 0.98, Gravity.d = 9.81
Global Energy.d
Procedure CalcForce(*Node.Node, deltatime.d)
Protected *pSpring.Long, *pNode.Long, a.l, F.V3D, Dist.d, mult.d, *rNode.Node, *rSpring.Spring, W.V3D, s.d
SetV3D(*Node\F, 0, 0, 0)
;Geschwindigkeit wird durch imaginäre Reibung gebremst
*Node\F\x = *Node\v\x * *Node\m / deltatime * Friction
*Node\F\y = *Node\v\y * *Node\m / deltatime * Friction
*Node\F\z = *Node\v\z * *Node\m / deltatime * Friction
*Node\F\y + (Gravity * *Node\m)
*pNode = *Node\pNodes
*pSpring = *Node\pSpring
For a = 1 To *Node\cNodes
*rNode = *pNode\l
*rSpring = *pSpring\l
If *rSpring\broken = #False
Dist = Distance(*Node\p, *rNode\p)
If *Node\Fixed
mult = 0
Else
mult = (Dist - *rSpring\length) * *rSpring\d * 0.5
EndIf
F\x = (*rNode\p\x - *Node\p\x) * mult; / *rSpring\length
F\y = (*rNode\p\y - *Node\p\y) * mult; / *rSpring\length
F\z = (*rNode\p\z - *Node\p\z) * mult; / *rSpring\length
*rSpring\nLength = Dist
If Dist < *rSpring\length
*rSpring\F = Sqr(F\x * F\x + F\y * F\y + F\z * F\z)
Else
*rSpring\F = - Sqr(F\x * F\x + F\y * F\y + F\z * F\z)
EndIf
If -*rSpring\F > *rSpring\maxF : *rSpring\broken = #True : EndIf
If *rSpring\nLength > *rSpring\maxLength : *rSpring\broken = #True : EndIf
*Node\F\x + F\x
*Node\F\y + F\y
*Node\F\z + F\z
EndIf
*pNode + SizeOf(Long)
*pSpring + SizeOf(Long)
Next
If *Node\Fixed = #False
*Node\v\x = *Node\F\x * deltatime / *Node\m
*Node\v\y = *Node\F\y * deltatime / *Node\m
*Node\v\z = *Node\F\z * deltatime / *Node\m
Else
SetV3D(*Node\v, 0, 0, 0)
EndIf
W\x = 0.5 * *Node\v\x * *Node\v\x * *Node\m
W\y = 0.5 * *Node\v\y * *Node\v\y * *Node\m
W\z = 0.5 * *Node\v\z * *Node\v\z * *Node\m
; Bewegungsenergie + Federspannungsenergie
s = Abs(Dist - *rSpring\length)
Energy + Sqr(W\x * W\x + W\y * W\y + W\z * W\z) + 0.5 * s * s * *rSpring\d
EndProcedure
Procedure CalcMove(*Node.Node, deltatime.d)
*Node\p\x + *Node\v\x * deltatime
*Node\p\y + *Node\v\y * deltatime
*Node\p\z + *Node\v\z * deltatime
EndProcedure
Procedure DrawNodes(deltatime.d)
Protected a.l, *pNode.Long, *rNode.Node, *pSpring.Long, *rSpring.Spring, SpringC.C3F, r.d, p1.V3D, p2.V3D
Protected speed.d
Static time_FPS.l = -1
If time_FPS = -1
time_FPS = ElapsedMilliseconds()
Else
time_FPS = ElapsedMilliseconds() - time_FPS
speed = deltatime * 1000 / time_FPS
EndIf
time_FPS = ElapsedMilliseconds()
StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Transparent)
ForEach Nodes()
*pNode = Nodes()\pNodes
*pSpring = Nodes()\pSpring
If Camera_3Dto2D(*Camera, Nodes()\p, p1)
For a = 1 To Nodes()\cNodes
*rNode = *pNode\l
*rSpring = *pSpring\l
If Camera_3Dto2D(*Camera, *rNode\p, p2)
If *rSpring\broken = #False
If *rSpring\nLength < *rSpring\length ;Kürzer=Grün, Normal=Blau, Länger=Rot
SpringC\r = 0
SpringC\g = (*rSpring\length - *rSpring\nLength) * 1.5 / *rSpring\length
SpringC\b = 1 - SpringC\g
ElseIf *rSpring\nLength > *rSpring\length
SpringC\r = (*rSpring\nLength - *rSpring\length) * 0.75 / *rSpring\length
SpringC\g = 0
SpringC\b = 1 - SpringC\r
Else
SpringC\r = 0
SpringC\g = 0
SpringC\b = 1
EndIf
If SpringC\r > 1.0 : SpringC\r = 1.0 : EndIf : If SpringC\r < 0.0 : SpringC\r = 0.0 : EndIf
If SpringC\g > 1.0 : SpringC\g = 1.0 : EndIf : If SpringC\g < 0.0 : SpringC\g = 0.0 : EndIf
If SpringC\b > 1.0 : SpringC\b = 1.0 : EndIf : If SpringC\b < 0.0 : SpringC\b = 0.0 : EndIf
LineXY(p1\x, p1\y, p2\x, p2\y, RGB(SpringC\r * 255, SpringC\g * 255, SpringC\b * 255))
EndIf
EndIf
*pNode + SizeOf(Long)
*pSpring + SizeOf(Long)
Next
r = Pow(Nodes()\m * 50, 0.25)
Circle(p1\x, p1\y, r, $FFFFFF) ;Rote Kreise für Nodes
EndIf
Next
DrawText(0, 0, "Energy: " + RSet(StrF(Energy, 4), 15, "0"), $FFFFFF)
DrawText(0, 16, "Gravity: " + StrF(Gravity, 2), $FFFFFF)
DrawText(0, 32, "Friction: " + StrF(Friction, 4), $FFFFFF)
DrawText(0, 48, "Speed: " + StrF(speed, 2) + " x", $FFFFFF)
If MouseFocus = 0
DrawText(0, 64, "Modus: Fixpunktmodus", $FF0000)
Else
DrawText(0, 64, "Modus: Kameramodus", $FF0000)
EndIf
StopDrawing()
EndProcedure
Global *MouseNode.Node
Procedure Test1()
Protected a.l, Nodes.l, *Spring.Spring
ClearNodes()
ClearSprings()
Nodes = 40
Gravity = 0
Protected Dim *Nodes.Node(Nodes - 1)
For a = 0 To Nodes - 1
*Nodes(a) = NewNode(10 * a / Nodes - 5, 0, 0, 0.01)
Next
For a = 0 To Nodes - 2
*Spring = LinkNodes(*Nodes(a), *Nodes(a + 1), 5, 0.8)
SetSpring(*Spring, 0, 0, 200)
Next
For a = 1 To 0
LinkNodes(*Nodes(Random(Nodes - 1)), *Nodes(Random(Nodes - 1)), 1)
Next
*Nodes(Nodes - 1)\Fixed = #True
*MouseNode = *Nodes(0)
EndProcedure
Procedure Test2()
Define a.l, *Spring.Spring, Nodes = 20
ClearNodes()
ClearSprings()
Nodes = 20
Protected Dim *Nodes.Node(Nodes - 1)
*Nodes(0) = NewNode(0, 0, 0, 1, #True)
For a = 1 To Nodes - 1
*Nodes(a) = NewNode(Random(100) / 10 - 5, Random(100) / 10 - 5, Random(100) / 10 - 5, 1)
If a > 2
*Spring = LinkNodes(*Nodes(a), *Nodes(a - 1), 1)
SetSpring(*Spring, 0, 0, 5)
EndIf
*Spring = LinkNodes(*Nodes(0), *Nodes(a), 1)
SetSpring(*Spring, 0, 0, 5)
Next
*Spring = LinkNodes(*Nodes(1), *Nodes(Nodes - 1), 1)
SetSpring(*Spring, 0, 0, 5)
*MouseNode = *Nodes(0)
EndProcedure
Macro p(x, y)
(x) * CountY + y
EndMacro
Macro Test3()
Define x.l, y.l, p.V3D, *Spring.Spring, d.d, LengthMult.d, SpringPercent.d, m.d, CountX.l, CountY.l, arrp.l
ClearNodes()
ClearSprings()
CountX = 31
CountY = 31
d = 150
LengthMult = 500
SpringPercent = 1.0
m = 0.1
Gravity = 9.81
Friction = 0.98
Global Dim *Nodes.Node(CountX * CountY - 1)
p\y = 0
For x = 0 To CountX - 1
p\x = x * 10 / CountX - 5
For y = 0 To CountY - 1
p\z = y * 10 / CountY
;If 0
If x = 0 Or y = 0 Or y = CountY - 1 Or x = CountX - 1
;If (x = 0 Xor x = CountX - 1) And (y = 0 Or y = CountY - 1)
*Nodes(p(x, y)) = NewNode(p\x, p\y, p\z, m, #True)
Else
*Nodes(p(x, y)) = NewNode(p\x, p\y, p\z, m)
EndIf
If x > 0
*Spring = LinkNodes(*Nodes(p(x, y)), *Nodes(p(x - 1, y)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
EndIf
If y > 0
*Spring = LinkNodes(*Nodes(p(x, y)), *Nodes(p(x, y - 1)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
EndIf
If x > 0 And y > 0
*Spring = LinkNodes(*Nodes(p(x, y)), *Nodes(p(x - 1, y - 1)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
*Spring = LinkNodes(*Nodes(p(x - 1, y)), *Nodes(p(x, y - 1)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
EndIf
Next
Next
;*Nodes(1 + Random(CountX - 3), 1 + Random(CountY - 3))\m * 10
*Nodes(p(CountX / 2, 0))\Fixed = #True
*Nodes(p(CountX / 2, CountY - 1))\Fixed = #True
*Nodes(p(0, CountY / 2))\Fixed = #True
*Nodes(p(CountX - 1, CountY / 2))\Fixed = #True
*MouseNode = *Nodes(p(CountX / 2, CountY / 2))
;*MouseNode\m = 50
EndMacro
InitSprite()
InitMouse()
InitKeyboard()
OpenWindow(0, 0, 0, width, height, "Feder-Simulation", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, width, height, 0, 0, 0)
Define time.l, deltatime.d, xm.d, ym.d
Define *pNode.Node, a.l, new.l
;Kamera
Define pos.V3D, angle.V3D, p2d.V3D, p2d.V3D
Define p_add.d, a_add.d, FOV.d
p_add.d = 0.5
a_add.d = 1.5
FOV.d = 45
*Camera = Camera_New()
Camera_Size(*Camera, 0, width - 1, 0, height - 1)
If *MouseNode : MouseLocate(*MouseNode\p\x, *MouseNode\p\y) : EndIf
Define MouseFocusChange.l
MouseFocus = 0
MouseFocusChange = #False
deltatime = 0.01
Repeat
ClearScreen(0)
ExamineMouse()
ExamineKeyboard()
pos\x = 0 : pos\y = 0 : pos\z = 0
angle\x = 0 : angle\y = 0 : angle\z = 0
If MouseButton(2)
If MouseFocusChange = #False
If MouseFocus = 1 : MouseFocus = 0 : Else : MouseFocus + 1 : EndIf
MouseFocusChange = #True
EndIf
Else
MouseFocusChange = #False
EndIf
Select MouseFocus
Case 0
If *MouseNode
If Not MouseButton(1)
*MouseNode\p\x + MouseDeltaX() * 0.01
*MouseNode\p\y + MouseDeltaY() * 0.01
*MouseNode\Fixed = #True
Else
*MouseNode\Fixed = #False
EndIf
EndIf
Case 1
angle\x + MouseDeltaY() * 0.5
angle\y + MouseDeltaX() * 0.5
EndSelect
If KeyboardPushed(#PB_Key_Add) : Gravity + 0.01 : EndIf
If KeyboardPushed(#PB_Key_Subtract) : Gravity - 0.01 : EndIf
If KeyboardPushed(#PB_Key_PageUp) : Friction + 0.0005 : EndIf
If KeyboardPushed(#PB_Key_PageDown) : Friction - 0.0005 : EndIf
If KeyboardPushed(#PB_Key_F1) : Test1() : new = #True : EndIf
If KeyboardPushed(#PB_Key_F2) : Test2() : new = #True : EndIf
If KeyboardPushed(#PB_Key_F3) : Test3() : new = #True : EndIf
If KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
If KeyboardPushed(#PB_Key_Up) : pos\y - p_add : EndIf
If KeyboardPushed(#PB_Key_Down) : pos\y + p_add : EndIf
If KeyboardPushed(#PB_Key_Left) : angle\y - a_add : EndIf
If KeyboardPushed(#PB_Key_Right) : angle\y + a_add : EndIf
Else
If KeyboardPushed(#PB_Key_Up) : pos\z + p_add : EndIf
If KeyboardPushed(#PB_Key_Down) : pos\z - p_add : EndIf
If KeyboardPushed(#PB_Key_Left) : pos\x - p_add : EndIf
If KeyboardPushed(#PB_Key_Right) : pos\x + p_add : EndIf
EndIf
If KeyboardPushed(#PB_Key_A) : angle\x + a_add : EndIf
If KeyboardPushed(#PB_Key_Z) : angle\x - a_add : EndIf
If KeyboardPushed(#PB_Key_S) : angle\z + a_add : EndIf
If KeyboardPushed(#PB_Key_X) : angle\z - a_add : EndIf
If KeyboardPushed(#PB_Key_D) : FOV - 0.25 : EndIf
If KeyboardPushed(#PB_Key_C) : FOV + 0.25 : EndIf
Camera_FOV(*Camera, FOV)
Camera_Move(*Camera, pos, angle)
Energy = 0
ForEach Nodes()
CalcForce(@Nodes(), deltatime)
Next
ForEach Nodes()
CalcMove(@Nodes(), deltatime)
Next
DrawNodes(deltatime)
FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow
deltatime.d gibt die Genauigkeit und damit auch die Geschwindigkeit der
Simulation aus. Je kleiner, desto genauer, aber langsamer. Bei großen
Werten kann es passieren, dass die Federn sich ins Unendliche schwingen
und einfach reißen.