view release on metacpan or  search on metacpan

lib/Curses/UI.pm  view on Meta::CPAN

# Detect if we should use the new moushandler
if ($ENV{"TERM"} ne "xterm") {
    eval { require Curses::UI::Mousehandler::GPM;
	   import Curses::UI::Mousehandler::GPM; };
    if (!$@) {
	$Curses::UI::gpm_mouse = gpm_enable();
	print STDERR "DEBUG: gpm_mouse: " . $Curses::UI::gpm_mouse . "\n"
	    if $Curses::UI::debug;
    }
} else {
    # Detect ncurses functionality. Magic for Solaris 8
    eval { $Curses::UI::ncurses_mouse = (Curses->can('NCURSES_MOUSE_VERSION')
					 &&
					 (NCURSES_MOUSE_VERSION() >= 1 ) ) };
    print STDERR "DEBUG: Detected mouse support $Curses::UI::ncurses_mouse\n"
      if $Curses::UI::debug;
}



=head1 CONSTRUCTOR

Create a new Curses::UI object:

    my $cui = Curses::UI->new( OPTIONS );

where C<OPTIONS> is one or more of the following.

=head2 -clear_on_exit

If true, Curses::UI will call C<clear> on exit. Defaults to false.

=head2 -color_support

If true, Curses::UI tries to enable color for the
application. Defaults to false.

=head2 -compat

If true, Curses::UI will run in compatibility mode, meaning that only
very simple characters will be used for creating the widgets. Defaults
to false.

=head2 -keydelay

If set to a positive integer, Curses::UI will track elapsed seconds
since the user's last keystroke, preventing timer events from
occurring for the specified number of seconds afterwards. By default
this option is set to '0' (disabled).

=head2 -mouse_support

Curses::UI attempts to auto-discover if mouse support should be
enabled or not. This option allows a hard override. Expects a boolean
value.

=head2 -userdata

Takes a scalar (frequently a hashref) as its argument, and stows that
scalar inside the Curses::UI object where it can be retrieved with the
L<#userdata> method. Handy inside callbacks and the like.

=head2 -default_colors

Directs the underlying Curses library to allow use of default color
pairs on terminals. Is preset to true and you almost certainly don't
want to twiddle it. See C<man use_default_colors> if you think you do.

=cut

sub new {
    my ($class,%userargs) = @_;

    fatalerror("Curses::UI->new can only be called once!")
      if $Curses::UI::initialized;

    &Curses::UI::Common::keys_to_lowercase(\%userargs);

    my %args = (
        -compat        => 0,     # Use compatibility mode?
        -clear_on_exit => 0,     # Clear screen if program exits?
        -cursor_mode   => 0,     # What is the current cursor_mode?
	-debug         => undef, # Turn on debugging mode?
	-keydelay      => 0,     # Track seconds since last keystroke?
	-language      => undef, # Which language to use?
	-mouse_support => 1,     # Do we want mouse support
	-overlapping   => 1,     # Whether overlapping widgets are supported
	-color_support => 0,
	-default_colors=> 1,
        #user data
        -userdata       => undef,    #user internal data
	%userargs,
	-read_timeout   => -1,    # full blocking read by default
	-scheduled_code => [],
	-added_code     => {},
        -lastkey        => 0,     # Last keypress time (set in mainloop)
    );

    $Curses::UI::debug = $args{-debug}
        if defined $args{-debug};

    $Curses::UI::ncurses_mouse = $args{-mouse_support}
        if defined $args{-mouse_support};

    if ($Curses::UI::gpm_mouse && $args{-mouse_support}) {
	$Curses::UI::ncurses_mouse = 1;
	$args{-read_timeout} = 0.25;
    } else {
	$Curses::UI::gpm_mouse = 0;
    }

    my $self = bless { %args }, $class;

    my $lang = new Curses::UI::Language($self->{-language});
    $self->lang($lang);
    print STDERR "DEBUG: Loaded language: $lang->{-lang}\n"
	if $Curses::UI::debug;

    # Color support
    $Curses::UI::color_support = $args{-color_support} if
	defined $args{-color_support};