sub Calc($$) {
my ($o, $a) = @_;
die if $record_deps;
+ return unless defined $o->{"f:$a"};
+
$record_deps = $o->{"d:$a"};
$record_dep_obj = $o;
$record_dep_attr = $a;
}
}
+sub MultiSet($@) {
+ my $o = shift @_;
+ my ($a, $v);
+ while ($a = shift @_) {
+ $v = shift @_;
+ if (ref $v eq "CODE") {
+ $o->Bind($a, $v);
+ } else {
+ $o->Set($a, $v);
+ }
+ }
+}
+
1;
$cairo->fill;
}
+package AA::Label;
+
+@ISA = ('AA');
+
+sub new($$) {
+ my ($class, $id) = @_;
+ my $t = AA::new($class, $id);
+ $t->DefSet('d', 10);
+ $t->DefSet('x', 100);
+ $t->DefSet('y', 100);
+ $t->DefSet('color', [1, 1, 1]);
+ $t->DefSet('size', 12);
+ $t->DefSet('text', '');
+ return $t;
+}
+
+sub Draw($$) {
+ my ($t, $cairo) = @_;
+ my $text = $t->Get('text');
+ $cairo->set_source_rgb(@{$t->Get('color')});
+ $cairo->set_font_size($t->Get('size'));
+ my $xt = $cairo->text_extents($text);
+ $cairo->move_to($t->Get("x") - $xt->{'width'}/2 - $xt->{'x_bearing'},
+ $t->Get("y") - $xt->{'height'}/2 - $xt->{'y_bearing'});
+ $cairo->show_text($text);
+}
+
1;
$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->DefSet('arrow-size', 20); # distance between arrow tip and back
+ $e->DefSet('arrow-span', 0.5); # fraction of arrow-size
$e->DefSet('overshoot', 3);
+ $e->DefBind('dir', sub {
+ my $dx = $w->Get('x') - $v->Get('x');
+ my $dy = $w->Get('y') - $v->Get('y');
+ my $d = sqrt($dx*$dx + $dy*$dy);
+ if ($d) {
+ return [$dx/$d, $dy/$d];
+ } else {
+ return [0, 0];
+ }
+ });
$e->DefBind('ends', sub {
my $over = $e->Get('overshoot');
my $x1 = $v->Get('x');
my $x2 = $w->Get('x');
my $y2 = $w->Get('y');
my $r2 = $w->Get('r') - $over;
- 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 ];
+ my ($dx,$dy) = @{$e->Get('dir')};
+ return [ $x1+$r1*$dx, $y1+$r1*$dy, $x2-$r2*$dx, $y2-$r2*$dy ];
});
$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')};
+ my ($e, $cairo) = @_;
+ my ($x1, $y1, $x2, $y2) = @{$e->Get('ends')};
+ $cairo->set_source_rgb(@{$e->Get('color')});
+ $cairo->set_line_width($e->Get('width'));
+ if (my $arrow = $e->Get('arrow')) {
+ my $size = $e->Get('arrow-size');
+ my $span = $size * $e->Get('arrow-span');
+ my ($dx,$dy) = @{$e->Get('dir')};
+ # line
+ $cairo->move_to($x1, $y1);
+ $cairo->line_to($x2 - $dx*$size*0.9, $y2 - $dy*$size*0.9);
+ $cairo->stroke;
+ # arrow
+ my ($ax,$ay) = (-$dy,$dx);
+ my ($bx,$by) = ($x2 - $dx*$size, $y2 - $dy*$size);
$cairo->move_to($x2, $y2);
- $cairo->line_to($ax1, $ay1);
- $cairo->line_to($ax2, $ay2);
+ $cairo->line_to($bx + $ax*$span, $by + $ay*$span);
+ $cairo->line_to($bx - $ax*$span, $by - $ay*$span);
$cairo->close_path;
$cairo->fill;
+ } else {
+ $cairo->move_to($x1, $y1);
+ $cairo->line_to($x2, $y2);
+ $cairo->stroke;
}
}
$v->Set('x', 100);
$v->DefSet('y0', 100);
$v->DefSet('h', 0);
- $v->Bind('y', sub { $v->Get("y0") + 100*$v->Get("h") });
+ $v->DefSet('xs', '');
+ $v->Bind('y', sub { $v->Get("y0") - 50*$v->Get("h") });
+ $v->{XS} = AA::Label->new("$id-label");
+ $v->{XS}->MultiSet(
+ 'x' => sub { $v->Get('x') },
+ 'y' => sub { $v->Get('y') + 80 },
+ 'size' => 50,
+ 'text' => sub { $v->Get('xs') },
+ 'color' => sub { $v->Get('xs') ? [1,0,0] : [1,1,1] },
+ );
return $v;
}
+package AA::NetE;
+
+our @ISA = ('AA');
+
+sub new($$$$) {
+ my ($class, $id, $v, $w) = @_;
+ my $e = AA::new($class, $id);
+ $e->{E} = AA::Edge->new("$id-e", $v, $w);
+ $e->{E}->Set('arrow', 1);
+ $e->{E}->Set('color', [1,0,0]);
+ $e->DefSet('c', 1);
+ $e->DefSet('f', 0);
+ $e->DefSet('d', 9);
+ $e->DefDep('ends', $e->{E}, 'ends');
+ $e->{E}->Bind('width', sub { $e->Get('f') * 5 + 1 });
+# $e->{E}->Bind('overshoot', sub { $e->Get('f') * 3 + 3});
+ $e->{E}->Bind('arrow-size', sub { $e->Get('f') * 5 + 20});
+ return $e;
+}
+
+sub Draw($$) {
+ my ($e, $cairo) = @_;
+ my ($x1, $y1, $x2, $y2) = @{$e->Get('ends')};
+ $cairo->new_path;
+ $cairo->set_source_rgb(0.3, 1, 0);
+ $cairo->set_line_width($e->Get('c') * 5 + 1);
+ $cairo->move_to($x1, $y1);
+ $cairo->line_to($x2, $y2);
+ $cairo->stroke;
+}
+
1;
my $back = AA::Background->new('bg');
-my $v = AA::NetV->new('v');
-$v->Set('x', 100);
-$v->Set('y0', 100);
-$v->Set('label', '1');
+my @v;
+for (my $i=0; $i<5; $i++) {
+ my $v = AA::NetV->new("v$i");
+ $v->MultiSet(
+ 'x' => 100 + 180*$i,
+ 'y0' => 600,
+ 'label' => ($i == 0) ? "Z" : ($i == 4) ? "S" : $i,
+ 'h' => ($i == 0) ? 5 : 0,
+ );
+ push @v, $v;
+}
-my $w = AA::NetV->new('w');
-$w->Bind('x', AA::Anim->ticker(200, 600, 200));
-$w->Set('y0', 100);
-$w->Set('label', '2');
+my @e;
+for (my $i=0; $i<4; $i++) {
+ my $e = AA::NetE->new("e$i", $v[$i], $v[$i+1]);
+ $e->Set('c', 5);
+ $e->Set('f', 0);
+ push @e, $e;
+}
-my $e = AA::Edge->new('e', $v, $w);
-$e->Set('arrow', 1);
+for (my $i=1; $i<@v; $i++) {
+ my $ii = $i; # need to keep a copy in the current closure
+ $v[$i]->Bind('xs', sub { $e[$ii-1]->Get('f') - (($ii == @v-1) ? 0 : $e[$ii]->Get('f')) });
+}
+$v[4]->{XS}->Set('color', [0,1,0]);
+
+sub flow($$) {
+ my ($i,$df) = @_;
+ $e[$i]->Set('f', $e[$i]->Get('f') + $df);
+}
+
+sub up($) {
+ my ($i) = @_;
+ $v[$i]->Set('h', $v[$i]->Get('h') + 1);
+}
my $scenario = [
- sub {
- $v->Set("h", 1);
- $w->Set("h", 1);
- },
- sub {
- $v->Set("h", 1);
- $w->Set("h", 2);
- }
+ sub { flow(0, 5); },
+ sub { up(1); },
+ sub { flow(1, 5); },
+ sub { up(2); },
+ sub { flow(2, 5); },
+ sub { up(3); },
+ sub { flow(3, 5); },
];
+if (1) {
+ for (my $i=0; $i<@v-1; $i++) {
+ $e[$i]->Set('c', 5-$i);
+ }
+ $scenario = [
+ sub { flow(0, 5); },
+ sub { up(1); },
+ sub { flow(1, 4); },
+ sub { up(2); },
+ sub { flow(2, 3); },
+ sub { up(3); },
+ sub { flow(3, 2); },
+ sub { up(3); },
+ sub { flow(2, -1); },
+ sub { up(2); },
+ sub { flow(1, -1); },
+ sub { up(1); },
+ sub { up(1); },
+ sub { flow(1, 1); },
+ sub { up(1); },
+ sub { up(1); },
+ sub { up(1); },
+ sub { flow(0, -1); },
+ sub { up(2); },
+ sub { flow(2, 1); },
+ sub { up(3); },
+ sub { up(3); },
+ sub { flow(2, -1); },
+ sub { up(2); },
+ sub { up(2); },
+ sub { flow(2, 1); },
+ sub { up(3); },
+ sub { up(3); },
+ sub { flow(2, -1); },
+ sub { up(2); },
+ sub { up(2); },
+ sub { flow(2, 1); },
+ sub { flow(1, -1); },
+ sub { flow(0, -1); },
+ sub { up(3); },
+ sub { up(3); },
+ sub { flow(2, -1); },
+ sub { flow(1, -1); },
+ sub { flow(0, -1); },
+ ];
+}
+
$ui->RunScenario($scenario, 1);
exit 0;
projects / anim.git / commitdiff