Basic Univers
Structure StarField
Quantity.l
Speed.l
Size.b
Direction.b
DeltaAngle.f
Width.w
Height.w
EndStructure
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 Position3D
x.l
y.l
z.l
EndStructure
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
StarFieldDirection(StarField) = - 1
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