File Coverage

inc/TeX/XDV/Print.pm
Criterion Covered Total %
statement 55 73 75.3
branch 6 16 37.5
condition n/a
subroutine 6 8 75.0
pod 0 5 0.0
total 67 102 65.6


line stmt bran cond sub pod time code
1             package TeX::XDV::Print;
2 1     1   970 use strict;
  1         2  
  1         38  
3 1     1   6 use warnings;
  1         3  
  1         33  
4 1     1   586 use TeX::XDV::Parse ':constants';
  1         4  
  1         1171  
5              
6             @TeX::XDV::Print::ISA = qw/TeX::DVI::Print/;
7              
8             sub dir {
9 0     0 0 0 my ($self, $ord, $dir) = @_;
10 0 0       0 my $d = $dir == 1 ? 'horizontal' : $dir == 0 ? 'vertical' : 'unknown';
    0          
11 0         0 print "Dir\t$ord, $d\n";
12             }
13              
14             sub native_font_def {
15             # k : font id
16             # ps: point size /* skip point size */ (from dvi.c)
17             # : flags
18             # : ps name len
19             # : family name len
20             # : style name len
21             # n : font_name
22             # : fam_name
23             # : sty_name
24             # : rgba_color
25             # : nvars
26             # : variations * nvars (not used?)
27             # : extend
28             # : slant
29             # : embolden
30 2     2 0 26 my ($self,$ord,$k,$ps,$fl,$plen,$flen,$slen,$font,$fam,$sty,@more) = @_;
31              
32 2 50       6 my $dir = $fl & XDV_FLAG_VERTICAL ? 1 : 0;
33 2 50       4 my $color = $fl & XDV_FLAG_COLORED ? shift(@more) : 0xffffffff;
34              
35 2         3 my ($nvars, @vars) = (0);
36 2 50       6 if ($fl & XDV_FLAG_VARIATIONS) {
37 0         0 $nvars = shift @more;
38 0         0 push( @vars, shift( @more ) ) for 1 .. 2*$nvars;
39             }
40              
41 2 50       6 my $extend = $fl & XDV_FLAG_EXTEND ? shift(@more) : 0x00010000;
42 2 50       4 my $slant = $fl & XDV_FLAG_SLANT ? shift(@more) : 0;
43 2 50       4 my $bold = $fl & XDV_FLAG_EMBOLDEN ? shift(@more) : 0;
44              
45 2         4 local $" = ','; # for @vars
46 2         5 print "NatFont\t$ord, ...\n";
47 2         5 print " font id.................: $k\n";
48 2         4 print " point size..............: $ps\n";
49 2         5 print " flags...................: $fl\n";
50 2         4 print " postscript name length..: $plen\n";
51 2         4 print " family name length......: $flen\n";
52 2         5 print " style name length.......: $slen\n";
53 2         4 print " font name...............: $font\n";
54 2         3 print " family name.............: $fam\n";
55 2         3 print " style name..............: $sty\n";
56 2         5 print " rgba color..............: $color\n";
57 2         3 print " number variations.......: $nvars\n";
58 2         5 print " variations..............: @vars\n";
59 2         4 print " extend..................: $extend\n";
60 2         4 print " slant...................: $slant\n";
61 2         12 print " embolden................: $bold\n";
62             }
63              
64             sub glyph_string {
65 5     5 0 56 my ($self, $ord, $width, $len, @more) = @_;
66 5         17 my @x_locs = @more[0 .. $len-1];
67 5         14 my @glyphs = @more[$len .. 2*$len-1];
68 5         8 local $" = ',';
69 5         11 print "GlyphSt\t$ord, ...\n";
70 5         9 print " width...................: $width\n";
71 5         18 print " length..................: $len\n";
72 5         21 print " x_locs..................: @x_locs\n";
73 5         41 print " glyphs..................: @glyphs\n";
74             }
75              
76             sub glyph_array {
77 0     0 0 0 my ($self, $ord, $width, $len, @more) = @_;
78 0         0 my @x_locs = @more[ map { 2*$_ } 1 .. $len-1 ];
  0         0  
79 0         0 my @y_locs = @more[ map { 2*$_+1 } 1 .. $len-1 ];
  0         0  
80 0         0 my @glyphs = @more[ 2*$len+2 .. 3*$len-1 ];
81 0         0 local $" = ',';
82 0         0 print "GlyphAr\t$ord, ...\n";
83 0         0 print " width...................: $width\n";
84 0         0 print " length..................: $len\n";
85 0         0 print " x_locs..................: @x_locs\n";
86 0         0 print " y_locs..................: @y_locs\n";
87 0         0 print " glyphs..................: @glyphs\n";
88             }
89              
90             sub pic_file {
91 3     3 0 33 my ($self, $ord, $t, $a, $b, $c, $d, $e, $f, $pg, $l, $p ) = @_;
92 3         10 print "PicFile\t$ord, ...\n";
93 3         7 print " box type................: $t\n";
94 3         6 print " a.......................: $a\n";
95 3         7 print " b.......................: $b\n";
96 3         5 print " c.......................: $c\n";
97 3         7 print " d.......................: $d\n";
98 3         5 print " e.......................: $e\n";
99 3         5 print " f.......................: $f\n";
100 3         7 print " page number.............: $pg\n";
101 3         6 print " path length.............: $l\n";
102 3         15 print " path....................: $p\n";
103             }
104              
105             1;
106