Ｐｅｒｌ／Ｔｋｘを使ったＧＵＩ

2019-09-02 きちんとしたPerl/Tkxを解説したサイトを見つけましたので、私のサイトを見るよりも是非こちらをご覧ください。 お気楽 Perl/Tkx 超入門

ＡｃｔｉｖｅＰｅｒｌでＧＵＩ付きのプログラムを作ろうとするとＴｋがなくてＴｋｘが入っています。 ＡｃｔｉｖｅＰｅｒｌの途中のバージョンでＴｋからＴｋｘに変わりました。 Ｔｋｘについて記述している日本語サイトはありません（重要）。
見てくださいこの惨状→perl "tkx" - Google 検索
その理由を想像してみると、最初にＴｋを解説しているサイトの人はＴｋで書いたスクリプトが多量にありＴｋｘに行かないし、そもそもＡｃｔｉｖｅＰｅｒｌ（Ｗｉｎｄｏｗｓ用）を使っていないのだろうと思います。 じゃあ後からの人達は？(・_・　)　(　・_・)

こんなサンプルを書いてみました。 このソースを元に処理を書き足せば良いんじゃないかな？

文字コードはＵＴＦ－８ね。

#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;
use open IO => ":utf8";

use Encode::Locale;
use Tkx;

binmode STDOUT, ":encoding(console_out)";

$| = 1;

my $mw = Tkx::widget->new(".");
menu_build($mw, [
	[ "ファイル", "F", [
		[ "メニューＡ...", "A", \&file_menu_a, ],
		[ "メニューＢ", "B", \&file_menu_b, ],
		[ "終了", "X", \&wm_delete_window, ],
	], ],
	[ "編集", "E", [
		[ "メニューＣ", "C", \&edit_menu_c, ],
		[ "メニューＤ...", "D", \&edit_menu_d, ],
		[ "メニューＥ", "E", \&edit_menu_e, ],
	], ],
	[ "設定", "P", [
		[ "メニューＦ...", "F", \&preferences_menu_f, ],
		[ "メニューＧ", "G", \&preferences_menu_g, ],
	], ],
]);

$mw->g_wm_title("サンプル１");
$mw->g_wm_minsize(500, 200);
$mw->g_wm_protocol(WM_DELETE_WINDOW => \&wm_delete_window);
$mw->g_wm_resizable(0, 0);

$mw->new_label(-text => "サンプル１")->g_pack(-anchor => "w");

sub my_msg($$) {
	my ($msg, $parent) = @_;
	if (!defined $parent) {
		$parent = $mw;
	}

	Tkx::tk___messageBox(
		-parent => $parent,
		-title => "メッセージ",
		-type => "ok",
		-icon => "info",
		-message => "$msg",
	);
}

Tkx::MainLoop();

exit;

sub file_menu_a {
	my_msg "メニューＡ", $mw;
}

sub file_menu_b {
	my_msg "メニューＢ", $mw;
}

sub edit_menu_c {
	my_msg "メニューＣ", $mw;
}

sub edit_menu_d {
	my_msg "メニューＤ", $mw;
}

sub edit_menu_e {
	my_msg "メニューＥ", $mw;
}

sub preferences_menu_f {
	my_msg "メニューＦ", $mw;
}

sub preferences_menu_g {
	my_msg "メニューＧ", $mw;
}

sub menu_build {
	my ($mainwindow, $tree) = @_;
	my $top = $mainwindow->new_menu;

	for (@$tree) {
		my $second = $top->new_menu( -tearoff => 0, );
		$top->add_cascade(
			-label => "${$_}[0](${$_}[1])",
			-underline => 1 + length ${$_}[0],
			-menu => $second,
		);
		for (@{${$_}[2]}) {
			my $label = ${$_}[0];
			my $label_after = "";
			my $underline = 1 + length ${$_}[0];
			if ($label =~ /\.\.\.$/) {
				$label =~ s/\.\.\.$//;
				$label_after = "...";
				$underline -= 3;
			}
			$label .= "(${$_}[1])$label_after";
			if ("CODE" eq ref ${$_}[2]) {
				$second->add_command(
					-label => $label,
					-underline => $underline,
					-command => ${$_}[2],
 				);
			} elsif ("SCALAR" eq ref ${$_}[2]) {
				$second->add_checkbutton(
					-label => $label,
					-underline => $underline,
					-variable => ${$_}[2],
					-offvalue => 0,
					-onvalue => 1,
 				);
			}
		}
	}

	$mainwindow->configure(-menu => $top);
}

sub wm_delete_window {
	$mw->g_destroy;
}