#------------------------------------------------------------------------------ # 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 => ' ' ' ' ' ' ' ' ' ' 1 $mod = $$self{'split'} if $$self{'split'} > 1; next; } else { @vals = split /[ ,;\t\n\r][\n\r]? */, $val; $val = shift @vals; } } my $docNum = $docNum ? $$docNum{$tag} || 0 : 0; next if $docNum and not $ee; unless ($$data{$name}) { if (@{$$self{Name}} >= $maxLines + $scat) { unless ($$self{MaxTags}) { if ($$self{type} =~ /^h/ and not $$self{multi}) { $$self{Warn} = 'Use the Multi setting to make a separate histogram for each dataset'; } else { $$self{Warn} = 'Too many variables to plot all of them'; } $$self{MaxTags} = 1; } next; } push @{$$self{Name}}, $name; $xname or $xname = $name; # x-axis data for scatter plot unless ($scat and $name eq $xname) { $$self{Max} = $val if not defined $$self{Max} or $val > $$self{Max}; $$self{Min} = $val if not defined $$self{Min} or $val < $$self{Min}; } $xmin = $xmax = $docNum unless defined $xmin; $num{$name} = $xmax; $$data{$name}[$xmax - $xmin] = $val if $xmax >= $xmin; next; } if ($docNum and defined $num{$name} and $num{$name} < $docNum) { $num{$name} = $docNum; # keep documents synchronized if some tags are missing } else { $num{$name} = $xmax unless defined $num{$name}; ++$num{$name}; } $$data{$name}[$num{$name} - $xmin] = $val if $num{$name} >= $xmin; unless ($scat and $name eq $xname) { $$self{Max} = $val if $val > $$self{Max}; $$self{Min} = $val if $val < $$self{Min}; } } # start next file at x value so far $xmax < $num{$_} and $xmax = $num{$_} foreach keys %num; $$self{XMin} = $xmin; $$self{XMax} = $xmax; } #------------------------------------------------------------------------------ # Calculate a nice round number for grid spacing # Inputs: 0) nominal spacing (must be positive), 1) flag to increment to next number # Returns: spacing rounded to an even number sub GetGridSpacing($;$) { my ($nom, $inc) = @_; my ($rounded, $spc); my $div = sprintf('%.3e', $nom); my $num = substr($div, 0, 1); my $exp = $div =~ s/.*e// ? $div : 0; if ($inc) { # increment to next highest even number $num = $num < 2 ? 2 : ($num < 5 ? 5 : (++$exp, 1)); } else { # look for nearest factor to 1, 2 or 5 * 10^x $num = $num < 8 ? 5 : (++$exp, 1) if $num > 2; } return $exp >= 0 ? $num . ('0' x $exp) : '.' . ('0' x (-$exp - 1)) . $num; } #------------------------------------------------------------------------------ # Get plot range # Inputs: 0) minimum, 1) maximum # Returns: difference # Notes: Adjusts min/max if necessary to make difference positive sub GetRange($$) { if ($_[0] >= $_[1]) { $_[0] = ($_[0] + $_[1]) / 2; $_[0] -= 0.5 if $_[0]; $_[1] = $_[0] + 1; } return $_[1] - $_[0]; } #------------------------------------------------------------------------------ # Draw SVG plot # Inputs: 0) Plot ref, 1) Output file reference sub Draw($$) { my ($self, $fp) = @_; my ($min, $max, $xmin, $xmax, $name, $style) = @$self{qw(Min Max XMin XMax Name style)}; my ($plotNum, $multiMulti); if (not defined $min or not defined $xmin) { $$self{Error} = 'Nothing to plot'; return; } my $scat = $$self{type} =~ /^s/ ? 1 : 0; my $hist = $$self{type} =~ /^h/ ? [ ] : 0; my $multi = $$self{multi} || 0; my @multi = $multi =~ /\d+/g; my @names = @$name; shift @names if $scat; $multi = shift @multi; $multi = 0 unless $multi > 0; $style or $style = $hist ? 'line+fill' : 'line'; unless ($style =~ /\b[mpl]/ or ($hist and $style =~ /\bf/)) { $$self{Error} = 'Invalid plot Style setting'; return; } my $numPlots = 0; if ($multi) { my $n; for ($n=0; $n 1; } } else { $numPlots = 1; } my @size = @{$$self{size}}; my $sy = $size[1]; if ($multi) { $sy *= int(($numPlots + $multi - 1) / $multi) / $multi; $_ /= $multi foreach @size; } my $tmp = $$self{title} || "Plot by ExifTool $Image::ExifTool::VERSION"; print $fp qq{ $tmp}; # loop through all plots for ($plotNum=0; $plotNum<$numPlots; ++$plotNum) { my ($i, $n, %col, %class, $dx, $dy, $dx2, $xAxis, $x, $y, $px, $py, @og); my ($noLegend, $xname, $xdat, $xdiff, $diff, %markID); if ($numPlots > 1) { print $fp "\n"; if ($plotNum) { @$self{qw(XMin XMax title xlabel ylabel)} = @{$$self{Save}}; } else { $$self{Save} = [ @$self{qw(XMin XMax title xlabel ylabel)} ]; $$self{SaveName} = [ @{$$self{Name}} ]; } $name = $$self{Name} = [ ]; push @{$$self{Name}}, $$self{SaveName}[0] if $scat; foreach (0 .. (($multi[$plotNum] || 1) - 1)) { push @{$$self{Name}}, shift(@names); } undef $min; undef $max; foreach ($scat .. (@{$$self{Name}} - 1)) { my $dat = $$self{Data}{$$self{Name}[$_]}; foreach (@$dat) { defined or next; defined $min or $min = $max = $_, next; $min > $_ and $min = $_; $max < $_ and $max = $_; } } } my ($data, $title, $xlabel, $ylabel, $cols, $marks, $tpad, $wid) = @$self{qw(Data title xlabel ylabel cols marks txtpad stroke)}; my @name = @$name; my @margin = ( @{$$self{margin}} ); # set reasonable default titles and labels $xname = shift @name if $scat; $title = "$name[0] vs $xname" if $scat and defined $title and not $title and @name == 1 and not $multi; if ($scat || $hist and defined $xlabel and not $xlabel) { $xlabel = $$name[0]; $noLegend = 1 if $hist; } if (defined $ylabel and not $ylabel and @name == 1 and not $multiMulti) { $ylabel = $hist ? 'Count' : $name[0]; $noLegend = 1 unless $hist; } # make room for title/labels $margin[1] += $$self{linespacing} * 1.5 if $title; $margin[3] += $$self{linespacing} if $xlabel; $margin[0] += $$self{linespacing} if $ylabel; # calculate optimal number of X/Y grid lines for ($i=0; $i<2; ++$i) { $og[$i] = $ng[$i] * ($size[$i] - $margin[$i] - $margin[$i+2]) / ($defaults{size}[$i] - $defaults{margin}[$i] - $defaults{margin}[$i+2]); $og[$i] <= 0 and $$self{Error} = 'Invalid plot size', return; } if ($scat) { $xdat = $$self{Data}{$xname}; unless (defined $$self{xmin} and defined $$self{xmax}) { my $set; foreach (@$xdat) { next unless defined; $set or $xmin = $xmax = $_, $set = 1, next; $xmin = $_ if $xmin > $_; $xmax = $_ if $xmax < $_; } my $dnx2 = ($xmax - $xmin) / ($og[0] * 2); # leave a bit of a left/right margin, but don't pass 0 $xmin = ($xmin >= 0 and $xmin < $dnx2) ? 0 : $xmin - $dnx2; $xmax = ($xmax <= 0 and -$xmax < $dnx2) ? 0 : $xmax + $dnx2; } $xmin = $$self{xmin} if defined $$self{xmin}; $xmax = $$self{xmax} if defined $$self{xmax}; } else { # shift x range to correspond with index in data list $xmax -= $xmin; $xmin = 0; } if ($hist) { $$self{nbins} > 0 or $$self{Error} = 'Invalid number of histogram bins', return; $noLegend = 1; # y axis becomes histogram x axis after binning $min = $$self{xmin} if defined $$self{xmin}; $max = $$self{xmax} if defined $$self{xmax}; } else { # leave a bit of a margin above/below data when autoscaling but don't pass 0 my $dny2 = ($max - $min) / ($og[1] * 2); $min = ($min >= 0 and $min < $dny2) ? 0 : $min - $dny2; $max = ($max <= 0 and -$max < $dny2) ? 0 : $max + $dny2; # adjust to user-defined range if specified $min = $$self{ymin} if defined $$self{ymin}; $max = $$self{ymax} if defined $$self{ymax}; } # generate random colors if we need more while (@$cols < @$name) { $$self{seeded} or srand(141), $$self{seeded} = 1; push @$cols, sprintf("#%.2x%.2x%.2x",int(rand(220)),int(rand(220)),int(rand(220))); } $diff = GetRange($min, $max); $xdiff = GetRange($xmin, $xmax); # determine y grid spacing (nice even numbers) $dy = GetGridSpacing($diff / ($hist ? $$self{nbins} : $og[1])); # expand plot min/max to the nearest even multiple of our grid spacing $min = ($min > 0 ? int($min/$dy) : int($min/$dy-0.9999)) * $dy; $max = ($max > 0 ? int($max/$dy+0.9999) : int($max/$dy)) * $dy; # bin histogram if ($hist) { my $dat = $$data{$name[0]}; my $nmax = int(($max - $min) / $dy + 0.5); @$hist = (0) x $nmax; foreach (@$dat) { next unless defined; $n = ($_ - $min) / $dy; next if $n < 0 or $n > $nmax + 0.00001; $n = int($n); ++$$hist[$n < $nmax ? $n : $nmax - 1]; } ($xmin, $xmax, $min, $max) = ($min, $max, 0, 0); if ($$self{ymax}) { $max = $$self{ymax}; } else { $max < $_ and $max = $_ foreach @$hist; # find max count } $diff = GetRange($min, $max); $dx = $dy; $dy = GetGridSpacing($diff / $og[1]); $max = ($max > 0 ? int($max/$dy+0.9999) : int($max/$dy)) * $dy; $$data{$name[0]} = $hist; } else { $dx = GetGridSpacing($xdiff / $og[0]); } if ($scat) { $xmin = ($xmin > 0 ? int($xmin/$dx) : int($xmin/$dx-0.9999)) * $dx; $xmax = ($xmax > 0 ? int($xmax/$dx+0.9999) : int($xmax/$dx)) * $dx; } $diff = GetRange($min, $max); $xdiff = GetRange($xmin, $xmax); # width/height of plot area my $width = $size[0] - $margin[0] - $margin[2]; my $height = $size[1] - $margin[1] - $margin[3]; my $yscl = $height / $diff; my $xscl = $width / $xdiff; my $px0 = $margin[0] - $xmin * $xscl; my $py0 = $margin[1] + $height + $min * $yscl; my @clip = ($margin[0]-6*$wid, $margin[1]-6*$wid, $width+12*$wid, $height+12*$wid); print $fp "\n\n\n"; print $fp ""; if ($style =~ /\b[mp]/) { # 'm' for 'marker' or 'p' for 'point' (undocumented) for ($i=0; $i<@name; ++$i) { my @m = split /-/, ($$marks[$i] || $defaults{marks}[$i % @{$defaults{marks}}]); my ($fill, $mark); $fill = $m[2] || $$cols[$i] if $m[1] ? $m[1] =~ /^f/ : $style =~ /\bf/; $mark = $markerData{$m[0]}; $mark or $markID{$mark} = '', next; # skip 'none' or unrecognized marker name if ($fill and $fill ne 'none') { my $op = $m[3] || ($$cols[$i] eq 'none' ? 50 : 20); $mark .= qq( fill="$fill" style="fill-opacity: $op%"); } else { $mark .= ' fill="none"'; } # (was using 'context-stroke', but Chrome didn't show this properly) $mark .= " stroke='$$cols[$i]'/>"; # don't re-define mark if it is the same as a previous one $markID{$mark} and $markID{$i} = $markID{$mark}, next; $markID{$mark} = $markID{$i} = "mark$i"; print $fp "\n\n$mark\n"; } print $fp "\n\n" if $numPlots > 1; } print $fp "\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-2025, Phil Harvey (philharvey66 at gmail.com) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO =over 4 =item L =back =cut