# PureBasic Forum

 It is currently Wed Feb 26, 2020 5:35 pm

 All times are UTC + 1 hour

 Page 1 of 1 [ 14 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Double PendulumPosted: Sun Jul 01, 2018 8:05 pm
 Enthusiast

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 308
Location: Côtes d'Azur, France
https://en.wikipedia.org/wiki/Double_pendulum
Feel free to change arms length, pendulum's mass, departure angles...
Code:
#ArmLength1=100:#ArmLength2=120
#Mass1=3:#Mass2=2
#MaxHistoricNumber=200
;departure angles
Angle1.f=-#PI/2:Angle2.f=-#PI/2
#x=800:#y=600
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, #X, #Y, "Double Pendulum", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,#X,#Y,0,0,0,#PB_Screen_WaitSynchronization)=0
MessageRequester("Error", "Can't open the sprite system", 0)
End
EndIf
Structure xy
x.i
y.i
EndStructure
NewList trace.xy()
x0.i=#x/2:y0.i=#y/2:x1.i=0:y1.i=0:x2.i=0:y2.i=0
acceleration1.f=0.0:acceleration2.f=0.0
vitesse1.f=0:vitesse2.f=0
g.f=1
Repeat
FlipBuffers()
ClearScreen(#Black)
ExamineKeyboard()

num1.f=-g*(2*#Mass1+#Mass2)*Sin(Angle1)
num2.f=-g*#Mass2*Sin(Angle1-2*Angle2)
num3.f=-2*#Mass2*Sin(Angle1-Angle2)
num4.f=vitesse2*vitesse2*#ArmLength2+vitesse1*vitesse1*#ArmLength1*Cos(Angle1-Angle2)
num.f=num1+num2+num3*num4
den.f=2*#Mass1+#Mass2-#Mass2*Cos(2*Angle1-2*Angle2)
den.f=den*#ArmLength2
acceleration1=num/den

num1.f=2*Sin(Angle1-Angle2)
num2.f=vitesse1*vitesse1*#ArmLength1*(#Mass1+#Mass2)
num3.f= g*(#Mass1+#Mass2)*Cos(Angle1)
num4.f=vitesse2*vitesse2*#ArmLength2*#Mass2*Cos(Angle1-Angle2)
num.f=(num2+num3+num4)
num=num1*num
den.f  =#ArmLength2*(2*#Mass1+#Mass2-(#Mass2*Cos(2*Angle1-2*Angle2)))
acceleration2=num/den

vitesse1+acceleration1
vitesse2+acceleration2
Angle1+vitesse1
Angle2+vitesse2
x1=x0+#ArmLength1*Sin(Angle1)
y1=y0+#ArmLength1*Cos(Angle1)
x2=x1+#ArmLength2*Sin(Angle2)
y2=y1+#ArmLength2*Cos(Angle2)
If FirstElement(trace())
xold.i=trace()\x:yold.i=trace()\y
If ListSize(trace())>#MaxHistoricNumber:DeleteElement(trace()):EndIf
LastElement(trace())
EndIf
Trace()\x=x2
Trace()\y=y2

StartDrawing(ScreenOutput())

ForEach trace()
colorR.i=ListIndex(trace())*255/ListSize(trace())
LineXY(trace()\x,trace()\y,xold,yold,RGB(colorR,0,0))
xold=trace()\x:yold=trace()\y
Next
LineXY(x0,y0,x1,y1,#White)
LineXY(x1,y1,x2,y2,#White)
Circle(x1,y1,#Mass1)
Circle(x2,y2,#Mass2)
StopDrawing()
While WindowEvent():Wend
Until KeyboardPushed(#PB_Key_Escape)

_________________
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.70 LTS

Top

 Post subject: Re: Double PendulumPosted: Sun Jul 01, 2018 11:36 pm

Joined: Wed Aug 31, 2005 11:09 pm
Posts: 3695
Location: Italy
Very nice, I like it.
Nice how the trace slowly fades away.
Interesting demo

_________________

Top

 Post subject: Re: Double PendulumPosted: Mon Jul 02, 2018 6:00 am
 Enthusiast

Joined: Mon May 10, 2010 4:02 pm
Posts: 153
Very nice!

Top

 Post subject: Re: Double PendulumPosted: Mon Jul 02, 2018 8:33 am

Joined: Thu Jun 24, 2004 8:51 am
Posts: 1473
Location: Germany
little bit off topic:
I will write a Chipmunk4PB example too.
Thanks for the idea.

_________________
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...

Top

 Post subject: Re: Double PendulumPosted: Mon Jul 02, 2018 10:10 am
 Moderator

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1110
Location: Gernsbach (Germany)
Great

_________________

Top

 Post subject: Re: Double PendulumPosted: Mon Jul 02, 2018 11:02 am

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3465
Location: New Zealand
That's really great.

Top

 Post subject: Re: Double PendulumPosted: Mon Jul 02, 2018 7:21 pm

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1735
Location: Uttoxeter, UK
@Fig,
Another fine demonstration.
Thank you.

_________________
DE AA EB

Top

 Post subject: Re: Double PendulumPosted: Thu Jul 05, 2018 1:45 pm

Joined: Thu Jun 24, 2004 8:51 am
Posts: 1473
Location: Germany
Here the source part (not really optimized) of the "Double Pendulum" for the Chipmunk4PB wrapper framework.
Hope I can upload the next Chipmunk4PB wrapper framework version in few days.

Code:
Procedure initFuncDoublePendulum()
#ArmLength1 = 100:
#ArmLength2 = 120

initFunc()
cpSpaceSetGravity(*space, cpv(A,0, 100));
cpSpaceSetIterations(*space, 120)

; First stick
*pos1.cpVect = cpv(pos1.cpVect, wx/2,  200);
*sp1.cpSprite =  CreateSegmentElement(*space, *pos1\x,  *pos1\y, *pos1\x + #ArmLength1, *pos1\y, 0, #NormalBody)
cpShapeSetMass(*sp1\shape, 10)
*constraint1 = cpSpaceAddConstraint(*space, cpPinJointNew(*sp1\body, cpSpaceGetStaticBody(*space), *pos1, *pos1));

; Second stick
*pos2.cpVect = cpv(pos2.cpVect, *pos1\x + #ArmLength1,  *pos1\y);
*sp2.cpSprite = CreateSegmentElement(*space, *pos2\x,  *pos2\y, *pos2\x + #ArmLength2, *pos2\y, 0, #NormalBody)
cpShapeSetMass(*sp2\shape, 20)
*constraint2 = cpSpaceAddConstraint(*space, cpPinJointNew(*sp2\body, *sp1\body, *pos2, *pos2));
EndProcedure

Procedure updateFuncDoublePendulum()
updateFunc()
EndProcedure

Procedure destroyFuncDoublePendulum()
destroyFunc()
EndProcedure

ChipmunkDemo()\title = "Double Pendulum"
ChipmunkDemo()\timestep = 1.0/180
ChipmunkDemo()\initFunc = @initFuncDoublePendulum()
ChipmunkDemo()\updateFunc = @updateFuncDoublePendulum()
ChipmunkDemo()\destroyFunc = @destroyFuncDoublePendulum()

_________________
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...

Top

 Post subject: Re: Double PendulumPosted: Thu Jul 05, 2018 11:52 pm

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2465
Wow

Well done, even with some quirks (e.g. #ArmLength2=35)...
If anyone is able to predict the behaviour of a triple pendulum I will get nervous...

Top

 Post subject: Re: Double PendulumPosted: Fri Jul 06, 2018 6:40 am

Joined: Thu Jun 24, 2004 8:51 am
Posts: 1473
Location: Germany
Hint:
A n Pendulum with many small sections "simulates" a rope
I added an example to the Chipmunk4PB framework.

_________________
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...

Top

 Post subject: Re: Double PendulumPosted: Sat Jul 07, 2018 10:11 am

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2465
I've checked if vector drawing would be fast enough for Fig's nice code (replaced also the sprite commands by default event handling)...

Press 'Space' to change the drawing mode:

Code:
Global ActivePendulum
Global DrawingMode
Global DrawingModeChange

Procedure LineXY_(x1,y1,x2,y2,color)

If DrawingMode
MovePathCursor(x1,y1)
VectorSourceColor(\$FF000000|color)
StrokePath(2)

Else
LineXY(x1,y1,x2,y2,color)
EndIf

EndProcedure

If DrawingMode
;VectorSourceColor(\$FF000000|color)
FillPath()

Else

EndIf

EndProcedure

Procedure Pendulum(nil)

#ArmLength1=100:#ArmLength2=120
#Mass1=7:#Mass2=4
#MaxHistoricNumber=200

;departure angles
Angle1.f=-#PI/2:Angle2.f=-#PI/2
#x=800:#y=600

Structure xy
x.i
y.i
EndStructure
NewList trace.xy()

x0.i=#x/2:y0.i=#y/2:x1.i=0:y1.i=0:x2.i=0:y2.i=0
acceleration1.f=0.0:acceleration2.f=0.0
vitesse1.f=0:vitesse2.f=0
g.f=1

topleft.xy
topright.xy

ActivePendulum=#True

While ActivePendulum

num1.f=-g*(2*#Mass1+#Mass2)*Sin(Angle1)
num2.f=-g*#Mass2*Sin(Angle1-2*Angle2)
num3.f=-2*#Mass2*Sin(Angle1-Angle2)
num4.f=vitesse2*vitesse2*#ArmLength2+vitesse1*vitesse1*#ArmLength1*Cos(Angle1-Angle2)
num.f=num1+num2+num3*num4
den.f=2*#Mass1+#Mass2-#Mass2*Cos(2*Angle1-2*Angle2)
den.f=den*#ArmLength2
acceleration1=num/den

num1.f=2*Sin(Angle1-Angle2)
num2.f=vitesse1*vitesse1*#ArmLength1*(#Mass1+#Mass2)
num3.f= g*(#Mass1+#Mass2)*Cos(Angle1)
num4.f=vitesse2*vitesse2*#ArmLength2*#Mass2*Cos(Angle1-Angle2)
num.f=(num2+num3+num4)
num=num1*num
den.f  =#ArmLength2*(2*#Mass1+#Mass2-(#Mass2*Cos(2*Angle1-2*Angle2)))
acceleration2=num/den

vitesse1+acceleration1
vitesse2+acceleration2
Angle1+vitesse1
Angle2+vitesse2
x1=x0+#ArmLength1*Sin(Angle1)
y1=y0+#ArmLength1*Cos(Angle1)
x2=x1+#ArmLength2*Sin(Angle2)
y2=y1+#ArmLength2*Cos(Angle2)
If FirstElement(trace())
xold.i=trace()\x:yold.i=trace()\y
If ListSize(trace())>#MaxHistoricNumber:DeleteElement(trace()):EndIf
LastElement(trace())
EndIf
Trace()\x=x2
Trace()\y=y2

If DrawingMode
StartVectorDrawing(CanvasVectorOutput(0))
FillVectorOutput()
Else
StartDrawing(CanvasOutput(0))
Box(0,0,#X,#Y,#Black)
EndIf

#Marker=\$CBA762
#Taboo=#ArmLength1/2
topleft\y=9999
topright\y=9999

ForEach trace()
colorR.i=ListIndex(trace())*255/ListSize(trace())
LineXY_(trace()\x,trace()\y,xold,yold,RGB(colorR,0,0))
xold=trace()\x
yold=trace()\y
If xold<x0-#Taboo
If yold<topleft\y
topleft\y=yold
topleft\x=xold
EndIf
ElseIf xold>x0+#Taboo
If yold<topright\y
topright\y=yold
topright\x=xold
EndIf
EndIf
Next

LineXY_(topleft\x-6,topleft\y,topleft\x+6,topleft\y,#Marker)
LineXY_(topright\x-6,topright\y,topright\x+6,topright\y,#Marker)

LineXY_(x0,y0,x1,y1,#White)
LineXY_(x1,y1,x2,y2,#White)

Circle_(x1,y1,#Mass1)
Circle_(x2,y2,#Mass2)

If DrawingMode
StopVectorDrawing()
Else
StopDrawing()
EndIf

DrawingMode=DrawingModeChange
Wend

ActivePendulum=666

EndProcedure
Procedure Exit()
ActivePendulum=#Null
While ActivePendulum<>666
Delay(1)
Wend
Delay(5)
End
EndProcedure

Repeat

Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Exit()
Exit()
Else
DrawingModeChange!1
EndIf
EndSelect

ForEver

Top

 Post subject: Re: Double PendulumPosted: Mon Jul 09, 2018 8:44 am

Joined: Thu Jun 24, 2004 8:51 am
Posts: 1473
Location: Germany
Here are a Chipmunk2D Example (exe only! for the moment)
You can set 2-4 Sticks with the [-/+] Keys

Double Pendulum(screenshot):

4 Pendulum(screenshot):]

Zip (Exe only)

_________________
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...

Top

 Post subject: Re: Double PendulumPosted: Fri Sep 07, 2018 8:51 pm
 User

Joined: Fri Mar 04, 2005 7:46 pm
Posts: 73
Location: argentina

very interesting that,

_________________
Amd Vishera fx8350 ,16Gbram, Gtx650 ti, 2gb,Win 10pro. 13tbs.

Top

 Post subject: Re: Double PendulumPosted: Sun Oct 07, 2018 12:01 pm

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4597
Location: Spa, relaxing and thinking, and learning...
Great one.

_________________
http://www.zeitgeistmovie.com

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 14 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 0 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite