Cellular Textures

This code has been declared by its author to be Public Domain code.

Cellular Textures by BlitzSupport

2009

This is just a quick hacky implementation of the method described in this great little article by Carsten Przyluczky:

http://www.gamedev.net/reference/programming/features/cellTxt/

I have only implemented the method outlined in the first section, "The basic approach", just to see if I could get it to work, so it's not fast. I recommend reading the article for suggestions as to how this can be improved or altered to create other patterns and speed it up. (I do intend to try the grid approach for the sake of creating cool tileable textures!)

' Array of pixels in 'texture' to be generated...

Local points:Float [256, 256]

' Number of random points to use for generating cells...

rpoints = 20 ' Play with this! Higher values get slower and slower...

' 2D point type...

Type Point
	Field x:Float
	Field y:Float
End Type

' Array of Point objects...

Local random:Point [rpoints]

' A list for the random points...

pointlist:TList = CreateList ()

' Display stuff...

Graphics 640, 480

gw2 = GraphicsWidth () / 2.0
gh2 = GraphicsHeight () / 2.0

SetBlend LIGHTBLEND
AutoMidHandle True

' Create a pixmap to draw to...

pix:TPixmap = CreatePixmap (256, 256, PF_RGB888)

' Main loop...

Repeat

	Cls

	' Delete last set of random points...
		
	ClearList pointlist
	
	' Generate new ones and add to list...
	
	For r = 0 To rpoints - 1
		pt:Point = New Point
		pt.x = Rand (0, 255)
		pt.y = Rand (0, 255)
		ListAddLast pointlist, pt
	Next
		
	' Iterate through all pixels in texture...
	
	For x = 0 To 255
	
		For y = 0 To 255
		
			' Set start values...
			
			closest# = 255
			furthest# = 0
			
			' For every pixel, find the nearest of the random points...
			
			For pt = EachIn pointlist
				d# = Dist (x, y, pt.x, pt.y)
				If d < closest Then closest = d
			Next
			
			' This pixel's colour value is based on distance to nearest random point...
			
			points [x, y] = closest
	
		Next
		
	Next
	
	' Have to scale the distance to 0-255 so it can be used to set the colour...

	scale# = 255.0 / closest
	
	' Scale each pixel's colour value to fit 0-255 (points is the pixel array)...
	
	For p:Float = EachIn points
		p = p * scale
	Next

	' Write colour value for each pixel into the pixmap...
	
	For x = 0 To 255
		For y = 0 To 255
			color = points [x, y]
			color = ((color Shl 16) + (color Shl 8) + color) ' Conversion to RGB...
			WritePixel pix, x, y, color
		Next
	Next
	
	' Grab image from bitmap so it can be scaled...
	
	image:TImage = LoadImage (pix)

	' Draw result! Try different combinations of the below...
	
	SetScale GraphicsWidth () / 256.0, GraphicsHeight () / 256.0
	SetColor 255, 255, 255
	DrawImage image, gw2, gh2

'	SetScale GraphicsWidth () / 256.0, -GraphicsHeight () / 256.0
'	SetColor 255, 0, 0
'	DrawImage image, gw2, gh2

'	SetScale -GraphicsWidth () / 256.0, GraphicsHeight () / 256.0
'	SetColor 0, 255, 0
'	DrawImage image, gw2, gh2

'	SetScale -GraphicsWidth () / 256.0, -GraphicsHeight () / 256.0
'	SetColor 0, 0, 255
'	DrawImage image, gw2, gh2

	' Draw the random points used for calculation...
	
	'SetColor 255, 0, 0
	
	'For pt = EachIn pointlist
	'	Plot pt.x, pt.y
	'Next
	
	Flip

Until KeyHit (KEY_ESCAPE)

End

' Distance between x/y points...

Function Dist:Float (x1:Float, y1:Float, x2:Float, y2:Float)
	Return Sqr (((x2 - x1) * (x2 - x1)) + ((y2 - y1) * (y2 - y1)))
End Function

Comments

2009

This is pretty cool. Thanks!
looks a lot like the Voronoi diagram. but less complicated.
too bad its not possible to get access to the lines and intersections created.

tesuji

2009

Very nice.

Spent an evening playing around with this and got the tileable version working. Still aesthetically prefer the un-optimized version somehow as it's a bit more random but tiling is useful.

SuperStrict

Graphics 1024, 768, 32

Local displayTiled:Int = True 

While Not KeyHit(KEY_ESCAPE)

	Cls
	
	If displayTiled	
		Local image:TImage = LoadImage(TextureGenerator.cellTileTexture(8,8))
		SetScale GraphicsWidth()/512.0, GraphicsHeight()/512.0
		SetColor 255,255,255
		DrawImage image, 0,0
		SetColor 200,255,255
		DrawImage image, GraphicsWidth()/2,0
		SetColor 200,255,255
		DrawImage image, 0,GraphicsHeight()/2
		SetColor 255,255,255
		DrawImage image, GraphicsWidth()/2,GraphicsHeight()/2
	Else
		Local image:TImage = LoadImage(TextureGenerator.cellTexture(64,256,256))
		SetScale GraphicsWidth()/256.0, GraphicsHeight()/256.0
		SetColor 255,255,255
		DrawImage image, 0,0
	End If
	
	If KeyHit(KEY_ENTER) Then displayTiled = Not displayTiled ' Press Enter to toggle texture
	While KeyDown(KEY_SPACE) ' hold down space to pause
		Delay(1)
	Wend 
	
	Flip

Wend

End

' ---------------------------------------------------------------------------------------------

Type Point
	Field x:Float
	Field y:Float
	Field neighbours:Point[9]
	
	Function clone:Point(from:Point, offsetX:Float=0.0, offsetY:Float=0.0)
		Local pt:Point = New Point
		pt.x = from.x + offsetX
		pt.y = from.y + offsetY
		Return pt	
	End Function
	
End Type


Type TextureGenerator

	' speed optimized - points are constrained to grid squares
	' tileable
	Function cellTileTexture:TPixmap(gridWidth:Int=8, gridHeight:Int=8, width:Int=256, height:Int=256)

		Local grid:Point[gridWidth,gridHeight]
		Local gridCellWidth:Int = width/gridWidth
		Local gridCellHeight:Int = height/gridHeight
		
		For Local x:Int = 0 To gridWidth-1
			For Local y:Int = 0 To gridHeight-1
				grid[x,y] = New Point
				grid[x,y].x = Rand(0,gridCellWidth)
				grid[x,y].y = Rand(0,gridCellHeight)
			Next
		Next

		' pre-generate neighbour points including screen wrap around
		For Local x:Int = 0 To gridWidth-1
			For Local y:Int = 0 To gridHeight-1
				Local x0:Int = (x+(gridWidth-1)) Mod gridWidth
				Local x1:Int = (x+1) Mod gridWidth
				Local y0:Int = (y+(gridHeight-1)) Mod gridHeight
				Local y1:Int = (y+1) Mod gridHeight
				grid[x,y].neighbours[0] = Point.clone(grid[x0,y0], -gridCellWidth,-gridCellHeight)
				grid[x,y].neighbours[1] = Point.clone(grid[x,y0], 0,-gridCellHeight)
				grid[x,y].neighbours[2] = Point.clone(grid[x1,y0], gridCellWidth,-gridCellHeight)
				grid[x,y].neighbours[3] = Point.clone(grid[x0,y], -gridCellWidth,0)
				grid[x,y].neighbours[4] = Point.clone(grid[x,y], 0,0)
				grid[x,y].neighbours[5] = Point.clone(grid[x1,y], gridCellWidth,0)
				grid[x,y].neighbours[6] = Point.clone(grid[x0,y1], -gridCellWidth,gridCellHeight)
				grid[x,y].neighbours[7] = Point.clone(grid[x,y1], 0,gridCellHeight)
				grid[x,y].neighbours[8] = Point.clone(grid[x1,y1], gridCellWidth,gridCellHeight)
			Next
		Next

		Local distances:Float[width, height]
		Local furthest:Float = 0.0

		' For every pixel, find the nearest of the random points and use the distance as colour		
		For Local x:Int = 0 To width-1	
			For Local y:Int = 0 To height-1
				Local closest:Float = 255.0
				Local gridX:Int = x/gridCellWidth
				Local gridY:Int = y/gridCellHeight
				Local gridPoint:Point = grid[gridX,gridY]
				Local xx:Int = x - (gridX*gridCellWidth) ' convert pixel to grid coords
				Local yy:Int = y - (gridY*gridCellHeight)		
				For Local pt:Point = EachIn gridPoint.neighbours
					Local distance:Float = Sqr(((pt.x-xx) * (pt.x-xx)) + ((pt.y-yy) * (pt.y-yy)))
					If distance < closest Then closest = distance
				Next
				distances[x,y] = closest ' distance from closest point
				If closest > furthest Then furthest = closest
			Next		
		Next

		Local pix:TPixmap = CreatePixmap (width, height, PF_RGB888)
		Local scale:Float = 255.0 / furthest

		' Write colour value for each pixel into the pixmap...			
		For Local x:Int = 0 To width-1
			For Local y:Int = 0 To height-1
				Local color:Int = distances[x, y]*scale
				color = ((color Shl 16) + (color Shl 8) + color)
				WritePixel pix, x, y, color
			Next
		Next
		
		Return pix

	End Function
	
	Function cellTexture:TPixmap(cells:Int=40, width:Int=256, height:Int=256)

		' create a set of random points
		Local pointlist:TList = New TList
		For Local r:Int = 0 To cells - 1
			Local pt:Point = New Point
			pt.x = Rand(0, width-1)
			pt.y = Rand(0, height-1)
			pointlist.addLast(pt)
		Next

		Local distances:Float[width, height]
		Local furthest:Float = 0.0		
		For Local x:Int = 0 To width-1	
			For Local y:Int = 0 To height-1
				Local closest:Float = 255.0
			
				' For every pixel, find the nearest of the random points...		
				For Local pt:Point = EachIn pointlist
					Local distance:Float = Sqr(((pt.x-x) * (pt.x-x)) + ((pt.y-y) * (pt.y-y)))
					If distance < closest Then closest = distance
				Next

				distances[x, y] = closest ' distance from closest point
				If closest > furthest Then furthest = closest
			Next		
		Next

		Local scale:Float = 255.0 / furthest
		Local pix:TPixmap = CreatePixmap (width, height, PF_RGB888)

		' Write colour value for each pixel into the pixmap...			
		For Local x:Int = 0 To width-1
			For Local y:Int = 0 To height-1
				Local color:Int = distances[x, y]*scale
				color = ((color Shl 16) + (color Shl 8) + color)
				WritePixel pix, x, y, color
			Next
		Next
		
		Return pix

	End Function

End Type

BlitzSupport

2010

Only just noticed this -- nice update, tesuji!

Code Archives Forum