t/30-functor.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 10 + 2 * 7;
   7
   8 use LaTeX::TikZ;
   9
  10 use lib 't/lib';
  11 use LaTeX::TikZ::TestHelper;
  12
  13 using Tikz->formatter(
  14  format => '%d',
  15 );
  16
  17 my $translate = eval {
  18  Tikz->functor(
  19   'LaTeX::TikZ::Set::Point' => sub {
  20    my ($functor, $set, $v) = @_;
  21
  22    $set->new(
  23     point => [
  24      $set->x + $v->x,
  25      $set->y + $v->y,
  26     ],
  27     label => $set->label,
  28     pos   => $set->pos,
  29    );
  30   },
  31  );
  32 };
  33 is $@, '', 'creating a translator doesn\'t croak';
  34
  35 my $seq = Tikz->seq(
  36                  Tikz->point,
  37                  Tikz->raw('foo'),
  38                  Tikz->point(2),
  39                  Tikz->line(-1 => 3)
  40                      ->clip(Tikz->circle(1, 1))
  41                 )
  42               ->clip(Tikz->rectangle([0, -1] => [2, 3]));
  43
  44 my $seq2 = eval {
  45  $seq->$translate(Tikz->point(-1, 1));
  46 };
  47 is $@, '', 'translating a sequence doesn\'t croak';
  48
  49 check $seq, 'the original sequence', <<'RES';
  50 \begin{scope}
  51 \clip (0cm,-1cm) rectangle (2cm,3cm) ;
  52 \draw (0cm,0cm) ;
  53 \draw foo ;
  54 \draw (2cm,0cm) ;
  55 \begin{scope}
  56 \clip (1cm,0cm) circle (1cm) ;
  57 \draw (-1cm,0cm) -- (3cm,0cm) ;
  58 \end{scope}
  59 \end{scope}
  60 RES
  61
  62 check $seq2, 'the translated sequence', <<'RES';
  63 \begin{scope}
  64 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
  65 \draw (-1cm,1cm) ;
  66 \draw foo ;
  67 \draw (1cm,1cm) ;
  68 \begin{scope}
  69 \clip (0cm,1cm) circle (1cm) ;
  70 \draw (-2cm,1cm) -- (2cm,1cm) ;
  71 \end{scope}
  72 \end{scope}
  73 RES
  74
  75 my $strip = eval {
  76  Tikz->functor(
  77   '+LaTeX::TikZ::Mod' => sub { return },
  78  );
  79 };
  80 is $@, '', 'creating a stripper doesn\'t croak';
  81
  82 $_->mod(Tikz->color('red')) for $seq2->kids;
  83
  84 my $seq3 = eval {
  85  $seq2->$strip;
  86 };
  87 is $@, '', 'stripping a sequence doesn\'t croak';
  88
  89 check $seq2, 'the original sequence', <<'RES';
  90 \begin{scope} [color=red]
  91 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
  92 \draw (-1cm,1cm) ;
  93 \draw foo ;
  94 \draw (1cm,1cm) ;
  95 \begin{scope}
  96 \clip (0cm,1cm) circle (1cm) ;
  97 \draw (-2cm,1cm) -- (2cm,1cm) ;
  98 \end{scope}
  99 \end{scope}
 100 RES
 101
 102 check $seq3, 'the stripped sequence', <<'RES';
 103 \draw (-1cm,1cm) ;
 104 \draw foo ;
 105 \draw (1cm,1cm) ;
 106 \draw (-2cm,1cm) -- (2cm,1cm) ;
 107 RES
 108
 109 my $special = eval {
 110  Tikz->functor(
 111   '+LaTeX::TikZ::Mod' => sub { die "mod\n" },
 112   '+LaTeX::TikZ::Set' => sub { die "set\n" },
 113  );
 114 };
 115 is $@, '', 'creating a special functor with + rules doesn\'t croak';
 116
 117 eval { $seq->$special };
 118 is $@, "set\n", 'special functor with + rules eats everything properly';
 119
 120 $special = eval {
 121  Tikz->functor(
 122   '+LaTeX::TikZ::Mod'       => sub { die "mod\n" },
 123   '+LaTeX::TikZ::Set'       => sub { die "set\n" },
 124   'LaTeX::TikZ::Set::Point' => sub { Tikz->point(7) },
 125   'LaTeX::TikZ::Set::Path'  => sub { Tikz->raw('moo') },
 126  );
 127 };
 128 is $@, '', 'creating a special functor with + and normal rules doesn\'t croak';
 129
 130 my $res = eval { Tikz->point(3, 4)->$special };
 131 is $@, '', 'special functor with + and normal rules orders its rules properly';
 132
 133 check $res, 'the result of the special functor', <<'RES';
 134 \draw (7cm,0cm) ;
 135 RES
 136
 137 $res = eval { Tikz->raw('hlagh')->$special };
 138 is $@, '',
 139       'special functor with + and normal rules orders its rules properly again';
 140
 141 check $res, 'the result of the special functor', <<'RES';
 142 \draw moo ;
 143 RES
 144
 145 using eval {
 146  Tikz->formatter(
 147   origin => [ -1, 1 ],
 148  );
 149 };
 150 is $@, '', 'creating a formatter object with an origin doesn\'t croak';
 151
 152 check $seq, 'a sequence translated by an origin', <<'RES';
 153 \begin{scope}
 154 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
 155 \draw (-1cm,1cm) ;
 156 \draw foo ;
 157 \draw (1cm,1cm) ;
 158 \begin{scope}
 159 \clip (0cm,1cm) circle (1cm) ;
 160 \draw (-2cm,1cm) -- (2cm,1cm) ;
 161 \end{scope}
 162 \end{scope}
 163 RES