Const pi As Double = Acos(0)*2

Enum
	oval = 1
	rechteck
	raute
	rhombus
	unterprogramm
	punkt
End Enum

Enum
	_ndef = 0
	_oben
	_unten
	_rechts
	_links
End Enum

Type tPunkt
	x As Integer
	y As Integer
	typ As UByte 'oben/unten/rechts/links
	ofs As Integer 'länge des anfangs-/endstücks
End Type

Operator + (punkt As tPunkt, offset As Integer) As tPunkt
	'zum festlegen der individuellen länge des anfangs- bzw. endstückes des verbindungspfeils
	Dim As tPunkt pReturn
	
	pReturn = punkt
	pReturn.ofs = offset
	Return pReturn
End Operator

Type tDiagramm
	muster As UByte
	xpos As Integer
	ypos As Integer
	breite As Integer
	hoehe As Integer
	ofsdefault As Integer = 10
	text As String
	farbe As ULong = RGBA(255,255,255,255)
	textfarbe As ULong = RGBA(255,255,255,255)
	indexfarbe As ULong = RGBA(255,255,255,255)
	flag As UByte
	arrayptr As Any Ptr
	grafikpuffer As Any Ptr
	
	Static As ULong hintergrundfarbe
		
	Declare Property oben As tPunkt
	Declare Property unten As tPunkt
	Declare Property rechts As tPunkt
	Declare Property links As tPunkt
	Declare Property index As String
	
	Declare Sub zeichnen
	Declare Sub pfeil (von As tPunkt, bis As tPunkt, text As String = "", farbe As ULong = RGBA(255,255,255,255))
	Declare Function pfeil(von As tPunkt, verlauf As String, text As String = "", farbe As ULong = RGBA(255,255,255,255)) As tPunkt
	Declare Function hindernis(von As tPunkt, bis As tPunkt) As Integer
End Type

Static As ULong tDiagramm.hintergrundfarbe

Property tDiagramm.oben As tPunkt 'oberer anschlusspunkt
	If muster = punkt Then
		tDiagramm.oben = Type<tPunkt>(xpos, ypos, _oben Or &b1000, ofsdefault)
	Else
		tDiagramm.oben = Type<tPunkt>(xpos, ypos - hoehe / 2, _oben, ofsdefault)
	EndIf
End Property

Property tDiagramm.unten As tPunkt 'unterer anschlusspunkt
	If muster = punkt Then
		tDiagramm.unten = Type<tPunkt>(xpos, ypos, _unten Or &b1000, ofsdefault)
	Else
		tDiagramm.unten = Type<tPunkt>(xpos, ypos + hoehe / 2, _unten, ofsdefault)
	EndIf
End Property

Property tDiagramm.links As tPunkt 'linker anschlusspunkt
	If muster = punkt Then
		tDiagramm.links = Type<tPunkt>(xpos, ypos, _links Or &b1000, ofsdefault)
	Else
		tDiagramm.links = Type<tPunkt>(xpos - breite / 2, ypos, _links, ofsdefault)
	EndIf
End Property

Property tDiagramm.rechts As tPunkt 'rechter anschlusspunkt
	If muster = punkt Then
		tDiagramm.rechts = Type<tPunkt>(xpos, ypos, _rechts Or &b1000, ofsdefault)
	Else
		tDiagramm.rechts = Type<tPunkt>(xpos + breite / 2, ypos, _rechts, ofsdefault)
	EndIf
End Property

Property tDiagramm.index As String
	If arrayptr Then
		Return Str((Cast(UInteger,@This) - Cast(UInteger,arrayptr)) / SizeOf(This))
	Else
		Return ""
	EndIf
End Property

Sub tDiagramm.zeichnen
	Dim As Integer h2 = hoehe / 2
	Dim As Integer b2 = breite / 2
	Dim As Integer a, e
	ReDim As String t(0)
		
	'element zeichnen
	Select Case muster
		Case oval
			Line grafikpuffer, (xpos - b2 + h2, ypos - h2) - (xpos - b2  + breite - h2, ypos - h2), farbe
			Line grafikpuffer, (xpos - b2  + h2, ypos + h2) - (xpos - b2  + breite - h2, ypos + h2), farbe
			Circle grafikpuffer, (links.x + h2, links.y), h2, farbe, pi/2, pi/2*3
			Circle grafikpuffer, (rechts.x - h2, rechts.y), h2, farbe,  pi/2*3, pi/2
		Case rechteck
			Line grafikpuffer, (xpos - b2, ypos - h2) - (xpos + b2, ypos + h2), farbe, B
		Case raute
			Line grafikpuffer, (links.x, links.y) - (oben.x, oben.y), farbe
			Line grafikpuffer, (oben.x, oben.y) - (rechts.x, rechts.y), farbe
			Line grafikpuffer, (rechts.x, rechts.y) - (unten.x, unten.y), farbe
			Line grafikpuffer, (unten.x, unten.y) - (links.x, links.y), farbe
		Case rhombus
			Line grafikpuffer, (xpos - b2 + h2, ypos - h2) - (xpos + b2, ypos - h2), farbe 
			Line grafikpuffer, (xpos - b2, ypos + h2) - (xpos + b2 - h2, ypos + h2), farbe 
			Line grafikpuffer, (xpos - b2 + h2, ypos - h2) - (xpos - b2, ypos + h2), farbe 
			Line grafikpuffer, (xpos + b2, ypos - h2) - (xpos + b2 - h2, ypos + h2), farbe 
		Case unterprogramm
			Line grafikpuffer, (xpos - b2, ypos - h2) - (xpos + b2, ypos + h2), farbe, B
			Line grafikpuffer, (xpos - b2 + 10, ypos - h2) - (xpos - b2 + 10, ypos + h2), farbe
			Line grafikpuffer, (xpos + b2 - 10, ypos - h2) - (xpos + b2 - 10, ypos + h2), farbe
	End Select
			
	'text hineinschreiben
	a = 1
	Do 'teilstrings in array schreiben
		ReDim Preserve t(UBound(t) + 1)
		e = InStr(e + 1,text,"\n")
		t(UBound(t)) = Mid(text,a,e - a)
		a = e + 2
	Loop While e
	
	For a = 1 To UBound(t) 'text zentriert ausgeben
		Draw String grafikpuffer, (oben.x - (Len(t(a)) * 8 / 2), links.y - (UBound(t) * 4 - 1) + 8 * (a - 1)), t(a), textfarbe
	Next
	
	'optionalen index ausgeben
	Draw String grafikpuffer, (oben.x - Len(index) * 8 / 2, oben.y + 2), index, indexfarbe
	
	flag = 1 'sperrflag setzen
End Sub

Sub tDiagramm.pfeil(von As tPunkt, bis As tPunkt, text As String = "", farbe As ULong = RGBA(255,255,255,255))
	'parameter:
	'von     - anfangspunkt der verbindung
	'bis     - endpunkt der verbindung
	'text    - optionaler text am anfang der verbindungslinie
	'farbe   - farbe der verbindungslinie (default: weiss)
	        
	Dim As tPunkt von2, bis2
	Dim As Integer anflaenge = von.ofs 'länge des anfangsstückes
	Dim As Integer endlaenge = bis.ofs 'länge des endstückes
	Dim As Integer spitzenlaenge = 8 'länge der pfeilspitze
	Dim As String verlauf
			
	von2 = von
	Select Case von.typ And &b111
		Case _oben
			von2.y -= anflaenge
			verlauf += "o" + Str(anflaenge)
		Case _unten
			von2.y += anflaenge
			verlauf += "u" + Str(anflaenge)
		Case _rechts 'falls erforderlich, linie um den text herumführen
			von2.x += IIf((anflaenge < Len(text) * 8 + 4) And (von.y > bis.y), Len(text) * 8 + 4, anflaenge)
			verlauf += "r" + Str(Abs(von.x - von2.x))
		Case _links 'falls erforderlich, linie um den text herumführen
			von2.x -= IIf((anflaenge < Len(text) * 8 + 4) And (von.y > bis.y), Len(text) * 8 + 4, anflaenge)
			verlauf += "l" + Str(Abs(von.x - von2.x))
	End Select
			
	'länge des endabschnitts setzen
	bis2 = bis
	Select Case bis.typ And &b111
		Case _oben
			bis2.y -= endlaenge
		Case _unten
			bis2.y += endlaenge
		Case _rechts
			bis2.x += endlaenge
		Case _links
			bis2.x -= endlaenge
	End Select
		
	Select Case von2.typ And &b111
		Case _oben
			If bis2.y < von2.y Then 'ende höher als anfang
				verlauf += "o" + Str(Abs(von2.y - bis2.y)) 'zuerst y
				verlauf += IIf(von2.x < bis2.x,"r","l") + Str(Abs(von2.x - bis2.x)) 'dann x
			Else
				verlauf += IIf(von2.x < bis2.x,"r","l") + Str(Abs(von2.x - bis2.x)) 'zuerst x
				verlauf += "u" + Str(Abs(von2.y - bis2.y)) 'dann y
			EndIf
			
		Case _unten
			If bis2.y < von2.y Then 'ende höher als anfang
				verlauf += IIf(von2.x < bis2.x,"r","l") + Str(Abs(von2.x - bis2.x))
				verlauf += "o" + Str(Abs(von2.y - bis2.y))
			Else
				verlauf += "u" + Str(Abs(von2.y - bis2.y))
				verlauf += IIf(von2.x < bis2.x,"r","l") + Str(Abs(von2.x - bis2.x))
			EndIf
					
		Case _links
			If bis2.x < von2.x Then 'ende weiter links als anfang
				verlauf += "l" + Str(Abs(von2.x - bis2.x))
				verlauf += IIf(von2.y < bis2.y,"u","o") + Str(Abs(von2.y - bis2.y))
			Else
				verlauf += IIf(von2.y < bis2.y,"u","o") + Str(Abs(von2.y - bis2.y))
				verlauf += "r" + Str(Abs(von2.x - bis2.x))
			EndIf
			
		Case _rechts
			If bis2.x < von2.x Then 'ende weiter links als anfang
				verlauf += IIf(von2.y < bis2.y,"u","o") + Str(Abs(von2.y - bis2.y))
				verlauf += "l" + Str(Abs(von2.x - bis2.x))
			Else
				verlauf += "r" + Str(Abs(von2.x - bis2.x))
				verlauf += IIf(von2.y < bis2.y,"u","o") + Str(Abs(von2.y - bis2.y))
			EndIf
		
	End Select
	
	'endabschnitt
	Select Case bis.typ And &b111
		Case _oben
			verlauf += "u" + Str(Abs(bis.y - bis2.y))
		Case _unten
			verlauf += "o" + Str(Abs(bis.y - bis2.y))
		Case _rechts
			verlauf += "l" + Str(Abs(bis.x - bis2.x))
		Case _links
			verlauf += "r" + Str(Abs(bis.x - bis2.x))
	End Select
	
	'pfeilspitze, wenn muster <> "punkt"
	If bit(bis.typ, 3) = 0 Then
		verlauf += "p"
	EndIf
	
	pfeil(von, verlauf, text, farbe) 'zeichnen

End Sub

Function tDiagramm.pfeil(von As tPunkt, verlauf As String, text As String = "", farbe As ULong = RGBA(255,255,255,255)) As tPunkt
	Dim As Integer a = 1, h
	Dim As String richtung
	Dim As tPunkt p1, p2 = von
	Dim As Integer spitzenlaenge = 8 'länge der pfeilspitze
	
	'optionalen text ausgeben
	Select Case von.typ And &b111
		Case _oben
			Draw String grafikpuffer, (von.x + 2, von.y - 9), text, farbe
		Case _unten
			Draw String grafikpuffer, (von.x + 2, von.y + 2), text, farbe
		Case _rechts
			Draw String grafikpuffer, (von.x + 2, von.y - 9), text, farbe 'linksbündig über der linie
		Case _links
			Draw String grafikpuffer, (von.x -(Len(text) * 8 + 1), von.y - 9), text, farbe 'rechtsbündig über der linie
		Case Else
			Draw String grafikpuffer, (von.x + 2, von.y + 2), text, farbe
	End Select
	
	Do 'verlauf abarbeiten
		p1 = p2 'endpunkt als neuen anfangspunkt setzen
		Select Case Mid(verlauf,a,1)
			Case "o"
				a += 1 'zeiger auf längenangabe
				richtung = "o" 'letzte richtung merken
				p2.y -= Val(Mid(verlauf,a)) 'endpunkt setzen
				h = hindernis(p1,p2) 'auf hindernis prüfen
				If h Then 'linie nur bis zum hindernis zeichnen
					p2.y = p1.y - h
					If InStr(verlauf,"p") Then 'anweisung für pfeilspitze suchen
						a = InStrRev(verlauf,"p") 'pfeilspitze zeichnen
					Else
						a = Len(verlauf) 'linie beenden
					EndIf
				EndIf
				Line grafikpuffer, (p1.x, p1.y) - (p2.x, p2.y), farbe 'linie zeichnen
			Case "u"
				a += 1
				richtung = "u"
				p2.y += Val(Mid(verlauf,a))
				h = hindernis(p1,p2) 'auf hindernis prüfen
				If h Then 'linie nur bis zum hindernis zeichnen
					p2.y = p1.y + h
					If InStr(verlauf,"p") Then 'anweisung für pfeilspitze suchen
						a = InStrRev(verlauf,"p") 'pfeilspitze zeichnen
					Else
						a = Len(verlauf) 'linie beenden
					EndIf
				EndIf
				Line grafikpuffer, (p1.x, p1.y) - (p2.x, p2.y), farbe
			Case "r"
				a += 1
				richtung = "r"
				p2.x += Val(Mid(verlauf,a))
				h = hindernis(p1,p2) 'auf hindernis prüfen
				If h Then 'linie nur bis zum hindernis zeichnen
					p2.x = p1.x + h
					If InStr(verlauf,"p") Then 'anweisung für pfeilspitze suchen
						a = InStrRev(verlauf,"p") 'pfeilspitze zeichnen
					Else
						a = Len(verlauf) 'linie beenden
					EndIf
				EndIf
				Line grafikpuffer, (p1.x, p1.y) - (p2.x, p2.y), farbe
			Case "l"
				a += 1
				richtung = "l"
				p2.x -= Val(Mid(verlauf,a))
				h = hindernis(p1,p2) 'auf hindernis prüfen
				If h Then 'linie nur bis zum hindernis zeichnen
					p2.x = p1.x - h
					If InStr(verlauf,"p") Then 'anweisung für pfeilspitze suchen
						a = InStrRev(verlauf,"p") 'pfeilspitze zeichnen
					Else
						a = Len(verlauf) 'linie beenden
					EndIf
				EndIf
				Line grafikpuffer, (p1.x, p1.y) - (p2.x, p2.y), farbe
			Case "p" 'pfeilspitze
				spitzenlaenge = Val(Mid(verlauf,a + 1))
				If spitzenlaenge = 0 Then
					spitzenlaenge = 8 'defaultwert
				Else
					a += 1
				EndIf
				Select Case richtung 'richtung der letzten linie
					Case "o"
						Line grafikpuffer, (p2.x, p2.y + spitzenlaenge) - (p2.x, p2.y), hintergrundfarbe 'linie innerhalb des pfeils löschen
						Line grafikpuffer, (p2.x, p2.y) - (p2.x - spitzenlaenge/2, p2.y + spitzenlaenge), farbe 
						Line grafikpuffer, (p2.x, p2.y) - (p2.x + spitzenlaenge/2, p2.y + spitzenlaenge), farbe
						Line grafikpuffer, (p2.x + spitzenlaenge/2, p2.y + spitzenlaenge) - (p2.x - spitzenlaenge/2, p2.y + spitzenlaenge), farbe
					Case "u"
						Line grafikpuffer, (p2.x, p2.y - spitzenlaenge) - (p2.x, p2.y), hintergrundfarbe
						Line grafikpuffer, (p2.x, p2.y) - (p2.x + spitzenlaenge/2, p2.y - spitzenlaenge), farbe
						Line grafikpuffer, (p2.x, p2.y) - (p2.x - spitzenlaenge/2, p2.y - spitzenlaenge), farbe
						Line grafikpuffer, (p2.x - spitzenlaenge/2, p2.y - spitzenlaenge) - (p2.x + spitzenlaenge/2, p2.y - spitzenlaenge), farbe
					Case "r"
						Line grafikpuffer, (p2.x - spitzenlaenge, p2.y) - (p2.x, p2.y), hintergrundfarbe
						Line grafikpuffer, (p2.x, p2.y) - (p2.x - spitzenlaenge, p2.y - spitzenlaenge/2), farbe
						Line grafikpuffer, (p2.x, p2.y) - (p2.x - spitzenlaenge, p2.y + spitzenlaenge/2), farbe
						Line grafikpuffer, (p2.x - spitzenlaenge, p2.y - spitzenlaenge/2) - (p2.x - spitzenlaenge, p2.y + spitzenlaenge/2), farbe
					Case "l"
						Line grafikpuffer, (p2.x + spitzenlaenge, p2.y) - (p2.x, p2.y), hintergrundfarbe
						Line grafikpuffer, (p2.x, p2.y) - (p2.x + spitzenlaenge, p2.y - spitzenlaenge/2), farbe
						Line grafikpuffer, (p2.x, p2.y) - (p2.x + spitzenlaenge, p2.y + spitzenlaenge/2), farbe
						Line grafikpuffer, (p2.x + spitzenlaenge, p2.y - spitzenlaenge/2) - (p2.x + spitzenlaenge, p2.y + spitzenlaenge/2), farbe
				End Select
				a += 1
		End Select
		
		Do While InStr("0123456789 ", Mid(verlauf,a,1)) 'zeiger hinter längenangabe setzen
			a += 1
		Loop
	Loop While a <= Len(verlauf)
	
	Select Case richtung
		Case "o"
			p2.typ = _oben
		Case "u"
			p2.typ = _unten
		Case "r"
			p2.typ = _rechts
		Case "l"
			p2.typ = _links
	End Select
	
	Return p2	

End Function

Function tDiagramm.hindernis(von As tPunkt, bis As tPunkt) As Integer
	Dim As Integer i, d
	
	If von.x = bis.x Then 'senkrechte linie
		d = Abs(von.y - bis.y)
		For i = 1 To d
			If Point(von.x, von.y + IIf(von.y < bis.y,i,-i), grafikpuffer) <> hintergrundfarbe Then
				'                                       |  |_nach oben
				'                                       |____nach unten 
				Return i
			EndIf
		Next
	ElseIf von.y = bis.y Then 'waagerechte linie
		d = Abs(von.x - bis.x)
		For i = 1 To d
			If Point(von.x + IIf(von.x < bis.x,i,-i), von.y, grafikpuffer) <> hintergrundfarbe Then
				'                                |  |_nach links
				'                                |____nach rechts 
				Return i
			EndIf
		Next
	EndIf
	Return 0
	
End Function