--- /dev/null
+package AA;
+
+use overload '""' => 'ID';
+
+our $PI = 3.1415926535;
+our $TWOPI = 2*$PI;
+
+our %known_objs = ( );
+our $debug = 1;
+our $record_dep_obj;
+our $record_dep_attr;
+our $record_deps;
+our @pending_recalcs;
+
+sub new($$) {
+ my ($class, $id) = @_;
+ my $o = {
+ ID => $id,
+ };
+ !defined $known_objs{$id} or die "Object $id already defined";
+ $known_objs{$id} = $o;
+ print "Created object $id\n" if $debug;
+ return bless $o, $class;
+}
+
+sub find($$) {
+ my ($class, $id) = @_;
+ defined $known_objs{$id} or die "Object $id not known";
+ return $known_objs{$id};
+}
+
+sub calculate($) {
+ my ($class) = @_;
+ my $o;
+ while ($o = shift @pending_recalcs) {
+ print "Going to recalculate object $o\n" if $debug;
+ my $pend = $o->{PENDING};
+ foreach my $a (keys %$pend) {
+ $o->Calc("$a");
+ }
+ delete $o->{PENDING};
+ }
+}
+
+sub draw($$) {
+ my ($class, $cairo) = @_;
+ my @q = ();
+ print "Redrawing the scene...\n" if $debug;
+ foreach my $o (values %known_objs) {
+ push @q, $o if defined $o->{'a:d'};
+ }
+ foreach my $o (sort { $a->{'a:d'} <=> $b->{'a:d'} } @q) {
+ print "Drawing $o at depth ", $o->{'a:d'}, "\n" if $debug;
+ $o->Draw($cairo);
+ }
+}
+
+sub ID($) {
+ return (shift @_)->{ID};
+}
+
+sub Define($$) {
+ my ($o, $a) = @_;
+ !exists $o->{"a:$a"} or die "Redefining attribute $a of object $o";
+ $o->{"a:$a"} = undef; # attribute value
+ # $o->{"f:$a"} = undef; # binding function
+ $o->{"d:$a"} = { }; # depends on (obj:attr => obj)
+ $o->{"n:$a"} = { }; # notify (obj:attr => obj)
+}
+
+sub DefSet($$$) {
+ my ($o, $a, $v) = @_;
+ $o->Define($a);
+ $o->Set($a, $v);
+}
+
+sub DefBind($$$) {
+ my ($o, $a, $v) = @_;
+ $o->Define($a);
+ $o->Bind($a, $v);
+}
+
+sub DefDep($$$$) {
+ my ($o, $a, $v, $b) = @_;
+ $o->Define($a);
+ $o->Bind($a, sub { $v->Get($b); });
+}
+
+sub Exists($$) {
+ my ($o, $a) = @_;
+ return defined $o->{"a:$a"};
+}
+
+sub Get($$) {
+ my ($o, $a) = @_;
+ defined $o->{"a:$a"} or die "Getting undefined attribute $a of object $o";
+ if ($record_deps) {
+ # record the dependency
+ my $did = "$o:$a";
+ if (!defined $record_deps->{$did}) {
+ $record_deps->{$did} = $o;
+ my $rid = "$record_dep_obj:$record_dep_attr";
+ $o->{"n:$a"}->{$rid} = $record_dep_obj;
+ print "Added automatic dependency $rid -> $did\n" if $debug;
+ }
+ }
+ return $o->{"a:$a"};
+}
+
+sub Set($$$) {
+ my ($o, $a, $v) = @_;
+ exists $o->{"a:$a"} or die "Setting undefined attribute $a of object $o";
+ print "Setting $o:$a = $v\n" if $debug;
+ $o->{"a:$a"} = $v;
+ !defined $o->{"f:$a"} or $o->UnBind($a);
+ $o->Notify($a);
+}
+
+sub Bind($$$) {
+ my ($o, $a, $f) = @_;
+ exists $o->{"a:$a"} or die "Binding undefined attribute $a of object $o";
+ print "Binding $o:$a\n" if $debug;
+ $o->UnBind($a);
+ $o->{"f:$a"} = $f;
+ $o->Calc($a);
+}
+
+sub Calc($$) {
+ my ($o, $a) = @_;
+ die if $record_deps;
+ $record_deps = $o->{"d:$a"};
+ $record_dep_obj = $o;
+ $record_dep_attr = $a;
+
+ $o->{"a:$a"} = undef;
+ $o->{"a:$a"} = &{$o->{"f:$a"}} ($o);
+
+ $record_deps = undef;
+ $record_dep_obj = undef;
+ $record_dep_attr = undef;
+
+ print "Recalculated $o:$a = ", $o->{"a:$a"}, "\n" if $debug;
+ $o->Notify($a);
+}
+
+sub UnBind($$) {
+ my ($o, $a) = @_;
+ my $aid = "$o:$a";
+ foreach my $dep (keys %{$o->{"d:$a"}}) {
+ my ($deponame, $depa) = split(/:/, $dep);
+ my $depo = $o->{"d:$a"}->{$dep};
+ delete $depo->{"n:$depa"}->{$aid};
+ print "Removed notify $aid -> $depo:$depa\n" if $debug;
+ }
+ $o->{"d:$a"} = { };
+ delete $o->{"f:$a"};
+}
+
+sub Notify($$) {
+ my ($o, $a) = @_;
+ foreach my $dep (keys %{$o->{"n:$a"}}) {
+ my ($deponame, $depa) = split(/:/, $dep);
+ my $depo = $o->{"n:$a"}->{$dep};
+ print "Sending notify $o:$a -> $deponame:$depa\n" if $debug;
+ if (!defined $depo->{PENDING}) {
+ $depo->{PENDING} = { };
+ push @pending_recalcs, $depo;
+ print "\tPending object $deponame\n" if $debug;
+ }
+ $depo->{PENDING}->{$depa} = 1;
+ }
+}
+
+1;
--- /dev/null
+package AA::Vertex;
+
+our @ISA = ('AA');
+
+sub new($$) {
+ my ($class, $id) = @_;
+ my $v = AA::new($class, $id);
+ $v->DefSet('x', 100);
+ $v->DefSet('y', 100);
+ $v->DefSet('color', [ 0.7, 0, 0.7 ]);
+ $v->DefSet('gradient', 0.5);
+ $v->DefSet('r', 30);
+ $v->DefSet('rim', 2);
+ $v->DefSet('rim-color', [ 1, 1, 1 ]);
+ $v->Define('label');
+ $v->DefSet('label-color', [ 1, 1, 1 ]);
+ $v->DefSet('label-size', 1.5);
+ $v->DefSet('d', 20);
+ return $v;
+}
+
+sub Draw($$) {
+ my ($v, $cairo) = @_;
+ my ($x, $y, $r) = ($v->Get('x'), $v->Get('y'), $v->Get('r'));
+ my $grad = $v->Get('gradient');
+ my @col = @{$v->Get('color')};
+
+ $cairo->arc($x, $y, $r, 0, $AA::TWOPI);
+ if ($grad) {
+ my $lg = Cairo::RadialGradient->create($x, $y, 0, $x, $y, $r);
+ $lg->add_color_stop_rgb(0, @col);
+ $col[0] *= $grad;
+ $col[1] *= $grad;
+ $col[2] *= $grad;
+ $lg->add_color_stop_rgb(1, @col);
+ $cairo->set_source($lg);
+ } else {
+ $cairo->set_source_rgb(@col);
+ }
+ $cairo->fill;
+
+ $cairo->arc($x, $y, $r, 0, $AA::TWOPI);
+ $cairo->set_source_rgb(@{$v->Get('rim-color')});
+ $cairo->set_line_width($v->Get('rim'));
+ $cairo->stroke;
+
+ if ($v->Exists('label')) {
+ my $label = $v->Get('label');
+ $cairo->set_source_rgb(@{$v->Get('label-color')});
+ $cairo->set_font_size($r * $v->Get('label-size'));
+ my $xt = $cairo->text_extents($label);
+ $cairo->move_to($x - $xt->{'width'}/2 - $xt->{'x_bearing'},
+ $y - $xt->{'height'}/2 - $xt->{'y_bearing'});
+ $cairo->show_text($label);
+ }
+}
+
+package AA::Edge;
+
+our @ISA = ('AA');
+
+sub new($$$$) {
+ my ($class, $id, $v, $w) = @_;
+ my $e = AA::new($class, $id);
+ $e->DefSet('color', [1, 1, 1]);
+ $e->DefSet('width', 3);
+ $e->DefSet('arrow', 0);
+ $e->DefSet('arrow-dist', 20);
+ $e->DefSet('arrow-span', 6);
+ $e->DefBind('ends', sub {
+ my $x1 = $v->Get('x');
+ my $y1 = $v->Get('y');
+ my $r1 = $v->Get('r');
+ my $x2 = $w->Get('x');
+ my $y2 = $w->Get('y');
+ my $r2 = $w->Get('r');
+ my $dx = $x2 - $x1;
+ my $dy = $y2 - $y1;
+ my $d = sqrt($dx*$dx + $dy*$dy);
+ $x1 += $dx * $r1/$d;
+ $y1 += $dy * $r1/$d;
+ $x2 -= $dx * $r2/$d;
+ $y2 -= $dy * $r2/$d;
+ return [ $x1, $y1, $x2, $y2 ];
+ });
+ $e->DefBind('apos', sub {
+ my $type = $e->Get('arrow') or return undef;
+ my $span = $e->Get('arrow-span');
+ my $dist = $e->Get('arrow-dist');
+ my ($x1, $y1, $x2, $y2) = @{$e->Get('ends')};
+ my $dx = $x2 - $x1;
+ my $dy = $y2 - $y1;
+ my $d = sqrt($dx*$dx + $dy*$dy);
+ my $ax = $x2 - $dx * $dist/$d;
+ my $ay = $y2 - $dy * $dist/$d;
+ my $adx = -$dy;
+ my $ady = $dx;
+ ($adx, $ady) = ($adx * $span/$d, $ady * $span/$d);
+ return [ $ax+$adx, $ay+$ady,
+ $ax-$adx, $ay-$ady ];
+ });
+ $e->DefSet('d', 10);
+ return $e;
+}
+
+sub Draw($$) {
+ my ($v, $cairo) = @_;
+
+ my ($x1, $y1, $x2, $y2) = @{$v->Get('ends')};
+ $cairo->set_source_rgb(@{$v->Get('color')});
+
+ $cairo->move_to($x1, $y1);
+ $cairo->line_to($x2, $y2);
+ $cairo->set_line_width($v->Get('width'));
+ $cairo->stroke;
+
+ if ($v->Get('arrow')) {
+ my ($ax1, $ay1, $ax2, $ay2) = @{$v->Get('apos')};
+ $cairo->move_to($x2, $y2);
+ $cairo->line_to($ax1, $ay1);
+ $cairo->line_to($ax2, $ay2);
+ $cairo->close_path;
+ $cairo->fill;
+ }
+}
+
+1;
--- /dev/null
+package AA::NetV;
+
+our @ISA = ('AA::Vertex');
+
+sub new($$$$) {
+ my ($class, $id) = @_;
+ my $v = AA::Vertex::new($class, $id);
+ $v->Set('x', 100);
+ $v->DefSet('y0', 100);
+ $v->DefSet('h', 0);
+ $v->Bind('y', sub { $v->Get("y0") + 100*$v->Get("h") });
+ return $v;
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -W
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+use Cairo;
+
+use AA;
+use AA::Graph;
+use AA::Net;
+
+my $v = AA::NetV->new('v');
+$v->Set('x', 100);
+$v->Set('y0', 100);
+$v->Set('label', '1');
+
+my $w = AA::NetV->new('w');
+$w->Set('x', 200);
+$w->Set('y0', 100);
+$w->Set('label', '2');
+
+my $e = AA::Edge->new('e', $v, $w);
+$e->Set('arrow', 1);
+
+$v->Set("h", 1);
+$w->Set("h", 2);
+
+AA->calculate;
+
+### G T K ###
+
+my $area = Gtk2::DrawingArea->new();
+my $cairo;
+
+my $pixmap;
+my ($lastw, $lasth, $lastd) = (-1, -1, -1);
+my ($pixw, $pixh) = (-1, -1);
+sub draw($) {
+ my ($force) = @_;
+ my $win = $area->window;
+ my $wgc = Gtk2::Gdk::GC->new($win);
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+ my $d = $win->get_depth;
+ # print "Area $w x $h x $d, xx=$xx\n";
+
+ if (!defined($pixmap) || $lastw != $w || $lasth != $h || $lastd != $d) {
+ ($lastw, $lasth, $lastd) = ($w, $h, $d);
+ if ($w/$h >= 4/3) {
+ $pixh = $h;
+ $pixw = int($h/3*4);
+ } else {
+ $pixw = $w;
+ $pixh = int($w/4*3);
+ }
+ print "Resized to ${w}x${h}, pixmap size ${pixw}x${pixh}\n";
+
+ $pixmap = Gtk2::Gdk::Pixmap->new($win, $pixw, $pixh, $d);
+ $cairo = Gtk2::Gdk::Cairo::Context->create($pixmap);
+ $cairo->select_font_face('URW Palladio L', 'normal', 'normal');
+ my $scale = $pixw/1024;
+ $cairo->scale($scale, $scale);
+ }
+
+ if ($force) {
+ $wgc->set_rgb_background(0);
+ $wgc->set_rgb_foreground(0);
+ $win->draw_rectangle($wgc, 1, 0, 0, $w, $h);
+ }
+
+ $cairo->rectangle(0, 0, 1024, 768);
+ $cairo->set_source_rgb(0, 0, 0);
+ $cairo->fill;
+
+ AA->draw($cairo);
+
+ $win->draw_drawable($wgc, $pixmap, 0, 0, 0, 0, $pixw, $pixh);
+}
+
+sub step() {
+ draw(0);
+}
+
+my $timer = 1;
+my $stopped = 1;
+$area->signal_connect("expose-event" => sub {
+ draw(1);
+ if (!defined $timer) {
+ $timer = Glib::Timeout->add(30, sub { $stopped || step(); return 1; });
+ }
+});
+$area->set_flags('can-focus');
+# $area->add_events('key-press-mask');
+$area->signal_connect('key-press-event' => sub {
+ my ($w, $evt) = @_;
+ my $k = Gtk2::Gdk::keyval_name(0, $evt->keyval);
+ print "Pressed key $k\n";
+ if ($k eq "Escape") {
+ Gtk2->main_quit;
+ } elsif ($k eq "space") {
+ $stopped = !$stopped;
+ }
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("brum", "Brum");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+#$window->fullscreen;
+
+Gtk2->main;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+use Cairo;
+
+my $area = Gtk2::DrawingArea->new();
+my $cairo;
+my $xx=0;
+sub draw() {
+ my $win = $area->window;
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+ print "Area $w x $h, xx=$xx\n";
+
+ $cairo = Gtk2::Gdk::Cairo::Context->create($win);
+ $cairo->rectangle(0, 0, $w, $h);
+ $cairo->set_source_rgb(0, 0, 0);
+ $cairo->fill;
+
+ $cairo->rectangle($xx, 10, 40, 40);
+ $cairo->set_source_rgb(0, 0, 1);
+ $cairo->fill;
+
+ my $gc = Gtk2::Gdk::GC->new($win);
+ $gc->set_rgb_background(0x000000);
+ $gc->set_rgb_foreground(0x00ff00);
+ $win->draw_line($gc, $xx, 0, $w-1, $h-1);
+
+ $xx+=5;
+}
+
+my $timer;
+$area->signal_connect("expose-event" => sub {
+ draw();
+ if (!defined $timer) {
+ $timer = Glib::Timeout->add(10, sub { draw(); return 1; });
+ }
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("anim", "Anim");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+$window->fullscreen;
+
+Gtk2->main;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+
+my $area = Gtk2::DrawingArea->new();
+my $xx = 0;
+sub draw() {
+ my $win = $area->window;
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+ print "Area $w x $h\n";
+
+ ## my $sty = $area->style;
+ ## my $gc = $sty->fg_gc($area->state);
+ my $gc = Gtk2::Gdk::GC->new($win);
+ $gc->set_rgb_background(0x000000);
+ $gc->set_rgb_foreground(0x000000);
+ $win->draw_rectangle($gc, 1, 0, 0, $w, $h);
+ $gc->set_rgb_foreground(0x00ff00);
+ $win->draw_line($gc, $xx, 0, $w-1, $h-1);
+ $xx++;
+ if ($xx >= $w) { $xx=0; }
+}
+
+my $timer;
+$area->signal_connect("expose-event" => sub {
+ draw();
+ if (!defined $timer) {
+ $timer = Glib::Timeout->add(10, sub { draw(); return 1; });
+ }
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("anim", "Anim");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+#$window->fullscreen;
+
+Gtk2->main;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+use Cairo;
+
+my $area = Gtk2::DrawingArea->new();
+my $cairo;
+my $PI = 3.1415926535;
+my $TWOPI = 2*$PI;
+
+my $rad = 30;
+my $rim = 2;
+my $arrow_dist = 10;
+my $arrow_span = 5;
+
+sub draw_vertex($$) {
+ my ($x, $y) = @_;
+
+ my $lg = Cairo::RadialGradient->create($x, $y, 0, $x, $y, $rad);
+ $lg->add_color_stop_rgb(0, 0.7, 0, 0.7);
+ $lg->add_color_stop_rgb(1, 0.3, 0, 0.3);
+
+ $cairo->arc($x, $y, $rad, 0, $TWOPI);
+ $cairo->set_source($lg);
+ $cairo->fill;
+
+ $cairo->arc($x, $y, $rad, 0, $TWOPI);
+ $cairo->set_source_rgb(1, 1, 1);
+ $cairo->set_line_width($rim);
+ $cairo->stroke;
+
+ $cairo->set_font_size(0.6*$rad);
+ my $xt = $cairo->text_extents('Brum');
+ $cairo->move_to($x - $xt->{'width'}/2 - $xt->{'x_bearing'},
+ $y - $xt->{'height'}/2 - $xt->{'y_bearing'});
+ $cairo->show_text("Brum");
+}
+
+sub draw_edge($$$$) {
+ my ($x1, $y1, $x2, $y2) = @_;
+ my $dx = $x2 - $x1;
+ my $dy = $y2 - $y1;
+ my $d = sqrt($dx*$dx + $dy*$dy);
+
+ $x1 += $dx * $rad/$d;
+ $y1 += $dy * $rad/$d;
+ $x2 -= $dx * $rad/$d;
+ $y2 -= $dy * $rad/$d;
+
+ $cairo->set_source_rgb(1, 1, 1);
+
+ $cairo->move_to($x1, $y1);
+ $cairo->line_to($x2, $y2);
+ $cairo->set_line_width(2);
+ $cairo->stroke;
+
+ my $ax = $x2 - $dx * $arrow_dist/$d;
+ my $ay = $y2 - $dy * $arrow_dist/$d;
+ my $adx = -$dy;
+ my $ady = $dx;
+ ($adx, $ady) = ($adx * $arrow_span/$d, $ady * $arrow_span/$d);
+ $cairo->move_to($x2, $y2);
+ $cairo->line_to($ax+$adx, $ay+$ady);
+ $cairo->line_to($ax-$adx, $ay-$ady);
+ $cairo->close_path;
+ $cairo->fill;
+}
+
+my $xx=0;
+my $pixmap;
+my ($lastw, $lasth, $lastd) = (-1, -1, -1);
+my ($pixw, $pixh) = (-1, -1);
+sub draw($) {
+ my ($force) = @_;
+ my $win = $area->window;
+ my $wgc = Gtk2::Gdk::GC->new($win);
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+ my $d = $win->get_depth;
+ # print "Area $w x $h x $d, xx=$xx\n";
+
+ if (!defined($pixmap) || $lastw != $w || $lasth != $h || $lastd != $d) {
+ ($lastw, $lasth, $lastd) = ($w, $h, $d);
+ if ($w/$h >= 4/3) {
+ $pixh = $h;
+ $pixw = int($h/3*4);
+ } else {
+ $pixw = $w;
+ $pixh = int($w/4*3);
+ }
+ print "Resized to ${w}x${h}, pixmap size ${pixw}x${pixh}\n";
+
+ $pixmap = Gtk2::Gdk::Pixmap->new($win, $pixw, $pixh, $d);
+ $cairo = Gtk2::Gdk::Cairo::Context->create($pixmap);
+ $cairo->select_font_face('URW Palladio L', 'normal', 'normal');
+ my $scale = $pixw/1024;
+ $cairo->scale($scale, $scale);
+ }
+
+ if ($force) {
+ $wgc->set_rgb_background(0);
+ $wgc->set_rgb_foreground(0);
+ $win->draw_rectangle($wgc, 1, 0, 0, $w, $h);
+ }
+
+ $cairo->rectangle(0, 0, 1024, 768);
+ $cairo->set_source_rgb(0, 0, 0);
+ $cairo->fill;
+
+ my @v = ();
+ for (my $i=0; $i<6; $i++) {
+ my $a = $TWOPI/6 * $i + $TWOPI/400*$xx;
+ my $x = int(1024/2 + 300*cos($a));
+ my $y = int(768/2 + 300*sin($a));
+ draw_vertex($x, $y);
+ push @v, { 'x' => $x, 'y' => $y };
+ }
+
+ for (my $i=1; $i<6; $i++) {
+ for (my $j=0; $j<$i; $j++) {
+ my $v = $v[$i];
+ my $w = $v[$j];
+ draw_edge($v->{'x'}, $v->{'y'}, $w->{'x'}, $w->{'y'});
+ }
+ }
+
+ $win->draw_drawable($wgc, $pixmap, 0, 0, 0, 0, $pixw, $pixh);
+}
+
+sub step() {
+ draw(0);
+ $xx++;
+}
+
+my $timer;
+my $stopped = 0;
+$area->signal_connect("expose-event" => sub {
+ draw(1);
+ if (!defined $timer) {
+ $timer = Glib::Timeout->add(30, sub { $stopped || step(); return 1; });
+ }
+});
+$area->set_flags('can-focus');
+# $area->add_events('key-press-mask');
+$area->signal_connect('key-press-event' => sub {
+ my ($w, $evt) = @_;
+ my $k = Gtk2::Gdk::keyval_name(0, $evt->keyval);
+ print "Pressed key $k\n";
+ if ($k eq "Escape") {
+ Gtk2->main_quit;
+ } elsif ($k eq "space") {
+ $stopped = !$stopped;
+ }
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("anim", "Anim");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+#$window->fullscreen;
+
+Gtk2->main;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+use Cairo;
+
+my $area = Gtk2::DrawingArea->new();
+my $cairo;
+my $xx=0;
+my $pixmap;
+my ($pixw, $pixh, $pixd) = (-1, -1, -1);
+sub draw() {
+ my $win = $area->window;
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+ my $d = $win->get_depth;
+ # print "Area $w x $h x $d, xx=$xx\n";
+
+ if (!defined($pixmap) || $pixw != $w || $pixh != $h || $pixd != $d) {
+ $pixmap = Gtk2::Gdk::Pixmap->new($win, $w, $h, $d);
+ ($pixw, $pixh, $pixd) = ($w, $h, $d);
+ $cairo = Gtk2::Gdk::Cairo::Context->create($pixmap);
+ }
+
+ $cairo->rectangle(0, 0, $w, $h);
+ $cairo->set_source_rgb(0, 0, 0);
+ $cairo->fill;
+
+ $cairo->rectangle($xx, 10, 40, 40);
+ $cairo->set_source_rgb(0, 0, 1);
+ $cairo->fill;
+
+ #my $gc = Gtk2::Gdk::GC->new($pixmap);
+ #$gc->set_rgb_background(0x000000);
+ #$gc->set_rgb_foreground(0x00ff00);
+ #$pixmap->draw_line($gc, $xx, 0, $w-1, $h-1);
+
+ my $wgc = Gtk2::Gdk::GC->new($win);
+ $win->draw_drawable($wgc, $pixmap, 0, 0, 0, 0, $w, $h);
+
+ $xx+=1;
+}
+
+my $timer;
+$area->signal_connect("expose-event" => sub {
+ draw();
+ if (!defined $timer) {
+ $timer = Glib::Timeout->add(10, sub { draw(); return 1; });
+ }
+});
+$area->set_flags('can-focus');
+# $area->add_events('key-press-mask');
+$area->signal_connect('key-press-event' => sub {
+ my ($w, $evt) = @_;
+ my $k = Gtk2::Gdk::keyval_name(0, $evt->keyval);
+ print "Pressed key $k\n";
+ if ($k eq "Escape") {
+ Gtk2->main_quit;
+ }
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("anim", "Anim");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+$window->fullscreen;
+
+Gtk2->main;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+use Cairo;
+
+my $area = Gtk2::DrawingArea->new();
+my $cairo;
+
+sub draw_vertex($$) {
+ my ($x, $y) = @_;
+ my $rad = 100;
+ my $rim = 3;
+
+ my $lg = Cairo::RadialGradient->create($x, $y, 0, $x, $y, $rad);
+ $lg->add_color_stop_rgb(0, 0.7, 0, 0.7);
+ $lg->add_color_stop_rgb(1, 0.3, 0, 0.3);
+
+ $cairo->arc($x, $y, $rad, 0, 2*3.141592);
+ $cairo->set_source($lg);
+ $cairo->fill;
+
+ $cairo->arc($x, $y, $rad, 0, 2*3.141592);
+ $cairo->set_source_rgb(1, 1, 1);
+ $cairo->set_line_width($rim);
+ $cairo->stroke;
+
+ $cairo->set_font_size(0.6*$rad);
+ my $xt = $cairo->text_extents('Brum');
+ $cairo->move_to($x - $xt->{'width'}/2 - $xt->{'x_bearing'},
+ $y - $xt->{'height'}/2 - $xt->{'y_bearing'});
+ $cairo->show_text("Brum");
+}
+
+my $xx=0;
+my $pixmap;
+my ($lastw, $lasth, $lastd) = (-1, -1, -1);
+my ($pixw, $pixh) = (-1, -1);
+sub draw($) {
+ my ($force) = @_;
+ my $win = $area->window;
+ my $wgc = Gtk2::Gdk::GC->new($win);
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+ my $d = $win->get_depth;
+ # print "Area $w x $h x $d, xx=$xx\n";
+
+ if (!defined($pixmap) || $lastw != $w || $lasth != $h || $lastd != $d) {
+ ($lastw, $lasth, $lastd) = ($w, $h, $d);
+ if ($w/$h >= 4/3) {
+ $pixh = $h;
+ $pixw = int($h/3*4);
+ } else {
+ $pixw = $w;
+ $pixh = int($w/4*3);
+ }
+ print "Resized to ${w}x${h}, pixmap size ${pixw}x${pixh}\n";
+
+ if ($force) {
+ $wgc->set_rgb_background(0);
+ $wgc->set_rgb_foreground(0);
+ $win->draw_rectangle($wgc, 1, 0, 0, $w, $h);
+ }
+
+ $pixmap = Gtk2::Gdk::Pixmap->new($win, $pixw, $pixh, $d);
+ $cairo = Gtk2::Gdk::Cairo::Context->create($pixmap);
+ $cairo->select_font_face('URW Palladio L', 'normal', 'normal');
+ my $scale = $pixw/1024;
+ $cairo->scale($scale, $scale);
+ }
+
+ $cairo->rectangle(0, 0, 1024, 768);
+ $cairo->set_source_rgb(0, 0, 0);
+ $cairo->fill;
+
+ draw_vertex(4/3*$xx, $xx);
+
+ $win->draw_drawable($wgc, $pixmap, 0, 0, 0, 0, $pixw, $pixh);
+}
+
+sub step() {
+ draw(0);
+ $xx++;
+}
+
+my $timer;
+my $stopped = 0;
+$area->signal_connect("expose-event" => sub {
+ draw(1);
+ if (!defined $timer) {
+ $timer = Glib::Timeout->add(100, sub { $stopped || step(); return 1; });
+ }
+});
+$area->set_flags('can-focus');
+# $area->add_events('key-press-mask');
+$area->signal_connect('key-press-event' => sub {
+ my ($w, $evt) = @_;
+ my $k = Gtk2::Gdk::keyval_name(0, $evt->keyval);
+ print "Pressed key $k\n";
+ if ($k eq "Escape") {
+ Gtk2->main_quit;
+ } elsif ($k eq "space") {
+ $stopped = !$stopped;
+ }
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("anim", "Anim");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+#$window->fullscreen;
+
+Gtk2->main;
projects / anim.git / commitdiff