3D starfield pixel based by Euphoria20th Mar 2006 14:13
|
---|
Summary 3D pixel starfield, controllable Description 3D Pixel Starfield, controllable using the arrow keys Code ` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com set display mode 800,600,16 backdrop on color backdrop rgb(0,0,0) sync on sync rate 60 Type star xpos# as float ypos# as float zpos# as float endtype numStars = 2000 starSpeed# = 2.0 cx = screen width()/2 cy = screen height()/2 Dim star() as star ` Setup stars array For starcount = 1 To numStars array insert at bottom star() star().xpos# = Rnd(320) - 160 star().ypos# = Rnd(200) - 100 star().zpos# = Rnd(256) Next ` Main Loop Repeat gosub CheckKeyboard array index to top star() ` Lock buffer lock pixels ` Output frame repeat dec star().zpos#, starSpeed# inc star().xpos#, starSpeedX# inc star().ypos#, starSpeedY# If star().zpos# < 0 Then star().zpos# = 256.0 ` y axis movement check If star().ypos# < -100 Then star().ypos# = 100 + (star().ypos# + 100) If star().ypos# > 100 Then star().ypos# = -100 + (star().ypos# - 100) ` x axis movement check If star().xpos# < -160 Then star().xpos# = 160 + (star().xpos# + 160) If star().xpos# > 160 Then star().xpos# = -160 - (star().xpos# - 160) ` convert to 2d sx = ((star().xpos# * 256) / star().zpos#) + cx sy = ((star().ypos# * 256) / star().zpos#) + cy starcolour = 256-star().zpos# dot sx, sy, rgb(starcolour, starcolour, starcolour) next array index star() until array index valid( star() ) = 0 ` unlock buffer unlock pixels sync until escapekey() CheckKeyboard: if upkey() = 1 If starSpeedY# > -5.0 Then dec starSpeedY#, 0.5 endif if downkey() = 1 If starSpeedY# < 5.0 Then inc starSpeedY#, 0.5 endif if leftkey() = 1 If starSpeedX# > -5.0 Then dec starSpeedX#, 0.5 endif if rightkey() = 1 If starSpeedX# < 5.0 Then inc starSpeedX#, 0.5 endif return |