#!/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