line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Panotools::Script; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Panotools::Script - Panorama Tools scripting |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
Read, write and manipulate hugin script files. |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 DESCRIPTION |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Library and utilities for manipulating project files created by the hugin photo |
14
|
|
|
|
|
|
|
stitching software. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
This file format is shared with various other tools, in particular this module |
17
|
|
|
|
|
|
|
is also capable of working with Panorama Tools script files. |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=cut |
20
|
|
|
|
|
|
|
|
21
|
10
|
|
|
10
|
|
269832
|
use strict; |
|
10
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
487
|
|
22
|
10
|
|
|
10
|
|
61
|
use warnings; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
321
|
|
23
|
|
|
|
|
|
|
|
24
|
10
|
|
|
10
|
|
5342
|
use Panotools::Script::Line::Mode; |
|
10
|
|
|
|
|
29
|
|
|
10
|
|
|
|
|
316
|
|
25
|
10
|
|
|
10
|
|
6559
|
use Panotools::Script::Line::Panorama; |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
344
|
|
26
|
10
|
|
|
10
|
|
4988
|
use Panotools::Script::Line::Option; |
|
10
|
|
|
|
|
126
|
|
|
10
|
|
|
|
|
352
|
|
27
|
10
|
|
|
10
|
|
6814
|
use Panotools::Script::Line::Image; |
|
10
|
|
|
|
|
34
|
|
|
10
|
|
|
|
|
963
|
|
28
|
10
|
|
|
10
|
|
9041
|
use Panotools::Script::Line::ImageMetadata; |
|
10
|
|
|
|
|
32
|
|
|
10
|
|
|
|
|
328
|
|
29
|
10
|
|
|
10
|
|
5341
|
use Panotools::Script::Line::Output; |
|
10
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
367
|
|
30
|
10
|
|
|
10
|
|
5682
|
use Panotools::Script::Line::Control; |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
279
|
|
31
|
10
|
|
|
10
|
|
9842
|
use Panotools::Script::Line::ControlMorph; |
|
10
|
|
|
|
|
26
|
|
|
10
|
|
|
|
|
408
|
|
32
|
10
|
|
|
10
|
|
7216
|
use Panotools::Script::Line::Variable; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
328
|
|
33
|
10
|
|
|
10
|
|
9345
|
use Panotools::Script::Line::Mask; |
|
10
|
|
|
|
|
31
|
|
|
10
|
|
|
|
|
315
|
|
34
|
10
|
|
|
10
|
|
254
|
use Digest::MD5 'md5_hex'; |
|
10
|
|
|
|
|
33
|
|
|
10
|
|
|
|
|
754
|
|
35
|
|
|
|
|
|
|
|
36
|
10
|
|
|
10
|
|
11806
|
use File::Temp qw/ tempdir /; |
|
10
|
|
|
|
|
208186
|
|
|
10
|
|
|
|
|
621
|
|
37
|
10
|
|
|
10
|
|
74
|
use File::Spec; |
|
10
|
|
|
|
|
21
|
|
|
10
|
|
|
|
|
270
|
|
38
|
10
|
|
|
10
|
|
63
|
use Math::Trig qw/:radial pi great_circle_distance/; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
2479
|
|
39
|
|
|
|
|
|
|
|
40
|
10
|
|
|
10
|
|
62
|
use Storable qw/ dclone /; |
|
10
|
|
|
|
|
99
|
|
|
10
|
|
|
|
|
84670
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
our $VERSION = '0.28'; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
our $CLEANUP = 1; |
45
|
|
|
|
|
|
|
$CLEANUP = 0 if defined $ENV{DEBUG}; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 USAGE |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my $p = new Panotools::Script; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=cut |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub new |
54
|
|
|
|
|
|
|
{ |
55
|
10
|
|
|
10
|
0
|
8514
|
my $class = shift; |
56
|
10
|
|
33
|
|
|
92
|
$class = ref $class || $class; |
57
|
10
|
|
|
|
|
44
|
my $self = bless {}, $class; |
58
|
10
|
|
|
|
|
57
|
$self->_defaults; |
59
|
10
|
|
|
|
|
34
|
return $self; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _defaults |
63
|
|
|
|
|
|
|
{ |
64
|
16
|
|
|
16
|
|
36
|
my $self = shift; |
65
|
16
|
|
|
|
|
207
|
$self->{mode} = new Panotools::Script::Line::Mode; |
66
|
16
|
|
|
|
|
200
|
$self->{panorama} = new Panotools::Script::Line::Panorama; |
67
|
16
|
|
|
|
|
187
|
$self->{option} = new Panotools::Script::Line::Option; |
68
|
16
|
|
|
|
|
183
|
$self->{variable} = new Panotools::Script::Line::Variable; |
69
|
16
|
|
|
|
|
97
|
$self->{image} = []; |
70
|
16
|
|
|
|
|
43
|
$self->{imagemetadata} = []; |
71
|
16
|
|
|
|
|
51
|
$self->{output} = []; |
72
|
16
|
|
|
|
|
70
|
$self->{control} = []; |
73
|
16
|
|
|
|
|
55
|
$self->{controlmorph} = []; |
74
|
16
|
|
|
|
|
42
|
$self->{mask} = []; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=pod |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$p->Read ('/path/to/script.txt'); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=cut |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub Read |
84
|
|
|
|
|
|
|
{ |
85
|
6
|
|
|
6
|
0
|
74
|
my $self = shift; |
86
|
6
|
|
|
|
|
20
|
$self->_defaults; |
87
|
6
|
|
50
|
|
|
32
|
my $path = shift || return 0; |
88
|
6
|
50
|
|
|
|
27
|
if ($path eq '-') |
89
|
|
|
|
|
|
|
{ |
90
|
0
|
|
|
|
|
0
|
open FILE, '<-'; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
else |
93
|
|
|
|
|
|
|
{ |
94
|
6
|
50
|
|
|
|
389
|
open FILE, "<", $path or die "cannot read-open $path"; |
95
|
|
|
|
|
|
|
} |
96
|
6
|
|
|
|
|
903
|
my @raw = ; |
97
|
6
|
|
|
|
|
89
|
close FILE; |
98
|
|
|
|
|
|
|
|
99
|
6
|
|
|
|
|
180
|
$self->{md5} = md5_hex (join '', @raw); |
100
|
|
|
|
|
|
|
|
101
|
6
|
|
|
|
|
189
|
my ($volume, $directories, $file) = File::Spec->splitpath ($path); |
102
|
|
|
|
|
|
|
|
103
|
6
|
|
|
|
|
23
|
for my $line (@raw) |
104
|
|
|
|
|
|
|
{ |
105
|
367
|
|
|
|
|
1434
|
$line =~ s/(\r|\n)//g; |
106
|
367
|
100
|
|
|
|
834
|
$self->Mode->Parse ($line) if ($line =~ /^m /); |
107
|
367
|
100
|
|
|
|
1823
|
$self->Panorama->Parse ($line) if ($line =~ /^p /); |
108
|
367
|
100
|
|
|
|
863
|
$self->Option->Parse ($line) if ($line =~ /^#hugin_/); |
109
|
367
|
100
|
|
|
|
9367
|
$self->Variable->Parse ($line) if ($line =~ /^v /); |
110
|
367
|
100
|
|
|
|
1035
|
if ($line =~ /^i /) |
111
|
|
|
|
|
|
|
{ |
112
|
25
|
|
|
|
|
570
|
my $image = new Panotools::Script::Line::Image; |
113
|
25
|
|
|
|
|
363
|
$image->Parse ($line); |
114
|
25
|
|
|
|
|
32
|
push @{$self->Image}, $image; |
|
25
|
|
|
|
|
74
|
|
115
|
|
|
|
|
|
|
} |
116
|
367
|
100
|
|
|
|
671
|
if ($line =~ /^o /) |
117
|
|
|
|
|
|
|
{ |
118
|
5
|
|
|
|
|
26
|
my $output = new Panotools::Script::Line::Output; |
119
|
5
|
|
|
|
|
16
|
$output->Parse ($line); |
120
|
5
|
|
|
|
|
6
|
push @{$self->Output}, $output; |
|
5
|
|
|
|
|
11
|
|
121
|
|
|
|
|
|
|
} |
122
|
367
|
100
|
|
|
|
1392
|
if ($line =~ /^c /) |
123
|
|
|
|
|
|
|
{ |
124
|
205
|
|
|
|
|
1213
|
my $control = new Panotools::Script::Line::Control; |
125
|
205
|
|
|
|
|
495
|
$control->Parse ($line); |
126
|
205
|
|
|
|
|
420
|
push @{$self->Control}, $control; |
|
205
|
|
|
|
|
416
|
|
127
|
|
|
|
|
|
|
} |
128
|
367
|
50
|
|
|
|
2305
|
if ($line =~ /^C /) |
129
|
|
|
|
|
|
|
{ |
130
|
0
|
|
|
|
|
0
|
my $controlmorph = new Panotools::Script::Line::ControlMorph; |
131
|
0
|
|
|
|
|
0
|
$controlmorph->Parse ($line); |
132
|
0
|
|
|
|
|
0
|
push @{$self->ControlMorph}, $controlmorph; |
|
0
|
|
|
|
|
0
|
|
133
|
|
|
|
|
|
|
} |
134
|
367
|
100
|
|
|
|
701
|
if ($line =~ /^#-hugin /) |
135
|
|
|
|
|
|
|
{ |
136
|
|
|
|
|
|
|
# per-image metadata |
137
|
25
|
|
|
|
|
148
|
my $imagemeta = new Panotools::Script::Line::ImageMetadata; |
138
|
25
|
|
|
|
|
78
|
$imagemeta->Parse ($line); |
139
|
25
|
|
|
|
|
34
|
push @{$self->ImageMetadata}, $imagemeta; |
|
25
|
|
|
|
|
78
|
|
140
|
|
|
|
|
|
|
} |
141
|
367
|
100
|
|
|
|
808
|
if ($line =~ /^k /) |
142
|
|
|
|
|
|
|
{ |
143
|
4
|
|
|
|
|
60
|
my $mask = new Panotools::Script::Line::Mask; |
144
|
4
|
|
|
|
|
25
|
$mask->Parse ($line); |
145
|
4
|
|
|
|
|
9
|
push @{$self->Mask}, $mask; |
|
4
|
|
|
|
|
20
|
|
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
} |
148
|
6
|
|
|
|
|
36
|
$self->Output2Image; |
149
|
6
|
|
|
|
|
61
|
return 1; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=pod |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
$p->Write ('/path/to/script.txt'); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
File paths in a Panorama Tools script file are generally relative to the |
157
|
|
|
|
|
|
|
directory containing the script. Modify this or otherwise prefix the filenames |
158
|
|
|
|
|
|
|
by supplying an optional second argument: |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
$p->Write ('/path/to/script.txt', '../path/to/prefix/tofiles'); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub Write |
165
|
|
|
|
|
|
|
{ |
166
|
7
|
|
|
7
|
0
|
179
|
my $self = shift; |
167
|
7
|
100
|
|
|
|
16
|
$self->Image2Output if scalar @{$self->Output}; |
|
7
|
|
|
|
|
25
|
|
168
|
7
|
|
50
|
|
|
30
|
my $path = shift || return 0; |
169
|
7
|
|
50
|
|
|
47
|
my $vector = shift || ''; |
170
|
7
|
50
|
|
|
|
45
|
if ($path eq '-') |
171
|
|
|
|
|
|
|
{ |
172
|
0
|
|
|
|
|
0
|
open FILE, '>-'; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
else |
175
|
|
|
|
|
|
|
{ |
176
|
7
|
50
|
|
|
|
1088
|
open FILE, ">", $path or die "cannot write-open $path"; |
177
|
|
|
|
|
|
|
} |
178
|
7
|
|
|
|
|
144
|
print FILE "# Created by ". (ref $self) ." $VERSION\n\n"; |
179
|
7
|
|
|
|
|
39
|
print FILE $self->Panorama->Assemble; |
180
|
7
|
|
|
|
|
54
|
print FILE $self->Mode->Assemble; |
181
|
7
|
|
|
|
|
27
|
print FILE "\n# Image lines\n"; |
182
|
7
|
|
|
|
|
18
|
for my $index (0 .. (scalar (@{$self->Image}) - 1)) |
|
7
|
|
|
|
|
40
|
|
183
|
|
|
|
|
|
|
{ |
184
|
23
|
100
|
|
|
|
1639
|
print FILE $self->ImageMetadata->[$index]->Assemble if defined ($self->ImageMetadata->[$index]); |
185
|
23
|
50
|
|
|
|
73
|
print FILE $self->Image->[$index]->Assemble if defined ($self->Image->[$index]); |
186
|
|
|
|
|
|
|
} |
187
|
7
|
|
|
|
|
20
|
print FILE "\n# Variable lines\n"; |
188
|
7
|
|
|
|
|
30
|
print FILE $self->Variable->Assemble; |
189
|
7
|
|
|
|
|
17
|
print FILE "\n# Control point lines\n"; |
190
|
7
|
|
|
|
|
19
|
for my $control (@{$self->Control}) |
|
7
|
|
|
|
|
35
|
|
191
|
|
|
|
|
|
|
{ |
192
|
82
|
|
|
|
|
674
|
print FILE $control->Assemble; |
193
|
|
|
|
|
|
|
} |
194
|
7
|
|
|
|
|
16
|
for my $controlmorph (@{$self->ControlMorph}) |
|
7
|
|
|
|
|
28
|
|
195
|
|
|
|
|
|
|
{ |
196
|
0
|
|
|
|
|
0
|
print FILE $controlmorph->Assemble; |
197
|
|
|
|
|
|
|
} |
198
|
7
|
|
|
|
|
15
|
print FILE "\n# Mask lines\n"; |
199
|
7
|
|
|
|
|
15
|
for my $mask (@{$self->Mask}) |
|
7
|
|
|
|
|
26
|
|
200
|
|
|
|
|
|
|
{ |
201
|
1
|
|
|
|
|
50
|
print FILE $mask->Assemble; |
202
|
|
|
|
|
|
|
} |
203
|
7
|
|
|
|
|
16
|
print FILE "\n# option lines\n"; |
204
|
7
|
|
|
|
|
26
|
print FILE $self->Option->Assemble; |
205
|
7
|
|
|
|
|
30
|
print FILE "\n*\n"; |
206
|
7
|
|
|
|
|
12
|
print FILE "\n# Output image lines\n"; |
207
|
7
|
|
|
|
|
16
|
for my $output (@{$self->Output}) |
|
7
|
|
|
|
|
26
|
|
208
|
|
|
|
|
|
|
{ |
209
|
15
|
|
|
|
|
59
|
print FILE $output->Assemble ($vector); |
210
|
|
|
|
|
|
|
} |
211
|
7
|
|
|
|
|
556
|
close FILE; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=pod |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Clone a script object |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
$clone = $p->Clone; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=cut |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub Clone |
223
|
|
|
|
|
|
|
{ |
224
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
225
|
2
|
|
|
|
|
2246
|
dclone ($self); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=pod |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Access various sections of the scriptfile: |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
$p->Mode; # a L object |
233
|
|
|
|
|
|
|
$p->Panorama; # a L object |
234
|
|
|
|
|
|
|
$p->Variable; # a L object |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=cut |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub Mode |
239
|
|
|
|
|
|
|
{ |
240
|
15
|
|
|
15
|
0
|
1283
|
my $self = shift; |
241
|
15
|
|
|
|
|
3950
|
$self->{mode}; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub Panorama |
245
|
|
|
|
|
|
|
{ |
246
|
27
|
|
|
27
|
0
|
675
|
my $self = shift; |
247
|
27
|
|
|
|
|
223
|
$self->{panorama}; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub Option |
251
|
|
|
|
|
|
|
{ |
252
|
34
|
|
|
34
|
0
|
55
|
my $self = shift; |
253
|
34
|
|
|
|
|
168
|
$self->{option}; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub Variable |
257
|
|
|
|
|
|
|
{ |
258
|
41
|
|
|
41
|
0
|
65
|
my $self = shift; |
259
|
41
|
|
|
|
|
191
|
$self->{variable}; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=pod |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
$p->Image; # an array of L objects |
265
|
|
|
|
|
|
|
$p->Output; # an array of L objects |
266
|
|
|
|
|
|
|
$p->Control; # an array of L objects |
267
|
|
|
|
|
|
|
$p->ControlMorph; # an array of L objects |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=cut |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub Image |
272
|
|
|
|
|
|
|
{ |
273
|
1869
|
|
|
1869
|
0
|
2086
|
my $self = shift; |
274
|
1869
|
|
|
|
|
6097
|
$self->{image}; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub ImageMetadata |
278
|
|
|
|
|
|
|
{ |
279
|
64
|
|
|
64
|
0
|
87
|
my $self = shift; |
280
|
64
|
|
|
|
|
244
|
$self->{imagemetadata}; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub Output |
284
|
|
|
|
|
|
|
{ |
285
|
1206
|
|
|
1206
|
0
|
1660
|
my $self = shift; |
286
|
1206
|
|
|
|
|
6520
|
$self->{output}; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub Control |
290
|
|
|
|
|
|
|
{ |
291
|
445
|
|
|
445
|
0
|
2241
|
my $self = shift; |
292
|
445
|
100
|
|
|
|
933
|
$self->{control} = shift if scalar @_; |
293
|
445
|
|
|
|
|
1734
|
$self->{control}; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub ControlMorph |
297
|
|
|
|
|
|
|
{ |
298
|
7
|
|
|
7
|
0
|
16
|
my $self = shift; |
299
|
7
|
|
|
|
|
28
|
$self->{controlmorph}; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub Mask |
303
|
|
|
|
|
|
|
{ |
304
|
17
|
|
|
17
|
0
|
37
|
my $self = shift; |
305
|
17
|
|
|
|
|
95
|
$self->{mask}; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=pod |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Rotate transform all the images in a project, angles in degrees: |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
$p->Transform ($roll, $pitch, $yaw); |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=cut |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub Transform |
317
|
|
|
|
|
|
|
{ |
318
|
2
|
|
|
2
|
0
|
9
|
my $self = shift; |
319
|
2
|
|
|
|
|
5
|
my ($roll, $pitch, $yaw) = @_; |
320
|
2
|
|
|
|
|
4
|
for my $image (@{$self->Image}) |
|
2
|
|
|
|
|
8
|
|
321
|
|
|
|
|
|
|
{ |
322
|
7
|
|
|
|
|
28
|
$image->Transform ($roll, $pitch, $yaw); |
323
|
|
|
|
|
|
|
} |
324
|
2
|
|
|
|
|
154
|
$self->Image2Output; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=pod |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
'o' output lines are generated by PTOptimizer and contain stitching parameters |
330
|
|
|
|
|
|
|
for each input image. |
331
|
|
|
|
|
|
|
'i' image lines provide parameters for optimisation as well as stitching. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Update the 'image' lines based on 'output' lines and vice-versa like so: |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
$p->Output2Image; |
336
|
|
|
|
|
|
|
$p->Image2Output; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=cut |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub Output2Image |
341
|
|
|
|
|
|
|
{ |
342
|
7
|
|
|
7
|
0
|
27
|
my $self = shift; |
343
|
7
|
|
|
|
|
482
|
for my $index (0 .. (@{$self->Output} - 1)) |
|
7
|
|
|
|
|
41
|
|
344
|
|
|
|
|
|
|
{ |
345
|
7
|
|
|
|
|
10
|
for my $entry (keys %{$self->Output->[$index]}) |
|
7
|
|
|
|
|
16
|
|
346
|
|
|
|
|
|
|
{ |
347
|
101
|
100
|
|
|
|
167
|
$self->Image->[$index] = new Panotools::Script::Line::Image unless (defined $self->Image->[$index]); |
348
|
101
|
100
|
100
|
|
|
170
|
$self->Image->[$index]->{$entry} = $self->Output->[$index]->{$entry} |
349
|
|
|
|
|
|
|
unless (defined $self->Image->[$index]->{$entry} and $self->Image->[$index]->{$entry} =~ /=/); |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub Image2Output |
355
|
|
|
|
|
|
|
{ |
356
|
7
|
|
|
7
|
0
|
27
|
my $self = shift; |
357
|
7
|
|
|
|
|
26
|
for my $index (0 .. (@{$self->Image} - 1)) |
|
7
|
|
|
|
|
26
|
|
358
|
|
|
|
|
|
|
{ |
359
|
26
|
|
|
|
|
34
|
for my $entry (keys %{$self->Image->[$index]}) |
|
26
|
|
|
|
|
50
|
|
360
|
|
|
|
|
|
|
{ |
361
|
528
|
100
|
|
|
|
971
|
$self->Output->[$index] = new Panotools::Script::Line::Output unless (defined $self->Output->[$index]); |
362
|
528
|
100
|
|
|
|
981
|
unless ($self->Image->[$index]->{$entry} =~ /=/) |
363
|
|
|
|
|
|
|
{ |
364
|
414
|
|
|
|
|
796
|
$self->Output->[$index]->{$entry} = $self->Image->[$index]->{$entry}; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
else |
367
|
|
|
|
|
|
|
{ |
368
|
114
|
|
|
|
|
235
|
my $base = $self->Image->[$index]->{$entry}; |
369
|
114
|
|
|
|
|
259
|
$base =~ s/=//; |
370
|
114
|
|
|
|
|
214
|
$self->Output->[$index]->{$entry} = $self->Image->[$base]->{$entry}; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=pod |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Remove duplicate control points from the project, returns a list of deleted |
379
|
|
|
|
|
|
|
points: |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
my $deleted = $p->Duplicates; |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=cut |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
sub Duplicates |
386
|
|
|
|
|
|
|
{ |
387
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
388
|
2
|
|
|
|
|
6
|
my $packed_seen = {}; |
389
|
2
|
|
|
|
|
5
|
my $points_uniq = []; |
390
|
2
|
|
|
|
|
6
|
my $points_deleted = []; |
391
|
2
|
|
|
|
|
3
|
for my $point (@{$self->Control}) |
|
2
|
|
|
|
|
5
|
|
392
|
|
|
|
|
|
|
{ |
393
|
81
|
|
|
|
|
208
|
my $packed = $point->Packed; |
394
|
81
|
100
|
|
|
|
200
|
if (defined $packed_seen->{$packed}) |
395
|
|
|
|
|
|
|
{ |
396
|
1
|
|
|
|
|
5
|
push @{$points_deleted}, $point; |
|
1
|
|
|
|
|
4
|
|
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
else |
399
|
|
|
|
|
|
|
{ |
400
|
80
|
|
|
|
|
84
|
push @{$points_uniq}, $point; |
|
80
|
|
|
|
|
139
|
|
401
|
|
|
|
|
|
|
} |
402
|
81
|
|
|
|
|
11743
|
$packed_seen->{$packed} = 'TRUE'; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
2
|
|
|
|
|
12
|
$self->Control ($points_uniq); |
406
|
2
|
|
|
|
|
24
|
return $points_deleted; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=pod |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Remove all points with an error distance greater than a threshold measured in |
412
|
|
|
|
|
|
|
pixels, returns a list of deleted points: |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
my $pruned = $p->Prune (12.345); |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=cut |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub Prune |
419
|
|
|
|
|
|
|
{ |
420
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
421
|
0
|
|
|
|
|
0
|
my $threshold = shift; |
422
|
0
|
0
|
|
|
|
0
|
return [] unless $threshold > 0; |
423
|
0
|
|
|
|
|
0
|
my $points_new = []; |
424
|
0
|
|
|
|
|
0
|
my $points_pruned = []; |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
0
|
for my $point (@{$self->Control}) |
|
0
|
|
|
|
|
0
|
|
427
|
|
|
|
|
|
|
{ |
428
|
0
|
0
|
0
|
|
|
0
|
if ($point->{t} > 0 or $point->Distance ($self) < $threshold) |
429
|
|
|
|
|
|
|
{ |
430
|
0
|
|
|
|
|
0
|
push @{$points_new}, $point; |
|
0
|
|
|
|
|
0
|
|
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
else |
433
|
|
|
|
|
|
|
{ |
434
|
0
|
|
|
|
|
0
|
push @{$points_pruned}, $point; |
|
0
|
|
|
|
|
0
|
|
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
0
|
|
|
|
|
0
|
$self->{control} = $points_new; |
439
|
0
|
|
|
|
|
0
|
return $points_pruned; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=pod |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Extract a new object consisting of just the requested images, related |
445
|
|
|
|
|
|
|
control points and optimisation settings: |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
my $subset = $p->Subset (1, 2, 34, 56); |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Images can be requested in any order, but they will be returned in the same |
450
|
|
|
|
|
|
|
order as the 'parent' project. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=cut |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub Subset |
455
|
|
|
|
|
|
|
{ |
456
|
2
|
|
|
2
|
0
|
11
|
my $self = shift; |
457
|
2
|
|
|
|
|
16
|
my @selection = sort {$a <=> $b} @_; |
|
7
|
|
|
|
|
16
|
|
458
|
|
|
|
|
|
|
|
459
|
2
|
|
|
|
|
4
|
my $mapping; |
460
|
2
|
|
|
|
|
8
|
for my $index (0 .. scalar @selection -1) |
461
|
|
|
|
|
|
|
{ |
462
|
7
|
50
|
|
|
|
35
|
return 0 unless $selection[$index] =~ /^[0-9]+$/; |
463
|
7
|
50
|
|
|
|
10
|
return 0 if $selection[$index] >= scalar @{$self->{image}}; |
|
7
|
|
|
|
|
18
|
|
464
|
7
|
|
|
|
|
22
|
$mapping->{$selection[$index]} = $index; |
465
|
|
|
|
|
|
|
} |
466
|
2
|
50
|
|
|
|
4
|
return 0 unless scalar keys %{$mapping} == scalar @selection; |
|
2
|
|
|
|
|
20
|
|
467
|
|
|
|
|
|
|
|
468
|
2
|
|
|
|
|
13
|
my $pto_out = $self->Clone; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
# only use selected images |
471
|
2
|
|
|
|
|
8
|
$pto_out->{image} = []; |
472
|
2
|
|
|
|
|
48
|
$pto_out->{imagemetadata} = []; |
473
|
2
|
|
|
|
|
33
|
$pto_out->{variable} = new Panotools::Script::Line::Variable; |
474
|
|
|
|
|
|
|
|
475
|
2
|
|
|
|
|
10
|
for my $index (0 .. scalar @{$self->{image}} -1) |
|
2
|
|
|
|
|
8
|
|
476
|
|
|
|
|
|
|
{ |
477
|
10
|
100
|
|
|
|
29
|
next unless defined $mapping->{$index}; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
# copy metadata for selected image |
480
|
7
|
50
|
|
|
|
44
|
$pto_out->{imagemetadata}->[$mapping->{$index}] |
481
|
|
|
|
|
|
|
= $self->{imagemetadata}->[$index]->Clone |
482
|
|
|
|
|
|
|
if defined $self->{imagemetadata}->[$index]; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
# copy selected image but resolve '=0' style references |
485
|
7
|
|
|
|
|
35
|
my $image = $self->{image}->[$index]->Clone; |
486
|
7
|
|
|
|
|
13
|
for my $key (keys %{$image}) |
|
7
|
|
|
|
|
47
|
|
487
|
|
|
|
|
|
|
{ |
488
|
|
|
|
|
|
|
# resolve references as anchor image may be gone |
489
|
210
|
100
|
|
|
|
1649
|
if ($image->{$key} =~ /^=([0-9]+)$/) |
490
|
|
|
|
|
|
|
{ |
491
|
84
|
|
|
|
|
1732
|
$image->{$key} = $self->{image}->[$1]->{$key}; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
# rereference to image 0 if possible |
494
|
210
|
100
|
100
|
|
|
498
|
if (scalar @{$pto_out->{image}} > 0 |
|
210
|
|
100
|
|
|
2996
|
|
495
|
|
|
|
|
|
|
and $image->{$key} eq $pto_out->{image}->[0]->{$key} |
496
|
|
|
|
|
|
|
and $key =~ /^([abcdev]|R[abcde]|V[abcdxy])$/) |
497
|
|
|
|
|
|
|
{ |
498
|
85
|
|
|
|
|
156
|
$image->{$key} = '=0'; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
} |
501
|
7
|
|
|
|
|
35
|
$pto_out->{image}->[$mapping->{$index}] = $image; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
# copy only optimisation parameters for selected image |
504
|
7
|
|
|
|
|
445
|
$pto_out->{variable}->{$mapping->{$index}} |
505
|
7
|
50
|
|
|
|
28
|
= {%{$self->{variable}->{$index}}} |
506
|
|
|
|
|
|
|
if defined $self->{variable}->{$index}; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# copy only control points related to selected images |
510
|
2
|
|
|
|
|
7
|
$pto_out->{control} = []; |
511
|
2
|
|
|
|
|
97
|
for my $control (@{$self->{control}}) |
|
2
|
|
|
|
|
10
|
|
512
|
|
|
|
|
|
|
{ |
513
|
80
|
100
|
|
|
|
204
|
next unless defined $mapping->{$control->{n}}; |
514
|
47
|
100
|
|
|
|
110
|
next unless defined $mapping->{$control->{N}}; |
515
|
40
|
|
|
|
|
104
|
my $clone = $control->Clone; |
516
|
40
|
|
|
|
|
110
|
$clone->{n} = $mapping->{$control->{n}}; |
517
|
40
|
|
|
|
|
75
|
$clone->{N} = $mapping->{$control->{N}}; |
518
|
40
|
|
|
|
|
43
|
push @{$pto_out->{control}}, $clone; |
|
40
|
|
|
|
|
104
|
|
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# copy masks for selected images |
522
|
2
|
|
|
|
|
8
|
$pto_out->{mask} = []; |
523
|
2
|
|
|
|
|
17
|
for my $mask (@{$self->{mask}}) |
|
2
|
|
|
|
|
7
|
|
524
|
|
|
|
|
|
|
{ |
525
|
2
|
100
|
|
|
|
12
|
next unless defined $mapping->{$mask->{i}}; |
526
|
1
|
|
|
|
|
34
|
my $clone = $mask->Clone; |
527
|
1
|
|
|
|
|
3
|
$clone->{i} = $mapping->{$mask->{i}}; |
528
|
1
|
|
|
|
|
2
|
push @{$pto_out->{mask}}, $clone; |
|
1
|
|
|
|
|
5
|
|
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
2
|
|
|
|
|
19
|
return $pto_out; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=pod |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Merge a project with another: |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
$p->Merge ($newstuff); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
This adds extra images from $newstuff, skipping duplicates. All control points |
541
|
|
|
|
|
|
|
except exact duplicates are imported regardless. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=cut |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
sub Merge |
546
|
|
|
|
|
|
|
{ |
547
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
548
|
1
|
|
50
|
|
|
6
|
my $b = shift || return 0; |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# create lookup table relating filenames to index in final project |
551
|
1
|
|
|
|
|
2
|
my $mapping = {}; |
552
|
|
|
|
|
|
|
|
553
|
1
|
|
|
|
|
2
|
for my $index (0 .. scalar @{$self->Image} -1) |
|
1
|
|
|
|
|
4
|
|
554
|
|
|
|
|
|
|
{ |
555
|
3
|
|
|
|
|
6
|
$mapping->{$self->Image->[$index]->{n}} = $index; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
1
|
|
|
|
|
2
|
my $index = scalar keys %{$mapping}; |
|
1
|
|
|
|
|
3
|
|
559
|
1
|
|
|
|
|
3
|
for my $image (@{$b->Image}) |
|
1
|
|
|
|
|
3
|
|
560
|
|
|
|
|
|
|
{ |
561
|
4
|
100
|
|
|
|
15
|
unless (defined $mapping->{$image->{n}}) |
562
|
|
|
|
|
|
|
{ |
563
|
2
|
|
|
|
|
4
|
$mapping->{$image->{n}} = $index; |
564
|
2
|
|
|
|
|
5
|
$index++; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
# insert metadata, image and variable info if a new filename |
569
|
1
|
|
|
|
|
3
|
for my $index (0 .. scalar @{$b->Image} -1) |
|
1
|
|
|
|
|
3
|
|
570
|
|
|
|
|
|
|
{ |
571
|
4
|
|
|
|
|
9
|
my $filename = $b->Image->[$index]->{n}; |
572
|
4
|
100
|
|
|
|
9
|
next if defined $self->Image->[$mapping->{$filename}]; |
573
|
|
|
|
|
|
|
|
574
|
2
|
50
|
|
|
|
7
|
$self->ImageMetadata->[$mapping->{$filename}] = $b->ImageMetadata->[$index]->Clone |
575
|
|
|
|
|
|
|
if defined $b->ImageMetadata->[$index]; |
576
|
|
|
|
|
|
|
|
577
|
2
|
|
|
|
|
6
|
my $image = $b->Image->[$index]->Clone; |
578
|
2
|
|
|
|
|
3
|
for my $key (keys %{$image}) |
|
2
|
|
|
|
|
13
|
|
579
|
|
|
|
|
|
|
{ |
580
|
|
|
|
|
|
|
# update references |
581
|
60
|
100
|
|
|
|
162
|
if ($image->{$key} =~ /^=([0-9]+)$/) |
582
|
|
|
|
|
|
|
{ |
583
|
17
|
|
|
|
|
33
|
my $index_new = $mapping->{$b->Image->[$1]->{n}}; |
584
|
17
|
|
|
|
|
41
|
$image->{$key} = "=$index_new"; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
} |
587
|
2
|
|
|
|
|
9
|
$self->Image->[$mapping->{$filename}] = $image; |
588
|
|
|
|
|
|
|
|
589
|
2
|
|
|
|
|
8
|
my $variable = $b->Variable->Clone; |
590
|
2
|
|
|
|
|
9
|
$self->Variable->{$mapping->{$filename}} = $variable->{$index}; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
# append control points |
594
|
1
|
|
|
|
|
3
|
for my $control (@{$b->Control}) |
|
1
|
|
|
|
|
4
|
|
595
|
|
|
|
|
|
|
{ |
596
|
21
|
|
|
|
|
57
|
my $clone = $control->Clone; |
597
|
21
|
|
|
|
|
58
|
$clone->{n} = $mapping->{$b->Image->[$clone->{n}]->{n}}; |
598
|
21
|
|
|
|
|
48
|
$clone->{N} = $mapping->{$b->Image->[$clone->{N}]->{n}}; |
599
|
21
|
|
|
|
|
29
|
push @{$self->Control}, $clone; |
|
21
|
|
|
|
|
35
|
|
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
# add masks |
603
|
1
|
|
|
|
|
4
|
for my $mask (@{$b->Mask}) |
|
1
|
|
|
|
|
7
|
|
604
|
|
|
|
|
|
|
{ |
605
|
0
|
|
|
|
|
0
|
my $jump; |
606
|
0
|
|
|
|
|
0
|
for my $self_mask (@{$self->Mask}) |
|
0
|
|
|
|
|
0
|
|
607
|
|
|
|
|
|
|
{ |
608
|
0
|
0
|
0
|
|
|
0
|
$jump = 1 if ($self_mask->{i} eq $mask->{i} and $self_mask->{p} eq $mask->{p}); |
609
|
|
|
|
|
|
|
} |
610
|
0
|
0
|
|
|
|
0
|
next if $jump; |
611
|
0
|
|
|
|
|
0
|
my $clone = $mask->Clone; |
612
|
0
|
|
|
|
|
0
|
$clone->{i} = $mapping->{$b->Image->[$clone->{i}]->{n}}; |
613
|
0
|
|
|
|
|
0
|
push @{$self->Mask}, $clone; |
|
0
|
|
|
|
|
0
|
|
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
|
616
|
1
|
|
|
|
|
5
|
$self->Duplicates; |
617
|
|
|
|
|
|
|
|
618
|
1
|
|
|
|
|
2
|
for my $option (keys %{$b->Option}) |
|
1
|
|
|
|
|
7
|
|
619
|
|
|
|
|
|
|
{ |
620
|
21
|
50
|
|
|
|
693
|
$self->Option->{$option} = $b->Option->{$option} unless defined $self->Option->{$option}; |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
1
|
|
|
|
|
12
|
return 1; |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=pod |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
Get a summary of control point error distances in pixel units scaled to the |
629
|
|
|
|
|
|
|
output panorama: |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
my ($total, $min, $max, $average, $sigma) = $p->Stats; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=cut |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub Stats |
636
|
|
|
|
|
|
|
{ |
637
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
# get a list of all the distances |
640
|
0
|
|
|
|
|
0
|
my @distances; |
641
|
0
|
|
|
|
|
0
|
for my $point (@{$self->Control}) |
|
0
|
|
|
|
|
0
|
|
642
|
|
|
|
|
|
|
{ |
643
|
0
|
0
|
|
|
|
0
|
next unless $point->{t} == 0; |
644
|
0
|
|
|
|
|
0
|
push @distances, $point->Distance ($self); |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
0
|
|
|
|
|
0
|
my $total = scalar (@distances); |
648
|
|
|
|
|
|
|
|
649
|
0
|
0
|
|
|
|
0
|
return (0,0,0,0,0) unless $total; |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# calculate maximum and average distance |
652
|
0
|
|
|
|
|
0
|
my $max = undef; |
653
|
0
|
|
|
|
|
0
|
my $min = undef; |
654
|
0
|
|
|
|
|
0
|
my $sum = 0; |
655
|
0
|
|
|
|
|
0
|
for my $distance (@distances) |
656
|
|
|
|
|
|
|
{ |
657
|
0
|
0
|
|
|
|
0
|
$min = $distance unless defined $min; |
658
|
0
|
0
|
|
|
|
0
|
$min = $distance if ($min > $distance); |
659
|
0
|
0
|
|
|
|
0
|
$max = $distance unless defined $max; |
660
|
0
|
0
|
|
|
|
0
|
$max = $distance if ($max < $distance); |
661
|
0
|
|
|
|
|
0
|
$sum += $distance; |
662
|
|
|
|
|
|
|
} |
663
|
0
|
|
|
|
|
0
|
my $average = $sum / $total; |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# calculate variation and standard deviation (sigma) |
666
|
0
|
|
|
|
|
0
|
$sum = 0; |
667
|
0
|
|
|
|
|
0
|
for my $distance (@distances) |
668
|
|
|
|
|
|
|
{ |
669
|
0
|
|
|
|
|
0
|
my $variation = $distance - $average; |
670
|
0
|
|
|
|
|
0
|
$sum += $variation * $variation; |
671
|
|
|
|
|
|
|
} |
672
|
0
|
|
|
|
|
0
|
my $variance = $sum / $total; |
673
|
0
|
|
|
|
|
0
|
my $sigma = sqrt ($variance); |
674
|
|
|
|
|
|
|
|
675
|
0
|
|
|
|
|
0
|
return ($total, $min, $max, $average, $sigma); |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=pod |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Centre input images into the final panorama: |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
$p->Centre ('y'); |
683
|
|
|
|
|
|
|
$p->Centre ('p'); |
684
|
|
|
|
|
|
|
$p->Centre ('r'); |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub Centre |
689
|
|
|
|
|
|
|
{ |
690
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
691
|
0
|
|
|
|
|
0
|
my $param = shift; |
692
|
|
|
|
|
|
|
|
693
|
0
|
|
|
|
|
0
|
for my $image (@{$self->Image}) |
|
0
|
|
|
|
|
0
|
|
694
|
|
|
|
|
|
|
{ |
695
|
0
|
|
|
|
|
0
|
my $sigma_old = $self->Sigma ($param); |
696
|
0
|
|
|
|
|
0
|
$image->{$param} += 360; |
697
|
0
|
0
|
|
|
|
0
|
next if $self->Sigma ($param) < $sigma_old; |
698
|
0
|
|
|
|
|
0
|
$image->{$param} -= 720; |
699
|
0
|
0
|
|
|
|
0
|
next if $self->Sigma ($param) < $sigma_old; |
700
|
0
|
|
|
|
|
0
|
$image->{$param} += 360; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
0
|
|
|
|
|
0
|
my $average_r = $self->_average ('r'); |
704
|
0
|
|
|
|
|
0
|
my $average_p = $self->_average ('p'); |
705
|
0
|
|
|
|
|
0
|
my $average_y = $self->_average ('y'); |
706
|
|
|
|
|
|
|
|
707
|
0
|
0
|
|
|
|
0
|
if ($param eq 'r') |
708
|
|
|
|
|
|
|
{ |
709
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0, 0 - $average_y); |
710
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0 - $average_p, 0); |
711
|
0
|
|
|
|
|
0
|
$self->Transform (0 - $average_r, 0, 0); |
712
|
0
|
|
|
|
|
0
|
$self->Transform (0, $average_p, 0); |
713
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0, $average_y); |
714
|
|
|
|
|
|
|
} |
715
|
0
|
0
|
|
|
|
0
|
if ($param eq 'p') |
716
|
|
|
|
|
|
|
{ |
717
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0, 0 - $average_y); |
718
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0 - $average_p, 0); |
719
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0, $average_y); |
720
|
|
|
|
|
|
|
} |
721
|
0
|
0
|
|
|
|
0
|
if ($param eq 'y') |
722
|
|
|
|
|
|
|
{ |
723
|
0
|
|
|
|
|
0
|
$self->Transform (0, 0, 0 - $average_y); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub _average |
728
|
|
|
|
|
|
|
{ |
729
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
730
|
0
|
|
|
|
|
0
|
my $param = shift; |
731
|
0
|
|
|
|
|
0
|
my $sum = 0; |
732
|
0
|
|
|
|
|
0
|
for my $image (@{$self->Image}) |
|
0
|
|
|
|
|
0
|
|
733
|
|
|
|
|
|
|
{ |
734
|
0
|
|
|
|
|
0
|
$sum += $image->{$param} |
735
|
|
|
|
|
|
|
} |
736
|
0
|
|
|
|
|
0
|
return $sum / scalar @{$self->Image}; |
|
0
|
|
|
|
|
0
|
|
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
sub Sigma |
740
|
|
|
|
|
|
|
{ |
741
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
742
|
0
|
|
|
|
|
0
|
my $param = shift; |
743
|
0
|
|
|
|
|
0
|
my $sum = 0; |
744
|
0
|
|
|
|
|
0
|
my $average = $self->_average ($param); |
745
|
0
|
|
|
|
|
0
|
for my $image (@{$self->Image}) |
|
0
|
|
|
|
|
0
|
|
746
|
|
|
|
|
|
|
{ |
747
|
0
|
|
|
|
|
0
|
my $variation = $image->{$param} - $average; |
748
|
0
|
|
|
|
|
0
|
$sum += $variation * $variation; |
749
|
|
|
|
|
|
|
} |
750
|
0
|
|
|
|
|
0
|
my $variance = $sum / scalar @{$self->Image}; |
|
0
|
|
|
|
|
0
|
|
751
|
0
|
|
|
|
|
0
|
return sqrt ($variance); |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=pod |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Split the project into exposure stacks based in roll, pitch & yaw, or into |
757
|
|
|
|
|
|
|
exposure layers based on EV values: |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
$stacks = $pto->Stacks; |
760
|
|
|
|
|
|
|
$layers = $pto->ExposureLayers; |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Returns a list of image number lists. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
e.g. extract the first stack as a new project: |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
$pto_stack = $pto->Subset (@{$pto->Stacks->[0]}); |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=cut |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
sub Stacks |
771
|
|
|
|
|
|
|
{ |
772
|
0
|
|
|
0
|
0
|
0
|
my $self = shift->Clone; |
773
|
0
|
|
|
|
|
0
|
my $stacks = []; |
774
|
0
|
|
|
|
|
0
|
my $maxShift = $self->Image->[0]->{v} / 10.0; |
775
|
0
|
|
|
|
|
0
|
my @images = (0 .. scalar @{$self->Image} -1); |
|
0
|
|
|
|
|
0
|
|
776
|
0
|
|
|
|
|
0
|
while (@images) |
777
|
|
|
|
|
|
|
{ |
778
|
0
|
|
|
|
|
0
|
my $base_image = shift @images; |
779
|
0
|
|
|
|
|
0
|
my $stack = [$base_image]; |
780
|
0
|
|
|
|
|
0
|
my @images_remaining = @images; |
781
|
0
|
|
|
|
|
0
|
for my $image (@images) |
782
|
|
|
|
|
|
|
{ |
783
|
0
|
0
|
|
|
|
0
|
if (_samestack ($self->{image}->[$base_image], $self->{image}->[$image], $maxShift)) |
784
|
|
|
|
|
|
|
{ |
785
|
0
|
|
|
|
|
0
|
push @{$stack}, $image; |
|
0
|
|
|
|
|
0
|
|
786
|
0
|
|
|
|
|
0
|
@images_remaining = grep !/^$image$/, @images_remaining; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
} |
789
|
0
|
|
|
|
|
0
|
@images = @images_remaining; |
790
|
0
|
|
|
|
|
0
|
push @{$stacks}, $stack; |
|
0
|
|
|
|
|
0
|
|
791
|
|
|
|
|
|
|
} |
792
|
0
|
|
|
|
|
0
|
return $stacks; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
sub _samestack |
796
|
|
|
|
|
|
|
{ |
797
|
0
|
|
|
0
|
|
0
|
my ($image0, $image1, $maxShift) = @_; |
798
|
0
|
|
|
|
|
0
|
my $minShift = 360.0 - $maxShift; |
799
|
0
|
0
|
0
|
|
|
0
|
return 1 |
|
|
|
0
|
|
|
|
|
800
|
|
|
|
|
|
|
if ( (abs ($image0->y - $image1->y) < $maxShift || abs ($image0->y - $image1->y) > $minShift) |
801
|
|
|
|
|
|
|
&& abs ($image0->p - $image1->p) < $maxShift ); |
802
|
0
|
|
|
|
|
0
|
return 0; |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=pod |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
Split a project into exposure layers, returns a list of lists of image ids: |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
my $layers = $pto->ExposureLayers (1.0); |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
Deafults to 0.5EV difference threshold. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=cut |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
sub ExposureLayers |
816
|
|
|
|
|
|
|
{ |
817
|
0
|
|
|
0
|
0
|
0
|
my $self = shift->Clone; |
818
|
0
|
|
|
|
|
0
|
my $layers = []; |
819
|
0
|
|
0
|
|
|
0
|
my $maxEVDiff = shift || 0.5; |
820
|
0
|
|
|
|
|
0
|
my @images = (0 .. scalar @{$self->Image} -1); |
|
0
|
|
|
|
|
0
|
|
821
|
0
|
|
|
|
|
0
|
while (@images) |
822
|
|
|
|
|
|
|
{ |
823
|
0
|
|
|
|
|
0
|
my $base_image = shift @images; |
824
|
0
|
|
|
|
|
0
|
my $layer = [$base_image]; |
825
|
0
|
|
|
|
|
0
|
my @images_remaining = @images; |
826
|
0
|
|
|
|
|
0
|
for my $image (@images) |
827
|
|
|
|
|
|
|
{ |
828
|
0
|
0
|
|
|
|
0
|
if (_samelayer ($self->{image}->[$base_image], $self->{image}->[$image], $maxEVDiff)) |
829
|
|
|
|
|
|
|
{ |
830
|
0
|
|
|
|
|
0
|
push @{$layer}, $image; |
|
0
|
|
|
|
|
0
|
|
831
|
0
|
|
|
|
|
0
|
@images_remaining = grep !/^$image$/, @images_remaining; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
} |
834
|
0
|
|
|
|
|
0
|
@images = @images_remaining; |
835
|
0
|
|
|
|
|
0
|
push @{$layers}, $layer; |
|
0
|
|
|
|
|
0
|
|
836
|
|
|
|
|
|
|
} |
837
|
0
|
|
|
|
|
0
|
return $layers; |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
sub _samelayer |
841
|
|
|
|
|
|
|
{ |
842
|
0
|
|
|
0
|
|
0
|
my ($image0, $image1, $maxEVDiff) = @_; |
843
|
0
|
0
|
|
|
|
0
|
return 1 if (abs ($image0->{Eev} - $image1->{Eev}) < $maxEVDiff ); |
844
|
0
|
|
|
|
|
0
|
return 0; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=pod |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
Get a list of unconnected groups, i.e. a list of image id lists: |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
$groups = $pto->ConnectedGroups; |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
warn 'just one group' if scalar @{$groups} == 1; |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=cut |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
sub ConnectedGroups |
858
|
|
|
|
|
|
|
{ |
859
|
12
|
|
|
12
|
0
|
42
|
my $self = shift; |
860
|
12
|
50
|
|
|
|
20
|
return [[]] unless scalar @{$self->Image}; |
|
12
|
|
|
|
|
31
|
|
861
|
12
|
|
|
|
|
33
|
my $groups = [[0]]; |
862
|
12
|
|
|
|
|
22
|
my $group_id = 0; |
863
|
|
|
|
|
|
|
|
864
|
12
|
|
|
|
|
20
|
my @images = (1 .. scalar @{$self->Image} -1); |
|
12
|
|
|
|
|
21
|
|
865
|
12
|
|
|
|
|
32
|
while (@images) |
866
|
|
|
|
|
|
|
{ |
867
|
65
|
|
|
|
|
77
|
my $match = 0; |
868
|
65
|
|
|
|
|
89
|
for my $image (@images) |
869
|
|
|
|
|
|
|
{ |
870
|
166
|
100
|
|
|
|
286
|
next if $match; |
871
|
72
|
50
|
|
|
|
71
|
next if grep /^$image$/, @{$groups->[$group_id]}; |
|
72
|
|
|
|
|
977
|
|
872
|
72
|
|
|
|
|
89
|
for my $base_image (@{$groups->[$group_id]}) |
|
72
|
|
|
|
|
123
|
|
873
|
|
|
|
|
|
|
{ |
874
|
263
|
100
|
|
|
|
571
|
next if $match; |
875
|
176
|
100
|
|
|
|
384
|
if (scalar $self->Connections ($base_image, $image)) |
876
|
|
|
|
|
|
|
{ |
877
|
51
|
|
|
|
|
50
|
push @{$groups->[$group_id]}, $image; |
|
51
|
|
|
|
|
176
|
|
878
|
51
|
|
|
|
|
73
|
$match = 1; |
879
|
51
|
|
|
|
|
989
|
@images = grep !/^$image$/, @images; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
65
|
100
|
|
|
|
195
|
unless ($match) |
884
|
|
|
|
|
|
|
{ |
885
|
14
|
|
|
|
|
16
|
$group_id++; |
886
|
14
|
|
|
|
|
75
|
$groups->[$group_id]->[0] = shift @images; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
} |
889
|
12
|
|
|
|
|
126
|
return $groups; |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=pod |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
Count the connections between any two images: |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
$points = $pto->Connections (3, 5); |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=cut |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
sub Connections |
901
|
|
|
|
|
|
|
{ |
902
|
191
|
|
|
191
|
0
|
237
|
my $self = shift; |
903
|
191
|
|
|
|
|
261
|
my ($a, $b) = @_; |
904
|
|
|
|
|
|
|
|
905
|
191
|
|
|
|
|
215
|
my $results = 0; |
906
|
191
|
|
|
|
|
205
|
for my $control (@{$self->Control}) |
|
191
|
|
|
|
|
361
|
|
907
|
|
|
|
|
|
|
{ |
908
|
7885
|
|
|
|
|
10970
|
my $N = $control->{N}; |
909
|
7885
|
|
|
|
|
8663
|
my $n = $control->{n}; |
910
|
7885
|
100
|
100
|
|
|
35094
|
$results++ if (($n == $a and $N == $b) or ($n == $b and $N == $a)); |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
911
|
|
|
|
|
|
|
} |
912
|
191
|
|
|
|
|
708
|
return $results; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=pod |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
Given a project with unlinked lens parameters, link them together with the same |
918
|
|
|
|
|
|
|
lens number if all distortion, and photometric parameters match: |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
$pto->UnifyLenses; |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=cut |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
sub UnifyLenses |
925
|
|
|
|
|
|
|
{ |
926
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
927
|
0
|
|
|
|
|
0
|
for my $id (1 .. scalar @{$self->Image} -1) |
|
0
|
|
|
|
|
0
|
|
928
|
|
|
|
|
|
|
{ |
929
|
0
|
|
|
|
|
0
|
my $img = $self->Image->[$id]; |
930
|
0
|
|
|
|
|
0
|
for my $base_id (0 .. $id -1) |
931
|
|
|
|
|
|
|
{ |
932
|
0
|
|
|
|
|
0
|
my $base_img = $self->Image->[$base_id]; |
933
|
0
|
0
|
0
|
|
|
0
|
if ($img->v ($self) eq $base_img->{v} |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
934
|
|
|
|
|
|
|
and $img->a ($self) eq $base_img->{a} |
935
|
|
|
|
|
|
|
and $img->b ($self) eq $base_img->{b} |
936
|
|
|
|
|
|
|
and $img->c ($self) eq $base_img->{c} |
937
|
|
|
|
|
|
|
and $img->d ($self) eq $base_img->{d} |
938
|
|
|
|
|
|
|
and $img->e ($self) eq $base_img->{e} |
939
|
|
|
|
|
|
|
and $img->Ra ($self) eq $base_img->{Ra} |
940
|
|
|
|
|
|
|
and $img->Rb ($self) eq $base_img->{Rb} |
941
|
|
|
|
|
|
|
and $img->Rc ($self) eq $base_img->{Rc} |
942
|
|
|
|
|
|
|
and $img->Rd ($self) eq $base_img->{Rd} |
943
|
|
|
|
|
|
|
and $img->Re ($self) eq $base_img->{Re} |
944
|
|
|
|
|
|
|
and $img->Va ($self) eq $base_img->{Va} |
945
|
|
|
|
|
|
|
and $img->Vb ($self) eq $base_img->{Vb} |
946
|
|
|
|
|
|
|
and $img->Vc ($self) eq $base_img->{Vc} |
947
|
|
|
|
|
|
|
and $img->Vd ($self) eq $base_img->{Vd} |
948
|
|
|
|
|
|
|
and $img->Vx ($self) eq $base_img->{Vx} |
949
|
|
|
|
|
|
|
and $img->Vy ($self) eq $base_img->{Vy} |
950
|
|
|
|
|
|
|
) |
951
|
|
|
|
|
|
|
{ |
952
|
0
|
|
|
|
|
0
|
$img->{v} = "=$base_id"; |
953
|
0
|
|
|
|
|
0
|
$img->{a} = "=$base_id"; |
954
|
0
|
|
|
|
|
0
|
$img->{b} = "=$base_id"; |
955
|
0
|
|
|
|
|
0
|
$img->{c} = "=$base_id"; |
956
|
0
|
|
|
|
|
0
|
$img->{d} = "=$base_id"; |
957
|
0
|
|
|
|
|
0
|
$img->{e} = "=$base_id"; |
958
|
0
|
|
|
|
|
0
|
$img->{Ra} = "=$base_id"; |
959
|
0
|
|
|
|
|
0
|
$img->{Rb} = "=$base_id"; |
960
|
0
|
|
|
|
|
0
|
$img->{Rc} = "=$base_id"; |
961
|
0
|
|
|
|
|
0
|
$img->{Rd} = "=$base_id"; |
962
|
0
|
|
|
|
|
0
|
$img->{Re} = "=$base_id"; |
963
|
0
|
|
|
|
|
0
|
$img->{Va} = "=$base_id"; |
964
|
0
|
|
|
|
|
0
|
$img->{Vb} = "=$base_id"; |
965
|
0
|
|
|
|
|
0
|
$img->{Vc} = "=$base_id"; |
966
|
0
|
|
|
|
|
0
|
$img->{Vd} = "=$base_id"; |
967
|
0
|
|
|
|
|
0
|
$img->{Vx} = "=$base_id"; |
968
|
0
|
|
|
|
|
0
|
$img->{Vy} = "=$base_id"; |
969
|
0
|
|
|
|
|
0
|
next; |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
=pod |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
Given a project with stacks indicated by 'j' parameters, hard-link the |
978
|
|
|
|
|
|
|
positions (only recognised by Hugin with layout mode code). |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
$pto->LinkStacks; |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=cut |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
sub LinkStacks |
985
|
|
|
|
|
|
|
{ |
986
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
987
|
0
|
|
|
|
|
0
|
for my $id (1 .. scalar @{$self->Image} -1) |
|
0
|
|
|
|
|
0
|
|
988
|
|
|
|
|
|
|
{ |
989
|
0
|
|
|
|
|
0
|
my $img = $self->Image->[$id]; |
990
|
0
|
|
|
|
|
0
|
my $found; |
991
|
0
|
|
|
|
|
0
|
for my $base_id (0 .. $id -1) |
992
|
|
|
|
|
|
|
{ |
993
|
0
|
0
|
|
|
|
0
|
next if $found; |
994
|
0
|
|
|
|
|
0
|
my $base_img = $self->Image->[$base_id]; |
995
|
0
|
0
|
|
|
|
0
|
next unless defined $img->{j}; |
996
|
0
|
0
|
|
|
|
0
|
if ($img->{j} eq $base_img->{j}) |
997
|
|
|
|
|
|
|
{ |
998
|
0
|
|
|
|
|
0
|
$img->{r} = "=$base_id"; |
999
|
0
|
|
|
|
|
0
|
$img->{p} = "=$base_id"; |
1000
|
0
|
|
|
|
|
0
|
$img->{y} = "=$base_id"; |
1001
|
0
|
|
|
|
|
0
|
$found = 1; |
1002
|
0
|
|
|
|
|
0
|
next; |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
} |
1006
|
|
|
|
|
|
|
} |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=pod |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
Return the angular distance in degrees between two images: |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
$deg = $pto->AngularDistance (3, 5); |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=cut |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
sub AngularDistance |
1017
|
|
|
|
|
|
|
{ |
1018
|
14
|
|
|
14
|
0
|
30
|
my $self = shift; |
1019
|
14
|
50
|
33
|
|
|
115
|
return undef unless ($_[0] =~ /^[0-9]+$/ and $_[1] =~ /^[0-9]+$/); |
1020
|
14
|
|
|
|
|
30
|
my $yaw_a = $self->Image->[$_[0]]->y ($self); |
1021
|
14
|
|
|
|
|
32
|
my $pitch_a = $self->Image->[$_[0]]->p ($self); |
1022
|
14
|
|
|
|
|
48
|
my $yaw_b = $self->Image->[$_[1]]->y ($self); |
1023
|
14
|
|
|
|
|
31
|
my $pitch_b = $self->Image->[$_[1]]->p ($self); |
1024
|
14
|
|
|
|
|
118
|
my $distance = great_circle_distance ($yaw_a * pi/180, pi/2 - ($pitch_a * pi/180), |
1025
|
|
|
|
|
|
|
$yaw_b * pi/180, pi/2 - ($pitch_b * pi/180)); |
1026
|
14
|
|
|
|
|
306
|
return $distance * 180/pi; |
1027
|
|
|
|
|
|
|
} |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=pod |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
Look at all photos and calculate an optimal pixel width for this panorama, |
1032
|
|
|
|
|
|
|
optionally supply a scaling factor: |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
$width = $pto->OptimalWidth (0.7); |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
This number is rounded up to the nearest multiple of 16 pixels. |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=cut |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
sub OptimalWidth |
1041
|
|
|
|
|
|
|
{ |
1042
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1043
|
0
|
|
0
|
|
|
|
my $factor = shift || 1; |
1044
|
0
|
|
|
|
|
|
my $pix_radius_max = 1; |
1045
|
0
|
|
|
|
|
|
for (@{$self->Image}) |
|
0
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
{ |
1047
|
0
|
|
|
|
|
|
my $pix_radius = $_->Radius ($self); |
1048
|
0
|
0
|
|
|
|
|
$pix_radius_max = $pix_radius if $pix_radius > $pix_radius_max; |
1049
|
|
|
|
|
|
|
} |
1050
|
0
|
|
|
|
|
|
my $pix_width; |
1051
|
0
|
|
|
|
|
|
my $rad_fov = Math::Trig::deg2rad ($self->Panorama->{v}); |
1052
|
0
|
0
|
|
|
|
|
$rad_fov = 2 * Math::Trig::pi() if $rad_fov == 0; |
1053
|
0
|
0
|
|
|
|
|
if ($self->Panorama->{f} == 0) |
1054
|
|
|
|
|
|
|
{ |
1055
|
0
|
0
|
|
|
|
|
return $self->Panorama->{w} if $self->Panorama->{v} >= 180; |
1056
|
0
|
|
|
|
|
|
$pix_width = 2 * $pix_radius_max * Math::Trig::tan ($rad_fov/2); |
1057
|
|
|
|
|
|
|
} |
1058
|
|
|
|
|
|
|
else |
1059
|
|
|
|
|
|
|
{ |
1060
|
0
|
|
|
|
|
|
$pix_width = $pix_radius_max * $rad_fov; |
1061
|
|
|
|
|
|
|
} |
1062
|
0
|
|
|
|
|
|
return int (($pix_width * $factor / 16) +1) * 16; |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=pod |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
Hugin ships with a tool called pano_trafo for querying the forward and reverse |
1068
|
|
|
|
|
|
|
transform for pixel coordinates in a PTO project. |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
Initialise this as a service, spawns two pano_trafo processes which are only |
1071
|
|
|
|
|
|
|
killed when the perl process finishes: |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
$pto->InitTrafo ('/path/to/project.pto'); |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
This is very unlikely to work on non-unixy systems. |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
=cut |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
sub InitTrafo |
1080
|
|
|
|
|
|
|
{ |
1081
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1082
|
0
|
|
0
|
|
|
|
my $path_pto = shift || return 0; |
1083
|
10
|
|
|
10
|
|
17453
|
use IPC::Open2; |
|
10
|
|
|
|
|
73543
|
|
|
10
|
|
|
|
|
742
|
|
1084
|
10
|
|
|
10
|
|
103
|
use Symbol; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
6917
|
|
1085
|
|
|
|
|
|
|
|
1086
|
0
|
|
0
|
|
|
|
my $pid_forward_old = $self->{trafo_forward}->{pid} || undef; |
1087
|
0
|
|
|
|
|
|
my $WTR_forward = gensym; |
1088
|
0
|
|
|
|
|
|
my $RDR_forward = gensym; |
1089
|
0
|
|
|
|
|
|
my $pid_forward = open2 ($RDR_forward, $WTR_forward, 'pano_trafo', $path_pto); |
1090
|
0
|
|
|
|
|
|
$self->{trafo_forward} = {pid => $pid_forward, WTR => $WTR_forward, RDR => $RDR_forward}; |
1091
|
|
|
|
|
|
|
|
1092
|
0
|
|
0
|
|
|
|
my $pid_reverse_old = $self->{trafo_reverse}->{pid} || undef; |
1093
|
0
|
|
|
|
|
|
my $WTR_reverse = gensym; |
1094
|
0
|
|
|
|
|
|
my $RDR_reverse = gensym; |
1095
|
0
|
|
|
|
|
|
my $pid_reverse = open2 ($RDR_reverse, $WTR_reverse, 'pano_trafo', '-r', $path_pto); |
1096
|
0
|
|
|
|
|
|
$self->{trafo_reverse} = {pid => $pid_reverse, WTR => $WTR_reverse, RDR => $RDR_reverse}; |
1097
|
|
|
|
|
|
|
|
1098
|
0
|
0
|
|
|
|
|
waitpid ($pid_forward_old, 0) if defined $pid_forward_old; |
1099
|
0
|
0
|
|
|
|
|
waitpid ($pid_reverse_old, 0) if defined $pid_reverse_old; |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=pod |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
Query the forward transform like so: |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
($X, $Y) = $pto->Trafo ($image_no, $x, $y); |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=cut |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
sub Trafo |
1111
|
|
|
|
|
|
|
{ |
1112
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1113
|
0
|
|
|
|
|
|
my ($image, $x, $y) = @_; |
1114
|
0
|
|
|
|
|
|
my $WTX = $self->{trafo_forward}->{WTR}; |
1115
|
0
|
|
|
|
|
|
my $RDX = $self->{trafo_forward}->{RDR}; |
1116
|
0
|
|
|
|
|
|
print $WTX join (' ', $image, $x, $y) . "\n"; |
1117
|
0
|
|
|
|
|
|
my $result = <$RDX>; |
1118
|
0
|
|
|
|
|
|
chomp $result; |
1119
|
0
|
|
|
|
|
|
return split ' ', $result; |
1120
|
|
|
|
|
|
|
} |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
=pod |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
Query the reverse transform like so: |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
($x, $y) = $pto->TrafoReverse ($image_no, $X, $Y); |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=cut |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
sub TrafoReverse |
1131
|
|
|
|
|
|
|
{ |
1132
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1133
|
0
|
|
|
|
|
|
my ($image, $x, $y) = @_; |
1134
|
0
|
|
|
|
|
|
my $WTX = $self->{trafo_reverse}->{WTR}; |
1135
|
0
|
|
|
|
|
|
my $RDX = $self->{trafo_reverse}->{RDR}; |
1136
|
0
|
|
|
|
|
|
print $WTX join (' ', $image, $x, $y) . "\n"; |
1137
|
0
|
|
|
|
|
|
my $result = <$RDX>; |
1138
|
0
|
|
|
|
|
|
chomp $result; |
1139
|
0
|
|
|
|
|
|
return split ' ', $result; |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
Copyright (c) 2001 Bruno Postle . All Rights Reserved. |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
1147
|
|
|
|
|
|
|
modify it under the terms of the GNU General Public |
1148
|
|
|
|
|
|
|
License as published by the Free Software Foundation; either |
1149
|
|
|
|
|
|
|
version 2 of the License, or (at your option) any later version. |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
This software is distributed in the hope that it will be useful, |
1152
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
1153
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
1154
|
|
|
|
|
|
|
General Public License for more details. |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public |
1157
|
|
|
|
|
|
|
License along with this software; if not, write to the Free Software |
1158
|
|
|
|
|
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=cut |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
1; |
1163
|
|
|
|
|
|
|
|