Posts: 4,129
Threads: 189
Joined: Apr 2022
Reputation:
248
Nice looks like a start to a calligraphy app. 
b = b + ...
Posts: 312
Threads: 19
Joined: Apr 2022
Reputation:
58
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)
Posts: 312
Threads: 19
Joined: Apr 2022
Reputation:
58
10-11-2024, 12:16 AM
(This post was last modified: 10-11-2024, 07:54 PM by vince.)
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
Posts: 687
Threads: 105
Joined: Apr 2022
Reputation:
25
(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)
Posts: 312
Threads: 19
Joined: Apr 2022
Reputation:
58
thanks Phil, hopefully fixed now, and i appreciate the code backup
Posts: 687
Threads: 105
Joined: Apr 2022
Reputation:
25
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!
Posts: 312
Threads: 19
Joined: Apr 2022
Reputation:
58
10-15-2024, 10:54 AM
(This post was last modified: 10-15-2024, 11:59 AM by vince.)
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?
Posts: 4,129
Threads: 189
Joined: Apr 2022
Reputation:
248
Posts: 312
Threads: 19
Joined: Apr 2022
Reputation:
58
linked lists throwaway
Code: (Select All)
defint a-z
type nodeType
str as _mem
strLen as integer
'you can add more data to store per node here
n as _mem
p as _mem
end type
type listType
head as _mem
tail as _mem
end type
screen 0
dim new as listType
dim cur as _mem
dim temp as _mem
newList new
'insert garbage
addNodeNext temp, "test1", new.head
addNodeNext temp, "test2", temp
addNodeNext temp, "test3", temp
addNodeNext temp, "test4", temp
addNodePrev temp, "testa", new.tail
addNodePrev temp, "estb", temp
addNodePrev temp, "", temp
addNodePrev temp, "td", temp
printList new
nextNode cur, new.head
cx = 1
cy = 1
do
cls
locate 1,1
printList new
locate cy,cx
color 0,7
print chr$(screen(cy,cx))
color 7,0
do
k$ = inkey$
loop until len(k$)>0
select case k$
case chr$(13) 'enter
if cy = 1 and cx = 1 then
addNodePrev cur, "", cur
elseif -1 then
s$ = readNode$(cur)
ss$ = right$(s$, len(s$)-cx+1)
s$ = left$(s$, cx-1)
writeNode cur, s$
addNodeNext cur, ss$, cur
cy = cy + 1
cx = 1
end if
case chr$(8) 'backspace
if cx = 1 then
if cy > 1 then
s$ = readNode$(cur)
temp = cur
prevNode cur, cur
ss$ = readNode$(cur)
cx = len(ss$) + 1
writeNode cur, ss$ + s$
cy = cy-1
rmNode temp
end if
elseif cx > 1 then
cx = cx - 1
s$ = readNode$(cur)
ss$ = left$(s$, cx-1) + right$(s$, len(s$)-cx)
writeNode cur, ss$
end if
case chr$(0)+"K" 'left
if cx > 1 then cx = cx - 1
case chr$(0)+"M" 'right
s$ = readNode$(cur)
if cx <= len(s$) then cx = cx + 1
case chr$(0)+"H" 'up
s$ = readNode$(cur)
if cy > 1 then
prevNode cur, cur
s$ = readNode$(cur)
if cx > len(s$) then cx = len(s$) + 1
cy = cy - 1
end if
case chr$(0)+"P" 'down
nextNode temp, cur
if temp.offset <> new.tail.offset then
cur = temp
s$ = readNode$(cur)
if cx > len(s$) then cx = len(s$) + 1
cy = cy + 1
end if
case chr$(32) to chr$(128)
s$ = readNode$(cur)
s$ = mid$(s$,1,cx-1) + k$ + right$(s$, len(s$)-cx+1)
writeNode cur, s$
cx = cx + 1
end select
loop until k$ = chr$(27)
system
sub addNodeNext (new as _mem, s$, cur as _mem)
dim node as nodeType
dim temp as _mem
dim n as _mem
temp = _memnew(len(node))
nextNode n, cur
node.strLen = len(s$)
if node.strLen > 0 then
node.str = _memnew(len(s$))
_memput node.str, node.str.offset, s$
end if
node.n = n
node.p = cur
_memput temp, temp.offset, node
node = _memget(cur, cur.offset, nodeType)
node.n = temp
_memput cur, cur.offset, node
node = _memget(n, n.offset, nodeType)
node.p = temp
_memput n, n.offset, node
new = temp
end sub
sub addNodePrev (new as _mem, s$, cur as _mem)
dim node as nodeType
dim temp as _mem
dim p as _mem
temp = _memnew(len(node))
prevNode p, cur
node.strLen = len(s$)
if node.strLen > 0 then
node.str = _memnew(len(s$))
_memput node.str, node.str.offset, s$
end if
node.n = cur
node.p = p
_memput temp, temp.offset, node
node = _memget(cur, cur.offset, nodeType)
node.p = temp
_memput cur, cur.offset, node
node = _memget(p, p.offset, nodeType)
node.n = temp
_memput p, p.offset, node
new = temp
end sub
sub rmNode (cur as _mem)
dim node as nodeType
dim n as _mem
dim p as _mem
'remove the string first
node = _memget(cur, cur.offset, nodeType)
if node.strLen > 0 then
_memfree node.str
end if
nextNode n, cur
prevNode p, cur
node = _memget(p, p.offset, nodeType)
node.n = n
_memput p, p.offset, node
node = _memget(n, n.offset, nodeType)
node.p = p
_memput n, n.offset, node
_memfree cur
end sub
sub nextNode (new as _mem, old as _mem)
dim node as nodeType
node = _memget(old, old.offset, nodeType)
new = node.n
end sub
sub prevNode (new as _mem, old as _mem)
dim node as nodeType
node = _memget(old, old.offset, nodeType)
new = node.p
end sub
function readNode$ (cur as _mem)
dim node as nodeType
node = _memget(cur, cur.offset, nodeType)
if node.strLen = 0 then
readNode$ = ""
exit function
end if
s$ = string$(node.strLen, 0)
_memget node.str, node.str.offset, s$
readNode$ = s$
end sub
sub writeNode (cur as _mem, s$)
dim node as nodeType
'remove old string, freeing memory
node = _memget(cur, cur.offset, nodeType)
if node.strLen > 0 then _memfree node.str
'add new string
node.strLen = len(s$)
if node.strLen > 0 then
node.str = _memnew(len(s$))
_memput node.str, node.str.offset, s$
end if
_memput cur, cur.offset, node
end sub
sub newList (new as listType)
dim node as nodeType
new.head = _memnew(len(node))
new.tail = _memnew(len(node))
s$ = "head"
node.strLen = len(s$)
node.str = _memnew(len(s$))
node.n = new.tail
node.p = new.tail
_memput node.str, node.str.offset, s$
_memput new.head, new.head.offset, node
s$ = "tail"
node.strLen = len(s$)
node.str = _memnew(len(s$))
node.n = new.head
node.p = new.head
_memput node.str, node.str.offset, s$
_memput new.tail, new.tail.offset, node
end sub
sub printList (cur as listType)
dim temp as _mem
nextNode temp, cur.head
do
if temp.offset = cur.tail.offset then exit do
print readNode$ (temp)
nextNode temp, temp
loop
end sub
sub rmList (cur as listType)
dim temp as _mem
dim temp2 as _mem
nextNode temp, cur.head
do
if temp.offset = cur.tail.offset then exit do
temp2 = temp
nextNode temp, temp2
rmNode temp2
loop
rmNode cur.head
rmNode cur.tail
end sub
Posts: 4,129
Threads: 189
Joined: Apr 2022
Reputation:
248
+1 thanks looks interesting
b = b + ...
|
