Category: Perl

Just a little fun with the Cairo Perl bindings. The code is courtesy of the gtkmm tutorial, and can be found here.

Update: since the original website went down, here’s the inlined version of the script:

package Egg::ClockFace;

use warnings;
use strict;

use Glib qw/TRUE FALSE/;
use Gtk2;
use Cairo;
use Math::Trig;

use Glib::Object::Subclass
	Gtk2::DrawingArea::,
	signals => {
		expose_event => \&expose,
	};

sub min { return ($_[0] < $_[1] ? $_[0] : $_[1]); }

sub draw
{
	my $self = shift;
	my $cr = $self->{cr};

	return FALSE unless $cr;

	my $width  = $self->allocation->width;
	my $height = $self->allocation->height;
	
	$cr->scale($width, $height);
	$cr->translate(0.5, 0.5);
	$cr->set_line_width($self->{line_width});
	
	$cr->save;
	$cr->set_source_rgba (0.337, 0.612, 0.117, 0.9);
	$cr->paint;
	$cr->restore;
	$cr->arc (0, 0, $self->{radius}, 0, 2 * Math::Trig::pi);
	$cr->save;
	$cr->set_source_rgba (1.0, 1.0, 1.0, 0.8);
	$cr->fill_preserve;
	$cr->restore;
	$cr->stroke_preserve;
	$cr->clip;

	for (1 .. 12) {
		my $inset = 0.05;

		$cr->save;
		$cr->set_line_cap('round');

		if ($_ % 3 != 0) {
			$inset *= 0.8;
			$cr->set_line_width(0.03);
		}

		$cr->move_to(($self->{radius} - $inset) * cos ($_ * Math::Trig::pi / 6),
		             ($self->{radius} - $inset) * sin ($_ * Math::Trig::pi / 6));
		$cr->line_to($self->{radius} * cos ($_ * Math::Trig::pi / 6),
		             $self->{radius} * sin ($_ * Math::Trig::pi / 6));

		$cr->stroke;
		$cr->restore;
	}

	my @time    = localtime;
	my $hours   = $time[2] * Math::Trig::pi / 6;
	my $minutes = $time[1] * Math::Trig::pi / 30;
	my $seconds = $time[0] * Math::Trig::pi / 30;
	
	$cr->save;
	$cr->set_line_cap('round');
	
	# seconds
	$cr->save;
	$cr->set_line_width($self->{line_width} / 3);
	$cr->set_source_rgba(1.0, 0.0, 0.0, 0.8);
	$cr->move_to(0, 0);
	$cr->line_to(     sin($seconds) * ($self->{radius} * .9),
	             -1 * cos($seconds) * ($self->{radius} * .9));
	$cr->stroke;
	$cr->restore;
	
	# minutes;
	$cr->set_source_rgba(0.7, 0.7, 0.7, 0.8);
	$cr->move_to(0, 0);
	$cr->line_to(     sin($minutes + $seconds / 60) * ($self->{radius} * 0.8),
	             -1 * cos($minutes + $seconds / 60) * ($self->{radius} * 0.8));
	$cr->stroke;
	
	# hours
	$cr->set_source_rgba(0.117, 0.337, 0.612, 0.9);
	$cr->move_to(0, 0);
	$cr->line_to(     sin($hours + $minutes / 12.0) * ($self->{radius} * 0.5),
	             -1 * cos($hours + $minutes / 12.0) * ($self->{radius} * 0.5));
	$cr->stroke;
	
	$cr->restore;
	
	# dot
	$cr->arc(0, 0,  $self->{line_width} / 3.0, 0, 2 * Math::Trig::pi);
	$cr->fill;

	return TRUE;
}

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

	my $cr = Gtk2::Gdk::Cairo::Context->create($self->window);
	$cr->rectangle ($event->area->x,
			$event->area->y,
			$event->area->width,
			$event->area->height);
	$cr->clip;
	$self->{cr} = $cr;
	
	$self->draw;

	$self->{timeout} = Glib::Timeout->add(1000, sub {
			my $self = shift;
			
			my $alloc = $self->allocation;
			my $rect = Gtk2::Gdk::Rectangle->new(0, 0, $alloc->width, $alloc->height);
			$self->window->invalidate_rect($rect, FALSE);

			return TRUE;
		}, $self) unless $self->{timeout};

	return FALSE;
}

sub INIT_INSTANCE
{
	my $self = shift;

	$self->{line_width} = 0.05;
	$self->{radius}     = 0.42;
}

sub FINALIZE_INSTANCE
{
	my $self = shift;

	Glib::Source->remove($self->{timeout}) if $self->{timeout};
}

1;

package main;

use Gtk2 '-init';

my $window = Gtk2::Window->new('toplevel');
my $clock = Egg::ClockFace->new;

$window->add($clock);
$window->signal_connect(destroy => sub { Gtk2->main_quit; });

$window->show_all;

Gtk2->main;

0;

It seems that my work on a D-Bus perl binding was duplicating the (excellent) work of Daniel P. Berrange.

Not that I’m complaining: I badly needed to understand how D-Bus worked, and creating a binding was the fastest way to understand the inner workings of D-Bus.

Well, all in all I learned much, and now I volunteered for giving a hand to Daniel if he needs it. This is the beauty of F/OSS.

After four hours straight of hacking, double-checking references, learning D-Bus and the intricacies of Perl XS programming, I have a preliminary draft of perl bindings for D-Bus.

At the moment, they do nothing, since there isn’t much more than the DBus::Connection object, but they are loading correctely, and the approach is right.

The API should resemble the C one, with a perlish twist. A simple service lister program should be:

  use DBus;
  # we could use this class method...
  my $bus = DBus->get_session_bus;
  # or just the DBus::Bus class...
  #my $bus = DBus::Bus->get('session');
  # the result is the same: $bus will contain a reference to the session bus.
  # but it is also a perl hash reference, so it could hold something, such a string:
  $bus->{service} = 'org.freedesktop.DBus';
  # then we could use them in order to get a service
  my $service = $bus->get_service($bus->{service});
  # $service is also a perl hashref, so we could use it to store some more strings:
  $service->{path} = '/org/freedesktop/DBus';
  $service->{interface} = 'org.freedesktop.DBus';
  # and the get the object:
  my $object = $service->get_object($service->{path}, $service->{interface});
  # here's the remote method call:
  print "Service: $_\n" foreach ($object->ListServices);
  0;

I plan to make the low-level bindings work as soon as this weekend.

Future plans: creating a DBus::Object::Subclass pragmatic module, similar to Glib’s Glib::Object::Subclass, that permits the creation of D-Bus aware objects. This could be tricky, but I’m really optimistic.

After being in Florence with Marta for just about two days, I’ve received the “go ahead” from the gtk2-perl team, and committed my patch for the GKeyFile bindings (closing bug #301171). Now you can parse the .desktop files directly in Perl. Hurray for me.

Gtk2::Recent status: Finally, the libegg/recent-files bindings for Perl hit the gtk2-perl CVS server (well, at least the authenticated CVS server; anonymous CVS should be updated in 24 hours).

recent-files status: On a related note, I mailed James Willcox (the recent-files maintainer), asking him if this library is still actively maintained, and stepping up for help (triaging bugs, reviewing patches, applying them, and possibly development).

I’ve some ideas, like the creation of a Gnome library based on the actual recent-files code, depending on libgnomevfs and some other stuff, which monitors the recent files file and their state (if local, with the option for remote file checking, maybe using a GConf preference). It will have a RecentMenu widget, composed of RecentMenuItems, for visualization – thus simplifying the code:

  RecentModel *model = gnome_recent_model_new (RECENT_MODEL_ORDER_MRU);
  GtkWidget *menu = gnome_recent_menu_new (model);
  GtkWidget *menuitem = gtk_image_menu_item_new (GTK_STOCK_CLEAR);

  g_signal_connect (G_OBEJCT (menu), "activate", G_CALLBACK (on_recent_activate), NULL);
  g_signal_connect (G_OBJECT (menuitem), "activate", G_CALLBACK (on_clear_activate), model);

  gnome_recent_menu_set_show_trailing_separator (GNOME_RECENT_MENU (menu), TRUE);
  gnome_recent_menu_append_item (GNOME_RECENT_MENU (menu), menuitem);

  gtk_widget_show (menuitem);
  gtk_widget_show (menu);

Then, you could simply attach this menu as a GtkMenuItem submenu.

Future plans: See here for some neat ideas (not from me) about the recent stuff handling.