Molecule 3D

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global sprmax , sprtel , winx , winy , pi
sprmax = 20
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
dim sx( sprmax ) , sy( sprmax ) , sz( sprmax ) , ry( sprmax )
for i = 0 to sprmax
ry( i ) = i
next i
loadbmp "gray" , DefaultDir$ + "\BMP\GRAY.bmp"
loadbmp "red" , DefaultDir$ + "\BMP\RED.bmp"
loadbmp "green" , DefaultDir$ + "\BMP\GREEN.bmp"
loadbmp "yellow" , DefaultDir$ + "\BMP\YELLOW.bmp"
loadbmp "blue" , DefaultDir$ + "\BMP\BLUE.bmp"
loadbmp "magenta" , DefaultDir$ + "\BMP\MAGENTA.bmp"
loadbmp "cyan" , DefaultDir$ + "\BMP\CYAN.bmp"
loadbmp "white" , DefaultDir$ + "\BMP\WHITE.bmp"
nomainwin
open "molecules" for graphics as #m
#m "trapclose [quit]"
for i = 0 to sprmax
#m "addsprite spr" ; str$( i ) _
; " gray red green yellow blue magenta cyan white"
next i
''bild molecule
sprtel = 0
call atom 40 , 40 , 40 , "gray"
call atom -40 , 40 , 40 , "red"
call atom 40 ,-40 , 40 , "green"
call atom -40 ,-40 , 40 , "yellow"
call atom 40 , 40 ,-40 , "blue"
call atom -40 , 40 ,-40 , "magenta"
call atom 40 ,-40 ,-40 , "cyan"
call atom -40 ,-40 ,-40 , "white"
timer 40 , [tmr]
wait
[tmr]
call draw
wait
sub atom x , y , z , kl$
if sprtel >= sprmax then exit sub
#m "spriteimage spr" ; str$( sprtel ) ; " " ; kl$
sx( sprtel ) = x
sy( sprtel ) = y
sz( sprtel ) = z
sprtel = sprtel + 1
end sub
sub draw
s = sin( rad( 3 ) )
c = cos( rad( 3 ) )
''rotating matrix
for i = 0 to sprtel - 1
hx = sx( i ) * c - sz( i ) * s
hz = sx( i ) * s + sz( i ) * c
sx( i ) = hx
sz( i ) = hz
next i
''sort sprites on Z coordinate
for i = 1 to sprtel - 1
for j = 0 to i
if sz( ry( i ) ) < sz( ry( j ) ) then
h = ry( i )
ry( i ) = ry( j )
ry( j ) = h
end if
next j
next i
''put sprites in 3D screen
for i = 0 to sprmax - 1
#m "spritexy spr" ; str$( ry( i ) ) ; " " _
; winx / 2 + sx( ry( i ) ) ; " " _
; winy / 2 - sy( ry( i ) ) - sz( ry( i ) ) / 4
next i
#m "drawsprites"
end sub
function rad( x )
rad = x * pi / 180
end function
[quit]
unloadbmp "gray"
unloadbmp "red"
unloadbmp "green"
unloadbmp "yellow"
unloadbmp "blue"
unloadbmp "magenta"
unloadbmp "cyan"
unloadbmp "white"
close #m
end