2 ## --------------------------------------------------------------------------
4 ## Copyright 1996-2017 The NASM Authors - All Rights Reserved
5 ## See the file AUTHORS included with the NASM distribution for
6 ## the specific copyright holders.
8 ## Redistribution and use in source and binary forms, with or without
9 ## modification, are permitted provided that the following
10 ## conditions are met:
12 ## * Redistributions of source code must retain the above copyright
13 ## notice, this list of conditions and the following disclaimer.
14 ## * Redistributions in binary form must reproduce the above
15 ## copyright notice, this list of conditions and the following
16 ## disclaimer in the documentation and/or other materials provided
17 ## with the distribution.
19 ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
20 ## CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
21 ## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
22 ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23 ## DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
24 ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
26 ## NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 ## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28 ## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29 ## CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
30 ## OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
31 ## EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33 ## --------------------------------------------------------------------------
36 # Try our best to find a specific PostScipt font in the system.
37 # We need to find the font files so we can extract the metrics.
38 # Sadly there isn't any reasonable Perl module to do this for us,
39 # as far as I can tell.
46 require 'afmmetrics.ph';
47 require 'ttfmetrics.ph';
49 my %font_info_hash = ();
50 my $fonts_scanned = 0;
51 my %prefs = { 'otf' => 1, 'ttf' => 2, 'pfa' => 3, 'pfb' => 4 };
53 sub add_file_to_font_hash
($) {
56 return unless ( -f
$filename );
57 return unless ( $filename =~ /^(.*)\.([[:alnum:]]+)$/ );
63 if ( $filename =~ /\.(otf|ttf)$/i ) {
64 $fontdata = parse_ttf_file
($filename);
65 } elsif ( $filename =~ /\.(pfa|pfb)$/i ) {
66 if ( -f
"${filestem}.afm" ) {
67 $fontdata = parse_afm_file
($filestem, $fonttype);
71 return unless (defined($fontdata));
73 my $oldinfo = $font_info_hash{$fontdata->{name
}};
75 if (!defined($oldinfo) ||
76 $prefs{$fontdata->{type
}} < $prefs{$oldinfo->{type
}}) {
77 $font_info_hash{$fontdata->{name
}} = $fontdata;
82 require Win32
::Registry
;
83 Win32
::Registry
->import();
89 # Based on Font::TTF::Win32 by
90 # Martin Hosken <http://scripts.sil.org/FontUtils>.
93 # Copyright (c) 1998-2014, SIL International (http://www.sil.org)
95 # This module is released under the terms of the Artistic License 2.0.
96 # For details, see the full text of the license in the file LICENSE.
97 sub scanfonts_win32
() {
98 return undef unless ($win32_ok);
100 my $font_key = 'SOFTWARE\Microsoft\Windows' .
101 (Win32
::IsWinNT
() ?
'NT' : '') . '\CurrentVersion\Fonts';
102 my($regfont, $list, $l, $file);
104 $::HKEY_LOCAL_MACHINE
->Open($font_key, $regfont);
105 $regfont->GetValues($list);
107 foreach my $l (keys(%$list)) {
108 my $fname = $list->{$l}[0];
109 next unless ($fname =~ s/\((TrueType|OpenType)\)$//);
110 $file = File
::Spec
->rel2abs($list->{$l}[2], $ENV{'windir'}.'\fonts');
111 add_file_to_font_hash
($file)
115 sub font_search_file
() {
116 my($fontdata, $filestem, $fonttype);
118 add_file_to_font_hash
($_);
124 require Font
::TTF
::Win32
;
125 Font
::TTF
::Win32
->import();
128 my($file, $psname, $fontdata);
130 if (exists($font_info_hash{$fontname})) {
131 return $font_info_hash{$fontname};
134 # Are we on a system that uses fontconfig?
135 if (!defined($file) &&
136 open(my $fh, '-|', 'fc-match',
137 '-f', '%{file}\n%{postscriptname}\n',
138 " : postscriptname=$fontname")) {
139 chomp($file = <$fh>);
140 chomp($psname = <$fh>);
143 if ($psname eq $fontname) {
144 add_file_to_font_hash
($file);
146 if (!exists($font_info_hash{$fontname})) {
147 $font_info_hash{$fontname} = undef;
149 return $font_info_hash{$fontname};
153 if (exists($font_info_hash{$fontname})) {
154 return $font_info_hash{$fontname};
155 } elsif ($fonts_scanned >= 1) {
156 return $font_info_hash{$fontname} = undef;
164 if (exists($font_info_hash{$fontname})) {
165 return $font_info_hash{$fontname};
166 } elsif ($fonts_scanned >= 2) {
167 return $font_info_hash{$fontname} = undef;
170 # Search a set of possible locations for a file, from a few different
172 my @dirs = ('fonts', '/usr/share/fonts', '/Library/Fonts');
173 push @dirs, $ENV{'windir'}.'\fonts' if (defined $ENV{'windir'});
174 push @dirs, $ENV{'HOME'}.'/.fonts', $ENV{'HOME'}.'/Library/Fonts'
175 if (defined $ENV{'HOME'});
177 find
({wanted
=> \font_search_file
, follow
=>1, no_chdir
=>1}, @dirs);
180 return $font_info_hash{$fontname};