a.pl

   1 #!/usr/bin/perl -W
   2
   3 use strict;
   4 use warnings;
   5
   6 use Gtk2 -init;
   7 use Cairo;
   8
   9 use AA;
  10 use AA::Gfx;
  11 use AA::UI;
  12 use AA::Graph;
  13 use AA::Net;
  14 use AA::Anim;
  15
  16 my $ui = AA::UI->new('');
  17
  18 my $back = AA::Background->new('bg');
  19
  20 my @v;
  21 for (my $i=0; $i<5; $i++) {
  22         my $v = AA::NetV->new("v$i");
  23         $v->MultiSet(
  24                 'x' => 100 + 180*$i,
  25                 'y0' => 600,
  26                 'label' => ($i == 0) ? "Z" : ($i == 4) ? "S" : $i,
  27                 'h' => ($i == 0) ? 5 : 0,
  28         );
  29         push @v, $v;
  30 }
  31
  32 my @e;
  33 for (my $i=0; $i<4; $i++) {
  34         my $e = AA::NetE->new("e$i", $v[$i], $v[$i+1]);
  35         $e->Set('c', 5);
  36         $e->Set('f', 0);
  37         push @e, $e;
  38 }
  39
  40 for (my $i=1; $i<@v; $i++) {
  41         my $ii = $i;    # need to keep a copy in the current closure
  42         $v[$i]->Bind('xs', sub { $e[$ii-1]->Get('f') - (($ii == @v-1) ? 0 : $e[$ii]->Get('f')) });
  43 }
  44 $v[4]->{XS}->Set('color', [1,0,1]);
  45
  46 sub flow($$) {
  47         my ($i,$df) = @_;
  48         $e[$i]->Set('f', $e[$i]->Get('f') + $df);
  49 }
  50
  51 sub up($) {
  52         my ($i) = @_;
  53         $v[$i]->Set('h', $v[$i]->Get('h') + 1);
  54 }
  55
  56 sub hint($) {
  57         my ($h) = @_;
  58         for (my $i=0; $i<@v; $i++) {
  59                 $v[$i]->Set('hint', $i == $h);
  60         }
  61 }
  62
  63 my $scenario = [
  64         sub { flow(0, 5);       hint(1); },
  65         sub { up(1); },
  66         sub { flow(1, 5);       hint(2); },
  67         sub { up(2); },
  68         sub { flow(2, 5);       hint(3); },
  69         sub { up(3); },
  70         sub { flow(3, 5);       hint(-1); },
  71 ];
  72
  73 if (1) {
  74         for (my $i=0; $i<@v-1; $i++) {
  75                 $e[$i]->Set('c', 5-$i);
  76         }
  77         $scenario = [
  78                 sub { flow(0, 5); hint(1); },
  79                 sub { up(1); },
  80                 sub { flow(1, 4); hint(2); },
  81                 sub { up(2); },
  82                 sub { flow(2, 3); hint(3); },
  83                 sub { up(3); },
  84                 sub { flow(3, 2); },
  85                 sub { up(3); },
  86                 sub { flow(2, -1); hint(2); },
  87                 sub { up(2); },
  88                 sub { flow(1, -1); hint(1); },
  89                 sub { up(1); },
  90                 sub { up(1); },
  91                 sub { flow(1, 1); },
  92                 sub { up(1); },
  93                 sub { up(1); },
  94                 sub { up(1); },
  95                 sub { flow(0, -1); hint(2); },
  96                 sub { up(2); },
  97                 sub { flow(2, 1); hint(3); },
  98                 sub { up(3); },
  99                 sub { up(3); },
 100                 sub { flow(2, -1); hint(2); },
 101                 sub { up(2); },
 102                 sub { up(2); },
 103                 sub { flow(2, 1); hint(3); },
 104                 sub { up(3); },
 105                 sub { up(3); },
 106                 sub { flow(2, -1); hint(2); },
 107                 sub { up(2); },
 108                 sub { up(2); },
 109                 sub { flow(2, 1); },
 110                 sub { flow(1, -1); hint(1); },
 111                 sub { flow(0, -1); hint(3); },
 112                 sub { up(3); },
 113                 sub { up(3); },
 114                 sub { flow(2, -1); hint(2); },
 115                 sub { flow(1, -1); hint(1); },
 116                 sub { flow(0, -1); hint(-1); },
 117         ];
 118 }
 119
 120 $ui->RunScenario($scenario, 1);
 121
 122 exit 0;
 123