Viewing file:  ps_fonts.pl (5.71 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
use strict;
use warnings;
use Prima::PS::Printer;
use Prima::PS::PDF;
use Prima::PS::PostScript;
use Encode;
sub page
{
my ($p, $name) = @_;
my @size = $p->size;
$p->translate(0,0);
$p-> font-> set( size=>100,name=>$name);
my $h100 = $p->font->height;
my $m = $p-> get_font;
my $xtext = Encode::decode('latin1', "\x{c5}Mg");
my $glyphs = $p-> text_shape( $xtext, level => ts::Glyphs, polyfont => 0 );
if ( $glyphs && grep { $_ == 0 } @{ $glyphs->glyphs }) {
# bad glyphs find some others (best if not ascii)
my @g;
$xtext = '';
my $r = $p-> get_font_ranges;
GLYPHS: for ( my $i = @$r - 2; $i >= 0; $i -= 2) {
my ( $from, $to ) = @{$r}[$i,$i+1];
for ( my $j = $from; $j <= $to; $j++) {
$xtext .= chr($j);
last GLYPHS if length($xtext) > 2;
}
}
}
my $s = $size[1] - $m-> {height} - $m-> {externalLeading} - 220;
my $w = $p-> get_text_width($xtext) + 66;
$p-> textOutBaseline(1);
$p-> text_out($xtext, 20, $s);
my $cachedFacename = $p-> font-> name;
my $hsf = $p-> font-> height / 6;
$hsf = 10 if $hsf < 10;
$p-> font-> set(
height => $hsf,
style => fs::Italic,
name => '',
encoding => '',
);
$p-> line( 2, $s, $w, $s);
$p-> textOutBaseline(0);
$p-> text_out( "Baseline", $w - 8, $s);
my $sd = $s - $m-> {descent};
$p-> line( 2, $sd, $w, $sd);
$p-> text_out( "Descent", $w - 8, $sd);
$sd = $s + $m-> {ascent};
$p-> line( 2, $sd, $w, $sd);
$p-> text_out( "Ascent", $w - 8, $sd);
$sd = $s + $m-> {ascent} + $m-> {externalLeading};
if ( $m-> {ascent} > 4) {
$p-> line( $w - 12, $s + 1, $w - 12, $s + $m-> {ascent});
$p-> line( $w - 12, $s + $m-> {ascent}, $w - 14, $s + $m-> {ascent} - 2);
$p-> line( $w - 12, $s + $m-> {ascent}, $w - 10, $s + $m-> {ascent} - 2);
}
if ( ($m-> {ascent}-$m-> {internalLeading}) > 4) {
my $pt = $m-> {ascent}-$m-> {internalLeading};
$p-> line( $w - 16, $s + 1, $w - 16, $s + $pt);
$p-> line( $w - 16, $s + $pt, $w - 18, $s + $pt - 2);
$p-> line( $w - 16, $s + $pt, $w - 14, $s + $pt - 2);
}
if ( $m-> {descent} > 4) {
$p-> line( $w - 13, $s - 1, $w - 13, $s - $m-> {descent});
$p-> line( $w - 13, $s - $m-> {descent}, $w - 15, $s - $m-> {descent} + 2);
$p-> line( $w - 13, $s - $m-> {descent}, $w - 11, $s - $m-> {descent} + 2)
}
my $str;
$p-> text_out( "External Leading", 2, $sd);
$p-> line( 2, $sd, $w, $sd);
$sd = $s + $m-> {ascent} - $m-> {internalLeading};
$str = "Point size in device units";
$p-> text_out( $str, $w - 16 - $p-> get_text_width( $str), $sd);
$p-> linePattern( lp::Dash);
$p-> line( 2, $sd, $w, $sd);
$p-> font-> set(
size => 10,
pitch => fp::Fixed,
);
my $fh = $p-> font-> height;
$sd = $s - $m-> {descent} - $fh * 3;
$p-> text_out( 'nominal size : '.$m-> {size}, 2, $sd); $sd -= $fh;
$p-> text_out( 'cell height : '.$m-> {height }, 2, $sd); $sd -= $fh;
$p-> text_out( 'average width : '.$m-> {width }, 2, $sd); $sd -= $fh;
$p-> text_out( 'ascent : '.$m-> {ascent }, 2, $sd); $sd -= $fh;
$p-> text_out( 'descent : '.$m-> {descent }, 2, $sd); $sd -= $fh;
$p-> text_out( 'weight : '.$m-> {weight }, 2, $sd); $sd -= $fh;
$p-> text_out( 'internal leading : '.$m-> {internalLeading}, 2, $sd); $sd -= $fh;
$p-> text_out( 'external leading : '.$m-> {externalLeading}, 2, $sd); $sd -= $fh;
$p-> text_out( 'maximal width : '.$m-> {maximalWidth}, 2, $sd); $sd -= $fh;
$p-> text_out( 'horizontal dev.res. : '.$m-> {xDeviceRes}, 2, $sd); $sd -= $fh;
$p-> text_out( 'vertical dev.res. : '.$m-> {yDeviceRes}, 2, $sd); $sd -= $fh;
$p-> text_out( 'first char : '.$m-> {firstChar}, 2, $sd); $sd -= $fh;
$p-> text_out( 'last char : '.$m-> {lastChar }, 2, $sd); $sd -= $fh;
$p-> text_out( 'break char : '.$m-> {breakChar}, 2, $sd); $sd -= $fh;
$p-> text_out( 'default char : '.$m-> {defaultChar}, 2, $sd); $sd -= $fh;
$p-> text_out( 'family : '.$m-> {family }, 2, $sd); $sd -= $fh;
$p-> text_out( 'face name : '.$cachedFacename, 2, $sd); $sd -= $fh;
my $C = 'f';
$sd -= $h100 - 20;
#delete $m->{height};
#delete $m->{width};
$p->font( name => $m->{name}, size => $m->{size}, style=> $m->{style} );
$p-> line(50, $sd+$p->font->descent, 1000, $sd+$p->font->descent);
$p-> linePattern(lp::Dot);
my $ddx = 0;
for my $C ( split //, $xtext ) {
my $flags = utf8::is_utf8($C) ? to::Unicode : 0;
my ( $a, $b, $c ) = @{ $p->get_font_abc( ord($C), ord($C), $flags) };
my ( $d, $e, $f ) = @{ $p->get_font_def( ord($C), ord($C), $flags) };
my $w = (( $a < 0 ) ? 0 : $a) + $b + (( $c < 0 ) ? 0 : $c);
my $h = (( $d < 0 ) ? 0 : $d) + $e + (( $f < 0 ) ? 0 : $f);
# print ord($C), "/$C: $a $b $c ($w) / $d $e $f \n";
$h = $sd;
$p-> translate(350 + $ddx, $h);
$ddx += $w + 20;
$w = 50;
my $dx = 0;
my $dy = 0;
$dx -= $a if $a < 0;
$dy -= $d if $d < 0;
my $fh = $p-> font->height;
$p-> text_out( $C, $dx, $dy );
$dx = abs($a);
$dy = abs($d);
$p-> line($dx, 0, $dx, $m->{height});
$dx = (( $a < 0 ) ? 0 : $a) + $b + (( $c < 0 ) ? 0 : $c) - abs($c);
$p-> line($dx, 0, $dx, $m->{height});
$p-> line(0, $dy, $m->{width}, $dy);
$dy = (( $d < 0 ) ? 0 : $d) + $e + (( $f < 0 ) ? 0 : $f) - abs($f);
$p-> line(0, $dy, $m->{width}, $dy);
}
}
if (!@ARGV || $ARGV[0] !~ /^\-(ps|pdf)$/) {
print "Please run with either -ps or -pdf\n";
exit(1);
}
my $p = ($ARGV[0] eq '-ps') ?
Prima::PS::File->new( file => 'out.ps') :
Prima::PS::PDF::File->new( file => 'out.pdf');
$p->begin_doc;
my $ff = $p->font;
my @fonts = @{$p-> fonts};
my $i;
$|++;
for my $f ( sort { $a->{name} cmp $b->{name} } @fonts ) {
$i++;
printf "[%d/%d] %s \r", $i, scalar(@fonts), $f->{name};
$p->font($ff);
page( $p, $f->{name} );
$p->new_page;
}
$p->end_doc;
print "\n", $p->file, " generated ok\n";
|