Page 1 of 1
starfield demo
Posted: Thu Apr 18, 2002 12:20 am
by BackupUser
Code updated For 5.20+
Restored from previous forum. Originally posted by tex.
a starfiel for the fun
Code: Select all
;-----------------------------------------
;---------- STARFIELD DEMO----------------
;-----------------------------------------
;-------- Blitz to purebasic--------------
;-----------------------------------------
MAX_STAR.w=5000
STAR_SPEED.b=6
#width=800
#height=600
Global Dim star_x.l(MAX_STAR)
Global Dim star_y.l(MAX_STAR)
Global Dim star_z.l(MAX_STAR)
If InitSprite() = 0
MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
End
EndIf
If InitKeyboard() = 0
MessageRequester("Error","Can't open DirectX 7 Or later",0)
End
EndIf
If OpenScreen( #width,#height, 32, "Sprite")
Goto StartGame
Else
MessageRequester("Error", "Can't open screen !", 0)
EndIf
End
Procedure rnd(min.w,max.w)
a.w = max - Random (max-min)
ProcedureReturn a
EndProcedure
Procedure setup_stars()
For c.w=0 To 5000
star_x(c)= Rnd(-#width/2,#width/2) << 6
star_y(c)= Rnd(-#height/2,#height/2) << 6
star_z(c)=Rnd(2,255)
Next
ProcedureReturn value
EndProcedure
Procedure UpdateStar()
For c.w=0 To 5000
star_z(c)=star_z(c)- 4
If star_z(c)<=2
star_z(c)=255
EndIf
s_x.w=(star_x(c)/star_z(c))+(#width/2)
s_y.w=(star_y(c)/star_z(c))+(#height/2)
col.w=255-star_z(c)
FrontColor (RGB(col,col,col))
Box (s_x,s_y,3,3)
Next
ProcedureReturn value
EndProcedure
;-------------------------
; Game-LOOP
;-------------------------
StartGame:
setup_stars()
Repeat
FlipBuffers()
ClearScreen(RGB(0,0,0))
StartDrawing(ScreenOutput()) ; Start 2D-drawing
FrontColor(RGB(255,255,0))
updatestar()
StopDrawing() ; End 2D-Drawing
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) ; If ESCAPE is pressed: END
End
EndIf
ForEver
Posted: Thu Apr 18, 2002 10:13 am
by BackupUser
Restored from previous forum. Originally posted by fred.
Nice demo
.
Fred - AlphaSND
Posted: Thu Apr 18, 2002 11:29 am
by BackupUser
Restored from previous forum. Originally posted by Pupil.
Nice Tex,
to speed up your example one notch you could change your code to something like this:
Code: Select all
;-----------------------------------------
;---------- STARFIELD DEMO----------------
;-----------------------------------------
;-------- Blitz to purebasic--------------
;-----------------------------------------
MAX_STAR = 4000
STAR_SPEED = 3
#width=800
#height=600
Dim star_x.l(MAX_STAR)
Dim star_y.l(MAX_STAR)
Dim star_z.l(MAX_STAR)
Global MAX_STAR, STAR_SPEED, star_x, star_y, start_z
If InitSprite() = 0
MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
End
EndIf
If InitKeyboard() = 0
MessageRequester("Error","Can't open DirectX 7 Or later",0)
End
EndIf
If OpenScreen( #width,#height, 32, "Sprite")
Goto StartGame
Else
MessageRequester("Error", "Can't open screen !", 0)
EndIf
End
Procedure rnd(min.w,max.w)
a.w = max - Random (max-min)
ProcedureReturn a
EndProcedure
Procedure setup_stars()
For c.w=0 To MAX_STAR
star_x(c)= Rnd(-#width/2,#width/2) UPDATE! Added simple rotation..
Edited by - Pupil on 18 April 2002 13:49:59
Posted: Thu Apr 18, 2002 12:00 pm
by BackupUser
Restored from previous forum. Originally posted by tinman.
Nice work. When I tried Pupil's changes though, all I got was a gradient bar of black->white along the top of the screen. Not testing code before posting it?
--
It's not minimalist - I'm increasing efficiency by reducing input effort.
Posted: Thu Apr 18, 2002 12:47 pm
by BackupUser
Restored from previous forum. Originally posted by Pupil.
Nice work. When I tried Pupil's changes though, all I got was a gradient bar of black->white along the top of the screen. Not testing code before posting it?
--
It's not minimalist - I'm increasing efficiency by reducing input effort.
I've tested the code and it works fine here! Have you downloaded the latest PureLibraries from
http://www.purebasic.com/update/ ? Or perhaps it's OS related, my system is running WIN98SE.
Posted: Thu Apr 18, 2002 6:31 pm
by BackupUser
Restored from previous forum. Originally posted by Rings.
works fine for me on Win2000 .
Its a long way to the top if you wanna .....CodeGuru
Posted: Thu Apr 18, 2002 11:10 pm
by BackupUser
Restored from previous forum. Originally posted by tinman.
I've tested the code and it works fine here! Have you downloaded the latest PureLibraries from
http://www.purebasic.com/update/ ? Or perhaps it's OS related, my system is running WIN98SE.
No, I didn't realise there were any updates released since 3.00. Not sure if I'll be able to test if it was an OS problem, I spent all day upgrading my system
Thanks for the info though.
--
It's not minimalist - I'm increasing efficiency by reducing input effort.
Posted: Sun Oct 19, 2003 5:14 am
by kenet
can you add a Z rotation on it ?