Home

DrV :: Blog

Blog home | RSS gfx rss

02-24-2008

Cellular Textures in FreeBASIC

Cellular texture

I was poking around at some web sites and came across this page by Jim Scott about generating "cellular textures". It looked simple enough, so I decided to toss together a quick implementation in FreeBASIC (the built-in graphics library makes things like this quick and easy). This is the result after a few minutes.

I used 320x200x8bpp mode since I didn't bother to optimize the distance to nearest point as explained on that page, it runs rather slowly for larger image sizes, and I wanted to play around a bit with palette effects, seemingly a lost art in this age of 32-bit true-color displays. :) I ended up adding just a silly little glow-like effect on the red channel.

Anyway, here's the code, nearly a direct translation of the techniques described on that page:


const scrw = 320, scrh = 200
const numpts = 50

' 0 <= r,g,b <= 255
private function qbrgb(byval r as uinteger, byval g as uinteger, byval b as uinteger) as uinteger
	return (r shr 2) or ((g shr 2) shl 8) or ((b shr 2) shl 16)
end function

type Pt
	x as single
	y as single
end type

dim shared pts(0 to numpts - 1) as Pt
dim shared dist(0 to scrw, 0 to scrh) as single
dim shared pal(0 to 255) as uinteger
dim mindist as single = 999999
dim maxdist as single = 0

screenres scrw, scrh, 8

randomize timer

print "please wait..."

for i as integer = 0 to numpts - 1
	with pts(i)
		.x = int(rnd * scrw)
		.y = int(rnd * scrh)
	end with
next i


for y as integer = 0 to scrh - 1
	for x as integer = 0 to scrw - 1
		
		' this part can definitely be optimized... see the website linked above for info
		dim as single d = 999999
		for i as integer = 0 to numpts - 1
			var thisD = (x - pts(i).x)^2 + (y - pts(i).y)^2
			if thisD < d then d = thisD
		next i
		d = sqr(d)
		
		dist(x, y) = d
		
		if d < mindist then mindist = d
		if d > maxdist then maxdist = d
	next x
next y

for i as integer = 0 to 255
	pal(i) = qbrgb(i, i, i)
next i
palette using pal(0)

for y as integer = 0 to scrh - 1
	for x as integer = 0 to scrw - 1
		dim as single c = ((dist(x, y) - mindist) / (maxdist - mindist)) * 255
		pset (x, y), c
	next x
next y


dim as double startt = timer

do until len(inkey)
	for i as integer = 0 to 255
		pal(i) = qbrgb(sin((timer - startt) * 2) * 64 + 128, i, i)
	next i
	palette using pal(0)
loop

[category: /gfx | permalink ]


Powered by Blosxom
Last updated: 2008-Nov-24
Contact: daniel@drv.nu