Kleine Feder-Simulation

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8809
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Kleine Feder-Simulation

Beitrag von NicTheQuick »

Ich habe schon vor längerer Zeit zum Spaß eine Federsimulation
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
///Edit:
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.
Benutzeravatar
SimonSimCity
Beiträge: 132
Registriert: 14.01.2007 00:49

Beitrag von SimonSimCity »

Tut mir leid, aber ich kann dein Programm nicht starten :(
[16:16:08] [COMPILER] Zeile 4: Structure not found: Camera
[16:26:23] [COMPILER] Zeile 458: Syntax error!
[16:26:35] [COMPILER] Zeile 458: Syntax error!
//EDIT: Die 1. Zeile (Das weiß ich) Stammt daher, dass ich die Datei nicht eingebunden habe.. Aber die anderen beiden kann ich mir nicht erklären...

Und dann öffnet sich noch ein Fenster "Macro Fehler" mit folgendem Code:

Code: Alles auswählen

If KeyboardPushed(#PB_Key_F3)       :  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 x = 0 Or y = 0 Or y = CountY - 1 Or x = CountX - 1
                              *Nodes((x) * CountY + y) = NewNode(p\x, p\y, p\z, m, #True)
                                    Else
                                      *Nodes((x) * CountY + y) = NewNode(p\x, p\y, p\z, m)
                                            EndIf
                                            If x > 0
                                            *Spring = LinkNodes(*Nodes((x) * CountY + y), *Nodes((x - 1) * CountY + y), d, SpringPercent)
                                              SetSpring(*Spring, 0, 0, LengthMult)
                                            EndIf
                                            If y > 0
                                            *Spring = LinkNodes(*Nodes((x) * CountY + y), *Nodes((x) * CountY + y - 1), d, SpringPercent)
                                              SetSpring(*Spring, 0, 0, LengthMult)
                                            EndIf
                                            If x > 0 And y > 0
                                            *Spring = LinkNodes(*Nodes((x) * CountY + y), *Nodes((x - 1) * CountY + y - 1), d, SpringPercent)
                                              SetSpring(*Spring, 0, 0, LengthMult)
                                            *Spring = LinkNodes(*Nodes((x - 1) * CountY + y), *Nodes((x) * CountY + y - 1), d, SpringPercent)
                                              SetSpring(*Spring, 0, 0, LengthMult)
                                            EndIf
                                          Next
                                        Next
                                        *Nodes((CountX / 2) * CountY + 0)\Fixed = #True
                                        *Nodes((CountX / 2) * CountY + CountY - 1)\Fixed = #True
                                        *Nodes((0) * CountY + CountY / 2)\Fixed = #True
                                        *Nodes((CountX - 1) * CountY + CountY / 2)\Fixed = #True
                                      *MouseNode = *Nodes((CountX / 2) * CountY + CountY / 2) :  new = #True :  EndIf
Ich hoffe, du kannst damit was anfangen...
Benutzeravatar
Thalius
Beiträge: 476
Registriert: 17.02.2005 16:17
Wohnort: Basel / Schweiz

Beitrag von Thalius »

läuft bei mir einwandfrei mit PB 4.02 .. :D

@Nic Saubere Arbeit !!

Thalius
"...smoking hash-tables until until you run out of memory." :P
Benutzeravatar
milan1612
Beiträge: 810
Registriert: 15.04.2007 17:58

Beitrag von milan1612 »

Schaut kompliziert aus :shock:
Ruckelt aber hemmungslos bei mir :lol:
Bin nur noch sehr selten hier, bitte nur noch per PN kontaktieren
Benutzeravatar
SimonSimCity
Beiträge: 132
Registriert: 14.01.2007 00:49

Beitrag von SimonSimCity »

Oder kann das bei mir auch an der PureBasic Beta 4.10Beta3 liegen?

Also, dass der mit nem Befehl anscheinend nicht klar kommt, oder so?
Weil der Fehler is bei mir permanent :(
Benutzeravatar
legion
Beiträge: 467
Registriert: 08.10.2006 18:04
Computerausstattung: Intel Core i5-6500 @ 4x 3.6GHz mit Windows 10 Pro, Intel Core-i7 mit Ubuntu 18.04 bionic, x86_64 Linux 4.18.0-16-generic, Microsoft Surface Pro - Windows 10 Pro
Wohnort: Wien
Kontaktdaten:

Beitrag von legion »

Bringt bei mir ebenfalls einen Macrofehler :(
"If KeyboardPushed(#PB_Key_F3) : Test3() : new = #True : EndIf"

Lg. Legion
PB 5.71 LTS Windows 10 Pro & Ubuntu 18.04.2 LTS & Linux Mint 19.3
-----------------------------------------------------
Alles ist, wie man glaubt, dass es ist!
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8809
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

Test1() und Test2() liegen ja als Procedure vor, aber wenn ich versuche
Test3() als Procedure zu machen, dann gibt es irgendeinen PB-Bug, den ich
nicht verstehe. Daher liegt Test3() nur als Macro vor, was unter PB V4.02
auch wunderbar funktioniert. Vielleicht sollten alle mit PB V4.10 dieses Macro
mal als Procedure machen, damit es funktioniert. Ich kann es auch leider
gerade nicht testen, weil ich nicht an meinem PC bin.
Benutzeravatar
legion
Beiträge: 467
Registriert: 08.10.2006 18:04
Computerausstattung: Intel Core i5-6500 @ 4x 3.6GHz mit Windows 10 Pro, Intel Core-i7 mit Ubuntu 18.04 bionic, x86_64 Linux 4.18.0-16-generic, Microsoft Surface Pro - Windows 10 Pro
Wohnort: Wien
Kontaktdaten:

Beitrag von legion »

NicTheQuick hat geschrieben:Vielleicht sollten alle mit PB V4.10 dieses Macro
mal als Procedure machen, damit es funktioniert.
Hallo !

Ja, wenn man das Macro auf eine Procedure umschreibt fuktioniert es.:allright:
Läuft flüssig unter Vista mit Core 2 Duo.

Lg. Legion
PB 5.71 LTS Windows 10 Pro & Ubuntu 18.04.2 LTS & Linux Mint 19.3
-----------------------------------------------------
Alles ist, wie man glaubt, dass es ist!
Benutzeravatar
SimonSimCity
Beiträge: 132
Registriert: 14.01.2007 00:49

Beitrag von SimonSimCity »

Supper Code!

Auf jeden Fall mal lustig zu experimentieren mit der Feder :D

Ich hab die Feder bei F3 zerspringen lassen...

nur, wenn ich die von oben über den Rand ziehe, ist das Netz auf einmal wieder innerhalb des Rechteckes!

Ich wollte das jetzt mal über den Rand ziehen...


Auch wenn ich das Netz nach links-unten ziehe, reißt rechts erst, wenn das ganze Netz rot ist ....
(vlt auch gewollt...)
Benutzeravatar
PureLust
Beiträge: 1145
Registriert: 21.07.2005 00:02
Computerausstattung: Hab aktuell im Grunde nur noch 'nen Lenovo Yoga 2 Pro im Einsatz.
Wohnort: am schönen Niederrhein

Beitrag von PureLust »

@NTQ: Very Nice !!! :allright:

Ich hab's mal ein wenig erweitert. Dabei ist mir aufgefallen, dass Du einige Node-Links doppelt anlegst und diese somit leider unnötig doppelt berechten bzw. doppelt gezeichnet werden (wobei Letzteres vor Allem auf die Performance geht).

In der Zeile 261/263 kannst Du mal die ";" rausnehmen und Dir dann mit "L" die jeweils in diesem Durchlauf berechneten Links anschauen.
Hierbei siehst Du dann, dass manche Links (bzw. Linien) doppelt vorhanden sind.

Vorgenommene Änderungen:
- Durch "Strg" & "+/-" kann man die Anzahl der Notes erhöhen oder reduzieren.
- Durch "L" kann man die Anzahl der sichtbaren Linien verändern, wodurch es dann möglich ist, sich auch Felder mit vielen Notes sehr flüssig anzeigen zu lassen.
- Beenden des Programms geht nun auch mit "Escape".

Code: Alles auswählen

XIncludeFile #PB_Compiler_Home+"Includes\Convert3Dto2D.pbi"
EnableExplicit 
DisableDebugger

Global width.l = 800, height.l = 600 
Global *Camera.Camera, MouseFocus.l
Global ShowLines = 2, NodeDims = 47
Global ActTest

; 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
Macro min(a,b)
	((0 Or (a<b))*a + (0 Or (a>=b))*b)
EndMacro
Macro max(a,b)
	((0 Or (a>b))*a + (0 Or (a<=b))*b)
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, Duration
  Static time_FPS.l = -1 
  
  If time_FPS = -1 
    time_FPS = ElapsedMilliseconds() 
  Else 
    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 
      
      If Camera_3Dto2D(*Camera, Nodes()\p, p1) 
      
        For a = 1 To min(Nodes()\cNodes , ShowLines)
          *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 
;               If a = ShowLines ; <<<<< @NTQ : Aktiviere mal diese und die übernächste Zeile und schalte mal ...
                LineXY(p1\x, p1\y, p2\x, p2\y, RGB(SpringC\r * 255, SpringC\g * 255, SpringC\b * 255))
;               EndIf ; <<<<< mit "L" die angezeigten Linien durch, um zu sehen, welche Linien doppelt gezeichnet werden.
            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)+"  (PgUp/PgDn)", $FFFFFF) 
    DrawText(0, 48, "Speed: " + StrF(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 
  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) 
  (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 
  ActTest = 3
  ClearNodes() 
  ClearSprings() 
  
  CountX = NodeDims 
  CountY = NodeDims 
  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 

;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 
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(128, NodeDims + 2) : Test3() : EndIf 
    If KeyboardReleased(#PB_Key_Subtract) : NodeDims = max( 15, 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 KeyboardReleased(#PB_Key_L)
    ShowLines + 1
    If ShowLines > 5 : ShowLines = 0 : EndIf
  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 Or KeyboardPushed(#PB_Key_Escape)
Wie bereits gesagt NTQ ... very nice code !!! :allright:

Greetz, PL.
[Dynamic-Dialogs] - komplexe dynamische GUIs einfach erstellen
[DeFlicker] - Fenster flimmerfrei resizen
[WinFX] - Window Effekte (inkl. 'durchklickbares' Window)
Antworten