08-19-2022, 03:40 AM
I use SUBs in place of FUNCTIONs when I need to return two values, ie complex numbers.
here is an example of my complex math library which is a mixture of SUBs and FUNCTIONs
here is an example of my complex math library which is a mixture of SUBs and FUNCTIONs
Code: (Select All)
defdbl a-z
const sw = 800
const sh = 600
dim shared pi
pi = 4*atn(1)
zoom = 140
screen _newimage(sw, sh, 32)
_screenmove 100,100
dim as long i, xx, yy
for i=0 to 3
for yy=0 to sh
for xx=0 to sw
x = (xx - sw/2)/zoom
y = (sh/2 - yy)/zoom
select case i
case 0
u = x
v = y
pset (xx, yy), hrgb(u, v)
'pset (xx, yy), checker(u, v)
case 1
cdiv u, v, 1, 0, x, y
'pset (xx, yy), hrgb(u, v)
pset (xx, yy), checker(u, v)
case 2
cmul u, v, 1, 0, x - cos(2*pi/3), y + sin(2*pi/3)
cmul u, v, u, v, x - cos(2*pi/3), y - sin(2*pi/3)
cmul u, v, u, v, x - 1, y
'cdiv u, v, u, v, x - 1, y
pset (xx, yy), hrgb(u, v)
'pset (xx, yy), checker(u, v)
case 3
n = 10
uu = 0
vv = 0
for j=0 to n - 1
p = 1.5*cos(j*2*pi/n)
q = 1.5*sin(j*2*pi/n)
cmul u, v, 1, 0, p - cos(2*pi/3), q + sin(2*pi/3)
cmul u, v, u, v, p - cos(2*pi/3), q - sin(2*pi/3)
cmul u, v, u, v, p - 1, q
cdiv u, v, u, v, p - x, q - y
cmul u, v, u, v, -1.5*sin(j*2*pi/n), 1.5*cos(j*2*pi/n)
if j = 0 or j = n - 1 then
uu = uu + 0.5*u
vv = vv + 0.5*v
else
uu = uu + u
vv = vv + v
end if
next
u = uu*2*pi/n
v = vv*2*pi/n
cmul u, v, u, v, 0, -1/(2*pi)
pset (xx, yy), hrgb(u, v)
'pset (xx, yy), checker(u, v)
end select
next
next
'''diagram
select case i
case 3
a = 0
x = 1.5*cos(a)
y = 1.5*sin(a)
circle (x*zoom + sw/2, sh/2 - y*zoom), 3, _rgb(255,255,0)
for a=0 to 2*pi step 2*pi/n
x = 1.5*cos(a)
y = 1.5*sin(a)
line -(x*zoom + sw/2, sh/2 - y*zoom), _rgb(255,255,0)
circle step(0,0), 3, _rgb(255,255,0)
next
end select
sleep
next
system
function checker~&(xx, yy)
if 1 then
x = xx
y = yy
else 'polar checkerboard
x = _atan2(yy, xx)/(pi/4)
y = sqr(xx*xx + yy*yy)
y = log(1 + 1000*y)
end if
z = abs(x - int(x)) xor abs(y - int(y))
if z then checker = _rgb(0,0,0) else checker = _rgb(255,255,255)
end function
function hrgb~&(x, y)
m = sqr(x*x + y*y)
a = (pi + _atan2(y, x))/(2*pi)
'm = log(1 + 1000*m)
r = 0.5 - 0.5*sin(2*pi*a - pi/2)
g = (0.5 + 0.5*sin(2*pi*a*1.5 - pi/2)) * -(a < 0.66)
b = (0.5 + 0.5*sin(2*pi*a*1.5 + pi/2)) * -(a > 0.33)
'polar contouring
n = 16
mm = m*500 mod 500
p = abs(a*n - int(a*n))
r = r - 0.0005*mm - 0.14*p
g = g - 0.0005*mm - 0.14*p
b = b - 0.0005*mm - 0.14*p
'cartesian shading
if 0 then
t = 0.03 'thickness
xx = abs(x - int(x)) < t or abs(-x - int(-x)) < t
yy = abs(y - int(y)) < t or abs(-y - int(-y)) < t
if xx or yy then
'if m > 1 then 'dont shade origin
r = r - 0.5
g = g - 0.5
b = b - 0.5
'end if
end if
end if
hrgb = _rgb(255*r, 255*g, 255*b)
end function
sub cmul(u, v, xx, yy, aa, bb)
x = xx
y = yy
a = aa
b = bb
u = x*a - y*b
v = x*b + y*a
end sub
sub cdiv(u, v, xx, yy, aa, bb)
x = xx
y = yy
a = aa
b = bb
d = a*a + b*b
u = (x*a + y*b)/d
v = (y*a - x*b)/d
end sub
sub cexp(u, v, xx, yy, aa, bb)
x = xx
y = yy
a = aa
b = bb
lnz = x*x + y*y
if lnz = 0 then
u = 0
v = 0
else
lnz = 0.5*log(lnz)
argz = _atan2(y, x)
m = exp(a*lnz - b*argz)
a = a*argz + b*lnz
u = m*cos(a)
v = m*sin(a)
end if
end sub
sub clog(u, v, xx, yy)
x = xx
y = yy
lnz = x*x + y*y
if lnz=0 then
u = 0
v = 0
else
u = 0.5*log(lnz)
v = _atan2(y, x)
end if
end sub
function cosh(x)
cosh = 0.5*(exp(x) + exp(-x))
end function
function sinh(x)
sinh = 0.5*(exp(x) - exp(-x))
end function
sub csin(u, v, xx, yy)
x = xx
y = yy
u = sin(x)*cosh(y)
v = cos(x)*sinh(y)
end sub
sub ccos(u, v, xx, yy)
x = xx
y = yy
u = cos(x)*cosh(y)
v =-sin(x)*sinh(y)
end sub
function factorial~&(n)
if n = 0 then
factorial = 1
else
factorial = n*factorial(n - 1)
end if
end function