back

Cfmake.pl

A summer or two back I started dabbling with a piece of software called Context Free (www.contextfree.org) which is a sorta procedural art program. Check it out, it's pretty fun and you can get some cool effects with it. What you do essentially is program what the picture is going to be made up of and how they're to be arranged. Ok, that's a bit too simple of a description because it does much more than that. Anyhow, the one thing you can't do with it is import any kind of bitmapped image, everything has to be made up of the primatives (squares, rectangles, triangles, etc) that the application comes with.

So, it got me to thinking, I've already got sofware that'll convert an image a pixel at a time into coloured letters - what's to stop me from re-using some of those same ideas and instead of creating text I'll output each pixel as a square primative that can be then loaded in Context Free? Turns out that there's nothing stopping me, so I knocked up the code below to do just that. It's a bit cludgy and things do start to slow down if you use large images, because remember that a 640 x 480 image is made up of 307200 pixels, so that's 307k of squares that the software has to manipulate for each use of the image. But, like I say on the homepage, I wrote it do a job for me - and I can put up with the limitations...


Example image of some clouds imported into Context Free and rendered into a coloured spiral.

usage: perl cfmake.pl image-filename rulename discard_black_flag
(if discard_black_flag is set to 1 then all areas of black in the image are set to transparent)
#!/usr/bin/perl

# create pixally squares for context free from an image
# cfmake.pl <image-filename> <rulename> <discard_black_flag>


use GD;

$imagefilename = $ARGV[0];
$rulename = $ARGV[1];
$discard_black = $ARGV[2];

$imagedata = GD::Image->new($imagefilename);

($width , $height) = $imagedata->getBounds();

print "rule $rulename {\n";

for ( $my = 0 ; $my < $height ; $my++ ) {
	for ( $mx = 0; $mx < $width ; $mx++ ) {
		( $mr , $mg , $mb ) = $imagedata->rgb( $imagedata->getPixel( $mx , $my ) );
		
		( $mh , $ms , $mv ) = n_rgr2hsv ( $mr , $mg , $mb );
		
		if ( ($mv <= 0.05) && ($discard_black == 1) ) { ;}
		else { output_shape ( $mx, -$my, 1, 1, $mh, $ms, $mv ); }
	}

}

print "}\n";
exit (0);

sub output_shape {							# x, y, sx, sy, h, sat, b 
	( $a , $b, $c , $d , $e , $f , $g) = @_;
	print "SQUARE { x $a y $b s $c $d h $e sat $f b $g }\n";
}


# linked to from http://www.perlmonks.com/?node_id=466191
# code taken out of http://search.cpan.org/src/JEFFA/Color-Spectrum-1.04/Spectrum.pm
# written by http://www.perlmonks.com/?node=extremely

sub rgb2hsi {
	my ( $r, $g, $b ) = @_;
	my ( $h, $s, $i ) = ( 0, 0, 0 );

	$i = ( $r + $g + $b ) / 3;
	return ( $h, $s, $i ) if $i == 0;

	my $x = $r - 0.5 * ( $g + $b );
	my $y = 0.866025403 * ( $g - $b );
	$s = ( $x ** 2 + $y ** 2 ) ** 0.5;
	return ( $h, $s, $i ) if $s == 0;

	$h = atan2( $y , $x ) / ( 2 * 3.1415926535 );
	return ( $h, $s, $i );
}


sub min3($$$){
  my $res=$_[0];
  $res=$_[1] if $res > $_[1];
  $res=$_[2] if $res > $_[2];
  $res;
}

sub max3($$$){
  my $res=$_[0];
  $res=$_[1] if $res < $_[1];
  $res=$_[2] if $res < $_[2];
  $res;
}


sub n_rgr2hsv {
	( $R, $G, $B) = @_;

	$var_R = ( $R / 255 );                     # RGB from 0 to 255
	$var_G = ( $G / 255 );
	$var_B = ( $B / 255 );

	$var_Min = min3( $var_R, $var_G, $var_B );    # Min. value of RGB
	$var_Max = max3( $var_R, $var_G, $var_B );    # Max. value of RGB
	$del_Max = $var_Max - $var_Min;             # Delta RGB value 

	$V = $var_Max;

	if ( $del_Max == 0 )                     # This is a gray, no chroma...
		{
   		$H = 0;                                # HSV results from 0 to 1
   		$S = 0;
	}
	else                                    # Chromatic data...
	{
		$S = $del_Max / $var_Max;

		$del_R = ( ( ( $var_Max - $var_R ) / 6 ) + ( $del_Max / 2 ) ) / $del_Max;
		$del_G = ( ( ( $var_Max - $var_G ) / 6 ) + ( $del_Max / 2 ) ) / $del_Max;
		$del_B = ( ( ( $var_Max - $var_B ) / 6 ) + ( $del_Max / 2 ) ) / $del_Max;

		if    ( $var_R == $var_Max ) { $H = $del_B - $del_G; }
		elsif ( $var_G == $var_Max ) { $H = ( 1 / 3 ) + $del_R - $del_B; }
		elsif ( $var_B == $var_Max ) { $H = ( 2 / 3 ) + $del_G - $del_R; }

		if ( $H < 0 ) { $H += 1; }
		if ( $H > 1 ) { $H -= 1; }
		$H = $H * 360;
	}
	return ( $H, $S, $V );
}

All this code is © 2006 - 2015, except for the noted pieces which are © to their authors as noted. Feel free to use anything you find here, I'm not that precious about it. Take it, improve it, make lots of cash with it, it's a gift.

back