From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

PMPERRY / PDF-Builder-3.027 / examples / Windows / Win32.pm 

            

              
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

              
package PDF::Builder::Win32;  ## no critic
use strict;
use warnings;
#no warnings qw[ deprecated recursion uninitialized ];
our $VERSION = '3.027'; # VERSION
our $LAST_UPDATE = '3.027'; # manually update whenever code is changed
use Win32::TieRegistry qw( :KEY_ );  # creates $Registry, et al.
=head1 NAME
PDF::Builder::Win32 - font file- and registry-related support routines for Windows operating system
=cut
our $wf = {};
$Registry->Delimiter('/');
# e.g., "C:\Windows\Fonts". $Registry->{} is a hash reference to Fonts element
my $fontdir = $Registry->{'HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders/Fonts'};
# $Registry->{} should be a hash reference containing elements which are the
# names of .ttf etc. files found in $fontdir. 
# E.g., $Registry->{'Arial (TrueType)'} = 'arial.ttf'
my $subKey = $Registry->Open('LMachine', {Access=>KEY_READ(), Delimiter=>'/'}) or die "error opening LMachine: $^E\n";
$subKey = $subKey->Open('SOFTWARE/Microsoft/Windows NT/CurrentVersion/Fonts/') or die "error accessing Fonts entry: $^E\n";
foreach my $k (sort keys %{$subKey}) {
    # $k should be something like 'Arial (TrueType)'
    # $subKey->{$k} would then be 'arial.ttf'
    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};
    }
}
# this one seems to be optional (often missing)
$subKey = $Registry->Open('LMachine', {Access=>KEY_READ(), Delimiter=>'/'}) or die "error opening LMachine for T1 fonts: $^E\n";
$subKey = $subKey->Open('SOFTWARE/Microsoft/Windows NT/CurrentVersion/Type 1 Installer/Type 1 Fonts/') or die "error accessing T1 Fonts entry: $^E\n";
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'};
    }
}
# return hash of fonts, key=lc name w/o fileext, value=full name 
# e.g., {'arial'} = 'Arial (TrueType)'
sub enumwinfonts {
    my $self = shift;
    return map { $_ => $wf->{$_}->{'display'} } keys %$wf;
}
sub winfont {
    my $self = shift;
    my $key = lc(shift());
    my %opts = @_;
    $key =~ s/[^a-z0-9]+//g;
    # $wf is hash reference
    return unless defined $wf and defined $wf->{$key};
    # ttfile is complete path and name of a file
    if (defined $wf->{$key}->{'ttfile'}) {
        return $self->ttfont($wf->{$key}->{'ttfile'}, @_);
    } else {
        return $self->psfont($wf->{$key}->{'pfbfile'}, -pfmfile => $wf->{$key}->{'pfmfile'}, @_);
    }
}
1;