Version 10 of Canvas microjustification

Updated 2013-03-05 11:37:06 by RLE

WikiDbImage mjtext.jpg

Description

Richard Suchenwirth 2002-07-28: Microjustification is a typesetting technique where small gaps are inserted between words to make lines fully justified (flush left and right). Donald E. Knuth has done extensive research on the topic (which I didn't have handy over weekend ;-), so here's only my Tk experiments.

The text widget does not support full justification, so I use a canvas instead - it can display text at pixel-precise positions, and also produce Postscript. I could not use its text editing features, because then "a space is a space" of font-dependent constant width.

In this design, a sort of "mega-item" mjtext is created on the canvas, which first just is a rectangle. The returned handle however accepts text input with $mj insert end.. like a text widget. The words are rendered as separate text items and wrap around, except at newlines. For the resulting "raw lines", the number of missing pixels to flush-right is determined, and the rightmost word is shifted right by that amount, then the others by decreasing amounts to make them approximately evenly distributed.

That's all - still a far cry from real DTP (rather like 1970's IBM Composer); but it let me cross another horizon of what's all possible with Tcl/Tk - hyphenation might be the next target..

set docu(mjtext) {
    insert a good-size chunk of text, here
}
proc mjtext {c x0 y0 x1 y1 args} {
    array set opt {-bg white  -font {Times 11}}
    array set opt $args
    set _self mj[$c create rect $x0 $y0 $x1 $y1 \
        -fill $opt(-bg) -outline $opt(-bg)]
    upvar #0 $_self self
    array set self [list x $x0 x0 $x0 y $y0 x1 $x1 y1 $y1 c $c]
    set self(-font) $opt(-font)
    set self(dy) [font metrics $opt(-font) -linespace]
    interp alias {} $_self {} mjtext'do $_self
}

proc mjtext'do {_self cmd cmd2 args} {
    upvar #0 $_self self
    if {$cmd=="insert" && $cmd2=="end"} {
        foreach {text tag} $args {
            foreach line [split $text \n] {
                set ids {}
                foreach word [split $line] {
                    if {$word==""} continue
                    set id [$self(c) create text $self(x) $self(y) \
                      -anchor nw -text $word -font $self(-font)]
                    foreach {x0 y0 x1 y1} [$self(c) bbox $id] break
                    if {$x1 > $self(x1)} {
                        set dx [expr {$self(x0) - $x0}]
                        $self(c) move $id $dx $self(dy)
                        foreach {x0 y0 x1 y1} [$self(c) bbox $id] break
                        mjtext'justify $self(c) $ids $self(x1)
                        set ids {}
                    } else {lappend ids $id}
                    set self(x) [expr {$x1 + 1}]
                    set self(y) $y0
                }
                set self(x) $self(x0)
                set self(y) [expr {$self(y) + 2 * $self(dy)}]
            }
        }
    } else {error "usage: $self insert end text"}
}

proc mjtext'justify {c ids x1} {
    set last [lindex $ids end]
    set diff [expr {$x1 - [lindex [$c bbox $last] 2]}]
    set step [expr {double($diff)/([llength $ids]-1)}]
    for {set i [llength $ids]} {$i>1} {} {
        $c move [lindex $ids [incr i -1]] $diff 0
        set diff [expr {$diff-$step}]
    }
}

#----------- Test:

proc nl2flowtext s {
    # turn multiline text into flowtext, \n only on empty lines
    regsub -all {\n *\n} $s \x81 s ;# dummy char
    string map {\n " " \x81 \n} $s
}
pack [canvas .c -width 400 -height 410] -expand 1
set mj [mjtext .c 5 5 390 400]
$mj insert end [nl2flowtext $docu(mjtext)]

Disclaimer: Due to differing font metrics, Postscript output is produced, but not exactly flush right - mildly ragged instead. Hm - to reinvent TeX in a few hours is not that simple ;-)


Donal Fellows has an implementation for text widgets which uses blank images as spacers: