Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Vince's Corner Takeout
#51
hair
Code: (Select All)

defdbl a-z
dim shared as integer sw, sh, mx, my, mb, mw

pi = 4*atn(1)

sw = 800
sh = 600

screen _newimage(sw, sh, 32)

n = 15
dim x(n), y(n)

for i=0 to n-1
    x(i) = sw/2
    y(i) = i*sh/n
next

r = 35
mw = r

do
    cls

    getmouse
    r = mw

    x(0) = mx
    y(0) = my
    for i=1 to n-1
        if ((x(i - 1) - x(i))^2 + (y(i - 1) - y(i))^2) > r*r then
            a = _atan2(y(i - 1) - y(i), x(i - 1) - x(i)) - pi
            x(i) = x(i - 1) + r*cos(a)
            y(i) = y(i - 1) + r*sin(a)
        end if
    next


    'preset (x(0), y(0))
    'for i=0 to n - 1
    '    line -(x(i), y(i)), _rgb(55,55,0)
    '    circle (x(i), y(i)), 3, _rgb(255,255,0)
    'next

    preset (x(0), y(0))

    dt = 0.001
    for t=0 to 1 step dt
        bx = 0
        by = 0   
       
        'dx = 0
        'dy = 0
       
        for i=0 to n - 1
            bin = 1
            for j=1 to i
                bin = bin*(n - j)/j
            next
       
            p = bin*((1 - t)^(n - 1 - i))*(t^i)
            bx = bx + p*x(i)
            by = by + p*y(i)
                         
            'q = bin*((1 - t)^(n - 2 - i))*(t^(i - 1))*(i - n*t + t)
            'dx = dx + q*x(i)
            'dy = dy + q*y(i)               
        next

        if abs(bx - ox)>1 and abs(by - oy)>1 then
            line -(bx, by), _rgb(255,0,0)

            ox = bx
            oy = by
        end if
       
        'm = sqr(dx*dx + dy*dy)
        'line -step(10*dx/m, 10*dy/m), _rgb(0,255,0)
    next
    line -(bx, by), _rgb(255,0,0)


    _display
    _limit 30
loop until _keyhit = 27
system


sub getmouse()
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        mw = mw - _mousewheel
    loop while _mouseinput
end sub
Reply
#52
Nice looks like a start to a calligraphy app. Big Grin
b = b + ...
Reply
#53
clean summary of all things bezier -- nth order curves, points, and derivatives

Code: (Select All)
sw = 800
sh = 600
screen _newimage(sw, sh, 32)

if _resize then
    sw = _resizewidth - 20
    sh = _resizeheight - 20
    screen _newimage(sw, sh, 32)
end if

n = 8
dim x(n - 1), y(n - 1)
x(0)=sw/2:y(0)=sh/7
x(1)=sw/3:y(1)=2*sh/7
x(2)=2*sw/3:y(2)=3*sh/7
x(3)=sw/5:y(3)=4*sh/7
x(4)=sw/2:y(4)=5*sh/7
x(5)=sw/5:y(5)=5*sh/7
x(6)=sw/2:y(6)=6*sh/7
x(7)=4*sw/5:y(7)=6*sh/7

cls
for i=0 to n - 1
    circle (x(i), y(i)), 3, _rgb(255,255,0)
next

preset (x(0), y(0))

ox = x(0)
oy = y(0)
dt = 0.02
for t=0 to 1 step dt
    bx = 0
    by = 0   
   
    dx = 0
    dy = 0
   
    for i=0 to n - 1
        bin = 1
        for j=1 to i
            bin = bin*(n - j)/j
        next
   
        p = bin*((1 - t)^(n - 1 - i))*(t^i)
        bx = bx + p*x(i)
        by = by + p*y(i)
                     
        q = bin*((1 - t)^(n - 2 - i))*(t^(i - 1))*(i - n*t + t)
        dx = dx + q*x(i)
        dy = dy + q*y(i)               
    next

   
    'hairline
    if abs(bx - ox)>1 and abs(by - oy)>1 then
        'line (ox, oy)-(bx, by), _rgb(55,55,55)

        ox = bx
        oy = by
    end if

    'point
    pset (bx, by), _rgb(255,0,0)

    'derivative vector
    m = sqr(dx*dx + dy*dy)
    line -step(7*dx/m, 7*dy/m), _rgb(0,255,0)

next
'line (ox, oy)-(bx, by), _rgb(55,55,55)
Reply
#54
3D junk

mobius
Code: (Select All)
dim shared pi, p, q, a, b, x, y, z, t

zoom = 450

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

pi = 4*atn(1)
du = 2*pi/100
dv = pi/20

a = 0
b = pi/4

ou = 0
ov = 0

do
    for t = 0 to 0.12 step 0.01
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput

    cls

    xu = 0
    xv = 0

    for u=2*pi+pi/2 +du to pi step -du
        xu = xu xor 1
        for v=-pi to pi step dv
            xu = xu xor 1

            nx = sin(v)
            ny = -cos(v)
            nz = u

            roty a
            rotx b

            'parallel
            sx = -1
            sy = -sx/0.707
            sz = -0.707*sy

            'perspective
            sx = 0 
            sy = -1
            sz = 0 

            'if (nx*sx + ny*sy + nz*sz) < 0 then
                f u, v
                proj
                x1 = sw/2 + zoom*p - 200
                y1 = sh/2 - zoom*q
                'pset (x1, y1)

                f u + du, v
                proj
                x2 = sw/2 + zoom*p - 200
                y2 = sh/2 - zoom*q
                'line -(x2, y2)

                f u + du, v + dv
                proj
                x3 = sw/2 + zoom*p - 200
                y3 = sh/2 - zoom*q
                'line -(x3, y3)

                f u, v + dv
                proj
                x4 = sw/2 + zoom*p - 200
                y4 = sh/2 - zoom*q
                'line -(x4, y4)

                'line -(x1, y1)

                if xu then
                    c = 255 - 420*((u - pi)/(2*pi + pi/2))^2
                '    if v > 0.3*2*pi then
                '        c = c - 50*(2*pi - v)
                '    end if
                '    c = 255
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
                else
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
                end if
            'end if
        next


    next

    _limit 100
    _display
    next
loop until _keyhit = 27
sleep
system


sub f(u, v)
    'x = u*cos(v)
    'y = u*sin(v)
    'z = v

    x = (1 + 0.5*v*cos(0.5*(u - t)))*cos(u - t)
    y = (1 + 0.5*v*cos(0.5*(u - t)))*sin(u - t)
    z = 0.5*v*sin(0.5*(u - t))
end sub

sub proj
    'parallel
    'p = x + 0.707*y
    'q = z + 0.707*y

    roty a
    rotx b

    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(u)
    xx = x
    yy = y*cos(u) - z*sin(u)
    zz = y*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub roty(u)
    xx = x*cos(u) + z*sin(u)
    yy = y
    zz =-x*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(u)
    xx = x*cos(u) - y*sin(u)
    yy = x*sin(u) + y*cos(u)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

helicoid
Code: (Select All)
dim shared pi, p, q, a, b, x, y, z, t, tt

zoom = 80

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

pi = 4*atn(1)
du = 2*pi/20
dv = 2*pi/20

a = 0
b = 0'pi/4

tt = 0

do 
    tt = tt + 0.01
    t = 0.2*sin(tt)

    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput

    cls

    s = 0
    for v=-2*pi to 2*pi step dv
        s = s xor 1
        for u=-3*pi to 3*pi step du
            s = s xor 1

            nx = sin(v)
            ny = -cos(v)
            nz = u

            roty a
            rotx b

            'parallel
            sx = -1
            sy = -sx/0.707
            sz = -0.707*sy

            'perspective
            sx = 0 
            sy = -1
            sz = 0 

            'if (nx*sx + ny*sy + nz*sz) < 0 then
                f u, v
                proj
                x1 = sw/2 + zoom*p
                y1 = sh/2 - zoom*q
                'pset (x1, y1)

                f u + du, v
                proj
                x2 = sw/2 + zoom*p
                y2 = sh/2 - zoom*q
                'line -(x2, y2)

                f u + du, v + dv
                proj
                x3 = sw/2 + zoom*p
                y3 = sh/2 - zoom*q
                'line -(x3, y3)

                f u, v + dv
                proj
                x4 = sw/2 + zoom*p
                y4 = sh/2 - zoom*q
                'line -(x4, y4)

                'line -(x1, y1)

                if s then
                    c = 255 '- 20*y
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
                else
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
                end if
            'end if
        next
    next

    _limit 30
    _display
loop until _keyhit = 27
sleep
system


sub f(u, v)
    x = u*cos(v*t + tt)
    y = u*sin(v*t + tt)
    z = v

    'x = (1 + 0.5*v*cos(0.5*(u - t)))*cos(u - t)
    'y = (1 + 0.5*v*cos(0.5*(u - t)))*sin(u - t)
    'z = 0.5*v*sin(0.5*(u - t))
end sub

sub proj
    'parallel
    'p = x + 0.707*y
    'q = z + 0.707*y

    roty a
    rotx b

    p = x*10/(10 + y)
    q = z*10/(10 + y)
end sub

sub rotx(u)
    xx = x
    yy = y*cos(u) - z*sin(u)
    zz = y*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub roty(u)
    xx = x*cos(u) + z*sin(u)
    yy = y
    zz =-x*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(u)
    xx = x*cos(u) - y*sin(u)
    yy = x*sin(u) + y*cos(u)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

torus
Code: (Select All)
dim shared pi, p, q, a, b

zoom = 150

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

pi = 4*atn(1)
du = 2*pi/80
dv = pi/15

rr = 2.0
r = 1.5

a = -pi/6
b = pi/2 - pi/6

ou = 0
ov = 0

do
    oz = zoom
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput

    cls

    xu = 0
    xv = 0

    for vv=0 to 2*pi step dv
        v = vv + ov
        xu = xu xor 1
        for u=ou to 2*pi step du
            xu = xu xor 1

            x = cos(u)*cos(v)
            y = sin(u)*cos(v)
            z = sin(v)

            roty x,y,z,a
            rotx x,y,z,b

            'parallel
            sx = -1
            sy = -sx/0.707
            sz = -0.707*sy

            'perspective
            sx = 0 
            sy = -1
            sz = 0 

            if (x*sx + y*sy + z*sz) < 0.1 then
                proj (rr + r*cos(v))*cos(u), (rr + r*cos(v))*sin(u), r*sin(v)
                x1 = sw/2 + zoom*p
                y1 = sh/2 - zoom*q
                'pset (sw/2 + zoom*p, sh/2 - zoom*q)

                proj (rr + r*cos(v))*cos(u + du), (rr + r*cos(v))*sin(u + du), r*sin(v)
                x2 = sw/2 + zoom*p
                y2 = sh/2 - zoom*q
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj (rr + r*cos(v + dv))*cos(u + du), (rr + r*cos(v + dv))*sin(u + du), r*sin(v + dv)
                x3 = sw/2 + zoom*p
                y3 = sh/2 - zoom*q
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj (rr + r*cos(v + dv))*cos(u ), (rr + r*cos(v + dv))*sin(u ), r*sin(v + dv)
                x4 = sw/2 + zoom*p
                y4 = sh/2 - zoom*q
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                'proj (rr + r*cos(v))*cos(u), (rr + r*cos(v))*sin(u), r*sin(v)
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                if xu then
                    c = 255 - 50*z
                    if v > 0.3*2*pi then
                        c = c - 50*(2*pi - v)
                    end if
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
                else
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
                end if
            end if
        next
    next

    ov = ov + dv/30
    if ov >= 59*dv/30 then ov = 0

   
    _limit 30
    _display
loop until _keyhit = 27
sleep
system

sub proj(x, y, z)
    'parallel
    'p = x + 0.707*y
    'q = z + 0.707*y

    roty x,y,z,a
    rotx x,y,z,b

    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(x, y, z, a)
    xx = x
    yy = y*cos(a) - z*sin(a)
    zz = y*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub roty(x, y, z, a)
    xx = x*cos(a) + z*sin(a)
    yy = y
    zz = -x*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(x, y, z, a)
    xx = x*cos(a) - y*sin(a)
    yy = x*sin(a) + y*cos(a)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

4D cube
Code: (Select All)
dim shared pi, p, q, d, z0, t, f, sw, sh

sw = 800
sh = 600
d = 700
z0 = 1500
pi = 4*atn(1)


dim x(16), y(16), z(16), w(16)
x(0)=0-1: y(0) =0-1: z(0) =0-1: w(0) = 0-1
x(1)=  1: y(1) =0-1: z(1) =0-1: w(1) = 0-1
x(2)=  1: y(2) =  1: z(2) =0-1: w(2) = 0-1
x(3)=0-1: y(3) =  1: z(3) =0-1: w(3) = 0-1

x(4)=0-1: y(4) =0-1: z(4) =1: w(4) = 0-1
x(5)=  1: y(5) =0-1: z(5) =1: w(5) = 0-1
x(6)=  1: y(6) =  1: z(6) =1: w(6) = 0-1
x(7)=0-1: y(7) =  1: z(7) =1: w(7) = 0-1

x( 8)=0-1: y( 8) =0-1: z( 8) =0-1: w( 8) = 1
x( 9)=  1: y( 9) =0-1: z( 9) =0-1: w( 9) = 1
x(10)=  1: y(10) =  1: z(10) =0-1: w(10) = 1
x(11)=0-1: y(11) =  1: z(11) =0-1: w(11) = 1

x(12)=0-1: y(12) =0-1: z(12) =1: w(12) = 1
x(13)=  1: y(13) =0-1: z(13) =1: w(13) = 1
x(14)=  1: y(14) =  1: z(14) =1: w(14) = 1
x(15)=0-1: y(15) =  1: z(15) =1: w(15) = 1


screen _newimage(sw, sh, 32)

do
for t = 0 to 8*pi step 0.01
    cls

    f=0
    i = 0
    proj x(i), y(i), z(i), w(i)
    preset (p, q)
    for i=1 to 3
        proj x(i), y(i), z(i), w(i)
        line -(p, q)
    next
    i = 0
    proj x(i), y(i), z(i), w(i)
    line -(p, q)

    i = 4
    proj x(i), y(i), z(i), w(i)
    preset (p, q)
    for i=4 to 7
        proj x(i), y(i), z(i), w(i)
        line -(p, q)
    next
    i = 4
    proj x(i), y(i), z(i), w(i)
    line -(p, q)

    for i=0 to 3
        proj x(i), y(i), z(i), w(i)
        preset (p, q)
        proj x(i+4), y(i+4), z(i+4), w(i+4)
        line -(p, q)
    next

    f = 1
    k = 8
    i = 0+k
    proj x(i), y(i), z(i), w(i)
    preset (p, q), _rgb(255,0,0)
    for i=1+k to 3+k
        proj x(i), y(i), z(i), w(i)
        line -(p, q), _rgb(255,0,0)
    next
    i = 0+k
    proj x(i), y(i), z(i), w(i)
    line -(p, q), _rgb(255,0,0)

    i = 4+k
    proj x(i), y(i), z(i), w(i)
    preset (p, q), _rgb(255,0,0)
    for i=4+k to 7+k
        proj x(i), y(i), z(i), w(i)
        line -(p, q), _rgb(255,0,0)
    next
    i = 4+k
    proj x(i), y(i), z(i), w(i)
    line -(p, q), _rgb(255,0,0)

    for i=0+k to 3+k
        proj x(i), y(i), z(i), w(i)
        preset (p, q), _rgb(255,0,0)
        proj x(i+4), y(i+4), z(i+4), w(i+4)
        line -(p, q), _rgb(255,0,0)
    next

    for i=0 to 7
        f = 0
        proj x(i), y(i), z(i), w(i)
        preset (p, q)
        f = 1
        proj x(i+k), y(i+k), z(i+k), w(i+k)
        line -(p, q)
    next

    _limit 50
next
loop

sub proj(x, y, z, w)
    xx = x
    yy = y*cos(t) - w*sin(t)
    zz = z
    ww = y*sin(t) + w*cos(t)

    d2 = 3
    w0 = 3
    xx = xx*d2/(w0 + ww)
    yy = yy*d2/(w0 + ww)
    zz = zz*d2/(w0 + ww)

    xxx = xx*cos(t) - zz*sin(t)
    zzz = xx*sin(t) + zz*cos(t)
    xx = xxx
    zz = zzz

    a = pi/3
    b = pi/12
    xxx = xx*cos(a) - yy*sin(a)
    yyy = xx*sin(a) + yy*cos(a)
    xx = xxx
    yy = yyy

    yyy = yy*cos(b) - zz*sin(b)
    zzz = yy*sin(b) + zz*cos(b)
    yy = yyy
    zz = zzz

    xx = 100*xx
    yy = 100*yy
    zz = 100*zz

    p = sw/2 + 2*xx*d/(yy + z0)
    q = sh/2 - 2*zz*d/(yy + z0)
end sub

clifford torus
Code: (Select All)
dim shared pi, p, q, d, z0, t, f, sw, sh

sw = 800
sh = 600
d = 700
z0 = 1500
pi = 4*atn(1)

screen _newimage(sw, sh, 32)

sv = 2*pi/30
su = 2*pi/10

'do
for t = 0 to 2*pi step 0.01
    cls
    u = 0
    for v=0 to 2*pi+sv step sv
        x = cos(u)
        y = sin(u)
        z = cos(v)
        w = sin(v)
     
        proj x, y, z, w
        preset (p, q)
     
        for u=0 to 2*pi+su step su
            x = cos(u)
            y = sin(u)
            z = cos(v)
            w = sin(v)
     
            proj x, y, z, w
            line -(p, q)
        next
    next
 
    for u=0 to 2*pi+su step su
        x = cos(u)
        y = sin(u)
        z = cos(v)
        w = sin(v)
     
        proj x, y, z, w
        preset (p, q), _rgb(255,0,0)
     
        for v=0 to 2*pi+sv step sv
            x = cos(u)
            y = sin(u)
            z = cos(v)
            w = sin(v)
     
            proj x, y, z, w
            line -(p, q), _rgb(255,0,0)
        next
    next
 

    _limit 50
next
'loop

sub proj(x, y, z, w)
    xx = x
    yy = y*cos(t) - w*sin(t)
    zz = z
    ww = y*sin(t) + w*cos(t)

    d2 = 3
    w0 = 3
    xx = xx*d2/(w0 + ww)
    yy = yy*d2/(w0 + ww)
    zz = zz*d2/(w0 + ww)
 
    xxx = xx*cos(t) - zz*sin(t)
    zzz = xx*sin(t) + zz*cos(t)
    xx = xxx
    zz = zzz
 
    a = pi/12
    b = pi/3
    xxx = xx*cos(a) - yy*sin(a)
    yyy = xx*sin(a) + yy*cos(a)
    xx = xxx
    yy = yyy

    yyy = yy*cos(b) - zz*sin(b)
    zzz = yy*sin(b) + zz*cos(b)
    yy = yyy
    zz = zzz
 
    xx = 200*xx
    yy = 200*yy
    zz = 200*zz

    p = sw/2 + 2*xx*d/(yy + z0)
    q = sh/2 - 2*zz*d/(yy + z0)
end sub
Reply
#55
(10-11-2024, 12:16 AM)vince Wrote: 3D junk

mobius
Code: (Select All)
dim shared pi, p, q, a, b, x, y, z, t

zoom = 450

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

pi = 4*atn(1)
du = 2*pi/100
dv = pi/20

a = 0
b = pi/4

ou = 0
ov = 0

do
    for t = 0 to 0.12 step 0.01
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput

    cls

    xu = 0
    xv = 0

    for u=2*pi+pi/2 +du to pi step -du
        xu = xu xor 1
        for v=-pi to pi step dv
            xu = xu xor 1

            nx = sin(v)
            ny = -cos(v)
            nz = u

            roty a
            rotx b

            'parallel
            sx = -1
            sy = -sx/0.707
            sz = -0.707*sy

            'perspective
            sx = 0 
            sy = -1
            sz = 0 

            'if (nx*sx + ny*sy + nz*sz) < 0 then
                f u, v
                proj
                x1 = sw/2 + zoom*p - 200
                y1 = sh/2 - zoom*q
                'pset (x1, y1)

                f u + du, v
                proj
                x2 = sw/2 + zoom*p - 200
                y2 = sh/2 - zoom*q
                'line -(x2, y2)

                f u + du, v + dv
                proj
                x3 = sw/2 + zoom*p - 200
                y3 = sh/2 - zoom*q
                'line -(x3, y3)

                f u, v + dv
                proj
                x4 = sw/2 + zoom*p - 200
                y4 = sh/2 - zoom*q
                'line -(x4, y4)

                'line -(x1, y1)

                if xu then
                    c = 255 - 420*((u - pi)/(2*pi + pi/2))^2
                '    if v > 0.3*2*pi then
                '        c = c - 50*(2*pi - v)
                '    end if
                '    c = 255
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
                else
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
                end if
            'end if
        next


    next

    _limit 100
    _display
    next
loop until _keyhit = 27
sleep
system


sub f(u, v)
    'x = u*cos(v)
    'y = u*sin(v)
    'z = v

    x = (1 + 0.5*v*cos(0.5*(u - t)))*cos(u - t)
    y = (1 + 0.5*v*cos(0.5*(u - t)))*sin(u - t)
    z = 0.5*v*sin(0.5*(u - t))
end sub

sub proj
    'parallel
    'p = x + 0.707*y
    'q = z + 0.707*y

    roty a
    rotx b

    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(u)
    xx = x
    yy = y*cos(u) - z*sin(u)
    zz = y*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub roty(u)
    xx = x*cos(u) + z*sin(u)
    yy = y
    zz =-x*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(u)
    xx = x*cos(u) - y*sin(u)
    yy = x*sin(u) + y*cos(u)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

helicoid
Code: (Select All)
dim shared pi, p, q, a, b, x, y, z, t, tt

zoom = 80

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

pi = 4*atn(1)
du = 2*pi/20
dv = 2*pi/20

a = 0
b = 0'pi/4

tt = 0

do 
    tt = tt + 0.01
    t = 0.2*sin(tt)

    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput

    cls

    s = 0
    for v=-2*pi to 2*pi step dv
        s = s xor 1
        for u=-3*pi to 3*pi step du
            s = s xor 1

            nx = sin(v)
            ny = -cos(v)
            nz = u

            roty a
            rotx b

            'parallel
            sx = -1
            sy = -sx/0.707
            sz = -0.707*sy

            'perspective
            sx = 0 
            sy = -1
            sz = 0 

            'if (nx*sx + ny*sy + nz*sz) < 0 then
                f u, v
                proj
                x1 = sw/2 + zoom*p
                y1 = sh/2 - zoom*q
                'pset (x1, y1)

                f u + du, v
                proj
                x2 = sw/2 + zoom*p
                y2 = sh/2 - zoom*q
                'line -(x2, y2)

                f u + du, v + dv
                proj
                x3 = sw/2 + zoom*p
                y3 = sh/2 - zoom*q
                'line -(x3, y3)

                f u, v + dv
                proj
                x4 = sw/2 + zoom*p
                y4 = sh/2 - zoom*q
                'line -(x4, y4)

                'line -(x1, y1)

                if s then
                    c = 255 '- 20*y
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
                else
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
                end if
            'end if
        next
    next

    _limit 30
    _display
loop until _keyhit = 27
sleep
system


sub f(u, v)
    x = u*cos(v*t + tt)
    y = u*sin(v*t + tt)
    z = v

    'x = (1 + 0.5*v*cos(0.5*(u - t)))*cos(u - t)
    'y = (1 + 0.5*v*cos(0.5*(u - t)))*sin(u - t)
    'z = 0.5*v*sin(0.5*(u - t))
end sub

sub proj
    'parallel
    'p = x + 0.707*y
    'q = z + 0.707*y

    roty a
    rotx b

    p = x*10/(10 + y)
    q = z*10/(10 + y)
end sub

sub rotx(u)
    xx = x
    yy = y*cos(u) - z*sin(u)
    zz = y*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub roty(u)
    xx = x*cos(u) + z*sin(u)
    yy = y
    zz =-x*sin(u) + z*cos(u)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(u)
    xx = x*cos(u) - y*sin(u)
    yy = x*sin(u) + y*cos(u)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

torus
Code: (Select All)
dim shared pi, p, q, a, b

zoom = 150

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

pi = 4*atn(1)
du = 2*pi/80
dv = pi/15

rr = 2.0
r = 1.5

a = -pi/6
b = pi/2 - pi/6

ou = 0
ov = 0

do
    oz = zoom
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput

    cls

    xu = 0
    xv = 0

    for vv=0 to 2*pi step dv
        v = vv + ov
        xu = xu xor 1
        for u=ou to 2*pi step du
            xu = xu xor 1

            x = cos(u)*cos(v)
            y = sin(u)*cos(v)
            z = sin(v)

            roty x,y,z,a
            rotx x,y,z,b

            'parallel
            sx = -1
            sy = -sx/0.707
            sz = -0.707*sy

            'perspective
            sx = 0 
            sy = -1
            sz = 0 

            if (x*sx + y*sy + z*sz) < 0.1 then
                proj (rr + r*cos(v))*cos(u), (rr + r*cos(v))*sin(u), r*sin(v)
                x1 = sw/2 + zoom*p
                y1 = sh/2 - zoom*q
                'pset (sw/2 + zoom*p, sh/2 - zoom*q)

                proj (rr + r*cos(v))*cos(u + du), (rr + r*cos(v))*sin(u + du), r*sin(v)
                x2 = sw/2 + zoom*p
                y2 = sh/2 - zoom*q
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj (rr + r*cos(v + dv))*cos(u + du), (rr + r*cos(v + dv))*sin(u + du), r*sin(v + dv)
                x3 = sw/2 + zoom*p
                y3 = sh/2 - zoom*q
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj (rr + r*cos(v + dv))*cos(u ), (rr + r*cos(v + dv))*sin(u ), r*sin(v + dv)
                x4 = sw/2 + zoom*p
                y4 = sh/2 - zoom*q
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                'proj (rr + r*cos(v))*cos(u), (rr + r*cos(v))*sin(u), r*sin(v)
                'line -(sw/2 + zoom*p, sh/2 - zoom*q)

                if xu then
                    c = 255 - 50*z
                    if v > 0.3*2*pi then
                        c = c - 50*(2*pi - v)
                    end if
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
                else
                    FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
                    FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
                end if
            end if
        next
    next

    ov = ov + dv/30
    if ov >= 59*dv/30 then ov = 0

   
    _limit 30
    _display
loop until _keyhit = 27
sleep
system

sub proj(x, y, z)
    'parallel
    'p = x + 0.707*y
    'q = z + 0.707*y

    roty x,y,z,a
    rotx x,y,z,b

    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(x, y, z, a)
    xx = x
    yy = y*cos(a) - z*sin(a)
    zz = y*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub roty(x, y, z, a)
    xx = x*cos(a) + z*sin(a)
    yy = y
    zz = -x*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(x, y, z, a)
    xx = x*cos(a) - y*sin(a)
    yy = x*sin(a) + y*cos(a)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

4D cube
Code: (Select All)
dim shared pi, p, q, d, z0, t, f, sw, sh

sw = 800
sh = 600
d = 700
z0 = 1500
pi = 4*atn(1)


dim x(16), y(16), z(16), w(16)
x(0)=0-1: y(0) =0-1: z(0) =0-1: w(0) = 0-1
x(1)=  1: y(1) =0-1: z(1) =0-1: w(1) = 0-1
x(2)=  1: y(2) =  1: z(2) =0-1: w(2) = 0-1
x(3)=0-1: y(3) =  1: z(3) =0-1: w(3) = 0-1

x(4)=0-1: y(4) =0-1: z(4) =1: w(4) = 0-1
x(5)=  1: y(5) =0-1: z(5) =1: w(5) = 0-1
x(6)=  1: y(6) =  1: z(6) =1: w(6) = 0-1
x(7)=0-1: y(7) =  1: z(7) =1: w(7) = 0-1

x( 8)=0-1: y( 8) =0-1: z( 8) =0-1: w( 8) = 1
x( 9)=  1: y( 9) =0-1: z( 9) =0-1: w( 9) = 1
x(10)=  1: y(10) =  1: z(10) =0-1: w(10) = 1
x(11)=0-1: y(11) =  1: z(11) =0-1: w(11) = 1

x(12)=0-1: y(12) =0-1: z(12) =1: w(12) = 1
x(13)=  1: y(13) =0-1: z(13) =1: w(13) = 1
x(14)=  1: y(14) =  1: z(14) =1: w(14) = 1
x(15)=0-1: y(15) =  1: z(15) =1: w(15) = 1


screen _newimage(sw, sh)

do
for t = 0 to 8*pi step 0.01
    cls

    f=0
    i = 0
    proj x(i), y(i), z(i), w(i)
    preset (p, q)
    for i=1 to 3
        proj x(i), y(i), z(i), w(i)
        line -(p, q)
    next
    i = 0
    proj x(i), y(i), z(i), w(i)
    line -(p, q)

    i = 4
    proj x(i), y(i), z(i), w(i)
    preset (p, q)
    for i=4 to 7
        proj x(i), y(i), z(i), w(i)
        line -(p, q)
    next
    i = 4
    proj x(i), y(i), z(i), w(i)
    line -(p, q)

    for i=0 to 3
        proj x(i), y(i), z(i), w(i)
        preset (p, q)
        proj x(i+4), y(i+4), z(i+4), w(i+4)
        line -(p, q)
    next

    f = 1
    k = 8
    i = 0+k
    proj x(i), y(i), z(i), w(i)
    preset (p, q), _rgb(255,0,0)
    for i=1+k to 3+k
        proj x(i), y(i), z(i), w(i)
        line -(p, q), _rgb(255,0,0)
    next
    i = 0+k
    proj x(i), y(i), z(i), w(i)
    line -(p, q), _rgb(255,0,0)

    i = 4+k
    proj x(i), y(i), z(i), w(i)
    preset (p, q), _rgb(255,0,0)
    for i=4+k to 7+k
        proj x(i), y(i), z(i), w(i)
        line -(p, q), _rgb(255,0,0)
    next
    i = 4+k
    proj x(i), y(i), z(i), w(i)
    line -(p, q), _rgb(255,0,0)

    for i=0+k to 3+k
        proj x(i), y(i), z(i), w(i)
        preset (p, q), _rgb(255,0,0)
        proj x(i+4), y(i+4), z(i+4), w(i+4)
        line -(p, q), _rgb(255,0,0)
    next

    for i=0 to 7
        f = 0
        proj x(i), y(i), z(i), w(i)
        preset (p, q)
        f = 1
        proj x(i+k), y(i+k), z(i+k), w(i+k)
        line -(p, q)
    next

    _limit 50
next
loop

sub proj(x, y, z, w)
    xx = x
    yy = y*cos(t) - w*sin(t)
    zz = z
    ww = y*sin(t) + w*cos(t)

    d2 = 3
    w0 = 3
    xx = xx*d2/(w0 + ww)
    yy = yy*d2/(w0 + ww)
    zz = zz*d2/(w0 + ww)

    xxx = xx*cos(t) - zz*sin(t)
    zzz = xx*sin(t) + zz*cos(t)
    xx = xxx
    zz = zzz

    a = pi/3
    b = pi/12
    xxx = xx*cos(a) - yy*sin(a)
    yyy = xx*sin(a) + yy*cos(a)
    xx = xxx
    yy = yyy

    yyy = yy*cos(b) - zz*sin(b)
    zzz = yy*sin(b) + zz*cos(b)
    yy = yyy
    zz = zzz

    xx = 100*xx
    yy = 100*yy
    zz = 100*zz

    p = sw/2 + 2*xx*d/(yy + z0)
    q = sh/2 - 2*zz*d/(yy + z0)
end sub

clifford torus
Code: (Select All)
dim shared pi, p, q, d, z0, t, f, sw, sh

sw = 800
sh = 600
d = 700
z0 = 1500
pi = 4*atn(1)

screen _newimage(sw, sh, 32)

sv = 2*pi/30
su = 2*pi/10

'do
for t = 0 to 2*pi step 0.01
    cls
    u = 0
    for v=0 to 2*pi+sv step sv
        x = cos(u)
        y = sin(u)
        z = cos(v)
        w = sin(v)
     
        proj x, y, z, w
        preset (p, q)
     
        for u=0 to 2*pi+su step su
            x = cos(u)
            y = sin(u)
            z = cos(v)
            w = sin(v)
     
            proj x, y, z, w
            line -(p, q)
        next
    next
 
    for u=0 to 2*pi+su step su
        x = cos(u)
        y = sin(u)
        z = cos(v)
        w = sin(v)
     
        proj x, y, z, w
        preset (p, q), _rgb(255,0,0)
     
        for v=0 to 2*pi+sv step sv
            x = cos(u)
            y = sin(u)
            z = cos(v)
            w = sin(v)
     
            proj x, y, z, w
            line -(p, q), _rgb(255,0,0)
        next
    next
 

    _limit 50
next
'loop

sub proj(x, y, z, w)
    xx = x
    yy = y*cos(t) - w*sin(t)
    zz = z
    ww = y*sin(t) + w*cos(t)

    d2 = 3
    w0 = 3
    xx = xx*d2/(w0 + ww)
    yy = yy*d2/(w0 + ww)
    zz = zz*d2/(w0 + ww)
 
    xxx = xx*cos(t) - zz*sin(t)
    zzz = xx*sin(t) + zz*cos(t)
    xx = xxx
    zz = zzz
 
    a = pi/12
    b = pi/3
    xxx = xx*cos(a) - yy*sin(a)
    yyy = xx*sin(a) + yy*cos(a)
    xx = xxx
    yy = yyy

    yyy = yy*cos(b) - zz*sin(b)
    zzz = yy*sin(b) + zz*cos(b)
    yy = yyy
    zz = zzz
 
    xx = 200*xx
    yy = 200*yy
    zz = 200*zz

    p = sw/2 + 2*xx*d/(yy + z0)
    q = sh/2 - 2*zz*d/(yy + z0)
end sub

All fascinating images, but the 4d Cube one gives error at line 41 for me (p and q  not defined)
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#56
thanks Phil, hopefully fixed now, and i appreciate the code backup
Reply
#57
Brilliant (as usual)... I never cease to be amazed by what you people can achieve with a bit of math and a lot of imagination!
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#58
Coaxial rotor (arrow keys)

it would seem having the tail rotor gives better 'left right' angle control at the expense of some wasted power, while the coaxial will have terrible 'left right' angle control (hard to maneuver) but better 'up down' angle control and more power for lift and propulsion. with the tail rotor, a quick angle change is available at any position, the coaxials tend to have some extra wings on the back and probably have to really bank into every turn but with a lot more power

i wonder how do they actually mismatch rotor speed on these, maybe can slow down or speed up either one, or rather speed up and slow just one?
Reply
#59
Nice!
b = b + ...
Reply




Users browsing this thread: 20 Guest(s)