Re: rounded rectangles problem

[James Muir <hemlock vtlink net>]

Here's the latest RoundedRect.pm. It works great! Are there any 
improvements that should be made before I call it done?

#!/usr/bin/perl -w
#
# RoundedRect: Create a Gnome2::Canvas::Item rounded rectangle.
#
# This module inherits from Gnome2::Canvas::Shape via 
Glib::Object::Subclass.
#
# Author: James Muir (hemlock vtlink net).
#
# Thanks: muppet, Jan Hudec, gtk-perl-list gnome org
#
# Sample Usage:
#
# use strict;
# use Gtk2 '-init';
# use Gnome2::Canvas;
# use RoundedRect;
#
# my $window = Gtk2::Window->new();
#
# $window->set_default_size(200,200);
# $window->signal_connect (destroy=>sub {Gtk2->main_quit;});
#
# my $canvas = Gnome2::Canvas->new_aa();
#
# $window->add($canvas);
#
# my $rect = Gnome2::Canvas::Item->new ($canvas->root, 'RoundedRect',
# radius=>10, x1=>0, y1=>0, x2=>100, y2=>100,
# width_pixels=>5, outline_color=>'black',
# fill_color=>'white');
#
# $window->show_all;
#
# Gtk2->main;
#
# Notes: In order to receive events while mousing over the interior of the
# rounded rectangle, you must fill the rounded rectangle with a color.
#
# The corner radius of the rectangle may be up to 3/8ths of the
# shortest side of the rectangle.
#
# -------------------------------------------------------------------------
package RoundedRect;

use strict;
use Gnome2::Canvas;
use POSIX qw(DBL_MAX);

use Glib ':constants';
use Glib::Object::Subclass
Gnome2::Canvas::Shape::,
properties => [
Glib::ParamSpec->double ('radius', 'corner_radius', 'Radius of corners',
0.0, DBL_MAX, 10.0, G_PARAM_READWRITE),

Glib::ParamSpec->double ('x1', 'x1', 'Upper left X coord',
-(DBL_MAX), DBL_MAX, 0.0, G_PARAM_READWRITE),

Glib::ParamSpec->double ('y1', 'y1', 'Upper left Y coord',
-(DBL_MAX), DBL_MAX, 0.0, G_PARAM_READWRITE),

Glib::ParamSpec->double ('x2', 'x2', 'Lower right X coord',
-(DBL_MAX), DBL_MAX, 0.0, G_PARAM_READWRITE),

Glib::ParamSpec->double ('y2', 'y2', 'Lower right Y coord',
-(DBL_MAX), DBL_MAX, 0.0, G_PARAM_READWRITE),
]
;


sub SET_PROPERTY
{
my ($self, $pspec, $newval) = @_;

$self->{$pspec->get_name} = $newval;

# Set the path for the rectangle after we've received all the coordinates.
# Use Glib::Object::get method to fetch values for parameters as it will 
pickup
# default values.

if ((defined $self->{x1}) && (defined $self->{y1}) &&
(defined $self->{x2}) && (defined $self->{y2}))
{
$self->set_path_def(_roundedRect($self->get (qw(radius x1 y1 x2 y2))));
}
}


# _roundedRect: return the rounded rectangle path.
# --------------------------------------------------------
sub _roundedRect
{
my ($r, $x1, $y1, $x2, $y2) = @_;

# Make sure (x1,y1) is upper left.

if ($y1 > $y2)
{
my $t1 = $y1; $y1 = $y2; $y2 = $t1;
}

if ($x1 > $x2)
{
my $t1 = $x1; $x1 = $x2; $x2 = $t1;
}

# Limit size of the corner radius.

my $max_radius = _min(($x2 - $x1), ($y2 - $y1)) * 3 / 8;

$r = _max(0, _min($r, $max_radius));

# Get the points for the path.

my @p = ();

push @p, _bezier('UPPER_LEFT', $r, $x1, $y1);
push @p, _bezier('UPPER_RIGHT', $r, $x2, $y1);
push @p, _bezier('LOWER_RIGHT', $r, $x2, $y2);
push @p, _bezier('LOWER_LEFT', $r, $x1, $y2);

# Build the rounded rectangle path.

my $pathdef = Gnome2::Canvas::PathDef->new();

$pathdef->moveto ($p[0], $p[1]);
$pathdef->curveto ($p[2], $p[3], $p[4], $p[5], $p[6], $p[7]);
$pathdef->lineto ($p[8], $p[9]);
$pathdef->curveto ($p[10], $p[11], $p[12], $p[13], $p[14], $p[15]);
$pathdef->lineto ($p[16], $p[17]);
$pathdef->curveto ($p[18], $p[19], $p[20], $p[21], $p[22], $p[23]);
$pathdef->lineto ($p[24], $p[25]);
$pathdef->curveto ($p[26], $p[27], $p[28], $p[29], $p[30], $p[31]);
$pathdef->lineto ($p[0], $p[1]);

# Close the path so that 'fill-color' will work.

$pathdef->closepath_current;

return $pathdef;
}


# _bezier: return corner bezier points.
# --------------------------------------------------------
sub _bezier
{
my $corner = shift(@_);
my $r = shift(@_);
my $x = shift(@_);
my $y = shift(@_);

if ($corner eq 'UPPER_LEFT')
{
return ($x,$y+$r, $x,$y+($r/2), $x+($r/2),$y, $x+$r, $y);
}

if ($corner eq 'UPPER_RIGHT')
{
return ($x-$r,$y, $x-($r/2),$y, $x,$y+($r/2), $x, $y+$r);
}

if ($corner eq 'LOWER_RIGHT')
{
return ($x,$y-$r, $x,$y-($r/2), $x-($r/2),$y, $x-$r, $y);
}

if ($corner eq 'LOWER_LEFT')
{
return ($x+$r,$y, $x+($r/2),$y, $x,$y-($r/2), $x, $y-$r);
}

return ();
}


# _max: maximum of two values.
# --------------------------------------------------------
sub _max
{
my $i = shift(@_);
my $j = shift(@_);

return (($i > $j) ? $i : $j);
}


# _min: minimum of two values.
# --------------------------------------------------------
sub _min
{
my $i = shift(@_);
my $j = shift(@_);

return (($i > $j) ? $j : $i);
}



1;