view release on metacpan or  search on metacpan

examples/canvas.pl  view on Meta::CPAN

			['smooth1' => '~Spline' => \&smooth],
			['smooth0' => '~Straigth' => \&smooth],
			['rotate-' => 'Rotate ~right' => \&line_rotate],
			['rotate+' => 'Rotate ~left' => \&line_rotate],
			[],
			['Set ~arrows' => [
				map {["arrow=$_", ucfirst, \&set_arrowhead]} 'none', keys %Prima::Canvas::Line::arrowheads,
			]],
			['Set arrowhead ~size' => [
				map {["arrow=$_", $_, \&set_arrowhead]} 1,2,3,4,5
			]],
		]],
		['Filled shapes' => [
			['fillBackColor'    => '~Fill back color' => \&set_color],
			['outlineBackColor' => '~Outline back color' => \&set_color],
		]],
		['Te~xt' => [
			['font' => '~Font' => \&set_font],
			[],
			['textOpaque1' => '~Opaque' => \&set_text_opaque],
			['textOpaque0' => '~Transparent' => \&set_text_opaque],
			[],
			(map { [ "dt:$_:".(dt::Left|dt::Right|dt::Center), $_, \&set_text_flags ]}
				qw(Left Right Center) ),
			[],
			(map { [ "dt:$_:".(dt::Top|dt::Bottom|dt::VCenter), $_, \&set_text_flags ]}
				qw(Top Bottom VCenter)),
			[],
			(map { [ "dt:$_", $_, \&set_text_flags ]}
				qw(DrawPartial NewLineBreak WordBreak ExpandTabs UseExternalLeading))
		]],
	]],
	['~View' => [
		['zoom+' =>  'Zoom in' => '+' => '+' => \&zoom],
		['zoom-' =>  'Zoom out' => '-' => '-' => \&zoom],
		['zoom0' =>  'Zoom 100%' => 'Ctrl+1' => '^1' => \&zoom],
		[],
		['Align ~horizontally' => [
			map { [ "alignment=$_", $_, \&align ]} qw(Left Center Right)
		]],
		['Align ~vertically' => [
			map { [ "valignment=$_", $_, \&align ]} qw(Top Center Bottom)
		]],
	]],
],
);

my $c = $w-> insert( 'Prima::CanvasEdit' =>
	origin => [0,0],
	size   => [$w-> size],
	growMode => gm::Client,
	paneSize => [ 500, 500],
	hScroll => 1,
	vScroll => 1,
	name    => 'Canvas',
	buffered => 1,
	alignment => ta::Center,
	valignment => ta::Middle,
);

my $widget_popup =
[
	[ '~Move' => sub {
		my ( $self, $obj, $owner);
		return unless $obj = Prima::Canvas::Widget-> instance( $self = $_[0]);
		return unless $owner = $obj-> owner;
		my @pp = $owner-> object2screen(
			$obj-> left + $obj-> width / 2,
			$obj-> bottom + $obj-> height / 2);
		$owner-> pointerPos( @pp);
		$owner-> mouse_down( mb::Left, 0, @pp, 1);
	}],
	[ '~Delete' => sub {
		return unless $_ = Prima::Canvas::Widget-> instance( $_[0]);
		$_-> destroy;
	}],
];

sub insert
{
	my ( $self, $obj, %profile) = @_;
	$profile{image} = $logo if $obj eq 'Image';
	$profile{image} = $bitmap, $obj = 'Image' if $obj eq 'Bitmap';
	if ( $obj eq 'Line') {
		$profile{points} = [ 10,10,10,50,50,40,100,0,50,60,90,90];
		$profile{shift}  = [ 50,50];
		$profile{arrows} = [ 'feather:2','feather:-2'];
		$profile{size}   = [ 200,200];
		$profile{anchor} = [ 50,50];
		$profile{lineEnd} = le::Flat;
		$profile{lineWidth} = 3,
		$profile{smooth}  = 1;
	}
	if ( $obj eq 'Polygon') {
		$profile{points} = [ 20,0,50,100,80,0,0,65,100,65];
		$profile{anchor} = [50,50];
	}
	if ( $obj eq 'Button') {
		$profile{widget} = Prima::Button-> create( owner => $c);
		$obj = 'Widget';
	}
	if ( $obj eq 'InputLine') {
		$profile{widget} = Prima::InputLine-> create( owner => $c);
		$profile{scalable} = 0;
		$obj = 'Widget';
	}
	if ( $obj eq 'Widget') {
		$profile{widget}-> popupItems( $widget_popup);
	}
	$profile{text} = "use Prima qw(Application);\nMainWindow-> create();\nrun Prima;"
		if $obj eq 'Text';
	$c-> focused_object( $c-> insert_object( "Prima::Canvas::$obj", %profile));
}

sub insert_from_menu
{
	my ( $self, $obj ) = @_;
	insert($self, $obj);
}

sub delete
{
	my $obj;
	return unless $obj = $_[0]-> Canvas-> focused_object;
	$_[0]-> Canvas-> delete_object( $obj);
}

sub set_alpha
{
	my ( $self, $alpha) = @_;
	my $obj;
	return unless $obj = $self-> Canvas-> focused_object;
	$obj-> alpha( $alpha);
}

sub set_color
{
	my ( $self, $property) = @_;
	my $obj;
	return unless $obj = $self-> Canvas-> focused_object;
	return unless $obj->can($property);
	$colordialog = Prima::Dialog::ColorDialog-> create unless $colordialog;
	$colordialog-> value( $obj-> $property());
	$obj-> $property( $colordialog-> value) if $colordialog-> execute != mb::Cancel;
}

sub set_font
{
	my ( $self, $property) = @_;
	my $obj;
	return unless $obj = $self-> Canvas-> focused_object;
	$fontdialog = Prima::Dialog::FontDialog-> create unless $fontdialog;
	$fontdialog-> logFont( $obj-> font);
	$obj-> font( $fontdialog-> logFont) if $fontdialog-> execute != mb::Cancel;
}

sub set_fill_pattern
{
	my ( $self, $fp) = @_;
	my $obj;
	return unless $obj = $self-> Canvas-> focused_object;

	if ( $fp eq 'Icon') {
		$obj-> fillPattern($logo);
	} elsif ( $fp eq 'Bitmap') {
		$obj-> fillPattern($bitmap->image);
	} else {
		return unless $fp =~ /^(\w+)\:(\w+)\=(.*)$/;