#!/usr/bin/perl 

use warnings;
use strict;
use Tk;

# create a Main window and a scrolled text widget
my $mw   = MainWindow->new();
my $text = $mw->Scrolled(
    "Text",
    -scrollbars => 'e',
    -relief     => 'sunken',
    -takefocus  => 1
)->pack( -expand => 1, -fill => 'both' );

# redefine the scrollbar's callback that tells the Text to scroll
$text->Subwidget("yscrollbar")->configure( -command => \&Yscrollcallback, );

# add bindings for MouseWheel and for the Y arrow keys
$text->bind( "<MouseWheel>", \&OnYscrolllimit );
$text->bind( "<Key-Up>",     \&OnYarrowlimit );
$text->bind( "<Key-Down>",   \&OnYarrowlimit );

# for demo, fill Text with some lines ...
for ( 1 .. 200 ) {
    $text->insert( 'end', "$_ test\n" );
    $text->see('end');
}

my $lineAdded = 0; # and count the inserted ones

MainLoop;

### subs

sub Yscrollcallback {
    $text->yview(@_);	# scrollbar tells Text to scroll or moveto
    OnYscrolllimit();		# additional behavior
}

sub OnYarrowlimit {
    my $i = int( $text->index('insert') );
    my $e = int( $text->index('end') );
    if ( $i == 1 ) {
        insertLines('1.0');	# up arrow hits the first line
    }
    elsif ( $i == $e - 1 ) {
        insertLines('end');	# down arrow hits the last line
    }
}

sub OnYscrolllimit {
    my ( $top, $bot ) = $text->yview;
    if ( $top == 0 ) {
        insertLines('1.0');	# wheel or scrollbar try to go above the first line
    }
    elsif ( $bot == 1 ) {
        insertLines('end');	# wheel or scrollbar try to go below the last line
    }
}

sub insertLines {
    my $where = shift;
    my $number = shift || 1;
    return unless $where =~ /^1.0|end$/;
    ++$lineAdded;
    #print "insert [$lineAdded]: $where $number\n";
    $text->insert( $where, "insertLines at $where $lineAdded\n" );
    $text->see($where);
}

__END__