#!/usr/bin/perl
#
# app1.pl
#
# Autor: Marco Antonio Manzo <[email protected]>
#
# Descripción:
# Programa2 de ejemplo - Tutorial Gtk2-Perl
#
# Licencia:
# Este programa puede ser redistribuido y/o modificado bajo
# los mismos términos de la licencia artística de Perl.
#
use strict;
use warnings;
use File::Basename 'basename';
use Glib qw( TRUE FALSE );
use Gtk2 '-init';
sub _init {
my( $window, $menu, $vbox, $statusbar, $params, $img, $footer );
# Utilizamos Gtk2::Image para guardar el buffer actual de la imágen
# y Gtk2::Label para el nombre del archivo y su tamaño.
$img = Gtk2::Image->new,
$footer = Gtk2::Label->new( 'Tutorial Gtk2-Perl' );
# Creamos todo nuestro entorno utilizando funciones hechas por
# nosotros para encapsular los objetos.
$window = create_window_space();
# Utilizamos un hashref con los objetos que queremos ir modificando en el
# transcurso. Principalmente a la hora de seleccionar un nuevo archivo.
# Es decir, guardar persistencia entre dichos objetos.
$params = {
img => $img,
footer => $footer,
window => $window
};
$menu = create_menu_bar( $params );
$statusbar = create_statusbar();
# Agrupamos nuestros objetos de en una caja vertical. Entre el menú
# y nuestra imagen a abrir ponemos una línea horizonal para separarlos.
# Nuestro programa también cuenta por supuesto con una barra de estado!
$vbox = Gtk2::VBox->new( FALSE, 0 );
$vbox->pack_start( $menu, FALSE, FALSE, 3 );
$vbox->pack_start( Gtk2::HSeparator->new, FALSE, FALSE, 3 );
$vbox->pack_start( $img, FALSE, FALSE, 3 );
$vbox->pack_start( $footer, FALSE, FALSE, 3 );
$vbox->pack_end( $statusbar, FALSE, FALSE, 3 );
# Agregamos nuestra caja vertical a la ventana, y mostramos todo.
$window->add( $vbox );
$window->show_all;
return;
}
# Encapsulamos la creación de nuestra ventana, le establecemos algunos
# atributos y el manejador del evento destroy. Regresamos el objeto
# creado.
sub create_window_space {
my $window = Gtk2::Window->new( 'toplevel' );
$window->set_border_width( 4 );
$window->set_default_size( 300, 400 );
$window->signal_connect( destroy => sub{ Gtk2->main_quit } );
return $window;
}
# Creamos nuestra barra de menú con la ayuda de Gtk2::Menu, Gtk2::MenuItem
# y Gtk2::MenuBar.
sub create_menu_bar {
my $args = shift;
# Creamos algunos objetos contenedores de elementos para el menú,
# en este caso submenús.
my $file_menulist = Gtk2::Menu->new;
my $help_menulist = Gtk2::Menu->new;
# Creamos cada uno de esos elementos los cuales serán desplegados
# al seleccionar cada uno de los menús y establecemos sus respectivos
# manejadores para el evento de activación ('activate').
my $open_item = Gtk2::MenuItem->new( '_Abrir' );
$open_item->signal_connect( activate => \&open_file, $args );
my $exit_item = Gtk2::MenuItem->new( '_Salir' );
$exit_item->signal_connect( activate => sub{ Gtk2::main_quit } );
my $about_item = Gtk2::MenuItem->new( '_Acerca de...' );
$about_item->signal_connect( activate => \&about_this );
# Agregamos los elementos creados a nuestros contenedores( submenús ).
$file_menulist->append( $open_item );
$file_menulist->append( $exit_item );
$help_menulist->append( $about_item );
# Ahora necesitamos generar aquellos nombres de elementos que contendrá
# nuestra barra de menú principal y le agregamos nuestros submenús.
my $file_menu = Gtk2::MenuItem->new( '_Archivo' );
$file_menu->set_submenu( $file_menulist );
my $help_menu = Gtk2::MenuItem->new( 'A_yuda' );
$help_menu->set_submenu( $help_menulist );
# Finalmente creamos nuestra barra de menú con todos los elementos
# fabricados y retornamos dicho objeto.
my $menubar = Gtk2::MenuBar->new;
$menubar->append( $file_menu );
$menubar->append( $help_menu );
return $menubar;
}
# Esta función es llamada al recibir el evento 'activated' del menú File->Open
# el cual genera un objeto Gtk2::FileChooserDialog que nos permitirá seleccionar
# un archivo( en nuestro caso imagen ) para abrirlo.
sub open_file {
# El primer elemento en @_ es el widget que emitió la señal, el segundo
# los parámetros.
my ( $widget, $args ) = @_;
my $fc = Gtk2::FileChooserDialog->new( 'Elije una imagen...', undef, 'open',
'gtk-ok' => 'ok',
'gtk-cancel' => 'cancel' );
# Al correr nuestro widget, y después de seleccionar el archivo y presionar
# el botón de OK, se genera el response 'ok' el cual manejamos con el siguiente
# bloque
if( $fc->run eq 'ok' ) {
my $file = $fc->get_filename;
my $fileinfo = sprintf( "[ %s %.2f K ]", basename( $file ),
( stat( $file ) )[7] / 1024 );
$args->{footer}->set_label( $fileinfo ); # Guardamos su nombre y tamaño
$args->{img}->set_from_file( $file ); # Tomamos el archivo elegido
# Le ayudamos a la ventana a crecer y principalmente decrecer de
# acuerdo al tamaño de la imagen.
$args->{window}->resize( $args->{img}->get_pixbuf->get_width,
$args->{img}->get_pixbuf->get_height );
}
$fc->destroy;
return TRUE;
}
# Nuestra barra de estado utilizando Gtk2::Statusbar.
sub create_statusbar {
my $stbar = Gtk2::Statusbar->new;
#El primer parametro de push() es el id de contexto de nuestra barra, el cual es un
#identificador único que se obtiene llamando get_context_id del mismo objeto.
$stbar->push( $stbar->get_context_id( 'statusbar' ), 'Tutorial Gtk2-Perl' );
return $stbar;
}
# Y claro... nuestro diálogo de Acerca de..., no nos olvidemos de nuestros créditos.
sub about_this {
my $about = Gtk2::Dialog->new( 'Acerca de...', undef, 'modal',
'gtk-ok' => 'ok' );
my $text =<<INFO;
Programa de prueba para
el Tutorial de Gtk2-Perl.
Autor: Marco Antonio Manzo
Consol 2005
INFO
# Podemos observar como un objeto Gtk2::Dialog contiene un vbox internamente
# para poder empaquetarle otros items.
$about->vbox->pack_start( Gtk2::Label->new( $text ), FALSE, FALSE, 4 );
$about->vbox->show_all;
# Simplemente, presionamos el botón y cerramos la ventana.
$about->destroy if $about->run;
return TRUE;
}
_init;
Gtk2->main;
syntax highlighted by Code2HTML, v. 0.9