+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Vince's Corner Takeout (/showthread.php?tid=270)
RE: Vince's Corner Takeout - vince - 10-07-2024
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
RE: Vince's Corner Takeout - bplus - 10-07-2024
Nice looks like a start to a calligraphy app.
RE: Vince's Corner Takeout - vince - 10-11-2024
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)RE: Vince's Corner Takeout - vince - 10-11-2024
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 Subhelicoid
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 Subtorus
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 Sub4D 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 subclifford 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 subRE: Vince's Corner Takeout - PhilOfPerth - 10-11-2024
(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)
RE: Vince's Corner Takeout - vince - 10-11-2024
thanks Phil, hopefully fixed now, and i appreciate the code backup
RE: Vince's Corner Takeout - PhilOfPerth - 10-11-2024
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!
RE: Vince's Corner Takeout - vince - 10-15-2024
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?
RE: Vince's Corner Takeout - bplus - 10-15-2024
Nice!