exiftool_vendored 13.19.0 → 13.22.0
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- checksums.yaml +4 -4
- data/bin/Changes +37 -2
- data/bin/MANIFEST +8 -0
- data/bin/META.json +1 -1
- data/bin/META.yml +1 -1
- data/bin/README +2 -2
- data/bin/exiftool +150 -64
- data/bin/lib/Image/ExifTool/DJI.pm +97 -24
- data/bin/lib/Image/ExifTool/EXE.pm +2 -9
- data/bin/lib/Image/ExifTool/GM.pm +1 -1
- data/bin/lib/Image/ExifTool/GoPro.pm +28 -0
- data/bin/lib/Image/ExifTool/JPEG.pm +1 -1
- data/bin/lib/Image/ExifTool/JSON.pm +5 -1
- data/bin/lib/Image/ExifTool/Nikon.pm +808 -524
- data/bin/lib/Image/ExifTool/Olympus.pm +2 -1
- data/bin/lib/Image/ExifTool/PLIST.pm +57 -32
- data/bin/lib/Image/ExifTool/PNG.pm +7 -1
- data/bin/lib/Image/ExifTool/Plot.pm +712 -0
- data/bin/lib/Image/ExifTool/Protobuf.pm +21 -10
- data/bin/lib/Image/ExifTool/QuickTime.pm +41 -31
- data/bin/lib/Image/ExifTool/QuickTimeStream.pl +56 -22
- data/bin/lib/Image/ExifTool/TagLookup.pm +4988 -4965
- data/bin/lib/Image/ExifTool/TagNames.pod +163 -65
- data/bin/lib/Image/ExifTool/Trailer.pm +2 -2
- data/bin/lib/Image/ExifTool/WriteExif.pl +5 -0
- data/bin/lib/Image/ExifTool/WritePDF.pl +1 -1
- data/bin/lib/Image/ExifTool/Writer.pl +0 -1
- data/bin/lib/Image/ExifTool/XMP.pm +1 -1
- data/bin/lib/Image/ExifTool.pm +16 -2
- data/bin/lib/Image/ExifTool.pod +31 -0
- data/bin/perl-Image-ExifTool.spec +1 -1
- data/lib/exiftool_vendored/version.rb +1 -1
- metadata +3 -2
@@ -0,0 +1,712 @@
|
|
1
|
+
#------------------------------------------------------------------------------
|
2
|
+
# File: Plot.pm
|
3
|
+
#
|
4
|
+
# Description: Plot tag values in SVG format
|
5
|
+
#
|
6
|
+
# Revisions: 2025-02-14 - P. Harvey Created
|
7
|
+
#------------------------------------------------------------------------------
|
8
|
+
|
9
|
+
package Image::ExifTool::Plot;
|
10
|
+
|
11
|
+
use strict;
|
12
|
+
use vars qw($VERSION);
|
13
|
+
|
14
|
+
$VERSION = '1.01';
|
15
|
+
|
16
|
+
# default plot settings (lower-case settings may be overridden by the user)
|
17
|
+
my %defaults = (
|
18
|
+
size => [ 800, 600 ], # width,height of output image
|
19
|
+
margin => [ 60, 15, 15, 30 ], # left,top,right,bottom margins around plot area
|
20
|
+
legend => [ 0, 0 ], # top,right offset for legend
|
21
|
+
txtpad => [ 10, 10 ], # padding between text and x,y scale
|
22
|
+
linespacing => 20, # text line spacing
|
23
|
+
# colours for plot lines
|
24
|
+
cols => [ qw(red green blue black orange gray fuchsia brown turquoise gold
|
25
|
+
lime violet maroon aqua navy pink olive indigo silver teal) ],
|
26
|
+
marks => [ qw(circle square triangle diamond star plus pentagon left down right) ],
|
27
|
+
stroke => 1, # stroke width and marker scaling
|
28
|
+
grid => 'darkgray', # grid colour
|
29
|
+
text => 'black', # text and plot frame colour
|
30
|
+
type => 'line', # plot type, 'line' or 'scatter'
|
31
|
+
style => '', # 'line', 'marker' or 'line+marker'
|
32
|
+
xlabel => '', # x axis label
|
33
|
+
ylabel => '', # y axis label
|
34
|
+
title => '', # plot title
|
35
|
+
nbins => 20, # number of histogram bins
|
36
|
+
# xmin, xmax # x axis minimum,maximum
|
37
|
+
# ymin, ymax # y axis minimum,maximum
|
38
|
+
# split # split list of numbers into separate plot lines
|
39
|
+
# bkg # background colour
|
40
|
+
# multi # flag to make one plot per dataset
|
41
|
+
#
|
42
|
+
# members containing capital letters are used internally
|
43
|
+
#
|
44
|
+
Data => { }, # data arrays for each variable
|
45
|
+
Name => [ ], # variable names
|
46
|
+
# XMin, XMax # min/max data index
|
47
|
+
# YMin, YMax # min/max data value
|
48
|
+
# SaveName, Save # saved variables between plots
|
49
|
+
);
|
50
|
+
|
51
|
+
my %markerData = (
|
52
|
+
circle => '<circle cx="4" cy="4" r="2.667"',
|
53
|
+
square => '<path d="M1.667 1.667 l4.667 0 0 4.667 -4.667 0 z"',
|
54
|
+
triangle => '<path d="M4 0.8 l2.667 5.333 -5.333 0 z"',
|
55
|
+
diamond => '<path d="M4 1 l3 3 -3 3 -3 -3 z"',
|
56
|
+
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"',
|
57
|
+
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"',
|
58
|
+
pentagon => '<path d="M4 1 L6.853 3.073 5.763 6.427 2.237 6.427 1.147 3.073 z"',
|
59
|
+
left => '<path d="M0.8 4 l5.333 2.667 0 -5.333 z"',
|
60
|
+
down => '<path d="M4 7.2 l2.667 -5.333 -5.333 0 z"',
|
61
|
+
right => '<path d="M7.2 4 l-5.333 2.667 0 -5.333 z"',
|
62
|
+
);
|
63
|
+
|
64
|
+
my @ng = (20, 15); # optimal number grid lines in X and Y for a 800x600 plot
|
65
|
+
my $wch = 8; # nominal width of a character (measured at 7.92)
|
66
|
+
|
67
|
+
#------------------------------------------------------------------------------
|
68
|
+
# Create new plot object
|
69
|
+
sub new
|
70
|
+
{
|
71
|
+
my $that = shift;
|
72
|
+
my $class = ref($that) || $that || 'Image::ExifTool::Plot';
|
73
|
+
my $self = bless { }, $class;
|
74
|
+
foreach (keys %defaults) {
|
75
|
+
ref $defaults{$_} eq 'HASH' and $$self{$_} = { %{$defaults{$_}} }, next;
|
76
|
+
ref $defaults{$_} eq 'ARRAY' and $$self{$_} = [ @{$defaults{$_}} ], next;
|
77
|
+
$$self{$_} = $defaults{$_};
|
78
|
+
}
|
79
|
+
return $self;
|
80
|
+
}
|
81
|
+
|
82
|
+
#------------------------------------------------------------------------------
|
83
|
+
# Set plot settings
|
84
|
+
# Inputs: 0) Plot ref, 1) comma-separated options
|
85
|
+
sub Settings($$)
|
86
|
+
{
|
87
|
+
my ($self, $set) = @_;
|
88
|
+
return unless $set;
|
89
|
+
foreach (split /,\s*/, $set) {
|
90
|
+
next unless /^([a-z].*?)(=(.*))?$/i;
|
91
|
+
my ($name, $val) = (lc $1, $3);
|
92
|
+
if (ref $$self{$name} eq 'ARRAY') {
|
93
|
+
next unless defined $val;
|
94
|
+
my $isNum = $$self{$name}[0] =~ /^\d+$/;
|
95
|
+
# also allow numbers to also be separated by 'x'
|
96
|
+
my @vals = $isNum ? split(/\s*[x\s\/+]\s*/, $val) : split(/\s*[\s\/+]\s*/, $val);
|
97
|
+
my $i;
|
98
|
+
for ($i=0; @vals; ++$i) {
|
99
|
+
my $val = lc shift @vals;
|
100
|
+
next unless length $val;
|
101
|
+
if ($name eq 'marks') {
|
102
|
+
my @v = split /-/, $val;
|
103
|
+
if ($v[0]) {
|
104
|
+
if ($v[0] =~ /^n/) {
|
105
|
+
$v[0] = 'none';
|
106
|
+
} else {
|
107
|
+
($v[0]) = grep /^$v[0]/, @{$defaults{marks}};
|
108
|
+
$v[0] or $$self{Warn} = 'Invalid marker name', next;
|
109
|
+
}
|
110
|
+
} else {
|
111
|
+
# cycle through default markers if none specified
|
112
|
+
$v[0] = $defaults{marks}[$i % @{$defaults{marks}}];
|
113
|
+
}
|
114
|
+
$val = join '-', @v;
|
115
|
+
}
|
116
|
+
$$self{$name}[$i] = $val;
|
117
|
+
}
|
118
|
+
} else {
|
119
|
+
$val = 1 unless defined $val; # default to 1 if no "="
|
120
|
+
my %charName = ('&'=>'amp', '<'=>'lt', '>'=>'gt');
|
121
|
+
# escape necessary XML characters, but allow numerical entities
|
122
|
+
$val =~ s/([&><])/&$charName{$1};/sg and $val =~ s/&(#(\d+|x[0-9a-fA-F]+);)/&$1/;
|
123
|
+
undef $val unless length $val;
|
124
|
+
$$self{$name} = $val;
|
125
|
+
}
|
126
|
+
}
|
127
|
+
}
|
128
|
+
|
129
|
+
#------------------------------------------------------------------------------
|
130
|
+
# Add points to SVG plot
|
131
|
+
# Inputs: 0) Plot object ref, 1) tag value hash ref, 2) tag ID list ref
|
132
|
+
sub AddPoints($$$)
|
133
|
+
{
|
134
|
+
my ($self, $info, $tags) = @_;
|
135
|
+
my ($tag, $name, %num, $index, $mod, $val, @vals);
|
136
|
+
my ($ee, $docNum, $data, $xmin, $xmax) = @$self{qw(EE DocNum Data XMin XMax)};
|
137
|
+
$$self{type} or $$self{type} = 'line';
|
138
|
+
my $scat = $$self{type} =~ /^s/ ? 1 : 0;
|
139
|
+
my $xname = $$self{Name}[0]; # (x-axis name if using scatter plot)
|
140
|
+
my $maxLines = ($$self{type} =~ /^h/ and not $$self{multi}) ? 1 : 20;
|
141
|
+
for (;;) {
|
142
|
+
if (@vals) {
|
143
|
+
$val = shift @vals;
|
144
|
+
next unless $val =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?$/;
|
145
|
+
} else {
|
146
|
+
$tag = shift @$tags or last;
|
147
|
+
# ignore non-floating-point values
|
148
|
+
$val = $$info{$tag};
|
149
|
+
($name) = $tag =~ /^(\S+)/g; # remove index number
|
150
|
+
if (ref $val) {
|
151
|
+
if (ref $val eq 'ARRAY') {
|
152
|
+
$index = defined $index ? $index + 1 : 0;
|
153
|
+
$val = $$val[$index];
|
154
|
+
defined $val or undef($index), undef($mod), next;
|
155
|
+
$name .= $mod ? '['.($index % $mod).']' : "[$index]";
|
156
|
+
unshift @$tags, $tag; # will continue with this tag later
|
157
|
+
} elsif (ref $val eq 'SCALAR') {
|
158
|
+
$val = $$val; # handle binary values
|
159
|
+
} else {
|
160
|
+
next;
|
161
|
+
}
|
162
|
+
}
|
163
|
+
}
|
164
|
+
next unless defined $val and $val =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?([ ,;\t\n\r]+|$)/i;
|
165
|
+
if ($1) {
|
166
|
+
# split a string of numbers into separate plot points (eg. histogram tags)
|
167
|
+
if ($$self{'split'}) {
|
168
|
+
# make an array
|
169
|
+
$$info{$tag} = [ split /[ ,;\t\n\r][\n\r]? */, $val ];
|
170
|
+
unshift @$tags, $tag;
|
171
|
+
# split into lists of 'split' elements if split > 1
|
172
|
+
$mod = $$self{'split'} if $$self{'split'} > 1;
|
173
|
+
next;
|
174
|
+
} else {
|
175
|
+
@vals = split /[ ,;\t\n\r][\n\r]? */, $val;
|
176
|
+
$val = shift @vals;
|
177
|
+
}
|
178
|
+
}
|
179
|
+
my $docNum = $docNum ? $$docNum{$tag} || 0 : 0;
|
180
|
+
next if $docNum and not $ee;
|
181
|
+
unless ($$data{$name}) {
|
182
|
+
if (@{$$self{Name}} >= $maxLines + $scat) {
|
183
|
+
unless ($$self{MaxTags}) {
|
184
|
+
if ($$self{type} =~ /^h/ and not $$self{multi}) {
|
185
|
+
$$self{Warn} = 'Use the Multi setting to make a separate histogram for each dataset';
|
186
|
+
} else {
|
187
|
+
$$self{Warn} = 'Too many variables to plot all of them';
|
188
|
+
}
|
189
|
+
$$self{MaxTags} = 1;
|
190
|
+
}
|
191
|
+
next;
|
192
|
+
}
|
193
|
+
push @{$$self{Name}}, $name;
|
194
|
+
$xname or $xname = $name; # x-axis data for scatter plot
|
195
|
+
unless ($scat and $name eq $xname) {
|
196
|
+
$$self{Max} = $val if not defined $$self{Max} or $val > $$self{Max};
|
197
|
+
$$self{Min} = $val if not defined $$self{Min} or $val < $$self{Min};
|
198
|
+
}
|
199
|
+
$xmin = $xmax = $docNum unless defined $xmin;
|
200
|
+
$num{$name} = $xmax;
|
201
|
+
$$data{$name}[$xmax - $xmin] = $val if $xmax >= $xmin;
|
202
|
+
next;
|
203
|
+
}
|
204
|
+
if ($docNum and $num{$name} < $docNum) {
|
205
|
+
$num{$name} = $docNum; # keep documents synchronized if some tags are missing
|
206
|
+
} else {
|
207
|
+
$num{$name} = $xmax unless defined $num{$name};
|
208
|
+
++$num{$name};
|
209
|
+
}
|
210
|
+
$$data{$name}[$num{$name} - $xmin] = $val if $num{$name} >= $xmin;
|
211
|
+
unless ($scat and $name eq $xname) {
|
212
|
+
$$self{Max} = $val if $val > $$self{Max};
|
213
|
+
$$self{Min} = $val if $val < $$self{Min};
|
214
|
+
}
|
215
|
+
}
|
216
|
+
# start next file at x value so far
|
217
|
+
$xmax < $num{$_} and $xmax = $num{$_} foreach keys %num;
|
218
|
+
$$self{XMin} = $xmin;
|
219
|
+
$$self{XMax} = $xmax;
|
220
|
+
}
|
221
|
+
|
222
|
+
#------------------------------------------------------------------------------
|
223
|
+
# Calculate a nice round number for grid spacing
|
224
|
+
# Inputs: 0) nominal spacing (must be positive), 1) flag to increment to next number
|
225
|
+
# Returns: spacing rounded to an even number
|
226
|
+
sub GetGridSpacing($;$)
|
227
|
+
{
|
228
|
+
my ($nom, $inc) = @_;
|
229
|
+
my ($rounded, $spc);
|
230
|
+
my $div = sprintf('%.3e', $nom);
|
231
|
+
my $num = substr($div, 0, 1);
|
232
|
+
my $exp = $div =~ s/.*e// ? $div : 0;
|
233
|
+
if ($inc) {
|
234
|
+
# increment to next highest even number
|
235
|
+
$num = $num < 2 ? 2 : ($num < 5 ? 5 : (++$exp, 1));
|
236
|
+
} else {
|
237
|
+
# look for nearest factor to 1, 2 or 5 * 10^x
|
238
|
+
$num = $num < 8 ? 5 : (++$exp, 1) if $num > 2;
|
239
|
+
}
|
240
|
+
return $exp >= 0 ? $num . ('0' x $exp) : '.' . ('0' x (-$exp - 1)) . $num;
|
241
|
+
}
|
242
|
+
|
243
|
+
#------------------------------------------------------------------------------
|
244
|
+
# Get plot range
|
245
|
+
# Inputs: 0) minimum, 1) maximum
|
246
|
+
# Returns: difference
|
247
|
+
# Notes: Adjusts min/max if necessary to make difference positive
|
248
|
+
sub GetRange($$)
|
249
|
+
{
|
250
|
+
if ($_[0] >= $_[1]) {
|
251
|
+
$_[0] = ($_[0] + $_[1]) / 2;
|
252
|
+
$_[0] -= 0.5 if $_[0];
|
253
|
+
$_[1] = $_[0] + 1;
|
254
|
+
}
|
255
|
+
return $_[1] - $_[0];
|
256
|
+
}
|
257
|
+
|
258
|
+
#------------------------------------------------------------------------------
|
259
|
+
# Draw SVG plot
|
260
|
+
# Inputs: 0) Plot ref, 1) Output file reference
|
261
|
+
sub Draw($$)
|
262
|
+
{
|
263
|
+
my ($self, $fp) = @_;
|
264
|
+
my ($min, $max, $xmin, $xmax, $name, $style) = @$self{qw(Min Max XMin XMax Name style)};
|
265
|
+
|
266
|
+
if (not defined $min or not defined $xmin) {
|
267
|
+
$$self{Error} = 'Nothing to plot';
|
268
|
+
return;
|
269
|
+
}
|
270
|
+
my ($i, $n, %col, %class, $dx, $dy, $dx2, $xAxis, $x, $y, $px, $py, @og);
|
271
|
+
my ($noLegend, $xname, $xdat, $xdiff, $diff, %markID, $plotNum);
|
272
|
+
my $scat = $$self{type} =~ /^s/ ? 1 : 0;
|
273
|
+
my $hist = $$self{type} =~ /^h/ ? [ ] : 0;
|
274
|
+
my $multi = int($$self{multi} || 0);
|
275
|
+
$multi = 0 unless $multi > 0;
|
276
|
+
$style or $style = $hist ? 'line+fill' : 'line';
|
277
|
+
unless ($style =~ /\b[mpl]/ or ($hist and $style =~ /\bf/)) {
|
278
|
+
$$self{Error} = 'Invalid plot Style setting';
|
279
|
+
return;
|
280
|
+
}
|
281
|
+
my $numPlots = $multi ? scalar(@$name) - $scat : 1;
|
282
|
+
my @size = @{$$self{size}};
|
283
|
+
my $sy = $size[1];
|
284
|
+
if ($multi) {
|
285
|
+
$sy *= int(($numPlots + $multi - 1) / $multi) / $multi;
|
286
|
+
$_ /= $multi foreach @size;
|
287
|
+
}
|
288
|
+
my $tmp = $$self{title} || "Plot by ExifTool $Image::ExifTool::VERSION";
|
289
|
+
print $fp qq{<?xml version="1.0" standalone="no"?>
|
290
|
+
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
|
291
|
+
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" width="$$self{size}[0]" height="$sy"
|
292
|
+
preserveAspectRatio="xMidYMid meet" viewBox="0 0 $$self{size}[0] $sy">
|
293
|
+
<title>$tmp</title>};
|
294
|
+
# loop through all plots
|
295
|
+
for ($plotNum=0; $plotNum<$numPlots; ++$plotNum) {
|
296
|
+
if ($numPlots > 1) {
|
297
|
+
print $fp "\n<g transform='translate(", ($plotNum % $multi) * $size[0],
|
298
|
+
',', int($plotNum/$multi) * $size[1], ")'>";
|
299
|
+
if ($plotNum) {
|
300
|
+
@$self{qw(XMin XMax title xlabel ylabel)} = @{$$self{Save}};
|
301
|
+
} else {
|
302
|
+
$$self{Save} = [ @$self{qw(XMin XMax title xlabel ylabel)} ];
|
303
|
+
$$self{SaveName} = [ @{$$self{Name}} ];
|
304
|
+
}
|
305
|
+
$name = $$self{Name} = [ ];
|
306
|
+
push @{$$self{Name}}, $$self{SaveName}[0] if $scat;
|
307
|
+
push @{$$self{Name}}, $$self{SaveName}[$scat + $plotNum];
|
308
|
+
my $dat = $$self{Data}{$$self{Name}[$scat]};
|
309
|
+
undef $min; undef $max;
|
310
|
+
foreach (@$dat) {
|
311
|
+
defined or next;
|
312
|
+
defined $min or $min = $max = $_, next;
|
313
|
+
$min > $_ and $min = $_;
|
314
|
+
$max < $_ and $max = $_;
|
315
|
+
}
|
316
|
+
}
|
317
|
+
my ($data, $title, $xlabel, $ylabel, $cols, $marks, $tpad, $wid) =
|
318
|
+
@$self{qw(Data title xlabel ylabel cols marks txtpad stroke)};
|
319
|
+
my @name = @$name;
|
320
|
+
my @margin = ( @{$$self{margin}} );
|
321
|
+
|
322
|
+
# set reasonable default titles and labels
|
323
|
+
$xname = shift @name if $scat;
|
324
|
+
$title = "$name[0] vs $xname" if $scat and defined $title and not $title and @name == 1;
|
325
|
+
if ($scat || $hist and defined $xlabel and not $xlabel) {
|
326
|
+
$xlabel = $$name[0];
|
327
|
+
$noLegend = 1 if $hist;
|
328
|
+
}
|
329
|
+
if (defined $ylabel and not $ylabel and @name == 1) {
|
330
|
+
$ylabel = $hist ? 'Count' : $name[0];
|
331
|
+
$noLegend = 1 unless $hist;
|
332
|
+
}
|
333
|
+
|
334
|
+
# make room for title/labels
|
335
|
+
$margin[1] += $$self{linespacing} * 1.5 if $title;
|
336
|
+
$margin[3] += $$self{linespacing} if $xlabel;
|
337
|
+
$margin[0] += $$self{linespacing} if $ylabel;
|
338
|
+
|
339
|
+
# calculate optimal number of X/Y grid lines
|
340
|
+
for ($i=0; $i<2; ++$i) {
|
341
|
+
$og[$i] = $ng[$i] * ($size[$i] - $margin[$i] - $margin[$i+2]) /
|
342
|
+
($defaults{size}[$i] - $defaults{margin}[$i] - $defaults{margin}[$i+2]);
|
343
|
+
$og[$i] <= 0 and $$self{Error} = 'Invalid plot size', return;
|
344
|
+
}
|
345
|
+
if ($scat) {
|
346
|
+
$xdat = $$self{Data}{$xname};
|
347
|
+
unless (defined $$self{xmin} and defined $$self{xmax}) {
|
348
|
+
my $set;
|
349
|
+
foreach (@$xdat) {
|
350
|
+
next unless defined;
|
351
|
+
$set or $xmin = $xmax = $_, $set = 1, next;
|
352
|
+
$xmin = $_ if $xmin > $_;
|
353
|
+
$xmax = $_ if $xmax < $_;
|
354
|
+
}
|
355
|
+
my $dnx2 = ($xmax - $xmin) / ($og[0] * 2);
|
356
|
+
# leave a bit of a left/right margin, but don't pass 0
|
357
|
+
$xmin = ($xmin >= 0 and $xmin < $dnx2) ? 0 : $xmin - $dnx2;
|
358
|
+
$xmax = ($xmax <= 0 and -$xmax < $dnx2) ? 0 : $xmax + $dnx2;
|
359
|
+
}
|
360
|
+
$xmin = $$self{xmin} if defined $$self{xmin};
|
361
|
+
$xmax = $$self{xmax} if defined $$self{xmax};
|
362
|
+
} else {
|
363
|
+
# shift x range to correspond with index in data list
|
364
|
+
$xmax -= $xmin;
|
365
|
+
$xmin = 0;
|
366
|
+
}
|
367
|
+
if ($hist) {
|
368
|
+
$$self{nbins} > 0 or $$self{Error} = 'Invalid number of histogram bins', return;
|
369
|
+
$noLegend = 1;
|
370
|
+
# y axis becomes histogram x axis after binning
|
371
|
+
$min = $$self{xmin} if defined $$self{xmin};
|
372
|
+
$max = $$self{xmax} if defined $$self{xmax};
|
373
|
+
} else {
|
374
|
+
# leave a bit of a margin above/below data when autoscaling but don't pass 0
|
375
|
+
my $dny2 = ($max - $min) / ($og[1] * 2);
|
376
|
+
$min = ($min >= 0 and $min < $dny2) ? 0 : $min - $dny2;
|
377
|
+
$max = ($max <= 0 and -$max < $dny2) ? 0 : $max + $dny2;
|
378
|
+
# adjust to user-defined range if specified
|
379
|
+
$min = $$self{ymin} if defined $$self{ymin};
|
380
|
+
$max = $$self{ymax} if defined $$self{ymax};
|
381
|
+
}
|
382
|
+
# generate random colors if we need more
|
383
|
+
while (@$cols < @$name) {
|
384
|
+
$$self{seeded} or srand(141), $$self{seeded} = 1;
|
385
|
+
push @$cols, sprintf("#%.2x%.2x%.2x",int(rand(220)),int(rand(220)),int(rand(220)));
|
386
|
+
}
|
387
|
+
$diff = GetRange($min, $max);
|
388
|
+
$xdiff = GetRange($xmin, $xmax);
|
389
|
+
|
390
|
+
# determine y grid spacing (nice even numbers)
|
391
|
+
$dy = GetGridSpacing($diff / ($hist ? $$self{nbins} : $og[1]));
|
392
|
+
# expand plot min/max to the nearest even multiple of our grid spacing
|
393
|
+
$min = ($min > 0 ? int($min/$dy) : int($min/$dy-0.9999)) * $dy;
|
394
|
+
$max = ($max > 0 ? int($max/$dy+0.9999) : int($max/$dy)) * $dy;
|
395
|
+
|
396
|
+
# bin histogram
|
397
|
+
if ($hist) {
|
398
|
+
my $dat = $$data{$name[0]};
|
399
|
+
my $nmax = int(($max - $min) / $dy + 0.5);
|
400
|
+
@$hist = (0) x $nmax;
|
401
|
+
foreach (@$dat) {
|
402
|
+
next unless defined;
|
403
|
+
$n = ($_ - $min) / $dy;
|
404
|
+
next if $n < 0 or $n > $nmax + 0.00001;
|
405
|
+
$n = int($n);
|
406
|
+
++$$hist[$n < $nmax ? $n : $nmax - 1];
|
407
|
+
}
|
408
|
+
($xmin, $xmax, $min, $max) = ($min, $max, 0, 0);
|
409
|
+
if ($$self{ymax}) {
|
410
|
+
$max = $$self{ymax};
|
411
|
+
} else {
|
412
|
+
$max < $_ and $max = $_ foreach @$hist; # find max count
|
413
|
+
}
|
414
|
+
$diff = GetRange($min, $max);
|
415
|
+
$dx = $dy;
|
416
|
+
$dy = GetGridSpacing($diff / $og[1]);
|
417
|
+
$max = ($max > 0 ? int($max/$dy+0.9999) : int($max/$dy)) * $dy;
|
418
|
+
$$data{$name[0]} = $hist;
|
419
|
+
} else {
|
420
|
+
$dx = GetGridSpacing($xdiff / $og[0]);
|
421
|
+
}
|
422
|
+
if ($scat) {
|
423
|
+
$xmin = ($xmin > 0 ? int($xmin/$dx) : int($xmin/$dx-0.9999)) * $dx;
|
424
|
+
$xmax = ($xmax > 0 ? int($xmax/$dx+0.9999) : int($xmax/$dx)) * $dx;
|
425
|
+
}
|
426
|
+
$diff = GetRange($min, $max);
|
427
|
+
$xdiff = GetRange($xmin, $xmax);
|
428
|
+
# width/height of plot area
|
429
|
+
my $width = $size[0] - $margin[0] - $margin[2];
|
430
|
+
my $height = $size[1] - $margin[1] - $margin[3];
|
431
|
+
my $yscl = $height / $diff;
|
432
|
+
my $xscl = $width / $xdiff;
|
433
|
+
my $px0 = $margin[0] - $xmin * $xscl;
|
434
|
+
my $py0 = $margin[1] + $height + $min * $yscl;
|
435
|
+
my @clip = ($margin[0]-6*$wid, $margin[1]-6*$wid, $width+12*$wid, $height+12*$wid);
|
436
|
+
print $fp "\n<!-- Definitions -->\n<defs>\n<clipPath id='plot-area'>";
|
437
|
+
print $fp "<rect x='$clip[0]' y='$clip[1]' width='$clip[2]' height='$clip[3]'/></clipPath>";
|
438
|
+
if ($style =~ /\b[mp]/) { # 'm' for 'marker' or 'p' for 'point' (undocumented)
|
439
|
+
for ($i=0; $i<@name; ++$i) {
|
440
|
+
my @m = split /-/, ($$marks[$i] || $defaults{marks}[$i % @{$defaults{marks}}]);
|
441
|
+
my ($fill, $mark);
|
442
|
+
$fill = $m[2] || $$cols[$i] if $m[1] ? $m[1] =~ /^f/ : $style =~ /\bf/;
|
443
|
+
$mark = $markerData{$m[0]};
|
444
|
+
$mark or $markID{$mark} = '', next; # skip 'none' or unrecognized marker name
|
445
|
+
if ($fill and $fill ne 'none') {
|
446
|
+
my $op = $m[3] || ($$cols[$i] eq 'none' ? 50 : 20);
|
447
|
+
$mark .= qq( fill="$fill" style="fill-opacity: $op%");
|
448
|
+
} else {
|
449
|
+
$mark .= ' fill="none"';
|
450
|
+
}
|
451
|
+
$mark .= ' stroke="context-stroke"/>';
|
452
|
+
# don't re-define mark if it is the same as a previous one
|
453
|
+
$markID{$mark} and $markID{$i} = $markID{$mark}, next;
|
454
|
+
$markID{$mark} = $markID{$i} = "mark$i";
|
455
|
+
print $fp "\n<marker id='$markID{$i}' markerWidth='8' markerHeight='8' refX='4'",
|
456
|
+
" refY='4'>\n$mark\n</marker>";
|
457
|
+
}
|
458
|
+
print $fp "\n</defs>\n<style>";
|
459
|
+
for ($i=0; $i<@name; ++$i) {
|
460
|
+
next unless $markID{$i} eq "mark$i";
|
461
|
+
print $fp "\n path.mark$i { marker: url(#mark$i) }";
|
462
|
+
}
|
463
|
+
} else {
|
464
|
+
print $fp "\n</defs>\n<style>";
|
465
|
+
}
|
466
|
+
print $fp "\n text { fill: $$self{text} }\n</style>";
|
467
|
+
print $fp "\n<rect x='0' y='0' width='$size[0]' height='$size[1]' fill='$$self{bkg}'/>" if $$self{bkg};
|
468
|
+
print $fp "\n<!-- X axis -->";
|
469
|
+
print $fp "\n<g dominant-baseline='hanging' text-anchor='middle'>";
|
470
|
+
$py = int(($margin[1] + $height + $$tpad[1]) * 10 + 0.5) / 10;
|
471
|
+
$px = int(($margin[0] + $width / 2) * 10 + 0.5) / 10;
|
472
|
+
if ($title) {
|
473
|
+
print $fp "\n<text x='${px}' y='14' font-size='150%'>$title</text>";
|
474
|
+
}
|
475
|
+
if ($xlabel) {
|
476
|
+
$y = $py + $$self{linespacing};
|
477
|
+
print $fp "\n<text x='${px}' y='${y}'>$xlabel</text>";
|
478
|
+
}
|
479
|
+
if ($ylabel) {
|
480
|
+
$y = $margin[1] + $height / 2;
|
481
|
+
print $fp "\n<text x='10' y='${y}' transform='rotate(-90,10,$y)'>$ylabel</text>";
|
482
|
+
}
|
483
|
+
# make sure the X labels will fit
|
484
|
+
my $spc = $dx;
|
485
|
+
for (;;) {
|
486
|
+
# find longest label at current spacing
|
487
|
+
my $len = 0;
|
488
|
+
my $x0 = int($xmax / $spc + 0.5) * $spc; # get value of last x label
|
489
|
+
for ($i=0, $x=$x0; $i<3; ++$i, $x-=$spc) {
|
490
|
+
$n = length sprintf('%g', $x);
|
491
|
+
$len = $n if $len < $n;
|
492
|
+
}
|
493
|
+
last if $spc >= ($len + 1) * $wch * $xdiff / $width;
|
494
|
+
# increase label spacing by one increment and try again
|
495
|
+
$spc = $dx2 = GetGridSpacing($spc, 1);
|
496
|
+
}
|
497
|
+
my ($grid, $lastLen) = ('', 0);
|
498
|
+
for ($x=int($xmin/$dx-1)*$dx; ; $x+=$dx) {
|
499
|
+
$px = int(($margin[0] + ($x - $xmin) * $width / $xdiff) * 10 + 0.5) / 10;
|
500
|
+
next if $px < $margin[0] - 0.5;
|
501
|
+
last if $px > $margin[0] + $width + 0.5;
|
502
|
+
my $h = $height;
|
503
|
+
if (not $dx2 or abs($x/$dx2 - int($x/$dx2+($x>0 ? 0.5 : -0.5))) < 0.01) {
|
504
|
+
printf $fp "\n<text x='${px}' y='${py}'>%g</text>", $x;
|
505
|
+
$h += $$tpad[1]/2;
|
506
|
+
}
|
507
|
+
length($grid) - $lastLen > 80 and $grid .= "\n", $lastLen = length($grid);
|
508
|
+
$grid .= sprintf("M$px $margin[1] v$h ");
|
509
|
+
}
|
510
|
+
print $fp "\n<path stroke='$$self{grid}' stroke-width='0.5' d='\n${grid}'/>";
|
511
|
+
print $fp "\n</g>\n<!-- Y axis -->\n<g dominant-baseline='middle' text-anchor='end'>";
|
512
|
+
$px = int(($margin[0] - $$tpad[0]) * 10 + 0.5) / 10;
|
513
|
+
($grid, $lastLen) = ('', 0);
|
514
|
+
my ($gx, $gw) = ($margin[0]-$$tpad[0]/2, $width + $$tpad[0]/2);
|
515
|
+
for ($y=$min; ; $y+=$dy) {
|
516
|
+
$py = int(($margin[1] + $height - ($y - $min) * $yscl) * 10 + 0.5) / 10;
|
517
|
+
last if $py < $margin[1] - 0.5;
|
518
|
+
$y = 0 if $y < $dy/2 and $y > -$dy/2; # (avoid round-off errors)
|
519
|
+
printf $fp "\n<text x='${px}' y='${py}'>%g</text>", $y;
|
520
|
+
$y < $dy/2 and $y > -$dy/2 and $xAxis = 1; # redraw x axis later
|
521
|
+
length($grid) - $lastLen > 80 and $grid .= "\n", $lastLen = length($grid);
|
522
|
+
$grid .= "M$gx $py h$gw ";
|
523
|
+
}
|
524
|
+
if ($xAxis and $min!=0) {
|
525
|
+
$py = $margin[1] + $height + $min * $yscl;
|
526
|
+
print $fp "\n<path stroke='$$self{text}' d='M$margin[0] $py h$width'/>";
|
527
|
+
}
|
528
|
+
print $fp "\n<path stroke='$$self{grid}' stroke-width='0.5' d='\n${grid}'/>";
|
529
|
+
print $fp "\n</g>\n<!-- Plot box and legend -->\n<g dominant-baseline='middle' text-anchor='start'>";
|
530
|
+
print $fp "\n<path stroke='$$self{text}' fill='none' d='M$margin[0] $margin[1] l0 $height $width 0 0 -$height z'/>";
|
531
|
+
for ($i=0; $i<@name and not $noLegend; ++$i) {
|
532
|
+
$x = $size[0] - $margin[2] - 175 + $$self{legend}[0];
|
533
|
+
$y = $margin[1] + $$self{legend}[1] + 15 + $$self{linespacing} * ($i + 0.5);
|
534
|
+
my $col = $$cols[$i];
|
535
|
+
my $mark = $markID{$i} ? " marker-end='url(#$markID{$i})' fill='none'" : '';
|
536
|
+
my $line = ($style =~ /\bl/) ? ' l-20 0' : sprintf(' m%.4g 0', -5 * $wid);
|
537
|
+
my $sw = ($style =~ /\bm/ ? 1.5 : 2) * $wid; # (wider for line-only style so colour is more visible)
|
538
|
+
print $fp "\n<path$mark stroke-width='${sw}' stroke='${col}' d='M$x $y m-7 -1${line}'/>";
|
539
|
+
print $fp "\n<text x='${x}' y='${y}'>$name[$i]</text>";
|
540
|
+
}
|
541
|
+
# print the data
|
542
|
+
foreach (0..$#name) {
|
543
|
+
$col{$name[$_]} = $$cols[$_];
|
544
|
+
$class{$name[$_]} = $markID{$_} ? " class='$markID{$_}'" : '';
|
545
|
+
}
|
546
|
+
my ($i0, $i1, $xsclr);
|
547
|
+
my $fill = '';
|
548
|
+
if ($scat) {
|
549
|
+
($i0, $i1) = (0, $#$xdat);
|
550
|
+
} elsif ($hist) {
|
551
|
+
($i0, $i1) = (0, $#$hist);
|
552
|
+
$xscl = $width / @$hist;
|
553
|
+
$px0 = $margin[0];
|
554
|
+
$xsclr = int($xscl * 100 + 0.5) / 100;
|
555
|
+
if ($style =~ /\bf/) {
|
556
|
+
my @m = split /-/, $$marks[0];
|
557
|
+
my $op = $m[3] || ($style =~ /\bl/ ? 20 : 50);
|
558
|
+
$fill = " fill='$$cols[0]'";
|
559
|
+
$fill .= " style='fill-opacity: $op%'" if $$cols[0] ne 'none';
|
560
|
+
}
|
561
|
+
} else {
|
562
|
+
$i0 = int($xmin) - 1;
|
563
|
+
$i0 = 0 if $i0 < 0;
|
564
|
+
$i1 = int($xmax) + 1;
|
565
|
+
}
|
566
|
+
print $fp "\n</g>\n<!-- Datasets -->\n<g fill='none' clip-path='url(#plot-area)'",
|
567
|
+
" stroke-linejoin='round' stroke-linecap='round' stroke-width='",1.5*$wid,"'>";
|
568
|
+
my $doLines = $style =~ /\bl/;
|
569
|
+
foreach (@name) {
|
570
|
+
my $stroke = ($hist and not $doLines) ? 'none' : $col{$_};
|
571
|
+
my $dat = $$data{$_};
|
572
|
+
print $fp "\n<!-- $_ -->";
|
573
|
+
print $fp "\n<path$class{$_}$fill stroke='${stroke}' d='";
|
574
|
+
print $fp 'M' if $doLines;
|
575
|
+
my $m = $doLines ? '' : ' M';
|
576
|
+
for ($i=$i0; $i<=$i1; ++$i) {
|
577
|
+
next unless defined $$dat[$i];
|
578
|
+
$y = int(($py0 - $$dat[$i] * $yscl) * 10 + 0.5) / 10;
|
579
|
+
if ($scat) {
|
580
|
+
next unless defined $$xdat[$i];
|
581
|
+
$x = int(($px0 + $$xdat[$i] * $xscl) * 10 + 0.5) / 10;
|
582
|
+
} else {
|
583
|
+
$x = int(($px0 + $i * $xscl) * 10 + 0.5) / 10;
|
584
|
+
if ($hist) {
|
585
|
+
print $fp $m, ($i % 5 ? ' ' : "\n"), "$x $y h$xsclr";
|
586
|
+
$m = ' L'; # (draw lines after the first point)
|
587
|
+
next;
|
588
|
+
}
|
589
|
+
}
|
590
|
+
print $fp $m, ($i % 10 ? ' ' : "\n"), "$x $y";
|
591
|
+
}
|
592
|
+
print $fp ' V', $margin[1]+$height, " H$margin[0] z" if $hist and $fill;
|
593
|
+
print $fp "'/>";
|
594
|
+
}
|
595
|
+
print $fp "\n</g>";
|
596
|
+
print $fp "\n</g>" if $numPlots > 1;
|
597
|
+
}
|
598
|
+
print $fp "</svg>\n" or $$self{Error} = 'Error writing output plot file';
|
599
|
+
}
|
600
|
+
|
601
|
+
1; # end
|
602
|
+
|
603
|
+
__END__
|
604
|
+
|
605
|
+
=head1 NAME
|
606
|
+
|
607
|
+
Image::ExifTool::Plot - Plot tag values in SVG format
|
608
|
+
|
609
|
+
=head1 DESCRIPTION
|
610
|
+
|
611
|
+
Output plots in SVG format based on ExifTool tag information.
|
612
|
+
|
613
|
+
=head1 METHODS
|
614
|
+
|
615
|
+
=head2 new
|
616
|
+
|
617
|
+
Create a new Plot object.
|
618
|
+
|
619
|
+
$plot = Image::ExifTool::Plot->new;
|
620
|
+
|
621
|
+
=head2 Settings
|
622
|
+
|
623
|
+
Change plot settings.
|
624
|
+
|
625
|
+
=over 4
|
626
|
+
|
627
|
+
=item Inputs:
|
628
|
+
|
629
|
+
0) Plot object reference
|
630
|
+
|
631
|
+
1) Comma-delimited string of options
|
632
|
+
|
633
|
+
=item Options:
|
634
|
+
|
635
|
+
"Type=Line" - plot type (Line, Scatter or Histogram)
|
636
|
+
"Style=Line" - data style (Line, Marker and/or Fill)
|
637
|
+
"NBins=20" - number of bins for histogram plot
|
638
|
+
"Size=800 600" - width,height of output image
|
639
|
+
"Margin=60 15 15 30" - left,top,right,bottom margins around plot area
|
640
|
+
"Legend=0 0" - x,y offset to shift plot legend
|
641
|
+
"TxtPad=10 10" - padding between text and x,y scale
|
642
|
+
"LineSpacing=20" - spacing between text lines
|
643
|
+
"Stroke=1" - plot stroke width and marker-size scaling factor
|
644
|
+
Title, XLabel, YLabel - plot title and x/y axis labels (no default)
|
645
|
+
XMin, XMax - x axis minimum/maximum (autoscaling if not set)
|
646
|
+
YMin, YMax - y axis minimum/maximum
|
647
|
+
Multi - flag to draw multiple plots, one for each dataset
|
648
|
+
Split - flag to split strings of numbers into lists
|
649
|
+
(> 1 to split into lists of N items)
|
650
|
+
"Grid=darkgray" - grid color
|
651
|
+
"Text=black" - color of text and plot border
|
652
|
+
"Bkg=" - background color (default is transparent)
|
653
|
+
"Cols=red green blue black orange gray fuchsia brown turquoise gold"
|
654
|
+
- colors for plot data
|
655
|
+
"Marks=circle square triangle diamond star plus pentagon left down right"
|
656
|
+
- marker-shape names for each dataset
|
657
|
+
|
658
|
+
=back
|
659
|
+
|
660
|
+
=head2 AddPoints
|
661
|
+
|
662
|
+
Add points to be plotted.
|
663
|
+
|
664
|
+
=over 4
|
665
|
+
|
666
|
+
=item Inputs:
|
667
|
+
|
668
|
+
0) Plot object reference
|
669
|
+
|
670
|
+
1) Tag information hash reference from ExifTool
|
671
|
+
|
672
|
+
2) List of tag keys to plot
|
673
|
+
|
674
|
+
=back
|
675
|
+
|
676
|
+
=head2 Draw
|
677
|
+
|
678
|
+
Draw the SVG plot to the specified output file.
|
679
|
+
|
680
|
+
=over 4
|
681
|
+
|
682
|
+
=item Inputs:
|
683
|
+
|
684
|
+
0) Plot object reference
|
685
|
+
|
686
|
+
1) Output file reference
|
687
|
+
|
688
|
+
=item Notes:
|
689
|
+
|
690
|
+
On return, the Plot Error and Warn members contain error or warning strings
|
691
|
+
if there were any problems. If an Error is set, then the output SVG is
|
692
|
+
invalid.
|
693
|
+
|
694
|
+
=back
|
695
|
+
|
696
|
+
=head1 AUTHOR
|
697
|
+
|
698
|
+
Copyright 2003-2025, Phil Harvey (philharvey66 at gmail.com)
|
699
|
+
|
700
|
+
This library is free software; you can redistribute it and/or modify it
|
701
|
+
under the same terms as Perl itself.
|
702
|
+
|
703
|
+
=head1 SEE ALSO
|
704
|
+
|
705
|
+
=over 4
|
706
|
+
|
707
|
+
=item L<https://exiftool.org/plot.html>
|
708
|
+
|
709
|
+
=back
|
710
|
+
|
711
|
+
=cut
|
712
|
+
|