1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
package PDF::API2::Win32;
use strict;
no warnings qw[ deprecated recursion uninitialized ];
our $VERSION = '2.047'; # VERSION
package PDF::API2;
use Win32::TieRegistry;
use strict;
no warnings qw[ recursion uninitialized ];
our $wf = {};
$Registry->Delimiter('/');
my $fontdir = $Registry->{'HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders'}->{'Fonts'};
my $subKey = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Fonts/'};
foreach my $k (sort keys %{$subKey}) {
next unless $subKey->{$k} =~ /\.[ot]tf$/i;
my $kk = lc $k;
$kk =~ s|^/||;
$kk =~ s|\s+\(truetype\).*$||g;
$kk =~ s|\s+\(opentype\).*$||g;
$kk =~ s/[^a-z0-9]+//g;
$wf->{$kk} = {};
$wf->{$kk}->{'display'} = $k;
$wf->{$kk}->{'display'} =~ s|^/||;
if (-e "$fontdir/$subKey->{$k}") {
$wf->{$kk}->{'ttfile'} = "$fontdir/$subKey->{$k}";
}
else {
$wf->{$kk}->{'ttfile'} = $subKey->{$k};
}
}
$subKey = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Type 1 Installer/Type 1 Fonts/'};
foreach my $k (sort keys %$subKey) {
my $kk = lc $k;
$kk =~ s|^/||;
$kk =~ s/[^a-z0-9]+//g;
$wf->{$kk} = {};
$wf->{$kk}->{'display'} = $k;
$wf->{$kk}->{'display'} =~ s|^/||;
my $t;
($t, $wf->{$kk}->{'pfmfile'}, $wf->{$kk}->{'pfbfile'}) = split(/\0/, $subKey->{$k});
if (-e "$fontdir/$wf->{$kk}->{pfmfile}") {
$wf->{$kk}->{'pfmfile'} = "$fontdir/" . $wf->{$kk}->{'pfmfile'};
$wf->{$kk}->{'pfbfile'} = "$fontdir/" . $wf->{$kk}->{'pfbfile'};
}
}
sub enumwinfonts {
my $self = shift();
return map { $_ => $wf->{$_}->{'display'} } keys %$wf;
}
sub winfont {
my $self = shift();
my $key = lc(shift());
$key =~ s/[^a-z0-9]+//g;
return unless defined $wf and defined $wf->{$key};
if (defined $wf->{$key}->{'ttfile'}) {
return $self->ttfont($wf->{$key}->{'ttfile'}, @_);
}
else {
return $self->psfont($wf->{$key}->{'pfbfile'}, -pfmfile => $wf->{$key}->{'pfmfile'}, @_);
}
}
1;
|
