Ｐｅｒｌ／ＴｋｘでＲａｄｉｋｏプレーヤー

ダウンロードしたＲａｄｉｋｏの音源を連続で再生したい。 再生を中断してプレーヤーを終了後、再起動で再開したい。

1. スケールにｓｅｔがなく変数のリファレンスを渡しておいて変数を更新して現在値を設定する。
2. スケールの最大値を動的に変更できない（調査不足か？）
3. ＶＢＲのＭＰ３を再生するとWin32::MediaPlayerが再生時間を正しく把握しない。仕方ないのでＣＢＲのＭＰ３を用意する。

こんな感じです。

#!/usr/bin/perl -w

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

use Encode;
use Encode::Locale;
use File::Basename;
use FindBin;
use Tkx;
use Tkx::Scrolled;
use Win32::MediaPlayer;
use YAML;

# スクリプトがあるディレクトリの絶対パス
use lib $FindBin::Bin;

use menu_build;

binmode STDOUT, ":encoding(cp932)";

$| = 1;

my $findbin_bin = Encode::decode locale => $FindBin::Bin . "/";
my $yamlfile = $findbin_bin . "radikoplay.yaml";
my $preferences;
if (-e Encode::encode locale => $yamlfile) {
	$preferences = YAML::LoadFile($yamlfile);
}

# リストボックス内の文字を等幅にするため一律でフォントを指定
Tkx::option_add("*Listbox.font", "System");

my $mw = Tkx::widget->new(".");
menu_build($mw, [
	[ "ファイル", "F", [
		[ "終了", "X", \&wm_delete_window, ],
	], ],
]);

$mw->g_wm_title("Ｒａｄｉｋｏプレーヤー");
$mw->g_wm_minsize(300, 0);
$mw->g_wm_protocol(WM_DELETE_WINDOW => \&wm_delete_window);
$mw->g_wm_resizable(0, 0);

my $dialog_width = 60;

my $time_frame = $mw->new_frame();
$time_frame->g_pack(-side => "top", -fill => "x");

my $startpos = 0;
my $start_scale = 0;
my $mp3_len = 0;
my $mp = new Win32::MediaPlayer;
my $play_mp3;

my $time_sc = $time_frame->new_scale(
	-from => 0,
	-showvalue => 0,
	-to => 999,
	-orient => "horizontal",
	-variable => \$start_scale,
	-command => sub {
		$mp->seek(int($mp3_len * $start_scale / 1000)) if defined $play_mp3;
		update_playtime();
	},
)->g_pack(-side => "left", -expand => 1, -fill => "x");

my $pause_btn = $time_frame->new_button(
	-text => "\x{2016}",
	-command => sub {
		mp3_pause();
	},
);
$pause_btn->g_pack(-side => "right");

my $mp3_lbx = $mw->new_tkx_Scrolled(
	"listbox",
	-selectmode => "extended",
	-scrollbars => "e",
	-width => $dialog_width,
	-height => 10,
	-activestyle => "none",
);
$mp3_lbx->g_pack(-anchor => "w");

my $wg_status = $mw->new_label(-text => "");
$wg_status->g_pack(-anchor => "w");
sub update_status($) {
	my ($text) = @_;
	$wg_status->configure(-text => $text);
	Tkx::update();
}
update_status "";

my @mp3 = sort map {chomp; $_ = Encode::decode "cp932", $_} glob $ENV{USERPROFILE} . "\\Desktop\\radiko\\*.mp3";
if (exists $preferences->{file} && exists $preferences->{startpos} && grep {$_ eq $preferences->{file}} @mp3) {
	$startpos = $preferences->{startpos};
	while (@mp3 && $mp3[0] ne $preferences->{file}) {
		shift @mp3;
	}
}
for (@mp3) {
	$mp3_lbx->insert("end", basename($_, ".mp3"));
}

my $is_play = 0;
Tkx::after(0, sub {
	play_mp3();
});

Tkx::MainLoop();

exit;



sub wm_delete_window {
	$play_mp3 = "" if !defined $play_mp3;
	$preferences->{file} = $play_mp3;
	$preferences->{startpos} = $startpos;
	YAML::DumpFile($yamlfile, $preferences);

	close_mp3();

	$mw->g_destroy;
}



sub play_mp3 {
	load_mp3($startpos) if !defined $play_mp3;

	if ($mp->pos < $mp3_len) {
		$startpos = $mp->pos;
		update_playtime();
		$start_scale = $startpos / $mp3_len * 1000;
	} else {
		# 再生が終わったｍｐ３ファイルを一覧から削除
 		$mp3_lbx->delete(0, 0);
		close_mp3();
		load_mp3();
	}

	Tkx::after(1000, sub {
		play_mp3();
	});
}



sub update_playtime {
	my $len_form = len_str($mp3_len);
	my $playtime = len_str($startpos);
	update_status "再生時間 $playtime / $len_form";
}



sub len_str {
	my ($len) = @_;

	my $len_s = int($len / 1000);
	my $len_m = int($len_s / 60);
	$len_s -= $len_m * 60;
	my $len_h = int($len_m / 60);
	$len_m -= $len_h * 60;
	return sprintf "%d:%02d:%02d", $len_h, $len_m, $len_s;
}



sub load_mp3 {
	my ($pos) = @_;
	$pos = 0 if !defined $pos;

	$play_mp3 = shift @mp3;
	if (defined $play_mp3) {
		$mp->load(Encode::encode "cp932", $play_mp3);
		$mp->play;
		$is_play = 1;
		$pos += 0;
		$mp->seek($pos);

		$mp3_len = $mp->length;
	} else {
		wm_delete_window();
	}
}



sub close_mp3 {
	$mp->close if defined $play_mp3;
	undef $play_mp3;
	$is_play = 0;
}



sub mp3_pause {
	if (defined $play_mp3) {
		if ($is_play) {
			$mp->pause();
			$is_play = 0;
		} else {
			$mp->resume();
			$is_play = 1;
		}
	}
}