libprima-perl 1.28-1.1 / usr / lib / perl5 / Prima / IntUtils.pm

#
#  Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#  Created by Dmitry Karasik <dk@plab.ku.dk>
#
#  $Id: IntUtils.pm,v 1.28 2008/04/09 19:06:17 dk Exp $
package Prima::IntUtils;

use strict;
use Prima::Const;

package Prima::MouseScroller;

my $scrollTimer;

sub scroll_timer_active
{
	return 0 unless defined $scrollTimer;
	return $scrollTimer-> {active};
}

sub scroll_timer_semaphore
{
	return 0 unless defined $scrollTimer;
	$#_ ?
		$scrollTimer-> {semaphore} = $_[1] :
		return $scrollTimer-> {semaphore};
}

sub scroll_timer_stop
{
	return unless defined $scrollTimer;
	$scrollTimer-> stop;
	$scrollTimer-> {active} = 0;
	$scrollTimer-> timeout( $scrollTimer-> {firstRate});
	$scrollTimer-> {newRate} = $scrollTimer-> {nextRate};
}

sub scroll_timer_start
{
	my $self = $_[0];
	$self-> scroll_timer_stop;
	unless ( defined $scrollTimer) {
		my @rates = $::application-> get_scroll_rate;
		$scrollTimer = Prima::Timer-> create(
			owner      => $::application,
			timeout    => $rates[0],
			name       => q(ScrollTimer),
			onTick     => sub { $_[0]-> {delegator}-> ScrollTimer_Tick( @_)},
			onDestroy  => sub { undef $scrollTimer },
		);
		@{$scrollTimer}{qw(firstRate nextRate newRate)} = (@rates,$rates[1]);
	}
	$scrollTimer-> {delegator} = $self;
	$scrollTimer-> {semaphore} = 1;
	$scrollTimer-> {active} = 1;
	$scrollTimer-> start;
}

sub ScrollTimer_Tick
{
	my ( $self, $timer) = @_;
	if ( exists $scrollTimer-> {newRate})
	{
		$timer-> timeout( $scrollTimer-> {newRate});
		delete $scrollTimer-> {newRate};
	}
	$scrollTimer-> {semaphore} = 1;
	$self-> notify(q(MouseMove), 0, $self-> pointerPos);
	$self-> scroll_timer_stop unless defined $self-> {mouseTransaction};
}

package Prima::IntIndents;

sub indents
{
	return wantarray ? @{$_[0]-> {indents}} : [@{$_[0]-> {indents}}] unless $#_;
	my ( $self, @indents) = @_;
	@indents = @{$indents[0]} if ( scalar(@indents) == 1) && ( ref($indents[0]) eq 'ARRAY');
	for ( @indents) {
		$_ = 0 if $_ < 0;
	}
	$self-> {indents} = \@indents;
}

sub get_active_area
{
	my @r = ( scalar @_ > 2) ? @_[2,3] : $_[0]-> size;
	my $i = $_[0]-> {indents};
	if ( !defined($_[1]) || $_[1] == 0) {
		# returns inclusive - exclusive
		return $$i[0], $$i[1], $r[0] - $$i[2], $r[1] - $$i[3];
	} elsif ( $_[1] == 1) {
		# returns inclusive - inclusive
		return $$i[0], $$i[1], $r[0] - $$i[2] - 1, $r[1] - $$i[3] - 1;
	} else {
		# returns size
		return $r[0] - $$i[0] - $$i[2], $r[1] - $$i[1] - $$i[3];
	}
}

package Prima::GroupScroller;
use vars qw(@ISA);
@ISA = qw(Prima::IntIndents);

use Prima::ScrollBar;

sub setup_indents
{
	my ($self) = @_;
	$self-> {indents} = [ 0,0,0,0];
	my $bw = $self-> {borderWidth};
	$self-> {indents}-> [$_] += $bw for 0..3;
	$self-> {indents}-> [1] += $self-> {hScrollBar}-> height - 1 if $self-> {hScroll};
	$self-> {indents}-> [2] += $self-> {vScrollBar}-> width - 1 if $self-> {vScroll};
}

sub set_border_width
{
	my ( $self, $bw) = @_;

	my @size = $self-> size;
	$bw = 0 if $bw < 0;
	$bw = 1 if $bw > $size[1] / 2;
	$bw = 1 if $bw > $size[0] / 2;
	return if $bw == $self-> {borderWidth};
	
	my $obw  = $self-> {borderWidth};
	$self-> {borderWidth} = $bw;
	
	$self-> {hScrollBar}-> set(
		left   => $bw - 1,
		bottom => $bw - 1,
		width  => $size[0] - 
			$bw * 2 + 
			2 - 
			( $self-> {vScroll} ? 
				$self-> {vScrollBar}-> width - 2 : 
				0
			),
	) if $self-> {hScroll};
	
	$self-> {vScrollBar}-> set(
		top    => $size[1] - $bw + 1,
		right  => $size[0] - $bw + 1,
		bottom => $bw + ( $self-> {hScroll} ? 
			$self-> {hScrollBar}-> height - 2 : 
			0
		),
	) if $self-> {vScroll};
	
	$self-> insert_bone if defined $self-> {bone};
	
	$self-> setup_indents;
	$self-> reset_indents;
}

sub reset_indents {}

sub insert_bone
{
	my $self = $_[0];
	my $bw   = $self-> {borderWidth};
	$self-> {bone}-> destroy if defined $self-> {bone};

	$self-> {bone} = Prima::Widget-> new(
		owner  => $self,
		name   => q(Bone),
		pointerType => cr::Arrow,
		origin => [ $self-> width - $self-> {vScrollBar}-> width + 3 - $bw, $bw - 1],
		size   => [ $self-> {vScrollBar}-> width-2, $self-> {hScrollBar}-> height-1],
		growMode  => gm::GrowLoX,
		widgetClass => wc::ScrollBar,
		designScale => undef,
		onPaint   => sub {
			my ( $self, $canvas, $owner, $w, $h) = 
				($_[0], $_[1], $_[0]-> owner, $_[0]-> size);
			$canvas-> color( $self-> backColor);
			$canvas-> bar( 0, 1, $w - 2, $h - 1);
			$canvas-> color( $owner-> light3DColor);
			$canvas-> line( 0, 0, $w - 1, 0);
			$canvas-> line( $w - 1, 0, $w - 1, $h - 1);
		},
	);
}

sub set_h_scroll
{
	my ( $self, $hs) = @_;
	return if $hs == $self-> {hScroll};
	my $bw = $self-> {borderWidth} || 0;
	if ( $self-> {hScroll} = $hs) {
		$self-> {hScrollBar} = Prima::ScrollBar-> new(
			owner       => $self,
			name        => q(HScroll),
			vertical    => 0,
			origin      => [ $bw-1, $bw-1],
			growMode    => gm::GrowHiX,
			pointerType => cr::Arrow,
			width       => $self-> width - 
				2 * $bw + 2 - 
				( $self-> {vScroll} ? 
					$self-> {vScrollBar}-> width - 2 : 
					0),
			delegations => ['Change'],
			designScale => undef,
		);
		
		$self-> setup_indents;

		if ( $self-> {vScroll}) {
			my $h = $self-> {hScrollBar}-> height;
			$self-> {vScrollBar}-> set(
				bottom => $self-> {vScrollBar}-> bottom + $h - 2,
				top    => $self-> {vScrollBar}-> top,
			);
			$self-> insert_bone;
		}
	} else {
		$self-> setup_indents;
		$self-> {hScrollBar}-> destroy;
		
		if ( $self-> {vScroll})
		{
			$self-> {vScrollBar}-> set(
				bottom => $bw,
				height => $self-> height - $bw * 2,
			);
			$self-> {bone}-> destroy;
			delete $self-> {bone};
		}
	}
	$self-> reset_indents;
}

sub set_v_scroll
{
	my ( $self, $vs) = @_;
	return if $vs == $self-> {vScroll};

	my $bw = $self-> {borderWidth} || 0;
	my @size = $self-> size;
	
	if ( $self-> {vScroll} = $vs) {
		$self-> {vScrollBar} = Prima::ScrollBar-> new(
			owner    => $self,
			name     => q(VScroll),
			vertical => 1,
			left     => $size[0] - $bw - $Prima::ScrollBar::stdMetrics[0] + 1,
			top      => $size[1] - $bw + 1,
			bottom   => $bw + ( $self-> {hScroll} ? $self-> {hScrollBar}-> height - 2 : 0),
			growMode => gm::GrowLoX | gm::GrowHiY,
			pointerType  => cr::Arrow,
			delegations  => ['Change'],
			designScale => undef,
		);
		
		$self-> setup_indents;

		if ( $self-> {hScroll}) {
			$self-> {hScrollBar}-> width(
				$self-> {hScrollBar}-> width -
				$self-> {vScrollBar}-> width + 2,
			);
			$self-> insert_bone;
		}
	} else {
		$self-> setup_indents;
		$self-> {vScrollBar}-> destroy;
		if ( $self-> {hScroll})
		{
			$self-> {hScrollBar}-> width( $size[0] - 2 * $bw + 2);
			$self-> {bone}-> destroy;
			delete $self-> {bone};
		}
	}
	$self-> reset_indents;
}

sub autoHScroll
{
	return $_[0]-> {autoHScroll} unless $#_;
	my $v = ( $_[1] ? 1 : 0);
	return unless $v != $_[0]-> {autoHScroll};
	$_[0]-> {autoHScroll} = $v;
}

sub autoVScroll
{
	return $_[0]-> {autoVScroll} unless $#_;
	my $v = ( $_[1] ? 1 : 0);
	return unless $v != $_[0]-> {autoVScroll};
	$_[0]-> {autoVScroll} = $v;
}

sub borderWidth     {($#_)?($_[0]-> set_border_width( $_[1])):return $_[0]-> {borderWidth}}
sub hScroll         {($#_)?$_[0]-> set_h_scroll       ($_[1]):return $_[0]-> {hScroll}}
sub vScroll         {($#_)?$_[0]-> set_v_scroll       ($_[1]):return $_[0]-> {vScroll}}

sub draw_border
{
	my ( $self, $canvas, $backColor, @size) = @_;

	@size = $self-> size unless @size;
	$self-> rect_bevel(
		$canvas,
		0, 0,
		$size[0]-1, $size[1]-1,
		width => $self-> {borderWidth},
		panel => 1,
		fill  => $backColor,
	);
}

1;

__DATA__

=head1 NAME

Prima::IntUtils - internal functions

=head1 DESCRIPTION

The module provides packages, containing common functionality
for some standard classes. The packages are designed as a code
containers, not as widget classes, and are to be used as 
secondary ascendants in the widget inheritance declaration.

=head1 Prima::MouseScroller

Implements routines for emulation of auto repeating mouse events.
A code inside C<MouseMove> callback can be implemented by
the following scheme:

	if ( mouse_pointer_inside_the_scrollable_area) {
		$self-> scroll_timer_stop;
	} else {
		$self-> scroll_timer_start unless $self-> scroll_timer_active;
		return unless $self-> scroll_timer_semaphore;
		$self-> scroll_timer_semaphore( 0);
	}

The class uses a semaphore C<{mouseTransaction}>, which should
be set to non-zero if a widget is in mouse capture state, and set 
to zero or C<undef> otherwise.

The class starts an internal timer, which sets a semaphore and
calls C<MouseMove> notification when triggered. The timer is
assigned the timeouts, returned by C<Prima::Application::get_scroll_rate>
( see L<Prima::Application/get_scroll_rate> ).

=head2 Methods

=over

=item scroll_timer_active

Returns a boolean value indicating if the internal timer is started.

=item scroll_timer_semaphore [ VALUE ]

A semaphore, set to 1 when the internal timer was triggered. It is advisable
to check the semaphore state to discern a timer-generated event from
the real mouse movement. If VALUE is specified, it is assigned to the semaphore.

=item scroll_timer_start

Starts the internal timer.

=item scroll_timer_stop 

Stops the internal timer.

=back

=head1 Prima::IntIndents

Provides the common functionality for the widgets that delegate part of their
surface to the border elements. A list box can be of an example, where its
scroll bars and 3-d borders are such elements.

=head2 Properties

=over

=item indents ARRAY

Contains four integers, specifying the breadth of decoration elements for
each side. The first integer is width of the left element, the second - height
of the lower element, the third - width of the right element, the fourth - height
of the upper element.

The property can accept and return the array either as a four scalars, or as
an anonymous array of four scalars.

=back

=head2 Methods

=over

=item get_active_area [ TYPE = 0, WIDTH, HEIGHT ] 

Calculates and returns the extension of the area without the border elements,
or the active area.
The extension are related to the current size of a widget, however, can be
overridden by specifying WIDTH and HEIGHT. TYPE is an integer, indicating
the type of calculation:

=over

=item TYPE = 0

Returns four integers, defining the area in the inclusive-exclusive coordinates.

=item TYPE = 1

Returns four integers, defining the area in the inclusive-inclusive coordinates.

=item TYPE = 2

Returns two integers, the size of the area.

=back

=back

=head1 Prima::GroupScroller

The class is used for widgets that contain optional scroll bars, and provides means for
their maintenance. The class is the descendant of L<Prima::IntIndents>, and adjusts
the L<indents> property when scrollbars are shown or hidden, or L<borderWidth> is changed.

The class does not provide range selection for the scrollbars; the descentant classes
must implement that.

The descendant classes must follow the guidelines:

=over

=item *

A class must provide C<borderWidth>, C<hScroll>, and C<vScroll> property keys in profile_default() .
A class may provide C<autoHScroll> and C<autoVScroll> property keys in profile_default() .

=item *

A class' init() method must set C<{borderWidth}>, C<{hScroll}>, and C<{vScroll}> 
variables to 0 before the initialization, call C<setup_indents> method,
and then assign the properties from the object profile.

If a class provides C<autoHScroll> and C<autoVScroll> properties, these must be set to 
0 before the initialization.

=item *

If a class needs to overload one of C<borderWidth>, C<hScroll>, C<vScroll>,
C<autoHScroll>, and C<autoVScroll> properties,
it is mandatory to call the inherited properties.

=item *

A class must implement the scroll bar notification callbacks: C<HScroll_Change> and C<VScroll_Change>.

=item *

A class must not use the reserved variable names, which are:

	{borderWidth}  - internal borderWidth storage
	{hScroll}      - internal hScroll value storage
	{vScroll}      - internal vScroll value storage
	{hScrollBar}   - pointer to the horizontal scroll bar
	{vScrollBar}   - pointer to the vertical scroll bar
	{bone}         - rectangular widget between the scrollbars
	{autoHScroll}  - internal autoHScroll value storage
	{autoVScroll}  - internal autoVScroll value storage

The reserved method names:

	set_h_scroll
	set_v_scroll
	insert_bone
	setup_indents
	reset_indents
	borderWidth
	autoHScroll
	autoVScroll
	hScroll
	vScroll

The reserved widget names:

	HScroll
	VScroll
	Bone

=back

=head2 Properties

=over

=item autoHScroll BOOLEAN

Selects if the horizontal scrollbar is to be shown and hidden dynamically,
depending on the widget layout.

=item autoVScroll BOOLEAN

Selects if the vertical scrollbar is to be shown and hidden dynamically,
depending on the widget layout.

=item borderWidth INTEGER

Width of 3d-shade border around the widget.

Recommended default value: 2

=item hScroll BOOLEAN

Selects if the horizontal scrollbar is visible. If it is, C<{hScrollBar}>
points to it.

=item vScroll BOOLEAN

Selects if the vertical scrollbar is visible. If it is, C<{vScrollBar}>
points to it.

=back

=head2 Properties

=over

=item setup_indents

The method is never called directly; it should be called whenever widget
layout is changed so that indents are affected. The method is a request
to recalculate indents, depending on the widget layout.

The method is not reentrant; to receive this callback and update the widget
layout, that in turn can result in more C<setup_indents> calls, overload
C<reset_indents> .

=item reset_indents

Called after C<setup_indents> is called and internal widget layout is updated,
to give a chance to follow-up the layout changes.

=back

=head1 AUTHOR

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

=head1 SEE ALSO

L<Prima>, L<Prima::Widget>, L<Prima::InputLine>, L<Prima::Lists>, L<Prima::Edit>,
L<Prima::Outlines>, L<Prima::ScrollBar>.

=cut