# Copyright 2007 Kevin Ryde

# This file is part of Gtk2-Ex-OOP.
#
# Gtk2-Ex-OOP is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Gtk2-Ex-OOP is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with this program.  If not, see <http://www.gnu.org/licenses/>.

package Gtk2::Ex::GtkGCobj;
use strict;
use warnings;
use Carp;

our @ISA = ('Gtk2::Gdk::GC');

use constant DEBUG => 1;

sub get {
  my $class = shift;
  my $self = Gtk2::GC->get (@_);
  $self->{'release_count'}++;
  return bless $self, $class;  # rebless
}

# DESTROY is called when the gc is no longer used from anywhere in perl.
# The dark magic in gtk2-perl will actually re-reference to keep it around
# if it's still in use by C code, so we have to cope with being "DESTROY"ed
# multiple times, hence the release count is decremented as well as actually
# doing them.
#
# If you're wondering whether this should be FINALIZE_INSTANCE per
# Glib::Object::Subclass, the answer is no, because that won't be called
# until after all "releases" make the pool let go of its reference on the
# gc, ie. you have to do the releases before you see FINALIZE_INSTANCE.
#
sub DESTROY {
  my ($self) = @_;
  if (DEBUG) { print "$self destroy, release count ",
                 ($self->{'release_count'}||0), "\n"; }
  while ($self->{'release_count'} > 0) {
    $self->{'release_count'}--;
    Gtk2::GC->release ($self);
  }
  $self->SUPER::DESTROY;
}

sub new ($%) {
  my ($class, %values) = @_;
  my $widget = delete $values{'widget'};
  my $drawable = delete $values{'drawable'}
              || delete $values{'window'}
              || ($widget && $widget->window);
  if (! $drawable) {
    croak "Gtk2::Ex::GtkGCobj->new: no drawable specified";
  }
  my $colormap = delete $values{'colormap'}
              || ($widget && $widget->get_colormap)
              || $drawable->get_colormap;
  my $depth = $drawable->get_depth;
  my $values = \%values;

  return $class->get ($depth, $colormap, $values);
}

1;
__END__

=head1 NAME

Gtk2::Ex::GtkGCobj -- auto-release for Gtk2::GC shared GCs

=head1 SYNOPSIS

 use Gtk2::Ex::GtkGCobj;

 # the plain "get" style
 my $gc = Gtk2::Ex::GtkGCobj->get ($depth, $colormap, { attrs... });

 # or friendlier attributes interface
 my $gc = Gtk2::Ex::GtkGCobj->new (widget => $widget,
                                   foreground => $color,
                                   ...);

=head1 OBJECT HIERARCHY

 Glib::Object
   Gtk2::Gdk::GC
     Gtk2::Ex::GtkGCobj  (Perl subclass only)

=head1 DESCRIPTION

C<Gtk2::Ex::GtkGCobj> is a wrapper around the C<Gtk2::GC> pool of shared
graphics contexts adding an automatic C<< Gtk2::GC->release >> when the GC
is garbage collected by Perl.

Normally if you get a GC with C<< Gtk2::GC->get >> you have to remember to
C<< Gtk2::GC->release >> it when you're finished.  If you just drop it then
the GC remains in the pool forever.  It might be re-used later by chance,
but usually it's just a memory and X resource leak.

The GCs returned by C<Gtk2::Ex::GtkGCobj> are a Perl subclass of
C<Gtk2::Gdk::GC> and can be used everywhere an ordinary GC can be used --
the only difference is the auto-release.

As a bonus this module offers a C<new> function with a friendlier interface
than C<< Gtk2::GC->get >>.

=head1 FUNCTIONS

=over 4

=item C<< Gtk2::Ex::GtkGCobj->get ($depth, $colormap, $values) >>

Return a shared GC with the given attributes.  The arguments are the same as
for C<< Gtk2::GC->new >>, but the GC returned is the C<Gtk2::Ex::GtkGCobj>
subclass and so is automatically released when garbage collected.

    $gc = Gtk2::Ex::GtkGCobj->get ($my_depth, $my_colormap,
                                   { foreground => $my_color,
                                     line_width => 10
                                   });

=item C<< Gtk2::Ex::GtkGCobj->new (key => value, ...) >>

Return a shared GC with the given attributes.  The key/value parameters are
the Perl wrapped C<GCValues> attributes such as C<line_width>, and in
addition one or more of the following to give depth and colormap.

    widget     Gtk2::Widget
    window     Gtk2::Gdk::Window
    drawable   Gtk2::Gdk::Drawable
    depth      integer
    colormap   Gtk2::Gdk::Colormap

The simplest is to just pass a realized widget and let C<Gtk2::Ex::GtkGCobj>
get the depth and colormap from that.

    $gc = Gtk2::Ex::GtkGCobj->new (widget => $my_widget,
                                   foreground => $my_color);

Or equally easily with a window,

    $gc = Gtk2::Ex::GtkGCobj->new (window => $my_win,
                                   foreground => $my_color);

Any drawable can be used, except that pixmaps might not have a colormap set.
If that's the case you can either set it with C<< $drawable->set_colormap >>
or pass a colormap explicitly and let the drawable just give the depth.

    $gc = Gtk2::Ex::GtkGCobj->new (drawable => $my_pixmap,
                                   colormap => $my_colormap,
                                   foreground => $my_color);

Or finally depth and colormap can both be given explicitly, just as you
would for the C<get> above, but in key/value style.

    $gc = Gtk2::Ex::GtkGCobj->new (depth => 8,
                                   colormap => $my_cmap,
                                   foreground => $my_color);

=back

=head1 OTHER NOTES

The colormap parameter to C<Gtk2::GtkGC> and to C<GtkGCobj> here is so
C<Gtk2::Gdk::Rgb> can be used through C<< $gc->set_rgb_fg_color >> and
friends.  If you're not interested in that then it's pretty irritating to be
forced to give a colormap, because basic drawing operations don't need it
(only depth).  Your pixel values will certainly be designed to look good in
some colormap on some intended final target window, but the GC doesn't need
to know when or where that will be, and in fact for a pseudocolor visual the
colormap doesn't even have to exist yet.  If you know what you're doing it
probably works to pass any old colormap of the requisite depth, though be
sure to use the same one each time because the pool doesn't share GCs
between different colormaps.

As of Gtk version 2.12, C<< Gtk2::GtkGC->release >> will segfault if the GC
wasn't obtained from C<< Gtk2::GtkGC->get >>, or if more C<release>s than
C<get>s are done.  Letting C<Gtk2::Ex::GtkGCobj> keep track of the releasing
is thus a good thing (or if a segfault does occur then you'll know where to
start looking!).

=head1 SEE ALSO

L<Gtk2::GC>, L<Gtk2::Gdk::GC>, L<Gtk2::Gdk::Rgb>

=cut