Hello friend Monks;
Hacking Perl/Tk is, or can be, challenging, depending on so many factors, least of which is the totally confusing documentation. Many changes and improvements to Tk are poorly documented, with limited examples, and tutorials are rudimentary. I'd like to see a 2nd ed of "Mastering Perl/Tk" that updates Tkx, ttk and themes, but it seems Python, as ugly as it is, has eclipsed Perl. If I were younger I'd take a stab at writing a successor to that otherwise fine book. Not being one to give up easily, here be a working Tkx program that implements an improved font viewer that permits changing a named font dynamically. This works for classic widgets rather than themed widgets, but in this example I chose to mix classic and ttk widgets, just to prove a point. The key, of course, is using a named font. Comments, please?
#!/usr/bin/env -S perl ##!/usr/bin/env -S perl -d use warnings; use strict; use v5.36; use Tkx qw/MainLoop/; # can import many more widgets: syntactic +sugar my $mw = Tkx::widget->new(".",); $mw->g_wm_title( 'Tkx/ttk Font Viewer',); $mw->g_wm_minsize(320, 200); my $f = $mw->new_ttk__frame(); my $_lab0 = $f->new_label(-text => 'Families', -width => 16, -font => 'courier', ); my $_lab1 = $f->new_label(-text => 'Size ', -width => 10, -font => 'courier', ); # # Defaults # my $family = 'Helvetica'; my $weight = 'normal'; my $slant = 'roman'; my $size = 14; my $underline = 'off'; my $overstrike = 'off'; my $cbox1 = $f->new_ttk__combobox( -values => [3 .. 32], -textvariable => \$size, -width => '6', -height => '10', ); # # Remove duplicate font names # my %fonts; my @fonts; foreach ( Tkx::SplitList( Tkx::font_families() )) { # say $_; push (@fonts, $_) unless $fonts{$_}++; } my $cbox0 = $f->new_ttk__combobox( -values => [ sort @fonts ], -textvariable => \$family, -height => '20', # number of rows to display ); my $_bQuit = $f->new_button( # classic button #my $_bQuit = $f->new_ttk__button( # themed (Aqua) button; '__' == ': +:' -text => 'Quit', -relief => 'raised', -width => 10, -command => sub { Tkx::destroy("."); } ); # # Let's create a named font from defaults... # my $fontName = Tkx::font_create('PerlboysNewFont', -family => $family, #my $fontName = $mw->Tkx::font_create( -family => $family, -size => $size, -weight => $weight, -slant => $slant, -underline => $underline, -overstrike => $overstrike, ); say $fontName; say "Named fonts: ${\Tkx::font_names()}"; # # Here be how we change the named font dynamically... # my $apply_font = sub { say "Font selected: '$family' $size $weight $slant $underline $ove +rstrike"; $fontName->Tkx::font_configure( -family => $family, -size => $size, -weight => $weight, -slant => $slant, -underline => $underline, -overstrike => $overstrike, ); }; $cbox0->Tkx::bind('<<ComboboxSelected>>', $apply_font ); $cbox1->Tkx::bind('<<ComboboxSelected>>', $apply_font ); my $stext = "Sample Text, ABCDEFghijkl, 1234567890"; my $sample = $f->new_tk__entry(-textvariable => \$stext, -width => '38', -relief => 'sunken', -font => $fontName, # the point is to use the named font :-) ); my $_cbWgt = $f->new_tk__checkbutton( -onvalue => 'bold', -offvalue => 'normal', -text => 'Weight', -variable => \$weight, -command => $apply_font, ); my $_cbSlant = $f->new_tk__checkbutton( -onvalue => 'italic', -offvalue => 'roman', -text => 'Slant', -variable => \$slant, -command => $apply_font, ); my $_cbUL = $f->new_tk__checkbutton( -text => 'Underline', -onvalue => 'on', -offvalue => 'off', -variable => \$underline, -command => $apply_font, ); my $_cbOverStrk = $f->new_tk__checkbutton( -text => 'Overstrike', -onvalue => 'on', -offvalue => 'off', -variable => \$overstrike, -command => $apply_font, ); Tkx::grid("$f"); Tkx::grid("$_lab0", "$_lab1", -sticky => 'ew',); Tkx::grid("$cbox0", "$cbox1", -sticky => 'ew', -ipadx => '2', -ipady => '4', -padx => 5, -pady => 5,); Tkx::grid("$_cbWgt", "$_cbSlant", -sticky => 'ew',); Tkx::grid("$_cbUL", "$_cbOverStrk", -sticky => 'ew',); Tkx::grid("$sample", -columnspan => '2', -ipadx => '2', -ipady => '4', -padx => 5, -pady => 5,); Tkx::grid("$_bQuit", '-',); MainLoop; say "Here be the place to perform any post-MainLoop processing..."; exit(0); __END__
Happy New Year, one and all. Perhaps this one will be better than the last, which was awful... The four horsemen are winning.
U P D A T E: 01/01/2024
The code as posted works but there is a subtle semantic error that compromises the robustness and scalability of the examples, specifically re the creation of a named font. The code
my $fontName = $mw->Tkx::font_create( -family => $family,
yields a named font named '.'. This because the call to 'Tcl font create', 'Tkx::' becomes 'Tcl ', was from $mw. In essence, the create step used the Tcl pathName of the main window to name the new font. If you then try to create a second named font Tcl will attempt to also name it '.', which will result in a fatal error. The correct way to create a named font in Tkx with a unique name is:
my $fontName = Tkx::font_create('PerlboysNewFont', -family => $family,
If you then interrogate the list of named fonts with:
say $fontName; say "Named fonts: ${\Tkx::font_names()}";
you will see in macOS something like:
PerlboysNewFont Named fonts: TkCaptionFont PerlboysNewFont TkSmallCaptionFont TkTooltipFont TkFixedFont TkHeadingFont TkMenuFont TkIconFont TkTextFont TkDefaultFont
I have taken the liberty of correcting the posted code for those who may download it in the future.
Will
In reply to Re^2: Tk -font options configuration failing
by perlboy_emeritus
in thread Tk -font options configuration failing
by perlboy_emeritus
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |