t/30-functor.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4 + 2 * 4;
   7
   8 use LaTeX::TikZ;
   9
  10 my $tikz = Tikz->formatter(
  11  format => '%d',
  12 );
  13
  14 sub check {
  15  my ($set, $desc, $exp) = @_;
  16
  17  local $Test::Builder::Level = $Test::Builder::Level + 1;
  18
  19  my ($head, $decl, $body) = eval {
  20   $tikz->render(ref $set eq 'ARRAY' ? @$set : $set);
  21  };
  22  is $@, '', "$desc: no error";
  23
  24  unless (ref $exp eq 'ARRAY') {
  25   $exp = [ split /\n/, $exp ];
  26  }
  27  unshift @$exp, '\begin{tikzpicture}';
  28  push    @$exp, '\end{tikzpicture}';
  29
  30  is_deeply $body, $exp, $desc;
  31 }
  32
  33 my $translate = eval {
  34  Tikz->functor(
  35   'LaTeX::TikZ::Set::Point' => sub {
  36    my ($functor, $set, $v) = @_;
  37
  38    $set->new(
  39     point => [
  40      $set->x + $v->x,
  41      $set->y + $v->y,
  42     ],
  43    );
  44   },
  45  );
  46 };
  47 is $@, '', 'creating a translator doesn\'t croak';
  48
  49 my $seq = Tikz->seq(
  50                  Tikz->point,
  51                  Tikz->raw('foo'),
  52                  Tikz->point(2),
  53                  Tikz->line(-1 => 3)
  54                      ->clip(Tikz->circle(1, 1))
  55                 )
  56               ->clip(Tikz->rectangle([0, -1] => [2, 3]));
  57
  58 my $seq2 = eval {
  59  $seq->$translate(Tikz->point(-1, 1));
  60 };
  61 is $@, '', 'translating a sequence doesn\'t croak';
  62
  63 check $seq, 'the original sequence', <<'RES';
  64 \begin{scope}
  65 \clip (0cm,-1cm) rectangle (2cm,3cm) ;
  66 \draw (0cm,0cm) ;
  67 \draw foo ;
  68 \draw (2cm,0cm) ;
  69 \begin{scope}
  70 \clip (1cm,0cm) circle (1cm) ;
  71 \draw (-1cm,0cm) -- (3cm,0cm) ;
  72 \end{scope}
  73 \end{scope}
  74 RES
  75
  76 check $seq2, 'the translated sequence', <<'RES';
  77 \begin{scope}
  78 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
  79 \draw (-1cm,1cm) ;
  80 \draw foo ;
  81 \draw (1cm,1cm) ;
  82 \begin{scope}
  83 \clip (0cm,1cm) circle (1cm) ;
  84 \draw (-2cm,1cm) -- (2cm,1cm) ;
  85 \end{scope}
  86 \end{scope}
  87 RES
  88
  89 my $strip = eval {
  90  Tikz->functor(
  91   'LaTeX::TikZ::Mod' => sub { return },
  92  );
  93 };
  94 is $@, '', 'creating a stripper doesn\'t croak';
  95
  96 $_->mod(Tikz->color('red')) for $seq2->kids;
  97
  98 my $seq3 = eval {
  99  $seq2->$strip;
 100 };
 101 is $@, '', 'stripping a sequence doesn\'t croak';
 102
 103 check $seq2, 'the original sequence', <<'RES';
 104 \begin{scope} [color=red]
 105 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
 106 \draw (-1cm,1cm) ;
 107 \draw foo ;
 108 \draw (1cm,1cm) ;
 109 \begin{scope}
 110 \clip (0cm,1cm) circle (1cm) ;
 111 \draw (-2cm,1cm) -- (2cm,1cm) ;
 112 \end{scope}
 113 \end{scope}
 114 RES
 115
 116 check $seq3, 'the stripped sequence', <<'RES';
 117 \draw (-1cm,1cm) ;
 118 \draw foo ;
 119 \draw (1cm,1cm) ;
 120 \draw (-2cm,1cm) -- (2cm,1cm) ;
 121 RES