popup results from the CPAN

popup

Prima

view release on metacpan or search on metacpan

sub prf
{
	my ( $self, @property) = @_;
	my @ret = ();
	for ( @property) {
		push ( @ret, exists $self-> {profile}-> {$_} ?
			$self-> {profile}-> {$_} :
			$self-> {default}-> {$_});
		warn( "$self: cannot query `$_'") unless exists $self-> {default}-> {$_};
	}
	return wantarray ? @ret : $ret[0];
}

sub prf_adjust_default
{
}

sub prf_events
{
	return ();
}

sub ext_profile
{
	return;
}

sub act_profile
{
	return;
}

package Prima::VB::Component;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::Widget Prima::VB::Object);

{
my %RNT = (
	%{Prima::Widget-> notification_types()},
	Load => nt::Default,
);

sub notification_types { return \%RNT; }
}

sub profile_default
{
	my $def = $_[ 0]-> SUPER::profile_default;
	my %prf = (
		class      => 'Prima::Widget',
		module     => 'Prima::Classes',
		profile    => {},
		selectable => 1,
		sizeable   => 1,
		marked     => 0,
		mainEvent  => undef,
		sizeMin    => [11,11],
		selectingButtons => 0,
		accelItems => [
			['altpopup',0,0, km::Shift|km::Ctrl|kb::F9, sub{
				$_[0]-> altpopup;
				$_[0]-> clear_event;
			}],
		],
		o_delta    => [0,0],
	);
	@$def{keys %prf} = values %prf;
	return $def;
}


sub prf_types
{
	return {
		name       => ['name'],
		Handle     => ['owner'],
		FMAction   => [qw( onBegin onFormCreate onCreate onChild onChildCreate onEnd )],
	};
}

sub prf_events
{
	return (
		onPostMessage  => 'my ( $self, $info1, $info2) = @_;',
		onChangeOwner  => 'my ( $self, $old_owner) = @_;',
		onChildEnter   => 'my ( $self, $child) = @_;',
		onChildLeave   => 'my ( $self, $child) = @_;',
	);
}


sub prf_adjust_default
{
	my ( $self, $p, $pf) = @_;
	$self-> SUPER::prf_adjust_default( $p, $pf);
	$pf-> {owner} = '';
}


sub prf_types_add
{
	my ( $self, $pt, $de) = @_;
	for ( keys %{$de}) {
		# * uncomment this if you suspect property type clash *
		#
		#my $t1 = $_;
		#for ( @{$de-> {$_}}) {
		#  my $p1 = $_;
		#  for ( keys %$pt) {
		#     my $t2 = $_;
		#     for ( @{$pt-> {$_}}) {
		#        die "$self: $p1: $t2 vs $t1\n" if $p1 eq $_ && $t2 ne $t1;
		#     }
		#  }
		#}

		if ( exists $pt-> {$_}) {
			push( @{$pt-> {$_}}, @{$de-> {$_}});
		} else {
			$pt-> {$_} = [@{$de-> {$_}}];
		}

Prima/VB/Classes.pm view on Meta::CPAN

		$self-> bring_to_front;
		$self-> focus;
		if ( $VB::inspector) {
			$VB::inspector-> {selectorChanging} = 1; # disallow auto single-select
			Prima::VB::ObjectInspector::enter_widget( $self);
			$VB::inspector-> {selectorChanging} = 0;
		}

		$self-> iterate_children( sub { $_[0]-> bring_to_front; $_[0]-> update_view; });

		my @mw;
		@mw = $VB::form-> marked_widgets if $part eq q(client) && $self-> marked;
		$self-> marked( 1, 1) unless @mw;
		$self-> clear_event;
		$self-> capture(1, $self-> owner);
		$self-> {spotX} = $x;
		$self-> {spotY} = $y;
		$VB::form-> {modified} = 1;
		if ( $part eq q(client)) {
			my @rects = ();
			for ( @mw) {
				next if $_ == $self;
				$_-> marked(1);
				push( @rects, [$_->rect]);
			}
			$self-> {sav} = [$self-> origin];
			$self-> {drag} = 1;
			$VB::form-> dm_init( $self);
			$self-> {extraWidgets} = \@mw;
			$self-> {extraRects}   = \@rects;
			$self-> {prevRect} = [$self->rect];
			$self-> update_view;
			$VB::form-> {saveHdr} = $VB::form-> text;
			$self-> xorrect( @{$self-> {prevRect}});
			return;
		}

		if ( $part =~ /^Size/) {
			$self-> {sav} = [$self-> rect];
			$part =~ s/^Size//;
			$self-> {sizeAction} = $part;
			my ( $xa, $ya) = ( 0,0);
			if    ( $part eq q(S))   { ( $xa, $ya) = ( 0,-1); }
			elsif ( $part eq q(N))   { ( $xa, $ya) = ( 0, 1); }
			elsif ( $part eq q(W))   { ( $xa, $ya) = (-1, 0); }
			elsif ( $part eq q(E))   { ( $xa, $ya) = ( 1, 0); }
			elsif ( $part eq q(SW)) { ( $xa, $ya) = (-1,-1); }
			elsif ( $part eq q(NE)) { ( $xa, $ya) = ( 1, 1); }
			elsif ( $part eq q(NW)) { ( $xa, $ya) = (-1, 1); }
			elsif ( $part eq q(SE)) { ( $xa, $ya) = ( 1,-1); }
			$self-> {dirData} = [$xa, $ya];
			$self-> {prevRect} = [$self->rect];
			$self-> update_view;
			$VB::form-> {saveHdr} = $VB::form-> text;
			$self-> xorrect( @{$self-> {prevRect}});
			return;
		}
	}

	if ( $btn == mb::Right && $mod & km::Ctrl) {
		$self-> altpopup;
		$self-> clear_event;
		return;
	}
}

sub altpopup
{
	my $self  = $_[0];
	while ( 1) {
		my $p = $self-> bring( 'AltPopup');
		if ( $p) {
			$p-> popup( $self-> pointerPos);
			last;
		}
		last if $self == $VB::form;
		my $o = $self-> prf('owner');
		$self = ( $o eq $VB::form-> name) ? $VB::form : $VB::form-> bring( $o);
		last unless $self;
	}
}

sub on_mouseclick
{
	my ( $self, $btn, $mod, $x, $y, $dbl) = @_;

	return unless $dbl;
	$mod &= km::Alt|km::Shift|km::Ctrl;
	if ( $mod == 0 && defined $self-> mainEvent && $VB::inspector) {
		my $a = $self-> mainEvent;
		$self-> marked(1,1);
		$VB::inspector-> set_monger_index( 1);
		my $list = $VB::inspector-> {currentList};
		my $ix = $list-> {index}-> {$a};
		if ( defined $ix) {
			$list-> focusedItem( $ix);
			$list-> notify(q(Click)) unless $list-> {check}-> [$ix];
		}
		return;
	}
	$self-> notify( q(MouseDown), $btn, $mod, $x, $y);
}


sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;
	if ( $self-> {drag}) {
		my $dm = $VB::form-> dragMode;
		if ( $dm != 3) {
			my @o = @{$self-> {prevRect}}[0,1];
			my $rx = $x;
			$y = $o[1] - $self->bottom + $self-> {spotY} if $dm == 1;
			$x = $o[0] - $self->left   + $self-> {spotX} if $dm == 2;
		}
		my @sz = $self-> size;
		my @og = $self-> origin;
		if ( $VB::main-> {ini}-> {SnapToGrid}) {
			return if
				!$self-> {dragImpedance} &&
				abs( $x - $self-> {spotX}) < 4 &&
				abs( $y - $self-> {spotY}) < 4
				;
			$self-> {dragImpedance} = 1;
			$x -= ( $x - $self-> {spotX} + $og[0]) % 4;
			$y -= ( $y - $self-> {spotY} + $og[1]) % 4;
		}

		if ( $VB::main-> {ini}-> {SnapToGuidelines}) {
			my $xline = $VB::form-> {guidelineX} - $og[0];
			my $yline = $VB::form-> {guidelineY} - $og[1];
			$x = $xline + $self-> {spotX}
				if abs( $xline - $x + $self-> {spotX}) < 8;

Prima/VB/Classes.pm view on Meta::CPAN

		if ( abs( $VB::form-> {guidelineX} - $x) < 3) {
			$self-> pointer(( abs( $VB::form-> {guidelineY} - $y) < 3) ?
				cr::Move :
				cr::SizeWE);
		} elsif ( abs( $VB::form-> {guidelineY} - $y) < 3) {
			$self-> pointer( cr::SizeNS);
		} else {
			$self-> pointer( cr::Arrow);
		}
	}
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	if ( $btn == mb::Left)
	{
		if ( $self-> {drag}) {
			$self-> pointer( cr::Default);
			$self-> capture(0);
			$self-> {drag} = 0;
			$self-> xorrect;
			my @o = $self-> origin;
			$self-> origin( @{$self-> {prevRect}}[0,1] );
			if ( defined $self-> {extraRects}) {
				# get all children, and do _not_ move them together with us
				my @allchildren = ($self-> name);
				my %allwidgets;
				push @{$allwidgets{$_->prf('owner')}}, $_->name for $VB::form-> widgets;
				for ( my $i = 0; $i < @allchildren; $i++) {
					push @allchildren, @{$allwidgets{$allchildren[$i]}}
						if $allwidgets{$allchildren[$i]};
				}
				my %allchildren = map { $_ => 1 } @allchildren;

				my @org = @{$self-> {sav}};
				$org[0] = $self-> {prevRect}-> [0] - $org[0];
				$org[1] = $self-> {prevRect}-> [1] - $org[1];
				for my $wij ( @{$self-> {extraWidgets}}) {
					next if $allchildren{$wij-> name};
					my @o = $wij-> origin;
					$wij-> origin( $o[0] + $org[0], $o[1] + $org[1]);
				}
			}
			$VB::form-> text( $VB::form-> {saveHdr});
			$self-> {extraRects} = $self-> {extraWidgets} = undef;
		}
		if ( $self-> {sizeAction}) {
			my @r = @{$self-> {prevRect}};
			$self-> xorrect;
			my @o = $self-> origin;
			$self-> rect( @r);
			$self-> pointer( cr::Default);
			$self-> capture(0);
			$self-> {sizeAction} = 0;
			$VB::form-> text( $VB::form-> {saveHdr});
		}
	}
}

sub on_popup
{
	my $self = shift;
	my ($by_mouse, $x, $y) = @_;
	my $alt = $self-> bring('AltPopup');
	if ($alt) {
		my $aitems = $alt-> get_items('');
		my $pitems = $VB::form-> popup-> get_items('');
		my $p = Prima::Popup-> create(
				name => 'AltFormPopup',
				items => [
					@$pitems,
					[],
					[ '-' . $self-> name => '** ' . $self-> name . ' **' => qw(nope)],
					@$aitems,
				]
		);
		$p-> popup($self-> client_to_screen($x, $y));
		$self-> clear_event;
		return;
	}
}

sub on_keydown
{
	my ( $self, $code, $key, $mod) = @_;
	if ( $key == kb::Delete) {
		$self-> clear_event;
		$_-> destroy for $VB::form-> marked_widgets;
		Prima::VB::ObjectInspector::renew_widgets();
		return;
	}
	if ( $key == kb::Esc) {
		if ( $self-> {drag} || $self-> {sizeAction}) {
			$self-> xorrect;
			$self-> {drag} = $self-> {sizeAction} = 0;
			$self-> {dirData} = $self-> {spotX} = $self-> {spotY} = undef;
			$self-> pointer( cr::Default);
			$self-> capture(0);
			$VB::form-> text( $VB::form-> {saveHdr});
			return;
		}
	}
	if ( $key == kb::Tab && $self-> {drag}) {
		$VB::form-> dm_next( $self);
		my @pp = $self->owner-> pointerPos;
		$self-> {spotX} = $pp[0] - $self-> {prevRect}-> [0];
		$self-> {spotY} = $pp[1] - $self-> {prevRect}-> [1];
		$self-> clear_event;
		return;
	}
}

sub marked
{
	if ( $#_) {
		my ( $self, $mark, $exlusive) = @_;
		$mark = $mark ? 1 : 0;
		$mark = 0 if $self == $VB::form;
		return if ( $mark == $self-> {marked}) && !$exlusive;
		if ( $exlusive) {
			$_-> marked(0) for $VB::form-> marked_widgets;
		}
		$self-> {marked} = $mark;
		$self-> repaint;
		$VB::main-> update_markings();
	} else {
		return 0 if $_[0] == $VB::form;
		return $_[0]-> {marked};
	}
}

sub sizeable
{
	return $_[0]-> {sizeable} unless $#_;
	return if $_[1] == $_[0]-> {sizeable};
	$_[0]-> {sizeable} = $_[1];
	$_[0]-> pointer( cr::Default) unless $_[1];

Prima/VB/Classes.pm view on Meta::CPAN

	my $self = $_[0];
	my @d = $self-> get_o_delta();
	my @o = $self-> origin;
	$o[0] += $d[0];
	$o[1] += $d[1];
	$self-> hint(
		$self-> name . ' ['.
		join(',', @o) . '-' .
		join(',', $self-> size) .
	']');
}

package Prima::VB::Drawable;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::VB::Component);


sub prf_types
{
	my $pt = $_[ 0]-> SUPER::prf_types;
	my %de = (
		color         => ['color','backColor'],
		fillPattern   => ['fillPattern'],
		font          => ['font'],
		lineEnd       => ['lineEnd'],
		lineJoin      => ['lineJoin'],
		linePattern   => ['linePattern'],
		lineWidth     => ['lineWidth'],
		rop           => ['rop', 'rop2'],
		bool          => ['textOutBaseline', 'textOpaque', 'fillMode'],
		point         => ['translate', 'fillPatternOffset'],
		palette       => ['palette'],
		image         => ['region'],
		uiv           => ['miterLimit'],
	);
	$_[0]-> prf_types_add( $pt, \%de);
	return $pt;
}

package Prima::VB::Widget;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::VB::Drawable);

sub prf_adjust_default
{
	my ( $self, $prf, $def) = @_;
	$self-> SUPER::prf_adjust_default( $prf, $def);
	$def-> {size} = [$def-> {width}, $def-> {height}];
	$self-> size(@{$def-> {size}});

	delete $def-> {$_} for qw (
		accelTable
		clipOwner
		current
		currentWidget
		delegations
		effects
		focused
		popup
		selected
		selectedWidget
		capture
		hintVisible
		widgets
		buffered

		left
		right
		top
		bottom
		width
		height
		rect

		alpha
		antialias
		lineEnd
		lineJoin
		linePattern
		lineWidth
		fillPattern
		fillPatternOffset
		fillMode
		miterLimit
		region
		rop
		rop2
		textOpaque
		textOutBaseline
		translate
	);
	$def-> {text} = '' unless defined $def-> {text};
}

sub profile_default
{
	my $def = $_[ 0]-> SUPER::profile_default;
	my %prf = (
		mainEvent => 'onMouseClick',
	);
	@$def{keys %prf} = values %prf;
	return $def;
}

sub prf_types
{
	my $pt = $_[ 0]-> SUPER::prf_types;
	my %de = (
		menu          => [qw(accelTable popup)],
		menuItems     => [qw(accelItems popupItems)],
		color         => [qw(dark3DColor light3DColor disabledBackColor
			disabledColor hiliteBackColor hiliteColor popupColor
			popupBackColor popupHiliteColor popupHiliteBackColor
			popupDisabledColor popupDisabledBackColor
			popupLight3DColor popupDark3DColor
		)],
		font          => ['popupFont'],
		bool          => [qw(autoEnableChildren briefKeys buffered capture clipOwner
			centered current cursorVisible enabled firstClick focused
			hintVisible ownerColor ownerBackColor ownerFont ownerHint
			ownerShowHint ownerPalette scaleChildren
			selectable selected showHint syncPaint tabStop transparent
			visible x_centered y_centered originDontCare sizeDontCare
			packPropagate layered clipChildren
		)],
		iv            => [qw(bottom height left right top width)],
		tabOrder      => ['tabOrder'],
		rect          => ['rect'],
		point         => ['cursorPos'],
		origin        => ['origin'],
		upoint        => [qw(cursorSize designScale size sizeMin sizeMax pointerHotSpot)],
		widget        => [qw(currentWidget selectedWidget)],
		pointer       => ['pointer',],
		growMode      => ['growMode'],
		geometry      => ['geometry'],
		string        => ['helpContext', 'dndAware'],
		text          => ['text', 'hint'],
		selectingButtons=> ['selectingButtons'],
		widgetClass   => ['widgetClass'],
		image         => ['shape'],
		packInfo      => ['packInfo'],
	);
	$_[0]-> prf_types_add( $pt, \%de);
	return $pt;
}

sub prf_events
{
	return (
		$_[0]-> SUPER::prf_events,
		onColorChanged   => 'my ($self, $colorIndex) = @_;',
		onDragDrop       => 'my ($self, $x, $y) = @_;',
		onDragOver       => 'my ($self, $x, $y, $state) = @_;',
		onEndDrag        => 'my ($self, $x, $y) = @_;',
		onHint           => 'my ($self, $show) = @_;',
		onKeyDown        => 'my ($self, $code, $key, $mod, $repeat) = @_;',
		onKeyUp          => 'my ($self, $code, $key, $mod) = @_;',
		onMenu           => 'my ($self, $menu, $variable) = @_;',
		onMouseDown      => 'my ($self, $btn, $mod, $x, $y) = @_;',
		onMouseUp        => 'my ($self, $btn, $mod, $x, $y) = @_;',
		onMouseClick     => 'my ($self, $btn, $mod, $x, $y, $dblclk) = @_;',
		onMouseMove      => 'my ($self, $mod, $x, $y) = @_;',
		onMouseWheel     => 'my ($self, $mod, $x, $y, $z) = @_;',
		onMouseEnter     => 'my ($self, $mod, $x, $y) = @_;',
		onMove           => 'my ($self, $oldx, $oldy, $x, $y) = @_;',
		onPaint          => 'my ($self, $canvas) = @_;',
		onPopup          => 'my ($self, $mouseDriven, $x, $y) = @_;',
		onSize           => 'my ($self, $oldx, $oldy, $x, $y) = @_;',
		onTranslateAccel => 'my ($self, $code, $key, $mod) = @_;',
	);
}

sub prf_color        { $_[0]-> recolor($_[1],'color'); }
sub prf_backColor    { $_[0]-> recolor($_[1],'backColor'); }
sub prf_light3DColor { $_[0]-> recolor($_[1],'light3DColor'); }
sub prf_dark3DColor  { $_[0]-> recolor($_[1],'dark3DColor'); }
sub prf_hiliteColor       { $_[0]-> recolor($_[1],'hiliteColor'); }

Prima/VB/Classes.pm view on Meta::CPAN

{
	my $self = shift;
	return if $self->{locked} && !$self->{prelight};
	local $self->{syncColoring} = 1;
	delete $self->{prelight};
	$self->backColor( $self-> prf('backColor'));
}

sub update_children_geometry
{
	my ($self, $ox, $oy, $x, $y) = @_;
	return unless $VB::form;
	my $name = $self-> prf('name');
	my @w    = grep { $_-> prf('owner') eq $name } $VB::form-> widgets;
	my @o    = ( $self == $VB::form) ? ( 0, 0) : $self-> origin;
	for ( @w) {
		if ( $_-> prf('geometry') == gt::GrowMode) {
			my @size  = $_-> get_virtual_size;
			my @pos   = $_-> origin;
			$pos[$_] -= $o[$_] for 0,1;
			my @osize = @size;
			my @opos  = @pos;
			my @d     = ( $x - $ox, $y - $oy);
			my $gm    = $_-> prf('growMode');
			$pos[0]  += $d[0] if $gm & gm::GrowLoX;
			$pos[1]  += $d[1] if $gm & gm::GrowLoY;
			$size[0] += $d[0] if $gm & gm::GrowHiX;
			$size[1] += $d[1] if $gm & gm::GrowHiY;
			$pos[0]   = ( $x - $size[0]) / 2 if $gm & gm::XCenter;
			$pos[1]   = ( $y - $size[1]) / 2 if $gm & gm::YCenter;
			unless ( grep { $pos[$_] != $opos[$_] and $size[$_] != $osize[$_] } 0,1) {
				$pos[$_] += $o[$_] for 0,1;
				$_-> rect( @pos, $pos[0] + $size[0], $pos[1] + $size[1]);
			}
		}
	}
}

package Prima::VB::Control;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::VB::Widget);


sub prf_adjust_default
{
	my ( $self, $p, $pf) = @_;
	$self-> SUPER::prf_adjust_default( $p, $pf);
	delete $pf-> {$_} for qw (
		briefKeys
		cursorPos
		cursorSize
		cursorVisible
		pointer
		pointerType
		pointerHotSpot
		pointerIcon
		scaleChildren
		selectable
		selectingButtons
		popupColor
		popupBackColor
		popupHiliteBackColor
		popupDisabledBackColor
		popupHiliteColor
		popupDisabledColor
		popupDark3DColor
		popupLight3DColor
		popupFont
		widgetClass
	);
}

package Prima::VB::Window;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::VB::Control);

sub prf_adjust_default
{
	my ( $self, $p, $pf) = @_;
	$self-> SUPER::prf_adjust_default( $p, $pf);
	delete $pf-> {$_} for qw (
		menu
		modalResult
		menuColor
		menuBackColor
		menuHiliteBackColor
		menuDisabledBackColor
		menuHiliteColor
		menuDisabledColor
		menuDark3DColor
		menuLight3DColor
		menuFont
	);
}

sub prf_events
{
	return (
		$_[0]-> SUPER::prf_events,
		onWindowState  => 'my ( $self, $windowState) = @_;',
	);
}

sub prf_types
{
	my $pt = $_[ 0]-> SUPER::prf_types;
	my %de = (
		borderIcons   => ['borderIcons'],
		borderStyle   => ['borderStyle'],
		windowState   => ['windowState'],
		icon          => ['icon'],
		menu          => ['menu'],
		menuItems     => ['menuItems'],
		color         => ['menuColor', 'menuHiliteColor','menuDisabledColor',
			'menuBackColor', 'menuHiliteBackColor','menuDisabledBackColor',
			'menuLight3DColor', 'menuDark3DColor'
		],
		font          => ['menuFont'],
		bool          => ['modalHorizon', 'taskListed', 'ownerIcon', 'onTop', 'mainWindow'],
		uiv           => ['modalResult'],
	);
	$_[0]-> prf_types_add( $pt, \%de);
	return $pt;
}


package Prima::VB::Types;

Prima/VB/Classes.pm view on Meta::CPAN

	'name'    => 'menuname',
	'enabled' => 'bool',
	'checked' => 'bool',
	'image'   => 'image',
	'action'  => 'event',
);

%menuDefaults = (
	'key'     => kb::NoKey,
	'accel'   => '',
	'text'    => '',
	'name'    => 'MenuItem',
	'enabled' => 1,
	'checked' => 0,
	'image'   => undef,
	'action'  => 'my ( $self, $item) = @_;',
);


sub open
{
	my $self = $_[0];
	my $h = $self-> {container}-> height;
	my $w = $self-> {container}-> width;
	my $fh = $self-> {container}-> font-> height;

	my $divx = $h / 2;
	$self-> {A} = $self-> {container}-> insert( 'Prima::VB::MPropListViewer' =>
		origin => [ 0, 0],
		size   => [ 100, $divx],
		growMode => gm::Client,
		onSelectItem => sub {
			$self-> close_item;
			$self-> open_item;
		},
	);
	$self-> {A}-> {master} = $self;

	$self-> {Div1} = $self-> {container}-> insert( 'Prima::VB::Divider' =>
		vertical => 0,
		origin => [ 0, $divx],
		size   => [ 100, 6],
		min    => 20,
		max    => 20,
		name   => 'Div',
		growMode => gm::Ceiling,
		onChange => sub {
			my $bottom = $_[0]-> bottom;
			$self-> {A}-> height( $bottom);
			$self-> {B}-> set(
				top    => $self-> {container}-> height,
				bottom => $bottom + 6,
			);
		}
	);

	$self-> {B} = $self-> {container}-> insert( 'Prima::VB::MenuOutline' =>
		origin => [ 0, $divx + 6],
		size   => [ 100, $h - $divx - 6],
		growMode => gm::Ceiling,
		popupItems => [
			['~New' => q(newnode),],
			['~Make node' => q(makenode),],
			['Convert to ~separator' => q(makeseparator),],
			['~Delete' => q(del),],
		],
		onSelectItem => sub {
			my ( $x, $l) = $_[0]-> get_item( $_[0]-> focusedItem);
			$self-> enter_menuitem( $x);
		},
	);
	$self-> {B}-> {master} = $self;

	my $xb = $::application-> get_system_value( sv::XScrollbar);
	$self-> {B}-> insert( Button =>
		origin => [
			$self-> {B}-> indents()-> [0],
			$self-> {B}-> height - $xb - $self-> {B}-> indents()-> [3]
		],
		size   => [ ( $xb ) x 2],
		font   => { height => $xb - 4 * 0.8, style => fs::Bold },
		text   => 'X',
		growMode => gm::GrowLoY,
		onClick => sub { $self-> {B}-> popup-> popup($_[0]-> origin)},
	);

	$self-> {Div2} = $self-> {container}-> insert( 'Prima::VB::Divider' =>
		vertical => 1,
		origin => [ 100, 0],
		size   => [ 6, $h - 1],
		min    => 50,
		max    => 50,
		name   => 'Div',
		onChange => sub {
			my $right = $_[0]-> right;
			$self-> {A}-> width( $_[0]-> left);
			$self-> {Div1}-> width( $_[0]-> left);
			$self-> {B}-> width( $_[0]-> left);
			$self-> {panel}-> set(
				width => $self-> {container}-> width - $right,
				left  => $right,
			);
		}
	);

	$self-> {panel} = $self-> {container}-> insert( Notebook =>
		origin    => [ 106, 0],
		size      => [ $w - 106, $h - 1],
		growMode  => gm::Right,
		name      => 'Panel',
		pageCount => 1,
	);
	$self-> {panel}-> {pages} = {};
}

sub enter_menuitem
{
	my ( $self, $x ) = @_;
	if ( defined $x) {
		return if defined $self-> {current} and $self-> {current} == $x;
	} else {
		return unless defined $self-> {current};
	}
	$self-> {current} = $x;
	$self-> close_item;
	my $l = $self-> {A};
	if ( $self-> {current}) {
		my @id = sort keys %menuProps;
		my @chk = ();
		my %ix  = ();
		my $num = 0;
		for ( @id) {
			push( @chk, exists $x-> [0]-> [1]-> {$_} ? 1 : 0);
			$ix{$_} = $num++;
		}
		$l-> reset_items( \@id, \@chk, \%ix);
		$self-> open_item;
	} else {
		$l-> {id} = [];
		$l-> {check} = [];
		$l-> {index} = {};
		$l-> set_count( 0);
	}
}

Prima/VB/Classes.pm view on Meta::CPAN

use Prima::KeySelector;

sub open
{
	my $self = $_[0];
	my $i = $self-> {container};
	$self-> {A} = $i-> insert( KeySelector =>
		origin   => [ 5, 5],
		size     => [ $i-> width - 10, $i-> height - 10],
		growMode => gm::Ceiling,
		onChange => sub { $self-> change; },
	);
}

sub get
{
	return $_[0]-> {A}-> key;
}

sub set
{
	my ( $self, $data) = @_;
	$self-> {A}-> key( $data);
}

sub write
{
	my ( $class, $id, $data) = @_;
	return Prima::KeySelector::export( $data);
}


package Prima::VB::ItemsOutline;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::StringOutline Prima::VB::MyOutline);

sub new_item
{
	return  ['New Item', undef, 0];
}

package Prima::VB::Types::treeItems;
use strict;
use vars qw(@ISA);
@ISA = qw(Prima::VB::Types::generic);

sub outliner {'Prima::VB::ItemsOutline' }

sub open
{
	my $self = $_[0];
	my $h = $self-> {container}-> height;
	my $w = $self-> {container}-> width;
	my $fh = $self-> {container}-> font-> height;

	$self-> {A} = $self-> {container}-> insert( $self->outliner,
		origin => [ 0, $fh + 4],
		size   => [ $w - 1, $h - $fh - 4],
		growMode => gm::Client,
		popupItems => [
			['~New' => q(newnode),],
			['~Make node' => q(makenode),],
			['~Delete' => q(del),],
		],
		onSelectItem => sub {
			my ( $x, $l) = $_[0]-> get_item( $_[0]-> focusedItem);
			$self-> enter_menuitem( $x);
		},
	);
	$self-> {A}-> {master} = $self;
	my $xb = $self-> {A}-> {vScroll} ? $self-> {A}-> {vScrollBar}-> width : 0;
	$self-> {A}-> insert( Button =>
		origin => [
			$self-> {A}-> width - $xb - $self-> {A}-> indents()-> [2],
			$self-> {A}-> height - $xb - $self-> {A}-> indents()-> [3]
		],
		size   => [ ( $xb ) x 2],
		font   => { height => $xb - 4 * 0.8, style => fs::Bold },
		text   => 'X',
		growMode => gm::GrowLoX|gm::GrowLoY,
		onClick => sub { $self-> {A}-> popup-> popup($_[0]-> origin)},
	);
	$self-> {B} = $self-> {container}-> insert( InputLine =>
		origin => [ 0, 1],
		width  => $w,
		growMode => gm::Floor,
		text => '',
		onChange => sub {
			my ( $x, $l) = $self-> {A}-> get_item( $self-> {A}-> focusedItem);
			$self->on_b_change($x, $l, $self->{B}->text);
		},
	);
}

sub on_b_change
{
	my ( $self, $x, $l, $text) = @_;
	if ( $x) {
		$x-> [0] = $text;
		$self-> change;
		$self-> {A}-> reset_tree;
		$self-> {A}-> update_tree;
		$self-> {A}-> repaint;
	}
}

sub enter_menuitem
{
	my ( $self, $x ) = @_;
	$self-> {B}-> text( $x ? $x-> [0] : '');
}

sub get
{
	return $_[0]-> {A}-> items;
}

sub set
{
	return $_[0]-> {A}-> items( $_[1]);
}


sub write
{
	my ( $class, $id, $data) = @_;
	return '[]' unless $data;
	my $c = '';
	my $traverse;
	$traverse = sub {
		my ($x,$lev) = @_;
		$c .= ' ' x ( $lev * 3);
		$c .= "['". Prima::VB::Types::generic::quotable($x-> [0])."', ";
		if ( $x-> [1]) {
			$lev++;
			$c .= "[\n";
			$traverse-> ($_, $lev) for @{$x-> [1]};
			$lev--;
			$c .= ' ' x ( $lev * 3)."], $$x[2]";
		}
		$c .= "],\n";

Prima/VB/Classes.pm view on Meta::CPAN

by C<add_hooks> when PROPERTY on object NAME is changed
from OLD_VALUE to NEW_VALUE. Special PROPERTY C<'DESTROY'>
hook is called when object NAME is destroyed.

=back

=head1 Prima::VB::Component

=head2 Properties

=over

=item marked MARKED , EXCLUSIVE

Selects marked state of a widget. If MARKED flag is 1, the widget is
selected as marked. If 0, it is selected as unmarked.
If EXCLUSIVE flag is set to 1, then all marked widgets are unmarked
before the object mark flag is set.

=item sizeable BOOLEAN

If 1, the widget can be resized by the user.
If 0, in can only be moved.

=item mainEvent STRING

Selects the event name, that will be opened in the object inspector
when the user double clicks on the widget.

=back

=head2 Methods

=over

=item common_paint CANVAS

Draws selection and resize marks on the widget
if it is in the selected state. To be called from
all C<on_paint> callbacks.

=item get_o_delta

Returns offset to the owner widget. Since the builder does
not insert widgets in widgets to reflect the user-designed
object hierarchy, this method is to be used to calculate
children widgets relative positions.

=item xy2part X, Y

Maps X, Y point into part of widget. If result is not
equal to C<'client'> string, the event in X, Y point
must be ignored.

=item iterate_children SUB, @ARGS

Traverses all children widget in the hierarchy,
calling SUB routine with widget, self, and @ARGS
parameters on each.

=item altpopup

Invokes an alternative, class-specific popup menu, if present.
The popup object must be named C<'AltPopup'>.

=back

=head2 Events

=over

=item Load

Called when the widget is loaded from a file or the clipboard.

=back

=head1 Prima::VB::Types::generic

Root of all type classes.

A type class can be used with
and without object instance. The instantiated class
contains reference to ID string, which is a property
name that the object presents in the object inspector,
and WIDGET, which is the property applied to. When
the object inspector switches widgets, the type object
is commanded to update the references.

A class must also be usable without object instance,
in particular, in C<write> method. It is called to
export the property value in a storable format
as a string, better as a perl-evaluable expression.

=head2 Methods

=over


=item new CONTAINER, ID, WIDGET

Constructor method. CONTAINER is a panel widget in the object
inspector, where the type object can insert property value
selector widgets.

=item renew ID, WIDGET

Resets property name and the widget.

=item quotable STRING

Returns quotable STRING.

=item printable STRING

Returns a string that can be stored in a file.

=back

=head2 Callbacks

=over

=item change

( run in 0.957 second using v1.01-cache-2.11-cpan-364913b4093 )