10-11-2024, 03:51 AM
(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.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Please visit my Website at: http://oldendayskids.blogspot.com/