#!/usr/bin/perl
# <title> 語語(カタリガタリ) by Perl for Windows </title>
#         ktrgtr.pl (KaTaRiGaTaRi) by foussin (v0.00) 2016.05.08 Sun
use strict;
use warnings;
use utf8;
use Encode qw/decode/;
use Encode::Guess qw/sjis euc-jp/;
use FindBin;
use Term::ReadKey;

use Win32::Console::ANSI; # Win専用モジュール?(WinでESCシーケンス使用)
print "\e[2J";            # CLS(クリアー・スクリーン)
$| = 1;                   # STDOUT のバッファリング止め

# ●Act.0：画面表示の文字コード (実行環境をここで特定)
#   ":encoding(cp932)" → Windows(コマンドプロンプト)
#   ":utf8"            → Linux 等
#   ※デコード済の内部表現文字列を binmode で 自動エンコード
my $console_code = ($^O eq "MSWin32") ? ":encoding(cp932)" : ":utf8";
binmode STDOUT, $console_code;  # 標準出力を画面表示に使う
binmode STDERR, $console_code;  # 標準エラー出力を画面表示に使う


# ●Act.1：表示モード選択
print <<"EOT";

0. だらだら表示モード
1. 単語区切りタップ入力モード(主に英文用)
2. 1文字タップ入力モード(主に童謡の歌詞用)
EOT
print "表示モードを選択(0-2)> ";
chomp(my $mode = <STDIN>);  # エラートラップ省いた…


# ●Act.2：初期設定(waitのデフォルト値)
my $wait_sec = 0;                   # 1文字タップ入力(童謡の歌詞用)
($mode==0) and $wait_sec = 0.06;    # だらだら表示モード
($mode==1) and $wait_sec = 0.01;    # 単語区切りタップ入力(英文用)


# ●Act.3：入力ファイル読込
my $ifile = $ARGV[0] ? $ARGV[0] : "";
unless ($ifile) {
    # 実行中のスクリプトが居る場所をカレントディレクトリにする
    chdir $FindBin::Bin;
    # glob で "./ktrgtr-*.txt" ファイルリストをメニュー表示
    # Windows では open用と表示用、2種類の配列が必要(binmode指定が逆に仇?)
    my @files = glob("ktrgtr-*.txt");                   # open用リスト
    my $num = @files or die "error: 入力テキストが見つからない！";
    my $files = decode("Guess", join("\n", @files));
    my @decode_names = split /\n/, $files;              # メニュー表示用
    for (my $i=0; $num>$i; ++$i) { print "\n$i. $decode_names[$i]"; }
    if ($num == 1) {
        $ifile = $files[0];
    } else {
        print "\n読込テキストを選択(0-", $num-1, ")> ";
        chomp(my $id = <STDIN>);
        $ifile = $files[$id];
        $ifile or die "error: 番号指定が変かも？";
    }
}
# 入力ファイルの文字コードは不明のままオープン
open(IN, "<", $ifile) or die "Error: $!";
# 入力文字列をまるごと配列に入れ、文字コードを推測し内部コード変換
my @src_text = <IN>;   close IN;
my $src_text = decode("Guess", join('', @src_text));


# ●Act.4：テキストのコメント行を除去
# ktrgtr.pl では、"# " (#と半角スペース)から始まり "\n" (改行)まで
# をコメント行として除去する。行の途中にコメントを入れると表示が乱
# れる。 コメントの記述は『1行コメント』のみ有効という仕様とする。
$src_text =~ s/# .*\n//g;
#print $src_text; # 動作確認用


# ●Act.5：テキストを表示モードに合わせて分割し @str に格納
my @str;
if ($mode==1) {
    # 1. 単語区切りタップ入力モード(主に英文用)
    # スペース(全角・半角)、句読点(、。)、\n で区切り文章を分割する
    # (区切り文字 の直後に『＄■』を挿入し、最後に『＄■』で split)
    $src_text =~ s/(\n+)/$1＄■/g;          # 復改
    $src_text =~ s/([、。・＝])/$1＄■/g;   # 句読点・他
    $src_text =~ s/(　+)/$1＄■/g;          # 全角スペース
    $src_text =~ s/( +)/$1＄■/g;           # 半角スペース
    $src_text =~ s/\n＄■(　+)/\n$1/g;      # 行先頭のスペースは対象外
    $src_text =~ s/\n＄■( +)/\n$1/g;       # 行先頭のスペースは対象外
    $src_text =~ s/＄■(\n+)＄■/$1＄■/g;  # 行末尾をひとまとめにする
    @str = split '＄■', $src_text;         # テキスト → 配列
} elsif ($mode==2) {
    # 2. 1文字タップ入力モード(主に童謡の歌詞用)
    # 拗音(ゃゅょャュョ)、？(ぁぃぅぇぉァィゥェォ)、促音(っッ)、長音(ー)、
    # 句読点(、。,.)、スペース(全角・半角)、復改(\n)、記号等は直前の文字と
    # 連結して『1音節扱い』とする。
    # ($src_text を substr で 1文字ずつチェックしながら @str に push)
    $str[0] = "";   # 初期値はダミー
    my $len = length $src_text;
    for (my $j=0; $j<$len; ++$j) {
        my $ch = substr($src_text, $j, 1);
        if ($ch =~ /[ゃゅょぁぃぅぇぉっャュョァィゥェォッ…ー\-！!？?＝=・、。,\.：；:;\(\) 　\n]/) {
            push @str, pop(@str) . $ch;     # スタック操作
        } else {
            push @str, $ch;
        }
    }
    $str[0] or shift @str;
} else {
    # 0. だらだら表示モード
    $str[0] = $src_text;
}
#print join("●", @str); # 動作確認用
print <<"EOT";

準備完了：
何かキーを押すと CLS(画面クリア)してスタンバイ状態になります。
その後、もう一度適当なキーを押すと表示が始まります。

ご自分のタイミングでキーを押して実行開始してください。
EOT
ReadMode 4;         # Turn off controls keys(とりあえず 4 にしとけば OK)
my $x = ReadKey;    # 何かキーを押すまで wait を続行
print "\e[2J";      # CLS(クリアー・スクリーン)
#print "\e[5>h";     # カーソル非表示モード(Windows は使えないらしい)

# ●Act.6：@str の先頭要素を shift で取り出し、適度に wait をかけて表示
while (@str) {
    my $x = ReadKey;  # 何かキーを押すまで wait を続行
    my $str = shift @str;
    my $len = length($str);
    for (my $j=0; $j<$len; ++$j) {
        my $ch = substr($str, $j, 1);
        wait_on($wait_sec);
        print $ch;
    }
}
ReadMode 0;     # Reset tty mode before exiting
#print "\e[5>l"; # カーソル表示モードに戻す(Windows は使えないらしい)
sleep 2;
$| = 0;         # STDOUT のバッファリング復活
1;


# ●サブルーチン：wait_on (wait 実行ルーチン) by foussin
# 2005.11.05 Sat 10:21 (初版)
# 2012.05.15 Tue 23:42 (Perl5 風にリライト)
# 概要：1秒未満の wait をかける
#       最小単位：10ミリ秒＝1センチ秒 (Win32 の場合) (Linux は 1ミリ秒)
#       最小単位は times の実装に依存 (Linux と Win32 では仕様が異なる)
#       0.01秒未満の秒数を指定すると 0.01 を指定したと見なされる(Win32)
# 備考：times の実装は 2012年当時の話(現在では仕様が変わっているかも…)
# 書式：$true_time = wait_on($sec);
# 引数：$sec: 0.01秒以上の wait時間(秒数)を指定する。
# 戻値：$true_time: 実際に wait した時間を秒数(実数値)で返す。
# 備考：実際の待ち時間は引数$secを超える可能性アリ (正確なwaitではない)
sub wait_on {
    my $start = (times)[0];
    my $sec   = $_[0];
    my $break = $start + $sec;
    my $now;
    while (1) {
        $now   = (times)[0];
        ($now >= $break) && last;   # 正確な wait ではない...
    }
    return $now - $start;
}
__END__

機能：テキストをコンソール(ターミナル)に『ゆっくり標準出力』する
書式：ktrgtr.pl [入力テキストファイル名]

引数：引数を省略すると ktrgtr.pl が居る場所をカレントディレクトリにして
　　　そこにある『ktrgtr-云々.txt』を入力ファイルとして読み込む選択画面
　　　となる。入力ファイルが 1個しかない時は選択プロンプトを表示せずに、
　　　そのファイルを直ちに読み込む。入力ファイルの文字コードは問わない。

カテゴリ：創作支援ツール(映像表現用)
使用方法：はてなダイアリーで説明(長くなりそうなので)