Text's particles attraction repulsion

Advanced game related topics
User avatar
falsam
Enthusiast
Enthusiast
Posts: 630
Joined: Wed Sep 21, 2011 9:11 am
Location: France
Contact:

Re: Text's particles attraction repulsion

Post by falsam »

Tested with Mac OS and Windows 10 and With a classic Logitech mouse. Very nice. Thank you for sharing. ^-^ :wink:

➽ Windows 11 64-bit - PB 6.0 x64 - AMD Ryzen 7 - NVIDIA GeForce GTX 1650 Ti

Sorry for my bad english and the Dunning–Kruger effect.
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Text's particles attraction repulsion

Post by Michael Vogel »

Tried to get rid of the floating calculations (not completely done) which may add a little bit speed, checked also if a simple canvas gadget is quick enough.
Even these things are looking fine, there are two others on the bad side: mouse coordinates are calculated for windows only and not all particles seem to find the way back to their home position when the mouse pointer will be moved around...

Code: Select all

; Define
	#Precision=8

	#X=800
	#Y=300
	#Maxspeed=			5<<#Precision
	#MaxForce=			1<<#Precision
	#FleeAction=		50<<#Precision
	#RepulseMagnitude=	5<<#Precision
	#DistanceToLand=	20<<#Precision

	#DistanceBetweenPoint=10
	#FontSize=160
	#ParticleSize=2
	text$="PureBasic"

	If OpenWindow(0, 0, 0, #X, #Y, "Steering Particle Text", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0: MessageRequester("Error", "Can't open windowed screen!", 0): EndIf
	CanvasGadget(0,0,0,#x,#y)

	Structure vector
		x.i
		y.i
	EndStructure
	Structure pt
		Pos.vector
		Vel.vector
		Acc.vector
		target.vector
		size.i
		color.i
	EndStructure

	Enumeration sprites
		#mouse_spr
		#point_spr
	EndEnumeration

	;for addPointsFromImage procedure ;pour la procédure addPointsFromImage
	Enumeration -2
		#color_random
		#color_source
	EndEnumeration

	Global NewList Pt.pt()

; EndDefine
; Define Vector Functions
	Macro DebugVector(text,v)
		Debug text+": "+Str(v\x)+" / "+Str(v\y)
	EndMacro
	Macro SetVector(v,x_,y_)
		v\x=x_
		v\y=y_
	EndMacro
	Macro CopyVector(v,a)
		a=v
	EndMacro
	Macro AddVector(v,a)
		v\x+a\x
		v\y+a\y
	EndMacro
	Macro SubVector(v,a)
		v\x-a\x
		v\y-a\y
	EndMacro
	Macro MulVector(v,val)
		v\x*val
		v\y*val
	EndMacro
	Macro LenVector(v)
		Int(Sqr((v\x*v\x)+(v\y*v\y)))
	EndMacro
	Procedure.f SetMagnitudeVector(*V1.vector,magnitude.f)
		angle.f=ATan2(*V1\x,*V1\y)
		*V1\y=magnitude*Sin(angle)
		*V1\x=magnitude*Cos(angle)
	EndProcedure
	Procedure LimitMagnitudeVector(*V1.vector,limit)
		Protected magnitude=LenVector(*V1)
		If magnitude>limit
			SetMagnitudeVector(*V1,limit)
		EndIf
	EndProcedure
	Procedure RandomVector(*V1.vector,MagnitudeMax)
		*V1\x=(Random(2000)-1000)
		*V1\y=(Random(2000)-1000)
		SetMagnitudeVector(*V1,Random(MagnitudeMax))
	EndProcedure
; EndDefine
Procedure UpdateParticlePhysic()
	ForEach pt()
		With pt()
			AddVector(\Pos,\Vel)
			AddVector(\Vel,\Acc)
			MulVector(\Acc,0)
		EndWith
	Next pt()
EndProcedure
Procedure Arrive()
	Define steer.vector,desired.vector
	ForEach pt()
		With pt()
			CopyVector(\target,desired)
			SubVector(desired,\Pos)
			distance.f=LenVector(Desired)
			MaxSpeed.f=#MaxSpeed
			If distance<#DistanceToLand
				MaxSpeed=MaxSpeed/(#DistanceToLand-d)
			EndIf
			SetMagnitudeVector(Desired,MaxSpeed)
			CopyVector(desired,Steer)

			SubVector(Steer,pt()\vel)
			LimitMagnitudeVector(Steer,#MaxForce)
			AddVector(\acc,Steer)
		EndWith
	Next pt()
EndProcedure
Procedure Flee()

	Protected Desired.vector
	Static oldmouse.vector
	Protected mouse.vector
	Protected fleespeed
	Protected n

	GetCursorPos_(mouse)
	ScreenToClient_(GadgetID(0),mouse)
	MulVector(mouse,1<<#Precision)

	SubVector(oldmouse,mouse)
	fleespeed=LenVector(oldmouse)
	CopyVector(mouse,oldmouse)

	If fleespeed>#RepulseMagnitude
		fleespeed=#RepulseMagnitude
	EndIf

	ForEach pt()
		CopyVector(mouse,Desired)
		SubVector(Desired,pt()\Pos)
		If LenVector(Desired)<#FleeAction
			SetMagnitudeVector(Desired,-fleespeed)
			AddVector(pt()\acc,Desired)
			SubVector(Desired,pt()\vel)
			LimitMagnitudeVector(Desired,#MaxForce)
		EndIf
	Next pt()


EndProcedure

;filter drawing into equally spaced points specified by filterDistanceBetweenPoint ;Filtrage en points équidistants spécifiés par filterDistanceBetweenPoint
Procedure filterDraw(x, y, sourcecolor, targetcolor)
	Shared filterDistanceBetweenPoint
	If x % filterDistanceBetweenPoint = 0 And y % filterDistanceBetweenPoint = 0
		ProcedureReturn targetcolor
	Else
		ProcedureReturn 0
	EndIf
EndProcedure
;Add a particle for each points of the text/ajoute une particule pour chacun de ces point
Procedure addPointsFromImage(List pt.pt(), image, xmin, ymin, xmax, ymax, size = #ParticleSize, x_dst = 0, y_dst = 0, color = #color_random)
	Protected i, j

	If StartDrawing(ImageOutput(image))
		For j = ymin To ymax
			If j > OutputHeight() - 1: Continue: EndIf
			For i = xmin To xmax
				If i > OutputWidth() - 1: Continue: EndIf
				If Point(i, j) <> 0
					AddElement(pt())
					pt()\pos\x = Random(#X)<<#Precision; Random(x_dst + xmax)<<#Precision
					pt()\pos\y = Random(#Y)<<#Precision; Random(y_dst + ymax)<<#Precision
					pt()\target\x = (x_dst + i)<<#Precision
					pt()\target\y = (y_dst + j)<<#Precision
					RandomVector(pt()\vel, 10)
					pt()\size = size
					Select color
					Case #color_random
						pt()\color = RGB(Random(255), Random(255), Random(255))
					Case #color_source
						pt()\color = Point(i, j)
					Default
						pt()\color = color
					EndSelect
				EndIf
			Next i
		Next j
		StopDrawing()
	EndIf
EndProcedure

Define filterDistanceBetweenPoint = #DistanceBetweenPoint
;{ Transform text$ in a vector points shape. /transforme le text$ en une série de points
	CreateImage(0,#X,#Y)
	LoadFont(0, "Arial", 20, #PB_Font_Bold)

	If StartVectorDrawing(ImageVectorOutput(0,#PB_Unit_Pixel))
		VectorFont(FontID(0),#fontSize)

		large=VectorTextWidth(Text$)
		Haut=VectorTextHeight(Text$)
		ox=(#X-large)>>1
		oy=(#Y-haut)>>1
		MovePathCursor(ox,oy)

		AddPathText(Text$)
		VectorSourceColor(RGBA(255, 0, 0, 255))
		FillPath()
		StopVectorDrawing()

		If StartDrawing(ImageOutput(0)) ;filter image to equally spaced points ;filtre l'image sur des points équidistants
			filterDistanceBetweenPoint = #DistanceBetweenPoint / 3
			DrawingMode(#PB_2DDrawing_CustomFilter)
			CustomFilterCallback(@filterDraw())
			Box(ox,oy,large, haut, RGB(255, 0, 0))
			StopDrawing()
		EndIf
		addPointsFromImage(pt(),0,ox,oy,ox+large,oy+Haut, 5)
	EndIf

	If StartVectorDrawing(ImageVectorOutput(0, #PB_Unit_Pixel))

		MovePathCursor(0,0)
		AddPathBox(0,0,VectorOutputWidth(), VectorOutputHeight())
		VectorSourceColor(RGBA(0,0,0,255))
		FillPath()
		VectorFont(FontID(0),#fontSize)
		MovePathCursor(ox,oy)
		AddPathText(Text$)
		VectorSourceColor(RGBA(255, 0, 0, 255))
		DotPath(1,#DistanceBetweenPoint/4)
		StopVectorDrawing()
		addPointsFromImage(pt(),0,ox,oy,ox+large,oy+Haut, 5, 0,0,RGB(255, 0, 0))
	EndIf
	FreeImage(0)

	If LoadImage(0, #PB_Compiler_Home + "\Examples\Sources\Data\PureBasicLogo.bmp")
		addPointsFromImage(pt(), 0, 0, 0, ImageWidth(0), ImageHeight(0), 1, 0,#y - ImageHeight(0), #color_source)
		FreeImage(0)
	EndIf

	If LoadImage(0, #PB_Compiler_Home + "\Examples\Sources\Data\GeeBee2.bmp")
		If StartDrawing(ImageOutput(0))
			;filter image to equally spaced points ;filtre l'image sur des points équidistants
			filterDistanceBetweenPoint = #DistanceBetweenPoint / 4
			DrawingMode(#PB_2DDrawing_CustomFilter)
			CustomFilterCallback(@filterDraw())
			Box(0, 0, ImageWidth(0), ImageHeight(0), RGB(255, 0, 0))
			StopDrawing()
		EndIf
		addPointsFromImage(pt(), 0, 0, 0, ImageWidth(0), ImageHeight(0), 3, #x - ImageWidth(0),#y - ImageHeight(0), #color_source)
		FreeImage(0)
	EndIf

;}

Repeat
	Arrive()
	Flee()
	UpdateParticlePhysic()
	StartDrawing(CanvasOutput(0))
	Box(0,0,#X,#y,0)
	ForEach pt()
		Box(pt()\pos\x>>#Precision, pt()\pos\y>>#Precision,#ParticleSize,#ParticleSize,pt()\color)
	Next
	StopDrawing()
Until WindowEvent()=#PB_Event_CloseWindow
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: Text's particles attraction repulsion

Post by Kukulkan »

Really a great effect. The initial post works fine here on Linux, too. Impressive :)

The variants of Michael Vogel and Demivec do not work on my Linux machine (KDE Neon, PB 5.46 LTS). No cross-platform compatibility any more (Win API or only black screen).
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Text's particles attraction repulsion

Post by Kwai chang caine »

Amazing !!! :shock:
Works great here W7 sp1 / v5.62 x86 :D
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply