How can I create this effect?

BlitzMax Forums/BlitzMax Programming/How can I create this effect?


I want to create this effect, where, we have circles that "merge" when they are close. I can see how it would be impossible with sprites, and that you would need to draw the image with code on the fly.

Don't know what else to put in the post. :o

I depends on whether you want the outline of the objects to be a smooth curve or whether, as in your diagram, you simply want to have the outline be removed if it intersects another circle. If you want a smooth curve, which your diagram does not show, then you want blobby objects/metaballs. See my tutorial in the tutorials forum.

I see. Nice tutorial by the way, I loved it.

I actually only want the outline to be removed if it intersects. I have a game which involves a lot of bacteria, and it looks pretty ugly when a lot of bacteria are almost on top of each other, thus I want their edges to not overlap, but be merged.

Can you find their intersection points and then Drawpoly between those using the same colour as the sprite? You'll get the same problem though with the inner circle. Alternatively, don't have the outline?

Hm, yes, I'm starting to wonder if simply not having the outline would be the best option, and just using the proper BLEND to get the pale pink to merge.

When you draw the black outline first from both bacteria and then the pale pink on top it could simply hide the intersection underneath. But you need then two phases to draw, don't know if that works for you.

Here's a very simple example, that does what you want - just change the code to use Types and images etc.

Graphics 640,480

Global germ_x[50]
Global germ_y[50]

For n=0 To 49
 germ_x[n]=Rnd(0,640)
 germ_y[n]=Rnd(0,480)
Next

SetClsColor 255,255,255

Cls

While Not KeyHit(KEY_ESCAPE)

SetColor 0,0,0
For n=0 To 49
 DrawOval germ_x[n],germ_y[n],40,40
Next

SetColor 255,193,183
For n=0 To 49
 DrawOval germ_x[n]+2,germ_y[n]+2,36,36
Next


Flip

Cls

Wend
End


It would be more efficient to do something computational based on the pixels.

If you are willing to indulge in some custom OpenGL or DX coding you could draw all of the larger circle parts as filled circles in an OR logic operation, then use the resulting image to create some kind of outline of those shapes, perhaps by jittering or something, and then finally draw the centers of the objects.

Make layers. Draw borders first, then faces, etc. This would be the fastest way.

If it's only 2 sprites merging, then you could simply have a 3rd sprite image which you manipulate. I know...I cheat. :)

Thanks guys, but I've decided to drop the outline for simplicity, and also it kinda looks better. DX

You could fake an outline by drawing all your objects at a slight offset in a light color, then at another offset in a dark color, and then finally draw the normal colored objects. That would create a basic embossing effect.

I've wanted to be able to do this the proper algorithmic way for years, and yesterday I finally had a bout of inspiration!

Here's my code. It's pretty length, but to use it in your programs you can do with just copying everything above the example code, and the only bits you need to pay attention to are passing a list of circles to the intersectcircles function and doing whatever you want with the circle.draw method.

Type circle
	Field x#,y#,r#
	Field nonarcs:TList
	Field vx#,vy#

	Method New()
		nonarcs=New TList
	End Method

	Function Create:circle(x#,y#,r#)
		c:circle=New circle
		c.x=x
		c.y=y
		c.r=r
		an#=Rnd(360)
		v#=Rnd(.5,2)
		c.vx=v*Cos(an)
		c.vy=v*Sin(an)
		Return c
	End Function
	
	Method update()
		x:+vx
		If x<0 Or x>800
			vx=-vx
			x:+vx
		EndIf
		y:+vy
		If y<0 Or y>800
			vy=-vy
			y:+vy
		EndIf
	End Method
	
	Method intersect(c2:circle)
		debugo "<<<<<"
		dx#=c2.x-x
		dy#=c2.y-y
		d=Sqr(dx*dx+dy*dy)
		If d>=r+c2.r Then Return
		
		fullcircle:nonarc=nonarc.Create(0,360)
		If r>c2.r
			If d+c2.r<=r
				c2.nonarcs=New TList
				c2.nonarcs.addlast fullcircle
				debugo "removed second circle!"
				Return
			EndIf
		Else
			If d+r<=c2.r
				nonarcs=New TList
				nonarcs.addlast fullcircle
				debugo "removed first circle"
				Return
			EndIf
		EndIf
		
		dx:/d
		dy:/d
		
		b#=(r*r-c2.r*c2.r+d*d)/(2*d)
		theta#=ACos(b/r)
		phi#=ATan2(dy,dx)
		addnonarc(phi-theta,phi+theta)
		
		Rem
		If anbetween(0,phi-theta,phi+theta)
			SetColor 255,0,0
		Else
			SetColor 0,0,255
		EndIf
		
		x1#=x+Cos(phi-theta)*r
		y1#=y+Sin(phi-theta)*r
		x2#=x+Cos(phi+theta)*r
		y2#=y+Sin(phi+theta)*r
		DrawText "1",x1,y1
		DrawText "2",x2,y2
		
		SetColor 255,255,255
		EndRem
		
		theta2#=ACos((d-b)/c2.r)
		phi2#=phi+180
		c2.addnonarc(phi2-theta2,phi2+theta2)

		Rem
		x3#=c2.x+Cos(phi2-theta2)*c2.r
		y3#=c2.y+Sin(phi2-theta2)*c2.r
		x4#=c2.x+Cos(phi2+theta2)*c2.r
		y4#=c2.y+Sin(phi2+theta2)*c2.r
		DrawText "3",x3+5,y3
		DrawText "4",x4+5,y4
		EndRem
	End Method
	
	Method addnonarc(b1#,b2#)
		newna:nonarc=nonarc.Create(b1,b2)
		For na:nonarc=EachIn nonarcs
			debugo "compare "+newna.repr()+" with "+na.repr()
			If na.contains(b1)
				If na.contains(b2)
					If newna.contains(na.an1) And newna.contains(na.an2)
						debugo("both arcs contained in each other - full circle")
						nonarcs=New TList
						nonarcs.addlast nonarc.Create(0,360)
						Return
					EndIf
					debugo("new arc wholly contained in old arc")
					Return
				Else
					debugo("a1->b2")
					nonarcs.remove na
					addnonarc(na.an1,b2)
					Return
				EndIf
			Else
				If na.contains(b2)
					debugo("b1->a2")
					nonarcs.remove na
					addnonarc(b1,na.an2)
					Return
				Else
					If newna.contains(na.an1)
						debugo("old arc wholly contained in new arc")
						nonarcs.remove na
					Else
						debugo("arcs don't intersect")
					EndIf
				EndIf
			EndIf
		Next
		nonarcs.addlast newna
	End Method
	
	Method draw()
		DrawText nonarcs.count(),x+8,y
		Select nonarcs.count()
		Case 0 'this circle doesn't intersect any other, so just draw all of it
			drawarc(0,360)
		Case 1 'this circle intersects one other, so only need to look at one nonarc
			na:nonarc=nonarc(nonarcs.first())
			'If na.an1=0 And na.an2=360 Then Return
			drawarc(na.an2,na.an1)
		Default 'this circle intersects several others, so work through list of nonarcs, drawing 
				'from end of previous one to start of next one
			SortList nonarcs,True,nonarc.comparestarts
			ona:nonarc=nonarc(nonarcs.last())
			For na:nonarc=EachIn nonarcs
				drawarc(ona.an2,na.an1)
				ona=na
			Next
		End Select

		If drawnonarcs
			SetColor 255,0,0
			For na:nonarc=EachIn nonarcs
				drawarc(na.an1,na.an2)
			Next
			SetColor 255,255,255
		EndIf
	End Method
		
	Method drawarc(a#,b#)
		If b<a Then b:+360	
		steps=2*Pi*r/10
		s#=360.0/steps
		theta#=a
		ox#=x+r*Cos(theta)
		oy#=y+r*Sin(theta)
		While theta<b
			dx#=x+r*Cos(theta)
			dy#=y+r*Sin(theta)
			DrawLine ox,oy,dx,dy
			ox=dx
			oy=dy
			theta:+s
		Wend
		DrawLine ox,oy,x+r*Cos(b),y+r*Sin(b)
	End Method
End Type
Type nonarc
	Field an1#,an2#
	
	Function Create:nonarc(an1#,an2#)
		na:nonarc=New nonarc
		an1=an1 Mod 360
		If an1<0 Then an1:+360
		If an2<>360 Then an2=an2 Mod 360
		If an2<0 Then an2:+360
		na.an1=an1
		na.an2=an2
		Return na
	End Function
	
	Method contains(an#)
		d1#=andiff(an2,an1)
		If d1<0 Then d1:+360
		d2#=andiff(an,an1)
		If d2=0 Then Return 1
		If d2<0 Then d2:+360
		debugo "     "+d1
		debugo "     "+d2
		If d2<d1 Then Return 1 Else Return 0
	End Method
	
	Function comparestarts(o1:Object,o2:Object)
		na1:nonarc=nonarc(o1)
		na2:nonarc=nonarc(o2)
		If nicean(na1.an1)<nicean(na2.an1) Then Return -1 Else Return 1
	End Function
	
	Method repr$()
		Return "("+String(Int(an1))+","+String(Int(an2))+")"
	End Method
End Type

Function nicean#(an#)
	an=an Mod 360
	If an<=-180 Then an:+360
	Return an
End Function

Function andiff#(an1#,an2#)
	'debugo String(an1)+" , "+String(an2)
	If an2=0 And an1=360 Then Return 360
	dan#=(an1-an2) Mod 360
	If dan>180 dan:-360
	If dan<-180 dan:+360
	Return dan
End Function

Function anbetween(an#,an1#,an2#)
End Function

Function intersectcircles(circles:TList)
	For c:circle=EachIn circles
		c.nonarcs=New TList
	Next
	
	
	l:TList=circles.copy()
	While l.count()>1
		debugo "?????"
		c1:circle=circle(l.removefirst())
		For c2:circle=EachIn l
			c1.intersect(c2)
		Next
	Wend
End Function


''''TEST EXAMPLE


Global debugging=0

Function debugo(txt$)
	If debugging
		Print txt
	EndIf
End Function

Global drawnonarcs=0

circles:TList=New TList
SeedRnd MilliSecs()
For n=0 To 20
	circles.addlast circle.Create(Rand(300,500),Rand(300,500),Rand(30,100))
Next
c2:circle=circle.Create(400,400,80)
circles.addlast c2

Graphics 800,800,0

While Not KeyHit(KEY_ESCAPE) Or AppTerminate()
	c2.x=MouseX()
	c2.y=MouseY()
	
	If MouseHit(2)
		debugging=1
		debugo "------------------"
	Else
		debugging=0
	EndIf
	
	If MouseHit(1)
		drawnonarcs=1-drawnonarcs
	EndIf

	For c:circle=EachIn circles
		c.update()
	Next	
	
	intersectcircles(circles)
	
	For c:circle=EachIn circles
		c.draw()
	Next	
	
	DrawText "click mouse to see non-arcs",0,0

	Flip
	Cls
Wend


Nice effect!
Here's the superstrict version with locals declared and the like
SuperStrict
Type circle
	Field x:Float, y:Float, r:Float
	Field nonarcs:TList
	Field vx:Float, vy:Float

	Method New()
		nonarcs = New TList
	End Method

	Function Create:circle(x:Float, y:Float, r:Float)
		Local c:circle = New circle
		c.x = x
		c.y = y
		c.r = r
		Local an:Float = Rnd(360)
		Local v:Float = Rnd(.5, 2)
		c.vx = v * Cos(an)
		c.vy = v * Sin(an)
		Return c
	End Function
	
	Method update()
		x:+vx
		If x < 0 Or x > 800
			vx = -vx
			x:+vx
		EndIf
		y:+vy
		If y < 0 Or y > 800
			vy = -vy
			y:+vy
		EndIf
	End Method
	
	Method intersect(c2:circle)
		debugo "<<<<<"
		Local dx:Float = c2.x - x
		Local dy:Float = c2.y - y
		Local d:Int = Sqr(dx * dx + dy * dy)
		If d >= r + c2.r Then Return
		
		Local fullcircle:nonarc = nonarc.Create(0, 360)
		If r > c2.r
			If d + c2.r <= r
				c2.nonarcs = New TList
				c2.nonarcs.addlast fullcircle
				debugo "removed second circle!"
				Return
			EndIf
		Else
			If d + r <= c2.r
				nonarcs = New TList
				nonarcs.addlast fullcircle
				debugo "removed first circle"
				Return
			EndIf
		EndIf
		
		dx:/d
		dy:/d
		
		Local b:Float = (r * r - c2.r * c2.r + d * d) / (2 * d)
		Local theta:Float = ACos(b / r)
		Local phi:Float = ATan2(dy, dx)
		addnonarc(phi - theta, phi + theta)
		
		Local theta2:Float = ACos((d - b) / c2.r)
		Local phi2:Float = phi + 180
		c2.addnonarc(phi2 - theta2, phi2 + theta2)
	End Method
	
	Method addnonarc(b1:Float, b2:Float)
		Local newna:nonarc = nonarc.Create(b1, b2)
		For Local na:nonarc = EachIn nonarcs
			debugo "compare " + newna.repr() + " with " + na.repr()
			If na.contains(b1)
				If na.contains(b2)
					If newna.contains(na.an1) And newna.contains(na.an2)
						debugo("both arcs contained in each other - full circle")
						nonarcs = New TList
						nonarcs.addlast nonarc.Create(0, 360)
						Return
					EndIf
					debugo("new arc wholly contained in old arc")
					Return
				Else
					debugo("a1->b2")
					nonarcs.remove na
					addnonarc(na.an1, b2)
					Return
				EndIf
			Else
				If na.contains(b2)
					debugo("b1->a2")
					nonarcs.remove na
					addnonarc(b1, na.an2)
					Return
				Else
					If newna.contains(na.an1)
						debugo("old arc wholly contained in new arc")
						nonarcs.remove na
					Else
						debugo("arcs don't intersect")
					EndIf
				EndIf
			EndIf
		Next
		nonarcs.addlast newna
	End Method
	
	Method draw()
		DrawText nonarcs.count(), x + 8, y
		Select nonarcs.count()
			Case 0 'this circle doesn't intersect any other, so just draw all of it
				drawarc(0, 360)
			Case 1 'this circle intersects one other, so only need to look at one nonarc
				Local na:nonarc = nonarc(nonarcs.first())
				'If na.an1=0 And na.an2=360 Then Return
				drawarc(na.an2, na.an1)
				Default 'this circle intersects several others, so work through list of nonarcs, drawing 
				'from end of previous one to start of next one
				SortList nonarcs, True, nonarc.comparestarts
				Local ona:nonarc = nonarc(nonarcs.last())
				For Local na:nonarc = EachIn nonarcs
					drawarc(ona.an2, na.an1)
					ona = na
				Next
		End Select

		If drawnonarcs
			SetColor 255, 0, 0
			For Local na:nonarc = EachIn nonarcs
				drawarc(na.an1, na.an2)
			Next
			SetColor 255, 255, 255
		EndIf
	End Method
		
	Method drawarc(a:Float, b:Float)
		If b < a Then b:+360
		Local steps:Int = 2 * Pi * r / 10
		Local s:Float = 360.0 / steps
		Local theta:Float = a
		Local ox:Float = x + r * Cos(theta)
		Local oy:Float = y + r * Sin(theta)
		While theta < b
			Local dx:Float, dy:Float
			dx:Float = x + r * Cos(theta)
			dy:Float = y + r * Sin(theta)
			DrawLine ox, oy, dx, dy
			ox = dx
			oy = dy
			theta:+s
		Wend
		DrawLine ox, oy, x + r * Cos(b), y + r * Sin(b)
	End Method
End Type
Type nonarc
	Field an1:Float, an2:Float
	
	Function Create:nonarc(an1:Float, an2:Float)
		Local na:nonarc = New nonarc
		an1 = an1 Mod 360
		If an1 < 0 Then an1:+360
		If an2 <> 360 Then an2 = an2 Mod 360
		If an2 < 0 Then an2:+360
		na.an1 = an1
		na.an2 = an2
		Return na
	End Function
	
	Method contains:Int(an:Float)
		Local d1:Float = andiff(an2, an1)
		If d1 < 0 Then d1:+360
		Local d2:Float = andiff(an, an1)
		If d2 = 0 Then Return 1
		If d2 < 0 Then d2:+360
		debugo "     " + d1
		debugo "     " + d2
		If d2 < d1 Then Return 1 Else Return 0
	End Method
	
	Function comparestarts:Int(o1:Object, o2:Object)
		Local na1:nonarc = nonarc(o1)
		Local na2:nonarc = nonarc(o2)
		If nicean(na1.an1) < nicean(na2.an1) Then Return - 1 Else Return 1
	End Function
	
	Method repr:String()
		Return "(" + String(Int(an1)) + "," + String(Int(an2)) + ")"
			End Method
End Type

Function nicean:Float(an:Float)
	an = an Mod 360
	If an <= - 180 Then an:+360
	Return an
End Function

Function andiff:Float(an1:Float, an2:Float)
	'debugo String(an1)+" , "+String(an2)
	If an2 = 0 And an1 = 360 Then Return 360
	Local dan:Float = (an1 - an2) Mod 360
	If dan > 180 dan:-360
	If dan < - 180 dan:+360
	Return dan
End Function

Function anbetween(an:Float, an1:Float, an2:Float)
End Function

Function intersectcircles(circles:TList)
	For Local c:circle = EachIn circles
		c.nonarcs = New TList
	Next
	
	
	Local l:TList = circles.copy()
	While l.count() > 1
		debugo "?????"
		Local c1:circle = circle(l.removefirst())
		For Local c2:circle = EachIn l
			c1.intersect(c2)
		Next
	Wend
End Function


''''TEST EXAMPLE


Global debugging:Int = 0

Function debugo(txt:String)
	If debugging
		Print txt
	EndIf
End Function

Global drawnonarcs:Int = 0

Local circles:TList = New TList
SeedRnd MilliSecs()
For Local n:Int = 0 To 20
	circles.addlast circle.Create(Rand(300, 500), Rand(300, 500), Rand(30, 100))
Next
Local c2:circle = circle.Create(400, 400, 80)
circles.addlast c2

Graphics 800, 800, 0

While Not KeyHit(KEY_ESCAPE) Or AppTerminate()
	c2.x = MouseX()
	c2.y = MouseY()
	
	If MouseHit(2)
		debugging = 1
		debugo "------------------"
	Else
		debugging = 0
	EndIf
	
	If MouseHit(1)
		drawnonarcs = 1 - drawnonarcs
	EndIf

	For Local c:circle = EachIn circles
		c.update()
	Next
	
	intersectcircles(circles)
	
	For Local c:circle = EachIn circles
		c.draw()
	Next
	
	DrawText "click mouse to see non-arcs", 0, 0

	Flip
	Cls
Wend


thanks for that, ziggy

I don't think your girlfriend would like it if you did that.