#
# 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$
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} = $self->{scrollBarClass}-> 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->{hScrollBarProfile} || {} },
);
$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) {
my $width = exists( $self->{vScrollBarProfile}->{width} ) ?
$self->{vScrollBarProfile}->{width} :
$Prima::ScrollBar::stdMetrics[0];
$self-> {vScrollBar} = $self->{scrollBarClass}-> new(
owner => $self,
name => q(VScroll),
vertical => 1,
left => $size[0] - $bw - $width + 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->{vScrollBarProfile} || {} },
);
$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.
=item scrollBarClass STRING = Prima::ScrollBar
Create-only property that allows to change scrollbar class
=item hScrollBarProfile, vScrollBarProfile HASH
Create-only property that allows to change scrollbar parameters when it is being created
=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