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', [ 1, 1, 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->arc($x, $y, $r, 0, $AA::TWOPI);
  29         if ($grad) {
  30                 my $lg = Cairo::RadialGradient->create($x, $y, 0, $x, $y, $r);
  31                 $lg->add_color_stop_rgb(0, @col);
  32                 $col[0] *= $grad;
  33                 $col[1] *= $grad;
  34                 $col[2] *= $grad;
  35                 $lg->add_color_stop_rgb(1, @col);
  36                 $cairo->set_source($lg);
  37         } else {
  38                 $cairo->set_source_rgb(@col);
  39         }
  40         $cairo->fill;
  41
  42         $cairo->arc($x, $y, $r, 0, $AA::TWOPI);
  43         $cairo->set_source_rgb(@{$v->Get('rim-color')});
  44         $cairo->set_line_width($v->Get('rim'));
  45         $cairo->stroke;
  46
  47         if ($v->Exists('label')) {
  48                 my $label = $v->Get('label');
  49                 $cairo->set_source_rgb(@{$v->Get('label-color')});
  50                 $cairo->set_font_size($r * $v->Get('label-size'));
  51                 my $xt = $cairo->text_extents($label);
  52                 $cairo->move_to($x - $xt->{'width'}/2 - $xt->{'x_bearing'},
  53                                 $y - $xt->{'height'}/2 - $xt->{'y_bearing'});
  54                 $cairo->show_text($label);
  55         }
  56 }
  57
  58 package AA::Edge;
  59
  60 our @ISA = ('AA');
  61
  62 sub new($$$$) {
  63         my ($class, $id, $v, $w) = @_;
  64         my $e = AA::new($class, $id);
  65         $e->DefSet('color', [1, 1, 1]);
  66         $e->DefSet('width', 3);
  67         $e->DefSet('arrow', 0);
  68         $e->DefSet('arrow-dist', 20);
  69         $e->DefSet('arrow-span', 6);
  70         $e->DefBind('ends', sub {
  71                 my $x1 = $v->Get('x');
  72                 my $y1 = $v->Get('y');
  73                 my $r1 = $v->Get('r');
  74                 my $x2 = $w->Get('x');
  75                 my $y2 = $w->Get('y');
  76                 my $r2 = $w->Get('r');
  77                 my $dx = $x2 - $x1;
  78                 my $dy = $y2 - $y1;
  79                 my $d = sqrt($dx*$dx + $dy*$dy);
  80                 $x1 += $dx * $r1/$d;
  81                 $y1 += $dy * $r1/$d;
  82                 $x2 -= $dx * $r2/$d;
  83                 $y2 -= $dy * $r2/$d;
  84                 return [ $x1, $y1, $x2, $y2 ];
  85         });
  86         $e->DefBind('apos', sub {
  87                 my $type = $e->Get('arrow') or return undef;
  88                 my $span = $e->Get('arrow-span');
  89                 my $dist = $e->Get('arrow-dist');
  90                 my ($x1, $y1, $x2, $y2) = @{$e->Get('ends')};
  91                 my $dx = $x2 - $x1;
  92                 my $dy = $y2 - $y1;
  93                 my $d = sqrt($dx*$dx + $dy*$dy);
  94                 my $ax = $x2 - $dx * $dist/$d;
  95                 my $ay = $y2 - $dy * $dist/$d;
  96                 my $adx = -$dy;
  97                 my $ady = $dx;
  98                 ($adx, $ady) = ($adx * $span/$d, $ady * $span/$d);
  99                 return [ $ax+$adx, $ay+$ady,
 100                          $ax-$adx, $ay-$ady ];
 101         });
 102         $e->DefSet('d', 10);
 103         return $e;
 104 }
 105
 106 sub Draw($$) {
 107         my ($v, $cairo) = @_;
 108
 109         my ($x1, $y1, $x2, $y2) = @{$v->Get('ends')};
 110         $cairo->set_source_rgb(@{$v->Get('color')});
 111
 112         $cairo->move_to($x1, $y1);
 113         $cairo->line_to($x2, $y2);
 114         $cairo->set_line_width($v->Get('width'));
 115         $cairo->stroke;
 116
 117         if ($v->Get('arrow')) {
 118                 my ($ax1, $ay1, $ax2, $ay2) = @{$v->Get('apos')};
 119                 $cairo->move_to($x2, $y2);
 120                 $cairo->line_to($ax1, $ay1);
 121                 $cairo->line_to($ax2, $ay2);
 122                 $cairo->close_path;
 123                 $cairo->fill;
 124         }
 125 }
 126
 127 1;