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 2     2   1731 use strict;
  2         4  
  2         95  
3 2     2   10 use warnings;
  2         3  
  2         79  
4 2     2   957 use TeX::XDV::Parse ':constants';
  2         7  
  2         2362  
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 4     4 0 48 my ($self,$ord,$k,$ps,$fl,$plen,$flen,$slen,$font,$fam,$sty,@more) = @_;
31              
32 4 50       13 my $dir = $fl & XDV_FLAG_VERTICAL ? 1 : 0;
33 4 50       10 my $color = $fl & XDV_FLAG_COLORED ? shift(@more) : 0xffffffff;
34              
35 4         7 my ($nvars, @vars) = (0);
36 4 50       10 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 4 50       10 my $extend = $fl & XDV_FLAG_EXTEND ? shift(@more) : 0x00010000;
42 4 50       10 my $slant = $fl & XDV_FLAG_SLANT ? shift(@more) : 0;
43 4 50       13 my $bold = $fl & XDV_FLAG_EMBOLDEN ? shift(@more) : 0;
44              
45 4         7 local $" = ','; # for @vars
46 4         11 print "NatFont\t$ord, ...\n";
47 4         10 print " font id.................: $k\n";
48 4         9 print " point size..............: $ps\n";
49 4         9 print " flags...................: $fl\n";
50 4         7 print " postscript name length..: $plen\n";
51 4         8 print " family name length......: $flen\n";
52 4         7 print " style name length.......: $slen\n";
53 4         7 print " font name...............: $font\n";
54 4         8 print " family name.............: $fam\n";
55 4         6 print " style name..............: $sty\n";
56 4         10 print " rgba color..............: $color\n";
57 4         12 print " number variations.......: $nvars\n";
58 4         9 print " variations..............: @vars\n";
59 4         11 print " extend..................: $extend\n";
60 4         10 print " slant...................: $slant\n";
61 4         19 print " embolden................: $bold\n";
62             }
63              
64             sub glyph_string {
65 41     41 0 366 my ($self, $ord, $width, $len, @more) = @_;
66 41         135 my @x_locs = @more[0 .. $len-1];
67 41         93 my @glyphs = @more[$len .. 2*$len-1];
68 41         53 local $" = ',';
69 41         80 print "GlyphSt\t$ord, ...\n";
70 41         56 print " width...................: $width\n";
71 41         158 print " length..................: $len\n";
72 41         133 print " x_locs..................: @x_locs\n";
73 41         227 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 18 my ($self, $ord, $t, $a, $b, $c, $d, $e, $f, $pg, $l, $p ) = @_;
92 3         6 print "PicFile\t$ord, ...\n";
93 3         2 print " box type................: $t\n";
94 3         5 print " a.......................: $a\n";
95 3         4 print " b.......................: $b\n";
96 3         3 print " c.......................: $c\n";
97 3         3 print " d.......................: $d\n";
98 3         4 print " e.......................: $e\n";
99 3         3 print " f.......................: $f\n";
100 3         2 print " page number.............: $pg\n";
101 3         3 print " path length.............: $l\n";
102 3         8 print " path....................: $p\n";
103             }
104              
105             1;
106