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 )