[[ハム活動記]]
*テキストをモールスWAVに変換するソースの公開 [#k43262e4]
Text2WAV perlソースコードです

これは&color(red){''テキストコード(エンコードはUTF8 改行はLF)データを読み込んでモールスWAVに変換する''};ソースコードです。~
''トーン、早さ、文字間、長点の長さなども調整できます、つまり、和文のネバリ符号も出力出来ます''

[[ネバリ見本>http://print-man.jp/~jr1gdy/DLL/aiu-4.wav]]

wavをmp3に変換すればCD等から聴くことが出来ます

このソースは[[オープンソース>https://ja.wikipedia.org/wiki/Open_Source_Initiative]]として自由にお使い頂けます。~
ソフトの勉強に、改良して更に使いやすいものにお願いします。

また、このソースについての質問等はメールでお願いします。

***開発環境 [#k9588bc1]
-MacOS UNIX系
-ターミナルCUEからperlで動かします
-perlですから、他のパソコンでもコンパイルが可能です。
***テキストの決まり [#h4c08111]
-UTF8で保存する
-続ける符号は[ホレ]のように[]で囲む
-段落は」又は。で段落符号が出る(筈だ)
***コマンド [#vb463f0c]
perl text2wav.pl p=paris速度 c=文字間(通常は3) W=ウエイト(長音の長さ)~
詳しくはソースを見て下さい。~
perl text2wav.pl のみ入力すれば使い方が出ます
----
以下コピペ下さい。最初の行#!/usr/bin/perlは頭の半角スペースを取り、環境にあったperlの有り場所pathを指定する必要があります~
モジュール[[Audio::Wavはcpanから取得する>http://search.cpan.org/~brianski/Audio-Wav-0.14/]]

[[Morse.pmはココカラzipダウンロードする>http://print-man.jp/~jr1gdy/DLL/Morse.zip]]


ソース名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;
 	}
 #数字に1を掛けても値は変わらないが、もし文字が入っていたら0になる。
 	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を読み込む UTF8厳守
 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){
 	#モールスコード1文字取得し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;
 }

トップ   編集 差分 履歴 添付 複製 名前変更 リロード   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS