view release on metacpan or  search on metacpan

lib/LaTeXML/Util/Image.pm  view on Meta::CPAN

# /=====================================================================\ #
# |  LaTeXML::Util::Image                                               | #
# | Image support for LaTeXML                                           | #
# |=====================================================================| #
# | Part of LaTeXML:                                                    | #
# |  Public domain software, produced as part of work done by the       | #
# |  United States Government & not subject to copyright in the US.     | #
# |---------------------------------------------------------------------| #
# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
# \=========================================================ooo==U==ooo=/ #
package LaTeXML::Util::Image;
use strict;
use warnings;
use LaTeXML::Global;
use LaTeXML::Common::Error;
use LaTeXML::Common::Dimension;
use LaTeXML::Util::Pathname;
use List::Util qw(min max);
use Image::Size;
use POSIX;
use base qw(Exporter);
our @EXPORT = (
  qw( &image_candidates &image_type &image_size ),
  qw( &image_classes &image_can_image &image_object ),
  qw( &image_write ),
  qw( &image_graphicx_parse &image_graphicx_is_trivial &image_graphicx_trivialize
    &image_graphicx_size &image_graphicx_trivial &image_graphicx_complex),
  qw( &image_graphicx_sizer),
);
# The initial idea here is to form a minimal interface to image operations
# and to shield LaTeXML from the 'unreliable' Image::Magick;
# Namely, it is hard to rely on as a dependency, since it is often
# difficult to port, or has mismatched versions or whatever.
# We do, at least, need to be able to get image size.....

our $DPI        = 100;          # [CONSTANT]
our $BACKGROUND = "#FFFFFF";    # [CONSTANT]

# Return cleaned-up path and list of candidate image files
# {We could, but dont, filter out non-image types, since extensions are so inconsistent.
# although we could query image_type which is more thorough)
sub image_candidates {
  my ($path) = @_;
  $path =~ s/^\s+//; $path =~ s/\s+$//;
  $path =~ s/^("+)(.+)\g1$/$2/;    # unwrap if in quotes
  my $searchpaths = $STATE->lookupValue('GRAPHICSPATHS');
  my @candidates  = pathname_findall($path, types => ['*'], paths => $searchpaths);
  if (!@candidates) {
    # if we have no candidates, also consult kpsewhich,
    # e.g. for "example-image-a"
    if (my $kpse_found = pathname_kpsewhich("$path.png", "$path.pdf")) {
      @candidates = ($kpse_found); } }
  if (my $base = $STATE->lookupValue('SOURCEDIRECTORY')) {
    @candidates = map { pathname_relative($_, $base) } @candidates; }
  return ($path, @candidates); }

# These environment variables can be used to limit the amount
# of time & space used by ImageMagick.  They are particularly useful
# when ghostscript becomes involved in converting postscript or pdf.
# HOWEVER, there are indications that the time limit (at least)
# is being measured against the whole latexml process, not just image processing.
# Thus they aren't really that useful here.
# They probably are useful in a server context, however, so I'll leave the comments.
# $ENV{MAGICK_DISK_LIMIT} = "2GiB" unless defined $ENV{MAGICK_DISK_LIMIT};
# $ENV{MAGICK_MEMORY_LIMIT} = "512MiB" unless defined $ENV{MAGICK_MEMORY_LIMIT};
# $ENV{MAGICK_MAP_LIMIT} = "1GiB" unless defined $ENV{MAGICK_MAP_LIMIT};
# $ENV{MAGICK_TIME_LIMIT} = "300" unless defined $ENV{MAGICK_TIME_LIMIT};

# Note that Image::Size may, itself, use Image::Magick, if available,
# as a fallback for getting image size & type!!!
# However, it seems not to recognize file types with extension .EPS (uppercase), eg!
sub image_type {
  my ($pathname) = @_;
  my ($w, $h, $t) = imgsize($pathname);
  # even though Image::Size CLAIMS to use Image::Magick as fallback... needs tickling?
  if (!(defined $w) && !(defined $h) && image_can_image()) {    # try harder!
    my $image = image_read($pathname) or return;
    ($t) = image_getvalue($image, 'format'); }
  # Note that Image::Magick (sometimes) returns "descriptive" types
  # (but I can't find a list anywhere!)
  $t = 'eps' if $t && $t =~ /postscript/i;
  return (defined $t ? lc($t) : undef); }

sub image_size {
  my ($pathname) = @_;
  # Annoyingly, ImageMagick uses the MediaBox instead of CropBox (as does graphics.sty) for pdfs.
  # Worse, imgsize delegates to ImageMagick, w/o ability to add options
  if (($pathname =~ /\.pdf$/i) && image_can_image()) {
    my $image = image_read($pathname) or return;
    return image_getvalue($image, 'width', 'height'); }
  my ($w, $h, $t) = imgsize($pathname);
  return ($w, $h) if $w && $h;
  if (image_can_image()) {    # try harder!
    my $image = image_read($pathname) or return;
    return image_getvalue($image, 'width', 'height'); } }

# This will be set once we've found an Image processing library to use [Daemon safe]
our $IMAGECLASS;    # cached class if we found one that works. [CONFIGURABLE?]
my @MagickClasses = (qw(Graphics::Magick Image::Magick));    # CONSTANT

sub image_classes {
  return @MagickClasses; }

sub image_can_image {
  my ($pathname) = @_;
  if (!$IMAGECLASS) {
    foreach my $class (@MagickClasses) {
      my $module = $class . ".pm";
      $module =~ s/::/\//g;
      my $object = eval {
        local $LaTeXML::IGNORE_ERRORS = 1;
        require $module; $class->new(); };
      if ($object) {
        $IMAGECLASS = $class;
        last; } } }
  return $IMAGECLASS; }

# return an image object (into which you can read), if possible.
sub image_object {
  my (%properties) = @_;
  return unless image_can_image();
  my $image = $IMAGECLASS->new(%properties);
  return $image; }

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Working with Image transformation options from the graphic(s|x) packages
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Note that viewport is supposed to be relative to bounding box,
# and EITHER ONE can cause clipping, if clip=true.
# However, apparently the INTENT of bounding box is simply to
# supply one, if one can't be found, in order to determine the image size.
# In our case, we may end up getting a gif, jpeg, etc, whose origin is always 0,0,
# and whose size is clear; also postscript figures sizes will be determined
# by ghostview(?).  Another use of setting a bounding box, when clip=false,
# is to make the image lay ontop of neighboring text.  This isn't quite
# possible in HTML, other than possibly through some tricky CSS.
# Besides, I'd like to avoid reading the bb file, if I can.
# --- So, for all these reasons, we simply ignore bounding box here.

sub image_graphicx_parse {
  my ($transformstring, %options) = @_;
  return [] unless $transformstring;
  local $_ = $_;
  my ($v, $clip, $trim, $width, $height, $xscale, $yscale,
    $aspect, $angle, $rotfirst, $mag, @bb, @vp,) = ('', '', '', 0, 0, 0, 0, '', 0, '', 1, 0);
  my @unknown = ();
  my @ignore  = @{ $options{ignore_options} || [] };
  foreach (split(/(?<!\\),/, $transformstring || '')) {
    if (/^\s*(\w+)(?:=\s*(.*))?\s*$/) {
      $_ = $1; $v = $2 || ''; $v =~ s/\\,/,/g;
      my $op = $_;
      if (grep { $op eq $_ } @ignore) { }                          # Ignore this option
      elsif (/^bb$/)                  { @bb                 = map { to_bp($_) } split(' ', $v); }
      elsif (/^bb(?:ll|ur)(?:x|y)$/)  { $bb[2 * /ur/ + /y/] = to_bp($v); }
      elsif (/^nat(?:width|height)$/) { $bb[2 + /width/]    = to_bp($v); }
      elsif (/^viewport$/)            { @vp = map { to_bp($_) } split(' ', $v); $trim = 0; }
      elsif (/^trim$/)                { @vp = map { to_bp($_) } split(' ', $v); $trim = 1; }
      elsif (/^clip$/)                { $clip   = !($v eq 'false'); }
      elsif (/^keepaspectratio$/)     { $aspect = !($v eq 'false'); }

lib/LaTeXML/Util/Image.pm  view on Meta::CPAN

  if (my $curr_ncolors = image_getvalue($image, 'colors')) {
    if (my $req_ncolors = $properties{ncolors}) {
      $req_ncolors = int($orig_ncolors * $1 / 100) if $req_ncolors =~ /^([\d]*)\%$/;
      if ($req_ncolors < $curr_ncolors) {
        image_internalop($image, 'Quantize', colors => $req_ncolors) or return; } } }

  if (my $quality = $properties{quality}) {
    image_setvalue($image, quality => $properties{quality}) or return; }

  if ($properties{prescale} && ($upsample != 1)) {    # Now downsample IF actually upsampled!
    image_internalop($image, 'Scale', geometry => $w / $upsample . 'x' . $h / $upsample) or return;
    ($w, $h) = image_getvalue($image, 'width', 'height');
    Debug("  Downsampled to $w x $h") if $LaTeXML::DEBUG{images}; }

  my ($watt, $hatt) = ($w / $zoomout, $h = $h / $zoomout);
  Debug("Transformed $source final size $w x $h, displayed as $watt x $hatt") if $LaTeXML::DEBUG{images};
  return ($image, $watt, $hatt); }

# Wrap up ImageMagick's methods to give more useful & consistent error handling.
# These all return non-zero on success!
# so, you generally want to do image_internalop(...) or return;

# This reads a new image, setting the given properties BEFORE ingesting the image data.
sub image_read {
  my ($source, @args) = @_;
  if (!$source) {
    Error('imageprocessing', 'read', undef, "No image source given"); return; }
  return unless $source;
  my $image = image_object();
  # Just in case this is pdf, set this option; ImageMagick defaults to MediaBox (Wrong!!!)
  image_internalop($image, 'Set',  option => 'pdf:use-cropbox=true') or return;
  image_internalop($image, 'Set',  @args)                            or return;
  image_internalop($image, 'Read', $source)                          or return;
  return $image; }

sub image_write {
  my ($image, $destination) = @_;
  if (!$image) {
    Error('imageprocessing', 'write', undef, "No image object!"); return; }
  if (!$destination) {
    Error('imageprocessing', 'write', undef, "No image destination!"); return; }
  # In the perverse case that we've ended up with a sequence of images; flatten them.
  if (@$image > 1) {
    my $fimage = $image->Flatten();    # Just in case we ended up with pieces!?!?!?
    $image = $fimage if $fimage; }
  return image_internalop($image, 'Write', filename => $destination); }

sub image_getvalue {
  my ($image, @args) = @_;
  if (!$image) {
    Error('imageprocessing', 'getvalue', undef, "No image object!"); return; }
  my @values = $image->Get(@args);
  return @values; }

sub image_setvalue {
  my ($image, @args) = @_;
  if (!$image) {
    Error('imageprocessing', 'setvalue', undef, "No image object!"); return; }
  return image_internalop($image, 'Set', @args); }

# Apparently ignorable warnings from Image::Magick
our %ignorable = map { $_ => 1; } (
  350,    # profile 'icc' not permitted on grayscale PNG
);

sub image_internalop {
  my ($image, $operation, @args) = @_;
  if (!$image) {
    Error('imageprocessing', 'internal', undef, "No image object!"); return; }
  my $retval = $image->$operation(@args);
  return 1 unless $retval;
  my $retcode = 999;
  if ($retval =~ /(\d+)/) {
    $retcode = $1; }
  if ($retcode < 400) {    # Warning
    Warn('imageprocessing', $operation, undef,
      "Image processing operation $operation (" . join(', ', @args) . ") returned $retval")
      unless $ignorable{$retcode};
    return 1; }
  else {                   # Error
    Error('imageprocessing', $operation, undef,
      "Image processing operation $operation (" . join(', ', @args) . ") returned $retval");
    return 0; } }

#======================================================================
1;