view release on metacpan or  search on metacpan

lib/Ask/Tk.pm  view on Meta::CPAN

use 5.008008;
use strict;
use warnings;

package Ask::Tk;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.015';

use Moo;
use Path::Tiny 'path';
use Tk;
use namespace::autoclean;

with 'Ask::API';

sub is_usable {
	my ( $self ) = @_;
	return !!$ENV{'DISPLAY'};
}

sub quality {
	return 30;
}

sub info {
	my ( $self, %o ) = @_;
	
	my $mw = "MainWindow"->new;
	$mw->withdraw;
	
	$o{messagebox_type} ||= 'ok';
	$o{messagebox_icon} ||= 'info';
	
	my $r = $mw->messageBox(
		-title   => $o{title} || '',
		-message => $o{text}  || '',
		-type    => $o{messagebox_type},
		-icon    => $o{messagebox_icon},
	);
	$mw->destroy;
	return $r;
} #/ sub info

sub warning {
	my ( $self, %o ) = @_;
	$self->info( messagebox_icon => 'warning', %o );
}

sub error {
	my ( $self, %o ) = @_;
	$self->info( messagebox_icon => 'error', %o );
}

sub question {
	my ( $self, %o ) = @_;
	'Ok' eq $self->info(
		messagebox_icon => 'question',
		messagebox_type => 'OkCancel',
		%o,
	);
}

sub entry {
	my ( $self, %o ) = @_;
	my $mw = "MainWindow"->new;
	
	$mw->Label( -text => $o{text} )->pack
		if exists $o{text};
		
	my $return = $o{entry_text};
	my $entry  = $mw->Entry(
		( -show => '*' )x!!( $o{hide_text} ),