view release on metacpan or  search on metacpan

Prima/Docks.pm  view on Meta::CPAN

	my ( $self, $mod, $x, $y) = @_;
	return unless $self-> {drag};
	my @rc;
	my $w = 3;
	$rc[$_]  = $self-> {orgRect}-> [$_] - $self-> {anchor}-> [0] + $x for ( 0, 2);
	$rc[$_]  = $self-> {orgRect}-> [$_] - $self-> {anchor}-> [1] + $y for ( 1, 3);
	goto LEAVE unless $self-> {dockingRoot};
	my ( $dm, $rect) = $self-> find_docking($self-> {dockingRoot}, \@rc);
	goto LEAVE unless $dm;
	@rc = @$rect;
	$w = 1;
LEAVE:
	$self-> {oldRect} = \@rc;
	$self-> xorrect( @{$self-> {oldRect}}, $w);
	$self-> clear_event;
}

sub on_keydown
{
	my ( $self, $code, $key, $mod) = @_;
	if ( $self-> {drag} && $key == kb::Esc) {
		$self-> drag(0);
		$self-> clear_event;
	}
}

sub on_mouseclick
{
	my ( $self, $btn, $mod, $x, $y, $dbl) = @_;
	return unless $dbl;
	$self-> dock( undef);
}

sub on_getcaps
{
	my ( $self, $docker, $prf) = @_;
	push( @{$prf-> {sizes}}, [$self-> size]);
	$prf-> {sizeable} = [ $self-> {x_sizeable}, $self-> {y_sizeable}];
	$prf-> {sizeMin}  = [ $self-> {indents}-> [2] + $self-> {indents}-> [0], $self-> {indents}-> [3] + $self-> {indents}-> [1]];
}

sub find_docking
{
	my ( $self, $dm, $pos) = @_;
	my $sid;
	unless ( exists $self-> {sessions}-> {$dm}) {
		if ( $self-> fingerprint & $dm-> fingerprint) {
			my %caps;
			$self-> notify(q(GetCaps), $dm, \%caps);
			if ( keys %caps) { # $dm is user-approved
				$caps{position} = [ @$pos] if $pos;
				$caps{self}     = $self;
				$sid = $dm-> open_session( \%caps);
			}
		}
		$self-> {sessions}-> {$dm} = $sid;
	} else {
		$sid = $self-> {sessions}-> {$dm};
	}
	return unless $sid;
	my $relocationCount;
AGAIN:
	#print "{$dm:@$pos:";
	my @retval;
	my @rc = $dm-> query( $sid, $pos ? @$pos : ());
	#print "(@rc)\n";
	goto EXIT unless scalar @rc;
	if ( 4 == scalar @rc) { # rect returned
		my $sd = $self-> {snapDistance};
		if ( $pos && defined($sd)) {
			if ( $self-> {drag} &&
					( # have to change the shape
					(( $$pos[2] - $$pos[0]) != ( $rc[2] - $rc[0])) ||
					(( $$pos[3] - $$pos[1]) != ( $rc[3] - $rc[1])))) {
				my @pp = $::application-> pointerPos;
				my @newpos;
				#print '.';
				for ( 0, 1) {
					my ( $a, $b) = ( $_, $_ + 2);
					my $lb = (( $$pos[$a] + $$pos[$b]) / 2) > $pp[$a]; # 1 if pointer is closer to left/bottom
					my $pdist = $lb ? $pp[$a] - $$pos[$a] : $$pos[$b] - $pp[$a];
					my $sz1 = $rc[$b] - $rc[$a];
					if ( $sz1 <= $pdist * 2) {
						$newpos[$a] = $pp[$a] - int( $sz1/2);
					} else {
						$newpos[$a] = $lb ? ( $pp[$a] - $pdist) : ( $pp[$a] + $pdist - $sz1);
					}
					$newpos[$b] = $newpos[$a] + $sz1;
				}
				# asking for the new position for the shape, if $dm can accept that...
				if ( 2 >= $relocationCount++) {
				#print "case1: @newpos\n";
				$pos = \@newpos;
				goto AGAIN;
				}
			} elsif ( $self-> {drag} && ( # have to change the position
					( $$pos[0] != $rc[0]) || ( $$pos[1] != $rc[1]))) {
				my @pp = $::application-> pointerPos;
				my @newpos = @pp;
				#print ',';
				for ( 0, 1) {
					my ( $a, $b) = ( $_, $_ + 2);
					$newpos[$a] = $rc[$a] if $newpos[$a] < $rc[$a];
					$newpos[$a] = $rc[$b] if $newpos[$a] > $rc[$b];
				}
				goto EXIT  if ( $sd < abs($pp[0] - $newpos[0])) || ( $sd < abs($pp[1] - $newpos[1]));
				# asking for the new position, and maybe new shape...
				if ( 2 >= $relocationCount++) {
				#print "case2: @rc\n";
				$pos = [@rc];
				goto AGAIN;
				}
			}
			goto EXIT if ($sd < abs($rc[0] - $$pos[0])) || ($sd < abs($rc[1] - $$pos[1]));
		}
		goto EXIT unless $self-> notify(q(Landing), $dm, @rc);
		#print "@rc\n";
		@retval = ($dm, \@rc);
	} elsif ( 1 == scalar @rc) { # new docker returned
		my $next = $rc[0];
		while ( $next) {
			my ( $dm_found, $npos) = $self-> find_docking( $next, $pos);
			@retval = ($dm_found, $npos), goto EXIT if $npos;
			$next = $dm-> next_docker( $sid, $pos ? @$pos[0,1] : ());
		}
	}
EXIT:
	unless ( $self-> {drag}) {
		$dm-> close_session( $sid);
		delete $self-> {sessions};
	}
	return @retval;
}

sub dock
{
	return $_[0]-> {dock} unless $#_;
	my ( $self, $dm, @rect) = @_;
	if ( $dm) {
		my %caps;
		my $stage = 0;
		my ( $sid, @rc, @s1rc);
AGAIN:
		if ( $self-> fingerprint && $dm-> fingerprint) {
			$self-> notify(q(GetCaps), $dm, \%caps);
			if ( keys %caps) { # $dm is user-approved
				unshift(@{$caps{sizes}}, [$rect[2] - $rect[0], $rect[3] - $rect[1]]) if scalar @rect;
				$caps{position} = [ @rect[0,1]] if scalar @rect;
				$caps{self}     = $self;
				$sid = $dm-> open_session( \%caps);
			}
		}
		return 0 unless $sid;
		@rc = $dm-> query( $sid, scalar(@rect) ? @rect : ());
		@s1rc = $dm-> rect;
		$dm-> close_session( $sid);
		if ( 1 == scalar @rc) { # readdress
			my ( $dm2, $rc) = $self-> find_docking( $dm, @rect ? [@rect] : ());
			$self-> dock( $dm2, $rc ? @$rc : ());
			return;
		}
		return 0 if 4 != scalar @rc;
		return 0 unless $self-> notify(q(Landing), $dm, @rc);

		unless ( $stage) {
			$self-> {dock}-> undock( $self) if $self-> {dock};
	# during the undock $dm may change its position ( and/or size), so retrying
			my @s2rc = $dm-> rect;

Prima/Docks.pm  view on Meta::CPAN

Assigns hash of properties, passed to the external shuttle widget during the creation.

=item fingerprint INTEGER

A custom bit mask, used to reject inappropriate dock widgets on early stage.

Default value: C<0x0000FFFF>

=item indents ARRAY

Contains four integers, specifying the breadth of offset in pixels for each
widget side in the docked state.

Default value: C<5,5,5,5>.

=item snapDistance INTEGER

A maximum offset, in pixels, between the actual shuttle coordinates and the coordinates
proposed by the dock widget, where the shuttle is allowed to land.
In other words, it is the distance between the dock and the shuttle when the latter
'snaps' to the dock during the dragging session.

Default value: 10

=item x_sizeable BOOLEAN

Selects whether the shuttle can change its width in case the dock widget suggests so.

Default value: 0

=item y_sizeable BOOLEAN

Selects whether the shuttle can change its height in case the dock widget suggests so.

Default value: 0

=back

=head2 Methods

=over

=item client2frame X1, Y1, X2, Y2

Returns a rectangle that the shuttle would occupy if
its client rectangle is assigned to X1, Y1, X2, Y2
rectangle.

=item dock_back

Docks to the recent dock widget, if it is still available.

=item drag STATE, RECT, ANCHOR_X, ANCHOR_Y

Initiates or aborts the dragging session, depending on STATE boolean
flag.

If it is 1, RECT is an array with the coordinates of the shuttle rectangle
before the drag has started; ANCHOR_X and ANCHOR_Y are coordinates of the
aperture point where the mouse event occurred that has initiated the drag.
Depending on how the drag session ended, the shuttle can be relocated to
another dock, undocked, or left intact. Also, C<Dock>, C<Undock>, or
C<FailDock> notifications can be triggered.

If STATE is 0, RECT, ANCHOR_X ,and ANCHOR_Y parameters are not used.

=item find_docking DOCK, [ POSITION ]

Opens a session with DOCK, unless it is already opened,
and negotiates about the possibility of landing (
at particular POSITION, if this parameter is present ).

C<find_docking> caches the dock widget sessions, and provides a
possibility to select different parameters passed to C<open_session>
for different dock widgets. To achieve this, C<GetCaps> request
notification is triggered, which fills the parameters. The default
action sets C<sizeable> options according to C<x_sizeable>
and C<y_sizeable> properties.

In case an appropriate landing area is found, C<Landing>
notification is triggered with the proposed dock widget
and the target rectangle. The area can be rejected on this stage
if C<Landing> returns negative answer.

On success, returns a dock widget found and the target rectangle;
the widget is never docked though. On failure returns an empty array.

This method is used by the dragging routine to provide a visual feedback to
the user, to indicate that a shuttle may or may not land in a particular
area.

=item frame2client X1, Y1, X2, Y2

Returns a rectangle that the client would occupy if
the shuttle rectangle is assigned to X1, Y1, X2, Y2
rectangle.

=item redock

If docked, undocks form the dock widget and docks back.
If not docked, does not perform anything.

=back

=head2 Events

=over

=item Dock

Called when shuttle is docked.

=item EDSClose

Triggered when the user presses close button or otherwise activates the
C<close> function of the EDS ( external docker shuttle ). To cancel
the closing, C<clear_event> must be called inside the event handler.

=item FailDock X, Y

Called after the dragging session in the non-docked stage is finished,