Champs d'étoiles tournant

Guimauve · Message par **Guimauve** » sam. 22/avr./2006 19:15

Un vieux code de Pupil que j'ai mis à jour pour PB V4.00.

C'est en anglais mais le code est relativement simple à suivre.

A+
Guimauve

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : STARFIELD DEMO - Blitz to Purebasic
; File : RotatingStarField.pb
; File Version : 1.0.1
; Programmation : OK
; Programmed by : Pupil
; Updated by : Guimauve
; Date : 18-04-2002
; Last Update : 22-04-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure definition >>>>>

Structure StarField
   
   Quantity.l
   Speed.l
   Size.b
   Direction.b
   DeltaAngle.f
   Width.w
   Height.w
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Access Macros >>>>>

Macro StarFieldQuantity(ObjectA)
   
   ObjectA\Quantity
   
EndMacro

Macro StarFieldSpeed(ObjectA)
   
   ObjectA\Speed
   
EndMacro

Macro StarFieldSize(ObjectA)
   
   ObjectA\Size
   
EndMacro

Macro StarFieldDirection(ObjectA)
   
   ObjectA\Direction
   
EndMacro

Macro StarFieldDeltaAngle(ObjectA)
   
   ObjectA\DeltaAngle
   
EndMacro

Macro StarFieldWidth(ObjectA)
   
   ObjectA\Width
   
EndMacro

Macro StarFieldHeight(ObjectA)
   
   ObjectA\Height
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure definition >>>>>

Structure Position3D
   
   x.l
   y.l
   z.l
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Access Macros >>>>>

Macro Position3Dx(ObjetA)
   
   ObjetA\x
   
EndMacro

Macro Position3Dy(ObjetA)
   
   ObjetA\y
   
EndMacro

Macro Position3Dz(ObjetA)
   
   ObjetA\z
   
EndMacro

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

Procedure.w RandomMinMax(min.w, max.w)
   
   ProcedureReturn max - Random(max - min)
   
EndProcedure

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

Procedure SetupStars(*ObjectA.StarField, Array.Position3D(1))
   
   MAX_STAR.l = StarFieldQuantity(*ObjectA) 
   STAR_SIZE.l = StarFieldSize(*ObjectA)
   Half_Width = StarFieldWidth(*ObjectA) >> 1
   Half_Height = StarFieldHeight(*ObjectA) >> 1
   
   For Counter = 0 To MAX_STAR
      
      Position3Dx(Array(Counter)) = RandomMinMax(- Half_Width, Half_Width) << 6
      Position3Dy(Array(Counter)) = RandomMinMax(- Half_Height, Half_Height) << 6
      Position3Dz(Array(Counter)) = RandomMinMax(2, 255)
      
   Next
   
   StartDrawing(ScreenOutput())
   
   For i = 0 To 255
      FrontColor(RGB(i, i, i))
      Box(i * STAR_SIZE, 0, STAR_SIZE, STAR_SIZE)
   Next
   
   StopDrawing()
   
   For i = 0 To 255
      GrabSprite(i, i * STAR_SIZE, 0, STAR_SIZE, STAR_SIZE)
   Next
   
EndProcedure

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

Procedure UpdateStars(*ObjectA.StarField, Array.Position3D(1))
   
   Quantity = StarFieldQuantity(*ObjectA) 
   Direction = StarFieldDirection(*ObjectA)
   DeltaAngle.f = StarFieldDeltaAngle(*ObjectA)
   Speed = StarFieldSpeed(*ObjectA)
   Half_Width = StarFieldWidth(*ObjectA) >> 1
   Half_Height = StarFieldHeight(*ObjectA) >> 1
   
   cos.f = Cos(-Direction * DeltaAngle)
   sin.f = Sin(-Direction * DeltaAngle)
   
   For Counter = 0 To Quantity 
      
      Position3Dz(Array(Counter)) - Speed
      
      x.l = Position3Dx(Array(Counter))
      y.l = Position3Dy(Array(Counter))
      
      Position3Dy(Array(Counter)) = y * cos - x * sin
      Position3Dx(Array(Counter)) = x * cos + y * sin
      
      If Position3Dz(Array(Counter)) <= 2
         Position3Dz(Array(Counter)) = 255
      EndIf
      
      s_x.w = Position3Dx(Array(Counter)) / Position3Dz(Array(Counter)) + Half_Width
      s_y.w = Position3Dy(Array(Counter)) / Position3Dz(Array(Counter)) + Half_Height
      col.w = 255 - Position3Dz(Array(Counter))
      
      DisplaySprite(col, s_x, s_y)
      
   Next
   
EndProcedure

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

Procedure RunStarsAnimation(*ObjectA.StarField)
   
   Dim Stars.Position3D(StarFieldQuantity(*ObjectA))
   
   SetupStars(*ObjectA, Stars())
   
   Repeat
      
      FlipBuffers()
      ClearScreen(0)
      
      UpdateStars(*ObjectA, Stars())

      ExamineMouse()
      ExamineKeyboard()
      
   Until MouseDeltaX() Or MouseDeltaY() Or MouseWheel() Or KeyboardPushed(#PB_Key_All)
   
EndProcedure 

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

ScreenW = GetSystemMetrics_(#SM_CXSCREEN)
ScreenH = GetSystemMetrics_(#SM_CYSCREEN)
ScreenD = 32

StarFieldQuantity(StarField.StarField) =  3500
StarFieldSpeed(StarField) =  5
StarFieldSize(StarField) =  2 ; In pixel
StarFieldDirection(StarField) =  -1 ; -1 = CCW : 1 = CW
StarFieldDeltaAngle(StarField) =  0.030 
StarFieldWidth(StarField) =  ScreenW
StarFieldHeight(StarField) =  ScreenH

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
   
   MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
   
Else 
   
   If OpenScreen(ScreenW, ScreenH, ScreenD, "Rotating StarField") = 0
      
      MessageRequester("Error", "Can't open screen !", 0)
 
   Else
      
      RunStarsAnimation(StarField)
 
   EndIf
   
EndIf
   
End
   
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

olivier · Message par **olivier** » dim. 23/avr./2006 8:39

Moi j'aime...

En plus je cherche des effets comme cela pour ma fille (1 an 1/2). Comme cela elle appuye sur les touches et je lui balance des machins et des bidules.

On va voir si elle va aimer celui la ....

bernard13 · Message par **bernard13** » dim. 23/avr./2006 9:06

je te remercie
c'est trés jolie en plus