X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FReaction%2FUI%2FViewPort.pm;h=06ffffa864dec525ba4a8bd40a3af6be106bc896;hb=e653a48785a1942da650254c8fba30706ca18333;hp=7d24efc8983c6f45635f34b951aa04f2fdd2397c;hpb=5ee24b95cec49b29e5508a91d7ae5815cb535ab0;p=catagits%2FReaction.git

diff --git a/lib/Reaction/UI/ViewPort.pm b/lib/Reaction/UI/ViewPort.pm
index 7d24efc..06ffffa 100644
--- a/lib/Reaction/UI/ViewPort.pm
+++ b/lib/Reaction/UI/ViewPort.pm
@@ -3,128 +3,141 @@ package Reaction::UI::ViewPort;
 use Reaction::Class;
 use Scalar::Util qw/blessed/;
 
-class ViewPort which {
-
-  has location => (isa => 'Str', is => 'rw', required => 1);
-  has layout => (isa => 'Str', is => 'rw', lazy_build => 1);
-  has outer => (isa => 'Reaction::UI::ViewPort', is => 'rw', weak_ref => 1);
-  has inner => (isa => 'Reaction::UI::ViewPort', is => 'rw');
-  has focus_stack => (
-    isa => 'Reaction::UI::FocusStack', is => 'rw', weak_ref => 1
-  );
-  has _tangent_stacks => (
-    isa => 'HashRef', is => 'ro', default => sub { {} }
-  );
-  has ctx => (isa => 'Catalyst', is => 'ro', required => 1);
-
-  implements _build_layout => as {
-    '';
-  };
-
-  implements create_tangent => as {
-    my ($self, $name) = @_;
-    my $t_map = $self->_tangent_stacks;
-    if (exists $t_map->{$name}) {
-      confess "Can't create tangent with already existing name ${name}";
-    }
-    my $loc = join('.', $self->location, $name);
-    my $tangent = Reaction::UI::FocusStack->new(loc_prefix => $loc);
-    $t_map->{$name} = $tangent;
+use namespace::clean -except => [ qw(meta) ];
+
+
+sub DEBUG_EVENTS () { $ENV{REACTION_UI_VIEWPORT_DEBUG_EVENTS} }
+
+has location => (isa => 'Str', is => 'rw', required => 1);
+has layout => (isa => 'Str', is => 'rw', lazy_build => 1);
+has layout_args => (isa => 'HashRef', is => 'ro', default => sub { {} });
+has outer => (isa => 'Reaction::UI::ViewPort', is => 'rw', weak_ref => 1);
+has inner => (isa => 'Reaction::UI::ViewPort', is => 'rw');
+has focus_stack => (
+  isa => 'Reaction::UI::FocusStack', is => 'rw', weak_ref => 1
+);
+has _tangent_stacks => (
+  isa => 'HashRef', is => 'ro', default => sub { {} }
+);
+has ctx => (isa => 'Catalyst', is => 'ro', weak_ref => 1); #, required => 1);
+
+sub _build_layout {
+  '';
+}
+
+sub create_tangent {
+  my ($self, $name) = @_;
+  my $t_map = $self->_tangent_stacks;
+  if (exists $t_map->{$name}) {
+    confess "Can't create tangent with already existing name ${name}";
+  }
+  my $loc = join('.', $self->location, $name);
+  my $tangent = Reaction::UI::FocusStack->new(loc_prefix => $loc);
+  $t_map->{$name} = $tangent;
+  return $tangent;
+}
+
+sub focus_tangent {
+  my ($self, $name) = @_;
+  if (my $tangent = $self->_tangent_stacks->{$name}) {
     return $tangent;
-  };
-
-  implements focus_tangent => as {
-    my ($self, $name) = @_;
-    if (my $tangent = $self->_tangent_stacks->{$name}) {
-      return $tangent;
-    } else {
-      return;
-    }
-  };
-
-  implements focus_tangents => as {
-    return keys %{shift->_tangent_stacks};
-  };
-
-  implements child_event_sinks => as {
-    my $self = shift;
-    return values %{$self->_tangent_stacks};
-  };
-
-  implements apply_events => as {
-    my ($self, $ctx, $events) = @_;
-    return unless keys %$events;
-    $self->apply_child_events($ctx, $events);
-    $self->apply_our_events($ctx, $events);
-  };
-
-  implements apply_child_events => as {
-    my ($self, $ctx, $events) = @_;
-    return unless keys %$events;
-    foreach my $child ($self->child_event_sinks) {
-      confess blessed($child) ."($child) is not a valid object"
-        unless blessed($child) && $child->can('apply_events');
-      $child->apply_events($ctx, $events);
-    }
-  };
-
-  implements apply_our_events => as {
-    my ($self, $ctx, $events) = @_;
-    my @keys = keys %$events;
-    return unless @keys;
-    my $loc = $self->location;
-    my %our_events;
-    foreach my $key (keys %$events) {
-      if ($key =~ m/^${loc}:(.*)$/) {
-        $our_events{$1} = $events->{$key};
-      }
-    }
-    if (keys %our_events) {
-      #warn "$self: events ".join(', ', %our_events)."\n";
-      $self->handle_events(\%our_events);
+  } else {
+    return;
+  }
+}
+
+sub focus_tangents {
+  return keys %{shift->_tangent_stacks};
+}
+
+sub child_event_sinks {
+  my $self = shift;
+  return values %{$self->_tangent_stacks};
+}
+
+sub apply_events {
+  my ($self, $events) = @_;
+  return unless keys %$events;
+  $self->apply_child_events($events);
+  $self->apply_our_events($events);
+}
+
+sub apply_child_events {
+  my ($self, $events) = @_;
+  return unless keys %$events;
+  foreach my $child ($self->child_event_sinks) {
+    confess blessed($child) ."($child) is not a valid object"
+      unless blessed($child) && $child->can('apply_events');
+    my $loc = $child->location;
+    my %child_events = map { $_ => delete $events->{$_} }
+      grep { /^${loc}[-:]/ } keys %$events;
+    $child->apply_events(\%child_events);
+  }
+}
+
+sub apply_our_events {
+  my ($self, $events) = @_;
+  my $loc = $self->location;
+  my %our_events;
+  foreach my $key (keys %$events) {
+    if ($key =~ m/^${loc}:(.*)$/) {
+      $our_events{$1} = delete $events->{$key};
     }
-  };
-
-  implements handle_events => as {
-    my ($self, $events) = @_;
-    foreach my $event ($self->accept_events) {
-      if (exists $events->{$event}) {
-        #my $name = eval{$self->name};
-        #$self->ctx->log->debug("Applying Event: $event on $name with value: ". $events->{$event});
-        $self->$event($events->{$event});
+  }
+  $self->handle_events(\%our_events) if keys %our_events;
+}
+
+sub handle_events {
+  my ($self, $events) = @_;
+  my $exists = exists $events->{exists};
+  if ($exists) {
+    my %force = $self->force_events;
+    my @need = grep { !exists $events->{$_} } keys %force;
+    @{$events}{@need} = @force{@need};
+  }
+  foreach my $event ($self->accept_events) {
+    if (exists $events->{$event}) {
+      if (DEBUG_EVENTS) {
+        my $name = join(' at ', $self, $self->location);
+        print STDERR
+          "Applying Event: $event on $name with value: "
+          .(defined $events->{$event} ? $events->{$event} : '<undef>')."\n";
       }
+      $self->$event($events->{$event});
     }
-  };
+  }
+}
 
-  implements accept_events => as { () };
+sub accept_events { () }
 
-  implements event_id_for => as {
-    my ($self, $name) = @_;
-    return join(':', $self->location, $name);
-  };
+sub force_events { () }
 
-  implements sort_by_spec => as {
-    my ($self, $spec, $items) = @_;
-    return $items if not defined $spec;
+sub event_id_for {
+  my ($self, $name) = @_;
+  return join(':', $self->location, $name);
+}
 
-    my @order;
-    if (ref $spec eq 'ARRAY') {
-      @order = @$spec;
-    }
-    elsif (not ref $spec) {
-      return $items unless length $spec;
-      @order = split /\s+/, $spec;
-    }
+sub sort_by_spec {
+  my ($self, $spec, $items) = @_;
+  return [sort @$items] unless $spec;
 
-    my %order_map = map {$_ => 0} @$items;
-    for my $order_num (0..$#order) {
-      $order_map{ $order[$order_num] } = ($#order - $order_num) + 1;
-    }
+  my @order;
+  if (ref $spec eq 'ARRAY') {
+    @order = @$spec;
+  } elsif (not ref $spec) {
+    @order = split /\s+/, $spec;
+  }
+
+  my %order_map = map {$_ => 0} @$items;
+  for my $order_num (0..$#order) {
+    $order_map{ $order[$order_num] } = ($#order - $order_num) + 1;
+  }
+
+  return [sort {$order_map{$b} <=> $order_map{$a}} @$items];
+}
 
-    return [sort {$order_map{$b} <=> $order_map{$a}} @$items];
-  };
+__PACKAGE__->meta->make_immutable;
 
-};
 
 1;