PureBasic Forums - English

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

Rosace 2D Sprite Demo

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

Page 1 of 1

Rosace 2D Sprite Demo

Posted: Sat Aug 05, 2006 2:27 pm
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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: Sat Aug 05, 2006 2:36 pm
by oldBear
Hmm - uncommented macros, changed RadtoDeg to DegToRad but get only a blank screen :(

cheers

Posted: Sat Aug 05, 2006 2:40 pm
by Guimauve
Sorry !!

It's my mistakes :oops:

I have updated the code. Please try again.

Regards
Guimauve

Posted: Sat Aug 05, 2006 4:37 pm
by Flype
whaouu, it's really nice.
well done.

Posted: Sat Aug 05, 2006 9:12 pm
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

Posted: Sat Aug 05, 2006 9:23 pm
by Fred
Yes, works great ! The code still have macro commented, you should uncomment them.

Posted: Sat Aug 05, 2006 9:33 pm
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,

Posted: Sat Aug 05, 2006 9:55 pm
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

Posted: Sat Aug 05, 2006 11:19 pm
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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: Sat Aug 05, 2006 11:32 pm
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.

Posted: Sun Aug 06, 2006 12:08 am
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

Posted: Sun Aug 06, 2006 10:30 am
by Num3
Nice...

With Sprite3d i get a stable 120FPS :P
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited