;Graphenerstellungsprogramm von Thomas Decker - begonne Februar 2007
;Für ungerichtete, ungewichtete Graphen

;Linksklick auf freies Feld                               = Knoten erstellen
;Maus über einen Knoten + Entf                            = Knoten löschen
;Linksklick auf Knoten                                  = Drag&Drop starten zum verschieben
;Rechtsklick auf Knoten und über anderem Knoten loslassen    = Verbindung setzen/trennen
;Maus über einen Knoten + F2                              = Umbenennen

Const xr = 800, yr = 600, maxAdjazenzen = 99
Graphics xr, yr, 0, 2
AppTitle("Erstellt einfache ungewichtete Graphen")
SetBuffer BackBuffer()

Type Button
   Field x, y, r
   Field adj.Button[maxAdjazenzen]
   Field cr, cg, cb
   Field caption$
End Type

Type Adjazenzen
   Field B.Button
End Type


Global akt.Button
Global mouse_x, mouse_y

   bez = 0
   buttonAnzahl = 0
   startdrag = 0
   searchadj = 0
   Repeat
      
      mouse_x = MouseX()
      mouse_y = MouseY()      
      
      btn.Button = mouseOverButton()

      ;Neuen Button erstellen
      If MouseDown(1) And (Not MouseDown(2)) And btn = Null And startdrag = 0 Then
         buttonAnzahl = buttonAnzahl + 1
         bez = bez + 1
         akt = createButton(mouse_x, mouse_y, Str$(bez))
      End If
      
      ;Button markieren
      If (Not MouseDown(1)) And (Not MouseDown(2)) And startdrag = 0 And searchadj = 0 Then
         If btn <> Null Then akt = btn
      End If
      
      ;Markierung aufheben
      If btn = Null And startdrag = 0 And searchadj = 0 Then
         akt = Null
      End If      
      
      ;Starte Adjazenzverbindungserstellung
      If (Not MouseDown(1)) And MouseDown(2) And startdrag = 0 And searchadj = 0 And btn <> Null And akt <> Null Then
         If akt = btn Then searchadj = 1
      End If
      
      ;Setze Verbindung, oder lösche Verbindung
      If (Not MouseDown(1)) And (Not MouseDown(2)) And startdrag = 0 And searchadj = 1 And akt <> Null Then

         If btn <> Null Then ;ungerichtete Verbindungen

            loesch = 0
            For i = 0 To maxAdjazenzen - 1
               If akt\adj[i] = btn Then
                  For j = 0 To maxAdjazenzen - 1
                     If btn\adj[j] = akt Then btn\adj[j] = Null: loesch = 1: Exit
                  Next               
                  akt\adj[i] = Null: loesch = 1: Exit
               End If
            Next         
         
            If loesch = 0 Then
               For i = 0 To maxAdjazenzen - 2
                  If akt\adj[i] = Null Then akt\adj[i] = btn: Exit
               Next
               For i = 0 To maxAdjazenzen - 2
                  If btn\adj[i] = Null Then btn\adj[i] = akt: Exit
               Next
            End If
         End If
         
         searchadj = 0         
      End If
      
      ;Drag$Drop starten
      If MouseDown(1) And (Not MouseDown(2)) And btn <> Null And startdrag = 0 Then
         akt = btn
         startDrag = 1
         dragStartmX = mouse_x
         dragStartmY = mouse_y
         dragStartbX = btn\x
         dragStartbY = btn\y         
      End If

      ;Drag$Drop durchführen
      If startdrag = 1 Then dragButton(akt, dragStartmX, dragStartmY, dragStartbX, dragStartbY)      

      ;Drag$Drop Beenden
      If (Not MouseDown(1)) And (Not MouseDown(2)) And startdrag = 1 Then
         startdrag = 0            
          undoOverlapButtons(akt)
      End If
      
      ;Button löschen
      If KeyDown(211) And akt <> Null Then
         Delete akt
         buttonAnzahl = buttonAnzahl - 1
      End If
      
      ;Umbenennen
      If (Not MouseDown(1)) And (Not MouseDown(2)) And startdrag = 0 And searchadj = 0 And KeyDown(60) And akt <> Null Then
         Color 255, 255, 255
         Locate akt\x - akt\r, akt\y - akt\r
         akt\caption = Input$()
      End If

      Cls            
      ;Aktuellen markieren
      Color 50, 100, 200: If akt <> Null Then Oval akt\x - akt\r - 5, akt\y - akt\r - 5, 2 * akt\r + 10, 2 * akt\r + 10, 0
      If searchadj = 1 Then Color 100, 100, 100: Line akt\x, akt\y, mouse_x, mouse_y
      drawButtons
      
      Color 255, 255, 255      
      Text 0, 0, "Anzahl Buttons: " + buttonAnzahl
      Text 0, 16, "Maus: " + mouse_x + "," + mouse_y
      
      Flip()

   Until KeyDown(1)
   WaitKey
   End


Function undoOverlapButtons(btn.Button)

   mindestabstand = 10

   For b.Button = Each Button
      If b <> btn Then
      If abstandq(btn\x, btn\y, b\x, b\y) < (btn\r + b\r + mindestabstand) * (btn\r + b\r + mindestabstand) Then
         w = Winkel(btn\x, btn\y, b\x, b\y)
            While abstandq(btn\x, btn\y, b\x, b\y) < (btn\r + b\r + mindestabstand) * (btn\r + b\r + mindestabstand)
               
               b\x = b\x - Sin(w)
               b\y = b\y - Cos(w)
         
            Wend
            If isOverlapping(b) = True Then undoOverlapButtons(b)
      End If
      End If
   Next
   
End Function

Function isOverlapping(btn.Button)

   mindestabstand = 10
   For b.Button = Each Button
      If b <> btn Then
         If abstandq(btn\x, btn\y, b\x, b\y) < (btn\r + b\r + mindestabstand) * (btn\r + b\r + mindestabstand) Then Return True
      End If
   Next
   Return False

End Function

Function mouseOverButton.Button()

   For B.Button = Each Button
      If abstandq(mouse_x, mouse_y, B\x, B\y) < B\r * B\r Then Return B
   Next
   Return Null

End Function

Function dragButton(b.Button, dsmx, dsmy, dsbx, dsby)

   b\x = mouse_x - (dsmx - dsbx)
   b\y = mouse_y - (dsmy - dsby)

End Function

Function createButton.Button(x, y, cap$ = "NEU", r = 25)

   B.Button = New Button
      B\x = x
      B\y = y
      B\caption = cap$
      B\r = r
      B\cr = Rand(255)
      B\cg = Rand(255)
      B\cb = Rand(255)
   Return B

End Function

Function drawButtons()

   vpunkt = 5
   For B.Button = Each Button
      For i = 0 To maxAdjazenzen - 2
         If B\adj[i] <> Null Then
            Color 255, 255, 255
            Line B\x, B\y, B\adj[i]\x, B\adj[i]\y ;Verbindungslinie            
            If B\adj[i] = B Then Oval B\x - vpunkt, B\y - B\r - 3 * vpunkt, 2 * vpunkt, 4 * vpunkt, 0 ;Kringel bei Selbstadjazenz
            
            Color B\cr, B\cg, B\cb
            w = Winkel(B\x, B\y, B\adj[i]\x, B\adj[i]\y)
            Oval B\x - Sin(w) * B\r - vpunkt, B\y - Cos(w) * B\r - vpunkt, 2 * vpunkt, 2 * vpunkt, 1
            Color B\adj[i]\cr, B\adj[i]\cg, B\adj[i]\cb
            w = Winkel(B\adj[i]\x, B\adj[i]\y, B\x, B\y)
            Oval B\adj[i]\x - Sin(w) * B\adj[i]\r - vpunkt, B\adj[i]\y - Cos(w) * B\adj[i]\r - vpunkt, 2 * vpunkt, 2 * vpunkt, 1
            
         End If
      Next
   Next

   For B.Button = Each Button
      Color B\cr, B\cg, B\cb
      Oval B\x - B\r, B\y - B\r, 2* B\r, 2* B\r, 1
      If B\cr + B\cg + B\cb <= 384 Then Color 255, 255, 255 Else Color 0, 0 ,0
      Text B\x - StringWidth(B\caption) / 2, B\y - StringHeight(B\caption) / 2, B\caption
   Next
      
End Function      
      
Function abstandq(x1, y1, x2, y2)
   Return ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2))
End Function

Function Winkel#(x1#,y1#,x2#,y2#)
 Return (360+ATan2(x1#-x2#,y1#-y2#)) Mod 360
End Function