File Coverage

blib/lib/Text/Amuse/Compile/Fonts/Selected.pm
Criterion Covered Total %
statement 86 90 95.5
branch 33 40 82.5
condition 5 6 83.3
subroutine 11 11 100.0
pod 2 2 100.0
total 137 149 91.9


line stmt bran cond sub pod time code
1             package Text::Amuse::Compile::Fonts::Selected;
2 59     59   2576 use utf8;
  59         162  
  59         479  
3 59     59   2703 use strict;
  59         5353  
  59         1407  
4 59     59   295 use warnings;
  59         123  
  59         2964  
5 59     59   388 use Moo;
  59         145  
  59         565  
6 59     59   28714 use Types::Standard qw/InstanceOf Enum Bool/;
  59         192  
  59         792  
7              
8             =head1 NAME
9              
10             Text::Amuse::Compile::Fonts::Selected - simple class to hold selected fonts
11              
12             =head1 ACCESSORS
13              
14             All are read-only instances of L.
15              
16             =head2 main
17              
18             =head2 sans
19              
20             =head2 mono
21              
22             =head2 size
23              
24             =head2 luatex
25              
26             Boolean if running under luatex
27              
28             =head2 all_fonts
29              
30             The instance of L carrying all available
31             fonts.
32              
33             =head1 METHODS
34              
35             =head2 compose_polyglossia_fontspec_stanza(lang => 'english', others => [qw/russian farsi/], bidi => 1)
36              
37             The place to produce this stanza is a bit weird, but fontspec and
38             polyglossia are tighly coupled.
39              
40             Named arguments:
41              
42             =over 4
43              
44             =item lang
45              
46             The main language.
47              
48             =item others
49              
50             The other languages as arrayref
51              
52             =item bidi
53              
54             Boolean if bidirectional
55              
56             =item main_is_rtl
57              
58             Boolean if main language is RTL
59              
60             =item is_slide
61              
62             Boolean if for beamer
63              
64             =item captions
65              
66             Custom locale strings. See L
67              
68             =back
69              
70             =head2 families
71              
72             Return an arrayref with the C, C and C
objects.
73              
74             =cut
75              
76             has mono => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts::Family']);
77             has sans => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts::Family']);
78             has main => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts::Family']);
79             has size => (is => 'ro', default => sub { 10 }, isa => Enum[9..14]);
80             has all_fonts => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts']);
81             has luatex => (is => 'ro', default => sub { 0 }, isa => Bool);
82              
83             sub compose_polyglossia_fontspec_stanza {
84 257     257 1 128086 my ($self, %args) = @_;
85              
86 257         737 my @out;
87              
88 257         1007 push @out, <<'STANDARD';
89             \usepackage{microtype}
90             \usepackage{graphicx}
91             \usepackage{alltt}
92             \usepackage{verbatim}
93             \usepackage[shortlabels]{enumitem}
94             \usepackage{tabularx}
95             \usepackage[normalem]{ulem}
96             \def\hsout{\bgroup \ULdepth=-.55ex \ULset}
97             % https://tex.stackexchange.com/questions/22410/strikethrough-in-section-title
98             % Unclear if \protect \hsout is needed. Doesn't looks so
99             \DeclareRobustCommand{\sout}[1]{\texorpdfstring{\hsout{#1}}{#1}}
100             \usepackage{wrapfig}
101              
102             % avoid breakage on multiple

and avoid the next [] to be eaten
103             \newcommand*{\forcelinebreak}{\strut\\*{}}
104              
105             \newcommand*{\hairline}{%
106             \bigskip%
107             \noindent \hrulefill%
108             \bigskip%
109             }
110              
111             % reverse indentation for biblio and play
112              
113             \newenvironment*{amusebiblio}{
114             \leftskip=\parindent
115             \parindent=-\parindent
116             \smallskip
117             \indent
118             }{\smallskip}
119              
120             \newenvironment*{amuseplay}{
121             \leftskip=\parindent
122             \parindent=-\parindent
123             \smallskip
124             \indent
125             }{\smallskip}
126              
127             \newcommand*{\Slash}{\slash\hspace{0pt}}
128              
129             STANDARD
130              
131 257 100       1365 unless($args{is_slide}) {
132 248         860 push @out, <<'HYPERREF';
133             % http://tex.stackexchange.com/questions/3033/forcing-linebreaks-in-url
134             \PassOptionsToPackage{hyphens}{url}\usepackage[hyperfootnotes=false,hidelinks,breaklinks=true]{hyperref}
135             \usepackage{bookmark}
136             HYPERREF
137             }
138 257   100     1226 my $main_lang = $args{lang} || 'english';
139 257 100       698 my @langs = (@{ $args{others} || [] }, $main_lang);
  257         1327  
140 257         1194 my $babel_langs = join(',', @langs) . ",shorthands=off";
141 257         672 my $bidi_schema = 'basic';
142 257 100       1888 unless ($self->luatex) {
143 252 100       1060 $bidi_schema = $args{main_is_rtl} ? 'bidi-r' : 'bidi-l';
144             }
145 257 100       1046 my $bidi = $args{bidi} ? ", bidi=$bidi_schema" : "";
146             BABELFONTS: {
147 257 100       625 if (Text::Amuse::Utils::has_babel_ldf($main_lang)) {
  257         1146  
148             # one or more is missing, load the main from ldf, others from ini
149 238 100       15535 if (grep { !Text::Amuse::Utils::has_babel_ldf($_) } @{ $args{others} || []}) {
  16 100       953  
  238         1402  
150 8         1008 push @out, "\\usepackage[$babel_langs,provide+=*${bidi}]{babel}";
151             }
152             else {
153             # load everything with the standard ldf
154 230         1004 push @out, "\\usepackage[${babel_langs}${bidi}]{babel}";
155             }
156             }
157             else {
158 19         3864 push @out, "\\usepackage[$babel_langs,provide*=*${bidi}]{babel}";
159             }
160 257         1816 my %slots = (qw/main rm
161             mono tt
162             sans sf/);
163 257         1816 foreach my $slot (sort keys %slots) {
164             # check all the available fonts if there are language specific
165 771         7716 foreach my $lang (reverse @langs) {
166 858         4343 my $font = $self->_font_for_slot_and_lang($slot, $lang);
167 858 100       3517 my @font_opts = $slot eq 'main' ? () : (qw/Scale MatchLowercase/);
168 858 100       2301 if ($lang eq $main_lang) {
169             push @out, sprintf("\\babelfont{%s}[%s]{%s}",
170 771         3770 $slots{$slot},
171             $font->babel_font_options(@font_opts),
172             $font->babel_font_name);
173             }
174             else {
175             push @out, sprintf("\\babelfont[%s]{%s}[%s]{%s}",
176             $lang,
177 87         322 $slots{$slot},
178             $font->babel_font_options(@font_opts),
179             $font->babel_font_name);
180             }
181             }
182             }
183             }
184 257 50       4848 if (my $custom = $args{captions}) {
185 0 0       0 if (my $base = delete $custom->{_base_}) {
186 0         0 foreach my $k (sort keys %$custom) {
187 0         0 push @out, "\\setlocalecaption{$base}{$k}{$custom->{$k}}";
188             }
189             }
190             }
191 257 100       1053 if ($args{has_ruby}) {
192 2         6 push @out, "\\usepackage{ruby}";
193             }
194 257         743 push @out, '';
195 257         5581 return join("\n", @out);
196             }
197              
198             sub _shape_mapping {
199             return +{
200 9     9   72 bold => 'BoldFont',
201             italic => 'ItalicFont',
202             bolditalic => 'BoldItalicFont',
203             };
204             }
205              
206             has definitions => (is => 'lazy');
207              
208             sub _build_definitions {
209 1     1   829 my $self = shift;
210 1         3 my %definitions;
211 1         3 foreach my $slot (qw/mono sans main/) {
212 3         8 my $font = $self->$slot;
213 3 100       18 my %definition = (
214             name => $font->name,
215             attr => { $slot eq 'main' ? () : (Scale => 'MatchLowercase' ) },
216             );
217 3 50       54 if ($font->has_files) {
218 3         88 $definition{name} = $font->regular->basename_and_ext;
219              
220 3         50 my $dirname = $font->regular->dirname;
221              
222             # if $dirname have spaces, etc., skip it, and let's hope
223             # tex will find them anyway.
224 3 50       17 if ($font->regular->dirname =~ m/\A([A-Za-z0-9\.\/_-]+)\z/) {
225 3         27 $definition{attr}{Path} = $1;
226             }
227             else {
228 0         0 warn $font->regular->dirname . " does not look like a path which can be embedded." .
229             " Please make sure the fonts are installed in a standard TeX location\n";
230             }
231              
232 3         4 my %map = %{$self->_shape_mapping};
  3         9  
233 3         15 foreach my $method (keys %map) {
234 9         152 $definition{attr}{$map{$method}} = $font->$method->basename_and_ext;
235             }
236             }
237 3         57 $definitions{$slot} = \%definition;
238             }
239 1         9 return \%definitions;
240             }
241              
242             sub _fontspec_args {
243 6     6   2668 my ($self, $slot, $language) = @_;
244 6   50     16 $language ||= 'english';
245 6         34 my %scripts = (
246             macedonian => 'Cyrillic',
247             russian => 'Cyrillic',
248             farsi => 'Arabic',
249             arabic => 'Arabic',
250             hebrew => 'Hebrew',
251             greek => 'Greek',
252             );
253 6 50       155 my $def = $self->definitions->{$slot} or die "bad usage, can't find $slot";
254 6   100     60 my $script = $scripts{$language} || 'Latin';
255 6         11 my @list = ("Ligatures=TeX");
256 6         8 my @shapes = sort values %{ $self->_shape_mapping };
  6         12  
257 6         17 foreach my $att (qw/Scale Path/, @shapes) {
258 30 100       56 if (my $v = $def->{attr}->{$att}) {
259 28         62 push @list, "$att=$v";
260             }
261             }
262 6         44 return sprintf('{%s}[%s]', $def->{name}, join(",%\n ", @list));
263             }
264              
265             sub families {
266 134     134 1 2014304 my $self = shift;
267 134         1775 return [ $self->main, $self->mono, $self->sans ];
268             }
269              
270             sub _font_for_slot_and_lang {
271 858     858   2474 my ($self, $slot, $lang) = @_;
272 858         3918 my $font = $self->$slot;
273 858 100       5814 if (my @language_specific = $self->all_fonts->fonts_for_language($slot, $lang)) {
274             # there are other fonts setting the lang
275 9 50       32 unless ($font->for_babel_language($lang)) {
276 9         88 $font = $language_specific[0];
277             }
278             }
279 858         3097 return $font;
280             }
281              
282              
283             1;