That (stuff in space) link by badidea was cheating IMHO, it only showed a glimpse of the actual orbits if the mouse hovered over a particular satellite.

It should have shown the actual orbits and not have them all orbiting the same way.

But maybe that would be a real clutter.

Anyway, in the same spirit, here is definitive proof that orbits can be around any axis in any direction.

This is a brief look at goings on a long time ago (many moons), in a remote part of the universe.

Code: Select all

Type AxialAngle

As Single Sin,Cos

End Type

Type v3

As Single x,y,z

' As Ulong colour'unused here

End Type

Type satellite

As v3 position

As Single speed

As v3 axis

As Long rad

As Ulong colour

as string name

End Type

declare function main() as long ''RUN

end main

Function cross(v1 As v3,v2 As v3) As v3 'cross product

Return Type<v3>(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)

End Function

Function shortline(fp As v3,p As v3,length As Long) As v3

Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y,diffz=p.z-fp.z

Dim As Single L=Sqr(diffx*diffx+diffy*diffy+diffz*diffz)

Return Type<v3>(fp.x+length*diffx/L,fp.y+length*diffy/L,fp.z+length*diffz/L)

End Function

Function setAxialangle(angle As Single) As AxialAngle

Return Type(Sin(angle),Cos(angle))

End Function

Function normalize(v As V3) As V3

Dim As Single L= Sqr(v.x*v.x+v.y*v.y+v.z*v.z)

Return Type(v.x/L,v.y/L,v.z/L)

End Function

Function AxialRotate(centre As v3,Pt As V3,Angle As AxialAngle,norm As v3,T As Single=1) Byref As v3

#define crossP(v1,v2,N) Type<v3>( N*(v1.y*v2.z-v2.y*v1.z),N*(-(v1.x*v2.z-v2.x*v1.z)),N*(v1.x*v2.y-v2.x*v1.y))

#define plus(v1,v2) Type<v3>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)

#define dotP(v1,v2) (v1.x*v2.x + v1.y*v2.y + v1.z*v2.z)

#define mlt(f,v1) type<v3>(f*v1.x,f*v1.y,f*v1.z)

Static As v3 result

Dim As V3 V=Type(T*(Pt.x-centre.x),T*(Pt.y-centre.y),T*(Pt.z-centre.z))

Dim As V3 T1=crossP(norm,V,Angle.sin)

Dim As Single tmpS=dotP(Norm,V)

Dim As V3 tmpV=mlt(tmpS,norm)

tmpV=mlt((1-Angle.cos),tmpV)

T1=plus(T1,tmpV)

Dim As V3 tt=mlt(Angle.cos,V)

result=plus(tt,T1)

result=plus(result,centre)

'result.colour=Pt.colour

Return result

End Function

Function perspective(p As V3,eyepoint As V3) As V3

Dim As Single w=1+(p.z/eyepoint.z)

Return Type((p.x-eyepoint.x)/w+eyepoint.x,_

(p.y-eyepoint.y)/w+eyepoint.y,_

(p.z-eyepoint.z)/w+eyepoint.z)

End Function

Sub Qsort(array() As satellite,begin As Long,Finish As Long)

Dim As Long i=begin,j=finish

Dim As V3 x =array(((I+J)\2)).position

While I <= J

While array(I).position.z > X .z:I+=1:Wend

While array(J).position.z < X .z:J-=1:Wend

If I<=J Then Swap array(I),array(J): I+=1:J-=1

Wend

If J >begin Then Qsort(array(),begin,J)

If I <Finish Then Qsort(array(),I,Finish)

End Sub

Sub setsatellites(s() As satellite,x As Long,y As Long)

For n As Long= Lbound(s) To Ubound(s)

With s(n)

.axis=Type(Rnd-Rnd,Rnd-Rnd,Rnd-Rnd)

.axis=normalize(.axis)

Dim As v3 c=cross(.axis,Type(0,1,0))

c.x=x/2+c.x:c.y=y/2+c.y

Var z=150+Rnd*200

Dim As v3 p=shortline(Type(x/2,y/2,0),Type(c.x,c.y,c.z),z)

.position=p

.speed=200/(z)

.rad=1

.colour=Rgb(100+Rnd*155,100+Rnd*155,100+Rnd*155)

.name="Orbit speed " + str(int(.speed*100))

End With

s(Ubound(s)).position=Type(x/2,y/2,0)

s(Ubound(s)).rad=100

s(Ubound(s)).colour=Rgb(0,0,250)

s(Ubound(s)).name="Planet Soylent Blue"

Next n

End Sub

Sub ORB(cx As Long,_ 'CENTRES

cy As Long,_

radius As Long,_

c As Ulong,_ 'COLOUR

offsetX As Single=0,_ 'Bright spot (0 to about .9)

offsetY As Single=0,_

e As Single=0,_ 'eccentricity

resolution As Long=32,_ 'number of circles drawn

im As Any Pointer=0)

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)

Dim As Single ox,oy,nx,ny

ox=cx+offsetX*radius

oy=cy+offsetY*radius

Dim As Ubyte red=Cptr(Ubyte Ptr,@c)[2]

Dim As Ubyte green=Cptr(Ubyte Ptr,@c)[1]

Dim As Ubyte blue=Cptr(Ubyte Ptr,@c)[0]

For d As Single = radius To 0 Step -radius/resolution

nx=(cx-ox)*(d-radius)/radius + cx 'linear mappings for moving centre

ny=(cy-oy)*(d-radius)/radius + cy

Var f=map(radius,0,d,.3,1)

Circle im,(nx,ny),d,Rgb(f*red,f*green,f*blue),,,e,F

Next d

End Sub

Sub show(s As satellite,x As Long,y As Long,i As Any Ptr=0,E As Any Ptr)

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)

Var rad=map(-300,300,s.position.z,12,3)

orb(s.position.x,s.position.y,rad+s.rad,s.colour,0,0,0)

Pset i,(s.position.x,s.position.y),Rgb(50,50,50)

If s.position.z<0 Then Pset E,(s.position.x,s.position.y),Rgb(50,50,50)

End Sub

Sub move(s As satellite,Byref rot As satellite,x As Long,y As Long)

Static As Single a

a+=.001

rot=s

Dim As AxialAngle Aa=setAxialAngle((s.speed*a)/1)

rot.position=AxialRotate(Type(x/2,y/2,0),s.position,Aa,s.Axis)

End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long

Static As Double timervalue,_lastsleeptime,t3,frames

frames+=1

If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0

Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000

If sleeptime<1 Then sleeptime=1

_lastsleeptime=sleeptime

timervalue=Timer

Return sleeptime

End Function

function main() as long

#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius

Screen 20,32

Dim As Integer x,y

Screeninfo x,y

Dim As Any Ptr im=Imagecreate(x,y),E =Imagecreate(x,y)

Dim As satellite s(1 To 10)

Dim As satellite rot(1 To 10)

setsatellites(s(),x,y)

Dim As Long fps

dim as long mx,my

Do

getmouse mx,my

For n As Long=Lbound(s) To Ubound(s)

move(s(n),rot(n),x,y)

Next

Qsort(rot(),Lbound(rot),Ubound(rot))

Screenlock

Cls

draw string (20,20),"FPS = " &fps

Put(0,0),im,trans

For n As Long=Lbound(s) To Ubound(s)

rot(n).position=perspective(rot(n).position,Type(x/2,y/2,800))

show(rot(n),x,y,im,E)

if incircle( rot(n).position.x, rot(n).position.y,50,mx,my) then

draw string( rot(n).position.x, rot(n).position.y),rot(n).name

end if

Next

Put(0,0),E,trans

Screenunlock

Sleep regulate(60,fps),1

Loop Until Len(Inkey)

Imagedestroy im

Imagedestroy E

return 0

end function