File Coverage

blib/lib/Data/Page/Viewport.pm

Criterion	Covered	Total	%
statement	51	57	89.4
branch	10	20	50.0
condition	11	15	73.3
subroutine	7	9	77.7
pod	0	3	0.0
total	79	104	75.9

package Data::Page::Viewport;

# Name:
#	Data::Page::Viewport.
#
# Documentation:
#	POD-style documentation is at the end. Extract it with pod2html.*.
#
# Reference:
#	Object Oriented Perl
#	Damian Conway
#	Manning
#	1-884777-79-1
#	P 114
#
# Note:
#	o Tab = 4 spaces || die.
#
# Author:
#	Ron Savage
#	Home page: http://savage.net.au/index.html
#
# Licence:
#	Australian copyright (c) 1999-2002 Ron Savage.
#
#	All Programs of mine are 'OSI Certified Open Source Software';
#	you can redistribute them and/or modify them under the terms of
#	The Artistic License, a copy of which is available at:
#	http://www.opensource.org/licenses/index.html

use strict;
use warnings;
no warnings 'redefine';

require 5.005_62;

use Set::Window;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Data::Page::Viewport ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '1.06';

# -----------------------------------------------

# Encapsulated class data.

{
	my(%_attr_data) =
	(	# Alphabetical order.
		_data_size	=> - 1,
		_old_style	=> 0,
		_page_size	=> - 1,
	);

	sub _default_for
	{
		my($self, $attr_name) = @_;

		$_attr_data{$attr_name};
	}

	sub _standard_keys
	{
		sort keys %_attr_data;
	}

}	# End of Encapsulated class data.

# -----------------------------------------------

sub current
{
	my($self) = @_;

	$$self{'_current'};

}	# End of current.

# -----------------------------------------------

sub new
{
	my($caller, %arg)	= @_;
	my($caller_is_obj)	= ref($caller);
	my($class)			= $caller_is_obj || $caller;
	my($self)			= bless({}, $class);

	for my $attr_name ($self -> _standard_keys() )
	{
		my($arg_name) = $attr_name =~ /^_(.*)/;

		if (exists($arg{$arg_name}) )
		{
			$$self{$attr_name} = $arg{$arg_name};
		}
		elsif ($caller_is_obj)
		{
			$$self{$attr_name} = $$caller{$attr_name};
		}
		else
		{
			$$self{$attr_name} = $self -> _default_for($attr_name);
		}
	}

	$$self{'_current'}					= 0;
	$$self{'_port'}						= {};
	$$self{'_port'}{'inner'}			= {};
	$$self{'_port'}{'inner'}{'top'}		= 0; # Top (upwards on screen) and bottom of viewport.
	$$self{'_port'}{'inner'}{'bottom'}	= $$self{'_page_size'} - 1;
	$$self{'_port'}{'outer'}			= {};
	$$self{'_port'}{'outer'}{'top'}		= 0; # Top and bottom of fixed data.
	$$self{'_port'}{'outer'}{'bottom'}	= $$self{'_data_size'};
	$$self{'_inner'}					= Set::Window -> new_lr($$self{'_port'}{'inner'}{'top'}, $$self{'_port'}{'inner'}{'bottom'});
	$$self{'_outer'}					= Set::Window -> new_lr($$self{'_port'}{'outer'}{'top'}, $$self{'_port'}{'outer'}{'bottom'});
	$$self{'_page_size'}				= $$self{'_page_size'} - 1;

	$self;

}	# End of new.

# -----------------------------------------------

sub offset
{
    my($self, $offset) = @_;
	($$self{'_port'}{'inner'}{'top'}, $$self{'_port'}{'inner'}{'bottom'}) = $$self{'_inner'} -> bounds();

	if ($offset > 0)
	{
		$$self{'_current'}	+= $offset;
		$$self{'_current'}	= $$self{'_port'}{'outer'}{'bottom'} if ($$self{'_current'} > $$self{'_port'}{'outer'}{'bottom'});
		my($permit)			= $$self{'_old_style'} ? 1 : $$self{'_current'} > $$self{'_port'}{'inner'}{'bottom'} ? 1 : 0;

		# If we are scrolling down, and the scroll would leave something visible
		# within the viewport, then permit the scroll.

		while ($permit && ($offset > 0) && ( ($$self{'_port'}{'inner'}{'top'} + $$self{'_page_size'}) < $$self{'_port'}{'outer'}{'bottom'}) )
		{
			$offset--;

	 		$$self{'_inner'} = $$self{'_inner'} -> offset(1);
			($$self{'_port'}{'inner'}{'top'}, $$self{'_port'}{'inner'}{'bottom'}) = $$self{'_inner'} -> bounds();
		}
	}
	elsif ($offset < 0)
	{
		$$self{'_current'}	+= $offset; # + because offset is -!
		$$self{'_current'}	= $$self{'_port'}{'outer'}{'top'} if ($$self{'_current'} < $$self{'_port'}{'outer'}{'top'});
		my($permit)			= $$self{'_old_style'} ? 1 : $$self{'_current'} < $$self{'_port'}{'inner'}{'top'} ? 1 : 0;

		# If we are scrolling up, and the scroll would leave something visible
		# within the viewport, then permit the scroll.

		while ($permit && ($offset < 0) && ( ($$self{'_port'}{'inner'}{'bottom'} - $$self{'_page_size'}) > $$self{'_port'}{'outer'}{'top'}) )
		{
			$offset++;

	 		$$self{'_inner'} = $$self{'_inner'} -> offset(- 1);
			($$self{'_port'}{'inner'}{'top'}, $$self{'_port'}{'inner'}{'bottom'}) = $$self{'_inner'} -> bounds();
		}
	}

	# Return the viewport, knowing now that when the user calls bounds(),
	# there will definitely be something visible within the viewport.

	$$self{'_inner'} -> intersect($$self{'_outer'});

}	# End of offset.

# -----------------------------------------------

1;

__END__