;Graphenerstellungsprogramm von Thomas Decker - begonne Februar 2007
;Für ungerichtete 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 (Not MouseDown(1)) And MouseDown(2) And 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