#!/usr/bin/perl

# Copyright and (c) 2002, 2003 Jim Thomason. jim@jimandkoka.com
# http://www.jimandkoka.com
# distributed under the artistic license or something
#
# Note that this software requires the GD module, available from CPAN
# http://search.cpan.org/
#
# Usage - ./imagemaker.pl width height colors ?countonly? > some.png
#
# width is the image width
# height is the image height
# colors is the number of possible colors allowed in the image
# countonly is an optional param. If passed, the program will just 
#   print out a count of the number of combinations and then quit.
#

use strict;
use warnings;

use GD;

our $VERSION = 2.00;

#snag our command line arguments
my $w  = shift @ARGV or die 'Cannot run w/o width';
my $h  = shift @ARGV or die 'Cannot run w/o height';
my $c  = shift @ARGV or die 'Cannot run w/o colors';
my $s  = shift @ARGV || 1;
my $countonly = shift @ARGV || 0;

die "Cannot support more than 7 colors" if $c > 7 && ! $countonly;

#find out the number of pixel combinations
my $combos =  $c  ** ($w * $h);

#find out the unscaled area of each image set
my $unscaled_each_area = $w * $h;

#find out the area of each image set, taking the scaling into account
my $each_area = $unscaled_each_area * $s * $s;

#calculate how many we'd like to display per line.
my $perline = int sqrt $combos;
#round up if it's not an even number.
$perline += 1 unless $perline ** 2 == $combos;

# calculate the actual width and height of the image we're going 
# to generate. Each image will take up $w * $s pixels width + 
# $s pixels padding to its right but, the last image doesn't 
# require padding, so we subtract off its padding amount
#
# ditto for the height
my $width  = $perline * ($w * $s + $s) - $s;
my $height  = $perline * ($h * $s + $s) - $s;

#display some numbers
print STDERR "for a $w x $h image @ $c colors, "
  . "there are $combos combinations\n";

#and bow out if we're just counting
exit if $countonly;

#warn them about how big this thing is gonna get
print STDERR "your output will be $width x $height\n";

#create our new image
my $im = new GD::Image($width,$height);

# allocate some colors
#
# This is silly, we need to allocate red first, so we get that as 
# the background for our image. Bleh.
my $red    = $im->colorAllocate(255,0,0);
my $green  = $im->colorAllocate(0,255,0);
my $blue  = $im->colorAllocate(0,0,255);
my $cyan  = $im->colorAllocate(0,255,255);
my $magenta  = $im->colorAllocate(255,0,255);
my $yellow  = $im->colorAllocate(0,255,255);
my $black  = $im->colorAllocate(0,0,0);
my $white  = $im->colorAllocate(255,255,255);

# this is the order we want to use the colors
my @colors= ($white, $black, $green, $blue, $cyan, $magenta, $yellow);

#our padding starts at 0.
my $xpad = 0;
my $ypad = 0;

# and we're off to the races.
#
# It's pretty easy. iterate through all the numbers from
# 0 to the number of combinations we have. At each number,
# convert it from base 10 to the number base of the number
# of colors we have. So a B/W image is 2 colors is base 2.
# a black, white, and green image is 3 colors, is base 3
# and so on.
#
# With each base(x) number, each digit corresponds to a color
# value in our colors array. So use that color value to fill
# in the pixel at the appropriate square.
for (my $num = 0; $num < $combos; $num++) {

  # convert to the appropriate number base
  my @num = basemaster($num, 10, $c);
  
  # now, if we have fewer digits in the new base than we'll have
  # pixels in the image, zero pad the number until we reach the
  # appropriate size.
  if (@num < $unscaled_each_area) {
    @num = ((0) x ($unscaled_each_area - @num), @num);
  };

  {
    #keep track of which pixel we're on.
    my $pix    = 0;

    #we'll start drawing this image at the appropriate xpad
    # and ypad values
    my $x    = $xpad;
    my $y    = $ypad;
    
    #as long as we have pixels left to draw...
    while ($pix < $unscaled_each_area) {
      
      #grab our next color
      my $col = $colors[$num[$pix] || 0];
      
      #increment our pixel count
      # (yeah, I could've done the inc up in that last line,
      # but I didn't want it to get lost in the muck)
      $pix++;

      # and draw our pixel, scaled appropriately.
      # GD is a little silly, the arguments are the upper left
      # coordinates of the upper left pixel and the upper left
      # coordinates of the lower right pixel. So, to actually
      # set the lower right pixel to where we want, we need to back
      # up by one pixel to get it positioned properly
      $im->filledRectangle($x, $y, $x + $s - 1, $y + $s - 1, $col);
      
      # slide our y coordinate over by the scale value
      $y += $s;
      
      # okay, if $pix % $h == 0, then we're at the end of the row, so 
      # we'll need to drop to the next row by incrementing the xpad,
      # and go back to the first column by resetting the ypad.
      unless ($pix % $h) {

        $xpad += $s;
        $x = $xpad;
        $y = $ypad;
      };
  
    };
  };

  # okay, we've now finished drawing out the individual image, so
  # we're going to move onto the next in the sequence. So we're going
  # to slide our xpadding over by $s pixels to be
  # ready to start the next one. FYI, this is starting the image to
  # the right of the one just drawn
  $xpad += $s;
  
  # the one exception is if we've reached the perline limit. In that
  # case, we're at the end of the row, so we'll reset our xpad back
  # to zero and increment our ypad instead by the appropriate amount
  unless (($num + 1) % $perline) {
    $ypad += $h * $s + $s;
    $xpad = 0;
  };
};

#be nice and binmode it. Stupid dos.
binmode STDOUT;

#print
print $im->png;

exit;  #and we're done!


# basemaster takes 3 arguments.
# the number you're converting, the base you're converting from, and
# the base you're converting to
# Always returns an array of numbers in order, higher digits in the
# front, lower at the back.
# 
# so basemaster(13, 10, 2) returns (1, 1, 0, 1)

sub basemaster {
  my $num    = shift || return 0;
  my $from  = shift;
  my $to    = shift;

  # we allow it to accept a comma delimited number to allow for higher
  # bases
  my @num = reverse $num =~ /,/ ? split(/,/, $num) : split(//, $num);
  
  # starting power is 0
  my $pow = 0;

  # and we don't know it in base10
  my $base10 = undef;

  # if we're converting from base ten, then do it.
  if ($from != 10) {
    foreach my $digit (@num){
      die "Invalid number -- $digit >= $from" if $digit >= $from;
      $base10 += $digit * $from ** $pow++;
    };
  }
  # otherwise, we have a base 10 number, so there's no work to do.
  else {
    $base10 = $num;
  };
  
  #reset our power to 1
  $pow = 1;

  # and find the highest power of the number in the base we're
  # converting to
  $pow++ while $to ** $pow <= $base10;


  #we'll return our array here.
  my @return = ();

  #convert to the new base
  while ($pow >= 0){
    push @return, int ($base10 / $to ** $pow);
    $base10 %= $to ** $pow--;
  };
  
  #trash leading zeroes
  shift @return while $return[0] == 0;

  #and we are done.
  return @return;

};
[download]