PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Snakes of Balls Sprite Demo

https://www.purebasic.fr/english/viewtopic.php?t=66515

Page 1 of 1

Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 6:20 am
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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 7:15 am
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.

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 8:12 am
by majikeyric
Very nice!!!

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 2:40 pm
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 :)

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 4:37 pm
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")
...

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 5:37 pm
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.

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 8:05 pm
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

Re: Snakes of Balls Sprite Demo

Posted: Sun Sep 04, 2016 11:29 pm
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

Re: Snakes of Balls Sprite Demo

Posted: Mon Sep 05, 2016 9:14 am
by djes
Great ! I hadn't seen this, thank you both ! :)

Re: Snakes of Balls Sprite Demo

Posted: Mon Sep 05, 2016 11:59 am
by Kwai chang caine
Really cool !!! :shock:
Thanks for sharing 8)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited