The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

package main ;

use strict;
use warnings;

use Glib ':constants';
use Gtk2 -init;
Gtk2->init;

use App::Asciio ;

#-----------------------------------------------------------------------------

my $window = Gtk2::Window->new('toplevel');
$window->set_title("asciio");
$window->set_default_size(640, 480) ;
$window->signal_connect("destroy", sub { exit(0); });

my $vbox = Gtk2::VBox->new (FALSE, 0);
$window->add($vbox);

my $hpaned = Gtk2::HPaned->new;
$vbox->pack_start($hpaned, TRUE, TRUE, 0);
$hpaned->set_border_width (3);

my @asciios ;

my $asciio = new App::Asciio(50, 25) ;
push @asciios, $asciio ;

$hpaned->add1($asciio->{widget});
$vbox->show_all();
$window->show();

my ($command_line_switch_parse_ok, $command_line_parse_message, $asciio_config)
	= $asciio->ParseSwitches([@ARGV], 0) ;

die "Error: '$command_line_parse_message'!" unless $command_line_switch_parse_ok ;

$asciio->setup($asciio_config->{SETUP_INI_FILE}, $asciio_config->{SETUP_PATH}) ;

my ($character_width, $character_height) = $asciio->get_character_size() ;

if(defined $asciio_config->{TARGETS}[0])
	{
	$asciio->run_actions_by_name(['Open', $asciio_config->{TARGETS}[0]]) ;
	}
	
$asciio->set_modified_state(0) ;
$asciio->run_script($asciio_config->{SCRIPT}) ;
	
#--------------------------------------------------------------------------

$window->signal_connect (delete_event => \&delete_event, \@asciios) ;

sub delete_event
{
my ($window, $event, $asciios) = @_;
my $answer = 'yes';

my $should_save ;
for my $asciio (@{$asciios})
	{
	$should_save++ if $asciio->get_modified_state() ;
	}
	
if($should_save) 
	{
	$answer = App::Asciio::display_quit_dialog($window, 'asciio', ' ' x 25 . "Document is modified!\n\nAre you sure you want to quit and loose your changes?\n") ;
	}
	
if($answer eq 'save_and_quit')
	{
	for my $asciio (@{$asciios})
		{
		my @saved_result = $asciio->run_actions_by_name('Save') ;
		
		$answer = 'cancel' if(! defined $saved_result[0][0] || $saved_result[0][0] eq '') ;
		}
	}
	
return $answer eq 'cancel';
}

#--------------------------------------------------------------------------

Gtk2->main();