' Zufallskreise

Type kreis
	mx As Single
	my As Single
	r As Single
End Type

Const MAX_KREISE As Integer = 3000
Const MIN_ABSTAND As Single = 3.0
Const MIN_RAND As Single = 2.0
Const RADIUS_MIN As Single = 4.0
Const RADIUS_MAX As Single = 10.0
Const BREITE As Integer = 640
Const HOEHE As Integer = 480
Const MAX_VERSUCH As Integer = 1000

Randomize Timer

ScreenRes BREITE, HOEHE, 8
Width BREITE \ 8, HOEHE \ 16

Dim k(MAX_KREISE - 1) As kreis

Dim versuche As Integer = 0, anzKreise As Integer = 0
Dim xWeite As Single = CSng(BREITE) - 2.0 * MIN_RAND
Dim yWeite As Single = CSng(HOEHE) - 2.0 * MIN_RAND
Dim ok As Integer    ' sollte eigentlich Boolean sein!
Dim i As Integer

anzKreise = 0
versuche = 0

Function quad(x As Single)As Single
	quad = x * x
End Function

While anzKreise < MAX_KREISE And versuche < MAX_VERSUCH
	k(anzKreise).r = RADIUS_MIN + (RADIUS_MAX - RADIUS_MIN) * Rnd
	k(anzKreise).mx = MIN_RAND + k(anzKreise).r + (xWeite - 2.0 * k(anzKreise).r) * Rnd
	k(anzKreise).my = MIN_RAND + k(anzKreise).r + (yWeite - 2.0 * k(anzKreise).r) * Rnd
	ok = -1  ' wäre TRUE
	For i=0 To anzKreise - 1
		If quad(k(anzKreise).mx - k(i).mx) + quad(k(anzKreise).my - k(i).my) < _
		quad(k(anzKreise).r + MIN_ABSTAND + k(i).r) Then
			' liegt zu nahe zu einem bestehenden Kreis
			ok = 0  ' wäre FALSE
		EndIf
	Next i
	If ok Then
		' Kreis passt von der Verteilung her
		Circle(k(anzKreise).mx, k(anzKreise).my), k(anzKreise).r, 1 + anzKreise Mod 15 
		anzKreise += 1
		versuche = 0
	Else
		' Versuchszähler erhöhen, sonst kann Routine in Endlosschleife geraten, wenn einmal
		' alles ziemlich dicht belegt ist
		versuche += 1
	EndIf
Wend

Sleep
Print "Anzahl Kreise: "; anzKreise; !" Versuchsz\132hler: "; versuche
Sleep