lib/LaTeX/TikZ/Mod/Pattern.pm

   1 package LaTeX::TikZ::Mod::Pattern;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Mod::Pattern - A modifier that fills a closed path with a pattern.
   9
  10 =head1 VERSION
  11
  12 Version 0.01
  13
  14 =cut
  15
  16 our $VERSION = '0.01';
  17
  18 use LaTeX::TikZ::Interface;
  19
  20 use Any::Moose;
  21
  22 =head1 RELATIONSHIPS
  23
  24 This class consumes the L<LaTeX::TikZ::Mod> role, and as such implements the L</tag>, L</cover>, L</declare> and L</apply> methods.
  25
  26 =cut
  27
  28 with 'LaTeX::TikZ::Mod';
  29
  30 =head1 ATTRIBUTES
  31
  32 =head2 C<template>
  33
  34 =cut
  35
  36 has 'template' => (
  37  is       => 'ro',
  38  isa      => 'ArrayRef[Str]',
  39  required => 1,
  40 );
  41
  42 has '_cache' => (
  43  is       => 'ro',
  44  isa      => 'HashRef',
  45  init_arg => undef,
  46  default  => sub { +{ } },
  47 );
  48
  49 =head1 METHODS
  50
  51 =head2 C<name>
  52
  53 =cut
  54
  55 sub name {
  56  my ($pat, $tikz) = @_;
  57
  58  my $cache = $pat->_cache->{$tikz->id};
  59  confess('Template not yet declared') unless defined $cache;
  60
  61  $cache->[0];
  62 }
  63
  64 my $id = 'a';
  65
  66 my %handlers = (
  67  name  => sub { $_[0]->name($_[1]) },
  68  width => sub { sprintf '%0.1fpt', $_[1]->thickness($_[2]) },
  69 );
  70
  71 =head2 C<tag>
  72
  73 =cut
  74
  75 sub tag { ref $_[0] }
  76
  77 =head2 C<cover>
  78
  79 =cut
  80
  81 sub cover { 0 }
  82
  83 =head2 C<declare>
  84
  85 =cut
  86
  87 sub declare {
  88  my ($pat, $tikz) = @_;
  89
  90  my $tikz_id = $tikz->id;
  91  my $cache   = $pat->_cache->{$tikz_id};
  92  return @{$cache->[1]} if defined $cache;
  93
  94  $cache = $pat->_cache->{$tikz_id} = [ ];
  95  $cache->[0] = 'pat' . $id++;
  96
  97  my $template = [ map $_, @{$pat->template} ];
  98  s!#([^#]+)#!
  99   my ($command, @opts) = split /=/, $1, 2;
 100   @opts = split /,/, $opts[0] if @opts;
 101   $handlers{lc $command}->($pat, $tikz, @opts);
 102  !ge for @$template;
 103  $cache->[1] = $template;
 104
 105  return @$template;
 106 }
 107
 108 =head2 C<apply>
 109
 110 =cut
 111
 112 sub apply { 'fill', 'pattern=' . $_[0]->name($_[1]) }
 113
 114 LaTeX::TikZ::Interface->register(
 115  pattern => sub {
 116   my $class = shift;
 117
 118   my %args = @_;
 119   if (exists $args{class}) {
 120    $class = delete $args{class};
 121    $class = __PACKAGE__ . '::' . $class unless $class =~ /::/;
 122    (my $pm = $class) =~ s{::}{/}g;
 123    $pm .= '.pm';
 124    require $pm;
 125   }
 126
 127   $class->new(%args);
 128  },
 129 );
 130
 131 __PACKAGE__->meta->make_immutable;
 132
 133 =head1 SEE ALSO
 134
 135 L<LaTeX::TikZ>, L<LaTeX::TikZ::Mod>.
 136
 137 =head1 AUTHOR
 138
 139 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 140
 141 You can contact me by mail or on C<irc.perl.org> (vincent).
 142
 143 =head1 BUGS
 144
 145 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>.
 146 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 147
 148 =head1 SUPPORT
 149
 150 You can find documentation for this module with the perldoc command.
 151
 152     perldoc LaTeX::TikZ
 153
 154 =head1 COPYRIGHT & LICENSE
 155
 156 Copyright 2010 Vincent Pit, all rights reserved.
 157
 158 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 159
 160 =cut
 161
 162 1; # End of LaTeX::TikZ::Mod::Pattern