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
'    gravity simulator by michael "h4tt3n" Nissen
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 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 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, 16,,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)

'Option Explicit
'Randomize Timer
'CONST NIL = 0

Declare Sub MakePlanetStart(id As UInteger,mass As Single,gravpar As Single,dens As Single,radius As Single)
Declare Sub MakePlanetEnde(id As UInteger,mass As Single,gravpar As Single,dens As Single,radius As Single)
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,gravpar As Single,dens As Single,radius As Single)
    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=gravpar
        PlanetStart->Density=dens
        PlanetStart->Radius=radius
            PlanetStart->ID=id
        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=gravpar
        Neu->Density=dens
        Neu->Radius=radius
            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,gravpar As Single,dens As Single,radius As Single)
    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=gravpar
        PlanetEnde->Density=dens
        PlanetEnde->Radius=radius
          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=gravpar
        Neu->Density=dens
        Neu->Radius=radius
        Neu->nachPlanet = 0
        Neu->vorPlanet = PlanetEnde
        PlanetEnde->nachPlanet = Neu                                                                                    '!!!
          Neu->ID=id
          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 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
                                           'den Anfang setzen.
    While Element <> 0
        Print Element->ID
        Element = Element->nachPlanet
    Wend
End Sub



For i As Integer=0 To 10
    MakePlanetStart(i,0,0,0,0)
Next

For i As Integer=10 To 20
    MakePlanetEnde(i,0,0,0,0)
Next

DeletePlanetEnde(2)
DeletePlanetStart(7)

ListeAusgeben()
Sleep