freetype-config might not be available, allow pkg-config to work

[imager.git] / tools / imager

#!/usr/bin/perl -w
use strict;
use Imager;
use Getopt::Long;
use File::Spec;
use File::Basename qw(basename);
use vars qw($VERSION);

$VERSION="0.01_00";

my $help;
my $verbose;
my $backup; # backup extension name
my $directory; # output directory
my $output;
my $type;
my %write_opts; # options supplied to write()
my $understand;

my @collection; # actions/options in order to allow us to set values as needed

# each entry consists of:
#  - ref to action/option handler function
#  - help text
#  - optional ref to value parser function

my %funcs = im_functions();
my %options = im_options();
my %all = ( %funcs, %options );

my $action_func =
  sub { 
    my ($option, $value) = @_;
    if ($all{$option}[1] && ref $all{$option}[1]) {
      $value = $all{$option}[1]->($option, $value);
    }
    push @collection, [ $option, $value ] 
  };

my $did_help;
my $help_func =
  sub {
    my ($option) = @_;

    $option =~ s/help-//;
    help_on($option);
    ++$did_help;
  };

my @getoptions;
for my $option_name (keys %all) {
  my $option = $all{$option_name};
  my @names = ( $option_name );
  my @other_names = split /\|/, $option->[2] if $option->[2];
  push @names, @other_names;
  my $code = '';
  if ($option->[1]) {
    $code = ref $option->[1] ? "=s" : "=".$option->[1];
  }
  push @getoptions, join("|", @names) . $code => $action_func;
  # this would be evil $all{$_} = $option for @other_names;
  push @getoptions, join("|", map "help-$_", @names) => $help_func;
}

GetOptions('help' => sub { $help_func->("synopsis") },
	   'verbose|v+' => \$verbose,
	   'backup|i=s' => \$backup,
	   'directory|d=s' => \$directory,
	   'type|t=s' => \$type, # output file type
	   'write-option|wo=s' => \%write_opts,
	   'output|o=s' => \$output,
           'understand' => \$understand,

	   @getoptions,

	   'help-color-spec' => sub { $help_func->("color specifications") },
           'help-actions' => sub { $help_func->("actions") },
           'help-options' => sub { $help_func->("processing options") },
           'help-general' => sub { $help_func->("general options") },
	  )
  or usage();

$did_help and exit;

unless ($understand) {
  die <<EOS;
This tool is under-tested and will probably destroy your data.

If you understand and agree with this use the --understand option to
avoid this message.

In fact, only the --info and --tags actions have been used at all.
EOS
}

exists $write_opts{file}
  and die "Illegal write option 'file'\n";
exists $write_opts{type}
  and die "Use the --type option to set the output format\n";

delete $write_opts{qw/file fd fh data callback/};

my @actions = grep $funcs{$_->[0]}, @collection;

if ($help) {
  if (@actions) {
    print $funcs{$_}[1] for map $_->[0], @actions;
    exit;
  }
  else {
    usage();
  }
}

if (!@actions && !@ARGV) {
  usage();
}

unless (@ARGV) {
  die "No files to process\n";
}

unless (@actions) {
  die "Nothing to do, supply at least one action, see $0 --help\n";
}

my @type;
push @type, type => $type if $type;

for my $name (@ARGV) {
  my $im = Imager->new;
  if ($im->read(file=>$name)) {
    my %state = ( filename => $name );

    for my $action (@collection) {
      $im = $all{$action->[0]}[0]->($im, $action->[1], \%state);
      last unless $im;
    }

    if ($im) {
      my $outname = $name;
      if ($directory) {
	my $file;
	(undef, undef, $file) = File::Spec->split_path($outname);
	$outname = File::Spec->catfile($directory, $file);
      }
      if ($backup) {
	my $backfile = $name . $backup;
	rename $name, $backfile
	  or die "Couldn't rename source '$name' to backup '$backfile': $!\n";
      }

      unless ($im->write(file=>$outname, @type)) {
	die "Could not write result from '$name' to '$outname': ", $im->errstr,"\n";
      }
    }
  }
  else {
    print STDERR "Failed reading $name: ",$im->errstr,"\n";
  }
}

sub _replace_codes {
  my ($im, $state, $format) = @_;

  my %replace =
    (
     f => [ 's', $state->{filename} ],
     b => [ 's', basename($state->{filename}) ],
     w => [ 'd', $im->getwidth ],
     h => [ 'd', $im->getheight ],
     c => [ 'd', $im->getchannels ],
     t => [ 's', $im->type ],
     n => [ 'c', ord("\n") ], # a bit of a hack
     '%' => [ '%' ],
    );
  my @values;
  $format =~ s{%(-?(?:\d+(?:\.\d*)?|\.\d+)?)([fwhctbn%])}
    {
      my $which = $replace{$2};
      push @values, @$which[1..$#$which];
      "%$1$which->[0]"
    }eg;

  return sprintf $format, @values;
}

sub req_info {
  my ($im, $ignored, $state) = @_;

  my $format = $state->{info_format} || <<EOS;
Image: %f
Dimensions: %ww x %hh
Channels: %c
Type: %t
EOS

  print _replace_codes($im, $state, $format);

  return;
}

sub req_info_format {
  my ($im, $value, $state) = @_;

  $state->{info_format} = $value;

  $im;
}

sub req_tags {
  my ($im, $ignored, $state) = @_;

  print $state->{filename},"\n";
  my @tags = $im->tags;
  for my $tag (sort { $a->[0] cmp $b->[0] } @tags) {
    my $name = shift @$tag;
    print "  $name: @$tag\n";
  }

  return;
}

sub req_palette {
  my ($im, $ignored, $state) = @_;

  print $state->{filename},"\n";
  if ($im->type eq 'direct') {
    print "  No palette - this is a direct color image\n";
  }
  else {
    my @colors = $im->getcolors;
    for my $index (0..$#colors) {
      printf "%3d: (%3d, %3d, %3d)\n", $index, ($colors[$index]->rgba)[0..2];
    }
  }

  return;
}

sub val_scale {
  my ($option, $value) = @_;

  my %options;
  if ($option =~ /^(\d+)\s*x\s*(\d+)$/i) {
    return { xpixels=>$1, ypixels=>$2 };
  }
  elsif ($option =~ /^(\d+(?:\.\d*)?|\.\d+)$/) {
    return { scalefactor => $option };
  }
  elsif ($option =~ /^(\d+)\s*x\s*(\d+)\s*min$/i) {
    return { xpixels=>$1, ypixels=>$2, type=>'min' };
  }
  elsif ($option =~ /^(\d+)\s*(?:w|wide)$/i) {
    return { xpixels => $1 };
  }
  elsif ($option =~ /^(\d+)\s*(?:h|high)$/i) {
    return { ypixels => $1 };
  }
  else {
    die "Invalid parameter to --scale, try $0 --help-scale\n";
  }
}

sub req_scale {
  my ($im, $args) = @_;

  return $im->scale(%$args);
}

sub val_rotate {
  my ($option, $value) = @_;

  if ($value =~ /^[-+]?(?:\d+(?:\.\d*)|\.\d+)$/) {
    return { degrees => $value };
  }
  elsif ($value =~ /^([-+]?(?:\d+(?:\.\d*)|\.\d+))\s*(?:r|radians)$/i) {
    return { radians => $1 };
  }
  else {
    die "Invalid parameter to --rotate, try $0 --help-rotate\n";
  }
}

sub req_rotate {
  my ($im, $args, $state) = @_;

  my @moreargs;
  if ($state->{background}) {
    push @moreargs, back => $state->{background};
  }
  return $im->rotate(%$args, @moreargs);
}

sub req_bg {
  my ($im, $value, $state) = @_;

  $state->{background} = $value;
  
  $im;
}

sub req_fg {
  my ($im, $value, $state) = @_;

  $state->{foreground} = $value;

  $im;
}

sub req_font {
  my ($im, $value, $state) = @_;

  $state->{font} = Imager::Font->new(file=>$value)
    or die "Could not create font from $value: ", Imager->errstr,"\n";

  $im;
}

sub val_font_size {
  my ($option, $value) = @_;

  unless ($value =~ /^\d+$/ && $value > 0) {
    die "$option must be a positive integer\n";
  }

  $value;
}

sub req_font_size {
  my ($im, $value, $state) = @_;

  $state->{font_size} = $value;

  $im;
}

sub req_caption {
  my ($im, $format, $state) = @_;

  my $text = _replace_codes($im, $state, $format);

  my $font = $state->{font}
    or die "You must supply a --font option before the --caption command\n";

  my $size = $state->{font_size} || 16;

  my $box = $font->bounding_box(size=>$size);
  $box->total_width <= $im->getwidth
    or die "Caption text '$text' is wider (", $box->total_width, 
      ") than the image (",$im->getwidth,")\n";

  die "not implemented yet";
}

sub usage {
  help_on("SYNOPSIS");
  exit 1;
}

sub im_functions {
  return
    (
     info => [ \&req_info ],
     tags => [ \&req_tags ],
     palette => [ \&req_palette ],
     scale => [ \&req_scale, \&val_scale ],
     rotate => [ \&req_rotate, \&val_rotate ],
     # caption => [ \&req_caption ], # not done yet
    );
}

sub val_color {
  my ($option, $value) = @_;

  if ($value =~ /^rgba\((\d+),(\d+),(\d+),(\d+)\)$/i) {
    return Imager::Color->new($1,$2,$3,$4);
  }
  elsif ($value =~ /^rgb\((\d+),(\d+),(\d+)\)$/i) {
    return Imager::Color->new($1,$2,$3);
  }
  elsif ($value =~ /^\#[\da-f]{3}([\da-f]{3})?$/) {
    return Imager::Color->new(web=>$value);
  }
  elsif ($value =~ /^hsv\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+)\)$/) {
    return Imager::Color->new(hsv => [ $1, $2, $3 ]);
  }
  elsif ($value =~ /^hsva\((\d+(?:\.\d*)),(\d+\.\d*|\.\d+),(\d+\.\d*|\.\d+),(\d+)\)$/) {
    return Imager::Color->new(hsv => [ $1, $2, $3 ], alpha=>$4);
  }
  else {
    my $color = Imager::Color->new(name=>$value);
    return $color if $color;

    die "Unrecognized color specification $value supplied to --$option\n";
  }
}

sub im_options {
  return
    (
     background => [ \&req_bg, \&val_color, 'bg' ],
     foreground => [ \&req_fg, \&val_color, 'fg' ],
     'info-format' => [ \&req_info_format, 's'],
     font => [ \&req_font, \&val_font ],
     'font-size' => [ \&req_font_size, \&val_font_size, 'fs' ],
    );
}

sub help_on {
  my ($topic) = @_;

  open SOURCE, "< $0" or die "Cannot read source for help text: $!\n";
  my @lines;
  while (<SOURCE>) {
    # don't chomp it
    if (/^=item --$topic\s/) {
      push @lines, $_;
      # read any more =items then read text until we see =item or =back
      while (<SOURCE>) {
        last unless /^\s*$/ or /^=item /;
        push @lines, $_;
      }
      push @lines, $_;
      # and any other until another option or =back
      while (<SOURCE>) {
        last if /^=(item|cut|back)/;
        push @lines, $_;
      }
      print @lines;
      return;
    }
    elsif (/^=head(\d) $topic\s*$/i) {
      my $level = $1;
      push @lines, $_;
      while (<SOURCE>) {
        last if /=head[1-$level]/;
        push @lines, $_;
      }

      print @lines;
      return;
    }
  }
  close SOURCE;

  die "No help topic $topic found\n";
}


sub help_color_spec {
  print <<EOS;
EOS
}

=head1 NAME

imager - Imager command-line image manipulation tool

=head1 SYNOPSIS

 imager --help
 imager  [--font-size <size>] [--fs <size>] [--background <color>] 
    [--bg <color>] [--foreground <color>] [--fg <color] 
    [--info-format <format>] [--rotate <angle>] [--scale <scale-spec>] 
    [--caption <text>] [--info] [--tags] [--font fontfile] files ...
 imager --help-I<option>
 imager --help-I<operation>
 imager --help-options
 imager --help-actions
 imager --help-general
 imager --help-colorspec

=head1 DESCRIPTION

=head1 ACTIONS

=over

=item --info

Displays the width, height, channels, type for each image, and any tags
Imager picks up.  No options.

Note: Imager still converts many files into direct images when the source
is a paletted image, so the displayed image type may not match the
source image type.

No output image file is produced.

=item --tags

Displays all the tags the Imager reader for that format sets for each
file.

See L<Imager::Files> for file format specific tags and
L<Imager::ImageTypes> for common tags.

=item --palette

Dumps the palette of the given file, if it is an indexed image.

=item --scale <scalefactor>

=item --scale <width>x<height>

=item --scale <width>x<height>min

=item --scale <width>w

=item --scale <height>h

Scale either by the given scaling factor, given as a floating point number,
or to a given dimension.

The scaling is always proportional, if a dimension is given then the
scalefactor that results in the larger image that matches either the 
specified width or height is chosen, unless the word "min" is present".

  --scale 0.5         # half size image
  --scale 100x100     # aim for 100 pixel x 100 pixel image
  --scale 100x100min  # image that fits in 100 x 100 pixel box
  --scale 100w        # 100 pixel wide image
  --scale 100h        # 100 pixel high image

=item --rotate <degrees>

=item --rotate <radians>r

Rotate the image by the given number of degrees or radians.

=item --help

Displays the usage message if no extra parameter is found, otherwise displays
more detailed help for the given function, if any.

=item --caption text

Not implemented yet.

Expands the image to create a caption area and draws the given text in the
current font.

You must set a font with --font before this.

  imager --font arial.ttf --caption "my silly picture"

The text has the same replacements done as the --info command.

  imager --font arial.ttf --caption '%b - %w x %h'

If the caption text is too wide for the image an error is produced.

Any newlines that aren't at the beginning or end of the caption cause
multiple lines of text to be produced.

The --foreground and --background options can be used to set colors
for this.  By default black text on a white background is produced.

=back

=head1 GENERAL OPTIONS

=over

=item --help

Display the SYNOPSIS from this POD

=item --verbose

=item -v

Increase the verbosity level.

=item --backup <extension>

=item -i <extension>

Input files are renamed to I<filename><extension> before the output
file is written.

=item --directory <directory>

=item -d <directory>

If this is supplied the output files are written to this directory
instead of the 

=item --type <fileformat>

Specifies an output file format

=item --write-option name=value

=item --wo name=value

Sets the value of an option supplied to the Imager write() function.
The options available depend on the file format, see
L<Imager::Files/TYPE SPECIFIC INFORMATION> for file format specific
options.

You can also supply the L<Imager::ImageTypes/Common Tags>.

If you're writing to a gif file you can also supply the options
documented as tags under L<Imager::ImageTypes/Quantization options>.

=back

=head1 PROCESSING OPTIONS

These supply extra parameters to the actions

=over

=item --background <color-spec>

=item --bg <color-spec>

Sets the background color for the --rotate and --caption actions, and
possibly other actions in the future.

See $0 --help-color-spec for possible color specifications.

  --bg red
  --bg rgba(0,0,0,0)

=item --foreground <color-spec>

=item --fg <color-spec>

Sets the foreground color for the --caption action, and possibly other
actions in the future.

See $0 --help-color-spec for possible color specifications.

  --fg red
  --fg 'rgba(0,0,0,0)'

=item --font-size size

=item --fs size

Set the font size used by the --caption command, in pixels.

  --fs 16  # 16 pixels from baseline to top
  --font-size 40 # a bit bigger

=item --info-format format

Sets the format for the output of the --info command.

The format can contain printf style replacement codes, each value is %
followed by a sprintf() field width/precision, followed by the value
code.

The following values can be output:
  w - image width in pixels
  h - image height in pixels
  f - full image filename
  b - base image filename
  c - number of channels
  t - image type (direct vs paletted)
  n - inserts a newline
  % - inserts a '%' symbol

The default format is:

 Image: %f%nDimensions: %ww x %hh%nChannels: %c%nType: %t%n

You can use field widths to produce a more table like appearance:

  im --info-format '%4w %4h %4c %-8t %b%n' --info *.jpg

=item --font filename

Gives the name of a font file.  Required by actions that render text.

  --font ImUgly.ttf
  --font arial.ttf

=back

=head1 COLOR SPECIFICATIONS

Possible color specifications:
  color-name - the name of a built-in color
  rgb(red,green,blue) - as an RGB triplet
  #RRGGBB - as a HTML RGB hex triple
  #RGB - as a HTML CSS RGB hex triple
  rgba(red,green,blue,alpha) - as an RGBA quad
  hsv(hue,sat,value) - as an HSV triplet
  hsva(hue,sat,value,alpha) as an HSVA quad

For example:

  red
  rgb(255,0,0)
  #FF0000
  hsv(180,1,1)

If you use either of the HTML color specifications, or a specification
using parentheses from a Unix shell you will need to quote it, for
example:

  --fg '#FF0000'
  --bg 'rgb(255,0,255)'

=head1 AUTHOR

Tony Cook <tony@develop-help.com>

=cut