[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 [http://www.man.ac.uk/~zzcgudf/tcl/wordwrap.tcl%|%implementation] for text widgets which uses blank images as spacers: <> Arts and crafts of Tcl-Tk programming | Category Text Processing