Type Vector_2D
    As Single X, Y
End Type

Type Planet_t
    As Planet_t Ptr nachPlanet
    As Planet_t Ptr vorPlanet
    As Vector_2D Pos, Vel, Scrn
    As Single Mass
    As single Grav_Param
    As single Density
    As Single Radius
    As Integer Col
    As Ubyte Life_State
    As UInteger ID
End Type
Dim As Vector_2D Dist, Scrn_Center
Const Pi = 4*Atn(1), TwoPi = Pi*2, Gravity = 6.67e-11
Dim As Ubyte Red, Grn, Blu
Dim As Short a, b, FPS, FPS_Counter, Num_Planets, Num_Asteroids, num_moons
dim Shared As Integer Screen_X, Screen_Y, Screen_Rate, Mouse_X, Mouse_Y, _
Mouse_X_old, Mouse_Y_old, wheel, wheel_old, Mouse_Button, Mouse_Button_Old, _
Screen_X_Mid, Screen_Y_Mid, Scroll_factor,lebende,tode
Dim Shared As Single Spawn_Angle, Spawn_Distance, Distance, Dist_Sqared, MinDist, _
Vel_Mag, zoom_scale, zoom_scale_old, Inv_Zoom_Scale, Time_Scale, FPS_timer, _
Scroll_Rate, Screen_Update

'  screen settings
ScreenInfo Screen_X, Screen_Y,,,,Screen_Rate
screen_update = 1/screen_rate
Screen_X_Mid = Screen_X\2
Screen_Y_Mid = Screen_Y\2
ScreenRes screen_x, screen_y, 32,2',1 ', Screen_Rate
Color RGB(32, 255, 32)

'  program settings
Scroll_Factor = 400
Zoom_Scale = 1/8
Time_Scale = 10
Num_Planets = 10
Num_Asteroids = 1000'5000
lebende =5000
Dim As Planet_t Body(0 to Num_Planets+Num_Asteroids)

Randomize Timer
CONST NIL = 0

Declare Sub MakePlanetStart(id As UInteger,mass As Single,dens As Single,Posi As Vector_2D,vel As Vector_2D,col As UInteger)
Declare Sub MakePlanetEnde(id As UInteger,mass As Single,dens As Single,Posi As Vector_2D,vel As Vector_2D, col As UInteger)
Declare Sub DeletePlanetStart( id As UInteger)
Declare Sub DeletePlanetMitte( id As UInteger)
Declare Sub DeletePlanetEnde( id As UInteger)

Dim Shared PlanetStart As Planet_t Ptr
Dim Shared PlanetEnde As Planet_t Ptr


SUB MakePlanetStart(id As UInteger,mass As Single,dens As Single,Posi As Vector_2D,vel As Vector_2D,col As UInteger)
    If PlanetStart = 0 Then 'Falls die Liste leer ist: Anlegen!
        PlanetStart = ALLOCATE(SIZEOF(Planet_t))
        PlanetStart->vorPlanet = 0
        PlanetStart->nachPlanet = 0                                                                                                                                                                     '!!!
        PlanetStart->Mass=mass
        PlanetStart->Grav_Param=mass*Gravity
        PlanetStart->Density=dens
        PlanetStart->Radius=((mass/dens)/((4/3)*pi))^(1/3)
        PlanetStart->Pos.X=Posi.X
        PlanetStart->Pos.Y=Posi.Y
        PlanetStart->Vel.X=vel.X
        PlanetStart->Vel.Y=vel.Y
        PlanetStart->ID=id
        PlanetStart->Col=col
        PlanetEnde=PlanetStart

    Else       '...falls nicht: Neues Element anlegen und
        'Liste daran anhängen!
        Dim Neu As Planet_t PTR
        Neu = ALLOCATE(SIZEOF(Planet_t))    'Speicher
        'alloziieren
        Neu->Mass=mass
        Neu->Grav_Param=mass*Gravity
        Neu->Density=dens
        Neu->Radius=((mass/dens)/((4/3)*pi))^(1/3)
        Neu->Pos.X=Posi.X
        Neu->Pos.Y=Posi.Y
        Neu->Vel.X=vel.X
        Neu->Vel.Y=vel.Y
        Neu->Col=col
        Neu->ID=id
        Neu->vorPlanet = 0
        Neu->nachPlanet = PlanetStart   'Ehem. Listenanfang als
        '"Nächstes" definieren
        PlanetStart->vorPlanet = Neu                                                                                                                                                                            '!!!
        PlanetStart = Neu                                                       'Listenanfang auf das neue Element
        'setzen
    End If
END Sub
Sub MakePlanetEnde (id As UInteger,mass As Single,dens As Single,Posi As Vector_2D,vel As Vector_2D,col As UInteger)
    If PlanetEnde = 0 Then   'Falls die Liste leer ist: Anlegen!
        PlanetEnde = ALLOCATE(SIZEOF(Planet_t))
        PlanetEnde->vorPlanet= 0
        PlanetEnde->nachPlanet = 0
        PlanetEnde->Mass=mass
        PlanetEnde->Grav_Param=mass*Gravity
        PlanetEnde->Density=dens
        PlanetEnde->Pos.X=Posi.X
        PlanetEnde->Pos.Y=Posi.Y
        PlanetEnde->Vel.X=vel.X
        PlanetEnde->Vel.Y=vel.Y
        PlanetEnde->Radius=((mass/dens)/((4/3)*pi))^(1/3)
        PlanetEnde->Col=col
        PlanetEnde->ID=id
        PlanetStart=PlanetEnde
    Else              '...falls nicht: Neues Element anlegen
        'und anhängen!
        Dim Element As Planet_t PTR
        Dim Neu As Planet_t PTR
        Neu = ALLOCATE(SIZEOF(Planet_t))    'Speicher
        'alloziieren
        Neu->Mass=mass
        Neu->Grav_Param=mass*Gravity
        Neu->Density=dens
        Neu->Radius=((mass/dens)/((4/3)*pi))^(1/3)
        Neu->Pos.X=Posi.X
        Neu->Pos.Y=Posi.Y
        Neu->Vel.X=vel.X
        Neu->Vel.Y=vel.Y
        Neu->Col=col
        Neu->nachPlanet = 0
        Neu->vorPlanet = PlanetEnde
        Neu->ID=id

        PlanetEnde->nachPlanet = Neu                                                                                                                                                                    '!!!
        PlanetEnde=Neu
    End If
END Sub
Sub DeletePlanetStart (id As UInteger)

    If PlanetStart = 0 Then
        Print "Fehler: Die Liste ist leer!"
        Exit Sub
    End If
    Dim Element As Planet_t Ptr

    Element = PlanetStart
    While Element <> 0


        If Element->ID = id Then
            If Element = PlanetStart And Element = PlanetEnde Then
                PlanetStart = 0
                PlanetEnde = 0
            ElseIf Element = PlanetStart Then
                PlanetStart = Element->nachPlanet
                PlanetStart->vorPlanet = 0
            ElseIf Element = PlanetEnde Then
                PlanetEnde = Element->vorPlanet
                PlanetEnde->nachPlanet = 0
            Else
                Element->vorPlanet->nachPlanet = Element->nachPlanet
                Element->nachPlanet->vorPlanet = Element->vorPlanet
            EndIf
            DeAllocate Element
            Exit Sub
        End If

        Element = Element->nachPlanet

    Wend
End Sub
Sub DeletePlanetEnde (id As UInteger)

    If PlanetEnde = 0 Then
        Print "Fehler: Die Liste ist leer!"
        Exit Sub
    End If
    Dim Element As Planet_t Ptr

    Element = PlanetEnde

    While Element <> 0

        If Element->ID = id Then
            If Element = PlanetStart And Element = PlanetEnde Then
                PlanetStart = 0
                PlanetEnde = 0
            ElseIf Element = PlanetStart Then
                PlanetStart = Element->nachPlanet
                PlanetStart->vorPlanet = 0
            ElseIf Element = PlanetEnde Then
                PlanetEnde = Element->vorPlanet
                PlanetEnde->nachPlanet = 0
            Else
                Element->vorPlanet->nachPlanet = Element->nachPlanet
                Element->nachPlanet->vorPlanet = Element->vorPlanet
            EndIf
            DeAllocate Element
            Exit Sub
        End If

        Element = Element->vorPlanet
    Wend
End Sub
Sub Calc()
    Dim Element_o As Planet_t Ptr
    Dim Element_i As Planet_t Ptr
    Dim helper As Planet_t Ptr

    Element_o = PlanetStart
    While (Element_o <> 0)
        'If Element_o = PlanetStart And Element_o = PlanetEnde Then Exit sub
        Element_i = Element_o->nachPlanet
        While (Element_i <> 0)
            'If Element_i = PlanetStart And Element_i = PlanetEnde Then Exit sub
            Dim As Single DistX = Element_o->Pos.X-Element_i->Pos.X
            Dim As Single DistY = Element_o->Pos.Y-Element_i->Pos.Y
            Dim As Single Dist_Sqared = DistX^2+DistY^2
            Dim As Single Distance = Sqr(Dist_Sqared)
            Dim As Single MinDist = Element_o->Radius+Element_i->Radius
            If Distance < MinDist Then
                If Element_i->Mass < Element_o->Mass Then
                    Element_o->Mass+=Element_i->Mass
                    Element_o->Density=(Element_o->Density+Element_i->Density)/2
                    Element_o->Radius=(Element_o->Mass/Element_o->Density)/((4/3)*pi)^(1/3)
                    Element_o->Vel.X+=Element_i->Vel.X/Element_o->Mass
                    Element_o->Vel.Y+=Element_i->Vel.Y/Element_o->Mass
                    Element_o->Grav_Param=Element_o->Mass*Gravity
                    If Element_o->ID>Element_i->ID Then
                        helper=Element_i->nachPlanet
                        DeletePlanetStart(Element_i->ID)
                        Element_i=helper'->nachPlanet
                        'Element_i=Element_i->nachPlanet
                        tode+=1
                        'Continue While
                    Else
                        helper=Element_i->nachPlanet
                        DeletePlanetEnde(Element_i->ID)
                        Element_i=helper'->nachPlanet
                        'Element_i=Element_i->nachPlanet
                        tode+=1
                        'continue while
                    EndIf
                Else
                    Element_o->Life_State = 2'Dist_Sqared = MinDist^2
                    Element_i->Mass+=Element_o->Mass
                    Element_i->Density=(Element_i->Density+Element_o->Density)/2
                    Element_i->Radius=((Element_i->Mass/Element_i->Density)/((4/3)*pi))^(1/3)
                    Element_i->Vel.X+=Element_o->Vel.X/Element_i->Mass
                    Element_i->Vel.Y+=Element_o->Vel.Y/Element_i->Mass
                    Element_i->Grav_Param=Element_i->Mass*Gravity
                    If Element_o->ID>Element_i->ID Then
                        helper=Element_o->nachPlanet
                        DeletePlanetEnde(Element_o->ID)
                        Element_o=helper'->nachPlanet
                        tode+=1
                    Else
                        helper=Element_o->nachPlanet
                        DeletePlanetStart(Element_o->ID)
                        Element_o=helper'->nachPlanet
                        tode+=1
                    EndIf
                EndIf
            Else
                Dim As Single Vel_Mag = (Element_i->Grav_Param/Dist_Sqared)*Time_Scale
                Element_o->Vel.X -= (DistX/Distance)*Vel_Mag
                Element_o->Vel.Y -= (DistY/Distance)*Vel_Mag
                Vel_Mag = (Element_o->Grav_Param/Dist_Sqared)*Time_Scale
                Element_i->Vel.X += (DistX/Distance)*Vel_Mag
                Element_i->Vel.Y += (DistY/Distance)*Vel_Mag
                Element_i = Element_i->nachPlanet
            EndIf
        Wend
        Element_o->Pos.X += Element_o->Vel.X*Time_Scale
        Element_o->Pos.Y += Element_o->Vel.Y*Time_Scale
        Element_o = Element_o->nachPlanet
        'Element_i = PlanetStart
    Wend
End Sub
Sub ListeAusgeben()
    If PlanetStart = 0 THEN
        PRINT "Fehler: Die Liste ist leer!"
        EXIT SUB
    END IF
    DIM Element As Planet_t PTR
    Element = PlanetStart                        'Zeiger auf
    'If Element = PlanetStart And Element = PlanetEnde Then Exit Sub
    'den Anfang setzen.
    Do
        Color Element->Col
        Print Using "#### #######.# ######.# #####.# +####.# +####.# +####.# +####.# ####";Element->ID;Element->Mass;Element->Grav_Param;Element->Radius;Element->Pos.X;Element->Pos.Y;Element->Vel.X;Element->Vel.Y;tode
        If Element->nachPlanet <> 0 Then    'Listenende noch
            'nicht erreicht?
            Element = Element->nachPlanet   'Dann ein Element
            'weitergehen!
        Else
            Exit Do                        'Ansonsten Schleife
            'verlassen.
        End If
    Loop
END SUB

Dim Posi As Vector_2D
Dim vel As Vector_2D
vel.X=0
vel.Y=0
posi.X=0
posi.Y=0

MakePlanetStart(0,1e13,55000,Scrn_Center,vel,RGBA(48+Rnd*208, 48+Rnd*208, 48+Rnd*208, 48+Rnd*208))
For i As Integer=1 To 60
    Dim As Single Spawn_Angle = Rnd*TwoPi
    Dim As Single Spawn_Distance = (((1e13/55000)/((4/3)*pi))^(1/3)) + 400 + Rnd*5200'400+(Rnd*4000)
    Dim As Single Mass = 1e6+(Rnd*19e6^(1/6))^6
    dim as single Grav_Param = Mass*Gravity
    Dim As Single Density = 25000'+Rnd*3500
    Dim As Single Radius = ((Mass/Density)/((4/3)*pi))^(1/3)
    Dim As UByte Red = 64+Rnd*191
    Dim As UByte Grn = Red-32+Rnd*32
    Dim As UByte Blu = Grn-32+Rnd*32
    Dim As UInteger Col = RGB(Red, Grn, Blu)
    Posi.X = Scrn_Center.X-Spawn_Distance*Sin(Spawn_Angle)
    Posi.Y = Scrn_Center.Y-Spawn_Distance*Cos(Spawn_Angle)
    Vel.X = sqr(1e13*Gravity/Spawn_Distance)*Cos(Spawn_Angle)
    Vel.Y = sqr(1e13*Gravity/Spawn_Distance)*Sin(-Spawn_Angle)
    If Int(Rnd*10) = 0 Then
        Vel.X = -Vel.X
        Vel.Y = -Vel.Y
    EndIf

    MakePlanetEnde(i,Mass,Density,Posi,vel,Col)
Next


'ListeAusgeben()
While InKey=""
    Calc()
    Locate 1,1
    ScreenLock
    Line(0,0)-(Screen_X,Screen_Y),0,BF
    ListeAusgeben()
    ScreenUnLock
Wend

For i As Integer=0 To 60
    DeletePlanetStart(i)
next
end