Esher Ring

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global WinX , WinY
WinX = WindowWidth
WinY = Windowheight
global height , pi
global black , red , green , yellow
global blue , magenta , cyan , white
global pink , purple , gray , orange
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 "3D Ring" for graphics as #m
#m "trapclose [quit]"
call ring 400 , 300 , 50 , 50 , 25 , red
#m "flush"
wait
sub ring mx , my , dx , dy , d , clr
WinX = 0
WinY = 0
for i = 0 to 90 step 90 / ( dx + dy )
x = sin( rad( i ) )
y = cos( rad( i ) )
kl = mix( clr , 0 - i / 90 , black )
if clr = -1 then kl = black
r = int( kl and 255 )
g = int( kl / 256 ) and 255
b = int( kl / 256 / 256 ) and 255
#m "backcolor " ; r ;" "; g ;" "; b
#m "color " ; r ; " " ; g ; " " ; b
#m "down"
#m "line " ; x * dx + WinX / 2 + mx ; " " _
; y * dy + WinY / 2 + my ; " " _
; x * dx + d + WinX / 2 + mx ; " " _
; y * dy + WinY / 2 + my
#m "up"
#m "down"
#m "line " ; x * ( dx - d ) + WinX / 2 + mx ; " " _
; WinY / 2 - y * ( dy - d ) + my ; " " _
; x * ( dx - d ) + WinX / 2 + d + mx ; " " _
; WinY / 2 -y * ( dy - d ) + my
#m "up"
kl = mix( clr , 0 - i / 90 , white)
if clr = -1 then kl = black
r = int( kl and 255 )
g = int( kl / 256 ) and 255
b = int( kl / 256 / 256 ) and 255
#m "backcolor " ; r ;" "; g ;" "; b
#m "color " ; r ; " " ; g ; " " ; b
#m "down"
#m "line " ; WinX / 2 - x * ( dx - d ) + mx ; " " _
; WinY / 2 + y * ( dy - d ) + my ; " " _
; WinX / 2 - x * ( dx - d ) + d + mx ; " " _
; WinY / 2 + y * ( dy - d ) + my
#m "up"
#m "down"
#m "line " ; WinX / 2 - x * dx + mx ; " " _
; WinY / 2 - y * dy + my ; " " _
; WinX / 2 - x * dx + d + mx ; " " _
; WinY / 2 - y * dy + my
#m "up"
next i
if clr = nocolor then clr = black
for i = 0 to d
call arc WinX / 2 + mx , WinY / 2 + my , dx - i , dy - i _
, -90 , 90 , clr
call arc WinX / 2 + d +mx, WinY / 2 +my , dx - i , dy - i _
, 90 , 270 , clr
next i
end sub
function rad( x )
rad = x * pi / 180
end function
sub arc mx , my , dx , dy , b , e , kl
for i = b to e step 50 / ( dx + dy )
x = sin( rad( i ) ) * dx + mx
y = cos( rad( i ) ) * dy + my
r = int( kl and 255 )
g = int( kl / 256 ) and 255
b = int( kl / 256 / 256 ) and 255
#m "backcolor " ; r ;" "; g ;" "; b
#m "color " ; r ; " " ; g ; " " ; b
#m "down"
#m "set " ; x ; " " ; y
#m "up"
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