Snakes of Balls Sprite Demo

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
StarBootics
Addict
Addict
Posts: 1006
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Snakes of Balls Sprite Demo

Post by StarBootics »

Hello everyone

The Snakes of Balls sprite demo based on code from Le Soldat Inconnu (French forum) See http://www.purebasic.fr/french/viewtopic.php?f=2&t=7716

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Balls Snake Demo 
; File Name : Balls Snake Demo - Main.pb
; File version: 2.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 04-09-2009
; Last Update : 04-09-2016
; PureBasic code : V5.50
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by 
; Le Soldat Inconnu to create Snakes of balls 
; sprite animation.
;
; I deserve credit only to convert the original 
; code into a Module.
;
; This code is free to be use where ever you like 
; but you use it at your own risk.
;
; The author can in no way be held responsible 
; for data loss, damage or other annoying 
; situations that may occur.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule LinearlySpacedValue
  
  Declare.f Float(IncrementID.l, IncrementMax.l, MinValue.f, MaxValue.f)
  
EndDeclareModule

Module LinearlySpacedValue
  
  Procedure.f Float(IncrementID.l, IncrementMax.l, MinValue.f, MaxValue.f)
    
    ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  EndProcedure
  
EndModule

DeclareModule Snakes
  
  Declare AddInstance(P_ColorID.l, P_BallsMax.w)
  Declare Initialize(P_ScreenWidth.w, P_ScreenHeight.w, P_BallSize.w)
  Declare Reset()
  Declare Animate()
  
EndDeclareModule

Module Snakes
  
  #BALLS_MAX = 100
  
  Structure Ball
    
    SpriteID.l
    PosX.f
    PosY.f
    
  EndStructure
  
  Structure Secondary
    
    ScreenWidth.w
    ScreenHeight.w
    BallSize.w
    
  EndStructure
  
  Structure Instance
    
    HeadSpeed.f
    HeadAngle.f
    HeadPosX.f
    HeadPosY.f
    HeadMoveX.f
    HeadMoveY.f
    HeadRotation.f
    Distance.f
    Speed.f
    Angle.f
    ProximityCounter.l
    BallsDiameter.w
    BallsRadius.w
    BallsMax.w
    Balls.Ball[#BALLS_MAX]
    
  EndStructure
  
  Global Secondary.Secondary
  Global NewList Instances.Instance()
  
  Macro MoveBallPosition(BallA, BallB, P_Speed)
    
    BallA\PosX = BallA\PosX + (BallB\PosX - BallA\PosX) * P_Speed
    BallA\PosY = BallA\PosY + (BallB\PosY - BallA\PosY) * P_Speed
    
  EndMacro
  
  Procedure MakeBalls(SpriteID)
    
    PS = Secondary\BallSize
    Size = PS << 1
    COLORV = 0 
    
    If CreateSprite(SpriteID, Size, Size)
      
      TransparentSpriteColor(SpriteID, 0)
      
      If StartDrawing(SpriteOutput(SpriteID))
        
        Box(0,0, Size, Size, 0)
        Cxy = PS
        
        For Radius = 0 To PS
          
          Select SpriteID
              
            Case 0
              Color = RGB(COLORV >> 1, COLORV >> 1, COLORV)
              
            Case 1
              Color = RGB(COLORV, COLORV >> 1, COLORV >> 1)
              
            Case 2
              Color = RGB(COLORV >> 1, COLORV, COLORV >> 1)
              
            Case 3
              Color = RGB(COLORV >> 1, COLORV, COLORV)
              
            Case 4
              Color = RGB(COLORV, COLORV >> 1, COLORV)
              
            Case 5
              Color = RGB(COLORV, COLORV, COLORV >> 1)
              
            Case 6
              Color = RGB(COLORV, COLORV, COLORV)
              
            Case 7
              Color = RGB(COLORV >> 1, COLORV >> 1, COLORV >> 1)
              
            Case 8
              Color = RGB(COLORV >> 2, COLORV >> 2, COLORV >> 2)
              
            Case 9
              Color = RGB(COLORV, COLORV >> 2, COLORV >> 2)
              
            Case 10
              Color = RGB(COLORV >> 2, COLORV, COLORV >> 2)  
              
            Case 11
              Color = RGB(COLORV >> 2, COLORV >> 2, COLORV)
              
            Case 12
              Color = RGB(000, 000, COLORV)
              
            Case 13
              Color = RGB(000, COLORV, 000)
              
            Case 14
              Color = RGB(COLORV, 000, 000)
              
            Case 15
              Color = RGB(COLORV, COLORV, 000)
              
            Case 16
              Color = RGB(000, COLORV, COLORV)
              
            Case 17
              Color = RGB(COLORV, 000, COLORV)
              
            Case 18
              Color = RGB(000, COLORV >> 1, COLORV >> 1)   
              
            Case 19
              Color = RGB(COLORV, COLORV >> 1, 000)
              
          EndSelect
          
          Circle(Cxy, Cxy, PS - Radius, Color) 
          COLORV = Int(LinearlySpacedValue::Float(Radius, PS, 0, 255))
          
        Next
        
        StopDrawing() 
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure AddInstance(P_ColorID.l, P_BallsMax.w)
    
    AddElement(Instances())
    
    Instances()\HeadSpeed = 10.0
    Instances()\HeadAngle = 0.0
    Instances()\HeadPosX = 0.0
    Instances()\HeadPosY = 0.0
    Instances()\HeadMoveX = 0.0
    Instances()\HeadMoveY = 0.0
    Instances()\HeadRotation = 2 * #PI / 120
    Instances()\Distance = 0.0
    Instances()\Speed = 0.20
    Instances()\Angle = 0.0
    Instances()\ProximityCounter = 0
    Instances()\BallsDiameter = Secondary\BallSize
    Instances()\BallsRadius = Secondary\BallSize >> 1
    
    If P_BallsMax > #BALLS_MAX
      P_BallsMax = #BALLS_MAX
    EndIf
    
    Instances()\BallsMax = P_BallsMax
    
    For BallsID = 0 To Instances()\BallsMax
      Instances()\Balls[BallsID]\SpriteID = P_ColorID
    Next
    
  EndProcedure
  
  Procedure Initialize(P_ScreenWidth.w, P_ScreenHeight.w, P_BallSize.w)
    
    Secondary\ScreenWidth = P_ScreenWidth
    Secondary\ScreenHeight = P_ScreenHeight
    Secondary\BallSize = P_BallSize
    
    For SpriteID = 0 To 19
      MakeBalls(SpriteID)
    Next
    
  EndProcedure
  
  Procedure Reset()
    
    ForEach Instances()
      
      Instances()\HeadSpeed = 0.0
      Instances()\HeadAngle = 0.0
      Instances()\HeadPosX = 0.0
      Instances()\HeadPosY = 0.0
      Instances()\HeadMoveX = 0.0
      Instances()\HeadMoveY = 0.0
      Instances()\HeadRotation = 0.0
      Instances()\Distance = 0.0
      Instances()\Speed = 0.0
      Instances()\Angle = 0.0
      Instances()\ProximityCounter = 0
      Instances()\BallsDiameter = 0
      Instances()\BallsRadius = 0
      Instances()\BallsMax = 0
      
      For BallsID = 0 To #BALLS_MAX - 1
        Instances()\Balls[BallsID]\SpriteID = 0
        Instances()\Balls[BallsID]\PosX = 0.0
        Instances()\Balls[BallsID]\PosY = 0.0
      Next
      
    Next
    
    FreeList(Instances())
    
    Secondary\ScreenWidth = 0
    Secondary\ScreenHeight = 0
    
    For SpriteID = 0 To 19
      If IsSprite(SpriteID)
        FreeSprite(SpriteID)  
      EndIf
    Next
    
  EndProcedure
  
  Procedure Animate()
    
    ForEach Instances()
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Si on est arrivé, on va vers un autre point en aléatoire
      
      If Instances()\Distance < Instances()\HeadSpeed
        Instances()\HeadMoveX = Random(Secondary\ScreenWidth)
        Instances()\HeadMoveY = Random(Secondary\ScreenHeight)
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Si on arrive pas à atteindre le point au bout d'un moment, on dis qu'on l'a eu
      
      If Instances()\Distance < (Instances()\HeadSpeed * 40)
        
        Instances()\ProximityCounter = Instances()\ProximityCounter + 1
        
        If Instances()\ProximityCounter > 200
          Instances()\HeadMoveX = Random(Secondary\ScreenWidth)
          Instances()\HeadMoveY = Random(Secondary\ScreenHeight)
        EndIf
        
      Else
        
        Instances()\ProximityCounter = 0
        
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Distance entre la boule et le point visé
      
      X.f = Instances()\HeadMoveX - Instances()\HeadPosX
      Y.f = Instances()\HeadMoveY - Instances()\HeadPosY
      Instances()\Distance = Sqr(X*X + Y*Y)
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Angle entre la boule et le point visé
      
      If Instances()\HeadMoveX >= Instances()\HeadPosX And Instances()\HeadMoveY >= Instances()\HeadPosY ; entre 0 et Pi/2
        Instances()\Angle = ACos((Instances()\HeadMoveX - Instances()\HeadPosX) / Instances()\Distance)
      ElseIf Instances()\HeadMoveX >= Instances()\HeadPosX And Instances()\HeadMoveY <= Instances()\HeadPosY ; entre 0 et -Pi/2
        Instances()\Angle = -ACos((Instances()\HeadMoveX - Instances()\HeadPosX) / Instances()\Distance)
      ElseIf Instances()\HeadMoveX <= Instances()\HeadPosX And Instances()\HeadMoveY >= Instances()\HeadPosY ; entre Pi/2 et Pi
        Instances()\Angle = #PI - ACos((Instances()\HeadPosX - Instances()\HeadMoveX) / Instances()\Distance)
      Else ; entre -Pi/2 et -Pi
        Instances()\Angle = -#PI + ACos((Instances()\HeadPosX - Instances()\HeadMoveX) / Instances()\Distance)
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Si l'angle est plus grand que #Pi ou plus petit que -#Pi, on le ramene est -#pi et #pi
      
      If Instances()\HeadAngle > #PI 
        Instances()\HeadAngle = Instances()\HeadAngle - 2*#PI
      EndIf
      If Instances()\HeadAngle < -#PI 
        Instances()\HeadAngle = Instances()\HeadAngle + 2*#PI
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; on regarde dans quel sens on doit faire évoluer l'angle
      
      If Instances()\HeadAngle >= Instances()\Angle
        If Instances()\HeadAngle - Instances()\Angle > #PI
          Instances()\HeadAngle = Instances()\HeadAngle + Instances()\HeadRotation
        Else
          Instances()\HeadAngle = Instances()\HeadAngle - Instances()\HeadRotation
        EndIf
      Else
        If Instances()\Angle - Instances()\HeadAngle > #PI
          Instances()\HeadAngle = Instances()\HeadAngle - Instances()\HeadRotation
        Else
          Instances()\HeadAngle = Instances()\HeadAngle + Instances()\HeadRotation
        EndIf
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; On déplace suivant l'angle
      
      Instances()\HeadPosX = Instances()\HeadPosX + Cos(Instances()\HeadAngle) * Instances()\HeadSpeed
      Instances()\HeadPosY = Instances()\HeadPosY + Sin(Instances()\HeadAngle) * Instances()\HeadSpeed
      
      Instances()\Balls[00]\PosX = Instances()\HeadPosX - Instances()\BallsRadius
      Instances()\Balls[00]\PosY = Instances()\HeadPosY - Instances()\BallsRadius
      
      For BallsID = Instances()\BallsMax - 1 To 1 Step -1 ; Pour chaque boule
        MoveBallPosition(Instances()\Balls[BallsID], Instances()\Balls[BallsID-1], Instances()\Speed)
        DisplayTransparentSprite(Instances()\Balls[BallsID]\SpriteID, Instances()\Balls[BallsID]\PosX, Instances()\Balls[BallsID]\PosY)
      Next
      
      DisplayTransparentSprite(Instances()\Balls[00]\SpriteID, Instances()\Balls[00]\PosX, Instances()\Balls[00]\PosY)
      
    Next
    
  EndProcedure
  
EndModule

If InitKeyboard() = 0 Or InitSprite() = 0 Or InitMouse() = 0
  MessageRequester("Snakes of balls - ERROR","Can't initialize Keyboard, Sprite and/or Mouse !")
  End 
EndIf 

ExamineDesktops()
ScreenW = DesktopWidth(0)
ScreenH = DesktopHeight(0)
ScreenD = DesktopDepth(0)

If OpenScreen(ScreenW, ScreenH, ScreenD, "Snakes of balls - Sprite Demo") = 0 
  MessageRequester("Snakes of balls - ERROR", "Can't open screen !")
  End
EndIf

Snakes::Initialize(ScreenW, ScreenH, 24)

For Index = 0 To 19
  Snakes::AddInstance(Index, Random(35, 10))
Next

Repeat 
  
  If IsScreenActive() 
    
    ClearScreen(0)
    Snakes::Animate()
    
  Else 
    
    Delay(10) 
    
  EndIf 
  
  FlipBuffers() 
  ExamineMouse()
  ExamineKeyboard() 
  
Until KeyboardPushed(#PB_Key_All) Or MouseWheel() Or MouseButton(1) Or MouseButton(2) Or MouseButton(3)

; Libération des Sprites, remise à zéro des paramètres, ...
Snakes::Reset()
CloseScreen()
End

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Last edited by StarBootics on Sun Sep 04, 2016 10:42 pm, edited 2 times in total.
The Stone Age did not end due to a shortage of stones !
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Snakes of Balls Sprite Demo

Post by netmaestro »

Looks very good! I can't help thinking it would make an excellent screen saver for a cycle enthusiast if instead of balls you used motorcycle chain links.
BERESHEIT
Top
User avatar
majikeyric
Enthusiast
Enthusiast
Posts: 187
Joined: Mon Oct 21, 2013 5:21 pm
Location: France
Contact:
Contact majikeyric

Re: Snakes of Balls Sprite Demo

Post by majikeyric »

Very nice!!!
Top
User avatar
blueb
Addict
Addict
Posts: 1116
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: Snakes of Balls Sprite Demo

Post by blueb »

:?:
I'm using Win 10 (Pro) and PB 5.50 (x64) and for whatever reason this program ran and didn't do anything.

Nailed it down to:

Code: Select all

 If OpenScreen(ScreenW, ScreenH, 24, "Snake Balls")
Changed the depth to "32" and it works great. I also changed the next line to:

Code: Select all

Snakes::Initialize(ScreenW, ScreenH, 45) ; ball size
And now it has the appearance of 'glow worms' traversing my screen :)
- It was too lonely at the top.

System : PB 6.21(x64) and Win 11 Pro (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
Top
kvitaliy
Enthusiast
Enthusiast
Posts: 162
Joined: Mon May 10, 2010 4:02 pm

Re: Snakes of Balls Sprite Demo

Post by kvitaliy »

blueb wrote::?:
I'm using Win 10 (Pro) and PB 5.50 (x64) and for whatever reason this program ran and didn't do anything.
Use a universal solution:

Code: Select all

...
ExamineDesktops()
  ScreenW = DesktopWidth(0)
  ScreenH = DesktopHeight(0)
  ScreenD = DesktopDepth(0)
  If OpenScreen(ScreenW, ScreenH, ScreenD, "Snake Balls")
...
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Snakes of Balls Sprite Demo

Post by netmaestro »

Good tip, kvitaliy. Also iirc sprites are all 32bit in depth since somewhere in the mid-4.xx versions of PureBasic. There was a major overhaul to 2DDrawing and imaging in 4.40 and that's probably when it happened.
BERESHEIT
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Snakes of Balls Sprite Demo

Post by davido »

@kvitaliy,
I had the same problem posted by blueb. Thought I'd have a go and try to work it out myself.....
Glad you came to the rescue! :D

@StarBootics,
Thanks for resurrecting this code. Nice job! :D
DE AA EB
Top
User avatar
StarBootics
Addict
Addict
Posts: 1006
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: Snakes of Balls Sprite Demo

Post by StarBootics »

Hello everyone,

Small correction suggested by kvitaliy and some modification to the program animation loop. See the first post for the updated code.

Best regards
StarBootics
The Stone Age did not end due to a shortage of stones !
Top
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Snakes of Balls Sprite Demo

Post by djes »

Great ! I hadn't seen this, thank you both ! :)
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Snakes of Balls Sprite Demo

Post by Kwai chang caine »

Really cool !!! :shock:
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Top
Post Reply

Return to “Tricks 'n' Tips”