label text wrapped and aligned vertically

Difference between version 0 and 1 - Previous - Next
Labels are packed as table. 
The left column is fixed width, the right column wraps text when the window is resized.
Text in left column is top aligned.

======
 package require Tk
 catch {destroy {*}[winfo children .]}
 # create proc labeltext_wraps
 proc label_wrap {w font} {
   label $w -text 123 -width 1 -wraplength 3 -font $font
   set tags [font metrics [$w cget -font]]
   set pix_per_line [dict get [font metrics [$w cget -font]] -linespace]
   set h [winfo reqheight $w]
   set offset [expr {$h - 3*$pix_per_line}]
   list proc labeltext_wraps w "expr {((\[winfo reqheight \$w\]-$offset)/$pix_per_line)-1}"
 }
 proc resize_label {label_source label_dest} {   set w [winfo width .]
   # borderwidth
   set w [expr {$w-8}]
   set x [font measure {"Noto Mono" 20} w]
   set numchars [expr {$w/$x}]
   set wraps [labeltext_wraps $label_source]
   #puts "$label_source has $wraps wraps"
   set text [$label_dest cget -text]
   set head [regsub {\n*$} $text {}]
   append head [string repeat \n $wraps]
   $label_dest configure -text $head
   return
 }
 proc rewrap {} {
   set w [winfo width .k._c.col1]
   .k._c.col1.row0.text0 configure -wraplength $w
   .k._c.col1.row1.text1 configure -wraplength $w
   resize_label .k._c.col1.row0.text0 .k.col0.actor0
   resize_label .k._c.col1.row1.text1 .k.col0.actor1
 }
 # text source: http://www.karl-valentin.de/valentin/anekdoten.htm
 # purpose: align labels when wraplength changes
 # resize the window 
 set initial_width 300
 #. frame .k avoids gap between col0, col1
 frame .k -bg {}
 frame .k.col0 -bg {}
 set s0 "A man spoke to Valentin:"
 set s1 "      Then the comedian:"
 label .k.col0.actor0 -text $s0 -justify right -font {{Noto Mono} 20} -bg bisque -bd 4
 label .k.col0.actor1 -text $s1 -justify right -font {{Noto Mono} 20} -bg bisque -bd 4
 pack .k.col0.actor0 .k.col0.actor1 -side top -expand 1 -fill y -anchor e
 # required to get left alignment where text is centered when not wrapped
 frame .k._c -bg {}
 frame .k._c.col1 -bg {}
 # frame row required, to have text justified left, frame fill takes the rest
 frame .k._c.col1.row0 -bg {} ;#blue
 label .k._c.col1.row0.text0 -text "\"You, something occurs to me that I've wanted to ask you for a long time.\"" -justify left -wraplength $initial_width -bg aliceblue -font {Symbola 20} -bd 4
 frame .k._c.col1.row0.fill -bg pink
 pack .k._c.col1.row0.text0 -side left -fill y -expand 1 -anchor w
 pack .k._c.col1.row0.fill -side right -fill both -expand 1 -anchor e
 pack .k._c.col1.row0 -side top -fill both -expand 1
 
 frame .k._c.col1.row1 -bg {} ;#blue
 label .k._c.col1.row1.text1 -text "\"Just ask, I've wanted to answer that for a long time.\"" -justify left -wraplength $initial_width -bg aliceblue -font {Symbola 20} -bd 4
 frame .k._c.col1.row1.fill -bg pink
 pack .k._c.col1.row1.text1 -side left -fill y -expand 1 -anchor w
 pack .k._c.col1.row1.fill -side right -fill both -expand 1 -anchor e
 pack .k._c.col1.row1 -side top -fill both -expand 1
 
 pack .k.col0 -side left -fill y -expand 1
 pack .k._c.col1 -side left -fill both -expand 1 -anchor w
 pack .k._c -side left -fill both -expand 1 -anchor w
 pack .k -fill both -expand 1
 
 set dproc [label_wrap .invisible {Symbola 20}]
 # generate proc labeltext_wraps
 #puts dproc=<$dproc>
 eval $dproc
 bind .k._c.col1 <Configure> {after 300 rewrap}
 wm title . "Short Question"

======