Canvas microjustification
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: