TGC Codebase Backup



3D starfield pixel based by Euphoria

20th Mar 2006 14:13
Summary

3D pixel starfield, controllable



Description

3D Pixel Starfield, controllable using the arrow keys

Not a Cos or Sin used (was hoping it would make it quicker)



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