File Coverage

lib/Panotools/Script/Line/Image.pm
Criterion Covered Total %
statement 141 175 80.5
branch 36 76 47.3
condition 6 11 54.5
subroutine 21 25 84.0
pod 0 8 0.0
total 204 295 69.1


line stmt bran cond sub pod time code
1             package Panotools::Script::Line::Image;
2              
3 10     10   55 use strict;
  10         17  
  10         419  
4 10     10   60 use warnings;
  10         18  
  10         265  
5 10     10   55 use Panotools::Script::Line;
  10         16  
  10         321  
6 10     10   4789 use Panotools::Matrix qw(matrix2rollpitchyaw rollpitchyaw2matrix multiply);
  10         36  
  10         1266  
7 10     10   67 use Math::Trig;
  10         23  
  10         14684  
8 10     10   72 use File::Spec;
  10         21  
  10         650  
9 10     10   53 use Math::Trig ':radial';
  10         21  
  10         4277  
10              
11 10     10   61 use vars qw /@ISA/;
  10         22  
  10         28038  
12             @ISA = qw /Panotools::Script::Line/;
13              
14             our $AUTOLOAD;
15              
16             =head1 NAME
17              
18             Panotools::Script::Line::Image - Panotools input image
19              
20             =head1 SYNOPSIS
21              
22             A single input image is described by an 'i' line
23              
24             =head1 DESCRIPTION
25              
26             Basically the same format as an 'o' line.
27              
28             w1000
29             h500 nona requires the width and height of input images wheras PTStitcher/mender don't
30              
31             f0 projection format,
32             0 - rectilinear (normal lenses)
33             1 - Panoramic (Scanning cameras like Noblex)
34             2 - Circular fisheye
35             3 - full-frame fisheye
36             4 - PSphere, equirectangular
37             7 - Mirror (a spherical mirror)
38             8 - Orthographic fisheye
39             10 - Stereographic fisheye
40             21 - Equisolid fisheye
41              
42             v82 horizontal field of view of image (required)
43             y0 yaw angle (required)
44             p43 pitch angle (required)
45             r0 roll angle (required)
46             a,b,c lens correction coefficients (optional)
47             (see http://www.fh-furtwangen.de/~dersch/barrel/barrel.html)
48             d,e initial lens offset in pixels(defaults d0 e0, optional).
49             Used to correct for offset from center of image
50             d - horizontal offset,
51             e - vertical offset
52             g,t initial lens shear. Use to remove slight misalignment
53             of the line scanner relative to the film transport
54             g - horizontal shear
55             t - vertical shear
56             j stack number
57              
58             Eev exposure of image in EV (exposure values)
59             Er white balance factor for red channel
60             Eb white balance factor for blue channel
61              
62             Ra EMoR response model from the Computer Vision Lab at Columbia University
63             Rb This models the camera response curve
64             Rc
65             Rd
66             Re
67              
68             TiX,TiY,TiZ Tilt on x axis, y axis, z axis
69             TiS Scaling of field of view in the tilt transformation
70              
71             TrX,TrY,TrZ Translation on x axis, y axis, z axis
72              
73             Tpy,Tpp yaw and pitch of remapping plane for translation
74              
75             Te0,Te1,Te2,Te3 Test parameters
76              
77             Vm vignetting correction mode (default 0):
78             0: no vignetting correction
79             1: radial vignetting correction (see j,k,l,o options)
80             2: flatfield vignetting correction (see p option)
81             4: proportional correction: i_new = i / corr.
82             This mode is recommended for use with linear data.
83             If the input data is gamma corrected, try adding g2.2
84             to the m line.
85              
86             default is additive correction: i_new = i + corr
87              
88             Both radial and flatfield correction can be combined with the
89             proportional correction by adding 4.
90             Examples: i1 - radial polynomial correction by addition.
91             The coefficients j,k,l,o must be specified.
92             i5 - radial polynomial correction by division.
93             The coefficients j,k,l,o must be specified.
94             i6 - flatfield correction by division.
95             The flatfield image should be specified with the p option
96              
97             Va,Vb,Vc,Vd vignetting correction coefficients. (defaults: 0,0,0,0)
98             ( 0, 2, 4, 6 order polynomial coefficients):
99             corr = ( i + j*r^2 + k*r^4 + l*r^6), where r is the distance from the image center
100             The corrected pixel value is calculated with: i_new = i_old + corr
101             if additive correction is used (default)
102             for proportional correction (h5): i_new = i_old / corr;
103              
104             Vx,Vy radial vignetting correction offset in pixels (defaults q0 w0, optional).
105             Used to correct for offset from center of image
106             Vx - horizontal offset
107             Vy - vertical offset
108              
109             S100,600,100,800 Selection(l,r,t,b), Only pixels inside the rectangle will be used for conversion.
110             Original image size is used for all image parameters
111             (e.g. field-of-view) refer to the original image.
112             Selection can be outside image dimension.
113             The selection will be circular for circular fisheye images, and
114             rectangular for all other projection formats
115              
116             nName file name of the input image.
117              
118             i f2 r0 p0 y0 v183 a0 b-0.1 c0 S100,600,100,800 n"photo1.jpg"
119             i f2 r0 p0 y180 v183 a0 b-0.1 c0 S100,600,100,800 n"photo1.jpg"
120              
121             =cut
122              
123             sub _defaults
124             {
125 51     51   78 my $self = shift;
126 51         82 %{$self} = (a => 0, b => 0, c => 0, d => 0, e => 0, r => 0, p => 0, y => 0);
  51         638  
127             }
128              
129 103     103   631 sub _valid { return '^([abcdefghjnprtvwy]|[SCXYZ]|K[0-2][ab]|V[abcdfmxy]|Eev|E[rb]|Tp[yp]|Te[0123]|Tr[XYZ]|Ti[XYZS]|R[abcde])(.*)' }
130              
131 0     0   0 sub _valid_ptoptimizer { return '^([abcdefghnprtvwySC]|Tp[yp]|Te[0123]|Tr[XYZ]|Ti[XYZS])(.*)' }
132              
133             sub _sanitise_ptoptimizer
134             {
135 0     0   0 my $self = shift;
136 0         0 my $valid = $self->_valid_ptoptimizer;
137 0         0 for my $key (keys %{$self})
  0         0  
138             {
139 0 0       0 delete $self->{$key} unless (grep /$valid/, $key);
140             }
141             }
142              
143             sub Identifier
144             {
145 23     23 0 35 my $self = shift;
146 23         878 return "i";
147             }
148              
149             sub Assemble
150             {
151 38     38 0 48 my $self = shift;
152 38   50     151 my $vector = shift || '';
153 38         134 $self->_sanitise;
154 38         99 my @tokens;
155 38         50 for my $entry (sort keys %{$self})
  38         306  
156             {
157 714         1665 my $value = $self->{$entry};
158 714 100       4385 $value = _prepend ($vector, $value) if ($entry eq 'n');
159 714         1662 push @tokens, $entry . $value;
160             }
161 38 50       281 return (join ' ', ($self->Identifier, @tokens)) ."\n" if (@tokens);
162 0         0 return '';
163             }
164              
165             =pod
166              
167             Rotate transform the image, angles in degrees:
168              
169             $i->Transform ($roll, $pitch, $yaw);
170              
171             =cut
172              
173             sub Transform
174             {
175 7     7 0 11 my $self = shift;
176 7         11 my ($roll, $pitch, $yaw) = @_;
177 7         25 my @transform_rpy = map (deg2rad ($_), ($roll, $pitch, $yaw));
178 7         431 my $transform_matrix = rollpitchyaw2matrix (@transform_rpy);
179 7         58 my @rpy = map (deg2rad ($_), ($self->r, $self->p, $self->y));
180 7         213 my $matrix = rollpitchyaw2matrix (@rpy);
181 7         20 my $result = multiply ($transform_matrix, $matrix);
182 7         24 my ($r, $p, $y) = map (rad2deg ($_), matrix2rollpitchyaw ($result));
183 7 50       1128 $self->{r} = $r unless $self->{r} =~ /=/;
184 7 50       29 $self->{p} = $p unless $self->{p} =~ /=/;
185 7 50       70 $self->{y} = $y unless $self->{y} =~ /=/;
186             }
187              
188             sub _prepend
189             {
190 38     38   63 my $vector = shift;
191 38         46 my $name = shift;
192 38 50       117 return $name unless $vector;
193 0         0 $name =~ s/^"//;
194 0         0 $name =~ s/"$//;
195 10     10   85 use File::Spec;
  10         18  
  10         21572  
196 0 0       0 unless (File::Spec->file_name_is_absolute ($name))
197             {
198 0         0 $name = File::Spec->catfile ($vector, $name);
199             }
200 0         0 return "\"$name\"";
201             }
202              
203             sub Report
204             {
205 1     1 0 8 my $self = shift;
206 1         2 my @report;
207              
208 1         3 my $format = 'UNKNOWN';
209 1 50       5 $format = "Rectilinear" if $self->{f} == 0;
210 1 50       4 $format = "Cylindrical" if $self->{f} == 1;
211 1 50       5 $format = "Circular Fisheye" if $self->{f} == 2;
212 1 50       4 $format = "Full-frame Fisheye" if $self->{f} == 3;
213 1 50       4 $format = "Equirectangular" if $self->{f} == 4;
214 1 50       5 $format = "Mirror (a spherical mirror)" if $self->{f} == 7;
215 1 50       4 $format = "Orthographic fisheye" if $self->{f} == 8;
216 1 50       5 $format = "Stereographic fisheye" if $self->{f} == 10;
217 1 50       4 $format = "Equisolid fisheye" if $self->{f} == 21;
218              
219 1         6 push @report, ['Dimensions', $self->{w} .'x'. $self->{h}];
220 1         6 push @report, ['Megapixels', int ($self->{w} * $self->{h} / 1024 / 1024 * 10) / 10];
221 1         4 push @report, ['Format', $format];
222 1         4 push @report, ['Horizontal Field of View', $self->{v}];
223 1         5 push @report, ['Roll Pitch Yaw', $self->{r} .','. $self->{p} .','. $self->{y}];
224 1 50       11 push @report, ['Tilt', $self->{TiX} .','. $self->{TiY} .','. $self->{TiZ} .','. $self->{TiS}] if defined $self->{TiS};
225 1 50       5 push @report, ['XYZ transform', $self->{TrX} .','. $self->{TrY} .','. $self->{TrZ}] if defined $self->{TrX};
226 1 50       8 push @report, ['Lens distortion', $self->{a} .','. $self->{b} .','. $self->{c}] if defined $self->{a};
227 1 50       15 push @report, ['Image centre', $self->{d} .','. $self->{e}] if defined $self->{d};
228 1 50       7 push @report, ['Image shear', $self->{g} .','. $self->{t}] if defined $self->{g};
229 1 50       7 push @report, ['Exposure Value', $self->{Eev}] if defined $self->{Eev};
230 1 50       8 push @report, ['Red Blue colour balance', $self->{Er} .','. $self->{Eb}] if defined $self->{Er};
231 1 50       16 push @report, ['EMOR parameters', $self->{Ra} .','. $self->{Rb} .','. $self->{Rc} .','. $self->{Rd} .','. $self->{Re}] if defined $self->{Ra};
232 1 50       9 push @report, ['Vignetting parameters', $self->{Va} .','. $self->{Vb} .','. $self->{Vc} .','. $self->{Vd}] if defined $self->{Va};
233 1 50       6 push @report, ['Vignetting centre', $self->{Vx} .','. $self->{Vy}] if defined $self->{Vx};
234 1 50       4 push @report, ['Selection area', $self->{S}] if defined $self->{S};
235 1         4 push @report, ['File name', $self->{n}];
236              
237 1         10 [@report];
238             }
239              
240             sub W2
241             {
242 15     15 0 28 my $self = shift;
243 15 100       75 return ($self->{w} / 2) if ($self->{w} < $self->{h});
244 8         18 return ($self->{h} / 2);
245             }
246              
247             =pod
248              
249             Each image attribute (v, a, b, c etc...) can be read like so:
250              
251             $fov = $i->v;
252              
253             Note that this will return either the value (56.7) or a reference to another
254             image (=0). If you supply a Panotools::Script object as a parameter then the
255             reference will be resolved and you will always get the value:
256              
257             $fov = $i->v ($pto);
258              
259             =cut
260              
261             sub AUTOLOAD
262             {
263 194     194   433 my $self = shift;
264 194         422 my $pto = shift;
265 194         243 my $name = $AUTOLOAD;
266 194         617 $name =~ s/.*://;
267 194 50       565 return undef unless defined $self->{$name};
268 194 100 66     1327 if ($self->{$name} =~ /^=([0-9]+)$/ and defined $pto) {return $pto->Image->[$1]->{$name}};
  27         73  
269 167         724 return $self->{$name};
270             }
271              
272             =pod
273              
274             Get the absolute path to the image file
275              
276             $i->Path ('/path/to/project.pto');
277              
278             If a .pto project isn't specified then paths are assumed to be relatve to cwd
279              
280             =cut
281              
282             sub Path
283             {
284 0     0 0 0 my $self = shift;
285 0         0 my $path_pto = shift;
286 0         0 my $name = $self->{n};
287 0         0 $name =~ s/^"(.*)"$/$1/;
288 0 0       0 return $name if File::Spec->file_name_is_absolute ($name);
289 0 0       0 return File::Spec->rel2abs ($name) unless defined $path_pto;
290 0         0 my ($v, $d, $f) = File::Spec->splitpath ($path_pto);
291 0         0 my $base = File::Spec->catpath ($v, $d, '');
292 0         0 return File::Spec->rel2abs ($name, $base);
293             }
294              
295             # copied from libpano12 math.c inverse polynomial using Newton's method
296             sub _inv_radial
297             {
298 13     13   22 my $self = shift;
299 13         17 my $pto = shift;
300 13         16 my $dest = shift;
301 13         62 my $a = $self->a ($pto);
302 13         53 my $b = $self->b ($pto);
303 13         52 my $c = $self->c ($pto);
304 13         39 my $d = 1 - $a - $b - $c;
305              
306 13         20 my $iter = 0;
307 13         23 my $MAXITER = 100;
308 13         16 my $R_EPS = 0.000001;
309              
310 13         534 my $rd = (sqrt ($dest->[0] * $dest->[0] + $dest->[1] * $dest->[1])) / $self->W2;
311              
312 13 100       51 return [0, 0] if $rd == 0;
313              
314 7         10 my $rs = $rd;
315 7         21 my $f = ((($a * $rs + $b) * $rs + $c) * $rs + $d) * $rs;
316              
317 7   66     47 while (abs ($f - $rd) > $R_EPS && $iter < $MAXITER)
318             {
319 4         14 $rs = $rs - ($f - $rd) / (((4 * $a * $rs + 3 * $b) * $rs + 2 * $c) * $rs + $d);
320 4         10 $f = ((($a * $rs + $b) * $rs + $c) * $rs + $d) * $rs;
321 4         13 $iter++;
322             }
323              
324 7         12 my $scale = $rs / $rd;
325             # print "scale = $scale iter = $iter\n";
326              
327 7         25 return [$dest->[0] * $scale, $dest->[1] * $scale];
328             }
329              
330             sub _radial
331             {
332 1     1   2351 my $self = shift;
333 1         3 my $pto = shift;
334 1         3 my $dest = shift;
335 1         440 my $a = $self->a ($pto);
336 1         6 my $b = $self->b ($pto);
337 1         6 my $c = $self->c ($pto);
338 1         7 my $d = 1 - $a - $b - $c;
339              
340 1         100 my $r = (sqrt ($dest->[0] * $dest->[0] + $dest->[1] * $dest->[1])) / $self->W2;
341 1         3 my $scale = (($a * $r + $b) * $r + $c) * $r + $d;
342              
343 1         6 return [$dest->[0] * $scale, $dest->[1] * $scale];
344             }
345              
346             =pod
347              
348             For any given coordinate in this image (top left is 0,0), calculate an x,y,z
349             cartesian coordinate, accounting for lens distortion, projection and rotation.
350              
351             $coor = $i->To_Cartesian ($pto, [23,45]);
352             ($x, $y, $z) = @{$coor};
353              
354             =cut
355              
356             sub To_Cartesian
357             {
358 12     12 0 2062 my $self = shift;
359 12         14 my $pto = shift;
360 12         17 my $pix = shift;
361              
362 12         107 $pix->[0] = ($self->{w}/2) - $pix->[0] + $self->d ($pto);
363 12         456 $pix->[1] = ($self->{h}/2) - $pix->[1] + $self->e ($pto);
364 12         33 $pix = $self->_inv_radial ($pto, $pix);
365              
366             # FIXME returns false value for cylindrical and equirectangular images
367 12         42 my $point = [[1],[0],[0]];
368              
369 12 50       34 if ($self->{f} == 0)
370             {
371 12         61 my $rad = ($self->{w}/2) / tan (deg2rad ($self->v ($pto)) / 2);
372 12         1036 $point = [[$rad], [$pix->[0]], [$pix->[1]]];
373             }
374 12 50 33     104 if ($self->{f} == 2 or $self->{f} == 3)
375             {
376 0         0 my ($rho, $theta, $z) = cartesian_to_cylindrical ($pix->[1], $pix->[0], 1);
377 0         0 my $phi = $rho * deg2rad ($self->v ($pto)) / $self->{w};
378 0         0 $rho = $z;
379              
380 0         0 ($point->[2]->[0],
381             $point->[1]->[0],
382             $point->[0]->[0])
383             = spherical_to_cartesian ($rho, $theta, $phi);
384             }
385              
386 12         63 my $matrix = rollpitchyaw2matrix
387             (deg2rad ($self->r), deg2rad ($self->p), deg2rad ($self->y));
388              
389 12         58 multiply ($matrix, $point);
390             }
391              
392             =pod
393              
394             Query distance (radius) to photo in pixels:
395              
396             $pix_radius = $i->Radius ($pto);
397              
398             =cut
399              
400             sub Radius
401             {
402 0     0 0   my $self = shift;
403 0           my $pto = shift;
404              
405 0           my $rad_fov = deg2rad ($self->v ($pto));
406 0 0         return 0 unless $rad_fov;
407              
408 0           my $pix_radius;
409 0 0         if ($self->{f} == 0)
410             {
411 0           $pix_radius = ($self->{w}/2) / tan ($rad_fov/2);
412             }
413             else
414             {
415 0           $pix_radius = $self->{w} / $rad_fov;
416             }
417 0           return $pix_radius;
418             }
419              
420             1;
421