アナログ時計
それでは簡単な例題として、リサイズ可能なアナログ時計を作ってみましょう。今回は、時計をウィンドウいっぱいに広げて描画することにします。楕円の長径を a、短径を b、媒介変数を t とすると、楕円は以下の式で表すことができます。
x = a * cos(t)
y = b * sin(t)
0 <= t < 2π
キャンバスウィジェットに長針、短針、秒針を描き、1 秒ごとに針の位置を動かします。針の位置は上記の式で計算します。短針は動きを滑らかにするために、1 分ごとに位置を動かします。したがって、短針を動かす角度は 360 / (12 * 60) = 0.5 度となります。
●after
今回はユーザからの入力がなくても時計を動かさないといけなので、単純なイベント駆動型アプリケーションでは「時計」を実現することはできません。このため、プログラム自身でなんらかのきっかけを作ってやる必要があります。このような場合、Tcl/Tk で使用するコマンドが after です。Tkx では関数 after を使います。
- Tkx::after(msec)
指定された時間 (単位は msec) だけ待つ
- Tkx::after(msec, command)
指定した時間経過後 command を実行 (固有番号 id を返す)
- Tkx::after_cancel(id)
固有番号 id の command 実行待ちを取り消す
このように、after には単純な時間待ちを行うほかに、一定時間後に指定した command を起動するタイマーの働きも持っています。たとえば、一定間隔で実行する関数を foo としましょう。この場合、foo の最後で after を使って自分自身の起動を設定すればいいのです。具体的には次のようにプログラムします。
sub foo {
# foo の処理
.....
Tkx::after(500, \&foo);
}
これで 500 msec 後に foo が実行されます。もっとも、厳密に 500 msec ごとに foo が実行されるわけではありません。foo の処理にも時間がかかりますし、Windows はマルチタスクで動作しているので、ほかのタスクの影響も受けるからです。まあ、厳密なリアルタイム処理は必要としないので、これで十分です。
●画面の設定
最初に画面を設定します。ウィンドウが小さくなると時計がよく見えないので、ウィンドウの大きさを制限します。これはメソッド minsize() と maxsize() で設定することができます。幅と高さはピクセル単位で指定します。次のリストを見てください。
リスト : 画面の設定
# グローバル変数
my $width = 140;
my $height = 140;
my @sin_table;
my @cos_table;
my @backboard;
# メインウィンドウ
my $top = Tkx::widget->new('.');
$top->g_wm_title('時計');
$top->g_wm_minsize(140, 140);
$top->g_wm_maxsize(500, 500);
# キャンバス
my $c0 = $top->new_canvas(-width => 140, -height => 140, -bg => 'gray');
$c0->g_pack(-expand => 1, -fill => 'both');
# 図形の生成
my $circle = $c0->create_oval(5, 5, 135, 135, -fill => 'gray80');
for (my $i = 0; $i < 60; $i++) {
my $w;
if ($i % 5 == 0) {
$w = 2.0;
} else {
$w = 1.0;
}
$backboard[$i] = $c0->create_line($i, $i, 135, 135, -width => $w);
}
my $hour = $c0->create_line(70, 70, 70, 30, -fill => 'blue', -width => 3.0);
my $min = $c0->create_line(70, 70, 70, 20, -fill => 'green', -width => 2.0);
my $sec = $c0->create_line(70, 70, 70, 15, -fill => 'red');
ウィンドウの大きさは、幅と高さを 140 から 500 ピクセルの範囲に制限します。背景の円と目盛を表す図形は、変数 $circle と配列 @backboard に格納します。針を表す図形は変数 $hour, $min, $sec に格納します。ここは図形を生成するだけなので、位置はでたらめでもかまいません。
●ウィンドウの再描画
さて、問題はウィンドウがリサイズされた場合です。ここで発生するイベントが Configure です。このイベントをバインドして、ウィンドウの大きさが変わったら時計を再描画すればいいわけです。バインドはメインウィンドウに対して設定すれば大丈夫です。
$top->g_bind("<Configure>", \&change_size);
キャンバスウィジェットは -fill と -expand を設定して g_pack されているので、ウィンドウの大きさが変わると、キャンバスの大きさも変わります。詳しい説明は拙作のページ ウィンドウのリサイズ をお読みくださいませ。このときに Configure イベントを受け取るので、時計の大きさを変える関数 change_size を実行します。
キャンバスウィジェットの大きさですが、これは cget メソッドでは求めることができません。実際、ウィンドウがリサイズされキャンバスウィジェットが引き伸ばされても、最初に設定されたオプションの値そのままになっています。キャンバスウィジェットの大きさを求めるには、ウィジェットの情報を取得する関数 winfo_width と winfo_height を使います。change_size は次のようになります。
リスト : 大きさの変更
sub change_size {
$width = $c0->g_winfo_width;
$height = $c0->g_winfo_height;
&draw_backboard();
&draw_hand();
}
$width と $height は時計の大きさを表す変数で、キャンバスと同じ大きさに初期化しておきます。キャンバスの幅と高さを求め、それらの値を $width と $height にセットします。
図形の配置は背景を関数 draw_backboard で、針を関数 draw_hand で行います。これらの関数は $width と $height にセットされた大きさに合わせて時計を描画します。描画は coords メソッドで図形を移動させるだけです。針を動かす関数 draw_hand は次のようになります。
リスト : 針の描画
sub draw_hand {
my ($s, $m, $ht) = localtime(time);
my $w = $width / 2;
my $h = $height / 2;
my ($x, $y, $n);
# 秒
$n = $s * 12;
$x = $w + $w * $sin_table[$n] * 7 / 8;
$y = $h - $h * $cos_table[$n] * 7 / 8;
$c0->coords($sec, $w, $h, $x, $y);
# 分
$n = $m * 12;
$x = $w + $w * $sin_table[$n] * 6 / 8;
$y = $h - $h * $cos_table[$n] * 6 / 8;
$c0->coords($min, $w, $h, $x, $y);
# 時
$n = ($ht < 12 ? $ht : $ht - 12) * 60 + $m;
$x = $w + $w * $sin_table[$n] * 4 / 8;
$y = $h - $h * $cos_table[$n] * 4 / 8;
$c0->coords($hour, $w, $h, $x, $y);
}
関数 localtime で現在時刻を求めます。それから、あらかじめ計算しておいた三角関数表 @sin_table と @cos_table を使って座標を計算し、メソッド coords で針を移動させます。関数 draw_backboard も簡単なので説明は割愛いたします。詳細は プログラムリスト をお読みください。
●時計を動かす
あとは after メソッドを使って、１秒ずつ針を動かします。
# 表示
sub show_time {
&draw_hand();
Tkx::after(1000, \&show_time);
}
関数 show_time は draw_hand を呼び出して針を描画し、1 秒後に show_time を呼び出すよう after メソッドで設定します。最後に show_time を実行すれば、1 秒ごとに短針が動き、時計が動作します。
最小サイズ
ウィンドウを横に伸ばす
ウィンドウを縦に伸ばす
最大サイズ
これで、リサイズ可能なアナログ時計を作ることができました。シンプルな時計なので、少々物足りないかもしれません。興味のある方は、プログラムを改造してみてください。
●プログラムリスト
#
# clock.pl : アナログ時計
#
# Perl/Tkx サンプルプログラム
#
# Copyright (C) 2019 Makoto Hiroi
#
use strict;
use warnings;
use utf8;
use Tkx;
# グローバル変数
my $width = 140;
my $height = 140;
my @sin_table;
my @cos_table;
my @backboard;
# メインウィンドウ
my $top = Tkx::widget->new('.');
$top->g_wm_title('時計');
$top->g_wm_minsize(140, 140);
$top->g_wm_maxsize(500, 500);
# キャンバス
my $c0 = $top->new_canvas(-width => 140, -height => 140, -bg => 'gray');
$c0->g_pack(-expand => 1, -fill => 'both');
# 図形の生成
my $circle = $c0->create_oval(5, 5, 135, 135, -fill => 'gray80');
for (my $i = 0; $i < 60; $i++) {
my $w;
if ($i % 5 == 0) {
$w = 2.0;
} else {
$w = 1.0;
}
$backboard[$i] = $c0->create_line($i, $i, 135, 135, -width => $w);
}
my $hour = $c0->create_line(70, 70, 70, 30, -fill => 'blue', -width => 3.0);
my $min = $c0->create_line(70, 70, 70, 20, -fill => 'green', -width => 2.0);
my $sec = $c0->create_line(70, 70, 70, 15, -fill => 'red');
# データの初期化
sub init_data {
foreach my $i (0 .. 719) {
my $rad = 3.14 / 360 * $i;
$sin_table[$i] = sin($rad);
$cos_table[$i] = cos($rad);
}
}
# 背景の描画
sub draw_backboard {
my $i;
my $w = $width / 2;
my $h = $height / 2;
# 円
$c0->coords($circle, 5, 5, $width - 5, $height - 5);
# 目盛
for (my $i = 0; $i < 60; $i++) {
my $n = $i * 12;
my $l;
if ($n % 5 == 0) {
$l = 0.9;
} else {
$l = 0.95;
}
my $x1 = $w + ($w - 5) * $sin_table[$n];
my $y1 = $h + ($h - 5) * $cos_table[$n];
my $x2 = $w + ($w - 5) * $l * $sin_table[$n];
my $y2 = $h + ($h - 5) * $l * $cos_table[$n];
$c0->coords($backboard[$i], $x1, $y1, $x2, $y2);
}
}
# 針を描く
sub draw_hand {
my ($s, $m, $ht) = localtime(time);
my $w = $width / 2;
my $h = $height / 2;
my ($x, $y, $n);
# 秒
$n = $s * 12;
$x = $w + $w * $sin_table[$n] * 7 / 8;
$y = $h - $h * $cos_table[$n] * 7 / 8;
$c0->coords($sec, $w, $h, $x, $y);
# 分
$n = $m * 12;
$x = $w + $w * $sin_table[$n] * 6 / 8;
$y = $h - $h * $cos_table[$n] * 6 / 8;
$c0->coords($min, $w, $h, $x, $y);
# 時
$n = ($ht < 12 ? $ht : $ht - 12) * 60 + $m;
$x = $w + $w * $sin_table[$n] * 4 / 8;
$y = $h - $h * $cos_table[$n] * 4 / 8;
$c0->coords($hour, $w, $h, $x, $y);
}
# 大きさの変更
sub change_size {
$width = $c0->g_winfo_width;
$height = $c0->g_winfo_height;
draw_backboard();
draw_hand();
}
# 表示
sub show_time {
draw_hand();
Tkx::after(1000, \&show_time);
}
# バインディング
$top->g_bind("<Configure>", \&change_size);
# データの初期化
init_data();
# 最初の起動
draw_backboard();
show_time();
# メインループ
Tkx::MainLoop();
簡単なプログラム
●ワーム
A. K. デュードニー 著「別冊 日経サイエンス コンピューターレクリエーション３ 遊びの発見」 より、 ワーム（ミミズ）のグラフィックです。本では１匹のミミズしか登場しませんが、 このプログラムではミミズを４匹に増やしました。 ミミズは円を連結しているだけの簡単なグラフィックなので、 すぐに飽きると思います。 ミミズの数を増やすとか色や形を変えるなど、プログラムを改造して遊んでみてください。
●プログラムリスト
#
# worms.pl : ワーム
#
# Copyright (C) 2019 Makoto Hiroi
#
use strict;
use warnings;
use Tkx;
my $top = Tkx::widget->new('.');
$top->g_wm_title('Worms');
my $board_size = 300;
my $c0 = $top->new_canvas(-width => $board_size, -height => $board_size, -bg => 'darkgray');
$c0->g_pack;
# ワームの体を作る
sub make_body {
my $color = shift;
my $body = [];
my $x = $board_size / 2;
for (my $i = 0; $i < 25; $i++) {
my $id = $c0->create_oval($x, $x, $x + 10, $x + 10, -outline => $color);
$body->[$i] = $id;
}
$body;
}
# ワームを作る
sub make_worm {
my $color = shift;
my $worm = {
'body' => make_body($color),
'x' => $board_size / 2,
'y' => $board_size / 2,
'dir' => 0,
'tail' => 0,
};
$worm;
}
# 移動
sub move_worm {
my $worm = shift;
$worm->{'tail'} = ($worm->{'tail'} + 1) % 25;
if (rand() > 0.5) {
$worm->{'dir'} += 0.18;
} else {
$worm->{'dir'} -= 0.18;
}
my $x = $worm->{'x'};
$x += sin($worm->{'dir'}) * 4.0;
if ($x < 0) {
$x += $board_size;
} elsif ($x >= $board_size) {
$x -= $board_size;
}
$worm->{'x'} = $x;
my $y = $worm->{'y'};
$y += cos($worm->{'dir'}) * 4.0;
if ($y < 0) {
$y += $board_size;
} elsif ($y >= $board_size) {
$y -= $board_size;
}
$worm->{'y'} = $y;
my $body = $worm->{'body'};
$c0->coords($body->[$worm->{'tail'}], $x, $y, $x + 10, $y + 10);
}
my $worm1 = make_worm('red');
my $worm2 = make_worm('blue');
my $worm3 = make_worm('yellow');
my $worm4 = make_worm('green');
# 表示
sub show_worm {
move_worm($worm1);
move_worm($worm2);
move_worm($worm3);
move_worm($worm4);
Tkx::after(30, \&show_worm);
}
show_worm();
Tkx::MainLoop();
●ライフゲーム
ライフゲームは 1970 年にイギリスの数学者コンウェイ氏が考案したシミュレーションゲームです。格子状に並んだマス (セル) で生命を表し、周りのセルの状態で生命が誕生したり死滅したりします。以下に規則を示します。
- 生命がいないセル
- 周囲に生命がいるセルが 3 つあれば、新しい生命が誕生する
- それ以外は変化しない
- 生命がいるセル
- 周囲に生命がいるセルが 1 つ以下 (過疎) のときは死滅する
- 周囲に生命がいるセルが 4 つ以上 (過密) のときは死滅する
- 周囲に生命が 2 つまたは 3 つあるときは存続する
- 操作方法
- Start: ゲームの開始 (または再開)
- Stop: ゲームの停止
- Clear: ゲームの初期化
- Rand: 生命をランダムに配置する
今回のゲームでは黄色の四角形で生きている生命を表しています。ゲームを停止しているとき、マウスの左クリックで生命を追加したり取り除くことができます。
生命をランダムに配置
途中経過
定常状態
●プログラムリスト
#
# lifegame.pl : ライフゲーム
#
# Copyright (C) 2019 Makoto Hiroi
#
use strict;
use warnings;
use utf8;
use Tkx;
my $line = 40;
my $column = 60;
my $game_id = '';
my $buff = ''; # ラベルのバッファ
my $top = Tkx::widget->new('.');
$top->g_wm_title('LifeGame');
# ラベル
my $l0 = $top->new_label(-textvariable => \$buff);
$l0->g_pack;
# キャンバス
my $c0 = $top->new_canvas(-width => $column * 10, -height => $line * 10);
my $backboard = $c0->create_rectangle(0, 0, $column * 10, $line * 10, -fill => 'darkgray', -tags => 'back');
$c0->g_pack;
my $generation = 0; # 世代数
my $cells = []; # セルを表す図形 ID を格納
my $world1 = []; # 0: 死, 1: 生
my $world2 = [];
# 世代を進める
sub next_gen {
for (my $y = 0; $y < $line; $y++) {
for (my $x = 0; $x < $column; $x++) {
my $c = 0;
# 生きているセルをカウント
foreach my $d ([-1, -1], [0, -1], [1, -1], [-1, 0], [1, 0], [-1, 1], [0, 1], [1, 1]) {
my $x1 = $x + $d->[0];
my $y1 = $y + $d->[1];
if (0 <= $x1 && $x1 < $column && 0 <= $y1 && $y1 < $line) {
$c += $world1->[$y1][$x1];
}
}
if ($world1->[$y][$x] == 0) {
if ($c == 3) {
$world2->[$y][$x] = 1; # 誕生
$c0->raise($cells->[$y][$x], 'back');
} else {
$world2->[$y][$x] = 0;
}
} else {
if ($c <= 1 || $c >= 4) {
$world2->[$y][$x] = 0; # 過疎または過密
$c0->lower($cells->[$y][$x], 'back');
} else {
$world2->[$y][$x] = 1; # 存続
}
}
}
}
}
# セルの生成
sub make_cell {
my ($x, $y) = @_;
my $x1 = $x * 10;
my $y1 = $y * 10;
$c0->create_rectangle($x1, $y1, $x1 + 10, $y1 + 10, -fill => 'yellow', -tags => 'cell');
}
for (my $y = 0; $y < $line; $y++) {
my $c1 = [];
my $w1 = [];
my $w2 = [];
for (my $x = 0; $x < $column; $x++) {
push @$c1, make_cell($x, $y);
push @$w1, 0;
push @$w2, 0;
}
push @$cells, $c1;
push @$world1, $w1;
push @$world2, $w2;
}
# 乱数による初期化
sub init_game {
if (!$game_id) {
for (my $y = 0; $y < $line; $y++) {
for (my $x = 0; $x < $column; $x++) {
if (rand() <= 0.2) {
$world1->[$y][$x] = 1;
$c0->raise($cells->[$y][$x], 'back');
} else {
$world1->[$y][$x] = 0;
$c0->lower($cells->[$y][$x], 'back');
}
}
}
}
}
# ゲームの進行を表示する
sub show_game {
next_gen();
($world1, $world2) = ($world2, $world1);
$generation += 1;
$buff = sprintf("%d 世代", $generation);
$game_id = Tkx::after(300, \&show_game);
}
# ゲームの開始
sub start_game {
if (!$game_id) {
show_game();
}
}
# ゲームの停止
sub stop_game {
if ($game_id) {
Tkx::after_cancel($game_id);
$game_id = '';
}
}
# ゲームのクリア
sub clear_game {
if (!$game_id) {
for (my $y = 0; $y < $line; $y++) {
for (my $x = 0; $x < $column; $x++) {
$world1->[$y][$x] = 0;
}
}
$c0->lower('cell', 'back');
$generation = 0;
$buff = '';
}
}
# マウスによる入力
sub click {
my ($x1, $y1) = @_;
if (!$game_id) {
my $x = ($x1 / 10) % $column;
my $y = ($y1 / 10) % $line;
$world1->[$y][$x] ^= 1;
if ($world1->[$y][$x]) {
$c0->raise($cells->[$y][$x], 'back');
} else {
$c0->lower($cells->[$y][$x], 'back');
}
}
}
# バインディング
$c0->bind('back', "<Button-1>", [\&click, Tkx::Ev('%x', '%y')]);
$c0->bind('cell', "<Button-1>", [\&click, Tkx::Ev('%x', '%y')]);
# メニューバー
my $m = $top->new_menu;
$top->configure(-menu => $m);
$m->add_command(-label => "Start", -underline => 0, -command => \&start_game);
$m->add_command(-label => "Stop", -underline => 0, -command => \&stop_game);
$m->add_command(-label => "Clear", -underline => 0, -command => \&clear_game);
$m->add_command(-label => "Rand", -underline => 0, -command => \&init_game);
# 初期化
clear_game();
Tkx::MainLoop();
●15 Puzzle
皆さんお馴染みの 15 パズルです。レベルは Easy, Normal, Hard の三段階あります。Easy は最長でも 25 手、Normal は 50 手、Hard は 75 手で解くことができます。乱数で駒を動かしているので、実際にはそれよりも短い手数で解くことができると思います。
ゲーム開始 
103 手で解けた
●プログラムリスト
#
# fifteen.pl : 15 パズル
#
# Copyright (C) 2019 Makoto Hiroi
#
use strict;
use warnings;
use utf8;
use Tkx;
use List::Util ('all', 'first');
# 隣接リスト
my @adjacent = (
[1, 4], # 0
[0, 2, 5], # 1
[1, 3, 6], # 2
[2, 7], # 3
[0, 5, 8], # 4
[1, 4, 6, 9], # 5
[2, 5, 7, 10], # 6
[3, 6, 11], # 7
[4, 9, 12], # 8
[5, 8, 10, 13], # 9
[6, 9, 11, 14], # 10
[7, 10, 15], # 11
[8, 13], # 12
[9, 12, 14], # 13
[10, 13, 15], # 14
[11, 14] # 15
);
# 駒の色
my @piece_color = (
'white',
'deep sky blue',
'sky blue',
'light sky blue',
'gold2',
'deep pink',
'hot pink',
'pink',
'gold3',
'sea green',
'medium sea green',
'light sea green',
'gold4',
'dark salmon',
'salmon',
'light salmon'
);
# 完成形
my @goal = (
1, 2, 3, 4,
5, 6, 7, 8,
9, 10, 11, 12,
13, 14, 15, 0,
);
# メインウィンドウ
my $top = Tkx::widget->new('.');
$top->g_wm_title('15 Puzzle');
Tkx::option_add("*tearOff", 0);
# グローバル変数
my $level = 0; # Easy = 0, Normal = 1, Hard = 2
my $buff = ''; # ラベルのバッファ
my $moves = 0; # 手数
my $gameflag = 0; # ゲーム中ならば 1
my @min_moves = (999, 999, 999);
my @shuffle_count = (25, 50, 75);
# 手数表示用ラベル
my $la = $top->new_label(-textvariable => \$buff, -font => ['', 14]);
$la->g_pack;
# 盤面を表示するためのキャンバス
my $c0 = $top->new_canvas(-width => 220,- height => 220, -bg => 'brown4');
$c0->create_rectangle(9, 9, 210, 210, -fill => 'black');
$c0->g_pack;
# 盤面
my @board = ();
# 駒
my @piece = ('');
# 手数の表示
sub show_moves {
my $m = shift;
$buff = sprintf("手数: %3d 記録: %3d ", $m, $min_moves[$level]);
}
# 駒の移動
sub move_piece {
return if (!$gameflag);
my $n = shift;
my $z = first { $board[$_] == $n } (0 .. $#board);
my $a = $adjacent[$z];
my $s = first { $board[$_] == 0 } @$a;
if (defined $s) {
my $x = $s % 4;
my $y = int($s / 4);
$board[$s] = $n;
$board[$z] = 0;
$c0->coords($piece[$n], $x * 50 + 35, $y * 50 + 35);
$moves++;
show_moves($moves);
if (all {$board[$_] == $goal[$_]} (0 .. $#board)) {
Tkx::tk___messageBox(-type => 'ok', -icon => 'info', -title => 'Good Job!',
-message => 'おめでとうございます');
if ($min_moves[$level] > $moves) {
$min_moves[$level] = $moves;
show_moves($moves);
$gameflag = 0;
}
}
}
}
# ゲームの開始
sub start_game {
my $move = [0];
$moves = 0;
$gameflag = 1;
show_moves($moves);
@board = @goal;
my $s = 15;
my $c = 0;
while ($c < $shuffle_count[$level]) {
my $a = $adjacent[$s];
my $d = $a->[int(rand(scalar(@$a)))];
my $p = $board[$d];
if ($p != $move->[-1]) {
$board[$s] = $p;
$board[$d] = 0;
push @$move, $p;
$s = $d;
$c++;
}
}
foreach my $i (0 .. $#board) {
if ($board[$i] != 0) {
my $x = $i % 4;
my $y = int($i / 4);
$c0->coords($piece[$board[$i]], $x * 50 + 35, $y * 50 + 35);
}
}
}
#
# 盤面
#
# 駒の生成
for (my $i = 1; $i < 16; $i++) {
my $x = ($i - 1) % 4;
my $y = int(($i - 1) / 4);
my $la = $top->new_label(-text => "$i", -bg => $piece_color[$i], -fg => 'white', -font => ['', 24]);
$la->g_bind('<Button-1>', [\&move_piece, $i]);
my $id = $c0->create_window($x * 50 + 35, $y * 50 + 35, -window => $la, -width => 48, -height => 48);
$piece[$i] = $id;
}
#
show_moves(0);
#
# メニューバー
#
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);
my $games = $m->new_menu;
$m->add_cascade(-label => "Games", -underline => 0, -menu => $games);
my $levels = $m->new_menu;
$m->add_cascade(-label => "Level", -underline => 0, -menu => $levels);
# Games
$games->add_command(-label => "Start", -underline => 0, -command => \&start_game);
$games->add_separator;
$games->add_command(-label => "exit", -underline => 0, -command => sub { exit; });
# Labels
$levels->add_radiobutton(-label => 'Easy', -variable => \$level, -value => 0, -command => \&start_game);
$levels->add_radiobutton(-label => 'Normal', -variable => \$level, -value => 1, -command => \&start_game);
$levels->add_radiobutton(-label => 'Hard', -variable => \$level, -value => 2, -command => \&start_game);
Tkx::MainLoop();
●X めくりパズル
皆さんお馴染みのパズル「ライツアウト」や「８めくりパズル」と同様のパズルです。今回は 5 行 5 列盤で 3 つのパターンを用意しました。
(1) はライツアウトと、(3) は８めくりパズルと同じです。5 行 5 列盤の場合、(1) と (2) は全て点灯している状態でも解くことができますが、(3) は解けないので注意してください。最長手数は (1) で 15 手、(2) で 13 手、(3) で 20 手になります。解法アルゴリズムに興味のある方は、以下の拙作のページをお読みくださいませ。
X pattern Easy mode
3 手で解けた
●プログラムリスト
#
# xturn.py : X めくりパズル
#
# Copyright (C) 2019 Makoto Hiroi
#
use strict;
use warnings;
use utf8;
use Tkx;
use List::Util ('all', 'first', 'shuffle');
# 反転する位置
my @pattern_table = (
[[0, -1], [-1, 0], [0, 0], [1, 0], [0, 1]], # Plus (+)
[[-1, -1], [1, -1], [0, 0], [-1, 1], [1, 1]], # X
[[-1, -1], [0, -1], [1, -1], [-1, 0], # O (8 めくり)
[1, 0], [-1, 1], [0, 1], [1, 1]]
);
my $top = Tkx::widget->new('.');
$top->g_wm_title('X めくりパズル');
Tkx::option_add("*tearOff", 0);
#
# グローバル変数
#
# ラベルのバッファ
my $buff = '';
# メニュー用
my $pattern = 1; # + pattern = 0, X pattern = 1, O pattern = 2
my $level = 1; # Easy = 0, Normal = 1, Hard = 2
# カードの id を格納
my @card = ();
# 盤面
my @board = ();
# Retry 用
my @save_board = ();
my $steps = 0; # 手数
my $min_steps = 99; # 最短手数
my $gameflag = 0; # ゲーム中は 1
my $board_size = 25;
# 手数表示用ラベル
my $l0 = $top->new_label(-textvariable => \$buff, -font => ['', 14]);
$l0->g_pack;
# 盤面を表示するためのキャンバス
my $c0 = $top->new_canvas(-width => 270, -height => 270);
$c0->g_pack;
# 手数の表示
sub show_steps {
$buff = "steps: $steps min steps: $min_steps";
}
#
# カードをめくる
#
sub turn_card_sub {
my ($x, $y) = @_;
my $a = $pattern_table[$pattern];
foreach my $d (@$a) {
my $x1 = $x + $d->[0];
my $y1 = $y + $d->[1];
if (0 <= $x1 && $x1 < 5 && 0 <= $y1 && $y1 < 5) {
my $z1 = $y1 * 5 + $x1;
$board[$z1] ^= 1;
if ($board[$z1]) {
$c0->itemconfigure($card[$z1], -fill => 'yellow');
} else {
$c0->itemconfigure($card[$z1], -fill => 'darkgray');
}
}
}
}
sub turn_card {
my ($x1, $y1) = @_;
if ($gameflag) {
my $x = int(($x1 - 10) / 50);
my $y = int(($y1 - 10) / 50);
turn_card_sub($x, $y);
$steps++;
show_steps();
if (all {$_ == 0} @board) {
Tkx::tk___messageBox(-type => 'ok', -icon => 'info', -title => 'Good Job!',
-message => 'おめでとうございます');
if ($min_steps > $steps) {
$min_steps = $steps;
show_steps();
}
$gameflag = 0;
}
}
}
#
# 再挑戦！
#
sub retry_game {
if (@save_board) {
@board = @save_board;
$steps = 0;
foreach my $i (0 .. $#board) {
if ($board[$i]) {
$c0->itemconfigure($card[$i], -fill => 'yellow');
} else {
$c0->itemconfigure($card[$i], -fill => 'darkgray');
}
}
$gameflag = 1;
show_steps();
}
}
#
# ゲームの開始
#
sub start_game {
$gameflag = 1;
$steps = 0;
$min_steps = 99;
show_steps();
foreach my $n (0 .. $board_size) {
$board[$n] = 0;
$c0->itemconfigure($card[$n], -fill => 'darkgray');
}
my $m;
if ($level == 0) {
$m = int(rand(2)) + 2;
} elsif ($level == 1){
$m = int(rand(3)) + 5;
} else {
$m = int(rand(5)) + 10;
}
my @select_card = (0 .. $#board);
@select_card = shuffle @select_card;
for (my $n = 0; $n <= $m; $n++) {
my $k = $select_card[$n];
turn_card_sub($k % 5, int($k / 5));
}
@save_board = @board;
}
# カードの生成
foreach my $y (0 .. 4) {
foreach my $x (0 .. 4) {
my $x1 = $x * 50 + 10;
my $y1 = $y * 50 + 10;
my $id = $c0->create_rectangle($x1, $y1, $x1 + 50, $y1 + 50, -fill => 'darkgray', -tags => 'card');
push @card, $id;
}
}
# バインディング
$c0->bind('card', '<Button-1>', [\&turn_card, Tkx::Ev('%x', '%y')]);
#
# メニューバー
#
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);
my $games = $m->new_menu;
my $levels = $m->new_menu;
$m->add_cascade(-label => "Games", -underline => 0, -menu => $games);
$m->add_command(-label => "Retry", -underline => 0, -command => \&retry_game);
$m->add_cascade(-label => "Level", -underline => 0, -menu => $levels);
# Games
$games->add_command(-label => "Start", -underline => 0, -command => \&start_game);
$games->add_separator;
$games->add_radiobutton(-label => '+ pattern', -variable => \$pattern, -value => 0, -command => \&start_game);
$games->add_radiobutton(-label => 'X pattern', -variable => \$pattern, -value => 1, -command => \&start_game);
$games->add_radiobutton(-label => 'O pattern', -variable => \$pattern, -value => 2, -command => \&start_game);
$games->add_separator;
$games->add_command(-label => "exit", -underline => 0, -command => sub { exit; });
# Labels
$levels->add_radiobutton(-label => 'Easy', -variable => \$level, -value => 0, -command => \&start_game);
$levels->add_radiobutton(-label => 'Normal', -variable => \$level, -value => 1, -command => \&start_game);
$levels->add_radiobutton(-label => 'Hard', -variable => \$level, -value => 2, -command => \&start_game);
Tkx::MainLoop();
