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:

   * [pdf4tcl.tcl]
   * [glyph2uni.tcl]
   * [stdmetrics.tcl]

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.
----
!!!!!!
%| [Category Package] |  [Category Printing] |%
!!!!!!