It is currently Sun Aug 18, 2019 4:00 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 19 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 9:51 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 300
Location: Côtes d'Azur, France
Be gentle enough to press [Escape] to Quit. :wink:
Tested successfully on Win10x64, PB 5.62 x86

Image

Code:
#X=800:#Y=300 ;screen size /taille de l'écran
#Maxspeed=5.0:#MaxForce=1.0
#FleeAction=150 ;distance from mouse particles flee /Distance depuis laquelle les particules fuient la souris
#RepulseMagnitude=-3 ;should be negative to flee. Multiplicator to repulse particles /Multiplicateur négatif de la force de fuite
#DistanceToLand=20 ;distance to slowdown close to the goal, in pixels ;distance à partir de laquelle les particules ralentissent
#FontSize=160
#DistanceBetweenPoint=10 ;number of particles (space between dots in text's shape) /nombre de points dans le texte: donc nombre de particules
#ParticleSize=2          ;particles' radius /rayon d'une particule
text$="PureBasic"

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0: MessageRequester("Error", "Can't open the sprite system", 0): End: EndIf
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
If OpenWindowedScreen(WindowID(0), 0, 0, #X, #Y, 0, 0, 0) = 0: MessageRequester("Error", "Can't open windowed screen!", 0): EndIf   

Structure vector
    x.f
    y.f
EndStructure
Structure pt
    Pos.vector
    Vel.vector
    Acc.vector
    target.vector

    size.i
    color.i
EndStructure

Global NewList Pt.pt()

Procedure AddVector(*V1.vector,*V2.vector,*V3.vector)
    *V3\x=*V1\x+*V2\x
    *V3\y=*V1\y+*V2\y
EndProcedure   
Procedure SubVector(*V1.vector,*V2.vector,*V3.vector)
    *V3\x=*V1\x-*V2\x
    *V3\y=*V1\y-*V2\y
EndProcedure   
Procedure MultVector(*V1.vector,val.f)
    *V1\x*val
    *V1\y*val
EndProcedure   
Procedure.f ReadMagnitudeVector(*V1.vector)
    Magnitude.f=Sqr((*V1\x**V1\x)+(*V1\y**V1\y))
    ProcedureReturn Magnitude
EndProcedure
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.f LimitMagnitudeVector(*V1.vector,limit.f)
    magnitude.f=ReadMagnitudeVector(*V1)
    If magnitude>limit
        SetMagnitudeVector(*V1,limit)
    EndIf   
EndProcedure
Procedure RandomVector(*V1.vector,MagnitudeMax.f)
    *V1\x=Random(2000)-1000
    *V1\y=Random(2000)-1000
    SetMagnitudeVector(*V1,Random(MagnitudeMax*1000)/1000)
EndProcedure

Procedure UpdateParticlePhysic()
    ForEach pt()
        AddVector(pt()\pos,pt()\Vel,pt()\pos)
        AddVector(pt()\Vel,pt()\Acc,pt()\Vel)
        MultVector(pt()\Acc,0)
    Next pt()
EndProcedure
Procedure Arrive()
    Define steer.vector,desired.vector
    ForEach pt()
        SubVector(pt()\target,pt()\Pos,Desired)
        distance.f=ReadMagnitudeVector(Desired)
        MaxSpeed.f=#MaxSpeed
        If distance<#DistanceToLand
            MaxSpeed=MaxSpeed/(#DistanceToLand-distance)
        EndIf   
        SetMagnitudeVector(Desired,MaxSpeed)
        SubVector(Desired,pt()\vel,Steer)
        LimitMagnitudeVector(Steer,#MaxForce)
        AddVector(Steer,pt()\acc,pt()\acc)
    Next pt()   
EndProcedure
Procedure Flee(*mouse.vector)
    Define Steer.vector,Desired.vector
    ForEach pt()
        SubVector(*mouse,pt()\Pos,Desired)
        If ReadMagnitudeVector(Desired)<#FleeAction
            SetMagnitudeVector(Desired,#Maxspeed)
            MultVector(Desired,#RepulseMagnitude)
            SubVector(Desired,pt()\vel,Steer)
            LimitMagnitudeVector(Steer,#MaxForce)
            AddVector(Steer,pt()\acc,pt()\acc)
        EndIf
    Next pt()   
EndProcedure

;{ 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)
        MovePathCursor(0, 0)
        AddPathText(Text$)
        large.i=VectorTextWidth(Text$)
        Haut.i=VectorTextHeight(Text$)
        VectorSourceColor(RGBA(255, 0, 0, 255))
        DotPath(1,#DistanceBetweenPoint)
        StopVectorDrawing()
    EndIf
;}
;{ Add a particle for each points of the text/ajoute une particule pour chacun de ces point
  If StartDrawing(ImageOutput(0))
      For j=0 To haut
          For i=0 To large
              If i>#x-1 Or j>#y-1:Continue:EndIf
              If Point(i,j)<>0
                  AddElement(pt())
                  pt()\pos\x=Random(#x):pt()\pos\y=Random(#y)
                  pt()\target\x=i:pt()\target\y=j
                  RandomVector(pt()\vel,10)
                  pt()\size=#ParticleSize:pt()\color=RGB(Random(255),Random(255),Random(255))
              EndIf
          Next i
      Next j
      StopDrawing()
  EndIf
  FreeImage(0)
  ;}
 
Define mouse.vector:MouseLocate(#x/2,#y)
Repeat
    Repeat
    Until WindowEvent()=0

    FlipBuffers()
    ClearScreen($0)
    ExamineKeyboard()
    ExamineMouse()
    mouse\x=MouseX():mouse\y=MouseY()
   
    Arrive()
    Flee(mouse)
    UpdateParticlePhysic()
   
    StartDrawing(ScreenOutput())
    ;display particles /affiche les particules
    ForEach pt()
        Circle(pt()\pos\x,pt()\pos\y,pt()\size,pt()\color)
    Next
    ;display mouse cursor /affiche le curseur
    Circle(mouse\x,mouse\y,2,RGB(0,255,0))
    StopDrawing()
Until KeyboardPushed(#PB_Key_Escape)

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

Win10, Pb x86 5.70 LTS


Last edited by Fig on Tue Sep 18, 2018 9:06 am, edited 13 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 9:54 am 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1078
Location: Germany::Berlin()
Very nice effect. Image

_________________
ImageImageImageImage(Update: 17.08.2019 (+196 files, +1392 MB)) Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 10:16 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Oct 06, 2007 11:20 pm
Posts: 261
Location: France
Great ! Thanks for sharing.

_________________
~Ar-S~

ResizerGold : The easiest way to resize your pictures and more
My webSite (french) : LDVMULTIMEDIA
PB - 5.4x LTS / 5.6x - W10 x64 - GTX1080 - i5 6600k
Repeat : try : until done = 1


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 10:24 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jun 22, 2003 7:43 pm
Posts: 415
Location: Germany, Saarbrücken
OpenWindowedScreen() does not work correctly in Linux. The window appears and I can see the graphics but the mouse is locked in the middle of my desktop, the debugger window is on top and the graphics demo is in the background. I was not able to bring the window to the front, I was not able to move the mouse, I was not able to quit the demo using ESC because the window doesn't had the focus. I had to switch to an other terminal and the pkill the purebasic process.
What the heck? Is anyone able to use this demo on Linux like it is possible on Windows?

_________________
Electronics, Crazy & Interesting Stuff, all that with text, image and sound? Click here!

The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 12:06 pm 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1018
Location: right here
Quote:
Is anyone able to use this demo on Linux

Works here, kind of. The mouse responsiveness gets better if I use WaitWindowEvent() with a small timeout. When using the external debugger I get the focus problems, too. But I can alt-tab to the program and esc to exit it, though then 'Beenden' (quit/exit) in the external debugger window make it unresponsive and OS is asking me to terminate the unresponsive debugger. Then the same for the IDE (unresponsive, terminate).
Works fine without modification with debugger disabled.


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 4:23 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3635
Location: Berlin, Germany
Very nice, many thanks for sharing!

Unfortunately, I encountered a problem.
While earlier today there was a black-and-white version that seemed to work OK, the current coloured version (Mon Sep 17, 2018 3:00 pm) has a problem here with PB 5.62 x64 on Windows 10: Moving the mouse causes no effect. And while your code is running, the mouse cursor is invisible on the whole system, i.e. even outside of the window created by your code.

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 5:15 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 300
Location: Côtes d'Azur, France
I am a little bit confused. Each time I post a code there are problems with linux version. I can't manage to get a main loop right.
Events, flipscreen... What is the right order ?

I changed the code one more time, does it improve anything ?

There is nothing really complexe here, no memory trick, just a basic startdrawing/stopdrawing thing. :?

Does someone could help me there ?

Little John> I am so sorry to hear it doesn't work anymore even on Win10... It does for me so I am out of clue.
Does someone else have troubles ?

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

Win10, Pb x86 5.70 LTS


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 6:10 pm 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1018
Location: right here
I don't think there was anything particularly wrong with your previous code and also not with your current code. These are problems with the PB tools (debugger /editor).

For a mouse release/capture the last thing that worked for me can be found here (2nd code is for linux):
https://www.purebasic.fr/english/viewtopic.php?f=13&t=70915&p=523759#p523759

<edit>
the linked code doesn't seem to work with subsystem qt :( but i didn't look into that yet.


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Mon Sep 17, 2018 11:37 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3635
Location: Berlin, Germany
Fig wrote:
Little John> I am so sorry to hear it doesn't work anymore even on Win10... It does for me so I am out of clue.
Does someone else have troubles ?

The current version when I'm writing this (i.e. the version from Mon Sep 17, 2018 5:19 pm) works fine here on Windows 10. :D
Many thanks again!

#NULL wrote:
For a mouse release/capture the last thing that worked for me can be found here (2nd code is for linux):
https://www.purebasic.fr/english/viewtopic.php?f=13&t=70915&p=523759#p523759

I wasn't aware that OpenWindowedScreen() always captures the mouse. :oops: Your code is very helpful, thanks a lot!
IMHO it would be good if OpenWindowedScreen() had an additional optional parameter with possible values say #PB_Capture and #PB_DontCapture, so that we could control this behaviour without having to write our own code for it.

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 3:53 am 
Offline
Addict
Addict
User avatar

Joined: Mon Jul 25, 2005 3:51 pm
Posts: 3568
Location: Utah, USA
Thanks for the code Fig. I like it a lot.

Here are a few modifications. It now draws the points and mouse cursor with sprites (much faster). Added a procedure to add points from an image. You can specify what part of the image to transfer as well as the starting point of where to add the points to. You can also specify the size of the particles and the color to use. The choices are random color, image source color, or a specific color for all points being added.

It can still use some further stream lining but I had to make a stopping point.

Code:
;Text particles attraction, repulsion
;original code by Fig
;modifications by Demivec, Little John, Michael Vogel

EnableExplicit
#X=800:#Y=300 ;screen size /taille de l'écran
#Maxspeed=5.0:#MaxForce=1.0
#FleeAction=150 ;distance from mouse particles flee /Distance depuis laquelle les particules fuient la souris
#RepulseMagnitude=-3 ;should be negative to flee. Multiplicator to repulse particles /Multiplicateur négatif de la force de fuite
#DistanceToLand=20   ;distance to slowdown close to the goal, in pixels ;distance à partir de laquelle les particules ralentissent
#FontSize=160
#DistanceBetweenPoint=10 ;number of particles (space between dots in text's shape) /nombre de points dans le texte: donc nombre de particules
#ParticleSize=4          ;particles' diameter /diamètre d'une particule
Define text$="PureBasic"

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0: MessageRequester("Error", "Can't open the sprite system", 0): End: EndIf
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
If OpenWindowedScreen(WindowID(0), 0, 0, #X, #Y, 0, 0, 0) = 0: MessageRequester("Error", "Can't open windowed screen!", 0): EndIf   

Structure vector
  x.f
  y.f
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()

Procedure AddVector(*V1.vector,*V2.vector,*V3.vector)
  *V3\x=*V1\x+*V2\x
  *V3\y=*V1\y+*V2\y
EndProcedure   
Procedure SubVector(*V1.vector,*V2.vector,*V3.vector)
  *V3\x=*V1\x-*V2\x
  *V3\y=*V1\y-*V2\y
EndProcedure   
Procedure MultVector(*V1.vector,val.f)
  *V1\x*val
  *V1\y*val
EndProcedure   
Procedure.f ReadMagnitudeVector(*V1.vector)
  Protected Magnitude.f=Sqr((*V1\x**V1\x)+(*V1\y**V1\y))
  ProcedureReturn Magnitude
EndProcedure
Procedure.f SetMagnitudeVector(*V1.vector,magnitude.f)
  Protected angle.f=ATan2(*V1\x,*V1\y)
  *V1\y=magnitude*Sin(angle)
  *V1\x=magnitude*Cos(angle)
EndProcedure
Procedure.f LimitMagnitudeVector(*V1.vector,limit.f)
  Protected magnitude.f=ReadMagnitudeVector(*V1)
  If magnitude>limit
    SetMagnitudeVector(*V1,limit)
  EndIf   
EndProcedure
Procedure RandomVector(*V1.vector,MagnitudeMax.f)
  *V1\x=Random(2000)-1000
  *V1\y=Random(2000)-1000
  SetMagnitudeVector(*V1,Random(MagnitudeMax*1000)/1000)
EndProcedure

Procedure UpdateParticlePhysic()
  ForEach pt()
    AddVector(pt()\pos,pt()\Vel,pt()\pos)
    AddVector(pt()\Vel,pt()\Acc,pt()\Vel)
    MultVector(pt()\Acc,0)
  Next pt()
EndProcedure
Procedure Arrive()
  Protected steer.vector,desired.vector, distance.f, MaxSpeed.f
  ForEach pt()
    SubVector(pt()\target,pt()\Pos,Desired)
    distance.f=ReadMagnitudeVector(Desired)
    MaxSpeed.f=#MaxSpeed
    If distance<#DistanceToLand
      MaxSpeed=MaxSpeed/(#DistanceToLand-distance)
    EndIf   
    SetMagnitudeVector(Desired,MaxSpeed)
    SubVector(Desired,pt()\vel,Steer)
    LimitMagnitudeVector(Steer,#MaxForce)
    AddVector(Steer,pt()\acc,pt()\acc)
  Next pt()   
EndProcedure

Procedure Flee(*mouse.vector,*oldmouse.vector)
   Define Steer.vector,Desired.vector
   
   Protected factor.f=Pow(*oldmouse\x-*mouse\x,2)+Pow(*oldmouse\y-*mouse\y,2)
   While factor > 1.5: factor / 2.0: Wend
   
   ForEach pt()
      SubVector(*mouse,pt()\Pos,Desired)
      If ReadMagnitudeVector(Desired)<#FleeAction
         SetMagnitudeVector(Desired,#Maxspeed)
         MultVector(Desired,#RepulseMagnitude)
         SubVector(Desired,pt()\vel,Steer)
         LimitMagnitudeVector(Steer,factor) ;LimitMagnitudeVector(Steer,#MaxForce)
         AddVector(Steer,pt()\acc,pt()\acc)
      EndIf
   Next pt()
EndProcedure

Define filterDistanceBetweenPoint = #DistanceBetweenPoint
;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_dst + xmax - xmin): pt()\pos\y = Random(y_dst + ymax - ymin)
          pt()\target\x = x_dst + i - xmin: pt()\target\y = y_dst + j - ymin
          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


;{ Transform text$ in a vector points shape. /transforme le text$ en une série de points
Define large, Haut
CreateImage(0, #x, #y)
LoadFont(0, "Arial", 20, #PB_Font_Bold)
If StartVectorDrawing(ImageVectorOutput(0,#PB_Unit_Pixel))
  VectorFont(FontID(0),#fontSize)
  MovePathCursor(0, 0)
  AddPathText(Text$)
  large.i=VectorTextWidth(Text$)
  Haut.i=VectorTextHeight(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 / 2
    DrawingMode(#PB_2DDrawing_CustomFilter)
    CustomFilterCallback(@filterDraw())
    Box(0, 0, large, haut, RGB(255, 0, 0))
    StopDrawing()
  EndIf
  addPointsFromImage(pt(), 0, 0,0, large,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(0, 0)
  AddPathText(Text$)
  large.i = VectorTextWidth(Text$)
  Haut.i = VectorTextHeight(Text$)
  VectorSourceColor(RGBA(255, 0, 0, 255))
  DotPath(1, #DistanceBetweenPoint / 4)
  StopVectorDrawing()
  addPointsFromImage(pt(), 0, 0,0, large, 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

;}

If CreateSprite(#mouse_spr, 8, 8, #PB_Sprite_AlphaBlending)
  If StartDrawing(SpriteOutput(#mouse_spr))
    Circle(4, 4, 2, RGBA(0, 255, 0, 0))   
    StopDrawing()
    TransparentSpriteColor(#mouse_spr, 0)
  EndIf
EndIf

If CreateSprite(#point_spr, 16, 16, #PB_Sprite_AlphaBlending)
  If StartDrawing(SpriteOutput(#point_spr))
    Circle(8, 8, 7, RGBA(0, 255, 255, 255))   
    StopDrawing()
    TransparentSpriteColor(#point_spr, 0)
  EndIf
EndIf


Define oldmouse.vector
Define mouse.vector:MouseLocate(#x/2,#y)
Define InputReleased = 0, event
Repeat
  Repeat
    event = WindowEvent()
    If event = #PB_Event_CloseWindow: End: EndIf
  Until event = 0
 
  FlipBuffers()
 
  If IsScreenActive() = 0
    If InputReleased = 0
      ReleaseMouse(#True): InputReleased = 1
    EndIf
  Else
    If InputReleased = 1
      ReleaseMouse(#False): InputReleased = 0
    EndIf
  EndIf
 
  ClearScreen($0)
  ExamineKeyboard()
  If InputReleased = 0
    ExamineMouse()
    oldmouse=mouse; NEW
    mouse\x=MouseX():mouse\y=MouseY()
  EndIf
 
  Arrive()
  Flee(mouse, oldmouse)
  UpdateParticlePhysic()
 
  ForEach pt()
    ZoomSprite(#point_spr, pt()\size, pt()\size)
    DisplayTransparentSprite(#point_spr,pt()\pos\x, pt()\pos\y, 255, pt()\color) 
  Next
 
  ;display mouse cursor /affiche le curseur
  DisplaySprite(#mouse_spr, mouse\x - SpriteWidth(#mouse_spr) / 2, mouse\y - SpriteHeight(#mouse_spr) / 2);Circle(mouse\x,mouse\y,2,RGB(0,255,0))
Until KeyboardPushed(#PB_Key_Escape)


@Edit: I added Little John's idea to delcare all variables. I added a limited check for controlling whether the mouse is released to access other windows. I incorporated Michael Vogel's change in the Flee() procedure but limited it's effect to 1.5 (it was hitting 1000+ on my system!).

_________________
Image


Last edited by Demivec on Tue Sep 18, 2018 8:42 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 5:48 am 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1665
Location: Uttoxeter, UK
Very nice. Thank you for sharing.

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 7:43 am 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1018
Location: right here
Little John wrote:
I wasn't aware that OpenWindowedScreen() always captures the mouse.
It's actually the mouse lib, specifically the first call to ExamineMouse() that captures the mouse. But you can use a screen without the mouse lib. Or you can call ReleaseMouse(1) after opening the screen, rather pointless though. Some kind of auto-release would be nice, yes.


Last edited by #NULL on Tue Sep 18, 2018 9:16 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 8:24 am 
Offline
Addict
Addict
User avatar

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2430
C :shock: :shock: L !

I'v changed to things here, first drawing boxes instead of circles to speed everything up and second, making the mouse influence a bit more dynamic doing the following changes:
Code:
Procedure Flee(*mouse.vector,*oldmouse.vector)
   Define Steer.vector,Desired.vector
   
   Protected factor.f
   factor=Pow(*oldmouse\x-*mouse\x,2)+Pow(*oldmouse\y-*mouse\y,2)
   
   ForEach pt()
      SubVector(*mouse,pt()\Pos,Desired)
      If ReadMagnitudeVector(Desired)<#FleeAction
         SetMagnitudeVector(Desired,#Maxspeed)
         MultVector(Desired,#RepulseMagnitude)
         SubVector(Desired,pt()\vel,Steer)
         LimitMagnitudeVector(Steer,factor)
         AddVector(Steer,pt()\acc,pt()\acc)
      EndIf
   Next pt()
EndProcedure

 :

Define mouse.vector
Define oldmouse.vector; NEW
:
oldmouse=mouse; NEW
mouse\x=MouseX()
mouse\y=MouseY()
Arrive()
Flee(mouse,oldmouse); CHANGED
   


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 9:03 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3635
Location: Berlin, Germany
@Fig:
In my private copy, I added EnableExplicit as the first executable line and declared all variables. Then I stumbled across a tiny glitch in Procedure Arrive():
Code:
            MaxSpeed=MaxSpeed/(#DistanceToLand-d)

The variable d is not used anywhere else. :-)
Probably a remnant from some previous version.


#NULL wrote:
It's actually the mouse lib, specifically the first call to ExamineMouse() that captures the mouse.
Thank you for the explanation! I think that should be mentioned in the docs, BTW.

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
 Post subject: Re: Text's particles attraction repulsion
PostPosted: Tue Sep 18, 2018 12:02 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 300
Location: Côtes d'Azur, France
Thank you little John... The 'd' was for 'distance'... I corrected it. (doesn't have much effect on the way it worked though)

Demivec It's always a pleasure to see what others can improve. I was also thinking of words changing by creating or deleting particles...

Vogel, I had no doubt, tweaking a little bit values would improve it. Nicely done.

To all, thank you for your support and explanations.

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

Win10, Pb x86 5.70 LTS


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

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 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