lib/LaTeX/TikZ/Context.pm

   1 package LaTeX::TikZ::Context;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Context - An object modeling in which context a set is evaluated.
   9
  10 =head1 VERSION
  11
  12 Version 0.03
  13
  14 =cut
  15
  16 our $VERSION = '0.03';
  17
  18 use LaTeX::TikZ::Mod (); # Required to work around a bug in Mouse
  19
  20 use LaTeX::TikZ::Tools;
  21
  22 use Mouse;
  23
  24 =head1 ATTRIBUTES
  25
  26 =head2 C<parent>
  27
  28 The parent context of the current one, or C<undef> for the topmost context.
  29
  30 =cut
  31
  32 has 'parent' => (
  33  is       => 'ro',
  34  isa      => 'Maybe[LaTeX::TikZ::Context]',
  35  required => 0,
  36  default  => undef,
  37 );
  38
  39 =head2 C<mods>
  40
  41 The list of mods that are asked to be applied in this context.
  42
  43 =cut
  44
  45 has '_mods' => (
  46  is       => 'ro',
  47  isa      => 'ArrayRef[LaTeX::TikZ::Mod]',
  48  required => 0,
  49  default  => sub { [ ] },
  50  init_arg => 'mods',
  51 );
  52
  53 sub mods { @{$_[0]->_mods} }
  54
  55 has '_applied_mods' => (
  56  is       => 'ro',
  57  isa      => 'HashRef[LaTeX::TikZ::Mod]',
  58  required => 0,
  59  default  => sub { { } },
  60  init_arg => undef,
  61 );
  62
  63 =head2 C<effective_mods>
  64
  65 The list of mods that actually need to be applied in this context.
  66
  67 =cut
  68
  69 has '_effective_mods' => (
  70  is       => 'ro',
  71  isa      => 'ArrayRef[LaTeX::TikZ::Mod]',
  72  required => 0,
  73  default  => sub { [ ] },
  74  init_arg => undef,
  75 );
  76
  77 sub effective_mods { @{$_[0]->_effective_mods} }
  78
  79 has '_last_mod' => (
  80  is       => 'rw',
  81  isa      => 'Int',
  82  required => 0,
  83  default  => 0,
  84  init_arg => undef,
  85 );
  86
  87 my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer');
  88
  89 sub BUILD {
  90  my $cxt  = shift;
  91  my $pcxt = $cxt->parent;
  92
  93  my $applied_mods = $cxt->_applied_mods;
  94  for (my $c = $pcxt; defined $c; $c = $c->parent) {
  95   my $mods = $c->_applied_mods;
  96   while (my ($tag, $mods_info) = each %$mods) {
  97    unshift @{$applied_mods->{$tag}}, @$mods_info;
  98   }
  99  }
 100
 101  my $last_mod       = defined $pcxt ? $pcxt->_last_mod : 0;
 102  my $effective_mods = $cxt->_effective_mods;
 103
 104  my $last_layer;
 105
 106 MOD:
 107  for my $mod ($cxt->mods) {
 108   my $is_layer = $ltml_tc->check($mod);
 109   $last_layer  = $mod if $is_layer;
 110
 111   my $tag = $mod->tag;
 112   my $old = $applied_mods->{$tag} || [];
 113   for (@$old) {
 114    next MOD if $_->[0]->covers($mod);
 115   }
 116
 117   push @{$applied_mods->{$tag}}, [ $mod, $last_mod++, $is_layer ];
 118   push @$effective_mods, $mod;
 119  }
 120
 121  if ($last_layer) {
 122   # Clips and mods don't propagate through layers. Hence, if a layer is set,
 123   # we should force their reuse.
 124   @$effective_mods = $last_layer;
 125   push @$effective_mods, map $_->[0],
 126                           sort { $a->[1] <=> $b->[1] }
 127                            grep !$_->[2],
 128                             map @$_,
 129                              values %$applied_mods;
 130  }
 131
 132  $cxt->_last_mod($last_mod);
 133 }
 134
 135 =head1 SEE ALSO
 136
 137 L<LaTeX::TikZ>.
 138
 139 =head1 AUTHOR
 140
 141 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 142
 143 You can contact me by mail or on C<irc.perl.org> (vincent).
 144
 145 =head1 BUGS
 146
 147 Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
 148 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 149
 150 =head1 SUPPORT
 151
 152 You can find documentation for this module with the perldoc command.
 153
 154     perldoc LaTeX::TikZ
 155
 156 =head1 COPYRIGHT & LICENSE
 157
 158 Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved.
 159
 160 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 161
 162 =cut
 163
 164 1; # End of LaTeX::TikZ::Context