Drawing an ishihara (color blind test)?

Miscellaneous Forums/General Discussion/Drawing an ishihara (color blind test)?

The forum is locked. These are the original blitzbasic.com forums, kept so they can still be read. No new topics, replies or edits can be made here. To join in, head over to the Blitz3D+ forums.

Rck: Thanks for the example. I converted the second one to BlitzMax as I don't have BlitzPlus, and added space to stop it. :-)


Graphics 800,600,0,2
ft = CreateTimer(60)

SeedRnd(MilliSecs())

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Type ball
	Field x#, y#, r
End Type

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Global failsInARow = 0
Global maxFails = 50
Global ballList:TList = CreateList()


Repeat

	If failsInARow < maxFails Then
		If addBall() Then
			failsInARow = 0
		Else
			failsInARow = failsInARow + 1
		EndIf
	EndIf
	
	If KeyHit(KEY_SPACE) Then
		failsInARow = 51
		EndIf
	'WaitEvent()
	
	Cls
	DrawBalls()
	Flip(0)

Until KeyHit(KEY_ESCAPE)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Function addBall()
	
	GW = GraphicsWidth()
	GH = GraphicsHeight()
	newR = Rand(5, 20)
	
	For a = 1 To 1000
		newx = Rand(newR, GW-newR)
		newy = Rand(newR, GH-newR)
		
		isgood = 1
		
		For eb:ball = EachIn ballList
			dx = (eb.x-newx)
			dy = (eb.y-newy)
			If dx*dx + dy*dy < (eb.r + newR)*(eb.r + newR) Then
				isgood = 0
				Exit
			EndIf
		Next
		
		If isgood = 1 Then
			nb:ball = New ball
			nb.x = newx
			nb.y = newy
			nb.r = newR
			ballList.AddLast(nb)
			Exit
		EndIf
	Next
	
	Return isGood
	
End Function

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Function DrawBalls()
	If failsInARow < maxFails Then
		For eb:ball = EachIn ballList
			DrawRect eb.x-eb.r, eb.y-eb.r, 2*eb.r, 2*eb.r
		Next
		DrawText 0,0,failsInARow
	Else
		For eb:ball = EachIn ballList
			DrawOval eb.x-eb.r, eb.y-eb.r, 2*eb.r, 2*eb.r
		Next
	EndIf
End Function



It's close to what I want, though a bit brute force like my current method. Will look into it further.