An old code from Pupil updated for PB V4.00
Have Fun
Update :
Structure access via macro only.
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 Stars.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(Stars(Counter)) = RandomMinMax(- Half_Width, Half_Width) << 6
Position3Dy(Stars(Counter)) = RandomMinMax(- Half_Height, Half_Height) << 6
Position3Dz(Stars(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 Stars.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(Stars(Counter)) - Speed
x.l = Position3Dx(Stars(Counter))
y.l = Position3Dy(Stars(Counter))
Position3Dy(Stars(Counter)) = y * cos - x * sin
Position3Dx(Stars(Counter)) = x * cos + y * sin
If Position3Dz(Stars(Counter)) <= 2
Position3Dz(Stars(Counter)) = 255
EndIf
s_x.w = Position3Dx(Stars(Counter)) / Position3Dz(Stars(Counter)) + Half_Width
s_y.w = Position3Dy(Stars(Counter)) / Position3Dz(Stars(Counter)) + Half_Height
col.w = 255 - Position3Dz(Stars(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) = 1 ; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<Guimauve