Clutter/Ex/PieSlice.pm 

#!/usr/bin/perl

package Clutter::Ex::PieSlice;

use warnings;
use strict;

use Glib qw( :constants );

use Glib::Object::Subclass
    'Clutter::Actor',
    signals => {
        clicked => {
            class_closure => undef,
            flags         => [ qw( run-last ) ],
            return_type   => undef,
            param_types   => [ ],
        },
        button_press_event   => \&on_button_press,
        button_release_event => \&on_button_release,
        leave_event          => \&on_leave,
    },
    properties => [
        Glib::ParamSpec->boxed(
            'color',
            'Color',
            'Color of the PieSlice',
            'Clutter::Color',
            [ qw( readable writable ) ],
        ),
        Glib::ParamSpec->double(
            'proportion',
            'Proportion',
            'Proportion of the PieSlice to be filled',
            0,
            100,
            0,
            [ qw( readable writable ) ],
        ),
    ];

sub on_button_press {
    my ($self, $event) = @_;

    if ($event->button == 1) {
        $self->{is_pressed} = TRUE;

        Clutter->grab_pointer($self);

        return TRUE;
    }

    return FALSE;
}

sub on_button_release {
    my ($self, $event) = @_;

    if ($event->button == 1 and $self->{is_pressed}) {
        $self->{is_pressed} = FALSE;

        Clutter->ungrab_pointer();

        $self->signal_emit('clicked');

        return TRUE;
    }

    return FALSE;
}

sub on_leave {
    my ($self, $event) = @_;

    if ($self->{is_pressed}) {
        $self->{is_pressed} = FALSE;

        Clutter->ungrab_pointer();

        return TRUE;
    }

    return FALSE;
}

sub PICK {
    my ($self, $pick_color) = @_;

    # we override PICK because the actor has a non-rectangular shape

    # if pick should not paint, then skip it
    return unless $self->should_pick_paint();

    my $geom = $self->get_allocation_geometry();

    my $angle = $self->{proportion} * 360 / 100;
    my $radius = $geom->width() / 2;
    Clutter::Cogl->path_move_to($radius, $radius);
    Clutter::Cogl->path_arc($radius, $radius, $radius, $radius, -90, $angle - 90);
    Clutter::Cogl->path_close();

    Clutter::Cogl->color($pick_color);
    Clutter::Cogl->path_fill();
}

sub PAINT {
    my ($self) = @_;

    my $geom = $self->get_allocation_geometry();

    my $angle = $self->{proportion} * 360 / 100;
    my $radius = $geom->width() / 2;
    Clutter::Cogl->path_move_to($radius, $radius);
    Clutter::Cogl->path_arc($radius, $radius, $radius, $radius, -90, $angle - 90);
    Clutter::Cogl->path_close();

    my $color = $self->{color};

    $color->alpha(255);

    Clutter::Cogl->color($color);
    Clutter::Cogl->path_fill();
}

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

    $self->set_color($value)      if ($pspec->name() eq 'color');
    $self->set_proportion($value) if ($pspec->name() eq 'proportion');
}

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

    return $self->get_color()      if ($pspec->name() eq 'color');
    return $self->get_proportion() if ($pspec->name() eq 'proportion');
}

sub INIT_INSTANCE {
    my ($self) = @_;

    $self->{color} = Clutter::Color->new(255, 255, 255, 255);
    $self->{proportion} = 0;
}

sub set_color {
    my ($self, $color) = @_;

    $self->{color} = $color;
    $self->notify('color');

    $self->queue_redraw() if $self->visible();
}


sub get_color {
    my ($self) = @_;

    return $self->{color};
}


sub set_proportion {
    my ($self, $proportion) = @_;

    $self->{proportion} = $proportion;
    $self->notify('proportion');

    $self->queue_redraw() if $self->visible();
}


sub get_proportion {
    my ($self) = @_;

    return $self->{proportion};
}

1;