AA/Graph.pm

   1 package AA::Vertex;
   2
   3 our @ISA = ('AA');
   4
   5 sub new($$) {
   6         my ($class, $id) = @_;
   7         my $v = AA::new($class, $id);
   8         $v->DefSet('x', 100);
   9         $v->DefSet('y', 100);
  10         $v->DefSet('color', [ 0.7, 0, 0.7 ]);
  11         $v->DefSet('gradient', 0.5);
  12         $v->DefSet('r', 30);
  13         $v->DefSet('rim', 2);
  14         $v->DefSet('rim-color', [ 0.1, 0, 0.1 ]);
  15         $v->Define('label');
  16         $v->DefSet('label-color', [ 1, 1, 1 ]);
  17         $v->DefSet('label-size', 1.5);
  18         $v->DefSet('d', 20);
  19         return $v;
  20 }
  21
  22 sub Draw($$) {
  23         my ($v, $cairo) = @_;
  24         my ($x, $y, $r) = ($v->Get('x'), $v->Get('y'), $v->Get('r'));
  25         my $grad = $v->Get('gradient');
  26         my @col = @{$v->Get('color')};
  27
  28         $cairo->new_path;
  29
  30         if ($grad) {
  31                 my $lg = Cairo::RadialGradient->create($x, $y, 0, $x, $y, $r);
  32                 $lg->add_color_stop_rgb(0, @col);
  33                 $col[0] *= $grad;
  34                 $col[1] *= $grad;
  35                 $col[2] *= $grad;
  36                 $lg->add_color_stop_rgb(1, @col);
  37                 $cairo->set_source($lg);
  38         } else {
  39                 $cairo->set_source_rgb(@col);
  40         }
  41         $cairo->arc($x, $y, $r, 0, $AA::TWOPI);
  42         $cairo->fill_preserve;
  43
  44         $cairo->set_source_rgb(@{$v->Get('rim-color')});
  45         $cairo->set_line_width($v->Get('rim'));
  46         $cairo->stroke;
  47
  48         if ($v->Exists('label')) {
  49                 my $label = $v->Get('label');
  50                 $cairo->set_source_rgb(@{$v->Get('label-color')});
  51                 $cairo->set_font_size($r * $v->Get('label-size'));
  52                 my $xt = $cairo->text_extents($label);
  53                 $cairo->move_to($x - $xt->{'width'}/2 - $xt->{'x_bearing'},
  54                                 $y - $xt->{'height'}/2 - $xt->{'y_bearing'});
  55                 $cairo->show_text($label);
  56         }
  57 }
  58
  59 package AA::Edge;
  60
  61 our @ISA = ('AA');
  62
  63 sub new($$$$) {
  64         my ($class, $id, $v, $w) = @_;
  65         my $e = AA::new($class, $id);
  66         $e->DefSet('color', [1, 1, 1]);
  67         $e->DefSet('width', 3);
  68         $e->DefSet('arrow', 0);
  69         $e->DefSet('arrow-size', 20);   # distance between arrow tip and back
  70         $e->DefSet('arrow-span', 0.5);  # fraction of arrow-size
  71         $e->DefSet('overshoot', 3);
  72         $e->DefBind('dir', sub {
  73                 my $dx = $w->Get('x') - $v->Get('x');
  74                 my $dy = $w->Get('y') - $v->Get('y');
  75                 my $d = sqrt($dx*$dx + $dy*$dy);
  76                 if ($d) {
  77                         return [$dx/$d, $dy/$d];
  78                 } else {
  79                         return [0, 0];
  80                 }
  81         });
  82         $e->DefBind('ends', sub {
  83                 my $over = $e->Get('overshoot');
  84                 my $x1 = $v->Get('x');
  85                 my $y1 = $v->Get('y');
  86                 my $r1 = $v->Get('r') - $over;
  87                 my $x2 = $w->Get('x');
  88                 my $y2 = $w->Get('y');
  89                 my $r2 = $w->Get('r') - $over;
  90                 my ($dx,$dy) = @{$e->Get('dir')};
  91                 return [ $x1+$r1*$dx, $y1+$r1*$dy, $x2-$r2*$dx, $y2-$r2*$dy ];
  92         });
  93         $e->DefSet('d', 10);
  94         return $e;
  95 }
  96
  97 sub Draw($$) {
  98         my ($e, $cairo) = @_;
  99         my ($x1, $y1, $x2, $y2) = @{$e->Get('ends')};
 100         $cairo->set_source_rgb(@{$e->Get('color')});
 101         $cairo->set_line_width($e->Get('width'));
 102         if (my $arrow = $e->Get('arrow')) {
 103                 my $size = $e->Get('arrow-size');
 104                 my $span = $size * $e->Get('arrow-span');
 105                 my ($dx,$dy) = @{$e->Get('dir')};
 106                 # line
 107                 $cairo->move_to($x1, $y1);
 108                 $cairo->line_to($x2 - $dx*$size*0.9, $y2 - $dy*$size*0.9);
 109                 $cairo->stroke;
 110                 # arrow
 111                 my ($ax,$ay) = (-$dy,$dx);
 112                 my ($bx,$by) = ($x2 - $dx*$size, $y2 - $dy*$size);
 113                 $cairo->move_to($x2, $y2);
 114                 $cairo->line_to($bx + $ax*$span, $by + $ay*$span);
 115                 $cairo->line_to($bx - $ax*$span, $by - $ay*$span);
 116                 $cairo->close_path;
 117                 $cairo->fill;
 118         } else {
 119                 $cairo->move_to($x1, $y1);
 120                 $cairo->line_to($x2, $y2);
 121                 $cairo->stroke;
 122         }
 123 }
 124
 125 1;