Basic Univers
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<