' Test Grafikobjekte mit Vererbung

Const Pi As Single = 4.0 * Atn(1.0)

Type Punkt
	x As Single
	y As Single
	Declare Constructor(x As Single, y As Single)
	Declare Constructor()
	Declare Sub Skaliere(z As Punkt, f As Single)
	Declare Sub Drehe(m As Punkt, f As Single)
End Type

Function mod2Pi(w As Single) As Single
	Return w - 2.0 * Pi * Int(w / 2.0 / Pi)
End Function

Type Zeichenobjekt Extends Object
	Protected:
		farbe As Long
		Declare Constructor(f As Long)
		Declare Constructor()
	Public:
		Declare Abstract Sub Zeichne()
		Declare Sub WechsleFarbe(fneu As Long)
		Declare Abstract Sub Skaliere(z As Punkt, f As Single)
		Declare Abstract Sub Drehe(m As Punkt, w As Single)
End Type

Type Linie Extends Zeichenobjekt
	Private:
		p1 As Punkt
		p2 As Punkt
	Public:
		Declare Constructor(p1 As Punkt, p2 As Punkt, f As Long)
		Declare Sub Zeichne() Override
		Declare Sub Skaliere(z As Punkt, f As Single) Override
		Declare Sub Drehe(m As Punkt, w As Single) Override
End Type

Type Kreis Extends Zeichenobjekt
	Protected:
		m As Punkt
		r As Single
		Declare Constructor()
	Public:
		Declare Constructor(m As Punkt, r As Single, f As Long)
		Declare Virtual Sub Zeichne() Override
		Declare Virtual Sub Skaliere(z As Punkt, f As Single) Override
		Declare Virtual Sub Drehe(m As Punkt, w As Single) Override
End Type

Type Bogen Extends Kreis
	Protected:
		sw As Single
		ew As Single
	Public:
		Declare Constructor(m As Punkt, r As Single, sw As Single, ew As Single, f As Long)
		Declare Sub Zeichne() Override
		Declare Sub Skaliere(z As Punkt, f As Single) Override
		Declare Sub Drehe(z As Punkt, w As Single) Override
End Type

Constructor Punkt(x As Single, y As Single)
	This.x = x
	This.y = y 
End Constructor

Sub Punkt.Skaliere(z As Punkt, f As Single)
	Dim dx As Single, dy As Single
	dx = x - z.x
	dy = y - z.y
	x = z.x + dx * f
	y = z.y + dy * f 
End Sub

Sub Punkt.Drehe(m As Punkt, w As Single)
	Dim dx As Single, dy As Single
	dx = x - m.x
	dy = y - m.y
	x = m.x + dx * Cos(w) + dy * Sin(w)
	y = m.y - dx * Sin(w) + dy * Cos(w)
End Sub

Constructor Punkt()
	x = 0.0
	y = 0.0
End Constructor

Constructor Zeichenobjekt(f As Long)
	farbe = f
End Constructor

Constructor Zeichenobjekt()
	farbe = 0
End Constructor

Sub Zeichenobjekt.WechsleFarbe(fneu As Long)
	farbe = fneu
End Sub

Constructor Linie(p1 As Punkt, p2 As Punkt, f As Long)
	Base(f)
	this.p1 = p1
	this.p2 = p2
End Constructor

Sub Linie.Zeichne()
	Line (p1.x, p1.y)-(p2.x, p2.y), farbe
End Sub

Sub Linie.Skaliere(z As Punkt, f As Single)
	p1.Skaliere z, f
	p2.Skaliere z, f
End Sub

Sub Linie.Drehe(m As Punkt, w As Single)
	p1.Drehe m, w
	p2.Drehe m, w	
End Sub

Constructor Kreis(m As Punkt, r As Single, f As Long)
	Base(f)
	this.m = m
	this.r = r
End Constructor

Constructor Kreis()
	Base(0)
	m = Punkt()
	r = 0.0
End Constructor

Sub Kreis.Zeichne()
	Circle (m.x, m.y), r, farbe ,,, 1.0
End Sub

Sub Kreis.Skaliere(z As Punkt, f As Single)
	m.Skaliere z, f
	r *= f
End Sub

Sub Kreis.Drehe(m As Punkt, w As Single)
	This.m.Drehe m, w
End Sub

Constructor Bogen(m As Punkt, r As Single, sw As Single, ew As Single, f As Long)
	Base(m, r, f)
	This.sw = mod2Pi(sw)
	This.ew = mod2Pi(ew)
End Constructor

Sub Bogen.Zeichne()
	Circle (m.x, m.y), r, farbe, sw, ew, 1.0
End Sub

Sub Bogen.Skaliere(z As Punkt, f As Single)
	' Möglicher Compilerbug (fbc 0.90.1): Geht nicht
	' Update 13.04.2015: Bei fbc 1.02.00 gefixt
	Base.Skaliere z, f
	' => Als Ersatz direkt ausprogrammiert (bei FBC 1.02.00 nicht mehr nötig)
	' Base.m.Skaliere z, f
	' Base.r *= f
End Sub

Sub Bogen.Drehe(m As Punkt, w As Single)
	' Möglicher Compilerbug: Geht nicht
	' Base.Drehe m, w
	' => Als Ersatz direkt ausprogrammiert
	Base.m.Drehe m, w
	sw = mod2Pi(sw + w)
	ew = mod2Pi(ew + w)
End Sub

Dim figur(...) As Zeichenobjekt Ptr => { New Linie(Punkt(370.0, 240.0), Punkt(520.0, 240.0), 5), _
  New Kreis(Punkt(570.0, 215.0), 25.0, 6), New Bogen(Punkt(570.0, 240.0), 50.0, 1.75 * Pi, Pi, 7) }
Dim i As Integer, j As Integer

ScreenRes 640, 480, 4
Width 80, 30

For i = 1 To 50
  For j = LBound(figur) To UBound(figur)
	  figur(j)->Zeichne()
	  figur(j)->Drehe Punkt(320.0, 240.0), 0.34
	  figur(j)->Skaliere Punkt(320.0, 240.0), 0.94
	  figur(j)->WechsleFarbe 1 + i Mod 15 
  Next j
Next i

Sleep