vterl

#!/usr/bin/env perl

use strict;
use Glib qw(TRUE FALSE);
use Gtk2 -init;
use Gnome2::Vte;

my $ventana = Gtk2::Window->new;
$ventana->set_default_size(300, 200);
$ventana->set_border_width(5);
my $terminal = Gnome2::Vte::Terminal->new;
#$terminal->set_scroll_background (TRUE); # Hacer que se mueva el fondo de pantalla

my $archivo = Gtk2::Menu->new;
my $opciones = Gtk2::Menu->new;

my $cambiar_fondo = Gtk2::MenuItem->new( '_Fondo' );
$cambiar_fondo->signal_connect( activate => \&cambiar_fondo );
my $exit = Gtk2::MenuItem->new( '_Salir' );
$exit->signal_connect( activate => sub{ Gtk2::main_quit } );
my $about = Gtk2::MenuItem->new( '_Acerca de...' );
$about->signal_connect( activate => \&acerca_De );

$opciones->append( $cambiar_fondo );
$opciones->append( $exit);
$archivo->append( $about );

my $menu1 = Gtk2::MenuItem->new( '_Archivo' );
$menu1->set_submenu( $opciones );
my $menu2 = Gtk2::MenuItem->new( 'A_yuda' );
$menu2->set_submenu( $archivo );

my $menubar = Gtk2::MenuBar->new;
$menubar->append( $menu1 );
$menubar->append( $menu2 );

my $vbox = Gtk2::VBox->new;
$vbox->pack_start ($menubar, TRUE, TRUE, 0);
$vbox->pack_start ($terminal, TRUE, TRUE, 0);

$ventana->add ($vbox);
$ventana->show_all;

$terminal->fork_command ('/bin/bash', ['bash', '-login'], undef,
                           '~', FALSE, FALSE, FALSE);
$terminal->signal_connect (child_exited => sub { Gtk2->main_quit });

$ventana->signal_connect (delete_event =>
                           sub { Gtk2->main_quit; FALSE });

Gtk2->main;

sub cambiar_fondo {

my $imagen_de_fondo = Gtk2::FileChooserDialog->new( 'Elije una imagen...', undef, 'open',
'gtk-ok' => 'ok',
'gtk-cancel' => 'cancel' );

if( $imagen_de_fondo->run eq 'ok' ) {
my $imagen = $imagen_de_fondo->get_filename;
$terminal->set_background_image_file ($imagen);
$imagen_de_fondo->destroy;

} else { print "Error\n";}
}

sub acerca_De {
my $acerca_DE = Gtk2::Dialog->new( 'Acerca de...', undef, 'modal',
                   'gtk-ok' => 'ok' );

my $acerca =<<EOF;

Gtk2/Vte

Terminal : Perl para GNU/Linux

Por: Atheyus

EOF

$acerca_DE->vbox->pack_start( Gtk2::Label->new( $acerca ), FALSE, FALSE, 7 );
$acerca_DE->vbox->show_all;

if ($acerca_DE->run) { $acerca_DE->destroy }
return TRUE;
}