3 use overload '""' => 'ID';
5 our $PI = 3.1415926535;
16 my ($class, $id) = @_;
20 !defined $known_objs{$id} or die "Object $id already defined";
21 $known_objs{$id} = $o;
22 print "Created object $id\n" if $debug;
23 return bless $o, $class;
27 my ($class, $id) = @_;
28 defined $known_objs{$id} or die "Object $id not known";
29 return $known_objs{$id};
35 while ($o = shift @pending_recalcs) {
36 print "Going to recalculate object $o\n" if $debug;
37 my $pend = $o->{PENDING};
39 foreach my $a (keys %$pend) {
45 sub get_visible_objects() {
47 foreach my $o (values %known_objs) {
48 push @q, $o if defined $o->{'a:d'};
50 return sort { $a->{'a:d'} <=> $b->{'a:d'} } @q;
54 my ($class, $cairo) = @_;
55 print "Redrawing the scene...\n" if $debug;
56 foreach my $o (get_visible_objects()) {
57 print "Drawing $o at depth ", $o->{'a:d'}, "\n" if $debug;
63 return (shift @_)->{ID};
68 !exists $o->{"a:$a"} or die "Redefining attribute $a of object $o";
69 $o->{"a:$a"} = undef; # attribute value
70 # $o->{"f:$a"} = undef; # binding function
71 $o->{"d:$a"} = { }; # depends on (obj:attr => obj)
72 $o->{"n:$a"} = { }; # notify (obj:attr => obj)
88 my ($o, $a, $v, $b) = @_;
90 $o->Bind($a, sub { $v->Get($b); });
95 return defined $o->{"a:$a"};
100 defined $o->{"a:$a"} or die "Getting undefined attribute $a of object $o";
102 # record the dependency
104 if (!defined $record_deps->{$did}) {
105 $record_deps->{$did} = $o;
106 my $rid = "$record_dep_obj:$record_dep_attr";
107 $o->{"n:$a"}->{$rid} = $record_dep_obj;
108 print "Added automatic dependency $rid -> $did\n" if $debug;
115 my ($o, $a, $v) = @_;
116 exists $o->{"a:$a"} or die "Setting undefined attribute $a of object $o";
117 print "Setting $o:$a = $v\n" if $debug;
119 !defined $o->{"f:$a"} or $o->UnBind($a);
124 my ($o, $a, $f) = @_;
125 exists $o->{"a:$a"} or die "Binding undefined attribute $a of object $o";
126 print "Binding $o:$a\n" if $debug;
135 return unless defined $o->{"f:$a"};
137 $record_deps = $o->{"d:$a"};
138 $record_dep_obj = $o;
139 $record_dep_attr = $a;
141 $o->{"a:$a"} = undef;
142 $o->{"a:$a"} = &{$o->{"f:$a"}} ($o);
144 $record_deps = undef;
145 $record_dep_obj = undef;
146 $record_dep_attr = undef;
148 print "Recalculated $o:$a = ", $o->{"a:$a"}, "\n" if $debug;
155 foreach my $dep (keys %{$o->{"d:$a"}}) {
156 my ($deponame, $depa) = split(/:/, $dep);
157 my $depo = $o->{"d:$a"}->{$dep};
158 delete $depo->{"n:$depa"}->{$aid};
159 print "Removed notify $aid -> $depo:$depa\n" if $debug;
167 foreach my $dep (keys %{$o->{"n:$a"}}) {
168 my ($deponame, $depa) = split(/:/, $dep);
169 my $depo = $o->{"n:$a"}->{$dep};
170 print "Sending notify $o:$a -> $deponame:$depa\n" if $debug;
171 if (!defined $depo->{PENDING}) {
172 $depo->{PENDING} = { };
173 push @pending_recalcs, $depo;
174 print "\tPending object $deponame\n" if $debug;
176 $depo->{PENDING}->{$depa} = 1;
183 while ($a = shift @_) {
185 if (ref $v eq "CODE") {
198 print "Simulated draw...\n" if $debug;
199 foreach my $o (AA::get_visible_objects()) {
200 print "Drawing $o at depth ", $o->{'a:d'}, "\n" if $debug;
202 foreach my $k (keys %$o) {
203 $k =~ /^a:/ && push @$obj, $k, $o->{$k};
207 return bless($scene, $class);
211 my ($scene, $cairo) = @_;
212 foreach my $obj (@$scene) {
214 for (my $i=1; $i<@$obj; $i+=2) {