Re: subclassing Glib::Boxed

[Kevin Ryde <user42 zip com au>]

muppet <scott asofyet org> writes:
> Furthermore, you want to compare  
> the boxed objects by value, not by address, because the C code is  
> allowed to and often does copy boxed objects at will.

Oh, umm, yep copies or aliases to the underlying C pointer will be ok.
Unless $self+0 (the ref numerically) moves about, that'd be no good.

> I'm curious as to what you're trying to do; with more info we could  
> give better alternative suggestions.

:)  I was thinking about representing a colour allocated in a colormap
as a subclass of Gtk2::Gdk::Color, along the lines below (incomplete).
The advantage would be automatic freeing of the pixel on chucking away
the object, plus some room for a friendly widget-oriented "new" func.

The actual pixel resource is of course just an integer, but if it's in a
subclass of Gtk2::Gdk::Color then you can pass it straight to the GC
colour setting funcs and stuff.  The extra instance data is the
Gtk2::Gdk::Colormap object for use in the eventual freeing.

(I'm normally against excessive OOP, I'm slightly suspicious this idea
might be a case of that.  Within a widget there's probably enough good
places to alloc/free/change that you don't need an object wrapper to
manage the lifespan, if you know what I mean.  And getting it wrong has
no effect on a TrueColor visual of course, though a way to be confident
that you'll be doing the right thing on a rarely used pseudocolor might
be no bad thing.)



package Gtk2::Ex::ColorAlloc;
use strict;
use warnings;
use Carp;
use Gtk2;
use base 'Gtk2::Gdk::Color';

our %color_to_colormap = ();

sub new {
  my ($class, %params) = @_;
  # ... various friendly option crunching

  my $color = Gtk2::Gdk::Color->parse ($name)
    or croak "Gtk2::Ex::ColorAlloc->new: cannot parse colour \"$name\"";

  $colormap->alloc_color ($color, $writeable, $best_match)
    or croak "Gtk2::Ex::ColorAlloc->new: cannot allocate colour cell";

  my $self = bless $color, $class;  # rebless
  my $key = $self + 0;              # hash by address
  $color_to_colormap{$key} = $colormap;
  return $self;
}

sub DESTROY {
  my ($self) = @_;
  my $key = $self + 0;  # hash by address
  if (my $colormap = delete $color_to_colormap{$key}) {
    $colormap->free_colors ($self);
  }
  $self->SUPER::DESTROY;
}