It is currently Thu Jul 02, 2020 9:00 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 19 posts ]  Go to page Previous  1, 2
Author Message
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 7:43 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 21, 2011 9:11 am
Posts: 608
Location: France
Tested with Mac OS and Windows 10 and With a classic Logitech mouse. Very nice. Thank you for sharing. ^-^ :wink:

_________________

➽ Windows 10 - PB 5.62 & PB 5.70 LTS

Sorry for my bad english and the Dunning–Kruger effect.


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Wed Sep 19, 2018 12:03 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2544
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:
; 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


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Thu Sep 20, 2018 7:55 am 
Offline
Addict
Addict
User avatar

Joined: Mon Jun 06, 2005 2:35 pm
Posts: 1239
Location: germany
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).


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Thu Sep 20, 2018 1:22 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4685
Location: Lyon - France
Amazing !!! :shock:
Works great here W7 sp1 / v5.62 x86 :D
Thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 19 posts ]  Go to page Previous  1, 2

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


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

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye