# Ideas in progress do not document ...
$VERSION = '3.004'; # $Id: //depot/Tk8/Tk/Region.pm#4 $
Construct Tk::Widget 'Region';
my %index = (-widget => 1, '-x' => 2, '-y' => 3, -width => 4, -height => 5);
my ($obj,$key,$val) = @_;
foreach my $name (qw(widget x y width height))
*{$name} = sub { shift->_attr($key,@_) };
my $obj = bless [\
%index,$widget,0,0,0,0],$class;
return ucfirst(shift->cfgName(@_));
my ($meth) = $key =~ /^-(\w+)$/;
croak
("Invalid option $key") unless $obj->can($meth);
my $value = $obj->cget($key);
push(@results,$key,$obj->cfgName($key),$obj->cfgClass($key),$obj->cfgDefault($key),$value);
foreach my $key (sort keys %$obj)
push(@results,scalar($obj->configure($key)))
return wantarray ?
@results : \
@results;
return $obj->{$key} if exists $obj->{$key};
my ($meth) = $key =~ /^-(\w+)$/;
croak
("Invalid option $key") unless $obj->can($meth);
my $ref = (@_ == 1) ?
shift : \
@_;
my ($x1,$y1,$x2,$y2) = (ref $ref) ? @
$ref : split(/\s+/,$ref);
($x2,$x1) = ($x1,$x2) if ($x2 < $x1);
($y2,$y1) = ($y1,$y2) if ($y2 < $y1);
push(@results,$x,$y,$x+$obj->width,$y+$obj->height);
return wantarray ?
@results : \
@results;
$obj->x($x-$obj->widget->rootx);
return $obj->widget->rootx + $obj->{'-x'}
$obj->y($y-$obj->widget->rootx);
return $obj->widget->rooty + $obj->{'-y'}
my @results = ($obj->rootx,$obj->rooty);
return wantarray ?
@results : \
@results;
my ($x1,$y1) = $obj->rootxy;
my $x2 = $x1+$obj->width;
my $y2 = $y1+$obj->height;
my @results = ($x1,$y1,$x2,$y2);
return wantarray ?
@results : \
@results;