#!/usr/bin/perl
#=======================================================================
# ____ ____ _____ _ ____ ___ ____
# | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
# | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
# | __/| |_| | _| _ _ / ___ \| __/| | / __/
# |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
#
# A Perl Module Chain to faciliate the Creation and Modification
# of High-Quality "Portable Document Format (PDF)" Files.
#
# Copyright 1999-2004 Alfred Reibenschuh <areibens@cpan.org>.
#
#=======================================================================
#
# PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS FILE FOR
# ANY PURPOSE WITH OR WITHOUT FEE IS HEREBY GRANTED, PROVIDED THAT
# THE ABOVE COPYRIGHT NOTICE AND THIS PERMISSION NOTICE APPEAR IN ALL
# COPIES.
#
# THIS FILE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
# OF THE USE OF THIS FILE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Id: 024_bmpfonts,v 2.0 2005/11/16 02:16:00 areibens Exp $
#
#=======================================================================
use PDF::API2;
use PDF::API2::Util;
use PDF::API2::Resource::Font::BdFont;
use Data::Dumper;
my $data=PDF::API2::Resource::Font::BdFont->readBDF($ARGV[0]);
print Dumper($data);
$pdf=PDF::API2->new;
foreach my $char (@{$data->{char2}}) {
my $page = $pdf->page;
$page->mediabox('A4'); # 595,842
my $gfx=$page->gfx;
print "C: $char->{NAME} ($char->{ENCODING})\n";
my @bbx=@{$char->{BBX}};
my $stream=pack('H*',$char->{hex});
my $y=$bbx[1];
next unless($y);
my $x=8*length($stream)/$y;
my $img=qq|q $x 0 0 $y 50 50 cm
BI
/Interpolate false/Decode [1 0]/H $y/W $x/BPC 1/CS/G
ID $stream
EI
Q|;
$gfx->add($img);
delete $gfx->{Filter};
}
my $sx=33;
my $sy=45;
my $fx=20;
my $f1=$pdf->corefont('Helvetica');
my $font=$pdf->bdfont($ARGV[0]);
my $page = $pdf->page;
$page->mediabox(595,842);
my $gfx=$page->gfx;
my $txt=$page->text;
$txt->strokecolor('#000');
$txt->fillcolor('#000');
$txt->font($font,$fx);
my $txt2=$page->text;
$txt2->translate(50,800);
$txt2->font($f1,20);
$txt2->text("font='".$font->fontname." / ".$font->name."'");
$txt2->font($f1,5);
$txt2->hspace(80);
my $u=$font->underlineposition*$fx/1000;
foreach $x (0..15) {
print STDERR ".";
foreach $y (0..15) {
$txt->translate(50+($sx*$x),50+($sy*$y));
$txt->text(chr($y*16+$x));
my $wx=$font->width(chr($y*16+$x))*$fx;
$gfx->strokecolor('lightblue');
$gfx->move(50+($sx*$x),50+($sy*$y)+$fx);
$gfx->line(50+($sx*$x),50+($sy*$y)+$u);
$gfx->line(50+($sx*$x)+$wx,50+($sy*$y)+$u);
$gfx->line(50+($sx*$x)+$wx,50+($sy*$y)+$fx);
$gfx->close;
$gfx->stroke;
$gfx->strokecolor('gray');
$gfx->move(50+($sx*$x),50+($sy*$y));
$gfx->line(50+($sx*$x)+$wx,50+($sy*$y));
$gfx->stroke;
$txt2->translate(50+($sx*$x)-2,50+($sy*$y)-6);
$txt2->text_right($y*16+$x);
$txt2->translate(50+($sx*$x)-2,50+($sy*$y)-11);
$txt2->text_right(sprintf('U=0x%04X',$font->uniByEnc($y*16+$x)));
$txt2->translate(50+($sx*$x)-2,50+($sy*$y)-16);
$txt2->text_right($font->glyphByEnc($y*16+$x));
$txt2->translate(50+($sx*$x)-2,50+($sy*$y)-21);
$txt2->text_right(sprintf('wx=%i',$font->wxByEnc($y*16+$x)));
}
}
delete $gfx->{Filter};
delete $txt->{Filter};
delete $txt2->{Filter};
$pdf->{pdf}->{' version'}=4;
$pdf->saveas("$0.pdf");
$pdf->end();
__END__