File Coverage

lib/Panotools/Script/Line/Variable.pm
Criterion Covered Total %
statement 66 66 100.0
branch 20 40 50.0
condition 10 29 34.4
subroutine 10 10 100.0
pod 0 4 0.0
total 106 149 71.1


line stmt bran cond sub pod time code
1             package Panotools::Script::Line::Variable;
2              
3 11     11   1135 use strict;
  11         25  
  11         469  
4 11     11   55 use warnings;
  11         22  
  11         284  
5 11     11   382 use Panotools::Script::Line;
  11         22  
  11         277  
6              
7 11     11   60 use vars qw /@ISA/;
  11         22  
  11         10921  
8             @ISA = qw /Panotools::Script::Line/;
9              
10             =head1 NAME
11              
12             Panotools::Script::Line::Variable - Panotools optimisation variables
13              
14             =head1 SYNOPSIS
15              
16             One or more parameters for optimisation form a 'v' line
17              
18             =head1 DESCRIPTION
19              
20             Please note: the 'v'-line must come after the the 'i'-lines.
21             Optimization variables are listed together with the image number
22             starting at 0. There can be several v-lines.
23              
24             y0 Optimize yaw in image 0
25             p1 Optimize pitch in image 1
26             r2 Optimize roll in image 2
27             v0 Optimize field of view in image 0
28             a2 Optimize lens correction parameter 'a' in image 2
29             b1
30             c1
31             d1
32             e1
33             g1
34             t1
35             X1 Optimize x-coordinate of image 1, only for PTStereo
36             Y2 Optimize y-coordinate of image 2, only for PTStereo
37             Z6 Optimize z-coordinate of image 6, only for PTStereo
38             TrX3 Optimise x-coordinate of image 3, mosaic/translation mode
39             TrY2 Optimise y-coordinate of image 2, mosaic/translation mode
40             TrZ1 Optimise z-coordinate of image 1, mosaic/translation mode
41             Tpp1 Optimise pitch of picture plane of image 1, mosaic/translation mode
42             Tpy1 Optimise yaw of picture plane of image 1, mosaic/translation mode
43              
44             Additionally, photometric optimisation uses the same system. although this is a
45             secondary process and not simultaneous with geometric optimisation:
46              
47             Eev0 Optimise Exposure (Eev) for image 0
48             Er1 Optimise red multiplier for image 1
49             Eb1 Optimise blue multiplier for image 1
50              
51             Ra0 Optimise EMoR camera response for image 0
52             Rb0 note usually all EMoR parameters are optimised at the same time
53             Rc0
54             Rd0
55             Re0
56              
57             Va0 Optimise Vignetting 'Va' parameter for image 0, note usually only Vb, Vc, Vd are optimised
58             Vb0 Optimise Vignetting 'Vb' parameter for image 0
59             Vc0 Optimise Vignetting 'Vc' parameter for image 0
60             Vd0 Optimise Vignetting 'Vd' parameter for image 0
61             Vx1 Optimise Vignetting centre x-position for image 1
62             Vy1 Optimise Vignetting centre y-position for image 1
63              
64             If a image has a parameter linked to another image only need to optimize the master.
65              
66             =cut
67              
68 31     31   55 sub _valid { return '^([abcdegprtvyXYZ]|Te[0123]|Tp[py]|Tr[XYZ]|Ti[XYZS]|Eev|Er|Eb|Ra|Rb|Rc|Rd|Re|Va|Vb|Vc|Vd|Vx|Vy)(.*)' }
69              
70             sub Identifier
71             {
72 32     32 0 79 my $self = shift;
73 32         112 return "v";
74             }
75              
76             sub Parse
77             {
78 31     31 0 567 my $self = shift;
79 31   50     84 my $string = shift || return 0;
80 31         95 my $valid = $self->_valid;
81 31         174 my @res = $string =~ / ([a-zA-Z]+[0-9]+)/g;
82 31         57 for my $token (grep { defined $_ } @res)
  80         145  
83             {
84 80         247 my ($param, $image) = $token =~ /([a-zA-Z]+)([0-9]+)/;
85 80 50       173 next unless defined $image;
86 80         241 $self->{$image}->{$param} = 1;
87             }
88 31         78 $self->_sanitise;
89 31         92 return 1;
90             }
91              
92             sub Assemble
93             {
94 10     10 0 1792 my $self = shift;
95 10         35 $self->_sanitise;
96 10         26 my $string = '';
97 10         27 for my $image (sort {$a <=> $b} (keys %{$self}))
  23         44  
  10         42  
98             {
99 22         28 my @tokens;
100 22         27 for my $param (sort keys %{$self->{$image}})
  22         352  
101             {
102 58 50       133 next unless $self->{$image}->{$param};
103 58         113 push @tokens, $param . $image;
104             }
105 22         63 $string .= (join ' ', ($self->Identifier, @tokens)) ."\n";
106             }
107 10         45 $string .= $self->Identifier ."\n";
108 10         52 return $string;
109             }
110              
111             sub _sanitise
112             {
113 41     41   65 my $self = shift;
114 41         49 for my $image (keys %{$self})
  41         127  
115             {
116 126 50       403 delete $self->{$image} unless $image =~ /[0-9]+/;
117             }
118             }
119              
120             sub Report
121             {
122 1     1 0 2 my $self = shift;
123 1         1 my $index = shift;
124 1         2 my @report;
125              
126 1         3 my $i = $self->{$index};
127              
128 1 50       5 push @report, 'Roll' if $self->{$index}->{r};
129 1 50       4 push @report, 'Pitch' if $self->{$index}->{p};
130 1 50       5 push @report, 'Yaw' if $self->{$index}->{y};
131 1 50       4 push @report, 'Field of View' if $self->{$index}->{v};
132 1 50       6 push @report, 'a' if $self->{$index}->{a};
133 1 50       4 push @report, 'b' if $self->{$index}->{b};
134 1 50       3 push @report, 'c' if $self->{$index}->{c};
135 1 50       4 push @report, 'd' if $self->{$index}->{d};
136 1 50       4 push @report, 'e' if $self->{$index}->{e};
137 1 50       3 push @report, 'g' if $self->{$index}->{g};
138 1 50       3 push @report, 't' if $self->{$index}->{t};
139              
140 1 50       3 push @report, 'Exposure' if $i->{Eev};
141 1 50 33     10 push @report, 'Colour balance' if $i->{Er} or $i->{Eb};
142 1 50 33     19 push @report, 'Response curve' if $i->{Ra} or $i->{Rb} or $i->{Rc} or $i->{Rd} or $i->{Re};
      33        
      33        
      33        
143 1 50 33     12 push @report, 'Vignetting' if $i->{Va} or $i->{Vb} or $i->{Vc} or $i->{Vd};
      33        
      33        
144 1 50 33     6 push @report, 'Vignetting centre' if $i->{Vx} or $i->{Vy};
145              
146 1 50       3 @report = ('NONE') if scalar @report == 0;
147 1         7 [[('Optimise parameters', (join ',', @report))]];
148             }
149              
150             1;