Double Pendulum

Advanced game related topics
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Double Pendulum

Post by Fig »

https://en.wikipedia.org/wiki/Double_pendulum
Feel free to change arms length, pendulum's mass, departure angles...

Code: Select all

#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
    AddElement(Trace())
    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.71 LTS
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: Double Pendulum

Post by luis »

Very nice, I like it.
Nice how the trace slowly fades away.
Interesting demo :)
"Have you tried turning it off and on again ?"
A little PureBasic review
kvitaliy
Enthusiast
Enthusiast
Posts: 162
Joined: Mon May 10, 2010 4:02 pm

Re: Double Pendulum

Post by kvitaliy »

Very nice!
User avatar
IceSoft
Addict
Addict
Posts: 1616
Joined: Thu Jun 24, 2004 8:51 am
Location: Germany

Re: Double Pendulum

Post by IceSoft »

little bit off topic:
I will write a Chipmunk4PB example too.
Thanks for the idea.
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Double Pendulum

Post by RSBasic »

Great Image
Image
Image
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Double Pendulum

Post by idle »

That's really great.
Windows 11, Manjaro, Raspberry Pi OS
Image
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Double Pendulum

Post by davido »

@Fig,
Another fine demonstration.
Thank you.
DE AA EB
User avatar
IceSoft
Addict
Addict
Posts: 1616
Joined: Thu Jun 24, 2004 8:51 am
Location: Germany

Re: Double Pendulum

Post by IceSoft »

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: Select all

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

AddElement(ChipmunkDemo())
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,...
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Double Pendulum

Post by Michael Vogel »

Wow :shock:

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...
User avatar
IceSoft
Addict
Addict
Posts: 1616
Joined: Thu Jun 24, 2004 8:51 am
Location: Germany

Re: Double Pendulum

Post by IceSoft »

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,...
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Double Pendulum

Post by Michael Vogel »

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: Select all

Global ActivePendulum
Global DrawingMode
Global DrawingModeChange

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

	If DrawingMode
		MovePathCursor(x1,y1)
		AddPathLine(x2,y2)
		VectorSourceColor($FF000000|color)
		StrokePath(2)

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

EndProcedure
Procedure Circle_(x,y,radius)

	If DrawingMode
		AddPathCircle(x,y,radius)
		;VectorSourceColor($FF000000|color)
		FillPath()

	Else
		Circle(x,y,radius)

	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
		AddElement(Trace())
		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

OpenWindow(0,0,0,#X,#Y,"Double Pendulum",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,#X,#Y)
AddKeyboardShortcut(0,#PB_Shortcut_Escape,666)
AddKeyboardShortcut(0,#PB_Shortcut_Space,1000)

CreateThread(@Pendulum(),#Null)

Repeat

	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		Exit()
	Case #PB_Event_Menu
		If EventMenu()=666
			Exit()
		Else
			DrawingModeChange!1
		EndIf
	EndSelect

ForEver

User avatar
IceSoft
Addict
Addict
Posts: 1616
Joined: Thu Jun 24, 2004 8:51 am
Location: Germany

Re: Double Pendulum

Post by IceSoft »

Here are a Chipmunk2D Example (exe only! for the moment)
You can set 2-4 Sticks with the [-/+] Keys

Double Pendulum(screenshot):
Image

4 Pendulum(screenshot):]
Image

Zip (Exe only)
https://drive.google.com/file/d/1Moarsl ... sp=sharing
Belive!
<Wrapper>4PB, PB<game>, =QONK=, PetriDish, Movie2Image, PictureManager,...
zefiro_flashparty
User
User
Posts: 74
Joined: Fri Mar 04, 2005 7:46 pm
Location: argentina

Re: Double Pendulum

Post by zefiro_flashparty »

:lol:
very interesting that,
Amd Vishera fx8350 ,16Gbram, Gtx650 ti, 2gb,Win 10pro. 13tbs. 8)
User avatar
Psychophanta
Addict
Addict
Posts: 4973
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Double Pendulum

Post by Psychophanta »

Great one. :!:
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
Post Reply