Posts: 301
Threads: 16
Joined: Apr 2022
Reputation:
51
09-19-2023, 12:55 AM
(This post was last modified: 09-19-2023, 03:35 AM by vince.)
Posts: 272
Threads: 24
Joined: Apr 2022
Reputation:
59
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation:
45
Posts: 1,272
Threads: 119
Joined: Apr 2022
Reputation:
100
Are the galaxies rotating? Crazy cool effect.
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Posts: 301
Threads: 16
Joined: Apr 2022
Reputation:
51
(09-20-2023, 03:01 AM)TerryRitchie Wrote: Are the galaxies rotating? nah it's an illusion because the point clouds are generated randomly every frame but you can force them to rotate with this less than tasteful mod
Code: (Select All) const stars = 2000
const galaxies = 50
randomize timer
dim shared pi, d, zz, sw, sh, t
pi = 4*atn(1)
d = 700
zz = 2100
sw = _RESIZEWIDTH-5
sh = _RESIZEHEIGHT-5
type stype
x as double
y as double
z as double
end type
dim shared star(stars) as stype
type gtype
x as double
y as double
z as double
r as double
r1 as double
r2 as double
a1 as double
a2 as double
a3 as double
end type
dim shared galaxy(galaxies) as gtype
screen _newimage(sw, sh, 32)
dim as double i,x1,y1,z1,z0,r,r1,r2,a1,a2,a3
for i=0 to stars
star(i).x = 5000*rnd-2500
star(i).y = 5000*rnd-2500
star(i).z = 5000*rnd-2500
next
for i=0 to galaxies
galaxy(i).x = 4000*rnd-2000
galaxy(i).y = 4000*rnd-2000
galaxy(i).z = 4000*rnd-2000
galaxy(i).r = 150*rnd
galaxy(i).r1 = rnd
galaxy(i).r2 = rnd
galaxy(i).a1 = 2*pi*rnd
galaxy(i).a2 = 2*pi*rnd
galaxy(i).a3 = 4*pi*rnd - 2.5*pi*rnd
next
dim p, q
do
t = t + 1
cls
for i=0 to stars
star(i).z = star(i).z - 100
if star(i).z < 0 then
star(i).x = 4000*rnd-2000
star(i).y = 4000*rnd-2000
star(i).z = 4000*rnd-2000
end if
x1 = star(i).x
y1 = star(i).y
z1 = star(i).z
for z0 = 0 to 3
p = sw/2 + x1*d/(z1 + zz + z0*10)
q = sh/2 - y1*d/(z1 + zz + z0*10)
if p>0 and p<sw and q>0 and q<sh then
pset (p, q),_rgb(255 - 50*z0, 255 - 50*z0, 0)
end if
next
next
for i=0 to galaxies
galaxy(i).z = galaxy(i).z - 100
if galaxy(i).z < 0 then
galaxy(i).x = 4000*rnd-2000
galaxy(i).y = 4000*rnd-2000
galaxy(i).z = 4000*rnd+8000
galaxy(i).r = 20*rnd + 30
galaxy(i).r1 = rnd
galaxy(i).r2 = rnd
galaxy(i).a1 = 2*pi*rnd
galaxy(i).a2 = 2*pi*rnd
galaxy(i).a3 = 4*pi*rnd - 2.5*pi*rnd
end if
x1 = galaxy(i).x
y1 = galaxy(i).y
z1 = galaxy(i).z
r = galaxy(i).r
r1 = galaxy(i).r1
r2 = galaxy(i).r2
a1 = galaxy(i).a1
a2 = galaxy(i).a2
a3 = galaxy(i).a3
drawgalaxy x1, y1, z1, r, r1, r2, a1, a2, a3
next
_display
_limit 60
loop until _keyhit = 27
sleep
system
sub drawgalaxy(x1, y1, z1, r, r1, r2, a1, a2, u)
dim c as _unsigned long
dim p, q
dim x,y,z,xx,yy,zz,x0,y0,z0,i,k,a,rr,gg,bb
for a=0 to u step 0.1
for i=0 to 0.001*r*(u - a)^3.5
x0 = (rnd - 0.5)*0.2*r*(u - a)
y0 = (rnd - 0.5)*0.2*r*(u - a)
z0 = (rnd - 0.5)*0.2*r*(u - a)
if x0*x0 + y0*y0 + z0*z0 < 2000 then
for k=0 to 1
x = x0 + r1*r*a*cos(a + k*pi - t)
y = y0 + r2*r*a*sin(a + k*pi - t)
z = z0 + 1
'rot x, y, a1
'rot y, z, a2
xx = x
yy = y
x = xx*cos(a1) - yy*sin(a1)
y = xx*sin(a1) + yy*cos(a1)
yy = y
zz = z
y = yy*cos(a2) - zz*sin(a2)
z = yy*sin(a2) + zz*cos(a2)
c = 255*(u - a)/2
rr = c + rnd*50
gg = 0.2*c + rnd*50
bb = 0
if rr < 0 then rr = 0
if gg < 0 then gg = 0
if bb < 0 then bb = 0
if rr > 255 then rr = 255
if gg > 255 then gg = 255
if bb > 255 then bb = 255
rr = rr - z1/100
gg = gg - z1/100
bb = bb - z1/100
p = sw/2 + (x + x1)*d/(z + z1 + zz)
q = sh/2 - (y + y1)*d/(z + z1 + zz)
if p>0 and p<sw and q>0 and q<sh then
pset (p, q), _rgb(rr, gg, bb)
end if
next
end if
next
next
end sub
Posts: 176
Threads: 13
Joined: Apr 2022
Reputation:
5
This is a VERY cool demo... Although technically... there are no stars in inter-galactic space... but still a very cool effect!! Well done!!
ps: The rotating galaxies, in the second script, are a nice touch as well...
J
May your journey be free of incident. Live long and prosper.
|