Image-ExifTool
view release on metacpan or search on metacpan
lib/Image/ExifTool/Plot.pm view on Meta::CPAN
#------------------------------------------------------------------------------
# File: Plot.pm
#
# Description: Plot tag values in SVG format
#
# Revisions: 2025-02-14 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::Plot;
use strict;
use vars qw($VERSION);
$VERSION = '1.05';
# default plot settings (lower-case settings may be overridden by the user)
my %defaults = (
size => [ 800, 600 ], # width,height of output image
margin => [ 60, 15, 15, 30 ], # left,top,right,bottom margins around plot area
legend => [ 0, 0 ], # top,right offset for legend
txtpad => [ 10, 10 ], # padding between text and x,y scale
linespacing => 20, # text line spacing
# colours for plot lines
cols => [ qw(red green blue black orange gray fuchsia brown turquoise gold
lime violet maroon aqua navy pink olive indigo silver teal) ],
marks => [ qw(circle square triangle diamond star plus pentagon left down right) ],
stroke => 1, # stroke width and marker scaling
grid => 'darkgray', # grid colour
text => 'black', # text and plot frame colour
type => 'line', # plot type, 'line' or 'scatter'
style => '', # 'line', 'marker' or 'line+marker'
xlabel => '', # x axis label
ylabel => '', # y axis label
title => '', # plot title
nbins => 20, # number of histogram bins
# xmin, xmax # x axis minimum,maximum
# ymin, ymax # y axis minimum,maximum
# split # split list of numbers into separate plot lines
# bkg # background colour
# multi # flag to make one plot per dataset
#
# members containing capital letters are used internally
#
Data => { }, # data arrays for each variable
Name => [ ], # variable names
# XMin, XMax # min/max data index
# YMin, YMax # min/max data value
# SaveName, Save # saved variables between plots
);
my %markerData = (
circle => '<circle cx="4" cy="4" r="2.667"',
square => '<path d="M1.667 1.667 l4.667 0 0 4.667 -4.667 0 z"',
triangle => '<path d="M4 0.8 l2.667 5.333 -5.333 0 z"',
diamond => '<path d="M4 1 l3 3 -3 3 -3 -3 z"',
star => '<path d="M4 0.8 L5 2.625 7.043 3.011 5.617 4.525 5.881 6.589 4 5.7 2.119 6.589 2.383 4.525 0.957 3.011 3 2.625 z"',
plus => '<path d="M2.75 1 l2.5 0 0 1.75 1.75 0 0 2.5 -1.75 0 0 1.75 -2.5 0 0 -1.75 -1.75 0 0 -2.5 1.75 0 z"',
pentagon => '<path d="M4 1 L6.853 3.073 5.763 6.427 2.237 6.427 1.147 3.073 z"',
left => '<path d="M0.8 4 l5.333 2.667 0 -5.333 z"',
down => '<path d="M4 7.2 l2.667 -5.333 -5.333 0 z"',
right => '<path d="M7.2 4 l-5.333 2.667 0 -5.333 z"',
);
my @ng = (20, 15); # optimal number grid lines in X and Y for a 800x600 plot
my $wch = 8; # nominal width of a character (measured at 7.92)
#------------------------------------------------------------------------------
# Create new plot object
sub new
{
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool::Plot';
my $self = bless { }, $class;
foreach (keys %defaults) {
ref $defaults{$_} eq 'HASH' and $$self{$_} = { %{$defaults{$_}} }, next;
ref $defaults{$_} eq 'ARRAY' and $$self{$_} = [ @{$defaults{$_}} ], next;
$$self{$_} = $defaults{$_};
}
return $self;
}
lib/Image/ExifTool/Plot.pm view on Meta::CPAN
print $fp "\n<g dominant-baseline='hanging' text-anchor='middle'>";
$py = int(($margin[1] + $height + $$tpad[1]) * 10 + 0.5) / 10;
$px = int(($margin[0] + $width / 2) * 10 + 0.5) / 10;
if ($title) {
print $fp "\n<text x='${px}' y='14' font-size='150%'>$title</text>";
}
if ($xlabel) {
$y = $py + $$self{linespacing};
print $fp "\n<text x='${px}' y='${y}'>$xlabel</text>";
}
if ($ylabel) {
$y = $margin[1] + $height / 2;
print $fp "\n<text x='10' y='${y}' transform='rotate(-90,10,$y)'>$ylabel</text>";
}
# make sure the X labels will fit
my $spc = $dx;
for (;;) {
# find longest label at current spacing
my $len = 0;
my $x0 = int($xmax / $spc + 0.5) * $spc; # get value of last x label
for ($i=0, $x=$x0; $i<3; ++$i, $x-=$spc) {
$n = length sprintf('%g', $x);
$len = $n if $len < $n;
}
last if $spc >= ($len + 1) * $wch * $xdiff / $width;
# increase label spacing by one increment and try again
$spc = $dx2 = GetGridSpacing($spc, 1);
}
my ($grid, $lastLen) = ('', 0);
for ($x=int($xmin/$dx-1)*$dx; ; $x+=$dx) {
$px = int(($margin[0] + ($x - $xmin) * $width / $xdiff) * 10 + 0.5) / 10;
next if $px < $margin[0] - 0.5;
last if $px > $margin[0] + $width + 0.5;
my $h = $height;
if (not $dx2 or abs($x/$dx2 - int($x/$dx2+($x>0 ? 0.5 : -0.5))) < 0.01) {
printf $fp "\n<text x='${px}' y='${py}'>%g</text>", $x;
$h += $$tpad[1]/2;
}
length($grid) - $lastLen > 80 and $grid .= "\n", $lastLen = length($grid);
$grid .= sprintf("M$px $margin[1] v$h ");
}
print $fp "\n<path stroke='$$self{grid}' stroke-width='0.5' d='\n${grid}'/>";
print $fp "\n</g>\n<!-- Y axis -->\n<g dominant-baseline='middle' text-anchor='end'>";
$px = int(($margin[0] - $$tpad[0]) * 10 + 0.5) / 10;
($grid, $lastLen) = ('', 0);
my ($gx, $gw) = ($margin[0]-$$tpad[0]/2, $width + $$tpad[0]/2);
for ($y=$min; ; $y+=$dy) {
$py = int(($margin[1] + $height - ($y - $min) * $yscl) * 10 + 0.5) / 10;
last if $py < $margin[1] - 0.5;
$y = 0 if $y < $dy/2 and $y > -$dy/2; # (avoid round-off errors)
printf $fp "\n<text x='${px}' y='${py}'>%g</text>", $y;
$y < $dy/2 and $y > -$dy/2 and $xAxis = 1; # redraw x axis later
length($grid) - $lastLen > 80 and $grid .= "\n", $lastLen = length($grid);
$grid .= "M$gx $py h$gw ";
}
if ($xAxis and $min!=0) {
$py = $margin[1] + $height + $min * $yscl;
print $fp "\n<path stroke='$$self{text}' d='M$margin[0] $py h$width'/>";
}
print $fp "\n<path stroke='$$self{grid}' stroke-width='0.5' d='\n${grid}'/>";
print $fp "\n</g>\n<!-- Plot box and legend -->\n<g dominant-baseline='middle' text-anchor='start'>";
print $fp "\n<path stroke='$$self{text}' fill='none' d='M$margin[0] $margin[1] l0 $height $width 0 0 -$height z'/>";
for ($i=0; $i<@name and not $noLegend; ++$i) {
$x = $size[0] - $margin[2] - 175 + $$self{legend}[0];
$y = $margin[1] + $$self{legend}[1] + 15 + $$self{linespacing} * ($i + 0.5);
my $col = $$cols[$i];
my $mark = $markID{$i} ? " marker-end='url(#$markID{$i})' fill='none'" : '';
my $line = ($style =~ /\bl/) ? ' l-20 0' : sprintf(' m%.4g 0', -5 * $wid);
my $sw = ($style =~ /\bm/ ? 1.5 : 2) * $wid; # (wider for line-only style so colour is more visible)
print $fp "\n<path$mark stroke-width='${sw}' stroke='${col}' d='M$x $y m-7 -1${line}'/>";
print $fp "\n<text x='${x}' y='${y}'>$name[$i]</text>";
}
# print the data
foreach (0..$#name) {
$col{$name[$_]} = $$cols[$_];
$class{$name[$_]} = $markID{$_} ? " class='$markID{$_}'" : '';
}
my ($i0, $i1, $xsclr);
my $fill = '';
if ($scat) {
($i0, $i1) = (0, $#$xdat);
} elsif ($hist) {
($i0, $i1) = (0, $#$hist);
$xscl = $width / @$hist;
$px0 = $margin[0];
$xsclr = int($xscl * 100 + 0.5) / 100;
if ($style =~ /\bf/) {
my @m = split /-/, $$marks[0];
my $op = $m[3] || ($style =~ /\bl/ ? 20 : 50);
$fill = " fill='$$cols[0]'";
$fill .= " style='fill-opacity: $op%'" if $$cols[0] ne 'none';
}
} else {
$i0 = int($xmin) - 1;
$i0 = 0 if $i0 < 0;
$i1 = int($xmax) + 1;
}
print $fp "\n</g>\n<!-- Datasets -->\n<g fill='none' clip-path='url(#plot-area)'",
" stroke-linejoin='round' stroke-linecap='round' stroke-width='",1.5*$wid,"'>";
my $doLines = $style =~ /\bl/;
foreach (@name) {
my $stroke = ($hist and not $doLines) ? 'none' : $col{$_};
my $dat = $$data{$_};
print $fp "\n<!-- $_ -->";
print $fp "\n<path$class{$_}$fill stroke='${stroke}' d='";
print $fp 'M' if $doLines;
my $m = $doLines ? '' : ' M';
for ($i=$i0; $i<=$i1; ++$i) {
next unless defined $$dat[$i];
$y = int(($py0 - $$dat[$i] * $yscl) * 10 + 0.5) / 10;
if ($scat) {
next unless defined $$xdat[$i];
$x = int(($px0 + $$xdat[$i] * $xscl) * 10 + 0.5) / 10;
} else {
$x = int(($px0 + $i * $xscl) * 10 + 0.5) / 10;
if ($hist) {
print $fp $m, ($i % 5 ? ' ' : "\n"), "$x $y h$xsclr";
$m = ' L'; # (draw lines after the first point)
next;
}
}
print $fp $m, ($i % 10 ? ' ' : "\n"), "$x $y";
}
print $fp ' V', $margin[1]+$height, " H$margin[0] z" if $hist and $fill;
print $fp "'/>";
}
print $fp "\n</g>";
print $fp "\n</g>" if $numPlots > 1;
}
print $fp "</svg>\n" or $$self{Error} = 'Error writing output plot file';
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Plot - Plot tag values in SVG format
=head1 DESCRIPTION
Output plots in SVG format based on ExifTool tag information.
=head1 METHODS
=head2 new
Create a new Plot object.
$plot = Image::ExifTool::Plot->new;
=head2 Settings
Change plot settings.
=over 4
=item Inputs:
0) Plot object reference
1) Comma-delimited string of options
=item Options:
"Type=Line" - plot type (Line, Scatter or Histogram)
"Style=Line" - data style (Line, Marker and/or Fill)
"NBins=20" - number of bins for histogram plot
"Size=800 600" - width,height of output image
"Margin=60 15 15 30" - left,top,right,bottom margins around plot area
"Legend=0 0" - x,y offset to shift plot legend
"TxtPad=10 10" - padding between text and x,y scale
"LineSpacing=20" - spacing between text lines
"Stroke=1" - plot stroke width and marker-size scaling factor
Title, XLabel, YLabel - plot title and x/y axis labels (no default)
XMin, XMax - x axis minimum/maximum (autoscaling if not set)
YMin, YMax - y axis minimum/maximum
Multi - number of columns when drawing multiple plots,
followed optional number of datasets for each
plot (1 by default) using any separator
Split - flag to split strings of numbers into lists
(> 1 to split into lists of N items)
"Grid=darkgray" - grid color
"Text=black" - color of text and plot border
"Bkg=" - background color (default is transparent)
"Cols=red green blue black orange gray fuchsia brown turquoise gold"
- colors for plot data
"Marks=circle square triangle diamond star plus pentagon left down right"
- marker-shape names for each dataset
=back
=head2 AddPoints
Add points to be plotted.
=over 4
=item Inputs:
0) Plot object reference
1) Tag information hash reference from ExifTool
2) List of tag keys to plot
=back
=head2 Draw
Draw the SVG plot to the specified output file.
=over 4
=item Inputs:
0) Plot object reference
1) Output file reference
=item Notes:
On return, the Plot Error and Warn members contain error or warning strings
if there were any problems. If an Error is set, then the output SVG is
invalid.
=back
=head1 AUTHOR
Copyright 2003-2026, Phil Harvey (philharvey66 at gmail.com)
( run in 0.622 second using v1.01-cache-2.11-cpan-fe3c2283af0 )