he unpack code for ICO/CUR file handling could extend 32-bit unsigned values to 64...
[imager.git] / tools / imager
1 #!/usr/bin/perl -w
2 use strict;
3 use Imager;
4 use Getopt::Long;
5 use File::Spec;
6 use File::Basename qw(basename);
7 use vars qw($VERSION);
8
9 $VERSION="0.01_00";
10
11 my $help;
12 my $verbose;
13 my $backup; # backup extension name
14 my $directory; # output directory
15 my $output;
16 my $type;
17 my %write_opts; # options supplied to write()
18 my $understand;
19
20 my @collection; # actions/options in order to allow us to set values as needed
21
22 # each entry consists of:
23 #  - ref to action/option handler function
24 #  - help text
25 #  - optional ref to value parser function
26
27 my %funcs = im_functions();
28 my %options = im_options();
29 my %all = ( %funcs, %options );
30
31 my $action_func =
32   sub { 
33     my ($option, $value) = @_;
34     if ($all{$option}[1] && ref $all{$option}[1]) {
35       $value = $all{$option}[1]->($option, $value);
36     }
37     push @collection, [ $option, $value ] 
38   };
39
40 my $did_help;
41 my $help_func =
42   sub {
43     my ($option) = @_;
44
45     $option =~ s/help-//;
46     help_on($option);
47     ++$did_help;
48   };
49
50 my @getoptions;
51 for my $option_name (keys %all) {
52   my $option = $all{$option_name};
53   my @names = ( $option_name );
54   my @other_names = split /\|/, $option->[2] if $option->[2];
55   push @names, @other_names;
56   my $code = '';
57   if ($option->[1]) {
58     $code = ref $option->[1] ? "=s" : "=".$option->[1];
59   }
60   push @getoptions, join("|", @names) . $code => $action_func;
61   # this would be evil $all{$_} = $option for @other_names;
62   push @getoptions, join("|", map "help-$_", @names) => $help_func;
63 }
64
65 GetOptions('help' => sub { $help_func->("synopsis") },
66            'verbose|v+' => \$verbose,
67            'backup|i=s' => \$backup,
68            'directory|d=s' => \$directory,
69            'type|t=s' => \$type, # output file type
70            'write-option|wo=s' => \%write_opts,
71            'output|o=s' => \$output,
72            'understand' => \$understand,
73
74            @getoptions,
75
76            'help-color-spec' => sub { $help_func->("color specifications") },
77            'help-actions' => sub { $help_func->("actions") },
78            'help-options' => sub { $help_func->("processing options") },
79            'help-general' => sub { $help_func->("general options") },
80           )
81   or usage();
82
83 $did_help and exit;
84
85 unless ($understand) {
86   die <<EOS;
87 This tool is under-tested and will probably destroy your data.
88
89 If you understand and agree with this use the --understand option to
90 avoid this message.
91
92 In fact, only the --info and --tags actions have been used at all.
93 EOS
94 }
95
96 exists $write_opts{file}
97   and die "Illegal write option 'file'\n";
98 exists $write_opts{type}
99   and die "Use the --type option to set the output format\n";
100
101 delete $write_opts{qw/file fd fh data callback/};
102
103 my @actions = grep $funcs{$_->[0]}, @collection;
104
105 if ($help) {
106   if (@actions) {
107     print $funcs{$_}[1] for map $_->[0], @actions;
108     exit;
109   }
110   else {
111     usage();
112   }
113 }
114
115 if (!@actions && !@ARGV) {
116   usage();
117 }
118
119 unless (@ARGV) {
120   die "No files to process\n";
121 }
122
123 unless (@actions) {
124   die "Nothing to do, supply at least one action, see $0 --help\n";
125 }
126
127 my @type;
128 push @type, type => $type if $type;
129
130 for my $name (@ARGV) {
131   my $im = Imager->new;
132   if ($im->read(file=>$name)) {
133     my %state = ( filename => $name );
134
135     for my $action (@collection) {
136       $im = $all{$action->[0]}[0]->($im, $action->[1], \%state);
137       last unless $im;
138     }
139
140     if ($im) {
141       my $outname = $name;
142       if ($directory) {
143         my $file;
144         (undef, undef, $file) = File::Spec->split_path($outname);
145         $outname = File::Spec->catfile($directory, $file);
146       }
147       if ($backup) {
148         my $backfile = $name . $backup;
149         rename $name, $backfile
150           or die "Couldn't rename source '$name' to backup '$backfile': $!\n";
151       }
152
153       unless ($im->write(file=>$outname, @type)) {
154         die "Could not write result from '$name' to '$outname': ", $im->errstr,"\n";
155       }
156     }
157   }
158   else {
159     print STDERR "Failed reading $name: ",$im->errstr,"\n";
160   }
161 }
162
163 sub _replace_codes {
164   my ($im, $state, $format) = @_;
165
166   my %replace =
167     (
168      f => [ 's', $state->{filename} ],
169      b => [ 's', basename($state->{filename}) ],
170      w => [ 'd', $im->getwidth ],
171      h => [ 'd', $im->getheight ],
172      c => [ 'd', $im->getchannels ],
173      t => [ 's', $im->type ],
174      n => [ 'c', ord("\n") ], # a bit of a hack
175      '%' => [ '%' ],
176     );
177   my @values;
178   $format =~ s{%(-?(?:\d+(?:\.\d*)?|\.\d+)?)([fwhctbn%])}
179     {
180       my $which = $replace{$2};
181       push @values, @$which[1..$#$which];
182       "%$1$which->[0]"
183     }eg;
184
185   return sprintf $format, @values;
186 }
187
188 sub req_info {
189   my ($im, $ignored, $state) = @_;
190
191   my $format = $state->{info_format} || <<EOS;
192 Image: %f
193 Dimensions: %ww x %hh
194 Channels: %c
195 Type: %t
196 EOS
197
198   print _replace_codes($im, $state, $format);
199
200   return;
201 }
202
203 sub req_info_format {
204   my ($im, $value, $state) = @_;
205
206   $state->{info_format} = $value;
207
208   $im;
209 }
210
211 sub req_tags {
212   my ($im, $ignored, $state) = @_;
213
214   print $state->{filename},"\n";
215   my @tags = $im->tags;
216   for my $tag (sort { $a->[0] cmp $b->[0] } @tags) {
217     my $name = shift @$tag;
218     print "  $name: @$tag\n";
219   }
220
221   return;
222 }
223
224 sub req_palette {
225   my ($im, $ignored, $state) = @_;
226
227   print $state->{filename},"\n";
228   if ($im->type eq 'direct') {
229     print "  No palette - this is a direct color image\n";
230   }
231   else {
232     my @colors = $im->getcolors;
233     for my $index (0..$#colors) {
234       printf "%3d: (%3d, %3d, %3d)\n", $index, ($colors[$index]->rgba)[0..2];
235     }
236   }
237
238   return;
239 }
240
241 sub val_scale {
242   my ($option, $value) = @_;
243
244   my %options;
245   if ($option =~ /^(\d+)\s*x\s*(\d+)$/i) {
246     return { xpixels=>$1, ypixels=>$2 };
247   }
248   elsif ($option =~ /^(\d+(?:\.\d*)?|\.\d+)$/) {
249     return { scalefactor => $option };
250   }
251   elsif ($option =~ /^(\d+)\s*x\s*(\d+)\s*min$/i) {
252     return { xpixels=>$1, ypixels=>$2, type=>'min' };
253   }
254   elsif ($option =~ /^(\d+)\s*(?:w|wide)$/i) {
255     return { xpixels => $1 };
256   }
257   elsif ($option =~ /^(\d+)\s*(?:h|high)$/i) {
258     return { ypixels => $1 };
259   }
260   else {
261     die "Invalid parameter to --scale, try $0 --help-scale\n";
262   }
263 }
264
265 sub req_scale {
266   my ($im, $args) = @_;
267
268   return $im->scale(%$args);
269 }
270
271 sub val_rotate {
272   my ($option, $value) = @_;
273
274   if ($value =~ /^[-+]?(?:\d+(?:\.\d*)|\.\d+)$/) {
275     return { degrees => $value };
276   }
277   elsif ($value =~ /^([-+]?(?:\d+(?:\.\d*)|\.\d+))\s*(?:r|radians)$/i) {
278     return { radians => $1 };
279   }
280   else {
281     die "Invalid parameter to --rotate, try $0 --help-rotate\n";
282   }
283 }
284
285 sub req_rotate {
286   my ($im, $args, $state) = @_;
287
288   my @moreargs;
289   if ($state->{background}) {
290     push @moreargs, back => $state->{background};
291   }
292   return $im->rotate(%$args, @moreargs);
293 }
294
295 sub req_bg {
296   my ($im, $value, $state) = @_;
297
298   $state->{background} = $value;
299   
300   $im;
301 }
302
303 sub req_fg {
304   my ($im, $value, $state) = @_;
305
306   $state->{foreground} = $value;
307
308   $im;
309 }
310
311 sub req_font {
312   my ($im, $value, $state) = @_;
313
314   $state->{font} = Imager::Font->new(file=>$value)
315     or die "Could not create font from $value: ", Imager->errstr,"\n";
316
317   $im;
318 }
319
320 sub val_font_size {
321   my ($option, $value) = @_;
322
323   unless ($value =~ /^\d+$/ && $value > 0) {
324     die "$option must be a positive integer\n";
325   }
326
327   $value;
328 }
329
330 sub req_font_size {
331   my ($im, $value, $state) = @_;
332
333   $state->{font_size} = $value;
334
335   $im;
336 }
337
338 sub req_caption {
339   my ($im, $format, $state) = @_;
340
341   my $text = _replace_codes($im, $state, $format);
342
343   my $font = $state->{font}
344     or die "You must supply a --font option before the --caption command\n";
345
346   my $size = $state->{font_size} || 16;
347
348   my $box = $font->bounding_box(size=>$size);
349   $box->total_width <= $im->getwidth
350     or die "Caption text '$text' is wider (", $box->total_width, 
351       ") than the image (",$im->getwidth,")\n";
352
353   die "not implemented yet";
354 }
355
356 sub usage {
357   help_on("SYNOPSIS");
358   exit 1;
359 }
360
361 sub im_functions {
362   return
363     (
364      info => [ \&req_info ],
365      tags => [ \&req_tags ],
366      palette => [ \&req_palette ],
367      scale => [ \&req_scale, \&val_scale ],
368      rotate => [ \&req_rotate, \&val_rotate ],
369      # caption => [ \&req_caption ], # not done yet
370     );
371 }
372
373 sub val_color {
374   my ($option, $value) = @_;
375
376   if ($value =~ /^rgba\((\d+),(\d+),(\d+),(\d+)\)$/i) {
377     return Imager::Color->new($1,$2,$3,$4);
378   }
379   elsif ($value =~ /^rgb\((\d+),(\d+),(\d+)\)$/i) {
380     return Imager::Color->new($1,$2,$3);
381   }
382   elsif ($value =~ /^\#[\da-f]{3}([\da-f]{3})?$/) {
383     return Imager::Color->new(web=>$value);
384   }
385   elsif ($value =~ /^hsv\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+)\)$/) {
386     return Imager::Color->new(hsv => [ $1, $2, $3 ]);
387   }
388   elsif ($value =~ /^hsva\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+),(\d+)\)$/) {
389     return Imager::Color->new(hsv => [ $1, $2, $3 ], alpha=>$4);
390   }
391   else {
392     my $color = Imager::Color->new(name=>$value);
393     return $color if $color;
394
395     die "Unrecognized color specification $value supplied to --$option\n";
396   }
397 }
398
399 sub im_options {
400   return
401     (
402      background => [ \&req_bg, \&val_color, 'bg' ],
403      foreground => [ \&req_fg, \&val_color, 'fg' ],
404      'info-format' => [ \&req_info_format, 's'],
405      font => [ \&req_font, \&val_font ],
406      'font-size' => [ \&req_font_size, \&val_font_size, 'fs' ],
407     );
408 }
409
410 sub help_on {
411   my ($topic) = @_;
412
413   open SOURCE, "< $0" or die "Cannot read source for help text: $!\n";
414   my @lines;
415   while (<SOURCE>) {
416     # don't chomp it
417     if (/^=item --$topic\s/) {
418       push @lines, $_;
419       # read any more =items then read text until we see =item or =back
420       while (<SOURCE>) {
421         last unless /^\s*$/ or /^=item /;
422         push @lines, $_;
423       }
424       push @lines, $_;
425       # and any other until another option or =back
426       while (<SOURCE>) {
427         last if /^=(item|cut|back)/;
428         push @lines, $_;
429       }
430       print @lines;
431       return;
432     }
433     elsif (/^=head(\d) $topic\s*$/i) {
434       my $level = $1;
435       push @lines, $_;
436       while (<SOURCE>) {
437         last if /=head[1-$level]/;
438         push @lines, $_;
439       }
440
441       print @lines;
442       return;
443     }
444   }
445   close SOURCE;
446
447   die "No help topic $topic found\n";
448 }
449
450
451 sub help_color_spec {
452   print <<EOS;
453 EOS
454 }
455
456 =head1 NAME
457
458 imager - Imager command-line image manipulation tool
459
460 =head1 SYNOPSIS
461
462  imager --help
463  imager  [--font-size <size>] [--fs <size>] [--background <color>] 
464     [--bg <color>] [--foreground <color>] [--fg <color] 
465     [--info-format <format>] [--rotate <angle>] [--scale <scale-spec>] 
466     [--caption <text>] [--info] [--tags] [--font fontfile] files ...
467  imager --help-I<option>
468  imager --help-I<operation>
469  imager --help-options
470  imager --help-actions
471  imager --help-general
472  imager --help-colorspec
473
474 =head1 DESCRIPTION
475
476 =head1 ACTIONS
477
478 =over
479
480 =item --info
481
482 Displays the width, height, channels, type for each image, and any tags
483 Imager picks up.  No options.
484
485 Note: Imager still converts many files into direct images when the source
486 is a paletted image, so the displayed image type may not match the
487 source image type.
488
489 No output image file is produced.
490
491 =item --tags
492
493 Displays all the tags the Imager reader for that format sets for each
494 file.
495
496 See L<Imager::Files> for file format specific tags and
497 L<Imager::ImageTypes> for common tags.
498
499 =item --palette
500
501 Dumps the palette of the given file, if it is an indexed image.
502
503 =item --scale <scalefactor>
504
505 =item --scale <width>x<height>
506
507 =item --scale <width>x<height>min
508
509 =item --scale <width>w
510
511 =item --scale <height>h
512
513 Scale either by the given scaling factor, given as a floating point number,
514 or to a given dimension.
515
516 The scaling is always proportional, if a dimension is given then the
517 scalefactor that results in the larger image that matches either the 
518 specified width or height is chosen, unless the word "min" is present".
519
520   --scale 0.5         # half size image
521   --scale 100x100     # aim for 100 pixel x 100 pixel image
522   --scale 100x100min  # image that fits in 100 x 100 pixel box
523   --scale 100w        # 100 pixel wide image
524   --scale 100h        # 100 pixel high image
525
526 =item --rotate <degrees>
527
528 =item --rotate <radians>r
529
530 Rotate the image by the given number of degrees or radians.
531
532 =item --help
533
534 Displays the usage message if no extra parameter is found, otherwise displays
535 more detailed help for the given function, if any.
536
537 =item --caption text
538
539 Not implemented yet.
540
541 Expands the image to create a caption area and draws the given text in the
542 current font.
543
544 You must set a font with --font before this.
545
546   imager --font arial.ttf --caption "my silly picture"
547
548 The text has the same replacements done as the --info command.
549
550   imager --font arial.ttf --caption '%b - %w x %h'
551
552 If the caption text is too wide for the image an error is produced.
553
554 Any newlines that aren't at the beginning or end of the caption cause
555 multiple lines of text to be produced.
556
557 The --foreground and --background options can be used to set colors
558 for this.  By default black text on a white background is produced.
559
560 =back
561
562 =head1 GENERAL OPTIONS
563
564 =over
565
566 =item --help
567
568 Display the SYNOPSIS from this POD
569
570 =item --verbose
571
572 =item -v
573
574 Increase the verbosity level.
575
576 =item --backup <extension>
577
578 =item -i <extension>
579
580 Input files are renamed to I<filename><extension> before the output
581 file is written.
582
583 =item --directory <directory>
584
585 =item -d <directory>
586
587 If this is supplied the output files are written to this directory
588 instead of the 
589
590 =item --type <fileformat>
591
592 Specifies an output file format
593
594 =item --write-option name=value
595
596 =item --wo name=value
597
598 Sets the value of an option supplied to the Imager write() function.
599 The options available depend on the file format, see
600 L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
601 options.
602
603 You can also supply the L<Imager::ImageTypes/Common Tags>.
604
605 If you're writing to a gif file you can also supply the options
606 documented as tags under L<Imager::ImageTypes/Quantization options>.
607
608 =back
609
610 =head1 PROCESSING OPTIONS
611
612 These supply extra parameters to the actions
613
614 =over
615
616 =item --background <color-spec>
617
618 =item --bg <color-spec>
619
620 Sets the background color for the --rotate and --caption actions, and
621 possibly other actions in the future.
622
623 See $0 --help-color-spec for possible color specifications.
624
625   --bg red
626   --bg rgba(0,0,0,0)
627
628 =item --foreground <color-spec>
629
630 =item --fg <color-spec>
631
632 Sets the foreground color for the --caption action, and possibly other
633 actions in the future.
634
635 See $0 --help-color-spec for possible color specifications.
636
637   --fg red
638   --fg 'rgba(0,0,0,0)'
639
640 =item --font-size size
641
642 =item --fs size
643
644 Set the font size used by the --caption command, in pixels.
645
646   --fs 16  # 16 pixels from baseline to top
647   --font-size 40 # a bit bigger
648
649 =item --info-format format
650
651 Sets the format for the output of the --info command.
652
653 The format can contain printf style replacement codes, each value is %
654 followed by a sprintf() field width/precision, followed by the value
655 code.
656
657 The following values can be output:
658   w - image width in pixels
659   h - image height in pixels
660   f - full image filename
661   b - base image filename
662   c - number of channels
663   t - image type (direct vs paletted)
664   n - inserts a newline
665   % - inserts a '%' symbol
666
667 The default format is:
668
669  Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n
670
671 You can use field widths to produce a more table like appearance:
672
673   im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg
674
675 =item --font filename
676
677 Gives the name of a font file.  Required by actions that render text.
678
679   --font ImUgly.ttf
680   --font arial.ttf
681
682 =back
683
684 =head1 COLOR SPECIFICATIONS
685
686 Possible color specifications:
687   color-name - the name of a built-in color
688   rgb(red,green,blue) - as an RGB triplet
689   #RRGGBB - as a HTML RGB hex triple
690   #RGB - as a HTML CSS RGB hex triple
691   rgba(red,green,blue,alpha) - as an RGBA quad
692   hsv(hue,sat,value) - as an HSV triplet
693   hsva(hue,sat,value,alpha) as an HSVA quad
694
695 For example:
696
697   red
698   rgb(255,0,0)
699   #FF0000
700   hsv(180,1,1)
701
702 If you use either of the HTML color specifications, or a specification
703 using parentheses from a Unix shell you will need to quote it, for
704 example:
705
706   --fg '#FF0000'
707   --bg 'rgb(255,0,255)'
708
709 =head1 AUTHOR
710
711 Tony Cook <tony@develop-help.com>
712
713 =cut