File Coverage

blib/lib/Tk/CornerBox.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Tk::CornerBox;

use Tk::Canvas;
use Tk::Frame;
use Tk;

use vars qw ($VERSION $TRIMCOUNT);
use base qw (Tk::Frame);
use strict;

$VERSION = '0.02';

$TRIMCOUNT = 3;

Tk::Widget->Construct ('CornerBox');

sub Populate
   {
    my $this = shift;

    $this->SUPER::Populate (@_);

    my $l_Canvas = $this->Component
       (
        'Canvas' => 'Canvas',
        '-width' => 20,
        '-height' => 20,
        '-borderwidth' => 0,
        '-highlightthickness' => 0,
       );

    $l_Canvas->pack
       (
        '-fill' => 'both',
        '-expand' => 'false',
        '-padx' => 0,
        '-pady' => 0,
       );

    $l_Canvas->Tk::bind ('' => [\&Press, $this]);
    $l_Canvas->Tk::bind ('' => [\&Resize, $this]);
    $l_Canvas->Tk::bind ('' => [\&Configure, $this]);
    $this->Tk::bind ('' => [\&Enter, $this]);
    $this->Tk::bind ('' => [\&Leave, $this]);

    return $this;
   }

sub Configure
   {
    my ($p_Canvas, $this) = @_;

    return unless ($this->IsMapped());

    my $l_Height = $this->height();
    my $l_Width = $this->width();

    $p_Canvas->configure
       (
        '-scrollregion' => [0, 0, $l_Width, $l_Height],
       );

    unless (defined ($this->{'m_TrimList'}))
       {
        my $l_HighColor = $this->Darken ($this->cget ('-background'), 150);
        my $l_LowColor = $this->Darken ($this->cget ('-background'), 60);

        for (my $l_Index = 0; $l_Index < $TRIMCOUNT; ++$l_Index)
           {
            push
               (
                @{$this->{'m_TrimList'}},
                $p_Canvas->create ('line', 30, 0, 0, 30, '-fill' => $l_HighColor),
                $p_Canvas->create ('line', 30, 1, 1, 30, '-fill' => $l_LowColor),
               );
           }
       }

    for (my $l_Index = 0; $l_Index <= $#{$this->{'m_TrimList'}}; $l_Index += 2)
       {
        my ($l_Light, $l_Dark) = @{$this->{'m_TrimList'}} [$l_Index .. ($l_Index + 1)];
        my $l_Divisor = (($l_Index + 2) / 2) - 1;

        $p_Canvas->coords
           (
            $l_Light,
            $l_Width, ($l_Height / ($TRIMCOUNT + 1)) * $l_Divisor,
            ($l_Width / ($TRIMCOUNT + 1)) * $l_Divisor, $l_Height,
           );

        $p_Canvas->coords
           (
            $l_Dark,
            $l_Width, (($l_Height / ($TRIMCOUNT + 1)) * $l_Divisor) + 2,
            ($l_Width / (($TRIMCOUNT + 1)) * $l_Divisor) + 2, $l_Height,
           );
       }
   }

sub Enter
   {
    $_[0]->{'m_Cursor'} = $_[0]->cget ('-cursor');
    $_[0]->configure ('-cursor' => ($^O =~ /^(MSWin32|DOS)$/ ? 'size_nw_se' : 'bottom_right_corner'));
   }

sub Leave
   {
    $_[0]->configure ('-cursor' => $_[0]->{'m_Cursor'} || 'arrow');
   }

sub Press
   {
    $_[1]->{'-deltax'} = $_[1]->pointerx();
    $_[1]->{'-deltay'} = $_[1]->pointery();
   }

sub Resize
   {
    my @l_Coordinates = split (/[+x]/, $_[1]->toplevel()->geometry());

    $l_Coordinates [0] += ($_[1]->pointerx() - $_[1]->{'-deltax'});
    $l_Coordinates [1] += ($_[1]->pointery() - $_[1]->{'-deltay'});

    $_[1]->{'-deltax'} = $_[1]->pointerx();
    $_[1]->{'-deltay'} = $_[1]->pointery();

    $_[1]->toplevel()->geometry
       (
        $l_Coordinates [0].'x'.$l_Coordinates [1] # .'+'.$l_Coordinates [2].'+'.$l_Coordinates [3]
       );
   }

1;

__END__