#!/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 $overstrike";
    $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__

##</code><code>##

my $fontName = $mw->Tkx::font_create( -family => $family,

##</code><code>##

my $fontName = Tkx::font_create('PerlboysNewFont', -family => $family,

##</code><code>##

say $fontName;
say "Named fonts: ${\Tkx::font_names()}";