[Perl blog] Nine Block Quilt Patterns

[da]

I had fun today playing with GD.pm and quilting patterns. In "nine blocks" there are 9 squares, whose contents are limited to 16 basic patterns and radial symetry.

Here's a sample output:
3x3

The idea comes from this guy who has done some amazing artistry with Flash programming. While he has open-sourced his code, I don't have access to Macromedia products so I built it from the specs on that web page.

I'm currently planning to print out a whole lot of them on a sheet of photographic paper, as a present for a quilter.

It's got problems with it, but it's a start.

#!/usr/bin/perl
# nineblocks.pl - create assorted quilt patterns using 16 graphical primitives
#   and radial symetry.

#   Copyright (C) 2004 Daniel Allen.  It is distributed under the same
#   terms as Perl itself.  See the "Artistic License" in the Perl
#   source code distribution for licensing terms.

#   inspired by http://www.complexification.net/gallery/machines/nineblock/

use warnings;
use strict;
use GD;

my $XS = 20;    # dimensions of squares in pixels
my $XN = $XS*5; # dimensions of nineblocks in pixels

my $dim = 10;    # number of squares wide/tall
my $border = $XN/2;

my @squares = (
               "",
               ".5,1 1,1 1,.5",
               ".5,.5 .5,1 1,.5",
               "0,0 .5,.5 1,0",
               "0,.5 1,.5, .5,0",
               ".5,.5 .5,1 1,1 1,.5",
               ".25,.25 .25,.75 .75,.75 .75,.25",
               "0,1 .5,1 .5,.5 1,.5 1,0",
               "0,.5 1,1 .5,0",
               "0,0 .25,.5 .5,0 1,0 .75,.5 .5,0",
              # "0,0 .25,.5 .5,0 1,0 .75,.5 .5,0 .5,1, + .25,.5 .75,.5",
               "0,0 0,.5 1,1 .5,0",
               ".5,0 .5,1 1,1 1,0",
               "0,.5 .5,1 1,.5 .5,0",
               "0,0 .5,1 1,0",
               "0,1 1,1 1,0",
               "0,0 1,0 1,1 0,1"
               );

my @centers = (
              "",
              ".25,.25 .25,.75 .75,.75 .75,.25",
              "0,.5 .5,1 1,.5 .5,0",
              "0,0 1,0 1,1 0,1"
              );

my $image = new GD::Image($dim * $XN, $dim * $XN);
my $white = $image->colorAllocate(255,255,255); # background

my $xpos = 0;
my $ypos = 0;

OUT: while (1) {
    my $block = &nineblock(&r(3), &r(3), &r(15), &r(15), &r(3));
    $image->copy($block, $xpos, $ypos, 0, 0, $XN, $XN);
    $xpos += $XN;
    if ($xpos > (($dim ) * $XN)) {
        $xpos = 0;
        $ypos += $XN;
        if ($ypos > (($dim ) * $XN)) {
            last OUT;
        }
    }
}

# nineblocks are at left-top corner of their background
# (which might be useful for colored backgrounds, but not for white)
#
# new background should be: + 2 * border - the total offset of each 9square

my $background = new GD::Image($dim*$XN + 2*$border - 2*$XN/5,
                               $dim*$XN + 2*$border - 2*$XN/5);

$white = $background->colorAllocate(255,255,255);
$background->copy($image, $border, $border, 0, 0, $dim * $XN, $dim * $XN);

&display($background);

sub r {
    my ($max) = @_;
    int rand $max;
}

sub nineblock {
    # edgeRot     = 0-3 ( times 90 degrees)
    # cornerRot   = 0-3
    # edgeShape   = 0-15
    # cornerShape = 0-15
    # centerShape = 0-3

    my ($edgeRot, $cornerRot, $edgeShape, $cornerShape, $centerShape) = @_;

    my $image = new GD::Image(3*$XS,3*$XS);
    my $xpos = 0;

    my @face = (&square($edgeRot,   $squares[$edgeShape]),
                &square($cornerRot, $squares[$cornerShape]));

    my $center = &square(0, $centers[$centerShape]);

    $image->copy($center,
                 $XS, $XS, 0, 0, $XS, $XS);

    for (@face) {
        my $square = $_;#6&square($_);
        # $destimage->copy(srcImage, destX, destY, srcX, srcY, width, height)
        #
        # $destimage->copyResized(srcImage, destX, destY, srcX, srcY,
        #                         destWidth, destHeight, srcWidth, srcHeight)

        my $max = (2*$XS - $xpos);
        $image->copy($square, $xpos, 0, 0, 0, $XS, $XS);
        $image->copy($square->copyRotate90, 2*$XS, $xpos, 0, 0, $XS, $XS);
        $image->copy($square->copyRotate180, $max, 2*$XS, 0, 0, $XS, $XS);
        $image->copy($square->copyRotate270, 0, $max, 0, 0, $XS, $XS);
        $xpos += $XS;
    }
    return $image;
}

sub square {
    my ($rot, $points) = @_;

    my $image = new GD::Image($XS,$XS);

    my $polygon1 = new GD::Polygon;

    #my $white = $image->colorAllocate(&r(255),0,&r(255));
    my $white = $image->colorAllocate(255,255,255);
    my $black = $image->colorAllocate(&r(255),0,&r(255));
    #my $black = $image->colorAllocate(0,0,0);

    &add_points($polygon1, $points);

    $image->filledPolygon($polygon1, $black);
    $image->flipVertical;
    for (1 .. $rot) {
        $image = $image->copyRotate90;
    }
    return $image;
}

sub add_points {
    my ($poly, $points) = @_;

    foreach my $pair (split /\s/, $points) {
        $pair =~ /([\d.]+),([\d.]+)/;
        $poly->addPt($1 * $XS, $2 * $XS);
    }
}

sub display {
    my ($image) = @_;

    #   'display' program provided with ImageMagick
    open OUTFILE, "| display -" or die "couldn't open display";
    print OUTFILE $image->png;
    close OUTFILE;
}