; Gravitation und Umlaufbahnen
; Copyright August 2004, Daniel Nobis

; Hier werden Anziehungskräfte zwischen verschiedenen Objekten simuliert.
; Dabei wird die Masse und auch die Entfernung berücksichtigt.
; Auf diese Weise lassen sich zum Beispiel Umlaufbahnen erzeugen.

; Dieses Programm enthält 10 verschiedene Beispiele mit mehreren Objekten, die
; aufeinander einwirken. Zur Auswahl ändern sie einfach den Zähler von PresetSystem().

; Um eigene Objekte zu erstellen rufen Sie diese Funktion auf:
; CreateObjekt(PosX, PosY, SpeedX, SpeedY, Masse, Modus)

; - Der Modus bestimmt ob ein Objekt fixiert (0) oder frei beweglich (1) ist.

AppTitle "Gravitation Simulation"

Global ResX = 800
Global ResY = 600

Graphics ResX, ResY, 16, 2

Type Objekt
 Field x#,y#,sx#,sy#,masse#,typ
End Type

Type Punkt
 Field x,y,start
End Type

.Preset
Global Speed# = .08
Global Bahnen = 1
Global Name$ = "Gravitation Simulation"
Global PresetID

DeleteSystem()         ; Alle Objekte löschen
PresetSystem(PresetID) ; <---- Beispielkonfigurationen (10 Modi möglich)


; --- Hauptschleife ---
SetBuffer BackBuffer()
 Repeat
  Cls

    If KeyHit(59) Then Bahnen = Bahnen Xor 1
    Text ResX/2,30, "Copyright (C) 2004 Daniel Nobis", 1
    Text ResX/2,50, "FPS: " + FPS(), 1
    Text ResX/2,10, Name$, 1
   
    If PresetID = 0 Then
     Text ResX/2, ResY/2, "Drücken Sie die Pfeiltasten um durch die Presets zu blättern", 1
    EndIf
 
    If UpdateInput() = 1 Then Goto Preset

    UpdateObjekt()
    UpdatePunkt()

  Flip 0
 Until KeyHit(1)
End
; --- Hauptschleife ---


; --- System löschen ---
Function DeleteSystem()
 For o.objekt = Each objekt
  Delete o
 Next

 For p.punkt = Each punkt
  Delete p
 Next
End Function
; --- System löschen ---


; --- Beispielkonfigurationen ---
Function PresetSystem(ID)
 Select ID
  Case 1
   Speed# = .08
   Name$ = "Umlaufbahnen"
   CreateObjekt(ResX/2, ResY/2, 0, 0, 3.000, 1)
   CreateObjekt(ResX/2, ResY/7, 13.5, 0, 0.000, 1)
   CreateObjekt(ResX/2, ResY/4, 12.5, 0, 0.000, 1)
   CreateObjekt(ResX/2, ResY/3, 11.0, 0, 0.000, 1)
  Case 2
   Speed = .02
   Name$ = "Große Blume"
   CreateObjekt(ResX/2, ResY/2, 0, 0, 550.000, 0)
   CreateObjekt(700, 300, 50, -50, 1.000, 1)
   CreateObjekt(100, 300, -50, 50, 1.000, 1)
  Case 3
   Speed# = .08
   Name$ = "Chaos Anomalie"
   CreateObjekt(ResX/2, ResY/2, 0, 0, 30.000, 1)
   CreateObjekt(700, 300, 5, -5, 1.000, 1)
   CreateObjekt(100, 300, -5, 5, 1.000, 1)
  Case 4
   Speed# = .08
   Name$ = "Atom"
   CreateObjekt(ResX/2, ResY/2, 0, 0, 30.000, 1)
   CreateObjekt(ResX/2, ResY/7, 13.5, 0, 0.000, 1)
   CreateObjekt(ResX/2, ResY/4, 13.0, 0, 0.000, 1)
   CreateObjekt(ResX/2, ResY/3, 11.0, 0, 0.000, 1)
  Case 5
   Speed# = .08
   Name$ = "Spiro Fun"
   CreateObjekt(ResX/2, ResY/2, 0,  0, 3.000, 1)
   CreateObjekt(ResX/2, 100, -13.5, 0, 0.100, 1)
   CreateObjekt(ResX/2, 500, 13.5,  0, 0.100, 1)
  Case 6
   Speed# = .04
   Name$ = "Chaos Theorie"
   CreateObjekt(ResX/2, ResY/2,   0, 0, 30.000, 1)
   CreateObjekt(ResX/2, 100,  +15.5, 0,  5.000, 1)
   CreateObjekt(ResX/2, 500,  -15.5, 0,  5.000, 1)
  Case 7
   Speed# = .008
   Name$ = "Kleine Blume"
   CreateObjekt(ResX/2, 100, +157, 0, 5000.000, 1)
   CreateObjekt(ResX/2, 500, -157, 0, 5000.000, 1)
  Case 8
   Bahnen = 0
   Speed# = .08
   Name$ = "Gravitationskreis"
   For w = 0 To 359 Step 15
    PosX = ResX/2 + Cos(w) * 250
    PosY = ResY/2 + Sin(w) * 250
    CreateObjekt(PosX, PosY, 0, 0, 1.000, 0)
   Next   
   For w = 0 To 359 Step 15
    PosX = ResX/2 + Cos(w) * 100
    PosY = ResY/2 + Sin(w) * 100
    CreateObjekt(PosX, PosY, 0, 0, 1.000, 1)
   Next
  Case 9
   Speed = .08
   Name$ = "Instabiles System"
   CreateObjekt(ResX/2, ResY/2, 0,  0, 3.000, 1)
   CreateObjekt(ResX/2, ResY/2-200, -13.5, 0, 0.100, 1)
   CreateObjekt(ResX/2, ResY/2+200, +13.5, 0, 0.100, 1)
   CreateObjekt(ResX/2-100, ResY/2, 0, -11.0, 0.100, 1)
   CreateObjekt(ResX/2+100, ResY/2, 0, +11.0, 0.100, 1)
  Case 10
   Speed# = .001
   Name$ = "Stabiles System"
   CreateObjekt(ResX/2, ResY/2, 0,  0, 5000.000, 1)
   CreateObjekt(ResX/2, ResY/2-200, -560.0, 0, 5.000, 1)
   CreateObjekt(ResX/2, ResY/2+200, +560.0, 0, 5.000, 1)
   CreateObjekt(ResX/2-100, ResY/2, 0, -450.0, 5.000, 1)
   CreateObjekt(ResX/2+100, ResY/2, 0, +450.0, 5.000, 1)
 End Select
End Function
; --- Beispielkonfigurationen ---


; --- Neuen Flugbahnpunkt erstellen ---
Function CreatePunkt(x,y)
 If x > 0 And x < ResX And y > 0 And y < ResY Then
  p.punkt = New punkt
  p\x = x
  p\y = y
  p\start = MilliSecs()
 EndIf
End Function
; --- Neuen Flugbahnpunkt erstellen ---


; --- Neues Objekt erstellen ---
Function CreateObjekt(x#,y#,sx#,sy#,masse#,typ)
 o.objekt = New objekt
 o\x = x
 o\y = y
 o\sx = sx
 o\sy = sy
 o\masse# = masse
 o\typ = typ
End Function
; --- Neues Objekt erstellen ---


; --- Flugbahnpunkte aktualisieren ---
Function UpdatePunkt()
 LockBuffer BackBuffer()
  For p.punkt = Each punkt

   WritePixelFast(p\x, p\y, $FFFFFF, BackBuffer()) 
   If MilliSecs()-p\start > 2500 Then Delete p   

  Next
 UnlockBuffer BackBuffer()
End Function 
; --- Flugbahnpunkte aktualisieren ---


; --- Objekte aktualisieren ---
Function UpdateObjekt()
 For o.objekt = Each objekt

  For o2.objekt = Each objekt
   If o <> o2 Then
    Abstand# = Abstand(o\x,o\y,o2\x,o2\y)
    If Abstand < 500 Then
     
     Winkel1 = winkel(o2\x,o2\y,o\x,o\y) 
     Winkel2 = winkel(o\x,o\y,o2\x,o2\y)
 
     ; O1 wird von O2 angezogen
     o\sx# = o\sx + Cos(Winkel1) * (500-Abstand) / 2000 * o2\masse * speed
     o\sy# = o\sy + Sin(Winkel1) * (500-Abstand) / 2000 * o2\masse * speed

     ; O2 wird von O1 angezogen
     o2\sx# = o2\sx + Cos(Winkel2) * (500-Abstand) / 2000 * o\masse * speed
     o2\sy# = o2\sy + Sin(Winkel2) * (500-Abstand) / 2000 * o\masse * speed

    EndIf
   EndIf
  Next

  ; Objekte bewegen
  If o\typ <> 0 Then
   col = (3-o\masse#)*255
   Color col,col,+255-col
   o\x# = o\x# + o\sx# * Speed#
   o\y# = o\y# + o\sy# * Speed#
   If Bahnen = 1 Then CreatePunkt(o\x+3,o\y+3)
  Else
   Color 150,0,0
  EndIf

  ; Objekte darstellen
  Oval o\x+3,o\y+3,6,6

 Next
End Function
; --- Objekte aktualisieren ---


; --- Benutzereingabe ---
Function UpdateInput()
 If KeyHit(200) Then
  PresetID = PresetID + 1
  If PresetID > 10 Then PresetID = 1
  If PresetID < 1 Then PresetID = 10
  Return 1
 EndIf

 If KeyHit(208) Then
  PresetID = PresetID - 1
  If PresetID > 10 Then PresetID = 1
  If PresetID < 1 Then PresetID = 10
  Return 1
 EndIf
End Function
; --- Benutzereingabe ---


; --- Frames per Second ---
Global FPSSEC = MilliSecs(), FPS, FRAMES

Function FPS()
 
  FRAMES = FRAMES + 1
  If MilliSecs() - FPSSEC => 1000 Then
   FPS = FRAMES
   FRAMES = 0
   FPSSEC = MilliSecs()
  EndIf

 Return FPS
End Function
; --- Frames per Second ---


; --- Abstandsfunktion ---
Function Abstand(x1#,y1#,x2#,y2#)
 xhypo# = x1# - x2#
 yhypo# = y1# - y2#
 Abstand# = Sqr((xhypo# ^ 2) + (yhypo# ^ 2))
 Return Abstand#
End Function
; --- Abstandsfunktion ---


; --- Winkel berechnen ---
Function Winkel#(x1#,y1#,x2#,y2#)
 ; 1 = Ziel, 2 = Ursprung
 Return (450-ATan2(x1#-x2#,y1#-y2#)) Mod 360
End Function