Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

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
Node Status?
node history
Node Type: CUFP [id://62069]
Approved by root
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (12)
As of 2017-03-24 16:53 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (305 votes). Check out past polls.