[perl-Cairo] Add a subclassing example
- From: Torsten Schönfeld <tsch src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [perl-Cairo] Add a subclassing example
- Date: Mon, 10 May 2010 23:27:03 +0000 (UTC)
commit f1afe7d30222c348aafbc39467b0baf111eace85
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date: Mon May 10 23:54:01 2010 +0200
Add a subclassing example
Also, fix the file permissions of another example.
examples/subclassing.pl | 54 +++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 54 insertions(+), 0 deletions(-)
---
diff --git a/examples/simple.pl b/examples/simple.pl
old mode 100755
new mode 100644
diff --git a/examples/subclassing.pl b/examples/subclassing.pl
new file mode 100644
index 0000000..10908a4
--- /dev/null
+++ b/examples/subclassing.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+my $surface = Cairo::ImageSurface->create ('argb32', 1000, 1000);
+my $context = CustomContext->create ($surface);
+$context->draw_star;
+$context->show_page;
+$surface->write_to_png ($0 . '.png');
+
+package CustomContext;
+
+use strict;
+use warnings;
+use Cairo;
+use Math::Trig qw/pi/;
+
+use base qw/Cairo::Context/;
+
+sub create {
+ my ($package, $surface) = @_;
+
+ my $self = $package->SUPER::create($surface);
+
+ return bless $self, $package;
+}
+
+sub draw_star {
+ my ($self) = @_;
+
+ my $width = $self->get_target()->get_width();
+ my $height = $self->get_target()->get_height();
+
+ $self->rectangle (0, 0, $width, $height);
+ $self->set_source_rgb (1, 1, 1);
+ $self->fill;
+
+ $self->save;
+ {
+ $self->set_source_rgba (0, 0, 0, 0.5);
+ $self->translate ($width / 2, $height / 2);
+
+ my $mx = $width / 3.0;
+ my $count = 100;
+ foreach (0 .. $count-1) {
+ $self->new_path;
+ $self->move_to (0, 0);
+ $self->rel_line_to (-$mx, 0);
+ $self->stroke;
+ $self->rotate ((pi() * 2) / $count);
+ }
+ }
+ $self->restore;
+}
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]