#!/usr/bin/perl

package TkApp;

use base qw(Class::Accessor);

use strict;
use warnings;
use FileHandle;
use Data::Dumper qw/Dumper/;
use Date::Format;
use Tk;
use Tk::Graph;
use PostScript::Convert qw/psconvert/;

__PACKAGE__->follow_best_practice();
__PACKAGE__->mk_accessors(qw(mw graph));

our $VERSION = 0.1;

=head1 NAME

TkApp - Demonstration of the export functionality of a canvas. Allows for
different export formats than ps via L<PostScript::Convert>.

=head1 SYNOPSIS

	use strict;
	use warnings;
	
	my $app = TkApp->new();
	$app->run();

=head1 DESCRIPTION

A Tk::Canvas provides the method L<Tk::Canvas/postscript> to export the
contents to postscript. This code provides an example of how to work with
that method and how to allow for other export formats as postscript. Other
export formats are provided via L<PostScript::Convert>. Unfortunately, it's
lacking support for jpg files. Please feel free to commit a patch :)

=head2 EXPORT

None by default.


=head1 METHODS

=head2 new()

Ctor. Calls _build_gui.

=cut

sub new {
	my $class = shift;
	
	my $self = bless({}, $class);
	
	my $mw = Tk::MainWindow->new();
	$self->set_mw($mw);
	
	$self->_build_gui();
	
	return $self;
} # /new




=head2 _build_gui()

Build GUI. Set up widgets etc. Positioning is done here, too.

Private method. Don't call it directly, as this will be done by new().

=cut

sub _build_gui {
	my $self = shift;
	my $mw = $self->get_mw();
	
	
	# -- menu
	my $menuitems = [
		[Cascade => "~File", -menuitems =>
			[
				[Button => "~ExportCanvas", -command => sub{
					return $self->btn_export_canvas();
				}],
				[Separator => ""],
				[Button => "~Exit", -command => sub{ exit(0); }],
			],
		],
	];
	my $menu = $mw->Menu(-menuitems => $menuitems);
	$mw->configure(-menu => $menu);
	
	
	# -- graph
	my $data = {
		 Sleep   => 51,
		 Work    => 135,
		 Access  => 124,
		 mySQL   => 5
	};

	my $ca = $mw->Graph(
		-type => 'BARS',
	)->pack(
		-expand => 1,
		-fill => 'both',
    );
	$ca->set($data);
	$self->set_graph($ca);

} # /_build_gui




=head2 btn_export_canvas()

Menu item for canvas export has been clicked. Display a file dialog.
Evaluate response. If filename is given, export the contents of the canvas to
this file. Returns 1 on successfull export, 0 otherwise.

If no file is given, export has been aborted. This will return 0.

TODO: this code is ugly. Someone split up the dialog and the export in separate
methods.
TODO: allow for more export formats, evaluate chosen filetype.
FIXME: the export as png file isn't readable.

=cut

sub btn_export_canvas {
	my $self = shift;
	
	# -- file dialog
	my $mw = $self->get_mw();
	my $types = [ ['PNG files', '.png'],
				  ['All Files',   '*'],];
	my $output_path = $mw->getSaveFile(
		-filetypes => $types, 
		-initialfile => time2str("%Y-%m-%d", time()) . '-export',
		-defaultextension => '.png',
	);
	
	return 0 unless $output_path;
	
	
	# -- actual export
	my $graph = $self->get_graph();
	my @all_items = $graph->find('all');
	my @bbox = $graph->bbox(@all_items);

	my $ps = $graph->postscript(
		'-x' 	=> $bbox[0],
		'-y'	=> $bbox[1],
		-width	=> $bbox[2] - $bbox[0],
		-height	=> $bbox[3] - $bbox[1],
	);
	psconvert(\$ps, $output_path, format => 'png');
	
	return 1;
} # /btn_export_canvas




=head2 run()

This actually starts the application, including the gui event loop.

=cut

sub run {
	my $self = shift;
	my $mw = $self->get_mw();
	
	$mw->MainLoop();
} # /run




=head1 SEE ALSO

L<Tk::Canvas>, L<PostScript::Convert>.

Inspired by a thread at L<http://www.perl-community.de>.

=head1 AUTHOR

A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by A. U. Thor

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself, either Perl version 5.8.8 or, at your option,
any later version of Perl 5 you may have available.

=cut

1;

use strict;
use warnings;

my $app = TkApp->new();
$app->run();