Drawing an ishihara (color blind test)?

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


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

SeedRnd(MilliSecs())

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

Type ball
	Field x#, y#, dx#, dy#, r, count, sumxforce#, sumyforce#
End Type
Global ballRad = 5
makeBalls()

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

pushing = 1

Repeat

	If KeyHit(57) Then
		If pushing = 1 Then
			pushing = 0
			setBalls()
		EndIf
	EndIf
	
	If pushing Then PushBalls()
	
	;WaitEvent()
	
	Cls
	If pushing Then
		DrawRects()
	Else
		DrawBalls()
	EndIf
	Flip(0)

Until KeyHit(1)

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

Function makeBalls()
	For a = 1 To 2000
		nb.ball = New ball
		nb\r = Rand(2,5) * 10
		nb\x = Rand(nb\r, GraphicsWidth()-nb\r)
		nb\y = Rand(nb\r, GraphicsHeight()-nb\r)
		nb\count = a
	Next
End Function

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

Function PushBalls()
	
	GW = GraphicsWidth()
	GH = GraphicsHeight()
	
	For eb.ball = Each ball	
		
		For eb2.ball = Each ball
		If eb\count < eb2\count Then
			xdif = eb\x - eb2\x
			ydif = eb\y - eb2\y
			
			If RectsOverlap(eb\x-eb\r,eb\y-eb\r,2*eb\r,2*eb\r , eb2\x-eb2\r,eb2\y-eb2\r,2*eb2\r,2*eb2\r) Then
				dist# = Sqr(xdif*xdif + ydif*ydif)
			
				xf# = xdif / dist / dist
				yf# = ydif / dist / dist
				
				eb\sumxforce = eb\sumxforce + xf
				eb\sumyforce = eb\sumyforce + yf
				
				eb2\sumxforce = eb2\sumxforce - xf
				eb2\sumyforce = eb2\sumyforce - yf
			EndIf
			
		EndIf
		Next
		
		midDist# = Sqr((GW/2 - eb\x)*(GW/2 - eb\x) + (GH/2 - eb\y)*(GH/2 - eb\y))
		eb\sumxforce = eb\sumxforce + (GW/2 - eb\x) / midDist# / 100
		eb\sumYforce = eb\sumYforce + (GH/2 - eb\y) / midDist# / 100
		
	Next
	
	
	
	For eb.ball = Each ball	
		eb\dx = eb\dx + eb\sumxforce
		eb\dy = eb\dy + eb\sumyforce
		
		eb\x = eb\x + eb\dx
		eb\y = eb\y + eb\dy
		
		eb\dx = eb\dx * 0.8
		eb\dy = eb\dy * 0.8
		
		If eb\x-eb\r < 0 Then
			eb\x = eb\r
		ElseIf eb\x + eb\r > GW
			eb\x = GW - eb\r
		EndIf
		
		If eb\y - eb\r < 0 Then
			eb\y = eb\r
		ElseIf eb\y + eb\r > GH
			eb\y = GH - eb\r
		EndIf
		
		eb\sumxforce# = 0
		eb\sumyforce# = 0
		
	Next
End Function

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

Function setBalls()

	For eb.ball = Each ball	
		
		minDist = -1
		
		For eb2.ball = Each ball
		If eb <> eb2 Then
			xdif = eb\x - eb2\x
			ydif = eb\y - eb2\y
			dist# = Sqr(xdif*xdif + ydif*ydif)
			
			If minDist = -1 Or dist < minDist
				minDist = dist
			EndIf
			
		EndIf
		Next
		
		eb\r = minDist/2
		
	Next

End Function

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

Function DrawRects()
	For eb.ball = Each ball	
		Rect eb\x-eb\r/2/2, eb\y-eb\r/2/2, 2*eb\r/2/2, 2*eb\r/2/2
		;Oval eb\x-eb\r, eb\y-eb\r, 2*eb\r, 2*eb\r, 0
	Next
End Function

Function DrawBalls()
	For eb.ball = Each ball
		Oval eb\x-eb\r, eb\y-eb\r, 2*eb\r, 2*eb\r, 0
	Next
End Function



Here's a rough idea in BlitzPlus code to generate some positions and sizes. It's rough.

Run this for a few dozen loops and then hit the Space Bar.

What do you all think?