view release on metacpan or  search on metacpan

examples/menu.pl  view on Meta::CPAN

sub create_images_menu
{
	my @ret;
	my $template = shift;

	my $sub = sub {
		my $img = $_[0]-> menu-> icon( $_[1]);
		my @r = @{$img-> palette};
		$img-> palette( [reverse @r]) if @r;
		$_[0]-> menu-> icon( $_[1], $img);
	};

	push @ret, [ $template, $sub ], [];

	my $mono = $template->dup;
	$mono->conversion(ict::None);
	$mono->type(im::BW);

	my $monox = $mono->clone(type => 1);
	$monox->colormap(cl::Yellow, cl::Blue);
	push @ret, [ '1-bit image', $sub, { icon => $monox } ];
	push @ret, [ '-', '1-bit image disabled', $sub, { icon => $monox } ];

	my $mask1 = $template->dup;
	$mask1->set( color => cl::White, backColor => cl::Black, rop2 => rop::CopyPut );
	$mask1->map( $mask1->pixel(0,0) );
	$mask1->conversion(ict::None);
	$mask1->type(im::BW);

	my $mono2 = Prima::Icon->create_combined( $mono, $mask1);
	push @ret, [ '1-bit icon', $sub, { icon => $mono2 } ];
	push @ret, [ '-', '1-bit icon disabled', $sub, { icon => $mono2 } ];

	push @ret, [];
	push @ret, [ 'Color image', $sub, { icon => $template } ];
	push @ret, [ '-', 'Color image disabled', $sub, { icon => $template } ];
	my $color = Prima::Icon->create_combined( $template, $mask1);
	$color->maskColor($color->pixel(0,0));
	$color->autoMasking(am::MaskColor);
	push @ret, [ 'Color icon', $sub, { icon => $color } ];
	push @ret, [ '-', 'Color icon disabled', $sub, { icon => $color } ];
	push @ret, [];

	my $mask8 = $template->dup;
	$mask8->type(im::Byte);
	$mask8->set( color => cl::Black, backColor => 0x808080, rop2 => rop::CopyPut );
	$mask8->map( 0x10101 * $mask8->pixel(0,0) );
	my $argb = Prima::Icon->create_combined( $template, $mask8);
	push @ret, [ 'ARGB icon', $sub, { icon => $argb } ];
	push @ret, [ '-', 'ARGB icon disabled', $sub, { icon => $argb } ];

	return @ret;
}

sub create_custom_menu
{
	my @icons = map { Prima::StdBitmap::image($_) } sbmp::CheckBoxUnchecked, sbmp::CheckBoxChecked;
	return [ '@?' => "~Custom" => sub { print "Custom\n" } => {
		onMeasure => sub {
			my ( $self, $menu, $ref) = @_;
			my ($w, $h) = ( $self->owner->get_text_width( $menu-> text, 1 ), $self->owner->popupFont->height );
			my $i = $icons[ $menu->checked ];
			my $isz = $menu-> check_icon_size;
			my $dx = ( $isz > $i-> width ) ? $isz : $i-> width;
			@$ref = ($w + 20 + $dx, $h + 20);
		},
		onPaint => sub {
			my ( $self, $menu, $canvas, $selected, $x1, $y1, $x2, $y2) = @_;
			my @p = ( cl::Black, cl::White );
			@p = reverse @p if $selected;
			$canvas-> new_gradient(palette => \@p)->bar($x1, $y1, $x2, $y2, 1);
			$canvas-> font( $self-> owner->popupFont );
			$canvas-> color(cl::Yellow);

			my $i = $icons[ $menu->checked ];
			my $isz = $menu-> check_icon_size;
			my $dx = ( $isz > $i-> width ) ? $isz : $i-> width;
			$canvas-> draw_text( $menu->text, $x1 + 2 + $dx, $y1, $x2, $y2, dt::VCenter|dt::DrawMnemonic);
			$canvas-> put_image(
				$x1 + (( $isz > $i-> width ) ? ( $menu-> check_icon_size - $i-> width) / 2 : 0),
				($y2 + $y1 - $i->height) / 2, $i);
		},
	} ];
}

my $img = Prima::Image-> create;
$0 =~ /^(.*)(\\|\/)[^\\\/]+$/;
$img-> load(( $1 || '.') . '/Hand.gif');

sub test_toplevels
{
	my @img = map { ((ref($$_[-1]) // '') eq 'HASH') ? $$_[-1]->{icon} : () } create_images_menu($img);
	my $i;
	my @menu;
	push @menu, [ '@?', 'Layered', sub {$_[0]->layered( $_[2] ); },  create_custom_menu->[-1] ];

	for ( $i = 0; $i < @img; $i+=2) {
		push @menu, [ "\@t1-$i", $img[$i], sub {
			my $id = $_[1];
			$id =~ s/1/2/;
			my $m = Prima::MenuItem->new( $_[0]->menu, $id);
			$m->enabled(!$m->enabled);
		}];
		push @menu, [ "-\@t2-$i", $img[$i], sub {}];
	};
	TestWindow->new(
		menuItems => \@menu,
		size => [ 600, $::application->font->height ],
		text => 'Toplevel images',
	);
}

#    Menu item must be an array with up to 6 items in -
# [variable, text or image, accelerator text, shortcut key, sub or command, data]
# see exact rules how these are parsed in L<"Prima::Menu" / "Menu items">.

sub create_menu
{
	return [
		[ "~Window" => [
			[ "Anonymous" => "Ctrl+D" => '^d' => sub { print "sub!\n";}],   # anonymous sub
			[ '~Images' => [ create_images_menu($img) ]],
			create_custom_menu,
			[],                                       # division line
			[ 'Test toplevels' => 'test_toplevels' ],
			[ "E~xit" => "Exit"    ]    # calling named function of menu owner
		]],
		[ ef => "~Edit" => [                  # example of system commands usage
			[ "Cop~y"  => sub { $_[0]-> foc_action('copy')}  ],     # try these with input line focused
			[ "Cu~t"   => sub { $_[0]-> foc_action('cut')}   ],
			[ "Pa~ste" => sub { $_[0]-> foc_action('paste')} ],
			[],