starfield demo

[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

[BackupUser]

Restored from previous forum. Originally posted by fred.

Nice demo .

Fred - AlphaSND

[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

[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.

[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.

[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

[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.

[kenet]

can you add a Z rotation on it ?