view release on metacpan or  search on metacpan

lib/App/Guiio/Dialogs.pm  view on Meta::CPAN

package App::Guiio ;
$|++ ;

use strict;
use warnings;

use Data::TreeDumper ;
use Data::TreeDumper::Renderer::GTK ;
use Module::Util qw(find_installed) ;
use File::Basename ;
#-----------------------------------------------------------------------------

sub get_color_from_user
{
my ($self, $previous_color) = @_ ;

my $color = Gtk2::Gdk::Color->new (@{$previous_color});
my $dialog = Gtk2::ColorSelectionDialog->new ("Changing color");

my $colorsel = $dialog->colorsel;

$colorsel->set_previous_color ($color);
$colorsel->set_current_color ($color);
$colorsel->set_has_palette (TRUE);

my $response = $dialog->run;

if ($response eq 'ok') 
	{
	$color = $colorsel->get_current_color;
	}

$dialog->destroy;

return [$color->red, $color->green , $color->blue]  ;
}

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

sub show_dump_window
{
my ($self, $data, $title, @dumper_setup) = @_ ;

my $treedumper = Data::TreeDumper::Renderer::GTK->new
				(
				data => $data,
				title => $title,
				dumper_setup => {@dumper_setup}
				);
		
$treedumper->modify_font(Gtk2::Pango::FontDescription->from_string ('monospace'));
$treedumper->collapse_all;

# some boilerplate to get the widget onto the screen...
my $window = Gtk2::Window->new;

my $scroller = Gtk2::ScrolledWindow->new;
$scroller->add ($treedumper);

$window->add ($scroller);
$window->set_default_size(640, 1000) ;
$window->show_all;
}

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

sub display_message_modal
{
my ($self, $message) = @_ ;

my $window = new Gtk2::Window() ;

my $dialog = Gtk2::MessageDialog->new 
	(
	$window,
	'destroy-with-parent' ,
	'info' ,
	'close' ,
	$message ,
	) ;

$dialog->signal_connect(response => sub { $dialog->destroy ; 1 }) ;
$dialog->run() ;
}

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

sub display_yes_no_cancel_dialog
{
my ($self, $title, $text) = @_ ;

my $window = new Gtk2::Window() ;

my $dialog = Gtk2::Dialog->new($title, $window, 'destroy-with-parent')  ;
$dialog->set_default_size (300, 150);
$dialog->add_button ('gtk-yes' => 'yes');
$dialog->add_button ('gtk-no' => 'no');
$dialog->add_button ('gtk-cancel' => 'cancel');

my $lable = Gtk2::Label->new($text);
$dialog->vbox->add ($lable);
$lable->show;

my $result = $dialog->run() ;

$dialog->destroy ;

return $result ;
}

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

lib/App/Guiio/Dialogs.pm  view on Meta::CPAN

        $button->show;

        $dialog->add_action_widget ($button, $response_id);
}

#
# Create a button with a stock icon but with non-stock text.
#
sub create_button {
	# code by Muppet, j2simpso
        my ($text, $stock_id,$is_file) = @_;

        my $button = Gtk2::Button->new ();
        my $image = Gtk2::Image->new();
        #
        # This setup is cribbed from gtk_button_construct_child()
        # in gtkbutton.c.  It does not handle all the details like
        # left-to-right ordering and alignment and such, as in the
        # real button code.
        #
		# the if_file parameter specifies whether whether to treat $stock_id as a image_ID of a path to an image file (TRUE if path for image file)
		$is_file = FALSE unless defined $is_file;
		
		if (!$is_file){
		    $image = Gtk2::Image->new_from_stock ($stock_id, 'button');
			}
        else{
			$image = Gtk2::Image->new_from_file($stock_id);
			}
			
		my $label = Gtk2::Label->new ($text); # accepts mnemonics
        $label->set_mnemonic_widget ($button);

        my $hbox = Gtk2::HBox->new ();
        $hbox->pack_start ($image, FALSE, FALSE, 0);
        $hbox->pack_start ($label, FALSE, FALSE, 0);

        $hbox->show_all ();

        $button->add ($hbox);

        return $button;
}


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

sub display_edit_dialog
{
my ($self, $title, $text) = @_ ;

$text ='' unless defined $text ;

my $window = new Gtk2::Window() ;

my $dialog = Gtk2::Dialog->new($title, $window, 'destroy-with-parent')  ;
$dialog->set_default_size (300, 150);
$dialog->add_button ('gtk-ok' => 'ok');

my $textview = Gtk2::TextView->new;
$textview->modify_font (Gtk2::Pango::FontDescription->from_string ('monospace 10'));

my $buffer = $textview->get_buffer;
 $buffer->insert ($buffer->get_end_iter, $text);

$dialog->vbox->add ($textview);
$textview->show;

#
# Set up the dialog such that Ctrl+Return will activate the "ok"  response. Muppet
#
#~ my $accel = Gtk2::AccelGroup->new;
#~ $accel->connect
		#~ (
		#~ Gtk2::Gdk->keyval_from_name ('Return'), ['control-mask'], [],
                #~ sub { $dialog->response ('ok'); }
		#~ );
		
#~ $dialog->add_accel_group ($accel);

$dialog->run() ;

my $new_text =  $textview->get_buffer->get_text($buffer->get_start_iter, $buffer->get_end_iter, TRUE) ;

$dialog->destroy ;

return $new_text
}

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

sub get_file_name
{
my ($self, $type) = @_ ;

my $file_name = '' ;

my $file_chooser = Gtk2::FileChooserDialog->new 
				(
				$type, undef, $type,
				'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok'
				);

$file_name = $file_chooser->get_filename if ('ok' eq $file_chooser->run) ;
	
$file_chooser->destroy;

return $file_name ;
}

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

sub display_box_edit_dialog
{
my ($rows, $title, $text) = @_ ;

my $window = new Gtk2::Window() ;

my $dialog = Gtk2::Dialog->new('Box attributes', $window, 'destroy-with-parent')  ;
$dialog->set_default_size (450, 305);
$dialog->add_button ('gtk-ok' => 'ok');

#~ my $vbox = $dialog->vbox ;
my $dialog_vbox = $dialog->vbox ;

my $vbox = Gtk2::VBox->new (FALSE, 5);
$dialog_vbox->pack_start ($vbox, TRUE, TRUE, 0);

$vbox->pack_start (Gtk2::Label->new (""),
		 FALSE, FALSE, 0);

my $sw = Gtk2::ScrolledWindow->new;
$sw->set_shadow_type ('etched-in');
$sw->set_policy ('automatic', 'automatic');
$vbox->pack_start ($sw, TRUE, TRUE, 0);

# create model
my $model = create_model ($rows);

# create tree view
my $treeview = Gtk2::TreeView->new_with_model ($model);
$treeview->set_rules_hint (TRUE);
$treeview->get_selection->set_mode ('single');

add_columns($treeview, $rows);

$sw->add($treeview);

# title
my $titleview = Gtk2::TextView->new;
$titleview->modify_font (Gtk2::Pango::FontDescription->from_string ('monospace 10'));
my $title_buffer = $titleview->get_buffer ;
$title_buffer->insert ($title_buffer->get_end_iter, $title);

$vbox->add ($titleview);
$titleview->show;

# text 
my $textview = Gtk2::TextView->new;
$textview->modify_font (Gtk2::Pango::FontDescription->from_string ('monospace 10'));

my $text_buffer = $textview->get_buffer;
$text_buffer->insert ($text_buffer->get_end_iter, $text);

$vbox->add ($textview) ;
$textview->show() ;

# Focus and select, code by Tian
$text_buffer->select_range($text_buffer->get_start_iter, $text_buffer->get_end_iter);
$textview->grab_focus() ;


# some buttons
#~ my $hbox = Gtk2::HBox->new (TRUE, 4);
#~ $vbox->pack_start ($hbox, FALSE, FALSE, 0);

#~ my $button = Gtk2::Button->new ("Add item");
#~ $button->show() ;
#~ $button->signal_connect (clicked => \&add_item, $model);
#~ $hbox->pack_start ($button, TRUE, TRUE, 0);

#~ $button = Gtk2::Button->new ("Remove item");
#~ $button->signal_connect (clicked => \&remove_item, $treeview);
#~ $hbox->pack_start ($button, TRUE, TRUE, 0);

#~ $hbox->show() ;

$treeview->show() ;
$vbox->show() ;
$sw->show() ;

$dialog->run() ;

my $new_text =  $textview->get_buffer->get_text($text_buffer->get_start_iter, $text_buffer->get_end_iter, TRUE) ;
my $new_title =  $titleview->get_buffer->get_text($title_buffer->get_start_iter, $title_buffer->get_end_iter, TRUE) ;

$dialog->destroy ;

return($new_text, $new_title) ;
}

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

sub create_model 
{
my ($rows) = @_ ;

my $model = Gtk2::ListStore->new(qw/Glib::Boolean Glib::String  Glib::String Glib::String Glib::String Glib::Boolean/);

foreach my $row (@{$rows}) 
	{
	my $iter = $model->append;

	my $column = 0 ;
	$model->set ($iter, map {$column++, $_} @{$row}) ;
	}

return $model;
}