Geo-Raster
view release on metacpan or search on metacpan
lib/Geo/Raster/Layer.pm view on Meta::CPAN
our @ISA = qw(Exporter Geo::Raster Gtk2::Ex::Geo::Layer);
our %EXPORT_TAGS = ( 'all' => [ qw( %EPSG ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();
our $VERSION = 0.03;
use vars qw/%EPSG @EPSG/;
sub registration {
my $dialogs = Geo::Raster::Layer::Dialogs->new();
my $commands = [
tag => 'raster',
label => 'Raster',
tip => 'Open a raster dataset or save all libral rasters.',
{
label => 'Open...',
tip => 'Add a new raster layer.',
sub => \&open_raster
},
{
label => 'Save all',
tip => 'Save all libral raster layers.',
sub => \&save_all_rasters
}
];
return { dialogs => $dialogs, commands => $commands };
}
sub open_raster {
my(undef, $gui) = @_;
my $file_chooser =
Gtk2::FileChooserDialog->new ('Select a raster file',
undef, 'open',
'gtk-cancel' => 'cancel',
'gtk-ok' => 'ok');
$file_chooser->set_select_multiple(1);
$file_chooser->set_current_folder($gui->{folder}) if $gui->{folder};
my @filenames = $file_chooser->get_filenames if $file_chooser->run eq 'ok';
$gui->{folder} = $file_chooser->get_current_folder();
$file_chooser->destroy;
return unless @filenames;
for my $filename (@filenames) {
my $dataset = Geo::GDAL::Open($filename);
croak "$filename is not recognized by GDAL" unless $dataset;
my $bands = $dataset->{RasterCount};
for my $band (1..$bands) {
my $layer = Geo::Raster::Layer->new(filename => $filename, band => $band);
my $name = fileparse($filename);
$name =~ s/\.\w+$//;
$name .= "_$band" if $bands > 1;
$gui->add_layer($layer, $name, 1);
$gui->{overlay}->render;
}
}
$gui->{tree_view}->set_cursor(Gtk2::TreePath->new(0));
}
sub save_all_rasters {
my(undef, $gui) = @_;
my @rasters;
if ($gui->{overlay}->{layers}) {
for my $layer (@{$gui->{overlay}->{layers}}) {
if (blessed($layer) and $layer->isa('Geo::Raster')) {
next if $layer->{GDAL};
push @rasters, $layer;
}
}
}
croak('No libral layers to save.') unless @rasters;
my $uri = file_chooser('Save all rasters into folder', 'select_folder');
if ($uri) {
for my $layer (@rasters) {
#my $filename = File::Spec->catfile($uri, $layer->name);
my $filename = File::Spec->catfile($gui->{folder}, $layer->name);
my $save = 1;
if ($layer->exists($filename)) {
my $dialog = Gtk2::MessageDialog->new(undef,'destroy-with-parent',
'question',
'yes_no',
"Overwrite existing $filename?");
my $ret = $dialog->run;
$save = 0 if $ret eq 'no';
$dialog->destroy;
}
$layer->save($filename) if $save;
}
}
}
## @ignore
sub upgrade {
my($object) = @_;
if (blessed($object) and $object->isa('Geo::Raster') and !(blessed($object) and $object->isa('Geo::Raster::Layer'))) {
bless($object, 'Geo::Raster::Layer');
$object->defaults();
return 1;
}
return 0;
}
## @ignore
sub new {
my($package, %params) = @_;
my $self = Geo::Raster::new($package, %params);
Gtk2::Ex::Geo::Layer::new($package, self => $self, %params);
return $self;
}
## @ignore
sub DESTROY {
my $self = shift;
return unless $self;
Geo::Raster::DESTROY($self);
Gtk2::Ex::Geo::Layer::DESTROY($self);
}
## @ignore
( run in 1.073 second using v1.01-cache-2.11-cpan-39bf76dae61 )