![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
Text2WAV perlソースコードです
これはテキストコード（エンコードはUTF8 改行はLF）データを読み込んでモールスWAVに変換するソースコードです。
トーン、早さ、文字間、長点の長さなども調整できます、つまり、和文のネバリ符号も出力出来ます
wavをmp3に変換すればCD等から聴くことが出来ます
このソースはオープンソースとして自由にお使い頂けます。
ソフトの勉強に、改良して更に使いやすいものにお願いします。
また、このソースについての質問等はメールでお願いします。
perl text2wav.pl p=paris速度 c=文字間（通常は3） W=ウエイト（長音の長さ）
詳しくはソースを見て下さい。
perl text2wav.pl のみ入力すれば使い方が出ます
以下コピペ下さい。最初の行#!/usr/bin/perlは頭の半角スペースを取り、環境にあったperlの有り場所pathを指定する必要があります
モジュールAudio::Wavはcpanから取得する
ソース名TextWAV,pl
#!/usr/bin/perl
# 2012/09/19
use strict;
use Audio::Wav;
use Jcode;
use Morse;
my $doc =<< "DOC";
入力コマンドの例
0. 初心者；コードを覚える p=4 w=3 c=5 en in.txt out.wav
1. 初心者；コードを理解する p=5 w=3 c=4 en in.txt out.wav
2. 初心者；5paris(30) p=6 w=3 c=3.5 en in.txt out.wav
3. 中級者；8paris(45) p=9 w=3 c=3 en in.txt out.wav
4. 中級者；12paris(60) p=12 c=4 en in.txt out.wav
5. 中級者；14paris(70) p=14 en in.txt out.wav
6. 上級者；16paris(80) p=16 en in.txt out.wav
7. 上級者；20paris(100) p=20 en in.txt out.wav
DOC
my ($gTone,$gParis,$gWeight,$gMoji,$gInFile,$gOutFile);
my $gWabun=1; #和文中心
my $gOubun=0; #欧文中心
foreach my $argv(@ARGV){
if($argv eq "help" || $argv eq "HELP"){
print "\n******************************************************\n";
print " usage cw t=700 p=14 w=3 c=3 m=jp|en in.txt out.wav\n";
print " t:tone p:paris w:weight c:文字間 cwtext.txt morse.wav\n";
print " jp:和文中心 en:欧文中心\n";
print "******************************************************\n";
print $doc;
exit;
}
#数字に１を掛けても値は変わらないが、もし文字が入っていたら０になる。
if($argv =~ /^t=/i) {$gTone=$argv; $gTone=~ s/t=//i; $gTone*=1;}
if($argv =~ /^p=/i) {$gParis=$argv; $gParis=~ s/p=//i; $gParis*=1;}
if($argv =~ /^w=/i) {$gWeight=$argv; $gWeight=~ s/w=//i; $gWeight*=1;}
if($argv =~ /^c=/i) {$gMoji=$argv; $gMoji=~ s/c=//i; $gMoji*=1;}
if($argv =~ /^m=jp/i) {$gWabun=1;$gOubun=0;}
if($argv =~ /^m=en/i) {$gWabun=0;$gOubun=1;}
if($argv =~ /.txt$/i) {$gInFile = $argv;}
if($argv =~ /.wav$/i) {$gOutFile = $argv;}
}
if(!$gTone){$gTone=700;}
if(!$gParis){$gParis =12;}
if(!$gWeight){$gWeight =3;}
if(!$gMoji){$gMoji=3;}
if($gMoji < 3){$gMoji = 3;}
if(!$gInFile){$gInFile="cwtext.txt";}
if(!$gOutFile){$gOutFile="Morse.wav";}
#print("gWeight =$gWeight\n");
#exit;
my $gDotLen =&paris2dotsec($gParis);
my $gDashLen = $gDotLen * $gWeight;
my $gToneZero = 0;
my $gCharSpace =$gDotLen * $gMoji;
#my $gWardSpace =$gDotLen*7;
my $gWardSpace =$gDotLen * (7 + $gMoji-3);
if($gWabun){print "\n***START*和文中心**************************************\n";}
if($gOubun){print "\n***START*欧文中心**************************************\n";}
print(" Tone=$gTone Paris=$gParis Weight=$gWeight\n");
print(" 文字間=$gMoji Infile=$gInFile OutFile=$gOutFile\n");
print(" 短点=$gDotLen 長点=$gDashLen 文字間=$gCharSpace 単語間=$gWardSpace\n");
print "******************************************************\n";
#TEXTを読み込む UTF８厳守
if(!open (TEXT,"< $gInFile")){print("*** ERR-->TEXT File Not Open($gInFile)***\n");}
my $text_buff;
my $text_rec;
while(<TEXT>){
$text_rec=$_;
$text_rec =~ s/\r\n/\n/g;
# 下記はUTF8に変換するところだが、入ってくるエンコードで文字化けあるので、UTF8のみとする
# if($gWabun){$text_rec =~ s/\n/」 /g;}
# if($gOubun){$text_rec =~ s/\n/[bt] /g;}
# my $cd=getcode($text_rec);
# my $utc8_str = Jcode->new($text_rec,$cd)->utf8; #不明コードをutf8に変更する
# my $utc8_str = Jcode->new($text_rec)->utf8; #不明コードをutf8に変更する
# $text_buff .= $utc8_str;
$text_buff .= $text_rec;
}
close(TEXT);
my $wav = new Audio::Wav;
my $sample_rate = 44100;
my $bits_sample = 16; #16;
my $details = {
'bits_sample' => $bits_sample,
'sample_rate' => $sample_rate,
'channels' => 1,
};
my $write = $wav -> write( "$gOutFile", $details );
&Morse::cw_open(); #Morse.pm参照
#単語毎に処理する。単語の区切りはスペース
my @text_arry=split(/\s+/,$text_buff);
foreach my $text_str(@text_arry){
# if($gWabun){ #和文なら文中の。や改行を段落符号にする→今はコメント 本文に忠実に
# $text_str =~ s/。/」 /g;
# $text_str =~ s/\n/」/g;
# $text_str =~ s/」」/」/g;
# $text_str =~ s/」/」 /g;
# }
# if($gOubun){
# $text_str =~ s/\n/[bt] /ig;
# $text_str =~ s/[bt][bt]/[bt]/ig;
# $text_str =~ s/\n/[bt] /ig;
# }
#単語をまとめてモールスコードに、一文字ずつリスト化して戻ってくる。
my @dec_list = &Morse::cw_decode($text_str);
foreach my $cc (@dec_list){
#モールスコード１文字取得しWAV出力する
my ($char, $code)=split(/<>/,$cc);
print "$char$code ";
if($char =~ /」/ && $gWabun){print "\n";}
if($char =~ /bt/ && $gOubun){print "\n";}
if($char ne " " || $char ne " "){&cc2wav($code);&cc2wav(" ");}
if($char eq " " || $char eq " "){&cc2wav("&");}
}
print "\n";
}
$write -> finish();
print "\nEND OF Text->CW->WAV\n";
exit;
##############################################################
sub cc2wav{
my ($char)=@_;
my @cw_code=split(//,$char);
foreach my $cw_rec(@cw_code){
# print "rr($cw_rec)\n";
if($cw_rec eq "."){&add_sine($gTone,$gDotLen); &add_sine($gToneZero,$gDotLen);}
if($cw_rec eq "-"){&add_sine($gTone,$gDashLen); &add_sine($gToneZero,$gDotLen);}
if($cw_rec eq " "){&add_sine($gToneZero,$gCharSpace);}
if($cw_rec eq "&"){&add_sine($gToneZero,$gWardSpace);}
}
}
sub add_sine {
my $hz = shift;
my $length = shift;
my $pi = ( 22 / 7 ) * 2;
$length *= $sample_rate;
my $max_no = ( 2 ** $bits_sample ) / 2 - 1;
for my $pos ( 0 .. $length ) {
my $time = $pos / $sample_rate;
$time *= $hz;
my $val = sin $pi * $time;
my $samp = $val * $max_no;
$write -> write( $samp );
}
}
sub paris2dotsec{
my ($paris)=@_;
my $dotsec=50 / 60;
my $dot_sec=$dotsec / $paris;
return $dot_sec;
}
sub paris2cpm{
my ($paris)=@_;
return ($paris * 5);
}
sub cpm2paris{
my ($cpm)=@_;
return ($cpm / 5);
}
sub cpm2dotsec{
my ($cpm)=@_;
my $paris=&cpm2paris($cpm);
my $dotsec=&paris2dotsec($paris);
return $dotsec;
}
