09-22-2005, 03:05 AM
Code:
option explicit
''' consts
const MAX_STARS as uinteger = 100000
const LAST_STAR as uinteger = MAX_STARS - 1
const XWIDTH as integer = 800
const YHEIGHT as integer = 600
const XLAST as integer = XWIDTH - 1
const YLAST as integer = YHEIGHT - 1
const XHALF as integer = XWIDTH / 2
const YHALF as integer = -(YHEIGHT / 2)
const SPACE_DIMENSION as single = 500000
const SPACE_HALF_SIZE as single = SPACE_DIMENSION / 2.0
const ONE_DEGREE as single = 0.017453292 'pi/180
''' types
type v3d
x as single
y as single
z as single
end type
type v2D
x as integer
y as integer
end type
type UNIVERS
o(MAX_STARS) as v3d 'object space
w(MAX_STARS) as v3d 'world space
s(MAX_STARS) as v2d 'screen space
v(MAX_STARS) as single 'speed
end type
'''Protos
declare sub VectorRot(byref New as V3D,byref Old as V3D, _
byval sin_x as single,byval cos_x as single, _
byval sin_y as single,byval cos_y as single, _
byval sin_z as single,byval cos_z as single)
declare sub animate(byval fps as single)
declare sub render()
'''vars
dim shared MyWorld as UNIVERS
dim i as uinteger
dim frames as uinteger
dim starttime as single
dim nowtime as single
dim fps as single
dim page as integer
dim shared as single cx,cy,cz,sx,sy,sz
dim shared as integer current_stars =MAX_STARS
'''init with random
for i=0 to LAST_STAR
MyWorld.o(i).x = rnd * SPACE_DIMENSION - SPACE_HALF_SIZE
MyWorld.o(i).y = rnd * SPACE_DIMENSION - SPACE_HALF_SIZE
MyWorld.o(i).z = rnd * SPACE_DIMENSION - SPACE_HALF_SIZE
MyWorld.v(i)= 1000 +rnd * 10000
next
current_stars=max_stars / 10
'''main
screenres XWIDTH,YHEIGHT,32,2
starttime=timer
fps=25.0
while inkey = ""
screenset page,page xor 1
page = page xor 1
animate 1.0/fps
render
if fps>25.0 and current_stars<(MAX_STARS-100) then
current_stars+=100
elseif fps<25.0 and (current_stars>100) then
current_stars-=100
end if
frames+=1
if frames mod 10=0 then
nowtime=timer
fps = 10.0 / (nowtime - starttime)
starttime = nowtime
windowtitle "FPS:" + str$(int(fps)) + " Stars per Sec.:" + str$(int(current_stars*fps))
end if
wend
end
sub animate(byval FPS as single)
static as single a,b,g
dim i as uinteger
dim zd1 as single
'dummy scale,mov
cx=cos(a):cy=cos(b):cz=cos(g)
sx=sin(a):sy=sin(b):sz=sin(g)
a+=ONE_DEGREE*fps
b+=ONE_DEGREE*3*fps
g+=ONE_DEGREE*7*fps
for i =0 to current_stars
myworld.o(i).z+=myworld.v(i)*fps
if abs(myworld.o(i).z)>SPACE_HALF_SIZE then
MyWorld.o(i).x = rnd * SPACE_DIMENSION - SPACE_HALF_SIZE
MyWorld.o(i).y = rnd * SPACE_DIMENSION - SPACE_HALF_SIZE
MyWorld.o(i).z = rnd * SPACE_DIMENSION - SPACE_HALF_SIZE
MyWorld.v(i)= 1000 +rnd * 10000
end if
VectorRot MyWorld.w(i),MyWorld.o(i),sx,cx,sy,cy,sz,cz
next
'worldspace -> screenspace
for i =0 to current_stars
if MyWorld.w(i).z>0.1 then
zd1=1.0/(MyWorld.w(i).z/256.0) 'same as x'=xm + x*256/z
MyWorld.s(i).x=int( MyWorld.w(i).x * zd1 ):MyWorld.s(i).x+=XHALF
MyWorld.s(i).y=int( MyWorld.w(i).y * zd1 ):MyWorld.s(i).y+=YHALF
end if
next
end sub
sub render()
dim pageptr as uinteger ptr
dim index as uinteger
dim i as uinteger
dim x as uinteger
dim y as uinteger
cls
screenlock
pageptr = screenptr
for i =0 to current_stars
if MyWorld.w(i).z>0.1 then
if MyWorld.s(i).x>0 then
if MyWorld.s(i).x<XWIDTH then
if MyWorld.s(i).y>0 then
if MyWorld.s(i).y<YHEIGHT then
index = MyWorld.s(i).y * XWIDTH
index+= MyWorld.s(i).x
pageptr[index]=&HFFFF
end if
end if
end if
end if
end if
next
screenunlock
end sub
sub VectorRot(byref New as V3D,byref Old as V3D, _
byval sin_x as single,byval cos_x as single, _
byval sin_y as single,byval cos_y as single, _
byval sin_z as single,byval cos_z as single)
asm
mov eax,[Old] 'st0 st1 st2 st3 st4 st5
mov edx,[New] '-------------------------------------------
fld dword ptr [eax+8] 'Z
fld st(0) 'Z Z
fmul dword ptr [sin_x] 'Z*sx Z
fld dword ptr [eax+4] 'Y Z*sx Z
fld st(0) 'Y Y Z*sx Z
fmul dword ptr [cos_x] 'Y*cx Y Z*sx Z
fsub st(2) 'YT Y Z*sx Z
fld st(0) 'YT YT Y Z*sx Z
fxch st(3) 'Z*sx YT Y YT Z
fstp st(0) 'YT Y YT Z
fxch st(3) 'Z Y YT YT
fmul dword ptr [cos_x] 'Z*cx Y YT YT
fxch st(1) 'Y Z*cx YT YT
fmul dword ptr [sin_x] 'Y*sx Z*cx YT YT
fadd st(1) 'ZT Z*cx YT YT
fxch st(1) 'Z*cx ZT YT YT
fstp st(0) 'ZT YT YT
fld st(0) 'ZT ZT YT YT
fmul dword ptr [sin_y] 'ZT*sy ZT YT YT
fld dword ptr [eax+0] 'X ZT*sy ZT YT YT
fld st(0) 'X X ZT*sy ZT YT YT
fmul dword ptr[cos_y] 'X*cy X ZT*sy ZT YT YT
faddp st(2),st(0) 'X XT ZT YT YT
fxch st(1) 'XT X ZT YT YT
fld st(0) 'XT XT X ZT YT YT
fxch st(3) 'ZT XT X XT YT YT
fmul dword ptr [cos_y] 'ZT*cy XT X XT YT YT
fxch st(2) 'X XT ZT*cy XT YT YT
fchs '-X XT ZT*cy XT YT YT
fmul dword ptr [sin_y] '-X*sy XT ZT*cy XT YT YT
fadd st(2)
fstp dword ptr [edx+8] 'XT ZT*cy XT YT YT
fxch st(1) 'ZT*cy XT XT YT YT
fstp st(0) 'XT XT YT YT
fxch st(2) 'YT XT XT YT
fmul dword ptr [sin_z] 'YT*sz XT XT YT
fxch st(1) 'XT YT*sz XT YT
fmul dword ptr [cos_z] 'XT*cz YT*sz XT YT
fsub st(1)
fstp dword ptr [edx+0] 'YT*sz XT YT
fstp st(0) 'XT YT
fxch st(1) 'YT XT
fmul dword ptr [cos_Z] 'YT*cz XT
fxch st(1) 'XT YT*cz
fmul dword ptr [sin_z] 'XT*sz YT*cz
fadd st(1)
fstp dword ptr [edx+4] 'YT*cz
fstp st(0)
end asm
end sub
sorry about my english