lib/LaTeX/TikZ/Mod/Clip.pm

   1 package LaTeX::TikZ::Mod::Clip;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Mod::Clip - A modifier that clips sequences with a path.
   9
  10 =head1 VERSION
  11
  12 Version 0.02
  13
  14 =cut
  15
  16 our $VERSION = '0.02';
  17
  18 use Sub::Name ();
  19
  20 use LaTeX::TikZ::Formatter;
  21 use LaTeX::TikZ::Mod::Formatted;
  22
  23 use LaTeX::TikZ::Interface;
  24 use LaTeX::TikZ::Functor;
  25
  26 use LaTeX::TikZ::Tools;
  27
  28 use Mouse;
  29
  30 =head1 RELATIONSHIPS
  31
  32 This class consumes the L<LaTeX::TikZ::Mod> role, and as such implements the L</tag>, L</covers>, L</declare> and L</apply> methods.
  33
  34 =cut
  35
  36 with 'LaTeX::TikZ::Mod';
  37
  38 =head1 ATTRIBUTES
  39
  40 =head2 C<clip>
  41
  42 The path that specifies the clipped area.
  43
  44 =cut
  45
  46 has clip => (
  47  is       => 'ro',
  48  does     => 'LaTeX::TikZ::Set::Path',
  49  required => 1,
  50 );
  51
  52 my $default_formatter = LaTeX::TikZ::Formatter->new(
  53  unit   => 'cm',
  54  format => '%.07f',
  55  scale  => 1,
  56 );
  57
  58 =head1 METHODS
  59
  60 =head2 C<tag>
  61
  62 =cut
  63
  64 sub tag { ref $_[0] }
  65
  66 =head2 C<covers>
  67
  68 =cut
  69
  70 my $get_tc = do {
  71  my %tc;
  72
  73  Sub::Name::subname('get_tc' => sub {
  74   my ($class) = @_;
  75
  76   return $tc{$class} if exists $tc{class};
  77
  78   my $tc = LaTeX::TikZ::Tools::type_constraint($class);
  79   return unless defined $tc;
  80
  81   $tc{$class} ||= $tc;
  82  })
  83 };
  84
  85 my $cover_rectangle = Sub::Name::subname('cover_rectangle' => sub {
  86  my ($old, $new, $self_tc) = @_;
  87
  88  my $p = $new->from;
  89  my $q = $new->to;
  90
  91  my $x = $p->x;
  92  my $y = $p->y;
  93  my $X = $q->x;
  94  my $Y = $q->y;
  95
  96  ($x, $X) = ($X, $x) if $x > $X;
  97  ($y, $Y) = ($Y, $y) if $y > $Y;
  98
  99  if ($self_tc->check($old)) {
 100   # The old rectangle covers the new one if and only if it's inside the new.
 101
 102   for ($old->from, $old->to) {
 103    my $r = $_->x;
 104    return 0 if LaTeX::TikZ::Tools::numcmp($r, $x) < 0
 105             or LaTeX::TikZ::Tools::numcmp($X, $r) < 0;
 106    my $i = $_->y;
 107    return 0 if LaTeX::TikZ::Tools::numcmp($i, $y) < 0
 108             or LaTeX::TikZ::Tools::numcmp($Y, $i) < 0;
 109   }
 110
 111   return 1;
 112  }
 113
 114  return 0;
 115 });
 116
 117 my $cover_circle = Sub::Name::subname('cover_circle' => sub {
 118  my ($old, $new, $self_tc) = @_;
 119
 120  my $c2 = $new->center;
 121  my $r2 = $new->radius;
 122
 123  if ($self_tc->check($old)) {
 124   # The old circle covers the new one if and only if it's inside the new.
 125
 126   my $c1 = $old->center;
 127   my $r1 = $old->radius;
 128
 129   my $d = abs($c1 - $c2);
 130
 131   return    LaTeX::TikZ::Tools::numcmp($d, $r2)       <= 0
 132          && LaTeX::TikZ::Tools::numcmp($d + $r1, $r2) <= 0;
 133  }
 134
 135  return 0;
 136 });
 137
 138 my @handlers = (
 139  [ 'LaTeX::TikZ::Set::Rectangle' => $cover_rectangle ],
 140  [ 'LaTeX::TikZ::Set::Circle'    => $cover_circle    ],
 141 );
 142
 143 sub covers {
 144  my ($old, $new) = map $_->clip, @_[0, 1];
 145
 146  for (@handlers) {
 147   my $tc = $get_tc->($_->[0]);
 148   next unless defined $tc and $tc->check($new);
 149   return $_->[1]->($old, $new, $tc);
 150  }
 151
 152  $old->path($default_formatter) eq $new->path($default_formatter);
 153 }
 154
 155 =head2 C<declare>
 156
 157 =cut
 158
 159 sub declare { }
 160
 161 =head2 C<apply>
 162
 163 =cut
 164
 165 sub apply {
 166  my ($self) = @_;
 167
 168  LaTeX::TikZ::Mod::Formatted->new(
 169   type    => 'clip',
 170   content => $_[0]->clip->path($_[1]),
 171  )
 172 }
 173
 174 LaTeX::TikZ::Interface->register(
 175  clip => sub {
 176   shift;
 177
 178   __PACKAGE__->new(clip => $_[0]);
 179  },
 180 );
 181
 182 LaTeX::TikZ::Functor->default_rule(
 183  (__PACKAGE__) => sub {
 184   my ($functor, $mod, @args) = @_;
 185   $mod->new(clip => $mod->clip->$functor(@args))
 186  }
 187 );
 188
 189 __PACKAGE__->meta->make_immutable;
 190
 191 =head1 SEE ALSO
 192
 193 L<LaTeX::TikZ>, L<LaTeX::TikZ::Mod>.
 194
 195 =head1 AUTHOR
 196
 197 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 198
 199 You can contact me by mail or on C<irc.perl.org> (vincent).
 200
 201 =head1 BUGS
 202
 203 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>.
 204 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 205
 206 =head1 SUPPORT
 207
 208 You can find documentation for this module with the perldoc command.
 209
 210     perldoc LaTeX::TikZ
 211
 212 =head1 COPYRIGHT & LICENSE
 213
 214 Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved.
 215
 216 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 217
 218 =cut
 219
 220 1; # End of LaTeX::TikZ::Mod::Clip