exiftool_vendored 13.21.0 → 13.24.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.
@@ -11,23 +11,24 @@ package Image::ExifTool::Plot;
11
11
  use strict;
12
12
  use vars qw($VERSION);
13
13
 
14
- $VERSION = '1.01';
14
+ $VERSION = '1.02';
15
15
 
16
16
  # default plot settings (lower-case settings may be overridden by the user)
17
17
  my %defaults = (
18
18
  size => [ 800, 600 ], # width,height of output image
19
19
  margin => [ 60, 15, 15, 30 ], # left,top,right,bottom margins around plot area
20
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
- # colors for plot lines
24
- cols => [ qw(red green blue black orange gray purple cyan brown pink
25
- goldenrod lightsalmon seagreen goldenrod cadetblue plum
26
- deepskyblue mediumpurple royalblue tomato) ],
27
- grid => 'darkgray', # grid color
28
- text => 'black', # text and plot frame color
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
29
30
  type => 'line', # plot type, 'line' or 'scatter'
30
- style => 'line', # 'line', 'marker' or 'line+marker'
31
+ style => '', # 'line', 'marker' or 'line+marker'
31
32
  xlabel => '', # x axis label
32
33
  ylabel => '', # y axis label
33
34
  title => '', # plot title
@@ -35,24 +36,33 @@ my %defaults = (
35
36
  # xmin, xmax # x axis minimum,maximum
36
37
  # ymin, ymax # y axis minimum,maximum
37
38
  # split # split list of numbers into separate plot lines
38
- # bkg # background color
39
+ # bkg # background colour
40
+ # multi # flag to make one plot per dataset
41
+ #
42
+ # members containing capital letters are used internally
43
+ #
39
44
  Data => { }, # data arrays for each variable
40
45
  Name => [ ], # variable names
41
- XMax => 0, # number of points in plot so far
46
+ # XMin, XMax # min/max data index
47
+ # YMin, YMax # min/max data value
48
+ # SaveName, Save # saved variables between plots
42
49
  );
43
50
 
44
- my @markerName = qw(circle square triangle diamond triangle2 triangle3 triangle4);
45
- my @markerData = (
46
- '<circle cx="6" cy="6" r="4" stroke-width="1.5" stroke="context-stroke" fill="none" />',
47
- '<path stroke-width="1.5" stroke="context-stroke" fill="none" d="M2.5 2.5 l7 0 0 7 -7 0 z"/>',
48
- '<path stroke-width="1.5" stroke="context-stroke" fill="none" d="M6 1.2 l4 8 -8 0 z"/>',
49
- '<path stroke-width="1.5" stroke="context-stroke" fill="none" d="M6 1.5 l4.5 4.5 -4.5 4.5 -4.5 -4.5 z"/>',
50
- '<path stroke-width="1.5" stroke="context-stroke" fill="none" d="M1.2 6 l8 4 0 -8 z"/>',
51
- '<path stroke-width="1.5" stroke="context-stroke" fill="none" d="M6 10.8 l4 -8 -8 0 z"/>',
52
- '<path stroke-width="1.5" stroke="context-stroke" fill="none" d="M10.8 6 l-8 4 0 -8 z"/>',
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"',
53
62
  );
54
- # optimal number grid lines in X and Y for a 800x600 plot and nominal character width
55
- my ($nx, $ny, $wch) = (15, 12, 8);
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)
56
66
 
57
67
  #------------------------------------------------------------------------------
58
68
  # Create new plot object
@@ -78,17 +88,40 @@ sub Settings($$)
78
88
  return unless $set;
79
89
  foreach (split /,\s*/, $set) {
80
90
  next unless /^([a-z].*?)(=(.*))?$/i;
81
- my ($name, $val) = ($1, $3);
91
+ my ($name, $val) = (lc $1, $3);
82
92
  if (ref $$self{$name} eq 'ARRAY') {
83
93
  next unless defined $val;
84
- $$self{lc $name} = [ split /[\s\/]+/, $val ]; # split on space or slash
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
+ }
85
118
  } else {
86
119
  $val = 1 unless defined $val; # default to 1 if no "="
87
120
  my %charName = ('&'=>'amp', '<'=>'lt', '>'=>'gt');
88
121
  # escape necessary XML characters, but allow numerical entities
89
122
  $val =~ s/([&><])/&$charName{$1};/sg and $val =~ s/&amp;(#(\d+|x[0-9a-fA-F]+);)/&$1/;
90
123
  undef $val unless length $val;
91
- $$self{lc $name} = $val;
124
+ $$self{$name} = $val;
92
125
  }
93
126
  }
94
127
  }
@@ -102,12 +135,13 @@ sub AddPoints($$$)
102
135
  my ($tag, $name, %num, $index, $mod, $val, @vals);
103
136
  my ($ee, $docNum, $data, $xmin, $xmax) = @$self{qw(EE DocNum Data XMin XMax)};
104
137
  $$self{type} or $$self{type} = 'line';
105
- my $scat = $$self{type} =~ /^s/i;
138
+ my $scat = $$self{type} =~ /^s/ ? 1 : 0;
106
139
  my $xname = $$self{Name}[0]; # (x-axis name if using scatter plot)
107
- my $maxLines = $$self{type} =~ /^h/i ? 1 : 20;
140
+ my $maxLines = ($$self{type} =~ /^h/ and not $$self{multi}) ? 1 : 20;
108
141
  for (;;) {
109
142
  if (@vals) {
110
143
  $val = shift @vals;
144
+ next unless $val =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?$/;
111
145
  } else {
112
146
  $tag = shift @$tags or last;
113
147
  # ignore non-floating-point values
@@ -127,7 +161,7 @@ sub AddPoints($$$)
127
161
  }
128
162
  }
129
163
  }
130
- next unless defined $val and $val =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?([ ,;\t\n\r]?|\z)/i;
164
+ next unless defined $val and $val =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?([ ,;\t\n\r]+|$)/i;
131
165
  if ($1) {
132
166
  # split a string of numbers into separate plot points (eg. histogram tags)
133
167
  if ($$self{'split'}) {
@@ -145,10 +179,10 @@ sub AddPoints($$$)
145
179
  my $docNum = $docNum ? $$docNum{$tag} || 0 : 0;
146
180
  next if $docNum and not $ee;
147
181
  unless ($$data{$name}) {
148
- if (@{$$self{Name}} >= $maxLines) {
182
+ if (@{$$self{Name}} >= $maxLines + $scat) {
149
183
  unless ($$self{MaxTags}) {
150
- if ($$self{type} =~ /^h/i) {
151
- $$self{Warn} = 'A histogram can only plot one variable';
184
+ if ($$self{type} =~ /^h/ and not $$self{multi}) {
185
+ $$self{Warn} = 'Use the Multi setting to make a separate histogram for each dataset';
152
186
  } else {
153
187
  $$self{Warn} = 'Too many variables to plot all of them';
154
188
  }
@@ -158,10 +192,11 @@ sub AddPoints($$$)
158
192
  }
159
193
  push @{$$self{Name}}, $name;
160
194
  $xname or $xname = $name; # x-axis data for scatter plot
161
- unless (defined $$self{Min}) {
162
- $$self{Min} = $$self{Max} = $val unless $scat and $name eq $xname;
163
- $xmin = $xmax = $docNum unless defined $xmin;
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};
164
198
  }
199
+ $xmin = $xmax = $docNum unless defined $xmin;
165
200
  $num{$name} = $xmax;
166
201
  $$data{$name}[$xmax - $xmin] = $val if $xmax >= $xmin;
167
202
  next;
@@ -186,20 +221,40 @@ sub AddPoints($$$)
186
221
 
187
222
  #------------------------------------------------------------------------------
188
223
  # Calculate a nice round number for grid spacing
189
- # Inputs: 0) nominal spacing (must be positive)
224
+ # Inputs: 0) nominal spacing (must be positive), 1) flag to increment to next number
190
225
  # Returns: spacing rounded to an even number
191
- sub GetGridSpacing($)
226
+ sub GetGridSpacing($;$)
192
227
  {
193
- my $nom = shift;
194
- my $rounded;
228
+ my ($nom, $inc) = @_;
229
+ my ($rounded, $spc);
195
230
  my $div = sprintf('%.3e', $nom);
196
231
  my $num = substr($div, 0, 1);
197
232
  my $exp = $div =~ s/.*e// ? $div : 0;
198
- # look for nearest factor to 1, 1.5, 2 or 5 * 10^x
199
- ($num, $exp) = $num < 8 ? (5, $exp) : (1, $exp+1) if $num > 2;
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
+ }
200
240
  return $exp >= 0 ? $num . ('0' x $exp) : '.' . ('0' x (-$exp - 1)) . $num;
201
241
  }
202
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
+
203
258
  #------------------------------------------------------------------------------
204
259
  # Draw SVG plot
205
260
  # Inputs: 0) Plot ref, 1) Output file reference
@@ -208,29 +263,85 @@ sub Draw($$)
208
263
  my ($self, $fp) = @_;
209
264
  my ($min, $max, $xmin, $xmax, $name, $style) = @$self{qw(Min Max XMin XMax Name style)};
210
265
 
211
- if (not defined $min or not defined $xmin or not $style) {
266
+ if (not defined $min or not defined $xmin) {
212
267
  $$self{Error} = 'Nothing to plot';
213
268
  return;
214
269
  }
215
- my ($data, $title, $xlabel, $ylabel, $cols) = @$self{qw(Data title xlabel ylabel cols)};
216
- my ($i, $n, %col, %class, $dx, $dy, $dx2, $xAxis, $x, $y, $px, $py);
217
- my ($grid, $lastLen, $noLegend, $xname, $xdat, $xdiff, $diff);
218
- my $scat = $$self{type} =~ /^s/i ? 1 : 0;
219
- my $hist = $$self{type} =~ /^h/i ? [ ] : 0;
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)};
220
319
  my @name = @$name;
221
320
  my @margin = ( @{$$self{margin}} );
222
321
 
223
322
  # set reasonable default titles and labels
224
323
  $xname = shift @name if $scat;
225
324
  $title = "$name[0] vs $xname" if $scat and defined $title and not $title and @name == 1;
226
- $xlabel = $$name[0] if $scat || $hist and defined $xlabel and not $xlabel;
227
- $ylabel = ($hist ? 'Count' : $name[0]) and $noLegend=1 if defined $ylabel and not $ylabel 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
+ }
228
333
 
229
334
  # make room for title/labels
230
- $margin[1] += $$self{lineSpacing} * 1.5 if $title;
231
- $margin[3] += $$self{lineSpacing} if $xlabel;
232
- $margin[0] += $$self{lineSpacing} if $ylabel;
335
+ $margin[1] += $$self{linespacing} * 1.5 if $title;
336
+ $margin[3] += $$self{linespacing} if $xlabel;
337
+ $margin[0] += $$self{linespacing} if $ylabel;
233
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
+ }
234
345
  if ($scat) {
235
346
  $xdat = $$self{Data}{$xname};
236
347
  unless (defined $$self{xmin} and defined $$self{xmax}) {
@@ -241,7 +352,7 @@ sub Draw($$)
241
352
  $xmin = $_ if $xmin > $_;
242
353
  $xmax = $_ if $xmax < $_;
243
354
  }
244
- my $dnx2 = ($xmax - $xmin) / ($nx * 2);
355
+ my $dnx2 = ($xmax - $xmin) / ($og[0] * 2);
245
356
  # leave a bit of a left/right margin, but don't pass 0
246
357
  $xmin = ($xmin >= 0 and $xmin < $dnx2) ? 0 : $xmin - $dnx2;
247
358
  $xmax = ($xmax <= 0 and -$xmax < $dnx2) ? 0 : $xmax + $dnx2;
@@ -261,7 +372,7 @@ sub Draw($$)
261
372
  $max = $$self{xmax} if defined $$self{xmax};
262
373
  } else {
263
374
  # leave a bit of a margin above/below data when autoscaling but don't pass 0
264
- my $dny2 = ($max - $min) / ($ny * 2);
375
+ my $dny2 = ($max - $min) / ($og[1] * 2);
265
376
  $min = ($min >= 0 and $min < $dny2) ? 0 : $min - $dny2;
266
377
  $max = ($max <= 0 and -$max < $dny2) ? 0 : $max + $dny2;
267
378
  # adjust to user-defined range if specified
@@ -269,15 +380,15 @@ sub Draw($$)
269
380
  $max = $$self{ymax} if defined $$self{ymax};
270
381
  }
271
382
  # generate random colors if we need more
272
- while (@$cols < @$name) {#138
383
+ while (@$cols < @$name) {
273
384
  $$self{seeded} or srand(141), $$self{seeded} = 1;
274
385
  push @$cols, sprintf("#%.2x%.2x%.2x",int(rand(220)),int(rand(220)),int(rand(220)));
275
386
  }
276
- $diff = $max - $min || 1;
277
- $xdiff = $xmax - $xmin || 1;
387
+ $diff = GetRange($min, $max);
388
+ $xdiff = GetRange($xmin, $xmax);
278
389
 
279
390
  # determine y grid spacing (nice even numbers)
280
- $dy = GetGridSpacing($diff / ($hist ? $$self{nbins} : $ny));
391
+ $dy = GetGridSpacing($diff / ($hist ? $$self{nbins} : $og[1]));
281
392
  # expand plot min/max to the nearest even multiple of our grid spacing
282
393
  $min = ($min > 0 ? int($min/$dy) : int($min/$dy-0.9999)) * $dy;
283
394
  $max = ($max > 0 ? int($max/$dy+0.9999) : int($max/$dy)) * $dy;
@@ -300,125 +411,138 @@ sub Draw($$)
300
411
  } else {
301
412
  $max < $_ and $max = $_ foreach @$hist; # find max count
302
413
  }
303
- $diff = $max - $min || 1;
414
+ $diff = GetRange($min, $max);
304
415
  $dx = $dy;
305
- $dy = GetGridSpacing($diff / $ny);
416
+ $dy = GetGridSpacing($diff / $og[1]);
306
417
  $max = ($max > 0 ? int($max/$dy+0.9999) : int($max/$dy)) * $dy;
307
418
  $$data{$name[0]} = $hist;
308
419
  } else {
309
- $dx = GetGridSpacing($xdiff / $nx);
420
+ $dx = GetGridSpacing($xdiff / $og[0]);
310
421
  }
311
422
  if ($scat) {
312
423
  $xmin = ($xmin > 0 ? int($xmin/$dx) : int($xmin/$dx-0.9999)) * $dx;
313
424
  $xmax = ($xmax > 0 ? int($xmax/$dx+0.9999) : int($xmax/$dx)) * $dx;
314
425
  }
315
- $diff = $max - $min || 1;
316
- $xdiff = $xmax - $xmin || 1;
426
+ $diff = GetRange($min, $max);
427
+ $xdiff = GetRange($xmin, $xmax);
317
428
  # width/height of plot area
318
- my $width = $$self{size}[0] - $margin[0] - $margin[2];
319
- my $height = $$self{size}[1] - $margin[1] - $margin[3];
429
+ my $width = $size[0] - $margin[0] - $margin[2];
430
+ my $height = $size[1] - $margin[1] - $margin[3];
320
431
  my $yscl = $height / $diff;
321
432
  my $xscl = $width / $xdiff;
322
433
  my $px0 = $margin[0] - $xmin * $xscl;
323
434
  my $py0 = $margin[1] + $height + $min * $yscl;
324
- my $tmp = $title || "Plot by ExifTool $Image::ExifTool::VERSION";
325
- print $fp qq{<?xml version="1.0" standalone="no"?>
326
- <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
327
- <svg version="1.1" xmlns="http://www.w3.org/2000/svg" width="$$self{size}[0]" height="$$self{size}[1]"
328
- preserveAspectRatio="xMidYMid meet" viewBox="0 0 $$self{size}[0] $$self{size}[1]">
329
- <title>$tmp</title>};
330
- print $fp "<rect x='0' y='0' width='$$self{size}[0]' height='$$self{size}[1]' fill='$$self{bkg}'/>" if $$self{bkg};
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
+ # (was using 'context-stroke', but Chrome didn't show this properly)
452
+ $mark .= " stroke='$$cols[$i]'/>";
453
+ # don't re-define mark if it is the same as a previous one
454
+ $markID{$mark} and $markID{$i} = $markID{$mark}, next;
455
+ $markID{$mark} = $markID{$i} = "mark$i";
456
+ print $fp "\n<marker id='$markID{$i}' markerWidth='8' markerHeight='8' refX='4'",
457
+ " refY='4'>\n$mark\n</marker>";
458
+ }
459
+ print $fp "\n</defs>\n<style>";
460
+ for ($i=0; $i<@name; ++$i) {
461
+ next unless $markID{$i} eq "mark$i";
462
+ print $fp "\n path.mark$i { marker: url(#mark$i) }";
463
+ }
464
+ } else {
465
+ print $fp "\n</defs>\n<style>";
466
+ }
467
+ print $fp "\n text { fill: $$self{text} }\n</style>";
468
+ print $fp "\n<rect x='0' y='0' width='$size[0]' height='$size[1]' fill='$$self{bkg}'/>" if $$self{bkg};
331
469
  print $fp "\n<!-- X axis -->";
332
470
  print $fp "\n<g dominant-baseline='hanging' text-anchor='middle'>";
333
- $py = int(($margin[1] + $height + $$self{txtPad}[1]) * 10 + 0.5) / 10;
471
+ $py = int(($margin[1] + $height + $$tpad[1]) * 10 + 0.5) / 10;
334
472
  $px = int(($margin[0] + $width / 2) * 10 + 0.5) / 10;
335
473
  if ($title) {
336
474
  print $fp "\n<text x='${px}' y='14' font-size='150%'>$title</text>";
337
475
  }
338
476
  if ($xlabel) {
339
- $y = $py + $$self{lineSpacing};
477
+ $y = $py + $$self{linespacing};
340
478
  print $fp "\n<text x='${px}' y='${y}'>$xlabel</text>";
341
479
  }
342
480
  if ($ylabel) {
343
481
  $y = $margin[1] + $height / 2;
344
482
  print $fp "\n<text x='10' y='${y}' transform='rotate(-90,10,$y)'>$ylabel</text>";
345
483
  }
346
- # check to be sure the X labels will fit
347
- my $len = 0;
348
- for ($i=0, $x=$xmax; $i<3; ++$i, $x-=$dx) {
349
- $n = length sprintf('%g', $x);
350
- $len = $n if $len < $n;
484
+ # make sure the X labels will fit
485
+ my $spc = $dx;
486
+ for (;;) {
487
+ # find longest label at current spacing
488
+ my $len = 0;
489
+ my $x0 = int($xmax / $spc + 0.5) * $spc; # get value of last x label
490
+ for ($i=0, $x=$x0; $i<3; ++$i, $x-=$spc) {
491
+ $n = length sprintf('%g', $x);
492
+ $len = $n if $len < $n;
493
+ }
494
+ last if $spc >= ($len + 1) * $wch * $xdiff / $width;
495
+ # increase label spacing by one increment and try again
496
+ $spc = $dx2 = GetGridSpacing($spc, 1);
351
497
  }
352
- my $n = $wch * $len * $xdiff / $dx; # conservative length of all x-axis text
353
- $dx2 = GetGridSpacing($dx * $n * 1.5 / 500) if $n > 500; # use larger label spacing
354
- ($grid, $lastLen) = ('', 0);
498
+ my ($grid, $lastLen) = ('', 0);
355
499
  for ($x=int($xmin/$dx-1)*$dx; ; $x+=$dx) {
356
500
  $px = int(($margin[0] + ($x - $xmin) * $width / $xdiff) * 10 + 0.5) / 10;
357
501
  next if $px < $margin[0] - 0.5;
358
502
  last if $px > $margin[0] + $width + 0.5;
359
- if (not $dx2 or $x/$dx2 - int($x/$dx2) < 0.1) {
503
+ my $h = $height;
504
+ if (not $dx2 or abs($x/$dx2 - int($x/$dx2+($x>0 ? 0.5 : -0.5))) < 0.01) {
360
505
  printf $fp "\n<text x='${px}' y='${py}'>%g</text>", $x;
506
+ $h += $$tpad[1]/2;
361
507
  }
362
508
  length($grid) - $lastLen > 80 and $grid .= "\n", $lastLen = length($grid);
363
- $grid .= sprintf("M$px $margin[1] v$height ");
509
+ $grid .= sprintf("M$px $margin[1] v$h ");
364
510
  }
365
511
  print $fp "\n<path stroke='$$self{grid}' stroke-width='0.5' d='\n${grid}'/>";
366
512
  print $fp "\n</g>\n<!-- Y axis -->\n<g dominant-baseline='middle' text-anchor='end'>";
367
- $px = int(($margin[0] - $$self{txtPad}[0]) * 10 + 0.5) / 10;
513
+ $px = int(($margin[0] - $$tpad[0]) * 10 + 0.5) / 10;
368
514
  ($grid, $lastLen) = ('', 0);
515
+ my ($gx, $gw) = ($margin[0]-$$tpad[0]/2, $width + $$tpad[0]/2);
369
516
  for ($y=$min; ; $y+=$dy) {
370
517
  $py = int(($margin[1] + $height - ($y - $min) * $yscl) * 10 + 0.5) / 10;
371
518
  last if $py < $margin[1] - 0.5;
372
- $y = 0 if $y < $dy/2 and $y > -$dy/2; # (avoid round-off errors)
519
+ $y = 0 if $y < $dy/2 and $y > -$dy/2; # (avoid round-off errors)
373
520
  printf $fp "\n<text x='${px}' y='${py}'>%g</text>", $y;
374
- $y < $dy/2 and $y > -$dy/2 and $xAxis = 1, next; # draw x axis later
521
+ $y < $dy/2 and $y > -$dy/2 and $xAxis = 1; # redraw x axis later
375
522
  length($grid) - $lastLen > 80 and $grid .= "\n", $lastLen = length($grid);
376
- $grid .= "M$margin[0] $py h$width ";
523
+ $grid .= "M$gx $py h$gw ";
377
524
  }
378
525
  if ($xAxis and $min!=0) {
379
526
  $py = $margin[1] + $height + $min * $yscl;
380
- print $fp "\n<path stroke='$$self{text}' d='M$margin[0] $py h${width}'/>";
527
+ print $fp "\n<path stroke='$$self{text}' d='M$margin[0] $py h$width'/>";
381
528
  }
382
529
  print $fp "\n<path stroke='$$self{grid}' stroke-width='0.5' d='\n${grid}'/>";
383
- print $fp "\n</g>\n<!-- Plot box and legend-->\n<g dominant-baseline='middle' text-anchor='start'>";
530
+ print $fp "\n</g>\n<!-- Plot box and legend -->\n<g dominant-baseline='middle' text-anchor='start'>";
384
531
  print $fp "\n<path stroke='$$self{text}' fill='none' d='M$margin[0] $margin[1] l0 $height $width 0 0 -$height z'/>";
385
532
  for ($i=0; $i<@name and not $noLegend; ++$i) {
386
- next if $scat and not $i;
387
- $x = $margin[0] + $$self{legend}[0] + 550;
388
- $y = $margin[1] + $$self{legend}[1] + 15 + $$self{lineSpacing} * ($i - $scat + 0.5);
533
+ $x = $size[0] - $margin[2] - 175 + $$self{legend}[0];
534
+ $y = $margin[1] + $$self{legend}[1] + 15 + $$self{linespacing} * ($i + 0.5);
389
535
  my $col = $$cols[$i];
390
- my $mark = '';
391
- if ($style =~ /\b[mp]/i) { # 'm' for 'marker' or 'p' for 'point' (undocumented)
392
- my $id = $markerName[$i % @markerName];
393
- $mark = " marker-end='url(#$id)' fill='none'";
394
- }
395
- my $line = ($style =~ /\bl/i) ? ' l-20 0' : '';
396
- print $fp "\n<path$mark stroke-width='2' stroke='${col}' d='M$x $y m-7 -1${line}'/>";
536
+ my $mark = $markID{$i} ? " marker-end='url(#$markID{$i})' fill='none'" : '';
537
+ my $line = ($style =~ /\bl/) ? ' l-20 0' : sprintf(' m%.4g 0', -5 * $wid);
538
+ my $sw = ($style =~ /\bm/ ? 1.5 : 2) * $wid; # (wider for line-only style so colour is more visible)
539
+ print $fp "\n<path$mark stroke-width='${sw}' stroke='${col}' d='M$x $y m-7 -1${line}'/>";
397
540
  print $fp "\n<text x='${x}' y='${y}'>$name[$i]</text>";
398
541
  }
399
- my @clip = ($margin[0]-6, $margin[1]-6, $width+12, $height+12);
400
- print $fp "\n</g>\n<!-- Definitions -->\n<defs>";
401
- print $fp "\n<clipPath id='plot-area'><rect x='$clip[0]' y='$clip[1]' width='$clip[2]' height='$clip[3]' /></clipPath>";
402
- if ($style =~ /\b[mp]/i) {
403
- for ($i=0; $i<@markerName and $i<@name; ++$i) {
404
- print $fp "\n<marker id='@markerName[$i]' markerWidth='12' markerHeight='12' refX='6' refY='6' markerUnits='userSpaceOnUse'>";
405
- my $mark = $markerData[$i];
406
- $mark =~ s/"none"/"$$cols[$i]"/ if $style =~ /\bf/i;
407
- print $fp "\n$mark\n</marker>";
408
- }
409
- print $fp "\n</defs>\n<style>";
410
- for ($i=0; $i<@markerName and $i<@name; ++$i) {
411
- print $fp "\n path.$markerName[$i] { marker: url(#$markerName[$i]) }";
412
- }
413
- print $fp "\n text { fill: $$self{text}] }";
414
- print $fp "\n</style>";
415
- } else {
416
- print $fp "\n</defs><style>\n text { fill: $$self{text} }\n</style>";
417
- }
418
- print $fp "\n<g fill='none' clip-path='url(#plot-area)' stroke-linejoin='round' stroke-linecap='round' stroke-width='1.5'>";
542
+ # print the data
419
543
  foreach (0..$#name) {
420
544
  $col{$name[$_]} = $$cols[$_];
421
- $class{$name[$_]} = $style =~ /\b[mp]/i ? ' class="' . $markerName[$_ % @markerName] . '"' : '';
545
+ $class{$name[$_]} = $markID{$_} ? " class='$markID{$_}'" : '';
422
546
  }
423
547
  my ($i0, $i1, $xsclr);
424
548
  my $fill = '';
@@ -429,17 +553,25 @@ sub Draw($$)
429
553
  $xscl = $width / @$hist;
430
554
  $px0 = $margin[0];
431
555
  $xsclr = int($xscl * 100 + 0.5) / 100;
432
- $fill = qq( fill="$$cols[0]" style="fill-opacity: .20") if $$self{style} =~ /\bf/i;
556
+ if ($style =~ /\bf/) {
557
+ my @m = split /-/, $$marks[0];
558
+ my $op = $m[3] || ($style =~ /\bl/ ? 20 : 50);
559
+ $fill = " fill='$$cols[0]'";
560
+ $fill .= " style='fill-opacity: $op%'" if $$cols[0] ne 'none';
561
+ }
433
562
  } else {
434
563
  $i0 = int($xmin) - 1;
435
564
  $i0 = 0 if $i0 < 0;
436
565
  $i1 = int($xmax) + 1;
437
566
  }
567
+ print $fp "\n</g>\n<!-- Datasets -->\n<g fill='none' clip-path='url(#plot-area)'",
568
+ " stroke-linejoin='round' stroke-linecap='round' stroke-width='",1.5*$wid,"'>";
569
+ my $doLines = $style =~ /\bl/;
438
570
  foreach (@name) {
571
+ my $stroke = ($hist and not $doLines) ? 'none' : $col{$_};
439
572
  my $dat = $$data{$_};
440
- my $doLines = $style =~ /\bl/i;
441
573
  print $fp "\n<!-- $_ -->";
442
- print $fp "\n<path$class{$_}$fill stroke='$col{$_}' d='";
574
+ print $fp "\n<path$class{$_}$fill stroke='${stroke}' d='";
443
575
  print $fp 'M' if $doLines;
444
576
  my $m = $doLines ? '' : ' M';
445
577
  for ($i=$i0; $i<=$i1; ++$i) {
@@ -456,12 +588,15 @@ sub Draw($$)
456
588
  next;
457
589
  }
458
590
  }
459
- print $fp $m, ($i % 20 ? ' ' : "\n"), "$x $y";
591
+ print $fp $m, ($i % 10 ? ' ' : "\n"), "$x $y";
460
592
  }
461
593
  print $fp ' V', $margin[1]+$height, " H$margin[0] z" if $hist and $fill;
462
594
  print $fp "'/>";
463
595
  }
464
- print $fp "\n</g></svg>\n";
596
+ print $fp "\n</g>";
597
+ print $fp "\n</g>" if $numPlots > 1;
598
+ }
599
+ print $fp "</svg>\n" or $$self{Error} = 'Error writing output plot file';
465
600
  }
466
601
 
467
602
  1; # end
@@ -472,14 +607,92 @@ __END__
472
607
 
473
608
  Image::ExifTool::Plot - Plot tag values in SVG format
474
609
 
475
- =head1 SYNOPSIS
610
+ =head1 DESCRIPTION
476
611
 
477
- This module is used by Image::ExifTool
612
+ Output plots in SVG format based on ExifTool tag information.
478
613
 
479
- =head1 DESCRIPTION
614
+ =head1 METHODS
615
+
616
+ =head2 new
617
+
618
+ Create a new Plot object.
619
+
620
+ $plot = Image::ExifTool::Plot->new;
621
+
622
+ =head2 Settings
623
+
624
+ Change plot settings.
625
+
626
+ =over 4
627
+
628
+ =item Inputs:
629
+
630
+ 0) Plot object reference
631
+
632
+ 1) Comma-delimited string of options
633
+
634
+ =item Options:
635
+
636
+ "Type=Line" - plot type (Line, Scatter or Histogram)
637
+ "Style=Line" - data style (Line, Marker and/or Fill)
638
+ "NBins=20" - number of bins for histogram plot
639
+ "Size=800 600" - width,height of output image
640
+ "Margin=60 15 15 30" - left,top,right,bottom margins around plot area
641
+ "Legend=0 0" - x,y offset to shift plot legend
642
+ "TxtPad=10 10" - padding between text and x,y scale
643
+ "LineSpacing=20" - spacing between text lines
644
+ "Stroke=1" - plot stroke width and marker-size scaling factor
645
+ Title, XLabel, YLabel - plot title and x/y axis labels (no default)
646
+ XMin, XMax - x axis minimum/maximum (autoscaling if not set)
647
+ YMin, YMax - y axis minimum/maximum
648
+ Multi - flag to draw multiple plots, one for each dataset
649
+ Split - flag to split strings of numbers into lists
650
+ (> 1 to split into lists of N items)
651
+ "Grid=darkgray" - grid color
652
+ "Text=black" - color of text and plot border
653
+ "Bkg=" - background color (default is transparent)
654
+ "Cols=red green blue black orange gray fuchsia brown turquoise gold"
655
+ - colors for plot data
656
+ "Marks=circle square triangle diamond star plus pentagon left down right"
657
+ - marker-shape names for each dataset
658
+
659
+ =back
480
660
 
481
- This module contains definitions required by Image::ExifTool to plot tag
482
- values in SVG format.
661
+ =head2 AddPoints
662
+
663
+ Add points to be plotted.
664
+
665
+ =over 4
666
+
667
+ =item Inputs:
668
+
669
+ 0) Plot object reference
670
+
671
+ 1) Tag information hash reference from ExifTool
672
+
673
+ 2) List of tag keys to plot
674
+
675
+ =back
676
+
677
+ =head2 Draw
678
+
679
+ Draw the SVG plot to the specified output file.
680
+
681
+ =over 4
682
+
683
+ =item Inputs:
684
+
685
+ 0) Plot object reference
686
+
687
+ 1) Output file reference
688
+
689
+ =item Notes:
690
+
691
+ On return, the Plot Error and Warn members contain error or warning strings
692
+ if there were any problems. If an Error is set, then the output SVG is
693
+ invalid.
694
+
695
+ =back
483
696
 
484
697
  =head1 AUTHOR
485
698
 
@@ -488,5 +701,13 @@ Copyright 2003-2025, Phil Harvey (philharvey66 at gmail.com)
488
701
  This library is free software; you can redistribute it and/or modify it
489
702
  under the same terms as Perl itself.
490
703
 
704
+ =head1 SEE ALSO
705
+
706
+ =over 4
707
+
708
+ =item L<https://exiftool.org/plot.html>
709
+
710
+ =back
711
+
491
712
  =cut
492
713