Joshy
Code: Select all
Const as double pi = 3.141592653589793
Const as double solar_mass = 4*pi*pi
Const as double DPY = 365.24 ' days per years
Type planet
as double x,y,z,vx,vy,vz,mass
End Type
Dim Shared as PLANET bodies(...) = { _
( 0, 0, 0, 0, 0, 0, solar_mass), _
( 4.84143144246472090e+00 ,-1.16032004402742839e+00 , -1.03622044471123109e-01, _
1.66007664274403694e-03 * DPY, 7.69901118419740425e-03 * DPY, -6.90460016972063023e-05 * DPY, _
9.54791938424326609e-04 * solar_mass), _
( 8.34336671824457987e+00 , 4.12479856412430479e+00 , -4.03523417114321381e-01,_
-2.76742510726862411e-03 * DPY, 4.99852801234917238e-03 * DPY, 2.30417297573763929e-05 * DPY, _
2.85885980666130812e-04 * solar_mass), _
( 1.28943695621391310e+01 ,-1.51111514016986312e+01 , -2.23307578892655734e-01, _
2.96460137564761618e-03 * DPY, 2.37847173959480950e-03 * DPY, -2.96589568540237556e-05 * DPY, _
4.36624404335156298e-05 * solar_mass), _
( 1.53796971148509165e+01 ,-2.59193146099879641e+01 , 1.79258772950371181e-01, _
2.68067772490389322e-03 * DPY, 1.62824170038242295e-03 * DPY, -9.51592254519715870e-05 * DPY, _
5.15138902046611451e-05 * solar_mass)}
Sub advance(Byval dt As Double)
dim as double dx,dy,dz,distance,mag,aMass,bMass
For i as integer = 0 To 4
var a = @bodies(i)
For j as integer = i + 1 To 4
var b = @bodies(j)
dx=a->x-b->x : dy=a->y-b->y : dz=a->z-b->z
distance = Sqr(dx*dx + dy*dy + dz*dz)
mag = dt / (distance * distance * distance)
aMass=a->mass*mag : bMass=b->mass*mag
a->vx -= dx*bMass : a->vy -= dy*bMass : a->vz -= dz*bMass
b->vx += dx*aMass : b->vy += dy*aMass : b->vz += dz*aMass
Next
Next
For i as integer = 0 To 4
with bodies(i)
.x += dt*.vx : .y += dt*.vy : .z += dt*.vz
end with
Next
End Sub
sub drawbodies()
dim as integer w,h
screeninfo w,h:w*=0.5:h*=0.5
for i as integer=0 to 4
var z=bodies(i).z+10
if z>0 then
circle(w+(bodies(i).x*170)/z,h+(bodies(i).y*170)/z),bodies(i).mass*iif(i=0,2,1000),iif(i=0,14,i),,,,F
end if
next
end sub
'
' main
'
dim as integer w,h
screeninfo w,h:w*=0.9:h*=0.9
screenres w,h,,2
screenset 1,0
'offset_momentum
while inkey=""
cls
drawbodies
advance(0.01)
flip
sleep 10
wend
Code: Select all
#include once "crt/math.bi"
CONST NBODIES = 500
Type planet
as single x,z,vx,vz,mass
End Type
dim shared as planet ptr ptr bodies
sub initBody(b as planet ptr)
dim as single s,r=100+rnd*20,w=6.28*rnd,l
b->x=cos(w)*r
b->z=sin(w)*r
b->vx=cos(w+0.2)*r - b->x
b->vz=sin(w+0.2)*r - b->z
l=sqrtf(b->vx*b->vx + b->vz*b->vz)
s=50+rnd*50
b->vx/=l:b->vx*=s
b->vz/=l:b->vz*=s
b->mass=10+rnd*10
end sub
sub initBodies
dim as single r,w
bodies = callocate(sizeof(PLANET ptr)*NBODIES)
for i as integer = 0 to NBODIES-1
bodies[i]=callocate(sizeof(PLANET))
initBody(bodies[i])
next
bodies[0]->x=0
bodies[0]->z=0
bodies[0]->vx=0
bodies[0]->vz=0
bodies[0]->mass=NBODIES*1000
end sub
Sub advance(Byval dt As Double)
dim as single dx,dz,dsquared,distance,mag,aMass,bMass
For i as integer = 0 To NBODIES-2
var a = bodies[i]
For j as integer = i + 1 To NBODIES-1
var b = bodies[j]
dx=a->x-b->x : dz=a->z-b->z
dsquared=dx*dx + dz*dz
if dsquared then
distance = sqrtf(dsquared)
mag = dt / (distance * distance * distance)
aMass=a->mass*mag : bMass=b->mass*mag
a->vx -= dx*bMass : a->vz -= dz*bMass
b->vx += dx*aMass : b->vz += dz*aMass
end if
Next
Next
For i as integer = 1 To NBODIES-1
var b = bodies[i]
b->x += dt*b->vx : b->z += dt*b->vz
'b->vx*=0.99 : b->vz*=0.99
Next
End Sub
sub drawbodies()
dim as integer w,h,w2,h2,x,y
dim as ulong c
screeninfo w,h
w2=w\2:h2=h\2
dim as ubyte ptr r,p=screenptr()
for y=0 to h-1
for x=0 to w-1
if *p>4 then *p-=4
p+=1
next
next
p=screenptr()
var b = bodies[0]
circle(w2+b->x,h2+b->z),10,255
for i as integer=1 to NBODIES-1
b = bodies[i]
x=w2+b->x : y=h2+b->z
if x>-1 andalso x<w andalso y>-1 andalso y<h then
p[y*w+x]=255
end if
if x<-100000 or x>100000 then initBody(b):continue for
if y<-100000 or y>100000 then initBody(b):continue for
next
end sub
'
' main
'
dim as integer w,h
initbodies
screeninfo w,h:w*=0.9:h*=0.9
screenres 640,480,,2
screenset 1,0
for i as integer=0 to 255
palette i,i,i,i
next
while inkey=""
drawbodies
advance(0.01)
flip
'sleep 10
wend