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->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-dist', 20);
  70         $e->DefSet('arrow-span', 6);
  71         $e->DefSet('overshoot', 3);
  72         $e->DefBind('ends', sub {
  73                 my $over = $e->Get('overshoot');
  74                 my $x1 = $v->Get('x');
  75                 my $y1 = $v->Get('y');
  76                 my $r1 = $v->Get('r') - $over;
  77                 my $x2 = $w->Get('x');
  78                 my $y2 = $w->Get('y');
  79                 my $r2 = $w->Get('r') - $over;
  80                 my $dx = $x2 - $x1;
  81                 my $dy = $y2 - $y1;
  82                 my $d = sqrt($dx*$dx + $dy*$dy);
  83                 $x1 += $dx * $r1/$d;
  84                 $y1 += $dy * $r1/$d;
  85                 $x2 -= $dx * $r2/$d;
  86                 $y2 -= $dy * $r2/$d;
  87                 return [ $x1, $y1, $x2, $y2 ];
  88         });
  89         $e->DefBind('apos', sub {
  90                 my $type = $e->Get('arrow') or return undef;
  91                 my $span = $e->Get('arrow-span');
  92                 my $dist = $e->Get('arrow-dist');
  93                 my ($x1, $y1, $x2, $y2) = @{$e->Get('ends')};
  94                 my $dx = $x2 - $x1;
  95                 my $dy = $y2 - $y1;
  96                 my $d = sqrt($dx*$dx + $dy*$dy);
  97                 my $ax = $x2 - $dx * $dist/$d;
  98                 my $ay = $y2 - $dy * $dist/$d;
  99                 my $adx = -$dy;
 100                 my $ady = $dx;
 101                 ($adx, $ady) = ($adx * $span/$d, $ady * $span/$d);
 102                 return [ $ax+$adx, $ay+$ady,
 103                          $ax-$adx, $ay-$ady ];
 104         });
 105         $e->DefSet('d', 10);
 106         return $e;
 107 }
 108
 109 sub Draw($$) {
 110         my ($v, $cairo) = @_;
 111
 112         my ($x1, $y1, $x2, $y2) = @{$v->Get('ends')};
 113         $cairo->set_source_rgb(@{$v->Get('color')});
 114
 115         $cairo->move_to($x1, $y1);
 116         $cairo->line_to($x2, $y2);
 117         $cairo->set_line_width($v->Get('width'));
 118         $cairo->stroke;
 119
 120         if ($v->Get('arrow')) {
 121                 my ($ax1, $ay1, $ax2, $ay2) = @{$v->Get('apos')};
 122                 $cairo->move_to($x2, $y2);
 123                 $cairo->line_to($ax1, $ay1);
 124                 $cairo->line_to($ax2, $ay2);
 125                 $cairo->close_path;
 126                 $cairo->fill;
 127         }
 128 }
 129
 130 1;