Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Why do we need Functions?
#5
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


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
Reply


Messages In This Thread
Why do we need Functions? - by PhilOfPerth - 08-19-2022, 01:00 AM
RE: Why do we need Functions? - by OldMoses - 08-19-2022, 01:44 AM
RE: Why do we need Functions? - by bplus - 08-19-2022, 02:05 AM
RE: Why do we need Functions? - by OldMoses - 08-19-2022, 02:12 AM
RE: Why do we need Functions? - by vince - 08-19-2022, 03:40 AM
RE: Why do we need Functions? - by PhilOfPerth - 08-19-2022, 05:40 AM
RE: Why do we need Functions? - by OldMoses - 08-19-2022, 12:58 PM
RE: Why do we need Functions? - by SMcNeill - 08-19-2022, 06:28 AM
RE: Why do we need Functions? - by SMcNeill - 08-19-2022, 06:42 AM
RE: Why do we need Functions? - by PhilOfPerth - 08-19-2022, 08:15 AM
RE: Why do we need Functions? - by bartok - 08-19-2022, 01:36 PM
RE: Why do we need Functions? - by mnrvovrfc - 08-20-2022, 11:59 AM
RE: Why do we need Functions? - by bartok - 08-20-2022, 01:54 PM
RE: Why do we need Functions? - by mnrvovrfc - 08-20-2022, 11:56 AM
RE: Why do we need Functions? - by TempodiBasic - 08-20-2022, 04:52 PM
RE: Why do we need Functions? - by bplus - 08-20-2022, 04:54 PM



Users browsing this thread: 7 Guest(s)