From: Martin Mares <mj@ucw.cz>
Date: Sun, 28 Oct 2007 21:02:56 +0000 (+0100)
Subject: Goldbergovske variace.
X-Git-Url: http://mj.ucw.cz/gitweb/?a=commitdiff_plain;h=bc773f70fb1411290ccccd2b77694a5ca3eaa03f;p=anim.git

Goldbergovske variace.
---

diff --git a/AA.pm b/AA.pm
index b2dc926..c4fcc59 100644
--- a/AA.pm
+++ b/AA.pm
@@ -128,6 +128,8 @@ sub Bind($$$) {
 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;
@@ -171,4 +173,17 @@ sub Notify($$) {
 	}
 }
 
+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;
diff --git a/AA/Gfx.pm b/AA/Gfx.pm
index 6a1eadc..f55ed7e 100644
--- a/AA/Gfx.pm
+++ b/AA/Gfx.pm
@@ -19,4 +19,31 @@ sub Draw($$) {
 	$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;
diff --git a/AA/Graph.pm b/AA/Graph.pm
index dbd17f5..afd1d6c 100644
--- a/AA/Graph.pm
+++ b/AA/Graph.pm
@@ -66,9 +66,19 @@ sub new($$$$) {
 	$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');
@@ -77,53 +87,38 @@ sub new($$$$) {
 		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;
 	}
 }
 
diff --git a/AA/Net.pm b/AA/Net.pm
index 9c06d42..d0d074a 100644
--- a/AA/Net.pm
+++ b/AA/Net.pm
@@ -8,8 +8,48 @@ sub new($$$$) {
 	$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;
diff --git a/a.pl b/a.pl
index d8df74d..48a9c04 100755
--- a/a.pl
+++ b/a.pl
@@ -17,30 +17,99 @@ my $ui = AA::UI->new('');
 
 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;