File Coverage

blib/lib/Text/Amuse/Compile/Fonts/Selected.pm
Criterion Covered Total %
statement 89 93 95.7
branch 31 38 81.5
condition 5 6 83.3
subroutine 11 11 100.0
pod 2 2 100.0
total 138 150 92.0


line stmt bran cond sub pod time code
1             package Text::Amuse::Compile::Fonts::Selected;
2 58     58   379 use utf8;
  58         148  
  58         376  
3 58     58   1614 use strict;
  58         124  
  58         1026  
4 58     58   278 use warnings;
  58         136  
  58         1383  
5 58     58   346 use Moo;
  58         169  
  58         405  
6 58     58   19113 use Types::Standard qw/InstanceOf Enum/;
  58         169  
  58         546  
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 all_fonts
25              
26             The instance of L carrying all available
27             fonts.
28              
29             =head1 METHODS
30              
31             =head2 compose_polyglossia_fontspec_stanza(lang => 'english', others => [qw/russian farsi/], bidi => 1)
32              
33             The place to produce this stanza is a bit weird, but fontspec and
34             polyglossia are tighly coupled.
35              
36             Named arguments:
37              
38             =over 4
39              
40             =item lang
41              
42             The main language.
43              
44             =item others
45              
46             The other languages as arrayref
47              
48             =item bidi
49              
50             Boolean if bidirectional
51              
52             =item is_slide
53              
54             Boolean if for beamer
55              
56             =item captions
57              
58             Custom locale strings. See L
59              
60             =back
61              
62             =head2 families
63              
64             Return an arrayref with the C, C and C
objects.
65              
66             =cut
67              
68             has mono => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts::Family']);
69             has sans => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts::Family']);
70             has main => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts::Family']);
71             has size => (is => 'ro', default => sub { 10 }, isa => Enum[9..14]);
72             has all_fonts => (is => 'ro', required => 1, isa => InstanceOf['Text::Amuse::Compile::Fonts']);
73              
74              
75             sub compose_polyglossia_fontspec_stanza {
76 253     253 1 88179 my ($self, %args) = @_;
77              
78 253         672 my @out;
79              
80 253         982 push @out, <<'STANDARD';
81             \usepackage{microtype}
82             \usepackage{graphicx}
83             \usepackage{alltt}
84             \usepackage{verbatim}
85             \usepackage[shortlabels]{enumitem}
86             \usepackage{tabularx}
87             \usepackage[normalem]{ulem}
88             \def\hsout{\bgroup \ULdepth=-.55ex \ULset}
89             % https://tex.stackexchange.com/questions/22410/strikethrough-in-section-title
90             % Unclear if \protect \hsout is needed. Doesn't looks so
91             \DeclareRobustCommand{\sout}[1]{\texorpdfstring{\hsout{#1}}{#1}}
92             \usepackage{wrapfig}
93              
94             % avoid breakage on multiple

and avoid the next [] to be eaten
95             \newcommand*{\forcelinebreak}{\strut\\*{}}
96              
97             \newcommand*{\hairline}{%
98             \bigskip%
99             \noindent \hrulefill%
100             \bigskip%
101             }
102              
103             % reverse indentation for biblio and play
104              
105             \newenvironment*{amusebiblio}{
106             \leftskip=\parindent
107             \parindent=-\parindent
108             \smallskip
109             \indent
110             }{\smallskip}
111              
112             \newenvironment*{amuseplay}{
113             \leftskip=\parindent
114             \parindent=-\parindent
115             \smallskip
116             \indent
117             }{\smallskip}
118              
119             \newcommand*{\Slash}{\slash\hspace{0pt}}
120              
121             STANDARD
122              
123 253 100       1017 unless($args{is_slide}) {
124 244         695 push @out, <<'HYPERREF';
125             % http://tex.stackexchange.com/questions/3033/forcing-linebreaks-in-url
126             \PassOptionsToPackage{hyphens}{url}\usepackage[hyperfootnotes=false,hidelinks,breaklinks=true]{hyperref}
127             \usepackage{bookmark}
128             HYPERREF
129             }
130 253   100     994 my $main_lang = $args{lang} || 'english';
131 253 100       501 my @langs = (@{ $args{others} || [] }, $main_lang);
  253         1422  
132 253         1174 my $babel_langs = join(',', @langs) . ",shorthands=off";
133 253 100       1232 my $bidi = $args{bidi} ? ", bidi=default" : "";
134             BABELFONTS: {
135 253 100       632 if (Text::Amuse::Utils::has_babel_ldf($main_lang)) {
  253         1295  
136             # one or more is missing, load the main from ldf, others from ini
137 236 100       13542 if (grep { !Text::Amuse::Utils::has_babel_ldf($_) } @{ $args{others} || []}) {
  13 100       688  
  236         1431  
138 5         420 push @out, "\\usepackage[$babel_langs,provide+=*${bidi}]{babel}";
139             }
140             else {
141             # load everything with the standard ldf
142 231         1271 push @out, "\\usepackage[${babel_langs}${bidi}]{babel}";
143             }
144             }
145             else {
146 17         2866 push @out, "\\usepackage[$babel_langs,provide*=*${bidi}]{babel}";
147             }
148 253         1653 my %slots = (qw/main rm
149             mono tt
150             sans sf/);
151 253         2353 foreach my $slot (sort keys %slots) {
152             # check all the available fonts if there are language specific
153 759         7131 foreach my $lang (reverse @langs) {
154 828         3130 my $font = $self->_font_for_slot_and_lang($slot, $lang);
155 828 100       2781 my @font_opts = $slot eq 'main' ? () : (qw/Scale MatchLowercase/);
156 828 100       1936 if ($lang eq $main_lang) {
157             push @out, sprintf("\\babelfont{%s}[%s]{%s}",
158 759         2843 $slots{$slot},
159             $font->babel_font_options(@font_opts),
160             $font->babel_font_name);
161             }
162             else {
163             push @out, sprintf("\\babelfont[%s]{%s}[%s]{%s}",
164             $lang,
165 69         206 $slots{$slot},
166             $font->babel_font_options(@font_opts),
167             $font->babel_font_name);
168             }
169             }
170             }
171             }
172 253         4639 my %cjk = (
173             japanese => 1,
174             korean => 1,
175             chinese => 1,
176             );
177              
178 253 100       1069 if ($cjk{$main_lang}) {
179             # these will die with luatex. Too bad.
180             # right now we’re using Song for sans and Kai for sf
181             # https://github.com/adobe-fonts/source-han-serif/releases/download/2.000R/SourceHanSerifCN.zip
182             # https://github.com/adobe-fonts/source-han-sans/releases/download/2.004R/SourceHanSansCN.zip
183             # load all languages with ini files
184 3         22 push @out, "\\usepackage{xeCJK}";
185 3         10 foreach my $slot (qw/main mono sans/) {
186             # original lang
187 9         20 my $font = $self->_font_for_slot_and_lang($slot, $main_lang);
188 9         39 push @out, sprintf("\\setCJK${slot}font{%s}[%s]",
189             $font->babel_font_name,
190             $font->babel_font_options,
191             );
192             }
193             }
194 253 50       928 if (my $custom = $args{captions}) {
195 0 0       0 if (my $base = delete $custom->{_base_}) {
196 0         0 foreach my $k (sort keys %$custom) {
197 0         0 push @out, "\\setlocalecaption{$base}{$k}{$custom->{$k}}";
198             }
199             }
200             }
201 253 100       848 if ($args{has_ruby}) {
202 2         6 push @out, "\\usepackage{ruby}";
203             }
204 253         622 push @out, '';
205 253         3869 return join("\n", @out);
206             }
207              
208             sub _shape_mapping {
209             return +{
210 9     9   49 bold => 'BoldFont',
211             italic => 'ItalicFont',
212             bolditalic => 'BoldItalicFont',
213             };
214             }
215              
216             has definitions => (is => 'lazy');
217              
218             sub _build_definitions {
219 1     1   359 my $self = shift;
220 1         3 my %definitions;
221 1         3 foreach my $slot (qw/mono sans main/) {
222 3         10 my $font = $self->$slot;
223 3 100       14 my %definition = (
224             name => $font->name,
225             attr => { $slot eq 'main' ? () : (Scale => 'MatchLowercase' ) },
226             );
227 3 50       48 if ($font->has_files) {
228 3         68 $definition{name} = $font->regular->basename_and_ext;
229              
230 3         50 my $dirname = $font->regular->dirname;
231              
232             # if $dirname have spaces, etc., skip it, and let's hope
233             # tex will find them anyway.
234 3 50       25 if ($font->regular->dirname =~ m/\A([A-Za-z0-9\.\/_-]+)\z/) {
235 3         47 $definition{attr}{Path} = $1;
236             }
237             else {
238 0         0 warn $font->regular->dirname . " does not look like a path which can be embedded." .
239             " Please make sure the fonts are installed in a standard TeX location\n";
240             }
241              
242 3         7 my %map = %{$self->_shape_mapping};
  3         6  
243 3         11 foreach my $method (keys %map) {
244 9         133 $definition{attr}{$map{$method}} = $font->$method->basename_and_ext;
245             }
246             }
247 3         63 $definitions{$slot} = \%definition;
248             }
249 1         6 return \%definitions;
250             }
251              
252             sub _fontspec_args {
253 6     6   1327 my ($self, $slot, $language) = @_;
254 6   50     14 $language ||= 'english';
255 6         24 my %scripts = (
256             macedonian => 'Cyrillic',
257             russian => 'Cyrillic',
258             farsi => 'Arabic',
259             arabic => 'Arabic',
260             hebrew => 'Hebrew',
261             greek => 'Greek',
262             );
263 6 50       114 my $def = $self->definitions->{$slot} or die "bad usage, can't find $slot";
264 6   100     53 my $script = $scripts{$language} || 'Latin';
265 6         11 my @list = ("Ligatures=TeX");
266 6         9 my @shapes = sort values %{ $self->_shape_mapping };
  6         12  
267 6         16 foreach my $att (qw/Scale Path/, @shapes) {
268 30 100       57 if (my $v = $def->{attr}->{$att}) {
269 28         56 push @list, "$att=$v";
270             }
271             }
272 6         45 return sprintf('{%s}[%s]', $def->{name}, join(",%\n ", @list));
273             }
274              
275             sub families {
276 134     134 1 1098485 my $self = shift;
277 134         1297 return [ $self->main, $self->mono, $self->sans ];
278             }
279              
280             sub _font_for_slot_and_lang {
281 837     837   1996 my ($self, $slot, $lang) = @_;
282 837         3468 my $font = $self->$slot;
283 837 100       3887 if (my @language_specific = $self->all_fonts->fonts_for_language($slot, $lang)) {
284             # there are other fonts setting the lang
285 15 50       38 unless ($font->for_babel_language($lang)) {
286 15         103 $font = $language_specific[0];
287             }
288             }
289 837         2265 return $font;
290             }
291              
292              
293             1;