Spheres

Edit 0 1 …
Older Version Newer Version

bluatigro bluatigro Apr 4, 2010 

''for this stuf i need line 3d to work
''and than you wil see some realy good stuf
''( animated 3D sprites etc... )
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global height , pi
pi = atn( 1 ) * 4
black = rgb( 0 , 0 , 0 )
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
white = rgb( 255 , 255 , 255 )
pink = rgb( 255 , 127 , 127 )
orange = rgb( 255 , 127 , 0 )
gray = rgb( 127 , 127 , 127 )
purple = rgb( 127 , 0 , 127 )
nomainwin
open "spheres" for graphics as #m
print #m , "trapclose [quit]"
for height = 0 to 700
'' call egg -100,100,100,50,red _
'' , 100,100,100,50,blue , 10
call sphere 0 , 300 , 0 , 60 , yellow
call sphere 28 , 328 , -36 , 20 , white
call sphere 28 , 328 , -56 , 8 , black
call sphere -28 , 328 , -36 , 20 , white
call sphere -28 , 328 , -56 , 8 , black
call sphere 60 , 300 , 0 , 10 , yellow
call sphere -60 , 300 , 0 , 10 , yellow
call sphere 0 , 300 , -60 , 20 , yellow
call sphere 0 , 180 , 0 , 60 , blue
next height
print #m , "flush"
wait
function rad( x )
rad = x * pi / 180
end function
sub sphere x , y , z , d , kl
if abs( height - y ) < d then
dd = sqr( d ^ 2 - ( height - y ) ^ 2 ) * 2
kl = mix( kl , 1 - ( height - y ) / d / 2 + 0.5 , 0 )
r = int( kl and 255 )
g = int( kl / 256 ) and 255
b = int( kl / 256 / 256 ) and 255
dx = WindowWidth
dy = WindowHeight
print #m , "backcolor " ; r ;" "; g ;" "; b
print #m , "color " ; r ; " " ; g ; " " ; b
print #m , "goto "; dx / 2 + x ;" " _
; dy * 5 / 6 - height - z / 4
print #m , "down"
print #m , "ellipsefilled "; dd ;" "; dd / 4
print #m , "up"
end if
if hoog = 0 then
print #m , "backcolor black"
print #m , "color black"
print #m , "goto " ; dx / 2 + x ; " " _
; dy * 5 / 6 - z / 4
print #m , "down"
print #m , "ellipsefilled " ; d * 2 ; " " ; d / 2
print #m , "up"
end if
end sub
sub egg x1 , y1 , z1 , d1 , k1 , x2 , y2 , z2 , d2 , k2 , dm
diff = sqr( ( x1 - x2 ) ^ 2 _
+ ( y1 - y2 ) ^ 2 _
+ ( z1 - z2 ) ^ 2 )
dx = ( x2 - x1 ) / diff
dy = ( y2 - y1 ) / diff
dz = ( z2 - z1 ) / diff
dd = ( d2 - d1 ) / diff
if dm = 0 then dm = ( d1 + d2 ) / 2
for i = 0 to diff
kl = mix( k1 , 1 - i / diff , k2 )
call sphere x1 + dx * i _
, y1 + dy * i _
, z1 + dz * i _
, d1 + dd * i _
+ sin( i / diff * pi ) _
* ( dm - ( d1 + d2 ) / 2 ) _
, kl
next i
end sub
function rgb( r , g , b )
rgb = ( r and 255 ) _
+ ( g and 255 ) * 256 _
+ ( b and 255 ) * 256 * 256
end function
function mix( kl1 , f , kl2 )
r1 = int( kl1 and 255 )
g1 = int( kl1 / 256 ) and 255
b1 = int( kl1 / 256 / 256 ) and 255
r2 = int( kl2 and 255 )
g2 = int( kl2 / 256 ) and 255
b2 = int( kl2 / 256 / 256 ) and 255
dr = r2 - r1
dg = g2 - g1
db = b2 - b1
dr = dr * f
dg = dg * f
db = db * f
r = r1 + dr
g = g1 + dg
b = b1 + db
mix = rgb( r and 255 , g and 255 , b and 255 )
end function
[quit]
close #m
end