Hab auch gerade etwas sehr sehr altes ausgegraben. Leider beendet PB unter Linux den Screen wohl nicht richtig, womit mein ganzer Desktop im Arsch ist. Aber ich weiß, dass es noch vor zwei Wochen lief.
Code: Alles auswählen
;Erstellt eine Kamera, die 3D-Koordinaten in 2D-Koordinaten umrechnet
#PI = 3.141592653589793238
#DEG2RAD = #PI / 180
Structure V3D
x.d
y.d
z.d
EndStructure
Structure Camera
p.V3D
a.V3D
x.V3D
y.V3D
z.V3D ;Zeigt in Blickrichtung
FOV.d
tFOV.d
MinX.d
MaxX.d
MinY.d
MaxY.d
AspX.d
AspY.d
EndStructure
Procedure Camera_Calc(*Camera.Camera) ;Wird intern aufgerufen
Protected a_1.d, a_2.d, a_3.d, a_4.d, a_5.d, a_6.d, v_x.V3D, v_y.V3D
Static Pi2.d = #PI / 2
a_1 = Sin(*Camera\a\y)
a_2 = Cos(*Camera\a\x)
a_3 = Cos(*Camera\a\y)
a_4 = Sin(*Camera\a\x)
a_5 = Cos(*Camera\a\z)
a_6 = Sin(*Camera\a\z)
;Z-Achse
*Camera\z\x = a_1 * a_2 ; Sin(y) * Cos(x) 0
*Camera\z\y = a_4 ; Sin(x) 0
*Camera\z\z = a_2 * a_3 ; Cos(x) * Cos(y) 1
;Y-Achse
v_y\x = -a_1 * a_4 ; -Sin(y) * Sin(x) 0
v_y\y = a_2 ; Cos(x) 1
v_y\z = -a_4 * a_3 ; -Sin(x) * Cos(y) 0
v_x\x = -*Camera\z\y * v_y\z + *Camera\z\z * v_y\y
v_x\y = -*Camera\z\z * v_y\x + *Camera\z\x * v_y\z
v_x\z = -*Camera\z\x * v_y\y + *Camera\z\y * v_y\x
;Einberechnung des Z-Winkels
*Camera\x\x = v_x\x * a_5 + v_y\x * a_6
*Camera\x\y = v_x\y * a_5 + v_y\y * a_6
*Camera\x\z = v_x\z * a_5 + v_y\z * a_6
*Camera\y\x = v_y\x * a_5 - v_x\x * a_6
*Camera\y\y = v_y\y * a_5 - v_x\y * a_6
*Camera\y\z = v_y\z * a_5 - v_x\z * a_6
EndProcedure
Procedure Camera_New() ;Erstellt eine neue Kamera
Protected *Camera.Camera
*Camera = AllocateMemory(SizeOf(Camera))
If *Camera = 0 : ProcedureReturn #False : EndIf
Camera_Calc(*Camera)
With *Camera
\MinX = -1
\MaxX = 1
\MinY = -1
\MaxY = 1
\AspX = 1
\AspY = 1
EndWith
ProcedureReturn *Camera
EndProcedure
Procedure Camera_Set(*Camera.Camera, *Position.V3D, *Angle.V3D) ;Setzt Position und Winkel der Kamera
If *Position
*Camera\p\x = *Position\x
*Camera\p\y = *Position\y
*Camera\p\z = *Position\z
EndIf
If *Angle
*Camera\a\x = *Angle\x * #DEG2RAD
*Camera\a\y = *Angle\y * #DEG2RAD
*Camera\a\z = *Angle\z * #DEG2RAD
Camera_Calc(*Camera)
EndIf
EndProcedure
Procedure Camera_Add(*Camera.Camera, *Position.V3D, *Angle.V3D) ;Addiert Position und Winkel zur Kamera
If *Position
*Camera\p\x + *Position\x
*Camera\p\y + *Position\y
*Camera\p\z + *Position\z
EndIf
If *Angle
*Camera\a\x + *Angle\x * #DEG2RAD
*Camera\a\y + *Angle\y * #DEG2RAD
*Camera\a\z + *Angle\z * #DEG2RAD
Camera_Calc(*Camera)
EndIf
EndProcedure
Procedure.d Camera_FOV(*Camera.Camera, FOV.d = -1) ;Setzt "Field of view" der Kamera in Grad (0 < FOV < 180) oder gibt es zurück
If FOV = -1
ProcedureReturn *Camera\FOV
ElseIf FOV > 0 And FOV < 180
*Camera\FOV = FOV * #DEG2RAD
*Camera\tFOV = Tan(*Camera\FOV)
EndIf
EndProcedure
Procedure Camera_Size(*Camera.Camera, MinX.d, MaxX.d, MinY.d, MaxY.d) ;Setzt die maximalen Ausgabekoordinaten
With *Camera
\MinX = MinX
\MaxX = MaxX
\MinY = MinY
\MaxY = MaxY
If \MaxX - \MinX > \MaxY - \MinY
\AspX = 1
\AspY = (\MaxY - \MinY) / (\MaxX - \MinX)
ElseIf \MaxX - \MinX = \MaxY - \MinY
\AspX = 1
\AspY = 1
Else
\AspY = 1
\AspX = (\MaxX - \MinX) / (\MaxY - \MinY)
EndIf
EndWith
EndProcedure
Procedure Camera_Move(*Camera.Camera, *Position.V3D, *Angle.V3D) ;Bewegt die Kamera relativ zu Position und Drehung
Protected CosZ.d, SinZ.d
If *Position
*Camera\p\x + *Position\x * *Camera\x\x + *Position\y * *Camera\y\x + *Position\z * *Camera\z\x
*Camera\p\y + *Position\x * *Camera\x\y + *Position\y * *Camera\y\y + *Position\z * *Camera\z\y
*Camera\p\z + *Position\x * *Camera\x\z + *Position\y * *Camera\y\z + *Position\z * *Camera\z\z
EndIf
If *Angle
*Camera\a\z + *Angle\z * #DEG2RAD
CosZ = Cos(*Camera\a\z)
SinZ = Sin(*Camera\a\z)
*Camera\a\x + (*Angle\x * CosZ + *Angle\y * SinZ) * #DEG2RAD
*Camera\a\y + (*Angle\y * CosZ - *Angle\x * SinZ) * #DEG2RAD
Camera_Calc(*Camera)
EndIf
EndProcedure
Procedure Camera_3Dto2D(*Camera.Camera, *p3d.V3D, *p2d.V3D, *c3d.V3D = 0) ;Rechnet 3D-Punkt in 2D-Punkt um
Protected v_x.V3D, v_y.V3D, v.V3D, cx.d, cy.d, cz.d
;Vektor von Kamera zu Punkt
v\x = *p3d\x - *Camera\p\x
v\y = *p3d\y - *Camera\p\y
v\z = *p3d\z - *Camera\p\z
;Abstand von Kamera auf Z-Achse
cz = v\x * *Camera\z\x + v\y * *Camera\z\y + v\z * *Camera\z\z
If cz = 0
cx = 0
cy = 0
*p2d\x = 0
*p2d\y = 0
Else
;Abstand von Kamera auf X- und Y-Achse
cx = v\x * *Camera\x\x + v\y * *Camera\x\y + v\z * *Camera\x\z
cy = v\x * *Camera\y\x + v\y * *Camera\y\y + v\z * *Camera\y\z
;Berechnung des 2D-Punktes auf X- und Y-Achse im Bereich -1 bis 1
*p2d\x = cx / (cz * *Camera\tFOV) / *Camera\AspX
*p2d\y = cy / (cz * *Camera\tFOV) / *Camera\AspY
;Umrechnung des Bereichs auf die maximalen Ausgabekoordinaten
*p2d\x = *Camera\MinX + (*p2d\x + 1) * 0.5 * (*Camera\MaxX - *Camera\MinX)
*p2d\y = *Camera\MinY + (*p2d\y + 1) * 0.5 * (*Camera\MaxY - *Camera\MinY)
EndIf
If *c3d
*c3d\x = cx
*c3d\y = cy
*c3d\z = cz
EndIf
;Wenn Punkt hinter Kamera war
If cz <= 0 : ProcedureReturn #False : EndIf
;Wenn Punkt außerhalb maximalen Ausgabekoordinaten war
If *p2d\x < *Camera\MinX Or *p2d\x > *Camera\MaxX : ProcedureReturn #False : EndIf
If *p2d\y < *Camera\MinY Or *p2d\y > *Camera\MaxY : ProcedureReturn #False : EndIf
;Wenn Punkt im sichtbaren Bereich
ProcedureReturn #True
EndProcedure
EnableExplicit
Global width.l = 800, height.l = 600
Global *Camera.Camera, MouseFocus.l
Global NodeDims = 39, DrawLines = 1, SpringD.d = 150, NodeM.d = 0.1, MaxL.d = 100
Global ActTest, deltatime.d
; 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
Procedure.d Min(a.d, b.d)
If a < b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
Procedure.d Max(a.d, b.d)
If a > b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
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
*pFirst
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
If Nodes()\pFirst : FreeMemory(Nodes()\pFirst) : 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, *tmp5, *tmp6
Protected *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))
*tmp5 = ReAllocateMemory(*Node1\pFirst, (*Node1\cNodes + 1))
*tmp3 = ReAllocateMemory(*Node2\pNodes, (*Node2\cNodes + 1) * SizeOf(Long))
*tmp4 = ReAllocateMemory(*Node2\pSpring, (*Node2\cNodes + 1) * SizeOf(Long))
*tmp6 = ReAllocateMemory(*Node2\pFirst, (*Node2\cNodes + 1))
If *tmp1 : *Node1\pNodes = *tmp1 : EndIf
If *tmp2 : *Node1\pSpring = *tmp2 : EndIf
If *tmp5 : *Node1\pFirst = *tmp5 : EndIf
If *tmp3 : *Node2\pNodes = *tmp3 : EndIf
If *tmp4 : *Node2\pSpring = *tmp4 : EndIf
If *tmp6 : *Node2\pFirst = *tmp6 : EndIf
If *tmp1 And *tmp2 And *tmp3 And *tmp4 And *tmp5 And *tmp6
PokeL(*Node1\pNodes + *Node1\cNodes * SizeOf(Long), *Node2)
PokeL(*Node1\pSpring + *Node1\cNodes * SizeOf(Long), *Spring)
PokeB(*Node1\pFirst + *Node1\cNodes, 1)
PokeL(*Node2\pNodes + *Node2\cNodes * SizeOf(Long), *Node1)
PokeL(*Node2\pSpring + *Node2\cNodes * SizeOf(Long), *Spring)
PokeB(*Node2\pFirst + *Node2\cNodes, 0)
*Node1\cNodes + 1
*Node2\cNodes + 1
ProcedureReturn *Spring
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure SetAllSpringsD(d.d)
ForEach Springs()
Springs()\d = d
Springs()\maxF = Springs()\maxLength * Springs()\d
Next
EndProcedure
Procedure SetAllNodesM(m.d)
ForEach Nodes()
Nodes()\m = m
Next
EndProcedure
Procedure SetAllSpringsL(l.d)
ForEach Springs()
SetSpring(@Springs(), 0, 0, l)
Next
EndProcedure
Global Friction.d = 0.98, Gravity.d = 9.81
Global Energy.d
Procedure CalcFriction(deltatime.d)
ForEach Nodes()
With Nodes()
;Geschwindigkeit wird durch imaginäre Reibung gebremst
\F\x = \v\x * \m / deltatime * Friction
\F\y = \v\y * \m / deltatime * Friction
\F\z = \v\z * \m / deltatime * Friction
\v\x = 0 : \v\y = 0 : \v\z = 0
EndWith
Next
EndProcedure
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
Protected *pFirst.Byte
*pNode = *Node\pNodes
*pSpring = *Node\pSpring
*pFirst = *Node\pFirst
For a = 1 To *Node\cNodes
*rNode = *pNode\l
*rSpring = *pSpring\l
If *rSpring\broken = #False And *pFirst\b = 1
Dist = Distance(*Node\p, *rNode\p)
mult = (Dist - *rSpring\length) * *rSpring\d * 0.5
F\x = (*rNode\p\x - *Node\p\x) * mult
F\y = (*rNode\p\y - *Node\p\y) * mult
F\z = (*rNode\p\z - *Node\p\z) * mult
*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
If *Node\Fixed = #False
*Node\F\x + F\x
*Node\F\y + F\y
*Node\F\z + F\z
EndIf
If *rNode\Fixed = #False
*rNode\F\x - F\x
*rNode\F\y - F\y
*rNode\F\z - F\z
EndIf
;Federspannungsenergie
s = Abs(Dist - *rSpring\length)
Energy + 0.5 * s * s * *rSpring\d
EndIf
*pNode + SizeOf(Long)
*pSpring + SizeOf(Long)
*pFirst + 1
Next
;Bewegungsenergie
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
Energy + Sqr(W\x * W\x + W\y * W\y + W\z * W\z)
EndProcedure
Procedure CalcMove(deltatime.d)
ForEach Nodes()
With Nodes()
If \Fixed = #False
\v\x = \F\x * deltatime / \m
\v\y = (\F\y + Gravity * \m) * deltatime / \m
\v\z = \F\z * deltatime / \m
\p\x + \v\x * deltatime
\p\y + \v\y * deltatime
\p\z + \v\z * deltatime
EndIf
EndWith
Next
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, duration.l, *pFirst.Byte, Drawed.l = 0
Static time_FPS.l = -1
If time_FPS >= 0
time_FPS = ElapsedMilliseconds() - time_FPS
duration = 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
*pFirst = Nodes()\pFirst
If Camera_3Dto2D(*Camera, Nodes()\p, p1)
If DrawLines = 1
For a = 1 To Nodes()\cNodes
*rNode = *pNode\l
*rSpring = *pSpring\l
If *rSpring\broken = #False And *pFirst\b = 1
If Camera_3Dto2D(*Camera, *rNode\p, p2)
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))
Drawed + 1
EndIf
EndIf
*pNode + SizeOf(Long)
*pSpring + SizeOf(Long)
*pFirst + 1
Next
EndIf
r = Pow(Nodes()\m * 50, 0.25)
Circle(p1\x, p1\y, r, $FFFFFF) ;Weiße Kreise für Nodes
EndIf
Next
DrawText(0, 0, "Energy: " + RSet(StrD(Energy, 4), 15, "0"), $FFFFFF)
DrawText(0, 16, "Gravity: " + StrD(Gravity, 2) + " (+/-)", $FFFFFF)
DrawText(0, 32, "Friction: " + StrD(Friction, 4) + " (PgUp/PgDn)", $FFFFFF)
DrawText(0, 48, "Speed: " + StrD(speed, 2) + " x", $FFFFFF)
DrawText(0, 64, "Duration: " + Str(duration) + " ms/Frame", $FFFFFF)
If ActTest = 3 : DrawText(0, 80, "Field: " + Str(NodeDims) + "x" + Str(NodeDims) + " (Strg +/-)", $FFFFFF) : EndIf
If MouseFocus = 0
DrawText(0, 96, "Modus: Fixpunktmodus", $FF0000)
Else
DrawText(0, 96, "Modus: Kameramodus", $FF0000)
EndIf
DrawText(0, 112, "Drawed Lines: " + Str(Drawed) + " (L)", $FFFFFF)
DrawText(0, 128, "Springconstant: " + StrD(SpringD, 0) + " (F/V)", $FFFFFF)
DrawText(0, 144, "Nodemass: " + StrD(NodeM, 1) + " (G/B)", $FFFFFF)
DrawText(0, 160, "deltatime: " + StrD(deltatime, 6) + " (H/N)", $FFFFFF)
DrawText(0, 176, "Springlength: " + StrD(MaxL * 100, 0) + "% (J/M)", $FFFFFF)
StopDrawing()
EndProcedure
Global *MouseNode.Node
Procedure Test1()
Protected a.l, Nodes.l, *Spring.Spring
ActTest = 1
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
ActTest = 2
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, yD)
((x) * yD + y)
EndMacro
Procedure Test3()
Protected x.l, y.l, p.V3D, *Spring.Spring, d.d, LengthMult.d, SpringPercent.d, m.d, CountX.l, CountY.l, arrp.l
ActTest = 3
ClearNodes()
ClearSprings()
CountX = NodeDims
CountY = NodeDims
d = SpringD ;Federkonstante: Je höher, desto stärkerer Zug bei Dehnung
LengthMult = MaxL ;maximale Länge in 100%: 500 = 50000%
SpringPercent = 1.0 ;Startlänge in 100%: Werte kleiner als 1 bewirken einen sofortigen Zug
m = NodeM ;Gewicht der Nodes: wirkt sich auf die Schwerkraft aus
; Gravity = 9.81
; Friction = 0.98
Protected 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, CountY)) = NewNode(p\x, p\y, p\z, m, #True)
Else
*Nodes(p(x, y, CountY)) = NewNode(p\x, p\y, p\z, m)
EndIf
If x > 0
*Spring = LinkNodes(*Nodes(p(x, y, CountY)), *Nodes(p(x - 1, y, CountY)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
EndIf
If y > 0
*Spring = LinkNodes(*Nodes(p(x, y, CountY)), *Nodes(p(x, y - 1, CountY)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
EndIf
If x > 0 And y > 0
*Spring = LinkNodes(*Nodes(p(x, y, CountY)), *Nodes(p(x - 1, y - 1, CountY)), d, SpringPercent)
SetSpring(*Spring, 0, 0, LengthMult)
*Spring = LinkNodes(*Nodes(p(x - 1, y, CountY)), *Nodes(p(x, y - 1, CountY)), 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, CountY))\Fixed = #True
*Nodes(p(CountX / 2, CountY - 1, CountY))\Fixed = #True
*Nodes(p(0, CountY / 2, CountY))\Fixed = #True
*Nodes(p(CountX - 1, CountY / 2, CountY))\Fixed = #True
*MouseNode = *Nodes(p(CountX / 2, CountY / 2, CountY))
;*MouseNode\m = 50
EndProcedure
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)
;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.0025
Test3()
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_PageUp) : Friction + 0.0005 : EndIf
If KeyboardPushed(#PB_Key_PageDown) : Friction - 0.0005 : EndIf
If KeyboardPushed(#PB_Key_F1) : Test1(): EndIf
If KeyboardPushed(#PB_Key_F2) : Test2(): EndIf
If KeyboardPushed(#PB_Key_F3) : Test3() : EndIf
If KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
If KeyboardReleased(#PB_Key_Add) : NodeDims = Min(255, NodeDims + 2) : Test3() : EndIf
If KeyboardReleased(#PB_Key_Subtract) : NodeDims = Max(3, NodeDims - 2) : Test3() : : EndIf
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_Add) : Gravity + 0.01 : EndIf
If KeyboardPushed(#PB_Key_Subtract) : Gravity - 0.01 : EndIf
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
If KeyboardPushed(#PB_Key_F) : SpringD = Min(1000, SpringD + 1) : SetAllSpringsD(SpringD) : EndIf
If KeyboardPushed(#PB_Key_V) : SpringD = Max(1, SpringD - 1) : SetAllSpringsD(SpringD) : EndIf
If KeyboardPushed(#PB_Key_G) : NodeM = Min(20, NodeM + 0.1) : SetAllNodesM(NodeM) : EndIf
If KeyboardPushed(#PB_Key_B) : NodeM = Max(0.1, NodeM - 0.1) : SetAllNodesM(NodeM) : EndIf
If KeyboardReleased(#PB_Key_H) : deltatime = Min(0.02, deltatime * 2) : EndIf
If KeyboardReleased(#PB_Key_N) : deltatime = Max(0.000625, deltatime / 2) : EndIf
If KeyboardPushed(#PB_Key_J) : MaxL = Min(1000, MaxL + 2) : SetAllSpringsL(MaxL) : EndIf
If KeyboardPushed(#PB_Key_M) : MaxL = Max(2, MaxL - 2) : SetAllSpringsL(MaxL) : EndIf
If KeyboardReleased(#PB_Key_L) : DrawLines ! 1 : EndIf
Camera_FOV(*Camera, FOV)
Camera_Move(*Camera, pos, angle)
CalcFriction(deltatime)
Energy = 0
ForEach Nodes()
CalcForce(@Nodes(), deltatime)
Next
CalcMove(deltatime)
DrawNodes(deltatime)
FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
