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.
@@ -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/&amp;(#(\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
+