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

scissors - divide an image in sub-images for easy printing

by polettix (Vicar)
on Aug 02, 2007 at 14:45 UTC ( [id://630287]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info
Description: This script helps in dividing an image into blocks that can be easily printed on a normal printer instead of an A0 plotter. Input images are divided into tiles whose dimensions can be established quite easily and flexibly. You can access the full documentation using the --man option.
#!/usr/bin/perl
use strict;
use warnings;
use Carp;
use Pod::Usage qw( pod2usage );
use Getopt::Long qw( :config gnu_getopt );
use version; my $VERSION = qv('0.0.1');
use English qw( -no_match_vars );
use File::Spec::Functions qw( splitpath );

# Other recommended modules (uncomment to use):
#  use IO::Prompt;
#  use Readonly;
#  use Data::Dumper;
use Image::Magick;

# Integrated logging facility
# use Log::Log4perl qw( :easy );
# Log::Log4perl->easy_init($DEBUG);

my %config = (bordercolor => 'white', overlap => 0);
GetOptions(
   \%config,    'usage',         'help',      'man',
   'version',   'tile|t=s',      'xtile|x=i', 'ytile|y=i',
   'tiles|T=s', 'bordercolor=s', 'overlap|o=i',
);
pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => '')
  if $config{version};
pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
  if $config{help};
pod2usage(-verbose => 2) if $config{man};

# Script implementation here
@config{qw( xtile ytile )} = split /x/, $config{tile}
  if exists $config{tile};

if (exists $config{tiles}) {
   @config{qw( ytiles xtiles )} = split(/x/, $config{tiles});
   $config{xtiles} = $config{ytiles} unless defined $config{xtiles};
}
pod2usage(-verbose => 99, -sections => 'USAGE')
  unless exists($config{xtile})
  || exists($config{ytile})
  || exists $config{tiles};

scissors_on($_) for @ARGV;

sub scissors_on {
   my ($filename) = @_;
   my ($volume, $directories, $file) = splitpath($filename);

   my $img = Image::Magick->new();
   $img->Read($filename);
   my ($xtot, $ytot) = $img->Get(qw( width height ));

   my ($xtile, $ytile) =
     get_tile_size(@config{qw( xtile ytile )}, $xtot, $ytot);

   my ($xntiles, $yntiles) = adapt_canvas($img, $xtile, $ytile);

   my $xtilew = $xtile + $config{overlap} * 2;
   my $ytilew = $ytile + $config{overlap} * 2;
   for my $xind (0 .. $xntiles - 1) {
      my $xoff = $xind * $xtile;
      for my $yind (0 .. $yntiles - 1) {
         my $yoff  = $yind * $ytile;
         my $clone = $img->Clone();
         $clone->Crop(geometry => "${xtilew}x$ytilew+$xoff+$yoff");
         $clone->Write("tile_${yind}-${xind}_$file");
      } ## end for my $yind (0 .. $yntiles...
   } ## end for my $xind (0 .. $xntiles...
} ## end sub scissors_on

sub adapt_canvas {
   my ($img, $xtile, $ytile) = @_;
   my ($xtot, $ytot) = $img->Get(qw( width height ));

   my $xdelta  = ($xtile - $xtot % $xtile) % $xtile;
   my $xntiles = ($xtot + $xdelta) / $xtile;
   my $ydelta  = ($ytile - $ytot % $ytile) % $ytile;
   my $yntiles = ($ytot + $ydelta) / $ytile;

   $xdelta += $config{overlap} * 2;
   $ydelta += $config{overlap} * 2;
   if ($xdelta || $ydelta) {
      my $xborder = int(($xdelta + 1) / 2);
      my $yborder = int(($ydelta + 1) / 2);
      $img->Border(
         width  => int(($xdelta + 1) / 2),
         height => int(($ydelta + 1) / 2),
         color  => $config{bordercolor},
      );
      $img->Crop(
         width  => $xtot += $xdelta,
         height => $ytot += $ydelta,
      );
   } ## end if ($xdelta || $ydelta)

   return ($xntiles, $yntiles);
} ## end sub adapt_canvas

sub other_with_ratio {
   my ($u, $utot, $vtot) = @_;
   my $p = $u * $vtot;
   return int($p / $utot) + (($p % $utot) ? 1 : 0);
}

sub get_tile_size {
   my ($xtile, $ytile, $xtot, $ytot) = @_;
   if (exists $config{xtiles}) {
      $xtile = int($xtot / $config{xtiles}) + ($xtot % $config{xtiles}
+ ? 1 : 0);
      $ytile = int($ytot / $config{ytiles}) + ($ytot % $config{ytiles}
+ ? 1 : 0);
   }
   else {
      $ytile = other_with_ratio($xtile, $xtot, $ytot)
        unless defined $ytile;
      $xtile = other_with_ratio($ytile, $ytot, $xtot)
        unless defined $xtile;
   } ## end else [ if (exists $config{tiles...
   return ($xtile, $ytile);
} ## end sub get_tile_size

__END__

=head1 NAME

scissors - divide an image in sub-images for easy printing


=head1 VERSION

See version at beginning of script, variable $VERSION, or call

   shell$ scissors --version


=head1 USAGE

   scissors [--usage] [--help] [--man] [--version]

   scissors [--bordercolor <color>] [--overlap|-o <width>]
      [--tile|-t <w>x<h>] [--xtile|-x <width>] [--ytile|-y <height>]
      [--tiles|-T <rows>x<cols>]
            

  
=head1 EXAMPLES

   shell$ scissors --usage

   # Divide image.jpg into 6 block parts, 2 rows and 3 columns
   shell$ scissors image.jpg -T 2x3

   # Divide image.jpg in tiles of exactly 254 pixel width
   # and 200 pixel height
   shell$ scissors image.jpg -t 254x200
   shell$ scissors image.jpg -x 254 -y 200

   # Divide image.jpg in tiles whose width is exactly 257 pixels, and
   # the height preserves aspect ratio with respect the whole image
   shell$ scissors image.jpg -x 257

   # Set background color of surrounding border to yellow
   shell$ scissors image.jpg -x 257 --bordercolor yellow

   # Make tiles overlap by 15 pixels
   shell$ scissors image.jpg -x 257 -o 15

  
=head1 DESCRIPTION

This script helps in dividing an image into blocks that can be easily 
+printed
on a normal printer instead of an A0 plotter. Input images are divided
+ into
tiles whose dimensions can be established quite easily and flexibly.

For example, you could evaluate your preferred tile size based on your
printing experience. If this is the case, it's pretty straightforward 
+to
generate tiles that are exactly this evaluated size:

   # Divide image.jpg in tiles of exactly 254 pixel width
   # and 200 pixel height
   shell$ scissors image.jpg -t 254x200
   shell$ scissors image.jpg -x 254 -y 200

On the other hand, if you aren't in the calculation mood, you can esta
+blish
a rough division of your image. Let's say that you want to divide it i
+nto
6 pieces, as in a table with two rows and three columns:

   shell$ scissors image.jpg -T 2x3

More than this, you could also want to have a little overlap between t
+he tiles, so that you can cut them more easily without fear of having
+ lame white
lines between the tiles. You can obtain this pretty straightforwardly:

   shell$ scissors image.jpg -t 1024x768 -o 50
   shell$ scissors image.jpg -T 2x3 -o 30

Setting an C<overlap> like this actually generates tile images that ar
+e
I<larger> than what you set. This is no surprise: the I<real> tile is
surrounded by C<overlap> pixels, so you end up with a width that is la
+rger
by the double of the C<overlap> itself, and the height accordingly.

Every time there is an offset, or one of the image dimensions is not
exactly divisible by the applicable input configuration, a border is a
+dded
around the image. This border is by default white, but you can also se
+t
the border color explicitly:

   shell$ scissors image.jpg -T 2x3 -o 30 --bordercolor yellow

Tiles are saved each in its own file. The file naming convention is th
+e
following (without the spaces):

   tile_ <row> - <column> _ <original-filename>

=head1 OPTIONS

=over

=item --bordercolor <color>

Set the color for the border, if any. The border size is evaluated
automatically based on various reasons (e.g. C<offset>, exact 
divisibility of the image sizes by the wanted width and height, etc.).

=item --help

print a somewhat more verbose help, showing usage, this description of
the options and some examples from the synopsis.

=item --man

print out the full documentation for the script.

=item --overlap <width>

Produce files that overlap by C<width> pixels. The resulting tile imag
+e
size is larger than what set, because the wanted tile is surrounded by
C<width> additional pixels in every direction.

=item --tile | -t <width>x<height>

This option allows to set the desired C<width> and C<height> of the ti
+le.
Note that the resulting image file can be larger than these values if
an C<overlap> is set as well.

=item --tiles | -T <rows>x<columns>

This option allows to specify in how many parts the image shall be
divided. Note that you specify this parameter in terms of C<rows> and
C<columns>, i.e. the value in the Y direction comes first.

As an example, if you set this parameter to C<3x2> you will end up wit
+h
6 tiles, that have to be arranged in 3 rows and 2 columns (presumibly
an image with vertical orientation).

=item --usage

print a concise usage line and exit.

=item --version

print the version of the script.

=item --xtile | -x <width>

=item --ytile | -y <height>

Set only the width or the height of the tile. See C<--tile|-t>.

=back

=head1 DIAGNOSTICS

The script shouldn't complain if you make it well. But I confess that
I'm not trying very hard (ehr - at all) to catch errors.


=head1 CONFIGURATION AND ENVIRONMENT

scissors requires no configuration files or environment variables.


=head1 DEPENDENCIES

You definitively need the following:

=over

=item *

Image::Magick

=item *

version

=back

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests through http://rt.cpan.org/

The generated tiles should have surrounding cut lines when using
C<overlapping>. Moreover, we should try more harder to catch errors.

There should be more flexibility in tile filename generation.


=head1 AUTHOR

Flavio Poletti C<flavio@polettix.it>


=head1 LICENCE AND COPYRIGHT

Copyright (c) 2006, Flavio Poletti C<flavio@polettix.it>. All rights r
+eserved.

This script is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>
and L<perlgpl>.

Questo script &#65533; software libero: potete ridistribuirlo e/o
modificarlo negli stessi termini di Perl stesso. Vedete anche
L<perlartistic> e L<perlgpl>.


=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WH
+EN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. TH
+E
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

=head1 NEGAZIONE DELLA GARANZIA

Poich&#65533; questo software viene dato con una licenza gratuita, non
c'&#65533; alcuna garanzia associata ad esso, ai fini e per quanto per
+messo
dalle leggi applicabili. A meno di quanto possa essere specificato
altrove, il proprietario e detentore del copyright fornisce questo
software "cos&#65533; com'&#65533;" senza garanzia di alcun tipo, sia 
+essa espressa
o implicita, includendo fra l'altro (senza per&#65533; limitarsi a que
+sto)
eventuali garanzie implicite di commerciabilit&#65533; e adeguatezza p
+er
uno scopo particolare. L'intero rischio riguardo alla qualit&#65533; e
+d
alle prestazioni di questo software rimane a voi. Se il software
dovesse dimostrarsi difettoso, vi assumete tutte le responsabilit&#655
+33;
ed i costi per tutti i necessari servizi, riparazioni o correzioni.

In nessun caso, a meno che ci&#65533; non sia richiesto dalle leggi vi
+genti
o sia regolato da un accordo scritto, alcuno dei detentori del diritto
di copyright, o qualunque altra parte che possa modificare, o redistri
+buire
questo software cos&#65533; come consentito dalla licenza di cui sopra
+, potr&#65533;
essere considerato responsabile nei vostri confronti per danni, ivi
inclusi danni generali, speciali, incidentali o conseguenziali, deriva
+nti
dall'utilizzo o dall'incapacit&#65533; di utilizzo di questo software.
+ Ci&#65533;
include, a puro titolo di esempio e senza limitarsi ad essi, la perdit
+a
di dati, l'alterazione involontaria o indesiderata di dati, le perdite
sostenute da voi o da terze parti o un fallimento del software ad
operare con un qualsivoglia altro software. Tale negazione di garanzia
rimane in essere anche se i dententori del copyright, o qualsiasi altr
+a
parte, &#65533; stata avvisata della possibilit&#65533; di tali danneg
+giamenti.

Se decidete di utilizzare questo software, lo fate a vostro rischio
e pericolo. Se pensate che i termini di questa negazione di garanzia
non si confacciano alle vostre esigenze, o al vostro modo di
considerare un software, o ancora al modo in cui avete sempre trattato
software di terze parti, non usatelo. Se lo usate, accettate espressam
+ente
questa negazione di garanzia e la piena responsabilit&#65533; per qual
+siasi
tipo di danno, di qualsiasi natura, possa derivarne.

=cut

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://630287]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (3)
As of 2024-04-25 05:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found