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   859 use strict;
  11         19  
  11         650  
4 11     11   51 use warnings;
  11         35  
  11         246  
5 11     11   392 use Panotools::Script::Line;
  11         216  
  11         285  
6              
7 11     11   68 use vars qw /@ISA/;
  11         20  
  11         8697  
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   50 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 38 my $self = shift;
73 32         85 return "v";
74             }
75              
76             sub Parse
77             {
78 31     31 0 647 my $self = shift;
79 31   50     63 my $string = shift || return 0;
80 31         56 my $valid = $self->_valid;
81 31         146 my @res = $string =~ / ([a-zA-Z]+[0-9]+)/g;
82 31         57 for my $token (grep { defined $_ } @res)
  80         148  
83             {
84 80         255 my ($param, $image) = $token =~ /([a-zA-Z]+)([0-9]+)/;
85 80 50       159 next unless defined $image;
86 80         196 $self->{$image}->{$param} = 1;
87             }
88 31         78 $self->_sanitise;
89 31         68 return 1;
90             }
91              
92             sub Assemble
93             {
94 10     10 0 1407 my $self = shift;
95 10         45 $self->_sanitise;
96 10         21 my $string = '';
97 10         15 for my $image (sort {$a <=> $b} (keys %{$self}))
  24         42  
  10         31  
98             {
99 22         28 my @tokens;
100 22         34 for my $param (sort keys %{$self->{$image}})
  22         64  
101             {
102 58 50       102 next unless $self->{$image}->{$param};
103 58         93 push @tokens, $param . $image;
104             }
105 22         43 $string .= (join ' ', ($self->Identifier, @tokens)) ."\n";
106             }
107 10         54 $string .= $self->Identifier ."\n";
108 10         36 return $string;
109             }
110              
111             sub _sanitise
112             {
113 41     41   54 my $self = shift;
114 41         55 for my $image (keys %{$self})
  41         116  
115             {
116 126 50       330 delete $self->{$image} unless $image =~ /[0-9]+/;
117             }
118             }
119              
120             sub Report
121             {
122 1     1 0 2 my $self = shift;
123 1         2 my $index = shift;
124 1         1 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       6 push @report, 'Pitch' if $self->{$index}->{p};
130 1 50       4 push @report, 'Yaw' if $self->{$index}->{y};
131 1 50       3 push @report, 'Field of View' if $self->{$index}->{v};
132 1 50       3 push @report, 'a' if $self->{$index}->{a};
133 1 50       3 push @report, 'b' if $self->{$index}->{b};
134 1 50       3 push @report, 'c' if $self->{$index}->{c};
135 1 50       2 push @report, 'd' if $self->{$index}->{d};
136 1 50       5 push @report, 'e' if $self->{$index}->{e};
137 1 50       2 push @report, 'g' if $self->{$index}->{g};
138 1 50       2 push @report, 't' if $self->{$index}->{t};
139              
140 1 50       3 push @report, 'Exposure' if $i->{Eev};
141 1 50 33     6 push @report, 'Colour balance' if $i->{Er} or $i->{Eb};
142 1 50 33     11 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     10 push @report, 'Vignetting' if $i->{Va} or $i->{Vb} or $i->{Vc} or $i->{Vd};
      33        
      33        
144 1 50 33     14 push @report, 'Vignetting centre' if $i->{Vx} or $i->{Vy};
145              
146 1 50       5 @report = ('NONE') if scalar @report == 0;
147 1         9 [[('Optimise parameters', (join ',', @report))]];
148             }
149              
150             1;