File Coverage

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


line stmt bran cond sub pod time code
1             package Panotools::Script::Line::Image;
2              
3 10     10   66 use strict;
  10         15  
  10         283  
4 10     10   43 use warnings;
  10         63  
  10         229  
5 10     10   52 use Panotools::Script::Line;
  10         13  
  10         264  
6 10     10   3614 use Panotools::Matrix qw(matrix2rollpitchyaw rollpitchyaw2matrix multiply);
  10         25  
  10         646  
7 10     10   68 use Math::Trig;
  10         20  
  10         1433  
8 10     10   67 use File::Spec;
  10         25  
  10         316  
9 10     10   60 use Math::Trig ':radial';
  10         20  
  10         1216  
10              
11 10     10   82 use vars qw /@ISA/;
  10         21  
  10         6597  
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   70 my $self = shift;
126 51         87 %{$self} = (a => 0, b => 0, c => 0, d => 0, e => 0, r => 0, p => 0, y => 0);
  51         301  
127             }
128              
129 103     103   195 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 32 my $self = shift;
146 23         162 return "i";
147             }
148              
149             sub Assemble
150             {
151 38     38 0 51 my $self = shift;
152 38   50     122 my $vector = shift || '';
153 38         99 $self->_sanitise;
154 38         77 my @tokens;
155 38         48 for my $entry (sort keys %{$self})
  38         236  
156             {
157 714         892 my $value = $self->{$entry};
158 714 100       1081 $value = _prepend ($vector, $value) if ($entry eq 'n');
159 714         1222 push @tokens, $entry . $value;
160             }
161 38 50       166 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 9 my $self = shift;
176 7         13 my ($roll, $pitch, $yaw) = @_;
177 7         20 my @transform_rpy = map (deg2rad ($_), ($roll, $pitch, $yaw));
178 7         155 my $transform_matrix = rollpitchyaw2matrix (@transform_rpy);
179 7         47 my @rpy = map (deg2rad ($_), ($self->r, $self->p, $self->y));
180 7         149 my $matrix = rollpitchyaw2matrix (@rpy);
181 7         14 my $result = multiply ($transform_matrix, $matrix);
182 7         17 my ($r, $p, $y) = map (rad2deg ($_), matrix2rollpitchyaw ($result));
183 7 50       149 $self->{r} = $r unless $self->{r} =~ /=/;
184 7 50       20 $self->{p} = $p unless $self->{p} =~ /=/;
185 7 50       42 $self->{y} = $y unless $self->{y} =~ /=/;
186             }
187              
188             sub _prepend
189             {
190 38     38   51 my $vector = shift;
191 38         46 my $name = shift;
192 38 50       82 return $name unless $vector;
193 0         0 $name =~ s/^"//;
194 0         0 $name =~ s/"$//;
195 10     10   86 use File::Spec;
  10         30  
  10         15967  
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 5 my $self = shift;
206 1         3 my @report;
207              
208 1         3 my $format = 'UNKNOWN';
209 1 50       4 $format = "Rectilinear" if $self->{f} == 0;
210 1 50       4 $format = "Cylindrical" if $self->{f} == 1;
211 1 50       4 $format = "Circular Fisheye" if $self->{f} == 2;
212 1 50       14 $format = "Full-frame Fisheye" if $self->{f} == 3;
213 1 50       6 $format = "Equirectangular" if $self->{f} == 4;
214 1 50       4 $format = "Mirror (a spherical mirror)" if $self->{f} == 7;
215 1 50       4 $format = "Orthographic fisheye" if $self->{f} == 8;
216 1 50       4 $format = "Stereographic fisheye" if $self->{f} == 10;
217 1 50       3 $format = "Equisolid fisheye" if $self->{f} == 21;
218              
219 1         6 push @report, ['Dimensions', $self->{w} .'x'. $self->{h}];
220 1         7 push @report, ['Megapixels', int ($self->{w} * $self->{h} / 1024 / 1024 * 10) / 10];
221 1         3 push @report, ['Format', $format];
222 1         2 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       12 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       7 push @report, ['Lens distortion', $self->{a} .','. $self->{b} .','. $self->{c}] if defined $self->{a};
227 1 50       7 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       8 push @report, ['Exposure Value', $self->{Eev}] if defined $self->{Eev};
230 1 50       6 push @report, ['Red Blue colour balance', $self->{Er} .','. $self->{Eb}] if defined $self->{Er};
231 1 50       15 push @report, ['EMOR parameters', $self->{Ra} .','. $self->{Rb} .','. $self->{Rc} .','. $self->{Rd} .','. $self->{Re}] if defined $self->{Ra};
232 1 50       7 push @report, ['Vignetting parameters', $self->{Va} .','. $self->{Vb} .','. $self->{Vc} .','. $self->{Vd}] if defined $self->{Va};
233 1 50       7 push @report, ['Vignetting centre', $self->{Vx} .','. $self->{Vy}] if defined $self->{Vx};
234 1 50       3 push @report, ['Selection area', $self->{S}] if defined $self->{S};
235 1         3 push @report, ['File name', $self->{n}];
236              
237 1         8 [@report];
238             }
239              
240             sub W2
241             {
242 15     15 0 27 my $self = shift;
243 15 100       56 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 274     274   4022 my $self = shift;
264 274         342 my $pto = shift;
265 274         329 my $name = $AUTOLOAD;
266 274         825 $name =~ s/.*://;
267 274 100       2644 return undef unless defined $self->{$name};
268 194 100 66     478 if ($self->{$name} =~ /^=([0-9]+)$/ and defined $pto) {return $pto->Image->[$1]->{$name}};
  27         58  
269 167         391 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   18 my $self = shift;
299 13         17 my $pto = shift;
300 13         16 my $dest = shift;
301 13         54 my $a = $self->a ($pto);
302 13         114 my $b = $self->b ($pto);
303 13         43 my $c = $self->c ($pto);
304 13         70 my $d = 1 - $a - $b - $c;
305              
306 13         22 my $iter = 0;
307 13         15 my $MAXITER = 100;
308 13         20 my $R_EPS = 0.000001;
309              
310 13         58 my $rd = (sqrt ($dest->[0] * $dest->[0] + $dest->[1] * $dest->[1])) / $self->W2;
311              
312 13 100       35 return [0, 0] if $rd == 0;
313              
314 7         10 my $rs = $rd;
315 7         20 my $f = ((($a * $rs + $b) * $rs + $c) * $rs + $d) * $rs;
316              
317 7   66     30 while (abs ($f - $rd) > $R_EPS && $iter < $MAXITER)
318             {
319 4         13 $rs = $rs - ($f - $rd) / (((4 * $a * $rs + 3 * $b) * $rs + 2 * $c) * $rs + $d);
320 4         7 $f = ((($a * $rs + $b) * $rs + $c) * $rs + $d) * $rs;
321 4         11 $iter++;
322             }
323              
324 7         11 my $scale = $rs / $rd;
325             # print "scale = $scale iter = $iter\n";
326              
327 7         22 return [$dest->[0] * $scale, $dest->[1] * $scale];
328             }
329              
330             sub _radial
331             {
332 1     1   1307 my $self = shift;
333 1         2 my $pto = shift;
334 1         3 my $dest = shift;
335 1         7 my $a = $self->a ($pto);
336 1         6 my $b = $self->b ($pto);
337 1         4 my $c = $self->c ($pto);
338 1         6 my $d = 1 - $a - $b - $c;
339              
340 1         5 my $r = (sqrt ($dest->[0] * $dest->[0] + $dest->[1] * $dest->[1])) / $self->W2;
341 1         4 my $scale = (($a * $r + $b) * $r + $c) * $r + $d;
342              
343 1         5 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 1527 my $self = shift;
359 12         15 my $pto = shift;
360 12         17 my $pix = shift;
361              
362 12         79 $pix->[0] = ($self->{w}/2) - $pix->[0] + $self->d ($pto);
363 12         62 $pix->[1] = ($self->{h}/2) - $pix->[1] + $self->e ($pto);
364 12         32 $pix = $self->_inv_radial ($pto, $pix);
365              
366             # FIXME returns false value for cylindrical and equirectangular images
367 12         27 my $point = [[1],[0],[0]];
368              
369 12 50       30 if ($self->{f} == 0)
370             {
371 12         51 my $rad = ($self->{w}/2) / tan (deg2rad ($self->v ($pto)) / 2);
372 12         401 $point = [[$rad], [$pix->[0]], [$pix->[1]]];
373             }
374 12 50 33     59 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         54 my $matrix = rollpitchyaw2matrix
387             (deg2rad ($self->r), deg2rad ($self->p), deg2rad ($self->y));
388              
389 12         33 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