File Coverage

lib/Dancer/Plugin/FontSubset.pm
Criterion Covered Total %
statement 17 19 89.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 24 26 92.3


line stmt bran cond sub pod time code
1             package Dancer::Plugin::FontSubset;
2             BEGIN {
3 1     1   332303 $Dancer::Plugin::FontSubset::AUTHORITY = 'cpan:YANICK';
4             }
5             {
6             $Dancer::Plugin::FontSubset::VERSION = '0.1.2';
7             }
8             # ABSTRACT: Generate font subsets on-the-fly
9              
10              
11 1     1   20 use 5.12.0;
  1         3  
  1         42  
12              
13 1     1   8 use Dancer ':syntax';
  1         1  
  1         8  
14 1     1   1506 use Dancer::Plugin;
  1         1445  
  1         71  
15              
16 1     1   1042 use List::AllUtils qw/ uniq /;
  1         2763  
  1         88  
17 1     1   1066 use Font::TTF::Font;
  1         68542  
  1         44  
18 1     1   215656 use Font::TTF::Scripts::Name;
  0            
  0            
19              
20             use Moo;
21             with 'MooX::Singleton';
22              
23             has _config => (
24             is => 'ro',
25             lazy => 1,
26             default => sub {
27             plugin_setting;
28             },
29             );
30              
31             has fonts_dir => (
32             is => 'ro',
33             lazy => 1,
34             default => sub {
35             $_[0]->_config->{fonts_dir} || 'public/fonts';
36             },
37             );
38              
39             has font_base_url => (
40             is => 'ro',
41             lazy => 1,
42             default => sub {
43             $_[0]->_config->{font_base_url} || '/font';
44             },
45             );
46              
47             has use_cache => (
48             is => 'ro',
49             lazy => 1,
50             default => sub {
51             $_[0]->_config->{use_cache};
52             },
53             );
54              
55             my $plugin = __PACKAGE__->instance;
56              
57             # do we need Cache::CHI?
58             if ( $plugin->use_cache ) {
59             eval "use Dancer::Plugin::Cache::CHI; 1"
60             or die $@;
61             }
62              
63             sub font_path {
64             $plugin->fonts_dir . '/' . $_[1];
65             }
66              
67             get $plugin->font_base_url . '/subset.js' => sub {
68              
69             return sprintf <<'END_JS', $plugin->font_base_url;
70             $(function(){
71             $('.subfont').each(function(){
72             var characters = $(this).text().split('').sort();
73             characters = characters.filter(function(e,i,a){
74             return characters.lastIndexOf(e) == i
75             }).join('');
76             var family = $(this).attr('data-font') + '-' + characters;
77             var style = "@font-face { font-family: " + family
78             + "; src: url('%s/" + $(this).attr('data-font') + ".ttf?t=" + characters
79             + "'); }";
80             $('body').append( "" );
81             $(this).css('font-family', family);
82             });
83             });
84             END_JS
85              
86             };
87              
88             get $plugin->font_base_url() . '/:fontname' => sub {
89             my $fontname = param('fontname');
90              
91             $fontname =~ s#\.\.##g; # just to be safe
92              
93             my $path = $plugin->font_path( $fontname );
94              
95             send_error 'font not found', 404 unless -f $path;
96              
97             # no text? No job to do
98             my $text = param('t') //
99             return send_file $path, system_path => 1;
100              
101             my @chars = map { ord } sort { $a cmp $b } uniq split //, $text;
102              
103             my $output = generate_subfont( $path, @chars );
104              
105             return send_file \$output, content_type => 'application/x-ttf';
106             };
107              
108             my $_generate_subfont = sub {
109             my( $path, @chars ) = @_;
110              
111             my $f = Font::TTF::Font->open($path);
112              
113             my $cmap = $f->{'cmap'}->read->find_ms;
114             my $post = $f->{'post'}->read;
115             my $subsetter = Font::TTF::Scripts::SubSetter->new;
116              
117             for my $char ( @chars ) {
118             $subsetter->add_glyph( $cmap->{val}{$char} )
119             if $cmap->{val}{$char};
120             }
121              
122             my $canchangegids = 1;
123             my $numg = $f->{'maxp'}{'numGlyphs'};
124             $f->tables_do(sub {$canchangegids |= $_[0]->canchangegids();});
125             $numg = $subsetter->creategidmap($f) if ($canchangegids);
126              
127             $f->{'loca'}->subset($subsetter);
128             $f->tables_do(sub {$_[0]->subset($subsetter);});
129             $f->{'maxp'}{'numGlyphs'} = $subsetter->{'gcount'};
130             $f->tables_do(sub {$_[0]->update;});
131             open my $fh, '>', \my $output;
132              
133             $f->out($fh);
134              
135             return $output;
136             };
137              
138             if( $plugin->use_cache ) {
139             *generate_subfont = sub {
140             my @args = @_;
141             Dancer::Plugin::Cache::CHI::cache()->compute( 'font-' . $args[0] . '-' . join( '', @args[1..$#args] ), sub {
142             $_generate_subfont->(@args);
143             });
144             };
145             }
146             else {
147             *generate_subfont = sub {
148             $_generate_subfont->(@_);
149             };
150             }
151              
152              
153             register_plugin;
154              
155             true;
156              
157             # all shamelessly ripped off from 'ttfsubset' from
158             # TTF::Font::TTF
159              
160             package
161             Font::TTF::Scripts::SubSetter;
162              
163             sub new
164             {
165             my ($class) = @_;
166             my ($self) = {};
167             $self->{'glyphs'} = '';
168             $self->{'remaps'} = {};
169             bless $self, $class || ref $class;
170             foreach (0..2) { $self->add_glyph($_); }
171             return $self;
172             }
173              
174             sub add_glyph
175             {
176             my ($self, $n, $private) = @_;
177             if (($private && !$self->{'gidmap'}[$n]) || (!$private && !vec($self->{'glyphs'}, $n, 1)))
178             {
179             vec($self->{'glyphs'}, $n, 1) = 1; # unless ($private);
180             $self->{'gidmap'}[$n] = $self->{'gcount'}++ if (defined $self->{'gidmap'});
181             return 1;
182             }
183             else
184             { return 0; }
185             }
186              
187             sub keep_glyph
188             {
189             my ($self, $n) = @_;
190             return vec($self->{'glyphs'}, $n, 1);
191             }
192              
193             sub remap
194             {
195             my ($self, $u, $n) = @_;
196             $self->{'remaps'}{$u} = $n;
197             }
198              
199             sub langlist
200             {
201             my ($self, @dat) = @_;
202             $self->{'langs'} = { map {$_=>1} @dat };
203             }
204              
205             sub scriptlist
206             {
207             my ($self, @dat) = @_;
208             $self->{'scripts'} = { map {$_=>1} @dat };
209             }
210              
211             sub creategidmap
212             {
213             my ($self, $font) = @_;
214             my ($numg) = $font->{'maxp'}{'numGlyphs'};
215             my ($count) = 0;
216              
217             $self->{'gidmap'} = [];
218             $self->{'gcount'} = 0;
219             foreach my $i (0 .. $numg - 1)
220             { push (@{$self->{'gidmap'}}, vec($self->{'glyphs'}, $i, 1) ? $self->{'gcount'}++ : 0); }
221             return $self->{'gcount'};
222             }
223              
224             sub map_glyph
225             {
226             my ($self, $g) = @_;
227             # no glyph remapping yet
228             if ($self->{'gidmap'})
229             { return $self->{'gidmap'}[$g]; }
230             else
231             { return $g; }
232             }
233              
234             package
235             Font::TTF::Table;
236              
237             sub canchangegids
238             { 1; }
239              
240             sub subset
241             {
242             my ($self, $subsetter) = @_;
243             return 0 if ($self->{' subsetdone'});
244             $self->{' subsetdone'} = 1;
245             $self->read;
246             $self->dirty;
247             return 1;
248             }
249              
250             package
251             Font::TTF::Loca;
252              
253             sub subset
254             {
255             my ($self, $subsetter) = @_;
256             my ($res) = [];
257             my ($i, $vec);
258              
259             return unless ($self->SUPER::subset($subsetter));
260             for ($i = 0; $i < @{$self->{'glyphs'}}; $i++)
261             {
262             if ($subsetter->keep_glyph($i))
263             { $self->outglyph($subsetter, $res, $i); }
264             }
265             $self->{'glyphs'} = $res;
266             }
267              
268             sub outglyph
269             {
270             my ($self, $subsetter, $res, $n) = @_;
271              
272             $res->[$subsetter->map_glyph($n)] = $self->{'glyphs'}[$n];
273             if (defined $self->{'glyphs'}[$n] && $self->{'glyphs'}[$n]->read()->{'numberOfContours'} < 0)
274             {
275             my ($g) = $self->{'glyphs'}[$n]->read_dat();
276             foreach my $c (@{$g->{'comps'}})
277             {
278             if ($subsetter->add_glyph($c->{'glyph'}, 1))
279             { $self->outglyph($subsetter, $res, $c->{'glyph'}); }
280             $c->{'glyph'} = $subsetter->map_glyph($c->{'glyph'});
281             }
282             $g->{' isDirty'} = 1;
283             }
284             }
285              
286             package
287             Font::TTF::Ttopen;
288              
289             sub subset
290             {
291             my ($self, $subsetter) = @_;
292             return unless ($self->SUPER::subset($subsetter));
293              
294             my ($l, $count, @lmap, @lookups, $lkvec, $res, $nlookup);
295             $lkvec = "";
296             $nlookup = $#{$self->{'LOOKUP'}};
297             # process non-contextual lookups
298             foreach $l (0 .. $nlookup)
299             {
300             my ($type) = $self->{'LOOKUP'}[$l]{'TYPE'};
301             next if ($type >= $self->extension() - 2 && $type < $self->extension());
302             $res = $self->subset_lookup($self->{'LOOKUP'}[$l]);
303              
304             if (!@{$res})
305             {
306             delete $self->{'LOOKUP'}[$l];
307             vec($lkvec, $l, 1) = 0;
308             }
309             else
310             {
311             $self->{'LOOKUP'}[$l]{'SUB'} = $res;
312             vec($lkvec, $l, 1) = 1;
313             }
314             }
315             # now process contextual lookups knowing whether the other lookup is there
316             # also collect the complete lookup list now
317             foreach $l (0 .. $nlookup)
318             {
319             if (defined $self->{'LOOKUP'}[$l])
320             {
321             my ($type) = $self->{'LOOKUP'}[$l]{'TYPE'};
322             if ($type >= $self->extension() - 2 && $type < $self->extension())
323             {
324             $res = $self->subset_lookup($self->{'LOOKUP'}[$l], $lkvec);
325             if (!@{$res})
326             {
327             delete $self->{'LOOKUP'}[$l];
328             vec($lkvec, $l, 1) = 0;
329             }
330             else
331             {
332             $self->{'LOOKUP'}[$l]{'SUB'} = $res;
333             vec($lkvec, $l, 1) = 1;
334             }
335             }
336             }
337             if (vec($lkvec, $l, 1))
338             {
339             push (@lookups, $self->{'LOOKUP'}[$l]);
340             push (@lmap, $count++);
341             }
342             else
343             { push (@lmap, -1); }
344             }
345            
346             $self->{'LOOKUP'} = \@lookups;
347             foreach $l (@lookups)
348             { $self->fixcontext($l, \@lmap); }
349              
350             foreach my $t (@{$self->{'FEATURES'}{'FEAT_TAGS'}})
351             {
352             my $f = $self->{'FEATURES'}{$t};
353             foreach $l (0 .. $#{$f->{'LOOKUPS'}})
354             {
355             my ($v) = $lmap[$f->{'LOOKUPS'}[$l]];
356             if ($v < 0)
357             { delete $f->{'LOOKUPS'}[$l]; }
358             else
359             { $f->{'LOOKUPS'}[$l] = $v; }
360             }
361             if (!@{$f->{'LOOKUPS'}})
362             { delete $self->{'FEATURES'}{$t}; }
363             else
364             { $f->{'LOOKUPS'} = [grep {defined $_} @{$f->{'LOOKUPS'}}]; }
365             }
366             $self->{'FEATURES'}{'FEAT_TAGS'} = [grep {defined $self->{'FEATURES'}{$_}} @{$self->{'FEATURES'}{'FEAT_TAGS'}}];
367              
368             my ($isEmpty) = 1;
369             foreach my $s (keys %{$self->{'SCRIPTS'}})
370             {
371             foreach $l (-1 .. $#{$self->{'SCRIPTS'}{$s}{'LANG_TAGS'}})
372             {
373             my $lang;
374             if ($l < 0)
375             { $lang = $self->{'SCRIPTS'}{$s}{'DEFAULT'}; }
376             else
377             { $lang = $self->{'SCRIPTS'}{$s}{$self->{'SCRIPTS'}{$s}{'LANG_TAGS'}[$l]}; }
378              
379             if (defined $lang->{'FEATURES'})
380             {
381             foreach my $i (0 .. @{$lang->{'FEATURES'}})
382             {
383             if (!defined $self->{'FEATURES'}{$lang->{'FEATURES'}[$i]})
384             { delete $lang->{'FEATURES'}[$i]; }
385             }
386             $lang->{'FEATURES'} = [grep {$_} @{$lang->{'FEATURES'}}];
387             }
388             if (defined $lang->{'DEFAULT'} && $lang->{'DEFAULT'} >= 0)
389             {
390             my ($found) = 0;
391             foreach my $f (@{$self->{'FEATURES'}{'FEAT_TAGS'}})
392             {
393             if ($self->{'FEATURES'}{$f}{'INDEX'} == $lang->{'DEFAULT'})
394             {
395             $found = 1;
396             last;
397             }
398             }
399             if (!$found)
400             { $lang->{'DEFAULT'} = -1; }
401             }
402             if (($l >= 0 && defined $subsetter->{'langs'}
403             && !defined $subsetter->{'langs'}{$self->{'SCRIPTS'}{$s}{'LANG_TAGS'}[$l]})
404             || ((!defined $lang->{'FEATURES'} || !@{$lang->{'FEATURES'}})
405             && (!defined $lang->{'DEFAULT'} || $lang->{'DEFAULT'} < 0)))
406             {
407             if ($l < 0)
408             { delete $self->{'SCRIPTS'}{$s}{'DEFAULT'}; }
409             else
410             {
411             delete $self->{'SCRIPTS'}{$s}{$self->{'SCRIPTS'}{$s}{'LANG_TAGS'}[$l]};
412             delete $self->{'SCRIPTS'}{$s}{'LANG_TAGS'}[$l];
413             }
414             }
415             }
416             if ((defined $subsetter->{'scripts'} && !defined $subsetter->{'scripts'}{$s})
417             || (!@{$self->{'SCRIPTS'}{$s}{'LANG_TAGS'}} && !defined $self->{'SCRIPTS'}{$s}{'DEFAULT'}))
418             {
419             delete $self->{'SCRIPTS'}{$s};
420             next;
421             }
422             else
423             { $isEmpty = 0; }
424             }
425             if ($isEmpty)
426             {
427             my ($k, $v);
428             while (($k, $v) = each %{$self->{' PARENT'}})
429             {
430             if ($v eq $self)
431             {
432             delete $self->{' PARENT'}{$k};
433             last;
434             }
435             }
436             }
437             }
438              
439             sub subset_lookup
440             {
441             my ($self, $lookup, $lkvec) = @_;
442             my ($s, $l);
443             my ($res) = [];
444              
445             foreach $s (@{$lookup->{'SUB'}})
446             {
447             if (!$self->subset_subtable(undef, $s, $lookup, $lkvec)
448             || !defined $s->{'RULES'} || !@{$s->{'RULES'}})
449             { next; }
450             $s->{'RULES'} = [grep {$_} @{$s->{'RULES'}}];
451             # remove unused coverage indices
452             if ($s->{'COVERAGE'})
453             {
454             my $c = $s->{'COVERAGE'}{'val'};
455             my $i = 0;
456             foreach my $k (sort {$c->{$a} <=> $c->{$b}} keys %{$c})
457             { $c->{$k} = $i++; }
458             }
459             push (@{$res}, $s);
460             }
461             return $res;
462             }
463              
464              
465             sub subset_class
466             {
467             my ($self, $subsetter, $classdef, $noremap) = @_;
468             my ($res) = [];
469             my ($count) = 0;
470             my ($class) = $classdef->{'val'};
471              
472             foreach (sort {$a <=> $b} keys %{$class})
473             {
474             if (!$subsetter->keep_glyph($_))
475             { delete $class->{$_}; }
476             else
477             {
478             my $g = $subsetter->map_glyph($_);
479             $class->{$g} = delete $class->{$_};
480             $res->[$class->{$g}] = ++$count unless (defined $res->[$class->{$g}])
481             }
482             }
483             # remap the class
484             unless ($noremap)
485             {
486             foreach (keys %{$class})
487             { $class->{$_} = $res->[$class->{$_}]; }
488             }
489             if (@{$res})
490             { return $res; }
491             else
492             { return undef; }
493             }
494              
495             sub subset_cover
496             {
497             my ($self, $subsetter, $coverage, $rules) = @_;
498             return $coverage if (defined $coverage->{'isremapped'});
499             my $isEmpty = 1;
500             my $cover = $coverage->{'val'};
501             foreach (sort {$a <=> $b} keys %{$cover})
502             {
503             if (!$subsetter->keep_glyph($_))
504             {
505             delete $rules->[$cover->{$_}] if $rules;
506             delete $cover->{$_};
507             }
508             else
509             {
510             $cover->{$subsetter->map_glyph($_)} = delete $cover->{$_};
511             $isEmpty = 0;
512             }
513             }
514             if ($isEmpty)
515             { return undef; }
516             else
517             {
518             $coverage->{'isremapped'} = 1;
519             return $coverage;
520             }
521             }
522              
523             sub subset_string
524             {
525             my ($self, $subsetter, $string, $fmt, $classvals) = @_;
526             my ($test) = 1;
527              
528             return 0 if ($fmt == 2 && !$classvals);
529             foreach (@{$string})
530             {
531             if ($fmt == 1 && $subsetter->keep_glyph($_))
532             { $_ = $subsetter->map_glyph($_); }
533             elsif ($fmt == 2 && defined $classvals->[$_])
534             { $_ = $classvals->[$_]; }
535             elsif ($fmt == 3 && $self->subset_cover($subsetter, $_, undef))
536             { }
537             else
538             {
539             $test = 0;
540             last;
541             }
542             }
543             return $test;
544             }
545              
546             sub subset_context
547             {
548             my ($self, $subsetter, $sub, $type, $lkvec) = @_;
549             my ($fmt) = $sub->{'FORMAT'};
550             my ($classvals, $prevals, $postvals, $i, $j, @gids);
551              
552             return 0 if (defined $sub->{'COVERAGE'} && !$self->subset_cover($subsetter, $sub->{'COVERAGE'}, $fmt < 2 ? $sub->{'RULES'} : undef));
553             while (my ($k, $v) = each %{$sub->{'COVERAGE'}{'val'}})
554             { $gids[$v] = $k; }
555             return 0 if (defined $sub->{'CLASS'} && !($classvals = $self->subset_class($subsetter, $sub->{'CLASS'})));
556             return 0 if (defined $sub->{'PRE_CLASS'} && !($prevals = $self->subset_class($subsetter, $sub->{'PRE_CLASS'})));
557             return 0 if (defined $sub->{'POST_CLASS'} && !($postvals = $self->subset_class($subsetter, $sub->{'POST_CLASS'})));
558             # tidy up coverage tables that contain glyphs not in the matching class
559             # if (defined $sub->{'CLASS'})
560             # {
561             # foreach $i (0 .. $#gids)
562             # {
563             # if (defined $gids[$i] && !defined $sub->{'CLASS'}{'val'}{$gids[$i]})
564             # {
565             # delete $sub->{'COVERAGE'}{'val'}{$gids[$i]};
566             # delete $gids[$i];
567             # }
568             # }
569             # @gids = grep {defined $_} @gids;
570             # }
571             # return 0 unless (@gids);
572              
573              
574             foreach $i (0 .. @{$sub->{'RULES'}})
575             {
576             my ($isEmpty) = 1;
577             if ($sub->{'RULES'}[$i])
578             {
579             foreach $j (0 .. $#{$sub->{'RULES'}[$i]})
580             {
581             my ($r) = $sub->{'RULES'}[$i][$j];
582             my ($test) = 1;
583             if ($type == 4)
584             {
585             if ($subsetter->keep_glyph($r->{'ACTION'}[0]))
586             { $r->{'ACTION'}[0] = $subsetter->map_glyph($r->{'ACTION'}[0]); }
587             else
588             { $test = 0; }
589             }
590             else
591             {
592             foreach my $k (0 .. $#{$sub->{'RULES'}[$i][$j]{'ACTION'}})
593             {
594             my $a = $sub->{'RULES'}[$i][$j]{'ACTION'}[$k];
595             if (!vec($lkvec, $a->[1], 1))
596             { delete $sub->{'RULES'}[$i][$j]{'ACTION'}[$k]; }
597             }
598             $test = (@{$sub->{'RULES'}[$i][$j]{'ACTION'}} != 0);
599             }
600             if ($test && $type == 6 && defined $r->{'PRE'})
601             { $test = $self->subset_string($subsetter, $r->{'PRE'}, $fmt, $prevals); }
602             if ($test && $type == 6 && defined $r->{'POST'})
603             { $test = $self->subset_string($subsetter, $r->{'POST'}, $fmt, $postvals); }
604             if ($test)
605             { $test = $self->subset_string($subsetter, $r->{'MATCH'}, $fmt, $classvals); }
606             if (!$test)
607             { delete $sub->{'RULES'}[$i][$j]; }
608             else
609             { $isEmpty = 0; }
610             }
611             $sub->{'RULES'}[$i] = [grep {$_} @{$sub->{'RULES'}[$i]}];
612             }
613             if ($isEmpty)
614             {
615             delete $sub->{'RULES'}[$i];
616             delete $sub->{'COVERAGE'}{'val'}{$gids[$i]} if ($fmt < 2); # already remapped
617             }
618             }
619             return 1;
620             }
621              
622             sub fixcontext
623             {
624             my ($self, $l, $lmap) = @_;
625              
626             return if ($l->{'TYPE'} < $self->extension() - 2 || $l->{'TYPE'} >= $self->extension());
627             foreach my $s (@{$l->{'SUB'}})
628             {
629             foreach my $r (@{$s->{'RULES'}})
630             {
631             foreach my $p (@{$r})
632             {
633             foreach my $b (@{$p->{'ACTION'}})
634             { $b->[1] = $lmap->[$b->[1]]; }
635             }
636             }
637             }
638             }
639              
640              
641              
642             package
643             Font::TTF::GSUB;
644              
645             sub subset_subtable
646             {
647             my ($self, $subsetter, $sub, $lookup, $lkvec) = @_;
648             my ($type) = $lookup->{'TYPE'};
649             my ($fmt) = $sub->{'FORMAT'};
650             my ($r, $i, $j, @gids, $k, $v);
651              
652             return 0 if ($type < 4 && !$self->subset_cover($subsetter, $sub->{'COVERAGE'}, $sub->{'RULES'}));
653              
654             while (($k, $v) = each %{$sub->{'COVERAGE'}{'val'}})
655             { $gids[$v] = $k; }
656              
657             if (($type == 1 && $fmt > 1) || $type == 2)
658             {
659             foreach $i (0 .. $#{$sub->{'RULES'}})
660             {
661             next unless (defined $sub->{'RULES'}[$i]);
662             foreach my $k (0 .. $#{$sub->{'RULES'}[$i][0]{'ACTION'}})
663             {
664             $j = $sub->{'RULES'}[$i][0]{'ACTION'}[$k];
665             if (!$subsetter->keep_glyph($j))
666             {
667             delete $sub->{'RULES'}[$i];
668             delete $sub->{'COVERAGE'}{'val'}{$gids[$i]}; # already remapped
669             last;
670             }
671             else
672             { $sub->{'RULES'}[$i][0]{'ACTION'}[$k] = $subsetter->map_glyph($j); }
673             }
674             }
675             }
676             elsif ($type == 3)
677             {
678             foreach $i (0 .. $#{$sub->{'RULES'}})
679             {
680             if (!defined $sub->{'RULES'}[$i])
681             {
682             delete $sub->{'COVERAGE'}{'val'}{$gids[$i]};
683             next;
684             }
685             my $res = [];
686             foreach $j (@{$sub->{'RULES'}[$i][0]{'ACTION'}})
687             {
688             if ($subsetter->keep_glyph($j))
689             { push (@{$res}, $subsetter->map_glyph($j)); }
690             }
691             if (@{$res})
692             { $sub->{'RULES'}[$i][0]{'ACTION'} = $res; }
693             else
694             {
695             delete $sub->{'RULES'}[$i];
696             delete $sub->{'COVERAGE'}{'val'}{$gids[$i]}; # already remapped
697             }
698             }
699             }
700             elsif ($type >=4 && $type <= 6)
701             { return $self->subset_context($subsetter, $sub, $type, $lkvec); }
702             return 1;
703             }
704              
705             package
706             Font::TTF::GPOS;
707              
708             sub subset_subtable
709             {
710             my ($self, $subsetter, $sub, $lookup, $lkvec) = @_;
711             my ($type) = $lookup->{'TYPE'};
712             my ($fmt) = $sub->{'FORMAT'};
713             my (@gids) = sort { $a <=> $b} keys %{$sub->{'COVERAGE'}{'val'}};
714             my ($i, $j, $k);
715              
716             return 0 if ($type <= 6 && !$self->subset_cover($subsetter, $sub->{'COVERAGE'}, $sub->{'RULES'}));
717             if ($type == 2 && $fmt == 1)
718             {
719             foreach $i (0 .. $#{$sub->{'RULES'}})
720             {
721             foreach $j (0 .. $#{$sub->{'RULES'}[$i]})
722             {
723             my ($r) = $sub->{'RULES'}[$i][$j];
724             if (!$subsetter->keep_glyph($r->{'MATCH'}[0]))
725             { delete $sub->{'RULES'}[$i][$j]; }
726             else
727             { $r->{'MATCH'}[0] = $subsetter->map_glyph($r->{'MATCH'}[0]); }
728             }
729             if (!@{$sub->{'RULES'}[$i]})
730             { delete $sub->{'RULES'}[$i]; }
731             else
732             { $sub->{'RULES'}[$i] = [grep {$_} @{$sub->{'RULES'}[$i]}]; }
733             }
734             }
735             elsif ($type == 2 && $fmt == 2)
736             {
737             my ($c1vals) = $self->subset_class($subsetter, $sub->{'CLASS'});
738             my ($c2vals) = $self->subset_class($subsetter, $sub->{'MATCH'}[0]);
739             my ($nrules) = [];
740            
741             foreach $i (0 .. $#{$sub->{'RULES'}})
742             {
743             if (!$c1vals->[$i])
744             { delete $sub->{'RULES'}[$i]; }
745             else
746             {
747             my (@nrule);
748             foreach $j (0 .. $#{$sub->{'RULES'}[$i]})
749             {
750             if (!defined $c2vals->[$j])
751             { delete $sub->{'RULES'}[$i][$j]; }
752             else
753             { $nrule[$c2vals->[$j]] = $sub->{'RULES'}[$i][$j]; }
754             }
755             if (@nrule)
756             { $nrules->[$c1vals->[$i]] = [grep {$_} @nrule]; }
757             }
758             }
759             if (@{$nrules})
760             { $sub->{'RULES'} = $nrules; }
761             else
762             { return 0; }
763             }
764             elsif ($type >= 4 && $type <= 6)
765             { return $self->subset_cover($subsetter, $sub->{'MATCH'}[0], $sub->{'MARKS'}) ? 1 : 0; }
766             elsif ($type >=7 && $type <= 8)
767             { return $self->subset_context($subsetter, $sub, $type - 2, $lkvec); }
768             return 1;
769             }
770              
771             package
772             Font::TTF::GDEF;
773              
774             sub subset
775             {
776             my ($self, $subsetter) = @_;
777              
778             return unless ($self->SUPER::subset($subsetter));
779             if (defined $self->{'GLYPH'})
780             { delete $self->{'GLYPH'} unless (Font::TTF::Ttopen->subset_class($subsetter, $self->{'GLYPH'}, 1)); }
781             if (defined $self->{'ATTACH'})
782             { delete $self->{'ATTACH'} unless (Font::TTF::Ttopen->subset_cover($subsetter, $self->{'ATTACH'}{'COVERAGE'}, $self->{'ATTACH'}{'POINTS'})); }
783             if (defined $self->{'LIG'})
784             { delete $self->{'LIG'} unless (Font::TTF::Ttopen->subset_cover($subsetter, $self->{'LIG'}{'COVERAGE'}, $self->{'LIG'}{'POINTS'})); }
785             if (defined $self->{'MARKS'})
786             { delete $self->{'MARKS'} unless (Font::TTF::Ttopen->subset_cover($subsetter, $self->{'MARKS'}, undef)); }
787             }
788              
789             package
790             Font::TTF::Cmap;
791              
792             sub subset
793             {
794             my ($self, $subsetter) = @_;
795              
796             return unless ($self->SUPER::subset($subsetter));
797             foreach my $i (0 .. $#{$self->{'Tables'}})
798             {
799             my ($t) = $self->{'Tables'}[$i]{'val'};
800             foreach my $k (keys %{$t})
801             {
802             if ($subsetter->keep_glyph($t->{$k}))
803             { $t->{$k} = $subsetter->map_glyph($t->{$k}); }
804             else
805             { delete $t->{$k}; }
806             }
807             if ($self->is_unicode($i))
808             {
809             foreach my $k (keys %{$subsetter->{'remaps'}})
810             { $t->{$k} = $subsetter->map_glyph($subsetter->{'remaps'}{$k}); }
811             }
812             }
813             }
814              
815             package
816             Font::TTF::Post;
817              
818             no warnings;
819              
820             sub subset
821             {
822             my ($self, $subsetter) = @_;
823             my ($res) = [];
824              
825             return unless ($self->SUPER::subset($subsetter));
826             # need to rewrite for real glyph remapping
827             foreach my $i (0 .. @{$self->{'VAL'}})
828             { $res->[$subsetter->map_glyph($i)] = $subsetter->keep_glyph($i) ? $self->{'VAL'}[$i] : ".notdef"; }
829             $self->{'VAL'} = $res;
830             }
831              
832             package
833             Font::TTF::Hmtx;
834              
835             sub subset
836             {
837             my ($self, $subsetter) = @_;
838             my ($adv) = [];
839             my ($lsb) = [];
840              
841             return unless ($self->SUPER::subset($subsetter));
842             for (my $i = 0; $i < @{$self->{'advance'}}; $i++)
843             {
844             if ($subsetter->keep_glyph($i))
845             {
846             my ($g) = $subsetter->map_glyph($i);
847             $adv->[$g] = $self->{'advance'}[$i];
848             $lsb->[$g] = $self->{'lsb'}[$i];
849             }
850             }
851             $self->{'advance'} = $adv;
852             $self->{'lsb'} = $lsb;
853             }
854              
855             package
856             Font::TTF::LTSH;
857              
858             sub subset
859             {
860             my ($self, $subsetter) = @_;
861             my ($res) = [];
862              
863             return unless ($self->SUPER::subset($subsetter));
864             for (my $i = 0; $i < @{$self->{'glyphs'}}; $i++)
865             {
866             if ($subsetter->keep_glyph($i))
867             { $res->[$subsetter->map_glyph($i)] = $self->{'glyphs'}[$i]; }
868             }
869             $self->{'glyphs'} = $res;
870             $self->{'Num'} = $subsetter->{'gcount'};
871             }
872              
873              
874             package
875             Font::TTF::Gloc;
876              
877             sub canchangegids
878             { 0; }
879              
880             __END__