#!/usr/bin/perl -w # Iouri Ivliev 2008 use strict; use Getopt::Std; use Panotools::Script; $Getopt::Std::STANDARD_HELP_VERSION = 1; our $VERSION = "0.0.2 (using Panotools::Script $Panotools::Script::VERSION)"; our ($opt_C,$opt_I,$opt_M,$opt_P,$opt_V) = (undef, undef, undef, undef, undef); our ($opt_O,$opt_i,$opt_o,$opt_r,$opt_s) = (0, undef, undef, undef, undef); getopts 'C:I:M:P:V:O:io:rs'; (HELP_MESSAGE(\*STDERR),die "No input script\n") if $#ARGV<0; (HELP_MESSAGE(\*STDERR),die "Only one input script allowed\n") if $#ARGV>0; sub HELP_MESSAGE { my $h = shift; my ($cmd) = ($0 =~ m,([^/\\]+)$,); print $h < Options are: -C - set control point line(s) variables -I - set input image line(s) variables -M - set mode line variables -O - verbosity flags 0x01 - script info 0x02 - panorama and mode info 0x04 - images info 0x08 - control points info -P - set panorama line variables -V - set optimisation line(s) variables -i - update input image line(s) based on PToptimiser output line(s) implies -r -o - output script file -r - remove output line(s) and morph control point(s) -s - remove variables unrecognized by PToptimiser EOM } sub VERSION_MESSAGE { my $h = shift; my ($cmd) = ($0 =~ m,([^/\\]+)$,); print $h <Read($ARGV[0]); my ($p,$m) = ($P->Panorama,$P->Mode); my ($i,$c,$o) = ($P->Image,$P->Control,$P->Output); my ($in,$cn,$on) = (1+$#{$i},1+$#{$c},1+$#{$o}); my $v = $P->Variable; verbose 0x02,"Output panorama: %dx%d (HFOV: %d)\n",$p->{w},$p->{h},$p->{v}; verbose 0x02,"Input images ('i'): $in; Output images ('o'): $on\n"; verbose 0x02,"Control points ('c'): $cn\n"; $P->Output2Image if (!$in or $opt_i) and $on; if (defined $opt_P) { verbose 0x8000,"DEBUG: panorama line variables '%s'\n",$opt_P; my %p = split /:/,$opt_P; foreach (keys %p) { my $val = $p{$_}; verbose 0x8000,"DEBUG: vars = '%s'; val = '%s'\n",$_,$val; my @v = getvars $_; verbose 0x8000,"DEBUG: vars = %s\n",join ',',@v; my $valid = Panotools::Script::Line::Panorama::_valid; foreach my $vn (@v) { $vn =~ /$valid/ or die "Incorrect panorama line variables syntax: expecting :[::]\n\tvars are $valid\n"; verbose 0x02, "Panorama variable %s: %s => %s\n", $vn,defined($p->{$vn})?$p->{$vn}:'',$val; $p->{$vn} = $val; } } } if (defined $opt_M) { verbose 0x8000,"DEBUG: mode line variables '%s'\n",$opt_M; my %m = split /:/,$opt_M; foreach (keys %m) { my $val = $m{$_}; verbose 0x8000,"DEBUG: vars = '%s'; val = '%s'\n",$_,$val; my @v = getvars $_; verbose 0x8000,"DEBUG: vars = %s\n",join ',',@v; my $valid = Panotools::Script::Line::Mode::_valid; foreach my $vn (@v) { $vn =~ /$valid/ or die "Incorrect mode line variables syntax: expecting :[::]\n\tvars are $valid\n"; verbose 0x02, "Mode variable %s: %s => %s\n", $vn,defined($m->{$vn})?$m->{$vn}:'',$val; $m->{$vn} = $val; } } } if (defined $opt_I) { verbose 0x8000,"DEBUG: input image line(s) variables '%s'\n",$opt_I; my %i = split /:/,$opt_I; foreach (keys %i) { my ($vars,$imgs) = split /\//,$_; my $val = $i{$_}; verbose 0x8000,"DEBUG: vars = '%s'; imgs = '%s'\n",$vars,$imgs; my @v = getvars $vars; verbose 0x8000,"DEBUG: vars = %s\n",join ',',@v; my @i = getnums $in,$imgs; verbose 0x8000,"DEBUG: imgs = %s\n",join ',',@i; my $valid = Panotools::Script::Line::Image::_valid; foreach my $vn (@v) { $vn =~ /$valid/ or die "Incorrect input image line(s) variables syntax: expecting /:[:/:]\n\tvars are $valid\n"; foreach my $ii (@i) { my $nv = $val; $nv = sprintf $val,$ii if $vn eq 'n'; verbose 0x04, "Input image %d variable %s: %s => %s\n", $ii,$vn, defined($i->[$ii]->{$vn})?$i->[$ii]->{$vn}:'', $nv; $i->[$ii]->{$vn} = $nv; } } } } if (defined $opt_V) { delete @$v{keys %$v}; verbose 0x8000,"DEBUG: optimisation line(s) variables '%s'\n",$opt_V; foreach (split /:/,$opt_V) { my ($vars,$imgs) = split /\//,$_; verbose 0x8000,"DEBUG: vars = '%s'; imgs = '%s'\n",$vars,$imgs; my @v = getvars $vars; verbose 0x8000,"DEBUG: vars = %s\n",join ',',@v; my @i = getnums $in,$imgs; verbose 0x8000,"DEBUG: imgs = %s\n",join ',',@i; my $valid = Panotools::Script::Line::Variable::_valid; foreach my $vn (@v) { $vn =~ /$valid/ or die "Incorrect optimisation line(s) variables syntax: expecting /[:/]\n\tvars are $valid\n"; foreach my $ii (@i) { $v->{$ii}->{$vn} = 1; if (defined($i->[$ii]->{$vn}) and $i->[$ii]->{$vn} eq '=0') { $i->[$ii]->{$vn} = 0; verbose 0x04, "Input image %d variable %s: =0 => 0\n",$ii,$vn; } } } } } if (defined $opt_C) { verbose 0x8000,"DEBUG: control point line(s) variables '%s'\n",$opt_C; my %c = split /:/,$opt_C; foreach (keys %c) { my ($vars,$cps) = split /\//,$_; my $val = $c{$_}; verbose 0x8000,"DEBUG: vars = '%s'; imgs = '%s'\n",$vars,$cps; my @v = getvars $vars; verbose 0x8000,"DEBUG: vars = %s\n",join ',',@v; my @c = getnums $cn,$cps; verbose 0x8000,"DEBUG: imgs = %s\n",join ',',@c; my $valid = Panotools::Script::Line::Control::_valid; foreach my $vn (@v) { $vn =~ /$valid/ or die "Incorrect control point line(s) variables syntax: expecting /:[:/:]\n\tvars are $valid\n"; foreach my $ci (@c) { verbose 0x04, "Control point %d variable %s: %s => %s\n", $ci,$vn, defined($c->[$ci]->{$vn})?$c->[$ci]->{$vn}:'', $val; $c->[$ci]->{$vn} = $val; } } } } exit 0 unless defined $opt_o; verbose 0x10,"Saving $opt_o\n"; if ($opt_s) { delete $p->{E}; delete $p->{R}; delete $p->{S}; delete @$_{qw(Eb Eev Er Ra Rb Rc Rd Re Va Vb Vc Vd Vx Vy)} for @$i; } if ($opt_r or $opt_i) { splice @$o,0; splice @{$P->ControlMorph},0; } $P->Write($opt_o);