LaTeX/TikZ/Formatter.pm

   1 package LaTeX::TikZ::Formatter;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Formatter - LaTeX::TikZ formatter object.
   9
  10 =head1 VERSION
  11
  12 Version 0.01
  13
  14 =cut
  15
  16 our $VERSION = '0.01';
  17
  18 use Sub::Name ();
  19
  20 use LaTeX::TikZ::Point;
  21
  22 use LaTeX::TikZ::Interface;
  23
  24 use LaTeX::TikZ::Tools;
  25
  26 use Any::Moose;
  27 use Any::Moose 'Util::TypeConstraints';
  28
  29 has 'unit' => (
  30  is      => 'ro',
  31  isa     => enum([ qw/cm pt/ ]),
  32  default => 'cm',
  33 );
  34
  35 has 'format' => (
  36  is      => 'ro',
  37  isa     => 'Str',
  38  default => '%s',
  39 );
  40
  41 has 'scale' => (
  42  is      => 'rw',
  43  isa     => 'Num',
  44  default => 1,
  45 );
  46
  47 has 'width' => (
  48  is  => 'rw',
  49  isa => 'Maybe[Num]',
  50 );
  51
  52 has 'height' => (
  53  is  => 'rw',
  54  isa => 'Maybe[Num]',
  55 );
  56
  57 has 'origin' => (
  58  is     => 'rw',
  59  isa    => 'LaTeX::TikZ::Point::Autocoerce',
  60  coerce => 1,
  61 );
  62
  63 sub id {
  64  my $tikz = shift;
  65
  66  my $origin = $tikz->origin;
  67  if (defined $origin) {
  68   my ($x, $y) = map $origin->$_, qw/x y/;
  69   $origin = "($x;$y)";
  70  } else {
  71   $origin = "(0;0)";
  72  }
  73
  74  join $;, map {
  75   defined() ? "$_" : '(undef)';
  76  } map($tikz->$_, qw/unit format scale width height/), $origin;
  77 }
  78
  79 my $find_mods = do {
  80  our %seen;
  81
  82  my $find_mods_rec;
  83  $find_mods_rec = do {
  84   no warnings 'recursion';
  85
  86   Sub::Name::subname('find_mods_rec' => sub {
  87    my ($set, $layers, $others) = @_;
  88
  89    for ($set->mods) {
  90     my $tag = $_->tag;
  91     next if $seen{$tag}++;
  92
  93     if ($_->isa('LaTeX::TikZ::Mod::Layer')) {
  94      push @$layers, $_;
  95     } else {
  96      push @$others, $_;
  97     }
  98    }
  99
 100    my @subsets = $set->isa('LaTeX::TikZ::Set::Sequence')
 101                  ? $set->kids
 102                  : $set->isa('LaTeX::TikZ::Set::Path')
 103                    ? $set->ops
 104                    : ();
 105
 106    $find_mods_rec->($_, $layers, $others) for @subsets;
 107   });
 108  };
 109
 110  Sub::Name::subname('find_mods' => sub {
 111   local %seen = ();
 112
 113   $find_mods_rec->(@_);
 114  });
 115 };
 116
 117 my $translate;
 118
 119 sub render {
 120  my $tikz = shift;
 121
 122  my $seq = LaTeX::TikZ::Set::Sequence->new(
 123   kids => \@_,
 124  );
 125
 126  unless ($translate) {
 127   require LaTeX::TikZ::Functor;
 128   $translate = LaTeX::TikZ::Functor->new(
 129    rules => [
 130     'LaTeX::TikZ::Set::Point' => sub {
 131      my ($functor, $set, $v) = @_;
 132
 133      $set->new(
 134       point => [
 135        $set->x + $v->x,
 136        $set->y + $v->y,
 137       ],
 138       label => $set->label,
 139       pos   => $set->pos,
 140      );
 141     },
 142    ],
 143   );
 144  }
 145
 146  my $origin = $tikz->origin;
 147  $seq = $seq->$translate($origin) if defined $origin;
 148
 149  my (@layers, @other_mods);
 150  $find_mods->($seq, \@layers, \@other_mods);
 151
 152  my $w = $tikz->width;
 153  my $h = $tikz->height;
 154  my $canvas = '';
 155  if (defined $w and defined $h) {
 156   require LaTeX::TikZ::Set::Rectangle;
 157   $seq->clip(LaTeX::TikZ::Set::Rectangle->new(
 158    from   => 0,
 159    width  => $w,
 160    height => $h,
 161   ));
 162   $_ = $tikz->len($_) for $w, $h;
 163   $canvas = ",papersize={$w,$h},body={$w,$h}";
 164  }
 165
 166  my @header = (
 167   "\\usepackage[pdftex,hcentering,vcentering$canvas]{geometry}",
 168   "\\usepackage{tikz}",
 169   "\\usetikzlibrary{patterns}",
 170  );
 171
 172  my @decls;
 173  push @decls, LaTeX::TikZ::Mod::Layer->declare(@layers) if  @layers;
 174  push @decls, $_->declare($tikz)                        for @other_mods;
 175
 176  my @content = (
 177   "\\begin{tikzpicture}",
 178   @{ $seq->draw($tikz) },
 179   "\\end{tikzpicture}",
 180  );
 181
 182  return \@header, \@decls, \@content;
 183 }
 184
 185 sub len {
 186  my ($tikz, $len) = @_;
 187
 188  $len = 0 if LaTeX::TikZ::Tools::numeq($len, 0);
 189
 190  sprintf $tikz->format . $tikz->unit, $len * $tikz->scale;
 191 }
 192
 193 sub angle {
 194  my ($tikz, $a) = @_;
 195
 196  $a = ($a * 180) / CORE::atan2(0, -1);
 197  $a += 360 if LaTeX::TikZ::Tools::numcmp($a, 0) < 0;
 198
 199  require POSIX;
 200  sprintf $tikz->format, POSIX::ceil($a);
 201 }
 202
 203 sub label {
 204  my ($tikz, $name, $pos) = @_;
 205
 206  my $scale = sprintf '%0.2f', $tikz->scale / 5;
 207
 208  "node[scale=$scale,$pos] {$name}";
 209 }
 210
 211 sub thickness {
 212  my ($tikz, $width) = @_;
 213
 214  # width=1 is 0.4 points for a scale of 2.5
 215  0.8 * $width * ($tikz->scale / 5);
 216 }
 217
 218 LaTeX::TikZ::Interface->register(
 219  formatter => sub {
 220   shift;
 221
 222   __PACKAGE__->new(@_);
 223  },
 224 );
 225
 226 __PACKAGE__->meta->make_immutable;
 227
 228 =head1 AUTHOR
 229
 230 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 231
 232 You can contact me by mail or on C<irc.perl.org> (vincent).
 233
 234 =head1 BUGS
 235
 236 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>.
 237 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 238
 239 =head1 SUPPORT
 240
 241 You can find documentation for this module with the perldoc command.
 242
 243     perldoc LaTeX::TikZ
 244
 245 =head1 COPYRIGHT & LICENSE
 246
 247 Copyright 2010 Vincent Pit, all rights reserved.
 248
 249 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 250
 251 =cut
 252
 253 1; # End of LaTeX::TikZ::Formatter