lib/LaTeX/TikZ/Set/Mod.pm

   1 package LaTeX::TikZ::Set::Mod;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Set::Mod - A set object that stores modifiers to be applied underneath.
   9
  10 =head1 VERSION
  11
  12 Version 0.01
  13
  14 =cut
  15
  16 our $VERSION = '0.01';
  17
  18 use Scope::Guard ();
  19
  20 use LaTeX::TikZ::Tools;
  21
  22 use LaTeX::TikZ::Scope;
  23
  24 use Any::Moose;
  25
  26 with qw(
  27  LaTeX::TikZ::Set
  28  LaTeX::TikZ::Set::Mutable
  29 );
  30
  31 has '_set' => (
  32  is       => 'rw',
  33  does     => 'LaTeX::TikZ::Set',
  34  init_arg => 'set',
  35  required => 1,
  36 );
  37
  38 sub set { $_[0]->_set }
  39
  40
  41 has '_mods' => (
  42  is       => 'ro',
  43  isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Mod]]',
  44  init_arg => 'mods',
  45  default  => sub { [ ] },
  46 );
  47
  48 sub mods { @{$_[0]->_mods} }
  49
  50 my $ltm_tc  = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod');
  51 my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer');
  52
  53 sub mod {
  54  my $set = shift;
  55
  56  push @{$set->_mods},
  57   map { $ltm_tc->check($_) ? $_ : $ltm_tc->coerce($_) }
  58    @_;
  59
  60  $set;
  61 }
  62
  63 sub add {
  64  my $set = shift;
  65
  66  my $kid = $set->_set;
  67  if ($kid->does('LaTeX::TikZ::Set::Mutable')) {
  68   $kid->add(@_);
  69  } else {
  70   require LaTeX::TikZ::Set::Sequence;
  71   $set->_set(LaTeX::TikZ::Set::Sequence->new(
  72    kids => $kid,
  73   ));
  74  }
  75
  76  $set;
  77 }
  78
  79 {
  80  our %mods;
  81  our $last_mod = 0;
  82
  83  sub mods_unique {
  84   my ($set) = @_;
  85
  86   my (@mods, $has_layer);
  87 MOD:
  88   for my $mod ($set->mods) {
  89    $has_layer = 1 if $ltml_tc->check($mod);
  90    my $tag = $mod->tag;
  91    my @candidates;
  92    if (defined $tag) {
  93     my $old     = $mods{$tag};
  94     @candidates = $old ? map $_->[0], @$old : ();
  95    } else {
  96     @candidates = values %mods;
  97    }
  98    $_->cover($mod) and next MOD for @candidates;
  99    push @{$mods{$tag}}, [ $mod, $last_mod++ ];
 100    push @mods,          $mod;
 101   }
 102
 103   if ($has_layer) {
 104    # Clips and mods don't propagate through layers. Hence if a layer is set,
 105    # force their reuse.
 106    @mods = map $_->[0], sort { $a->[1] <=> $b->[1] } map @$_, values %mods;
 107   }
 108
 109   return @mods;
 110  }
 111
 112  sub draw {
 113   my ($set, $tikz) = @_;
 114
 115   local $last_mod = $last_mod;
 116
 117   # Save a deep copy
 118   my %saved_idx = map { $_ => $#{$mods{$_}} } keys %mods;
 119   my $guard     = Scope::Guard->new(sub {
 120    for (keys %mods) {
 121     if (exists $saved_idx{$_}) {
 122      $#{$mods{$_}} = $saved_idx{$_};
 123     } else {
 124      delete $mods{$_};
 125     }
 126    }
 127   });
 128
 129   my @mods = $set->mods_unique;
 130
 131   my $body = $set->_set->draw($tikz);
 132
 133   if (@mods) {
 134    $body = LaTeX::TikZ::Scope->new
 135                              ->mod(map $_->apply($tikz), @mods)
 136                              ->body($body)
 137   }
 138
 139   $body;
 140  }
 141 }
 142
 143 __PACKAGE__->meta->make_immutable;
 144
 145 =head1 AUTHOR
 146
 147 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 148
 149 You can contact me by mail or on C<irc.perl.org> (vincent).
 150
 151 =head1 BUGS
 152
 153 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>.
 154 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 155
 156 =head1 SUPPORT
 157
 158 You can find documentation for this module with the perldoc command.
 159
 160     perldoc LaTeX::TikZ
 161
 162 =head1 COPYRIGHT & LICENSE
 163
 164 Copyright 2010 Vincent Pit, all rights reserved.
 165
 166 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 167
 168 =cut
 169
 170 1; # End of LaTeX::TikZ::Set::Mod