Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

da (1525)

da
  (email not shown publicly)
http://coder.com/daniel/
AOL IM: daatcoderdotcom (Add Buddy, Send Message)
Public Calendar: Subscribe, Download

Linux and perl guy working for the Computer Science department [uwaterloo.ca] at the University of Waterloo [uwaterloo.ca]. For resume check here [coder.com].

Journal of da (1525)

Friday November 26, 2004
10:59 PM

Nine Block Quilt Patterns

[ #22024 ]
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;
}

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.