2008/02/24 rss
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