在 Mac 上使用 Perl 和 Ttk 闪烁 GUI 按钮

Question

使用 Perl v5.28，Tkx.pm v1.10 ActiveState Tcl/TTk v8.6.9（'aqua' 样式），在 macOS v10.13.6 上。这下面的演示按需要工作，启用给定的调用使用鼠标按下 GUI 按钮或使用使用 'normal' 文本字符的键盘输入。

我想要的一个附加功能是视觉反馈图形按钮被按下（闪烁）时键盘使用替代激活。我找到了看起来像 Tcl 的东西使用事件的解决方案生成命令，以及使用 Perl 的参考 Tkx::event_generate() 虚拟事件方法调用。我什至找到了等效的 Perl Tkx::after(100) 函数调用以创建建议的延迟。但是我我不知道如何将所有这些放在一起以实现想要的效果。任何帮助将不胜感激，理解与其他一些 TTk 功能一样，这可能不适用于 Mac.

代码

#!/usr/bin/env perl
# -*- cperl -*-

use warnings;
use strict;
use Tkx; $Tkx::TRACE = 1;
my $mw = Tkx::widget->new(".");
$mw->g_wm_geometry('200x200+100+100');

my $l = $mw->new_ttk__label
  (
    -text => ("Button Test Ttk v" . Tkx::info("patchlevel"))
  );

sub greeting { print(STDERR "--> [ Hello, world ] pressed\n") }

my $b = $mw->new_ttk__button
  (
         -text => "Hello, world",
    -underline => 0,
      -command => sub { greeting() }
  );

$mw->g_bind('<h>', sub { $b->invoke() });
$mw->g_bind('<H>', sub { $b->invoke() });
$l->g_pack();
$b->g_pack();
Tkx::MainLoop();

print(STDERR "Program exit...\n");

运行日志

Tkx-1-0.0s-demo-12: wm geometry . 200x200+100+100
Tkx-2-0.0s-demo-14: info patchlevel
Tkx-3-0.0s-demo-14: winfo children .
Tkx-4-0.0s-demo-14: ttk::label .l -text {Button Test Ttk v8.6.9}
Tkx-5-0.0s-demo-26: winfo children .
Tkx-6-0.0s-demo-26: ttk::button .b -text {Hello, world} -underline 0 -command perl::callback
Tkx-7-0.0s-demo-28: bind . <h> perl::callback
Tkx-8-0.0s-demo-29: bind . <H> perl::callback
Tkx-9-0.0s-demo-30: pack .l
Tkx-10-0.0s-demo-31: pack .b
--> [ Hello, world ] pressed
Tkx-11-6.4s-demo-28: .b invoke
--> [ Hello, world ] pressed
Tkx-12-7.9s-demo-29: .b invoke
--> [ Hello, world ] pressed
Program exit...

Answer 1

这是一个示例（在 Ubuntu 21.04 上测试）。通过在按钮上调用 g_event_generate("<ButtonPress-1>")，将在按钮上自动调用 invoke()：

use feature qw(say);
use strict;
use warnings;
use Tkx;
my $mw = Tkx::widget->new(".");
$mw->g_wm_geometry('200x200+100+100');

my $l = $mw->new_ttk__label(
    -text => ("Button Test Ttk v" . Tkx::info("patchlevel"))
);

sub greeting { say "--> [ Hello, world ] pressed"; }

my $b = $mw->new_ttk__button(
    -text      => "Hello, world",
    -underline => 0,
    -command   => sub { greeting() }
);
sub generate_button_click_event {
    $b->g_event_generate("<ButtonPress-1>");
    Tkx::after(
        200, sub {
            $b->g_event_generate("<ButtonRelease-1>");
        }
    );
}

$mw->g_bind('<h>', sub { generate_button_click_event() });
$mw->g_bind('<H>', sub { generate_button_click_event() });
$l->g_pack();
$b->g_pack();
Tkx::MainLoop();
say "Program exit...";

在 Mac 上使用 Perl 和 Ttk 闪烁 GUI 按钮

Flashing a GUI button using Perl & Ttk on a Mac

perl

tkx