Version 0 of label text wrapped and aligned vertically

Updated 2021-01-27 11:36:57 by fr

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"