Bruno, thanks for your feedback on this.

I’ve modified you ptodouble to create ptoscale (see below). Will this work? 
Feel free to do with this as you please.


> #!/usr/bin/perl
> use strict;
> use warnings;
> use Panotools::Script;
> use Getopt::Long;
> use Pod::Usage;
> 
> my $scale_pair;
> my $path_output;
> my $help = 0;
> 
> GetOptions (’s|scale=s’ => \$scale_pair,
>             'o|output=s' => \$path_output,
>             'h|help' => \$help);
> 
> pod2usage (-verbose => 2) if $help;
> 
> my $path_pto = shift || pod2usage;
> die "Can't find $path_pto" unless -e $path_pto;
> 
> my @Ratio = split ('/', $scale_pair);
> my $R = $Ratio[0] / $Ratio[1];
> 
> my $p = new Panotools::Script;
> $p->Read ($path_pto);
> 
> $p->Panorama->{w} *= $R;
> $p->Panorama->{h} *= $R;
> 
> for my $i (@{$p->Image})
> {
>     $i->{w} *= $R;
>     $i->{h} *= $R;
>     $i->{d} *= $R if $i->{d} =~ /^[-0-9.]+$/;
>     $i->{e} *= $R if $i->{e} =~ /^[-0-9.]+$/;
>     $i->{Vx} *= $R if $i->{Vx} =~ /^[-0-9.]+$/;
>     $i->{Vy} *= $R if $i->{Vy} =~ /^[-0-9.]+$/;
> 
>     if (defined $i->{S})
>     {
>         my @S = split (',', $i->{S});
>         @S = map {int ($_ * $R)} @S;
>         $i->{S} = join ',', @S;
>     }
> }
> 
> for my $c (@{$p->Control})
> {
>     $c->{x} *= $R;
>     $c->{y} *= $R;
>     $c->{X} *= $R;
>     $c->{Y} *= $R;
> }
> 
> for my $k (@{$p->Mask})
> {
>     my $string = $k->{p};
>     $string =~ s/"//g;
>     my @p = split (' ', $string);
>     @p = map {int ($_ * $R)} @p;
>     $k->{p} = '"'. (join ' ', @p) .'"';
> }
> 
> $p->Write ($path_output);
> 
> exit 0;
> 
> __END__
> 
> =head1 NAME
> 
> ptoscale - rescale a panorama project
> 
> =head1 SYNOPSIS
> 
> ptoscale [options] --output scaled.pto project.pto
> 
>  Options:
>   -s | --scale      Scale ratio (in the format m/n; m = new long side, n = 
> old long side)
>   -o | --output     Filename of scaled project (can be the the same as the 
> input)
>   -h | --help       Outputs help documentation
> 
> =head1 DESCRIPTION
> 
> B<ptoscale> takes a hugin .pto project and scales all pixel dimensions by the 
> ratio given (--scale).
> You will need to rescale the photos to match:
> 
>   mogrify -geometry {m/n}% *.JPG
> 
> Note, this tool is useful in conjunction with the L<ptodouble> and 
> L<ptohalve> tools which
> perform the specific scaling of 2 and 0.5 respectively.
> 
> =head1 LICENSE
> 
> This program is free software; you can redistribute it and/or
> modify it under the terms of the GNU General Public License
> as published by the Free Software Foundation; either version 2
> of the License, or (at your option) any later version.
> 
> =head1 SEE ALSO
> 
> L<http://hugin.sourceforge.net/>
> 
> L<ptodouble>
> 
> L<ptohalve>
> 
> =head1 AUTHOR
> 
> Donald Johnston; modified from Bruno Postle’s ptodouble - July 2016.
> 
> =cut






> On Jul 9, 2016, at 4:48 PM, Bruno Postle <[email protected]> wrote:
> 
> 
> 
> On 9 July 2016 23:15:04 BST, Donald Johnston wrote:
>> is there a script or program available that can scale the parameters in
>> a PTO file?
> 
> See ptohalve and prodouble in the Panotools:: Script Perl module, these 
> mostly do what you want.
> 
> -- 
> Bruno
> 
> -- 
> A list of frequently asked questions is available at: 
> http://wiki.panotools.org/Hugin_FAQ
> --- 
> You received this message because you are subscribed to the Google Groups 
> "hugin and other free panoramic software" group.
> To unsubscribe from this group and stop receiving emails from it, send an 
> email to [email protected].
> To view this discussion on the web visit 
> https://groups.google.com/d/msgid/hugin-ptx/6CB7B73D-9353-4E29-B122-9CB6CBCACCD0%40postle.net.
> For more options, visit https://groups.google.com/d/optout.

-- 
A list of frequently asked questions is available at: 
http://wiki.panotools.org/Hugin_FAQ
--- 
You received this message because you are subscribed to the Google Groups 
"hugin and other free panoramic software" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to [email protected].
To view this discussion on the web visit 
https://groups.google.com/d/msgid/hugin-ptx/1107DB39-38E8-477B-88B8-EEB25E307D86%40accesscomm.ca.
For more options, visit https://groups.google.com/d/optout.

Reply via email to