Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options

Revenge of the Perl Quilt

by ailie (Friar)
on Mar 04, 2001 at 05:50 UTC ( #62069=CUFP: print w/replies, xml ) Need Help??

A while back I engaged in an experiment combining two of my interests - Perl and quilting. I was pleased with the outcome, and decided to continue working on my script to extend its capabilities. This version uses Image::Magick to create an image of the generated random layout.

#!/usr/bin/perl -w use strict; use Image::Magick; ### # Revenge of the Perl Quilt # - an extension of the original perl quilt generator that # uses ImageMagick to create a montage image of the generated layout # Ellen Knowlton Wilson, 3/3/01 ### my @swatch; my @quilt; my $number_of_blocks; my $number_of_columns; my $number_of_rows; my %numbers_to_fabrics; # This is a hash containing the # number and the location of the fabric images. For example, # my %numbers_to_fabrics = (1 => 'red.jpg', 2 => # 'yellow.jpg', 3 => 'blue.jpg') my $count = scalar keys %numbers_to_fabrics; # Prompt for the number of columns and rows desired. do { print "How many columns would you like? \n"; chomp($number_of_columns = <STDIN>); print "How many rows would you like? \n"; chomp($number_of_rows = <STDIN>); $number_of_blocks = $number_of_columns * $number_of_rows } # Check that the number of blocks is less than or equal # to the number of available fabrics. At this time, to # reuse a fabric requires that it be entered multiple times # in the hash. I'll probably revise this later. until ($number_of_blocks <= $count); @swatch=(1 .. $number_of_blocks); my $images = Image::Magick->new(); while (@swatch) { my $x = rand(@swatch); my $v = $swatch[$x]; # This print statement is useful for finding # typos in your file names. print "opening file $numbers_to_fabrics{$v}\n"; $images->Read($numbers_to_fabrics{$v}) && die "read failed"; push(@quilt, $v) && splice(@swatch, $x, 1); } # This prints the grid of numbers. print join(" ", splice(@quilt, 0, $number_of_columns)) ."\n" for (1..$number_of_rows); # This creates the montage of images. my $layout=$images->Montage(geometry=>'50x50+0+0',tile=>$number_of_col +umns); $layout->Write("quilt.jpg") && die "write failed";

Replies are listed 'Best First'.
Re: Revenge of the Perl Quilt
by Lexicon (Chaplain) on Mar 05, 2001 at 13:44 UTC
    Ack! How am I supposed to fit that in 168 squares?!?!? You need to make a bigger quilt!


Re: Revenge of the Perl Quilt
by tame1 (Pilgrim) on Mar 05, 2001 at 20:25 UTC
    Strange...I d/l'd from the d/l link. When I run this, it just keeps asking me for column and row numbers....over and over.
    Of course I did run "perl -pi.bak -e 's/\015//g'" on it to clean out the ^M's

    What does this little button do . .<Click>; "USER HAS SIGNED OFF FOR THE DAY"

      Corion is right - it doesn't run out of the box, since it needs image files of the fabrics. I have a tarball with the script and some sample swatches, so if anyone wants to play with it, /msg me and I'll pass that along.

      Good suggestions for features, Corion - I see this project growing. It's been a great way for me to learn Perl. I'd eventually like to have a web interface for it, where you could click checkboxes on which fabrics you want in the quilt, and enter a weighting factor for each fabric.

      This is because the code dosen't run out-of-the-box. You need to supply some "colors" (as numbers and filenames) for the quilt in the hash %numbers_to_fabrics.

      An interesting project would be to add the capability to read a directory full of images and mush them into a quilt. Also interesting would maybe be to add more user/error feedback - both projects can be easily completed by using Perlmonks Super Search (search for "Reading Directory" and/or File::Find) and by looking at the program code and carefully sprinkling print statements here and there.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://62069]
Approved by root
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2021-11-28 12:28 GMT
Find Nodes?
    Voting Booth?

    No recent polls found