09-15-2024, 09:24 AM
if this isn't a mod
Code: (Select All)
dim shared pi, p, q, a, b
zoom = 250
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