Rosace 2D Sprite Demo

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Rosace 2D Sprite Demo

Post by Guimauve »

Code updated for 5.20+

Hello everyone !

This is a very small Sprite demo similar to the Danilo's Sprite Demo I have updated recently.

If you get an error message about some missing command, uncomment the custom macro from line 100 to 116.

Have fun !

Regards
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Exemple : Rosace 2D Sprite Demo
; Author : Guimauve
; Date : 05-08-2006
; Last Update : 05-08-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
   Radius.l
   Theta.l
   PositionX.w
   PositionY.w
   
EndStructure

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

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

Macro SetSpriteRadius(ObjetA, P_Radius)
   
   ObjetA\Radius = P_Radius
   
EndMacro

Macro SetSpriteTheta(ObjetA, P_Theta)
   
   ObjetA\Theta = P_Theta
   
EndMacro

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

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

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

Macro GetSpriteID(ObjetA)
   
   ObjetA\id
   
EndMacro

Macro GetSpriteRadius(ObjetA)
   
   ObjetA\Radius
   
EndMacro

Macro GetSpriteTheta(ObjetA)
   
   ObjetA\Theta
   
EndMacro

Macro GetSpritePositionX(ObjetA)
   
   ObjetA\PositionX
   
EndMacro

Macro GetSpritePositionY(ObjetA)
   
   ObjetA\PositionY
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 16 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

Macro DegToRad(Angle)

  (Angle * #PI / 180)

EndMacro

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

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

#Quantity = 500
#SpriteSize = 12
#MinRadius = 200
#MaxRadius = 500
 
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, "Rosace 2D Sprite Demo") = 0 
   If OpenScreen(Screen_W, Screen_H, 24, "Rosace 2D Sprite Demo") = 0 
      If OpenScreen(Screen_W, Screen_H, 16, "Rosace 2D 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, RGBColor(RandomMinMax($50, $FF), RandomMinMax($50, $FF), RandomMinMax($50, $FF))) 
      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))
   SetSpriteRadius(SpriteList(Index), RandomMinMax(#MinRadius, #MaxRadius))
   SetSpriteTheta(SpriteList(Index), Random(1800))
   
Next 

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

Repeat 
   
   FlipBuffers() 
   ExamineKeyboard() 
   
   If IsScreenActive() 
      
      ClearScreen(0)
      
      For Index = 0 To #Quantity
         
         ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
         ; We compute a new positions and we display sprites to 
         ; their new positions.
         
         SetSpritePositionX(SpriteList(Index), GetSpriteRadius(SpriteList(Index)) * Sin(8*DegToRad(GetSpriteTheta(SpriteList(Index))) /5) * Cos(DegToRad(GetSpriteTheta(SpriteList(Index)))) + (Screen_W / 2))
         SetSpritePositionY(SpriteList(Index), GetSpriteRadius(SpriteList(Index)) * Sin(8*DegToRad(GetSpriteTheta(SpriteList(Index))) /5) * Sin(DegToRad(GetSpriteTheta(SpriteList(Index)))) + (Screen_H / 2))
         
         DisplayTransparentSprite(GetSpriteID(SpriteList(Index)), Int(GetSpritePositionX(SpriteList(Index))), Int(GetSpritePositionY(SpriteList(Index))))

         ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
         ; We prepare the next loop. If Theta angle are bigger than 
         ; 1800°, we set it to 0. We also change the Radius.
         
         SetSpriteTheta(SpriteList(Index), GetSpriteTheta(SpriteList(Index))+ 1)
         
         If GetSpriteTheta(SpriteList(Index)) > 1800
            SetSpriteTheta(SpriteList(Index), 0)
            SetSpriteRadius(SpriteList(Index), RandomMinMax(#MinRadius, #MaxRadius))
         EndIf
         
      Next 
      
   Else 
      
      Delay(10) 
      
   EndIf 
   
Until KeyboardPushed(#PB_Key_Escape) 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Last edited by Guimauve on Sun Aug 06, 2006 12:00 am, edited 2 times in total.
Top
oldBear
Enthusiast
Enthusiast
Posts: 121
Joined: Tue Jul 05, 2005 2:42 pm
Location: berrypatch

Post by oldBear »

Hmm - uncommented macros, changed RadtoDeg to DegToRad but get only a blank screen :(

cheers
Top
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Post by Guimauve »

Sorry !!

It's my mistakes :oops:

I have updated the code. Please try again.

Regards
Guimauve
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

whaouu, it's really nice.
well done.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
oldBear
Enthusiast
Enthusiast
Posts: 121
Joined: Tue Jul 05, 2005 2:42 pm
Location: berrypatch

Post by oldBear »

The Danilo's version you provided was really nice, that's why I was so anxious to try this one - but still get a blank (dark) screen.

Not a big deal. I see it works for Flype, does everyone else get a display?

cheers,

WindowsXP Sp2 GForce FX5200
Top
Fred
Administrator
Administrator
Posts: 18252
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:
Contact Fred

Post by Fred »

Yes, works great ! The code still have macro commented, you should uncomment them.
Top
oldBear
Enthusiast
Enthusiast
Posts: 121
Joined: Tue Jul 05, 2005 2:42 pm
Location: berrypatch

Post by oldBear »

Yes, macro's are uncommented else it won't even compile.

But just a blank screen. No sense spending any time on if I'm the only one with the problem. Was just wondering if I am.

cheers,
Top
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Post by Guimauve »

oldBear wrote:Yes, macro's are uncommented else it won't even compile.

But just a blank screen. No sense spending any time on if I'm the only one with the problem. Was just wondering if I am.

cheers,
Except I have all commented macro already compiled as resident file with TailBite, the code work fine on my PC.

Also, I have just test the code without my custom resident file and the uncommented macros and the code work fine too.

Just try to compile with the debugger to see if you get an error message.

If yes, post this message here to see what is wrong.

Regards
Guimauve
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

Here is a modified version of it using the faster Sprite3D system, 2000 sprites and a FPS counter (I get 265 FPS):

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Exemple : Rosace 2D Sprite Demo
; Author : Guimauve
; Date : 05-08-2006
; Last Update : 05-08-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
   Radius.l
   Theta.l
   PositionX.w
   PositionY.w
   
EndStructure

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

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

Macro SetSpriteRadius(ObjetA, P_Radius)
   
   ObjetA\Radius = P_Radius
   
EndMacro

Macro SetSpriteTheta(ObjetA, P_Theta)
   
   ObjetA\Theta = P_Theta
   
EndMacro

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

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

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

Macro GetSpriteID(ObjetA)
   
   ObjetA\id
   
EndMacro

Macro GetSpriteRadius(ObjetA)
   
   ObjetA\Radius
   
EndMacro

Macro GetSpriteTheta(ObjetA)
   
   ObjetA\Theta
   
EndMacro

Macro GetSpritePositionX(ObjetA)
   
   ObjetA\PositionX
   
EndMacro

Macro GetSpritePositionY(ObjetA)
   
   ObjetA\PositionY
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 16 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

Macro DegToRad(Angle)

  (Angle * #PI / 180)

EndMacro

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

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

#Quantity = 2000
#SpriteSize = 12
#MinRadius = 200
#MaxRadius = 500
 
Dim SpriteList.Sprite(#Quantity)

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Initialize DirectX >>>>>

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

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

If OpenScreen(Screen_W, Screen_H, 32, "Rosace 2D Sprite Demo") = 0
   If OpenScreen(Screen_W, Screen_H, 24, "Rosace 2D Sprite Demo") = 0
      If OpenScreen(Screen_W, Screen_H, 16, "Rosace 2D 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, #PB_Sprite_Texture) And CreateSprite3D(SpriteID,SpriteID)
      StartDrawing(SpriteOutput(SpriteID))
      Circle(#SpriteSize >> 1, #SpriteSize >> 1, #SpriteSize >> 1, RGBColor(RandomMinMax($50, $FF), RandomMinMax($50, $FF), RandomMinMax($50, $FF)))
      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))
   SetSpriteRadius(SpriteList(Index), RandomMinMax(#MinRadius, #MaxRadius))
   SetSpriteTheta(SpriteList(Index), Random(1800))
   
Next

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

Procedure.l GetFPS()
  Static Frames, FPS, LastTime
  
  Frames + 1
  
  If ElapsedMilliseconds()-LastTime >= 1000
    LastTime = ElapsedMilliseconds()
    FPS = Frames
    Frames = 0
  EndIf
  
  ProcedureReturn FPS
EndProcedure

Repeat
   
   FlipBuffers(0)
   ExamineKeyboard()
   
   If IsScreenActive()
      
      ClearScreen(0)
      
      If Start3D()
        For Index = 0 To #Quantity
           
           ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
           ; We compute a new positions and we display sprites to
           ; their new positions.
           
           SetSpritePositionX(SpriteList(Index), GetSpriteRadius(SpriteList(Index)) * Sin(8*DegToRad(GetSpriteTheta(SpriteList(Index))) /5) * Cos(DegToRad(GetSpriteTheta(SpriteList(Index)))) + (Screen_W / 2))
           SetSpritePositionY(SpriteList(Index), GetSpriteRadius(SpriteList(Index)) * Sin(8*DegToRad(GetSpriteTheta(SpriteList(Index))) /5) * Sin(DegToRad(GetSpriteTheta(SpriteList(Index)))) + (Screen_H / 2))
           
           DisplaySprite3D(GetSpriteID(SpriteList(Index)), Int(GetSpritePositionX(SpriteList(Index))), Int(GetSpritePositionY(SpriteList(Index))))
  
           ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
           ; We prepare the next loop. If Theta angle are bigger than
           ; 1800°, we set it to 0. We also change the Radius.
           
           SetSpriteTheta(SpriteList(Index), GetSpriteTheta(SpriteList(Index))+ 1)
           
           If GetSpriteTheta(SpriteList(Index)) > 1800
              SetSpriteTheta(SpriteList(Index), 0)
              SetSpriteRadius(SpriteList(Index), RandomMinMax(#MinRadius, #MaxRadius))
           EndIf
           
        Next
        Stop3D()
     EndIf
     
    If StartDrawing(ScreenOutput())
      DrawingMode(#PB_2DDrawing_Transparent)
      FrontColor(#White)
      DrawText(10,10,Str(GetFPS()))
      StopDrawing()
    EndIf 
    
   Else
     
      Delay(10)
     
   EndIf
   
Until KeyboardPushed(#PB_Key_Escape)

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
I like logic, hence I dislike humans but love computers.
Top
oldBear
Enthusiast
Enthusiast
Posts: 121
Joined: Tue Jul 05, 2005 2:42 pm
Location: berrypatch

Post by oldBear »

That version works fine - looks like I'm getting 79 fps.

Very impressive display. Thanks.

cheers

On the other code - it appears to run OK - no errors - it just produces a blank dark screen. If I alt/tab out I can see the program in task manager, if I return to it, I get the dark screen again.
Top
oldBear
Enthusiast
Enthusiast
Posts: 121
Joined: Tue Jul 05, 2005 2:42 pm
Location: berrypatch

Post by oldBear »

Found it - for some reason when I uncommented the macros Max became mMax. (This happens consistently! - "max)" becomes "mMax" with no closing paren, which i was inadvertently adding)

Corrected that, and all is well.

Sorry for all the bother :oops:

cheers
Top
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:
Contact Num3

Post by Num3 »

Nice...

With Sprite3d i get a stable 120FPS :P
Top
Post Reply

Return to “Tricks 'n' Tips”