This is a modified version of pdf4tcl from SVN trunk with added support for embedding Type1 and TrueType fonts, skew for text. Bug with displaying angled background is fixed. Also, thanks to Martin Walcher for adding document/page configuration option "-rotate <value>". BUT it requires Tcl 8.5 now.
Fonts support is mostly taken (converted) from reportlab and libharu.
Examples:
1. dumpfont.tcl --- primitive dumping of font files, usage is:
$ dumpfont.tcl filename1.ttf filename1.afm ... filenameN.afm|pfb|ttf
Produces PDF file for each font. Result format is:
unicode (decimal) -- postscript name -- glyph
package require pdf4tcl
#Provide .afm and .pfb to dump type1 font:
proc dumpfontverbose {fname} {
set name [string range $fname 0 end-4]
set ext [string range $fname end-2 end]
if {$ext eq "ttf"} {
pdf4tcl::LoadBaseTrueTypeFont BaseFont$fname $fname
} elseif {$ext eq "afm"} {
pdf4tcl::LoadBaseType1Font BaseFont$fname $fname "${name}.pfb"
} elseif {$ext eq "pfb"} {
pdf4tcl::LoadBaseType1Font BaseFont$fname "${name}.afm" $fname
} else {
error $ext
}
foreach {psname ucode} [array get ::pdf4tcl::GlName2Uni] {
set U2PSname($ucode) $psname
}
#This requires poking into pdf4tcl internals:
#Result is list of lists (for each subset).
for {set f 0} {$f<=32} {incr f} {
lappend baseset $f
}
set Xchars 32
set f 33
set subsetN 1
set currtxt ""
set subtext ""
set subset $baseset
lappend res MyFont1
foreach {ucode w} $::pdf4tcl::BFA(BaseFont$fname,charWidths) {
lappend ucodes $ucode
}
set ucodes [lsort -integer $ucodes]
foreach ucode $ucodes {
if {$f==256} {
lappend res $subtext
#Reinit:
pdf4tcl::CreateFont_SpecEnc BaseFont$fname MyFont$subsetN $subset
incr subsetN
lappend res MyFont$subsetN
set f 33
set currtxt ""
set subtext ""
set subset $baseset
}
lappend subset $ucode
set psname ".notdef"
catch {set psname $U2PSname($ucode)}
lappend subtext [list $ucode $psname [format %c $ucode]]
incr f
}
#Finish all:
lappend res $subtext
pdf4tcl::CreateFont_SpecEnc BaseFont$fname MyFont$subsetN $subset
pdf4tcl::new mypdf -paper a4 -compress 1
mypdf startPage
foreach {w h} [mypdf getDrawableArea] break
set h [expr {$h-30.0}]
set w [expr {$w-50.0}]
set y 30
set x 50
foreach {fontname txtlist} $res {
foreach symlst $txtlist {
foreach {ucode psname char} $symlst break
mypdf setFont 10 Courier
mypdf text "$ucode $psname " -x $x -y $y
mypdf setFont 12 $fontname
mypdf text $char -bg #CCCCCC
incr x 180
if {$x>=$w} {
set x 50
incr y 22
if {$y>=$h} {
mypdf endPage
mypdf startPage
mypdf setFont 10 $fontname
set y 30
}
}
}
}
mypdf write -file ${name}_dump.pdf
mypdf destroy
}
foreach fname $argv {
dumpfontverbose $fname
}
2. multiout.tcl --- example of using same fonts in many pdf4tcl objects.
Font file names are hard-coded, replace with ones you want to use.
package require pdf4tcl
proc multipdf {args} {
global G_pdfobjs
foreach obj $G_pdfobjs {
$obj {*}$args
}
}
proc testmulti {} {
global G_pdfobjs
pdf4tcl::LoadBaseTrueTypeFont BaseArial "arial.ttf"
pdf4tcl::CreateFont BaseArial MyArial cp1251
pdf4tcl::LoadBaseType1Font BaseType1 "a010013l.afm" "a010013l.pfb"
pdf4tcl::CreateFont BaseType1 MyType1 cp1251
set G_pdfobjs [list one two three]
foreach obj $G_pdfobjs {
pdf4tcl::new $obj -paper a4 -compress 1
}
multipdf startPage
multipdf setFont 20 MyArial
multipdf text "QWERTY" -x 50 -y 50 -bg #CACACA
multipdf text "qwerty" -x 50 -y 100 -bg #CACACA
multipdf setFont 20 MyType1
multipdf text "QWERTY" -x 50 -y 150 -bg #CACACA
multipdf text "qwerty" -x 50 -y 200 -bg #CACACA
multipdf setFillColor #6A6A6A
multipdf setFont 16 Courier
multipdf text "This is text for testing purposes." -bg #8A8A8A -x 100 -y 370
multipdf setFont 20 MyType1
multipdf setFillColor #20FA20
multipdf text "Skewed." -bg #000000 -x 200 -y 420 -xangle 10 -yangle 15 -angle 25
foreach obj $G_pdfobjs {
$obj write -file $obj.pdf
$obj destroy
}
}
testmulti
3. specenc.tcl --- example of "special" encodings.
package require pdf4tcl
proc example_specenc {} {
pdf4tcl::LoadBaseTrueTypeFont BaseArial "arial.ttf"
#Subset is a list of unicodes:
for {set f 0} {$f<128} {incr f} {lappend subset $f}
lappend subset 178 946
pdf4tcl::CreateFont_SpecEnc BaseArial MyArial $subset
pdf4tcl::new mypdf -paper a4 -compress 1
mypdf startPage
mypdf setFont 16 MyArial
set txt "sin\u00B2\u03B2 + cos\u00B2\u03B2 = 1"
mypdf text $txt -x 50 -y 100
mypdf write -file font_spec.pdf
mypdf destroy
}
example_specenc
Sources:
pkgindex.tcl is:
package ifneeded pdf4tcl 0.6.1 [list source [file join $dir pdf4tcl.tcl]] package ifneeded pdf4tcl::stdmetrics 0.1 [list source [file join $dir stdmetrics.tcl]] package ifneeded pdf4tcl::glyph2unicode 0.1 [list source [file join $dir glyph2uni.tcl]]
YS, 07.09.2009.
YS, 22.10.2009: I've added some changes from upstream by Peter Spjuth, as my patch is still not fully integrated:
Peter Spjuth, 30.01.2010: This patch is now in pdf4tcl 0.7.