Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Vince's Corner Takeout
#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


Messages In This Thread
Vince's Corner Takeout - by bplus - 04-29-2022, 02:12 PM
RE: Vince's Corner Takeout - by vince - 04-29-2022, 09:34 PM
RE: Vince's Corner Takeout - by vince - 05-02-2022, 03:10 AM
RE: Vince's Corner Takeout - by bplus - 05-02-2022, 04:25 AM
RE: Vince's Corner Takeout - by vince - 05-02-2022, 11:16 PM
RE: Vince's Corner Takeout - by vince - 05-03-2022, 01:10 AM
RE: Vince's Corner Takeout - by bplus - 05-03-2022, 01:15 AM
RE: Vince's Corner Takeout - by vince - 05-03-2022, 04:26 AM
RE: Vince's Corner Takeout - by bplus - 05-03-2022, 03:32 PM
RE: Vince's Corner Takeout - by vince - 05-10-2022, 03:41 AM
RE: Vince's Corner Takeout - by vince - 05-10-2022, 03:57 AM
RE: Vince's Corner Takeout - by dcromley - 05-10-2022, 02:57 PM
RE: Vince's Corner Takeout - by vince - 05-10-2022, 08:14 PM
RE: Vince's Corner Takeout - by SMcNeill - 05-10-2022, 02:59 PM
RE: Vince's Corner Takeout - by vince - 05-11-2022, 01:13 AM
RE: Vince's Corner Takeout - by dcromley - 05-11-2022, 01:58 AM
RE: Vince's Corner Takeout - by vince - 06-01-2022, 09:05 AM
RE: Vince's Corner Takeout - by vince - 08-11-2022, 02:51 AM
RE: Vince's Corner Takeout - by bplus - 06-03-2022, 02:47 PM
RE: Vince's Corner Takeout - by triggered - 06-04-2022, 02:00 AM
RE: Vince's Corner Takeout - by vince - 06-07-2022, 02:02 AM
RE: Vince's Corner Takeout - by bplus - 06-07-2022, 02:15 AM
RE: Vince's Corner Takeout - by vince - 07-13-2022, 05:23 AM
RE: Vince's Corner Takeout - by BSpinoza - 07-14-2022, 04:54 AM
RE: Vince's Corner Takeout - by bplus - 07-14-2022, 04:35 PM
RE: Vince's Corner Takeout - by aurel - 08-11-2022, 01:02 PM
RE: Vince's Corner Takeout - by bplus - 08-11-2022, 04:22 PM
RE: Vince's Corner Takeout - by aurel - 08-11-2022, 05:33 PM
RE: Vince's Corner Takeout - by BSpinoza - 08-12-2022, 03:44 AM
RE: Vince's Corner Takeout - by vince - 08-11-2022, 08:42 PM
RE: Vince's Corner Takeout - by vince - 08-19-2022, 05:00 AM
RE: Vince's Corner Takeout - by bplus - 08-19-2022, 06:33 PM
RE: Vince's Corner Takeout - by vince - 08-23-2022, 10:04 PM
RE: Vince's Corner Takeout - by vince - 11-04-2022, 01:48 AM
RE: Vince's Corner Takeout - by vince - 03-31-2023, 11:07 PM
RE: Vince's Corner Takeout - by vince - 09-18-2023, 11:45 PM
RE: Vince's Corner Takeout - by Dav - 09-19-2023, 12:54 AM
RE: Vince's Corner Takeout - by bplus - 09-19-2023, 01:37 AM
RE: Vince's Corner Takeout - by GareBear - 09-19-2023, 03:56 PM
RE: Vince's Corner Takeout - by bplus - 09-19-2023, 04:47 PM
RE: Vince's Corner Takeout - by vince - 09-19-2023, 06:54 PM
RE: Vince's Corner Takeout - by bplus - 09-19-2023, 09:02 PM
RE: Vince's Corner Takeout - by vince - 01-13-2024, 07:15 PM
RE: Vince's Corner Takeout - by bplus - 01-13-2024, 07:59 PM
RE: Vince's Corner Takeout - by GareBear - 01-13-2024, 10:54 PM
RE: Vince's Corner Takeout - by vince - 02-16-2024, 04:01 AM
RE: Vince's Corner Takeout - by bplus - 02-16-2024, 02:27 PM
RE: Vince's Corner Takeout - by vince - 02-16-2024, 07:16 PM
RE: Vince's Corner Takeout - by Sprezzo - 02-17-2024, 03:04 AM
RE: Vince's Corner Takeout - by bplus - 02-17-2024, 02:44 PM
RE: Vince's Corner Takeout - by vince - 10-07-2024, 08:11 AM
RE: Vince's Corner Takeout - by bplus - 10-07-2024, 01:32 PM
RE: Vince's Corner Takeout - by vince - 10-11-2024, 12:05 AM
RE: Vince's Corner Takeout - by vince - 10-11-2024, 12:16 AM
RE: Vince's Corner Takeout - by PhilOfPerth - 10-11-2024, 03:51 AM
RE: Vince's Corner Takeout - by vince - 10-11-2024, 07:55 PM
RE: Vince's Corner Takeout - by PhilOfPerth - 10-11-2024, 11:30 PM
RE: Vince's Corner Takeout - by vince - 10-15-2024, 10:54 AM
RE: Vince's Corner Takeout - by bplus - 10-15-2024, 01:40 PM



Users browsing this thread: 23 Guest(s)