PureBasic Forums - English

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

Danilo's Sprite Demo Updated

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

Page 1 of 1

Danilo's Sprite Demo Updated

Posted: Sun Jul 30, 2006 2:52 am
by Guimauve
Code updated for 5.20+

Hello everyone,

I have updated the old Danilo's Sprite Demo for PB V4.0

Have Fun

Regards
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Exemple : Sprite Demo
; Author : Danilo
; Date : 18-04-2003
; Updated by : Guimauve
; Last Update : 29-07-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration >>>>>

Structure Sprite
   
   id.l
   PositionX.w
   PositionY.w
   MoveX.w
   MoveY.w
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<
; <<<<< Mutators >>>>>

Macro SetSpriteID(ObjectA, P_ID)
   
   ObjectA\id = P_ID
   
EndMacro

Macro SetSpritePositionX(ObjectA, P_PositionX)
   
   ObjectA\PositionX = P_PositionX
   
EndMacro

Macro SetSpritePositionY(ObjectA, P_PositionY)
   
   ObjectA\PositionY = P_PositionY
   
EndMacro

Macro SetSpriteMoveX(ObjectA, P_MoveX)
   
   ObjectA\MoveX = P_MoveX
   
EndMacro

Macro SetSpriteMoveY(ObjectA, P_MoveY)
   
   ObjectA\MoveY = P_MoveY
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Observators >>>>>

Macro GetSpriteID(ObjectA)
   
   ObjectA\id
   
EndMacro

Macro GetSpritePositionX(ObjectA)
   
   ObjectA\PositionX
   
EndMacro

Macro GetSpritePositionY(ObjectA)
   
   ObjectA\PositionY
   
EndMacro

Macro GetSpriteMoveX(ObjectA)
   
   ObjectA\MoveX
   
EndMacro

Macro GetSpriteMoveY(ObjectA)
   
   ObjectA\MoveY
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 15 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Customs Macro - Uncomment if needed >>>>>

; Macro RandomMinMax(min, max)
   ; 
   ; (max - Random(max - min))
   ; 
; EndMacro

; Macro RGBColor(Red, Green, Blue)
   ; 
   ; (((Blue << 8 + Green) << 8) + Red)
   ; 
; EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Constants and variables >>>>>

Screen_W = GetSystemMetrics_(#SM_CXSCREEN)
Screen_H = GetSystemMetrics_(#SM_CYSCREEN)

#Quantity = 500
#SpriteSize = 8
 
Dim SpriteList.Sprite(#Quantity)
 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Initialize DirectX >>>>>

If InitKeyboard() = 0 Or InitSprite() = 0 
   MessageRequester("ERROR","Cant initialize DirectX!",#MB_ICONERROR)
   End 
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<
; <<<<< OpenScreen >>>>>

If OpenScreen(Screen_W, Screen_H, 32, "Sprite Demo") = 0 
   If OpenScreen(Screen_W, Screen_H, 24, "Sprite Demo") = 0 
      If OpenScreen(Screen_W, Screen_H, 16, "Sprite Demo") = 0 
         MessageRequester("ERROR", "Cant open DirectX screen!", #MB_ICONERROR)
         End
      EndIf
   EndIf
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Create 21 differents Sprites >>>>>

For SpriteID = 0 To 20 
   
   If CreateSprite(SpriteID, #SpriteSize, #SpriteSize) 
      StartDrawing(SpriteOutput(SpriteID)) 
      Circle(#SpriteSize >> 1, #SpriteSize >> 1, #SpriteSize >> 1, RGB(Random($FF, $50), Random($FF, $50), Random($FF, $50))) 
      StopDrawing() 
   Else 
      CloseScreen() 
      MessageRequester("ERROR","Cant create Sprite!",#MB_ICONERROR)
      End 
   EndIf 
   
Next  

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Animation Setup >>>>>

For Index = 0 To #Quantity
   
   SetSpriteID(SpriteList(Index), Random(20))
   SetSpritePositionX(SpriteList(Index), Random(Screen_W >> 1))
   SetSpritePositionY(SpriteList(Index), Random(Screen_H >> 1))
   SetSpriteMoveX(SpriteList(Index), Random(6, 2))
   SetSpriteMoveY(SpriteList(Index), Random(6, 2))
   
Next 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Run Sprite Demo >>>>>

Repeat 
   
   FlipBuffers() 
   ExamineKeyboard() 
   
   If IsScreenActive() 
      
      ClearScreen(0) 
      
      For Index = 0 To #Quantity 
         
         ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
         ; If the sprites are about to fly outside of the screen area
         ; we reverse the Move direction.
         
         If GetSpritePositionX(SpriteList(Index)) > (Screen_W - #SpriteSize) Or GetSpritePositionX(SpriteList(Index)) < 0 
            SetSpriteMoveX(SpriteList(Index), -GetSpriteMoveX(SpriteList(Index))) 
         EndIf 
         
         If GetSpritePositionY(SpriteList(Index)) > (Screen_H - #SpriteSize) Or GetSpritePositionY(SpriteList(Index)) < 0  
            SetSpriteMoveY(SpriteList(Index), -GetSpriteMoveY(SpriteList(Index)))
         EndIf 
         
         ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
         ; We compute a new positions and we display sprites to 
         ; their new positions.
         
         SetSpritePositionX(SpriteList(Index), GetSpritePositionX(SpriteList(Index)) + GetSpriteMoveX(SpriteList(Index)))
         SetSpritePositionY(SpriteList(Index), GetSpritePositionY(SpriteList(Index)) + GetSpriteMoveY(SpriteList(Index)))
         DisplayTransparentSprite(GetSpriteID(SpriteList(Index)), GetSpritePositionX(SpriteList(Index)), GetSpritePositionY(SpriteList(Index))) 
         
      Next 
      
      ; If GetTickCount_() => zeit + 1000 
         ; FrameSek = Frames 
         ; Frames = 0 
         ; zeit = GetTickCount_() 
      ; Else 
         ; Frames + 1 
      ; EndIf      
      
      ; If StartDrawing(ScreenOutput()) 
         ; DrawingMode(1) 
         ; DrawText(20,20,"Frames/Sekunde: "+Str(FrameSek), RGBColor($FF,$FF,$00)) 
         ; StopDrawing() 
      ; EndIf 
      
   Else 
      
      Delay(10) 
      
   EndIf 
   
Until KeyboardPushed(#PB_Key_Escape) 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: Sun Jul 30, 2006 6:14 pm
by Psychophanta
Doesn't work here. Some functions are missing!

Posted: Sun Jul 30, 2006 6:38 pm
by netmaestro
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Customs Macro - Uncomment if needed >>>>>
You just have to uncomment 2 macros near the top, then it works.

Posted: Sun Jul 30, 2006 7:23 pm
by Kale
Syntax error, line 151

Posted: Sun Jul 30, 2006 7:33 pm
by netmaestro
If you uncommented the macros with ALT-B, the macro lines are not uncommented. That makes the syntax error.

Posted: Sun Jul 30, 2006 8:15 pm
by Kale
Ah yes, very strange...

Posted: Sun Jul 30, 2006 8:53 pm
by Guimauve
If you uncommented the macros with ALT-B, the macro lines are not uncommented. That makes the syntax error.
The uncomment command (Alt+B) in PB IDE don't work with a code like this :

Code: Select all

; Macro RandomMinMax(min, max)
   ; 
   ; (max - Random(max - min))
   ; 
; EndMacro
; 
; Macro RGBColor(Red, Green, Blue)
   ; 
   ; (((Blue << 8 + Green) << 8) + Red)
   ; 
; EndMacro
But work fine with a code like this :

Code: Select all

; Macro RandomMinMax(min, max)
;    
;    (max - Random(max - min))
;    
; EndMacro
; 
; Macro RGBColor(Red, Green, Blue)
;     
;    (((Blue << 8 + Green) << 8) + Red)
;    
; EndMacro
Why ???

This a PB IDE bug. I have no problem to comment / uncomment the Macro with jaPBe.
Just uncomment the Macro instruction line manually.

Regards
Guimauve

Posted: Mon Jul 31, 2006 6:31 am
by oldBear
Yes, it is fun :D

Thanks for the post.

Re: Danilo's Sprite Demo Updated

Posted: Fri Sep 02, 2016 5:35 pm
by StarBootics
Hello everyone,

Sorry to re-open a 10 years old topic ...
A Modularized version of Guimauve's code.

Best regards
StarBootics

Code: Select all

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

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by Danilo,
; updated by Guimauve for a little Sprite Demo.
;
; 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 Vector2W
  
  Structure Vector2W
    
    I.w
    J.w
    
  EndStructure
  
  Declare.w GetI(*Vector2WA.Vector2W)
  Declare.w GetJ(*Vector2WA.Vector2W)
  Declare SetI(*Vector2WA.Vector2W, P_I.w)
  Declare SetJ(*Vector2WA.Vector2W, P_J.w)
  Declare Update(*Vector2WA.Vector2W, P_I.w, P_J.w)
  Declare Reset(*Vector2WA.Vector2W)
  Declare Plus(*Vector2WR.Vector2W, *Vector2WA.Vector2W, *Vector2WB.Vector2W)
  
EndDeclareModule

Module Vector2W
  
  Procedure.w GetI(*Vector2WA.Vector2W)
    
    ProcedureReturn *Vector2WA\I
  EndProcedure
  
  Procedure.w GetJ(*Vector2WA.Vector2W)
    
    ProcedureReturn *Vector2WA\J
  EndProcedure
  
  Procedure SetI(*Vector2WA.Vector2W, P_I.w)
    
    *Vector2WA\I = P_I
    
  EndProcedure
  
  Procedure SetJ(*Vector2WA.Vector2W, P_J.w)
    
    *Vector2WA\J = P_J
    
  EndProcedure
  
  Procedure Update(*Vector2WA.Vector2W, P_I.w, P_J.w)
    
    *Vector2WA\I = P_I
    *Vector2WA\J = P_J
    
  EndProcedure
  
  Procedure Reset(*Vector2WA.Vector2W)
    
    *Vector2WA\I = 0
    *Vector2WA\J = 0
    
  EndProcedure
  
  Procedure Plus(*Vector2WR.Vector2W, *Vector2WA.Vector2W, *Vector2WB.Vector2W)
    
    *Vector2WR\I = *Vector2WA\I + *Vector2WB\I
    *Vector2WR\J = *Vector2WA\J + *Vector2WB\J
    
  EndProcedure
  
EndModule

DeclareModule Sprite
  
  Declare Initialize(P_Qty.l, P_Width.w, P_Height.w, P_SpriteSize.l)
  Declare Reset()
  Declare Animate()
  
EndDeclareModule

Module Sprite
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Déclaration des Structures <<<<<
  
  Structure Secondary
    
    Width.l
    Height.l
    Size.l
    
  EndStructure
  
  Structure Instance
    
    ID.l
    Position.Vector2W::Vector2W
    Speed.Vector2W::Vector2W
    
  EndStructure
  
  Global Secondary.Secondary
  Global NewList Instances.Instance()
  
  Procedure Initialize(P_Qty.l, P_Width.w, P_Height.w, P_SpriteSize.l)
    
    Secondary\Width = P_Width
    Secondary\Height = P_Height
    Secondary\Size = P_SpriteSize
    
    For SpriteID = 0 To 20 
      
      If CreateSprite(SpriteID, P_SpriteSize, P_SpriteSize) 
        
        If StartDrawing(SpriteOutput(SpriteID)) 
          
          Circle(P_SpriteSize >> 1, P_SpriteSize >> 1, P_SpriteSize >> 1, RGB(Random(255, 50), Random(255, 50), Random(255, 50))) 
          StopDrawing() 
          
        EndIf 
        
      Else 
        
        CloseScreen() 
        MessageRequester("ERROR","Can't create Sprite!")
        End 
        
      EndIf 
      
    Next  
    
    For Index = 0 To P_Qty
      
      AddElement(Instances())
      Instances()\ID = Random(20)
      Vector2W::Update(Instances()\Position, Random(P_Width) >> 1, Random(P_Height) >> 1)
      Vector2W::Update(Instances()\Speed, Random(8, 2), Random(8, 2))
      
    Next
    
  EndProcedure
  
  Procedure Reset()
    
    For SpriteID = 0 To 20 
      If IsSprite(SpriteID)
        FreeSprite(SpriteID)  
      EndIf
    Next
    
    ForEach Instances()
      Instances()\ID = 0
      Vector2W::Reset(Instances()\Position)
      Vector2W::Reset(Instances()\Speed)
    Next
    
    ClearList(Instances())
    
    Secondary\Width = 0
    Secondary\Height = 0
    Secondary\Size = 0
    
  EndProcedure
  
  Procedure Animate()
    
    ForEach Instances()
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; If going offscreen, then reverse speed component !
      
      If Vector2W::GetI(Instances()\Position) > Secondary\Width - Secondary\Size Or Vector2W::GetI(Instances()\Position) < 0
        Vector2W::SetI(Instances()\Speed, Vector2W::GetI(Instances()\Speed) * -1)
      EndIf
      
      If Vector2W::GetJ(Instances()\Position) > Secondary\Height - Secondary\Size Or Vector2W::GetJ(Instances()\Position) < 0
        Vector2W::SetJ(Instances()\Speed, Vector2W::GetJ(Instances()\Speed) * -1)
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Update Sprite position by adding the speed vector
      
      Vector2W::Plus(Instances()\Position, Instances()\Position, Instances()\Speed)
      DisplayTransparentSprite(Instances()\ID, Vector2W::GetI(Instances()\Position), Vector2W::GetJ(Instances()\Position))
      
    Next
    
  EndProcedure
  
EndModule

DeclareModule SpriteDemo
  
  Declare Initialize()
  Declare Reset()
  Declare CreateScreen()
  Declare RunAnimation()
  
EndDeclareModule

Module SpriteDemo
  
  Structure Instance
    
    ScreenW.w
    ScreenH.w
    ScreenD.b
    ScreenT.s
    Size.w
    Quantity.l
    
  EndStructure
  
  Global Instance.Instance
  
  Procedure Initialize()
    
    ExamineDesktops()
    Instance\ScreenW = DesktopWidth(0)
    Instance\ScreenH = DesktopHeight(0)
    Instance\ScreenD = DesktopDepth(0)
    Instance\ScreenT = "Sprite Demo"
    Instance\Size = 10
    Instance\Quantity = 250
    
  EndProcedure
  
  Procedure Reset()
    
    Instance\ScreenW = 0
    Instance\ScreenH = 0
    Instance\ScreenD = 0
    Instance\ScreenT = ""
    Instance\Size = 0
    Instance\Quantity = 0
    
    Sprite::Reset()
    
  EndProcedure
  
  Procedure CreateScreen()
    
    If InitSprite() = 0 Or InitKeyboard() = 0
      MessageRequester("Sprite Demo - Fatal Error", "Impossible to Initialize Sprite and/or Keyboard !")
      End
    EndIf
    
    If OpenScreen(Instance\ScreenW, Instance\ScreenH, Instance\ScreenD, Instance\ScreenT) = 0
      MessageRequester("Sprite Demo - Fatal Error", "Impossible to Open the screen !")
      End
    Else
      Sprite::Initialize(Instance\Quantity, Instance\ScreenW, Instance\ScreenH, Instance\Size)
    EndIf
    
  EndProcedure
  
  Procedure RunAnimation()
    
    Repeat 
      
      If IsScreenActive() 
        
        ClearScreen(0) 
        Sprite::Animate()
        
      Else 
        
        Delay(10) 
        
      EndIf 
      
      FlipBuffers() 
      
      ExamineKeyboard() 
      
    Until KeyboardPushed(#PB_Key_All)
    
    Reset()
    CloseScreen()
    
  EndProcedure
  
EndModule

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

SpriteDemo::Initialize()

SpriteDemo::CreateScreen()

SpriteDemo::RunAnimation()

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Re: Danilo's Sprite Demo Updated

Posted: Fri Sep 02, 2016 6:31 pm
by VB6_to_PBx
makes a great Screen Saver :)

need to be able to return to original Screen after clicking Mouse , instead of using Escape Key ... that would be better as Screen Saver

thanks for update !

Re: Danilo's Sprite Demo Updated

Posted: Sat Sep 03, 2016 2:56 am
by VB6_to_PBx
i made a sort of Screen Saver with Mouse clicks ending program :)

Code: Select all

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

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by Danilo,
; updated by Guimauve for a little Sprite Demo.
;
; 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 Vector2W
 
  Structure Vector2W
   
    I.w
    J.w
   
  EndStructure
 
  Declare.w GetI(*Vector2WA.Vector2W)
  Declare.w GetJ(*Vector2WA.Vector2W)
  Declare SetI(*Vector2WA.Vector2W, P_I.w)
  Declare SetJ(*Vector2WA.Vector2W, P_J.w)
  Declare Update(*Vector2WA.Vector2W, P_I.w, P_J.w)
  Declare Reset(*Vector2WA.Vector2W)
  Declare Plus(*Vector2WR.Vector2W, *Vector2WA.Vector2W, *Vector2WB.Vector2W)
 
EndDeclareModule

Module Vector2W
 
  Procedure.w GetI(*Vector2WA.Vector2W)
   
    ProcedureReturn *Vector2WA\I
  EndProcedure
 
  Procedure.w GetJ(*Vector2WA.Vector2W)
   
    ProcedureReturn *Vector2WA\J
  EndProcedure
 
  Procedure SetI(*Vector2WA.Vector2W, P_I.w)
   
    *Vector2WA\I = P_I
   
  EndProcedure
 
  Procedure SetJ(*Vector2WA.Vector2W, P_J.w)
   
    *Vector2WA\J = P_J
   
  EndProcedure
 
  Procedure Update(*Vector2WA.Vector2W, P_I.w, P_J.w)
   
    *Vector2WA\I = P_I
    *Vector2WA\J = P_J
   
  EndProcedure
 
  Procedure Reset(*Vector2WA.Vector2W)
   
    *Vector2WA\I = 0
    *Vector2WA\J = 0
   
  EndProcedure
 
  Procedure Plus(*Vector2WR.Vector2W, *Vector2WA.Vector2W, *Vector2WB.Vector2W)
   
    *Vector2WR\I = *Vector2WA\I + *Vector2WB\I
    *Vector2WR\J = *Vector2WA\J + *Vector2WB\J
   
  EndProcedure
 
EndModule

DeclareModule Sprite
 
  Declare Initialize(P_Qty.l, P_Width.w, P_Height.w, P_SpriteSize.l)
  Declare Reset()
  Declare Animate()
 
EndDeclareModule

Module Sprite
 
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Déclaration des Structures <<<<<
 
  Structure Secondary
   
    Width.l
    Height.l
    Size.l
   
  EndStructure
 
  Structure Instance
   
    ID.l
    Position.Vector2W::Vector2W
    Speed.Vector2W::Vector2W
   
  EndStructure
 
  Global Secondary.Secondary
  Global NewList Instances.Instance()
 
  Procedure Initialize(P_Qty.l, P_Width.w, P_Height.w, P_SpriteSize.l)
   
    Secondary\Width = P_Width
    Secondary\Height = P_Height
    Secondary\Size = P_SpriteSize
   
    For SpriteID = 0 To 20
     
      If CreateSprite(SpriteID, P_SpriteSize, P_SpriteSize)
       
        If StartDrawing(SpriteOutput(SpriteID))
         
          Circle(P_SpriteSize >> 1, P_SpriteSize >> 1, P_SpriteSize >> 1, RGB(Random(255, 50), Random(255, 50), Random(255, 50)))
          StopDrawing()
         
        EndIf
       
      Else
       
        CloseScreen()
        MessageRequester("ERROR","Can't create Sprite!")
        End
       
      EndIf
     
    Next 
   
    For Index = 0 To P_Qty
     
      AddElement(Instances())
      Instances()\ID = Random(20)
      Vector2W::Update(Instances()\Position, Random(P_Width) >> 1, Random(P_Height) >> 1)
      Vector2W::Update(Instances()\Speed, Random(8, 2), Random(8, 2))
     
    Next
   
  EndProcedure
 
  Procedure Reset()
   
    For SpriteID = 0 To 20
      If IsSprite(SpriteID)
        FreeSprite(SpriteID) 
      EndIf
    Next
   
    ForEach Instances()
      Instances()\ID = 0
      Vector2W::Reset(Instances()\Position)
      Vector2W::Reset(Instances()\Speed)
    Next
   
    ClearList(Instances())
   
    Secondary\Width = 0
    Secondary\Height = 0
    Secondary\Size = 0
   
  EndProcedure
 
  Procedure Animate()
   
    ForEach Instances()
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; If going offscreen, then reverse speed component !
     
      If Vector2W::GetI(Instances()\Position) > Secondary\Width - Secondary\Size Or Vector2W::GetI(Instances()\Position) < 0
        Vector2W::SetI(Instances()\Speed, Vector2W::GetI(Instances()\Speed) * -1)
      EndIf
     
      If Vector2W::GetJ(Instances()\Position) > Secondary\Height - Secondary\Size Or Vector2W::GetJ(Instances()\Position) < 0
        Vector2W::SetJ(Instances()\Speed, Vector2W::GetJ(Instances()\Speed) * -1)
      EndIf
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Update Sprite position by adding the speed vector
     
      Vector2W::Plus(Instances()\Position, Instances()\Position, Instances()\Speed)
      DisplayTransparentSprite(Instances()\ID, Vector2W::GetI(Instances()\Position), Vector2W::GetJ(Instances()\Position))
     
    Next
   
  EndProcedure
 
EndModule

DeclareModule SpriteDemo
 
  Declare Initialize()
  Declare Reset()
  Declare CreateScreen()
  Declare RunAnimation()
 
EndDeclareModule

Module SpriteDemo
 
  Structure Instance
   
    ScreenW.w
    ScreenH.w
    ScreenD.b
    ScreenT.s
    Size.w
    Quantity.l
   
  EndStructure
 
  Global Instance.Instance
 
  Procedure Initialize()
   
    ExamineDesktops()
    Instance\ScreenW = DesktopWidth(0)
    Instance\ScreenH = DesktopHeight(0)
    Instance\ScreenD = DesktopDepth(0)
    Instance\ScreenT = "Sprite Demo"
    Instance\Size = 10
    Instance\Quantity = 250
   
  EndProcedure
 
  Procedure Reset()
   
    Instance\ScreenW = 0
    Instance\ScreenH = 0
    Instance\ScreenD = 0
    Instance\ScreenT = ""
    Instance\Size = 0
    Instance\Quantity = 0
   
    Sprite::Reset()
   
  EndProcedure
 
  Procedure CreateScreen()
   
    If InitSprite() = 0 Or InitMouse() = 0 Or InitKeyboard() = 0
      MessageRequester("Sprite Demo - Fatal Error", "Impossible to Initialize Sprite and/or Keyboard !")
      End
    EndIf
   
    If OpenScreen(Instance\ScreenW, Instance\ScreenH, Instance\ScreenD, Instance\ScreenT) = 0
      MessageRequester("Sprite Demo - Fatal Error", "Impossible to Open the screen !")
      End
    Else
      Sprite::Initialize(Instance\Quantity, Instance\ScreenW, Instance\ScreenH, Instance\Size)
    EndIf
   
  EndProcedure
 
  Procedure RunAnimation()
   
    Repeat
     
      If IsScreenActive()
       
        ClearScreen(0)
        Sprite::Animate()
       
      Else
       
        Delay(10)
       
      EndIf
     
      FlipBuffers()
     
      ExamineKeyboard()
      ExamineMouse()
      
    ;If MouseButton(#PB_MouseButton_Left) : End : EndIf

    Until KeyboardPushed(#PB_Key_All) Or MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right) Or MouseButton(#PB_MouseButton_Middle)

   
    Reset()
    CloseScreen()
   
  EndProcedure
 
EndModule

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

SpriteDemo::Initialize()

SpriteDemo::CreateScreen()

SpriteDemo::RunAnimation()

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Re: Danilo's Sprite Demo Updated

Posted: Sun Sep 04, 2016 12:02 am
by StarBootics
Hello everyone,

Another update to have less boring Sprites, drawback the color are not totally random anymore.

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Sprite Demo
; File Name : Sprite Demo - Main.pb
; File version: 2.0.1
; Programming : OK
; Programmed by : StarBootics
; Date : 31-08-2016
; Last Update : 03-09-2016
; PureBasic code : V5.50
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by Danilo,
; updated by Guimauve for a little Sprite Demo.
;
; 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.b Byte(IncrementID.l, IncrementMax.l, MinValue.b, MaxValue.b)
  ;   Declare.a AsciiCharacter(IncrementID.l, IncrementMax.l, MinValue.a, MaxValue.a)
  ;   Declare.c Character(IncrementID.l, IncrementMax.l, MinValue.c, MaxValue.c)
  ;   Declare.u UnicodeCharacter(IncrementID.l, IncrementMax.l, MinValue.u, MaxValue.u)
  ;   Declare.w Word(IncrementID.l, IncrementMax.l, MinValue.w, MaxValue.w)
  ;   Declare.l Long(IncrementID.l, IncrementMax.l, MinValue.l, MaxValue.l)
  ;   Declare.i Integer(IncrementID.l, IncrementMax.l, MinValue.i, MaxValue.i)
  ;   Declare.q Quad(IncrementID.l, IncrementMax.l, MinValue.q, MaxValue.q)
  Declare.f Float(IncrementID.l, IncrementMax.l, MinValue.f, MaxValue.f)
  ;   Declare.d Double(IncrementID.l, IncrementMax.l, MinValue.d, MaxValue.d)
  
EndDeclareModule

Module LinearlySpacedValue
  
  ;   Procedure.b Byte(IncrementID.l, IncrementMax.l, MinValue.b, MaxValue.b)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.a AsciiCharacter(IncrementID.l, IncrementMax.l, MinValue.a, MaxValue.a)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.c Character(IncrementID.l, IncrementMax.l, MinValue.c, MaxValue.c)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.u UnicodeCharacter(IncrementID.l, IncrementMax.l, MinValue.u, MaxValue.u)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.w Word(IncrementID.l, IncrementMax.l, MinValue.w, MaxValue.w)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.l Long(IncrementID.l, IncrementMax.l, MinValue.l, MaxValue.l)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.i Integer(IncrementID.l, IncrementMax.l, MinValue.i, MaxValue.i)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  ;   
  ;   Procedure.q Quad(IncrementID.l, IncrementMax.l, MinValue.q, MaxValue.q)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  
  Procedure.f Float(IncrementID.l, IncrementMax.l, MinValue.f, MaxValue.f)
    
    ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  EndProcedure
  
  ;   Procedure.d Double(IncrementID.l, IncrementMax.l, MinValue.d, MaxValue.d)
  ;     
  ;     ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  ;   EndProcedure
  
EndModule

DeclareModule Vector2W
  
  Structure Vector2W
    
    I.w
    J.w
    
  EndStructure
  
  Declare.w GetI(*Vector2WA.Vector2W)
  Declare.w GetJ(*Vector2WA.Vector2W)
  Declare SetI(*Vector2WA.Vector2W, P_I.w)
  Declare SetJ(*Vector2WA.Vector2W, P_J.w)
  Declare Update(*Vector2WA.Vector2W, P_I.w, P_J.w)
  Declare Reset(*Vector2WA.Vector2W)
  Declare Plus(*Vector2WR.Vector2W, *Vector2WA.Vector2W, *Vector2WB.Vector2W)
  
EndDeclareModule

Module Vector2W
  
  Procedure.w GetI(*Vector2WA.Vector2W)
    
    ProcedureReturn *Vector2WA\I
  EndProcedure
  
  Procedure.w GetJ(*Vector2WA.Vector2W)
    
    ProcedureReturn *Vector2WA\J
  EndProcedure
  
  Procedure SetI(*Vector2WA.Vector2W, P_I.w)
    
    *Vector2WA\I = P_I
    
  EndProcedure
  
  Procedure SetJ(*Vector2WA.Vector2W, P_J.w)
    
    *Vector2WA\J = P_J
    
  EndProcedure
  
  Procedure Update(*Vector2WA.Vector2W, P_I.w, P_J.w)
    
    *Vector2WA\I = P_I
    *Vector2WA\J = P_J
    
  EndProcedure
  
  Procedure Reset(*Vector2WA.Vector2W)
    
    *Vector2WA\I = 0
    *Vector2WA\J = 0
    
  EndProcedure
  
  Procedure Plus(*Vector2WR.Vector2W, *Vector2WA.Vector2W, *Vector2WB.Vector2W)
    
    *Vector2WR\I = *Vector2WA\I + *Vector2WB\I
    *Vector2WR\J = *Vector2WA\J + *Vector2WB\J
    
  EndProcedure
  
EndModule

DeclareModule Sprite
  
  Declare Initialize(P_Qty.l, P_Width.w, P_Height.w, P_SpriteSize.l)
  Declare Reset()
  Declare Animate()
  
EndDeclareModule

Module Sprite
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Déclaration des Structures <<<<<
  
  Structure Secondary
    
    Width.l
    Height.l
    Size.l
    
  EndStructure
  
  Structure Instance
    
    ID.l
    Position.Vector2W::Vector2W
    Speed.Vector2W::Vector2W
    
  EndStructure
  
  Global Secondary.Secondary
  Global NewList Instances.Instance()
  
  Procedure MakeSprite(SpriteID)
    
    PS = Secondary\Size
    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)
              
            Case 9
              Color = RGB(COLORV, COLORV >> 2, COLORV >> 2)
              
            Case 10
              Color = RGB(COLORV >> 2, COLORV, COLORV >> 2)  
              
          EndSelect
          
          Circle(Cxy, Cxy, PS - Radius, Color) 
          COLORV = Int(LinearlySpacedValue::Float(Radius, PS, 0, 255))
        Next
        
        StopDrawing() 
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure Initialize(P_Qty.l, P_Width.w, P_Height.w, P_SpriteSize.l)
    
    Secondary\Width = P_Width
    Secondary\Height = P_Height
    Secondary\Size = P_SpriteSize
    MaxColor = 10
    
    For SpriteID = 0 To MaxColor
      MakeSprite(SpriteID)
    Next  
    
    For Index = 0 To P_Qty
      
      AddElement(Instances())
      Instances()\ID = Random(MaxColor)
      Vector2W::Update(Instances()\Position, Random(P_Width) >> 1, Random(P_Height) >> 1)
      Vector2W::Update(Instances()\Speed, Random(8, 2), Random(8, 2))
      
    Next
    
  EndProcedure
  
  Procedure Reset()
    
    For SpriteID = 0 To 10 
      If IsSprite(SpriteID)
        FreeSprite(SpriteID)  
      EndIf
    Next
    
    ForEach Instances()
      Instances()\ID = 0
      Vector2W::Reset(Instances()\Position)
      Vector2W::Reset(Instances()\Speed)
    Next
    
    ClearList(Instances())
    
    Secondary\Width = 0
    Secondary\Height = 0
    Secondary\Size = 0
    
  EndProcedure
  
  Procedure Animate()
    
    ForEach Instances()
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; If going offscreen, then reverse speed component !
      
      If Vector2W::GetI(Instances()\Position) > Secondary\Width - Secondary\Size Or Vector2W::GetI(Instances()\Position) < 0
        Vector2W::SetI(Instances()\Speed, Vector2W::GetI(Instances()\Speed) * -1)
      EndIf
      
      If Vector2W::GetJ(Instances()\Position) > Secondary\Height - Secondary\Size Or Vector2W::GetJ(Instances()\Position) < 0
        Vector2W::SetJ(Instances()\Speed, Vector2W::GetJ(Instances()\Speed) * -1)
      EndIf
      
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Update Sprite position by adding the speed vector
      
      Vector2W::Plus(Instances()\Position, Instances()\Position, Instances()\Speed)
      DisplayTransparentSprite(Instances()\ID, Vector2W::GetI(Instances()\Position), Vector2W::GetJ(Instances()\Position))
      
    Next
    
  EndProcedure
  
EndModule

DeclareModule SpriteDemo
  
  Declare Initialize()
  Declare Reset()
  Declare CreateScreen()
  Declare RunAnimation()
  
EndDeclareModule

Module SpriteDemo
  
  Structure Instance
    
    ScreenW.w
    ScreenH.w
    ScreenD.b
    ScreenT.s
    Size.w
    Quantity.l
    
  EndStructure
  
  Global Instance.Instance
  
  Procedure Initialize()
    
    ExamineDesktops()
    Instance\ScreenW = DesktopWidth(0)
    Instance\ScreenH = DesktopHeight(0)
    Instance\ScreenD = DesktopDepth(0)
    Instance\ScreenT = "Sprite Demo"
    Instance\Size = 24
    Instance\Quantity = 250
    
  EndProcedure
  
  Procedure Reset()
    
    Instance\ScreenW = 0
    Instance\ScreenH = 0
    Instance\ScreenD = 0
    Instance\ScreenT = ""
    Instance\Size = 0
    Instance\Quantity = 0
    
    Sprite::Reset()
    
  EndProcedure
  
  Procedure CreateScreen()
    
    If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
      MessageRequester("Sprite Demo - Fatal Error", "Impossible to Initialize Sprite, Keyboard and/or  Mouse!")
      End
    EndIf
    
    If OpenScreen(Instance\ScreenW, Instance\ScreenH, Instance\ScreenD, Instance\ScreenT) = 0
      MessageRequester("Sprite Demo - Fatal Error", "Impossible to Open the screen !")
      End
    Else
      Sprite::Initialize(Instance\Quantity, Instance\ScreenW, Instance\ScreenH, Instance\Size)
    EndIf
    
  EndProcedure
  
  Procedure RunAnimation()
    
    Repeat 
      
      If IsScreenActive() 
        
        ClearScreen(0) 
        Sprite::Animate()
        
      Else 
        
        Delay(10) 
        
      EndIf 
      
      FlipBuffers() 
      ExamineMouse()
      ExamineKeyboard() 
      
    Until KeyboardPushed(#PB_Key_All) Or MouseWheel() Or MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right) Or MouseButton(#PB_MouseButton_Middle)
    
    Reset()
    CloseScreen()
    
  EndProcedure
  
EndModule

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

SpriteDemo::Initialize()

SpriteDemo::CreateScreen()

SpriteDemo::RunAnimation()

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Re: Danilo's Sprite Demo Updated

Posted: Sun Sep 04, 2016 12:08 am
by netmaestro
Looks quite nice :mrgreen:

Re: Danilo's Sprite Demo Updated

Posted: Sun Sep 04, 2016 2:43 am
by VB6_to_PBx
i forgot about the MouseWheel, thanks for adding it
and thanks for this new version , looks great !
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited