' Film-Apfelmännchen

On Error GoTo Fehler

Dim datei As String, fh As Integer, zei As String, i As Integer, j As Integer
Dim xMinStart As Double=-3.2, yMinStart As Double=-1.8, yMaxStart As Double=1.8, k As Integer
Dim xMinEnd As Double=-0.032, yMinEnd As Double=-0.018, yMaxEnd As Double=0.018, teil2 As String
Dim zr0 As Double=0.0, zi0 As Double=0.0, iterMax As Integer=500, ausgDat As String="Frakt_"
Dim rFarb(63) As Integer, gFarb(63) As Integer, bFarb(63) As Integer, anzFarb As Integer=500
Dim breite As Integer=1280, hoehe As Integer=720, subaufl As Integer=1, anzBild As Integer=100
Dim zAufl As Integer=1

Dim faktTot As Double, faktEinz As Double, xZent As Double, yZent As Double
Dim pixSchritt As Double, xMinAkt0 As Double, yMaxAkt0 As Double
Dim pixSchritt0 As Double, zRend As Integer
Dim y As Integer, x As Integer, yRend As Integer, xRend As Integer
Dim rSum As Integer, gSum As Integer, bSum As Integer
Dim cr As Double, ci As Double, zr As Double, zi As Double, zr2 As Double, zi2 As Double

Function FuehrNull(w As Integer, b As Integer)As String
	Dim h As String
	
	h = Str(w)
	FuehrNull = String(b - Len(h), "0") + h
End Function

ScreenRes 640, 480
Width 80, 30

Input "Textdatei mit Metadaten"; datei

anzFarb = 0
fh = FreeFile
Open datei For Input As fh
i = 0
While Not Eof(fh)
	i += 1
	Line Input #fh, zei

	If zei <> Space(Len(zei)) And Left(zei, 1) <> "#" Then
		j = InStr(zei, "=")
		If j > 0 Then
			teil2 = Mid(zei, j + 1)
			Select Case LCase(Left(zei, j - 1))
				Case "farbe"
					' RGB-Eintrag
					If Len(teil2) = 7 And Left(teil2, 1) = "#" Then
						rFarb(anzFarb) = ValInt("&H" + Mid(teil2, 2, 2))
						gFarb(anzFarb) = ValInt("&H" + Mid(teil2, 4, 2))
						bFarb(anzFarb) = ValInt("&H" + Right(teil2, 2))
						anzFarb += 1
					Else
						Print "Syntaxfehler: Farbeintrag muss Format #RRGGBB in Hex sein"
					EndIf
				Case "konst"
					k = InStr(teil2, ",")
					If k > 0 Then
						zr0 = Val(Left(teil2, k - 1))
						zi0 = Val(Mid(teil2, k + 1))
					Else
						Print "Syntaxfehler: Muss Konst=real,img sein"
					EndIf
				Case "aufloes"
					k = InStr(teil2, "x")
					If k > 0 Then
						breite = ValInt(Left(teil2, k - 1))
						hoehe = ValInt(Mid(teil2, k + 1))
					Else
						Print !"Syntaxfehler: Aufl\148sung muss <Breite>x<Hoehe>, z.B. 1920x1080 sein"
					EndIf
				Case "subaufl"
					subaufl = ValInt(teil2)
				Case "zaufl"
					zAufl = ValInt(teil2)
				Case "anzbilder"
					anzBild = ValInt(teil2)
				Case "maxiter"
					iterMax = ValInt(teil2)
				Case "xminstart"
					xMinStart = Val(teil2)					
				Case "yminstart"
					yMinStart = Val(teil2)					
				Case "xmaxstart"
					yMaxStart = Val(teil2)					
				Case "xminend"
					xMinEnd = Val(teil2)					
				Case "yminend"
					yMinEnd = Val(teil2)					
				Case "ymaxend"
					yMaxEnd = Val(teil2)
				Case "bilddatei"
					ausgDat = teil2
				Case Else
					Print "Ungültiger Parameter in Zeile "; i
			End Select
		Else
			Print "Syntaxfehler in Zeile"; i
		EndIf		
	EndIf
Wend
Close fh

ScreenRes breite, hoehe, 24
' Ab hier Berechnung
faktTot = (yMaxEnd - yMinEnd) / (yMaxStart - yMinStart)
yZent = (yMinEnd - faktTot * yMinStart) / (1.0 - faktTot)
xZent = (xMinEnd - faktTot * xMinStart) / (1.0 - faktTot)
pixSchritt0 = (yMaxStart - yMinStart) / CDbl(hoehe * subaufl)

For i=0 To anzBild - 1
  For y=0 To hoehe - 1
  	 For x=0 To breite - 1
		rSum = (subaufl * subaufl * zAufl) \ 2
		gSum = rSum
		bSum = rSum
		For zRend=0 To zAufl - 1
			faktEinz = faktTot ^ (CDbl(i * zAufl + zRend) / CDbl(anzBild * zAufl - 1))
  			pixSchritt = pixSchritt0 * faktEinz
			xMinAkt0 = xZent + (xMinStart - xZent) * faktEinz + pixSchritt / 2.0
			yMaxAkt0 = yZent + (yMaxStart - yZent) * faktEinz - pixSchritt / 2.0
			For yRend = 0 To subaufl - 1
				For xRend = 0 To subaufl - 1
					cr = xMinAkt0 + pixSchritt * CDbl(x * subaufl + xRend)
					ci = yMaxAkt0 - pixSchritt * CDbl(y * subaufl + yRend)
					' Hier Mandelbrotalgorithmus (aus Geschwindigkeitsgründen ohne Klasse
					' mit komplexen Zahlen). TO DO: Threads!
					zr = zr0
					zi = zi0
					j = 0
					While j < iterMax And zr * zr + zi * zi < 4.0
						' Berechnung z(i+1) = z(i)^2 + c
						zr2 = zr * zr - zi * zi
						zi2 = 2.0 * zr * zi
						zr = zr2 + cr
						zi = zi2 + ci
						j += 1
					Wend
					If j = iterMax Then
						k = 0
					Else
						k = 1 + j Mod (anzFarb - 1)
					EndIf
					rSum += rFarb(k)
					gSum += gFarb(k)
					bSum += bFarb(k)
				Next xRend
			Next yRend
		Next zRend
		' Fertiger Pixel zeichnen
		PSet (x, y), RGB(rSum \ (subaufl * subaufl * zAufl), _
		gSum \ (subaufl * subaufl * zAufl), bSum \ (subaufl * subaufl * zAufl))
  	 Next x
  Next y
  BSave ausgDat + FuehrNull(i + 1, 5) + ".bmp", 0
  ' Test
  If InKey <> "" Then End
Next i

End

Fehler:
Print "Laufzeitfehler "; Err; " in "; Erl
Sleep
End