popup results from the CPAN

popup

Prima

view release on metacpan or search on metacpan

		if ($desired_item < 0 || $desired_item > $n) {
			$desired_item = 0 if $desired_item > $n;
			$desired_item = $n if $desired_item < 0;
			while (1) {
				my $object = $c->[$desired_item]->[OBJECT];
				last if $object && $object->selectable && $object->enabled;

				$desired_item += $direction_if_not_selectable;
				return if $desired_item < 0 || $desired_item > $n;
			}
		}
	}

	return if $desired_item == $self->selectedItem;
	$self->selectedItem($desired_item);
	return 1;
}

sub selectedItem
{
	return $_[0]->{selectedItem} unless $#_;
	my ( $self, $i) = @_;
	my $n = @{ $self->{cache} } - 1;
	$i = -1 if $i < 0;
	$i = $n if $i > $n;

	return if $i == $self->{selectedItem};
	my $old = $self->{selectedItem};
	$self->{selectedItem} = $i;
	$self->invalidate_rect( $self->get_item_rect($old) ) if $old >= 0;
	$self->invalidate_rect( $self->get_item_rect($i) )   if $i   >= 0;
}

sub enter_submenu
{
	my $self = shift;
	my $i = $self->selectedItem;
	return if $i < 0;

	if ( $self->{submenu} ) {
		return if $i == $self->{submenu_index};
		$self->{submenu}->cancel;
		undef $self->{submenu};
		undef $self->{submenu_index};
	}

	my ($itemid, $index);
	if ( defined ( $itemid = $self->{cache}->[$i]->[ITEMID] )) {
		return unless $self-> menu-> is_submenu($itemid);
		$index = 0;
	} else {
		$itemid = $self-> parent;
		$index  = $self-> parentIndex + @{ $self->{cache} } - 1;
	}

	$self->notify(qw(Submenu), $i);
	return unless $self->alive;

	$self->{submenu_index} = $i;

	my $submenu = $self->{submenu} = $self->insert( $self->root->popupClass,
		visible        => 0,
		root           => $self->root,
		parent         => $itemid,
		parentIndex    => $index,
		menu           => $self->menu,
		ownerColor     => 1,
		ownerBackColor => 1,
		ownerFont      => 1,
		( map { $_ , $self->$_() } 
			qw(hiliteColor hiliteBackColor disabledColor disabledBackColor)),
	);
	$submenu->origin($self->position_submenu);
	$submenu->show;
	$submenu->bring_to_front;
}

sub execute_selected
{
	my $self = shift;
	my $i = $self->selectedItem;
	return if $i < 0;

	my $cache = $self->{cache}->[$i];
	return $self-> enter_submenu if ! defined $cache->[ITEMID] or $self-> menu-> is_submenu($cache->[ITEMID]);

	$self->root->cancel;
	$cache->[OBJECT]-> execute if $cache->[OBJECT];
}

sub execute_item
{
	my ($self, $itemid) = @_;
	return unless defined $itemid;
	return $self-> enter_submenu if $self-> menu-> is_submenu($itemid);

	$self->root->cancel;
	$self->new_from_itemid( $itemid )->execute;
}

sub xy2item
{
	my ( $self, $x, $y ) = @_;

	my $c = $self->{cache};
	for ( my $i = 0; $i < @$c; $i++) {
		my ($X1,$Y1,$X2,$Y2) = @{ $c->[$i] };
		$X2 += $X1;
		$Y2 += $Y1;
		return $i if $x >= $X1 && $y >= $Y1 && $x <= $X2 && $y < $Y2;
	}

	return -1;
}

sub on_keydown
{
	my ( $self, $code, $key, $mod, $repeat) = @_;

	my $submenu = $self;
	my $level = 0;

Prima/Menus.pm view on Meta::CPAN

sub on_itemchanged
{
	my $self = shift;
	$self-> reset;
}

sub on_paint
{
	my ( $self, $canvas ) = @_;
	my @c = map { $self->colorIndex($_) } ci::NormalText .. ci::Dark3DColor;
	@c[ci::NormalText, ci::Normal] = @c[ci::DisabledText, ci::Disabled] unless $self->enabled;
	my @sz = $self->size;
	my $caches = $self->{cache};
	if ( $self->{vertical} ) {
		$self->rect_bevel( $canvas, 0, 0, $sz[0]-1, $sz[1]-1,
			width => $self->{borderSize}, 
			fill => $c[ci::Normal],
		);
	} else {
		$self->clear;
	}

	for ( my $i = 0; $i < @$caches; $i++) {
		my $cache = $caches->[$i];
		next unless $cache->[OBJECT];
		my @o = @{$cache}[X, Y];
		my @s = @{$cache}[WIDTH, HEIGHT];
		$cache->[OBJECT]->draw( $canvas, \@c, @$cache[X,Y,WIDTH,HEIGHT], $i == $self->{selectedItem});
	}
}

sub new_from_itemid
{
	my ( $self, $itemid ) = @_;
	return $self->root->{itemClass}-> new_from_itemid(
		$self-> root->menu, $itemid,
		vertical => $self->vertical,
	);
}

sub new_guillemots
{
	my ( $self ) = @_;
	return $self->root->{itemClass}-> new_from_itemid(
		$self->root->menu, undef,
		vertical => $self->vertical,
	);
}

package Prima::Menu::Transient;
use vars qw(@ISA);
@ISA = qw(Prima::Menu::Common);

BEGIN { Prima::Menu::Common::_export_constants(); };

sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	return {
		%def,
		font           => Prima::Widget->get_default_popup_font,
		widgetClass    => wc::Popup,
		clipOwner      => 0,
		selectable     => 0,
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$p->{font} //= Prima::Widget->get_default_popup_font;
	$self-> SUPER::profile_check_in( $p, $default);
}

sub init
{
	my $self = shift;
	$self->{vertical} = 1;
	my %profile = $self-> SUPER::init(@_);
	$self->root($profile{root});
	$self->reset;
	return %profile;
}

sub root        { $#_ ? $_[0]->{root}        = $_[1] : $_[0]->{root} }
sub menu        { shift->root->menu }

sub cancel
{
	my $self = shift;
	my $o = $self->owner;
	if ( $o && $o->isa('Prima::Menu::Common')) {
		undef $o->{submenu};
		$self->destroy;
	}
}

sub reset
{
	my $self = shift;
	return if $self->{lock_reset};

	my @cache;
	my @size = $self-> size;
	$self-> begin_paint_info;
	my $space_width = $self->get_text_width(' ');
	my $menu = $self-> menu or return;

	my $items = $menu-> get_children( $self-> parent );
	splice( @$items, 0, $self->parentIndex ) if $self->parentIndex > 0;
	my $borderSize = $self->{borderSize};
	my ($x, $y) = (0,0);
	my @ds = $::application->size;
	my $r = $ds[0] - $borderSize * 2;
	my $h = $ds[1] - $borderSize * 2;
	my @max = (0,0);
	my %storage;
	for my $itemid ( @$items ) {
		my $object = $self->new_from_itemid( $itemid );
		my ($W, $H) = $object-> size($self, \%storage);
		if ( $y + $H > $h ) {
			$object = $self->new_guillemots;
			($W, $H) = $object-> size($self);
			$max[0] = $W if $max[0] < $W;
			if ( @cache ) {
				@{$cache[-1]}[WIDTH,HEIGHT,ITEMID,OBJECT] = ($W, $H, undef, $object);
			} else {
				push @cache, [ $x, $y, $W, $H, undef, $object ];
			};
			last;
		}

Prima/Menus.pm view on Meta::CPAN

sub on_menuchange
{
	my ( $self, $menu, $what, @params) = @_;
	$self->reset;
}

sub set_menu
{
	my ( $self, $menu ) = @_;
	if ($self->{menu}) {
		if ($self->{menu_hook}) {
			$self-> {menu}-> remove_notification( $self-> {menu_hook} );
			undef $self->{menu_hook};
		}
		$self->cancel;
	}
	$self->{menu} = $menu;
	$self->{menu_hook} = $menu-> add_notification( Change => \&on_menuchange, $self )
		if $menu;
	$self->reset;
	$self->repaint;
}

sub on_menuenter
{
	my $self = shift;
	my $owner = $self->owner;

	$self-> {hooks} = [];
	my $cancel = sub { shift-> cancel };
	while ( $owner && $owner != $::application) {
		push @{$self->{hooks}}, $owner, $owner->add_notification( Move => $cancel, $self);
		$owner = $owner->owner;
	}
}

sub on_menuleave
{
	my $self = shift;
	my $hooks = $self->{hooks} // [];
	for ( my $i = 0; $i < @$hooks; $i += 2 ) {
		my ( $owner, $id ) = @{$hooks}[$i,$i+1];
		$owner->remove_notification($id);
	}
	$self->{hooks} = undef;
}

sub on_leave
{
	my $self = shift;

	alarm( 0.2, sub {
		my $f = $::application->get_focused_widget;
		$self->cancel unless $f && $f->isa('Prima::Menu::Common') && $f->root == $self->root;
	});
}

sub on_destroy { undef $_[0]->{hooks} }

sub itemClass   { $#_ ? $_[0]->{itemClass}   = $_[1] : $_[0]->{itemClass}  }
sub popupClass  { $#_ ? $_[0]->{popupClass}  = $_[1] : $_[0]->{popupClass}  }

package Prima::Menu::Popup;
use vars qw(@ISA);
@ISA = qw(Prima::Menu::Transient Prima::Menu::Root);

{
my %RNT = (
	%{Prima::Menu::Common-> notification_types()},
	MenuEnter  => nt::Default,
	MenuLeave  => nt::Default,
);

sub notification_types { return \%RNT; }
}

sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	return {
		%def,
		visible        => 0,
		itemClass      => 'Prima::Menu::Item',
		popupClass     => 'Prima::Menu::Transient',
		parent         => "",
		parentIndex    => 0,
		selectable     => 1,
	}
}

sub init
{
	my $self = shift;

	my %profile = $self-> SUPER::init(@_);
	$self->$_($profile{$_}) for qw(itemClass popupClass menu);
	return %profile;
}

sub root { $_[0] }
sub menu { $#_ ? $_[0]->set_menu($_[1]) : $_[0]->{menu} }

sub cancel
{
	my $self = shift;
	my $s = $self->{submenu};
	while ( $s ) {
		my $ss = $s->{submenu};
		$s->destroy;
		$s = $ss;
	}
	$self->{submenu} = undef;
	$self->{selectedItem} = -1;
	$self-> notify(q(MenuLeave));
	$self-> hide;
}

sub popup
{
	my ( $self, $x, $y ) = @_;
	unless ( defined($x) && defined($y)) {
		my @p = $self->owner->pointerPos;
		$x //= $p[0];
		$y //= $p[1];
	}
	my @sz = $self->size;
	my @dp = $::application->size;

	if ( $x + $sz[0] > $dp[0]) {
		if ( $x > $sz[0] ) {
			$x -= $sz[0];
		} else {
			$x = 0;
		}
	}

	if ( $y > $sz[1] ) {
		$y -= $sz[1];
	} elsif ( $y + $sz[1] > $dp[1] ) {
		$y = 0;
	}

	$self-> notify(q(MenuEnter));
	$self-> origin($x, $y);
	$self-> show;
	$self-> bring_to_front;
	$self-> focus;
}

package Prima::Menu::Bar;
use vars qw(@ISA);
@ISA = qw(Prima::Menu::Common Prima::Menu::Root);

BEGIN { Prima::Menu::Common::_export_constants(); };

{
my %RNT = (
	%{Prima::Menu::Common-> notification_types()},
	MenuEnter  => nt::Default,
	MenuLeave  => nt::Default,
);

sub notification_types { return \%RNT; }
}

sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	return {
		%def,
		font           => Prima::Window->get_default_menu_font,
		autoHeight     => 1,
		itemClass      => 'Prima::Menu::Item',
		popupClass     => 'Prima::Menu::Transient',
		parent         => "", # root menu item name
		selectable     => 1,
		widgetClass    => wc::Menu,
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$p-> {autoHeight} = 0 if !exists $p->{autoHeight} && (
		exists $p-> {height} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {top} && exists $p-> {bottom})
	);
	$p->{font} //= Prima::Window->get_default_menu_font;
	$self-> SUPER::profile_check_in( $p, $default);
}

sub init
{
	my $self = shift;

	$self->{autoHeight} = 1;
	$self->{vertical} = 0;
	my %profile = $self-> SUPER::init(@_);
	$self-> {lock_reset} = 1;
	$self->$_($profile{$_}) for qw(autoHeight menu itemClass popupClass);
	delete $self-> {lock_reset};
	$self->reset;

	return %profile;
}

sub root { $_[0] }
sub menu { $#_ ? $_[0]->set_menu($_[1]) : $_[0]->{menu} }

sub autoHeight
{
	return $_[0]->{autoHeight} unless $#_;
	my ( $self, $autoHeight ) = @_;
	$self->{autoHeight} = $autoHeight;
	$self-> geomHeight( $self-> font-> height + 10 + $self-> {borderSize} * 2 )
		if $autoHeight;
}

sub cancel
{
	my $self = shift;
	my $s = $self->{submenu};
	while ( $s ) {
		my $ss = $s->{submenu};
		$s->destroy;
		$s = $ss;
	}
	$self->{submenu} = undef;
	$self->{selectedItem} = -1;
	$self->focused(0);
	$self->repaint;
	$self-> notify(q(MenuLeave));
}


sub reset
{
	my $self = shift;
	return if $self->{lock_reset};

	my @cache;
	my @size = $self-> size;
	$self-> begin_paint_info;
	my $space_width = $self->get_text_width(' ');
	my $menu = $self->menu or return;

	my $items = $menu-> get_children( $self-> parent );
	splice( @$items, 0, $self->parentIndex ) if $self->parentIndex > 0;
	my $right_align;
	my ($x, $y) = ($self->{borderSize}) x 2;
	my $h = $size[1] - $y * 2;
	my $r = $size[0] - $x * 2;
	my %storage;
	for my $itemid ( @$items ) {
		if ( $self-> menu-> is_separator($itemid)) {
			push @cache, $right_align //= [0,0,0,0,undef,undef];
			next;
		}

		my $object = $self->new_from_itemid($itemid);

Prima/Menus.pm view on Meta::CPAN

	return if $i < 0;
	my $o = $self->{cache}->[$i]->[OBJECT];
	return unless $o && $o->selectable && $o->enabled;

	if ( $i != $self->selectedItem ) {
		$self->selectedItem($i);
		$self->enter_submenu;
	}
}

sub on_enter
{
	my $self = shift;
	$self->selectedItem(0) if
		$self->selectedItem < 0 && $self->enabled && @{ $self->{cache} // [] };
	$self->repaint;
}

sub on_disable
{
	my $self = shift;
	$self->cancel;
	$self->repaint;
}

sub on_enable
{
	my $self = shift;
	$self->repaint;
}

sub on_size
{
	my $self = $_[0];
	$self->cancel;
	$self->reset;
}

1;

=pod

=head1 NAME

Prima::Menus - menu widgets

=head1 DESCRIPTION

This module contains classes that can create menu widgets used as
normal widget, without special consideration about system-depended
menus.

=head1 SYNOPSIS

	use Prima qw(Application Menus);
	my $w = Prima::MainWindow->new(
		accelItems => [['~File' => [
			['Exit' => sub { exit } ],
		]]],
		onMouseDown => sub {
			Prima::Menu::Popup->new(menu => $_[0]-> accelTable)->popup;
		},
		height => 100,
	);
	$w->insert( 'Prima::Menu::Bar',
		pack  => { fill => 'x', expand => 1},
		menu  => $w-> accelTable,
	);
	run Prima;

=for podview <img src="Prima/menu.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/menu.gif">

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.

=head1 SEE ALSO

L<Prima>, L<Prima::Menu>, F<examples/menu.pl>

=cut

( run in 2.159 seconds using v1.01-cache-2.11-cpan-364913b4093 )