use strict;
use Getopt::Long;
use Tie::IxHash;

#mmlファイルがあるディレクトリ
our $dir = "./music/";
#brrファイルがあるディレクトリ
our $dirb = "./brr/";
#OWでも変化しない空いてるRAMアドレス。6桁で指定
our $free_ram = 0x7EC100; 


################################
#以下は書き換えないでください
################################

#	#コメント用
#	&関数呼び出し
#	sub 関数定義
#	our 取得。<STDIN>なら入力をもちかける
#	$変数
#	@配列
#	%組み合わせ指定配列?  ('',,     '',,)
#	GetOptions() 引数処理
#	行内で条件節を後付け可能(ifやunless)
#	$# 配列長−１


#	our	全体に対しての変数名宣言
#	my	サブルーチン内での変数名宣言。さらにその内部にサブルーチンがあった場合、その先まで効力は及ばない 
#	local	上とは逆。先まで効力が及ぶ




our $check_point = 0x80200;
our $aram_l = 0x5400;
our $seq_ofs = 0xFE000;
our $pcmset_add = 0xFCF00;
our $pcmdata = 0xFD000;
our $pcm_set = 0x00;
our ($startFILE, $startARAM, $intro, $msc, $list, $rom, $brrlist);
our (@sum_data_a, @sum_data, @data, @ptrL, @ptrI, @ptrA, @q, @update_q, @directm, @melody, @loop, @set_data, %msc, %list, %brrlist);


#音程
our %tone = ('a',9, 'b', 11, 'c', 0, 'd', 2, 'e', 4, 'f', 5, 'g', 7); 
#楽器毎の音程のズレ
our @transmap = (0, 0, 5, 0, 0, 0, 0, 0, 0, -5, 6, 0, -5, 0, 0, 8, 0, 0, 0); 


#引数処理
GetOptions('msc' => \$msc, 'list=s' => \$list, 'rom=s' => \$rom, 'blist=s' => \$brrlist);


#input rom name
unless($rom) {
	print "\n input your ROM name: ";
	$rom = <STDIN>;
	print "\n";
}


#rom check
chomp $rom;
$rom = $rom.'.smc' unless($rom =~ /\.smc$/i);
unless(-e $rom) {
	print "ROM not found";
	my $tmp = <STDIN>;
	exit;
}
our $size = -s $rom;
if($size < 1000000 || $size > 4200000) {
	print "Error: ROM size must be from 1MB to 4MB.";
	my $tmp = <STDIN>;
	exit;
}

open(IN,"+<$rom") or die "file open error:$!";
binmode(IN);					#ロムをバイナリデータとして読み込む

unless($list) {
	print "input any alphabets to use option shortcut (-b blist.txt -l list.txt) ";
	my $tmp = <STDIN>;
	chomp ($tmp);
	$list = 'list' if($tmp);
	$brrlist = 'blist' if($tmp);
	$msc = 1 if($tmp);
	}


#リストファイルの読み取り
if($list) {
	$list = $list.'.txt' unless($list =~ /\.txt$/i);
	unless(-e $list) {
		print "Error: $list not found";
		<STDIN>;
		exit;
	}
	open (LIST, "<$list");
	while(<LIST>) {
		chomp;
		$list{lc $1} = $2 if(m/^([^\s]+)\s+(.+)$/);
	}
	close(LIST);
}
if($brrlist) {
	$brrlist = $brrlist.'.txt' unless($brrlist =~ /\.txt$/i);
	unless(-e $brrlist) {
		print "Error: $brrlist not found";
		<STDIN>;
		exit;
	}
	open (LIST, "<$brrlist");
	while(<LIST>) {
		chomp;
		$brrlist{lc $1} = $2 if(m/^([^\s]+)\s+(.+)$/);
	}
	close(LIST);
}

&InsertSEQ(*IN);
print "\n";
&InsertPCM(*IN);
&Msc() if($msc);
print "\n completed";
close(IN);
our $endinput = <STDIN>;


sub InsertSEQ {
	local (*FILE) = @_;
	$startARAM = $aram_l;
	my $limit_size = 0x2BFF;											########

	my $snes_addr = $seq_ofs;

	&DeleteMusic($snes_addr, *FILE);


	print "inserting SEQ\n\n";
	@sum_data_a = ();
	for (0..95) {
		$sum_data_a[$_] = 0;			# 配列長　0x60
	}
	for my $i (0..0xFF) {
		my $flag = 0;
		$pcm_set = 0x02;			# 使用PCMセット番号 無指定なら02
		my $j = $i*3;
		@sum_data = @sum_data_a;
		@set_data = ();
		for ($j..$j) {
			my $k = sprintf("%x",$i);
			my $file = "$k.txt";
			#リストファイルがあるときはそっちを参照
			if($list) {
				$file = $list{$k};
				$file = $file.'.txt' unless($file =~ /\.txt$/i);
			}
			next unless(-e "$dir$file");
			$flag = 1;
			(@data, @ptrL, @ptrI, @ptrA, @q, @update_q, @directm, @melody, @loop) = ();
			for (0..12) {
				my $tmp = $data[$_][0];
			}
			$intro = 0;
			&MML2spc("$dir$file", $k);
			&StoreSpc(0);
		}
		
		next unless($flag);
		
		#データの書き込み
		$size = @sum_data;
		printf "%x(%d) / %x(%d)\n\n", $size, $size, $limit_size, $limit_size;
		if($size > $limit_size) {
			print "Error:too large sequence\n";
			<STDIN>;
			exit;
		}

		my $space_size = $size + 0x1C;
		my $input_point = &LocCheck($space_size, $check_point, *FILE);
		
		unless($input_point) {
			printf "Error:There are no spaces for inserting music NO.%x \n", $j;
			my $tmp = <STDIN>;
			exit;
		}

		my $rats_tag1 = (($size+19) & 0xFF)*0x100 + (($size+19) >> 8);
		my $rats_tag2 = 0xffff - $rats_tag1;
		my $rats_tag3 = (($size) & 0xFF)*0x100 + (($size) >> 8);
		$rats_tag1 = sprintf("%04X", $rats_tag1);
		$rats_tag2 = sprintf("%04X", $rats_tag2);
		$rats_tag3 = sprintf("%04X", $rats_tag3);
		my $rats_tag = pack("H*","53544152".$rats_tag1.$rats_tag2.$rats_tag3."0054");
		&WriteData($input_point, $rats_tag, *FILE);


		my $SE_tag1 = (($ptrA[9]) & 0xFF)*0x100 + (($ptrA[9]) >> 8);
		my $SE_tag2 = (($ptrA[10]) & 0xFF)*0x100 + (($ptrA[10]) >> 8);
		my $SE_tag3 = (($ptrA[11]) & 0xFF)*0x100 + (($ptrA[11]) >> 8);
		my $SE_tag4 = (($ptrA[12]) & 0xFF)*0x100 + (($ptrA[12]) >> 8);	
		$SE_tag1 = sprintf("%04X", $SE_tag1);	
		$SE_tag2 = sprintf("%04X", $SE_tag2);
		$SE_tag3 = sprintf("%04X", $SE_tag3);
		$SE_tag4 = sprintf("%04X", $SE_tag4);
		my $SE_tag = pack("H*","0800C917".$SE_tag1.$SE_tag2.$SE_tag3.$SE_tag4);


		
		seek FILE, $input_point+0xC, 0;
		#10進数配列→バイナリ
		print FILE pack("C*", @sum_data);
		print FILE $SE_tag;
		print FILE pack("H*","00000005");

		my $input_addr = &Pc2snes($input_point+8);
		my $addr = pack("H*",sprintf("%X", $input_addr));

		my $pc_addr = &Snes2pc($snes_addr) + $j;
		seek FILE, $pc_addr, 0;
		print FILE $addr;

		my $pc_addr = &Snes2pc($pcmset_add) + $i;
		seek FILE, $pc_addr, 0;
		print FILE pack("H*",sprintf("%02X",$pcm_set));

		my $pc_addr = $pcm_set * 0x10 + &Snes2pc($pcmdata);
		seek FILE, $pc_addr, 0;
		print FILE pack("C*",@set_data);

	}
}




#insert PCM
sub InsertPCM {
	local (*FILE) = @_;								

	my $addrm_pc = 0x7CE00;				#PCMOFSの位置
	my $snes_addr = &Pc2snes($addrm_pc);
	



	&DeletePCM($snes_addr, *FILE);


	print "inserting PCM\n\n";

	
	for my $i (0x00..0xFE) {

		my $k = sprintf("%x",$i);
		my $file = "$k.brr";
		#BRRのリストファイルがあるときはそっちを参照
		if($brrlist) {
			$file = $brrlist{$k};
			$file = $file.'.brr' unless($file =~ /\.brr$/i);
		}
		next unless(-e "$dirb$file");

		printf "$fileを検出…\n";


		my $size = -s "$dirb$file";
		
		if($size > 0x7FF5){
			printf "Error:$file is too large\n";
			my $tmp = <STDIN>;
			exit;
		}

		my $space_size = $size + 0xA;
		my $input_point = &LocCheck($space_size, $check_point, *FILE);


		unless($input_point) {
			printf "Error: There are no spaces for inserting $file \n";
			my $tmp = <STDIN>;
			exit;
		}

		my $rats_tag1 = (($size+1) & 0xFF)*0x100 + (($size+1) >> 8);
		my $rats_tag2 = 0xffff - $rats_tag1;
		$rats_tag1 = sprintf("%04X", $rats_tag1);
		$rats_tag2 = sprintf("%04X", $rats_tag2);
		my $rats_tag = pack("H*","53544152".$rats_tag1.$rats_tag2);
		&WriteData($input_point, $rats_tag, *FILE);




		open(BRR, "<$dirb$file");		#Brrファイルを開く
		binmode(BRR);				#Brrファイルをバイナリとして読み書きする
		seek BRR, 0, 0;				#ポインタは最初から
		read BRR, my $buf, $size;		#新しく指定した局所的スカラ変数 $buf に、
							#BRRから長さ$size分を読み込んで代入
		close(BRR);

		my $s = (($size-2) & 0xFF)*0x100 + (($size-2) >> 8);
		$s = pack("H*", sprintf("%04X", $s));
		&WriteData($input_point+0x08, $s, *FILE);		# ファイルサイズ書き込み
		&WriteData($input_point+0x0A, $buf, *FILE);		# BRRループポイント・本体書き込み


		my $input_addr = &Pc2snes($input_point+8);
		my $addr = pack("H*",sprintf("%X", $input_addr));

		my $pc_addr = &Snes2pc($snes_addr) + (hex($k) * 3);
		seek FILE, $pc_addr, 0;
		print FILE $addr;


	}
}





sub DeletePCM {
	my ($snes_addr) = @_;
	local *FILE = $_[1];
	my $zero = pack("H*","000000");
	my $pc_addr = &Snes2pc($snes_addr);
	print "deleting PCMs \n\n";
	for my $i (0..0xFE) {
		seek FILE, $pc_addr+($i*3), 0;					
		read FILE, my $buf, 3;
		my $snes_addr = hex(unpack("H*", $buf));
		next unless($snes_addr);
		&DeleteRatsData(&Snes2pc($snes_addr), *FILE);
		seek FILE, $pc_addr+($i*3), 0;
		print FILE $zero;
	}
}



















sub DeleteMusic {
	my ($snes_addr) = @_;							#SEQOFSのSNESアドレス
	local *FILE = $_[1];
	my $zero = pack("H*","000000");
	my $pc_addr = &Snes2pc($snes_addr);
	print "deleting SEQ data\n\n";
	for my $i (0..0xFF) {
		seek FILE, $pc_addr+$i*3, 0;					#SEQOFS+3iのアドレスを3バイト読む
		read FILE, my $buf, 3;
		my $snes_addr = hex(unpack("H*", $buf));
		next unless($snes_addr);					
		&DeleteRatsData(&Snes2pc($snes_addr), *FILE);			#読んだアドレスの直前に存在するRATSの保護範囲を削除する
		seek FILE, $pc_addr+$i*3, 0;					#000000とする
		print FILE $zero;
	}
}



#check free space
#バンクをまたいではダメ
sub LocCheck {
	my ($check_size,$local_check_point) = @_;
	local *FILE = $_[2];
	my ($buf, $count, $rats_count, $bank);
	my $zero = pack("H*","00");
	my @rats;
	$check_size += 8;
	push @rats, pack("H*","53");
	push @rats, pack("H*","54");
	push @rats, pack("H*","41");
	push @rats, pack("H*","52");
	seek FILE, $local_check_point, 0;
	
	while (read FILE, $buf, 1) {
		if($buf eq $zero) {
			$rats_count = 0;
			unless ($count) {
				#バンクの切れ目を求める
				my $now_point = (tell FILE) -1;
				$bank = (($now_point-0x200) & 0xFF8000) + 0x7FFF + 0x200;
				$count++;
				next;
			}
			my $now_point = (tell FILE) -1;
			#バンクの切れ目を超えたら
			if($bank >= $now_point) {
				return $local_check_point if($count++ > $check_size);
				next;
			}
		}
		$count = 0;

		#check RATS tag
		if($buf eq $rats[$rats_count++]) {
			if($rats_count == 4) {
				$rats_count = 0;
				my ($num, $pari);
				read FILE, $num, 2;
				read FILE, $pari, 2;
				#little endian
				$num = unpack("v", $num);
				$pari = unpack("v", $pari);
				if($num + $pari == 0xFFFF) {
					seek FILE, $num+1, 1;
				}
			}
		} else {
			$rats_count = 0;
		}
		$local_check_point = tell FILE;
	}
	return 0;
}


sub DeleteRatsData {
	my ($pc_addr) = @_;
	my ($buf,$num,$pari);
	my $zero = pack("H*","00");
	local *FILE = $_[1];
	$pc_addr -= 8;
	seek FILE, $pc_addr, 0;
	read FILE, $buf, 4;
	my $rats_data = unpack "H*", $buf;
	return 0 if($rats_data ne "53544152");#RATSタグでない
	read FILE, $num, 2;
	read FILE, $pari, 2;
	#little endian
	$num = unpack("v",$num);
	$pari = unpack("v",$pari);
	return 0 unless($num + $pari == 0xFFFF);#RATSタグでない
	seek FILE, $pc_addr, 0;
	for (1..$num+9) {
		print FILE $zero;
	}
}





#SnesAddress to PcAddres
sub Snes2pc {
	my ($addr) = @_;
	return ((($addr & 0x7FFFFF)/2 & 0xFF8000) + ($addr & 0x7FFF) + 0x200);
}

#PcAddress to SnesAddress
sub Pc2snes {
	my ($addr) = @_;
	my $pc_addr = ((($addr-0x200)*2 & 0xFF0000) + (($addr-0x200) & 0x7FFF) + 0x8000);
	$pc_addr += 0x800000 if($addr >= 0x380200);
	return $pc_addr;
}



#Write Data
sub WriteData {
	my ($local_addr, $local_data) = @_;
	local *FILE = $_[2];
	seek FILE, $local_addr, 0;
	print FILE $local_data;
}

sub MML2spc {
	my ($file, $file_num) = @_;
	
	my ($renpu, $ptr, $start_loop, $slur, $m, $n, $loop_count, %define);
	my ($octave, $tr, $last_tr, $def_long, $last_long, $renpuA) = (4, 8, 8, 8, -1, 1);
	tie %define, 'Tie::IxHash';
	for (0..8) {
		$q[$_] = '7F';
		$update_q[$_] = 1;
		$directm[$_] = 1000;
		$melody[$_] = -1;
	}
	print "$file  ";
	$msc{$file_num} = $list{$file_num} if($list{$file_num});
	my $finish = 0;
	open(MML, $file);
	while(<MML>) {
		last if($finish);
		chomp;
		#タイトル
		if(m/;title=(.*?)$/i) {
			$msc{$file_num} = $1;
			next;
		}
		s/\s+//g;
		s/;.*$//;
		#定義
		while(s/\"([^\"]*?)\"//) {
			my $dat = $1;
			$define{$1} = $2 if($dat =~ /^(.+?)=(.*?)$/);
		}
		#定義の置き換え(定義の逆順)
		foreach my $key (reverse keys %define) {
			s/$key/$define{$key}/g;
		}
		while(s/^([a-g]|r|z|\^|\&|w|v|t|o|p|P|q|y|l|\[|\]|\{|\}|h|s|\_|<|>|\(|\#|\@|\/|\*|\!|\$)//) {
			if($1 eq '!') {
				#終了
				$finish = 1;
				last;
			} elsif($1 eq '#') {
				#チャンネル番号
				if(s/^(\d+)// and 0<=$1 and $1<13 and $1!=8) {
					$tr = $1;
					$q[8] = $q[$tr];
					$update_q[8] = $update_q[$tr];
					$last_long = -1;
					next;
				} else {
					print "line $. Error about channel command\n";
					<STDIN>;
					exit;
				}
			} elsif($1 eq 'z') {
				#音長補正
				if(s/^(\d+)// and 0<=$1 and $1<3) {
					$renpuA = $1;
					next;
				} else {
					print "line $. Error about z command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'l') {
				#デフォルトの音長
				if(s/^(\d+)// and 0<$1 and $tr<9) {
					$def_long = $1;
					next;
				} else {
					print "line $. Error about l command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'w') {
				#主音量
				if(s/^(\d+)// and $1>=0 and $tr<9) {
					push @{$data[$tr]}, 0xE0;
					push @{$data[$tr]}, $1;
					next;
				} else {
					print "line $. Error about w command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'h') {
				#音階誤差直指定
				if(s/^(\-?\d+)// and $tr<9) {
					$directm[$tr] = $directm[$tr==8?$last_tr:8] = $1;
					next;
				} else {
					print "line $. Error about h command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'v') {
				#チャンネル音量
				if(s/^(\d+)// and $1<=255 and $tr<9) {
					push @{$data[$tr]}, 0xE7;
					push @{$data[$tr]}, $1;
					next;
				} else {
					print "line $. Error about v command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'q' ) {
				#クオンタイズ
				if(s/^((\d|[a-f]){2})//i and 0<=hex($1) and hex($1)<=0x7F and $tr<9) {
					$q[$tr] = $q[8] = $1;
					$update_q[$tr] = $update_q[8] = 1;
					next;
				} else {
					print "line $. Error about q command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'y') {
				#音源位置
				if(s/^(\d+)// and 0<=$1 and $1<=20 and $tr<9) {
					push @{$data[$tr]}, 0xDB;
					push @{$data[$tr]}, $1;
					next;
				} else {
					print "line $. Error about y command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '/'  and $tr<9) {
				#イントロの終わり
				$ptrI[$tr] = @{$data[$tr]};
				$intro = 1;
				$last_long = -1;
				next;
			} elsif ($1 eq 't') {
				#速度
				if(s/^(\d+)// and 0<=$1  and $tr<9) {
					push @{$data[$tr]}, 0xE2;
					push @{$data[$tr]}, $1;
					next;
				} else {
					print "line $. Error about t command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'o') {
				#音階
				if(s/^(\d+)// and 0<$1 and $1<=6) {
					$octave = $1;
					next;
				} else {
					print "line $. Error about o command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '@') {
				#音色
				if(s/^(\d+)// and $tr<9) {
					$directm[$tr] = $directm[$tr==8?$last_tr:8] = 1000;
					if(0<=$1 and $1<=18) {
						#音色変更
						push @{$data[$tr]}, 0xDA;
						push @{$data[$tr]}, $1;
						$melody[$tr] = $1;
						next;
					} elsif (21<=$1 and $1<=29) {
						#ドラム
						$melody[$tr] = $1;
						next;
					}
				}
				print "line $. Error about @ command\n";
				<STDIN>;
				exit;
			} elsif ($1 eq '[' and $tr<9) {
				#ループの始まり
				#if($loop_count == $loop_max) {
				#	print "line $. ; ループの数が最大値を超えました\n";
				#	<STDIN>;
				#	exit;
				#}
				#ループ行き先
				$start_loop = $ptrL[$loop_count] = @{$data[8]};
				$last_tr = $tr;
				$tr = 8; #ループ用トラック
				$last_long = -1;
				$melody[8] = $melody[$last_tr];
				next;
			} elsif ($1 eq ']' and $tr<9) {
				#ループの終わり
				my $num = 1;
				$num = $1 if(s/^(\d+)//);
				if(1<=$num and $num<=255) {
					push @{$data[$tr]}, 0x00;
					$tr = $last_tr;
					$ptrL[$loop_count++] = @{$data[$tr]}+1+($tr<<16);
					push @{$data[$tr]}, 0xE9;
					push @{$data[$tr]}, $start_loop & 0xff;
					push @{$data[$tr]}, $start_loop >> 8;
					push @{$data[$tr]}, $num;
					next;
				} else {
					print "line $. Error about loop command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '*' and $tr<9) {
				#ループの使い回し
				$last_long = -1;
				my $num = 1;
				$num = $1 if(s/^(\d+)//);
				if(1<=$num and $num<=255) {
					$m = $loop_count++;
					$ptrL[$m] = @{$data[$tr]}+1+($tr<<16);
					push @{$data[$tr]}, 0xE9;
					push @{$data[$tr]}, $start_loop & 0xff;
					push @{$data[$tr]}, $start_loop >> 8;
					push @{$data[$tr]}, $num;
					next;
				} else {
					print "line $. Error about loop command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '(' and $tr<9) {
				#ループラベル
				if(s/^(\d+)\)\[//) {
					#ループ行き先
					$start_loop = $loop[$1] = $ptrL[$loop_count] = @{$data[8]};
					$last_tr = $tr;
					$tr = 8; #ループ用トラック
					$last_long = -1;
					$melody[8] = $melody[$last_tr];
					next;
				}
				if(s/^(\d+)\)//) {
					my $label_num = $1;
					my $num = 1;
					$last_long = -1;
					$num = $1 if(s/^(\d+)//);
					if(1<=$num and $num<=255) {
						$m = $loop_count++;
						$ptrL[$m] = @{$data[$tr]}+1+($tr<<16);
						push @{$data[$tr]}, 0xE9;
						push @{$data[$tr]}, $loop[$label_num] & 0xff;
						push @{$data[$tr]}, $loop[$label_num] >> 8;
						push @{$data[$tr]}, $num;
						next;
					} else {
						print "line $. Error about loop command\n";
						<STDIN>;
						exit;
					}
				}else {
					print "line $. Error about loop command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 'p' or $1 eq 'P') {
				#ビブラート
				if(s/^(\d+),(\d+)// and 0<=$1 and 0<=$2 and $tr<9) {
					if($1) {
						push @{$data[$tr]}, 0xDE;
						push @{$data[$tr]}, 0x00;
						push @{$data[$tr]}, $1;
						push @{$data[$tr]}, $2;
					} else {
						push @{$data[$tr]}, 0xDF;
					}
					next;
				} else {
					print "line $. Error about p command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '{') {
				#三連符始まり
				if($renpu) {
					print "line $. Error about triplet command\n";
					<STDIN>;
					exit;
				} else {
					$renpu = 1;
					next;
				}
			} elsif ($1 eq '}') {
				#三連符終わり
				if($renpu) {
					$renpu = 0;
					next;
				} else {
					print "line $. Error about triplet command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '>') {
				#オクターブ変更大
				if(++$octave > 7) {
					print "line $. Error too high octave\n";
					<STDIN>;
					exit;
				}
				next;
			} elsif ($1 eq '<') {
				#オクターブ変更小
				if(--$octave < 0) {
					print "line $. Error too low octave\n";
					<STDIN>;
					exit;
				}
				next;
			} elsif ($1 eq '&' and $tr<9) {
				#スラー
				if($slur) {
					print "line $. Error about slur command \n";
					<STDIN>;
					exit;
				} else {
					$slur = 1;
					next;
				}
			} elsif ($1 eq '$') {
				#直接入力
				if(s/^((\d|[a-f]){2})//i) {
					push @{$data[$tr]}, hex($1);
					next;
				} else {
					print "line $. Error about hex input command \n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq 's') {
				#波形セット指定
				if(s/^((\d|[a-f]){2})//i) {
					$pcm_set = hex($1);
					next;
				} else {
					print "line $. Error about s command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 eq '_') {
				#波形セット構成設定
				if(s/^((\d|[a-f]){2})//i) {
					push @set_data, hex($1);					
					next;
				} else {
					print "line $. Error about _ command\n";
					<STDIN>;
					exit;
				}
			} elsif ($1 =~ /([a-g]|r|\^)/) {
				#音符・休符・タイ
				if($1 eq 'r') {
					$n = 0xC7;
				} elsif ($1 eq '^') {
					$n = 0xC6;
				} else {
					#a-g
					$n = $tone{$1} + ($octave - 1)*12 + 0x80;
					$n++ if(s/^\+//);
					$n-- if(s/^\-//);
					#音色調整
					if($directm[$tr] == 1000) {
						$n -= $transmap[$melody[$tr]] if(0<=$melody[$tr] and $melody[$tr]<=18);
					} else {
						$n += $directm[$tr];
					}
					if($n < 0x80) {
						print "line $. Error too low pitch\n";
						<STDIN>;
						exit;
					} elsif (0xC5 < $n) {
						print "line $. Error too high pitch\n";
						<STDIN>;
						exit;
					}
				}
				$m = $melody[$tr];
				#ドラム
				if(21<=$m and $m <= 30 and $n<0xC6) {
					$n = 0xD0 + $m - 21;
					$melody[$tr] = -1;
				}
				#スラー
				if($slur) {
					$slur = 0;
					push @{$data[$tr]}, 0xDD;
					push @{$data[$tr]}, 0;
					push @{$data[$tr]}, $last_long;
					push @{$data[$tr]}, $n & 0x7F;
				}
				#音長
				if(($m = &GetLength($def_long, $renpu, $update_q[$tr], $last_long, $renpuA)) >= 0x80) {
					#音調が長すぎるとき
					push @{$data[$tr]}, 0x60;
					#qがある時
					if($update_q[$tr]) {
						push @{$data[$tr]}, hex($q[$tr]);
						$update_q[$tr] = $update_q[8] = 0;
					}
					push @{$data[$tr]}, $n;
					$m -= 0x60;
					while($m > 0x60) {
						$m -= 0x60;
						push @{$data[$tr]}, 0xC6;
					}
					if($m) {
						push @{$data[$tr]}, $m if($m != 0x60);
						push @{$data[$tr]}, 0xC6;
					}
					$last_long = $m;
					next;
				#音長を付ける必要があるとき
				} elsif ($m) {
					push @{$data[$tr]}, $m;
					$last_long = $m;
					#qがあるとき
					if($update_q[$tr]) {
						push @{$data[$tr]}, hex($q[$tr]);
						$update_q[$tr] = $update_q[8] = 0;
					}
				}
				push @{$data[$tr]}, $n;
				next;
			}
		}
		#データが残っていた場合は構文エラー
		if(length) {
			print "$file line $. Error \n";
			<STDIN>;
			exit;
		}
	}
	close(MML);
	
	my $pointer = $startARAM + @sum_data;
	#終了処理
	for (0..12) {
		#チャンネル毎の容量オーバー
		#if(@{$data[$tr]} >= $tr_max) {
		#	print "$file line $. ; トラック$trのサイズが大きすぎます\n";
		#	<STDIN>;
		#	exit;
		#}
		#開始アドレス変換
		$ptrA[$_] = @{$data[$_]}?$pointer:0;
		#イントロ
		$ptrI[$_] += $ptrA[$_] if($intro and $_<=7 and 0<$ptrI[$_]);
		$pointer += @{$data[$_]} + 1 if(@{$data[$_]});
		#データがない場合
		next unless(@{$data[$_]});
		push @{$data[$_]}, 0x00;
	}
	#ループアドレス変換
	for (0..$loop_count-1) {
		next unless($m = $ptrL[$_]);
		$tr = $m >> 16;
		#ループ元
		$m = $m & 0xffff;
		#ループの行き先
		$n = $ptrA[8] + ($data[$tr][$m] & 0xff) + ($data[$tr][$m+1] << 8);
		#アドレス変換
		$data[$tr][$m] = $n & 0xff;
		$data[$tr][$m+1] = ($n >> 8) & 0xff;
	}
}


sub GetLength {
	my ($m, $renpu, $q, $last_long, $renpuA) = @_;
	
	#音長の直指定
	if(s/^=(\d+)//) {
		$m = $1;
	} else {
		#付点の付いてない1を2^2に置換
		s/^(1([^(\d|\.)])|1$)/2^2\2/;
		#自動付点化 先読み正規表現を利用
		s/^((\d|\^|\.)*?)((?<!\d)32)\^64/\1\3./;
		s/^((\d|\^|\.)*?)((?<!\d)16)\^32/\1\3./;
		s/^((\d|\^|\.)*?)((?<!\d)8)\^16/\1\3./;
		s/^((\d|\^|\.)*?)((?<!\d)4)\^8/\1\3./;
		s/^((\d|\^|\.)*?)((?<!\d)2)\^4/\1\3./;
		s/^((\d|\^|\.)*?)((?<!\d)1)\^2/\1\3./;

		$m = $1 if(s/^(\d+)// and 0<$1);
		$m = 192.0 / $m;
	}
	#付点
	my $bef_long = $m;
	while(s/^\.//) {
		$bef_long /= 2.0;
		$m += $bef_long;
	}
	#三連符
	$m *= (2.0/3.0) if($renpu);

	#補正
	$m *= (1.0/2.0) if($renpuA == 0);	
	$m *= (2.0) if($renpuA == 2);

	#直前の音長・クオンタイズと同じとき 0 を返す
	return 0 if($m == $last_long and !$q);
	return $m;
}

sub StoreSpc {
	my ($num) = @_;
	my ($i, $j, $sound_size);
	#各チャンネルのデータを一本化
	for (0..12) {
		push @sum_data, @{$data[$_]};
		#$sum_size += @{$data[$_]};
		$sound_size += @{$data[$_]};
	}
	printf "%x(%d)バイト\n",$sound_size,$sound_size;
	#各チャンネルのアドレス（イントロ）
	for (0..7) {
		push @sum_data, $ptrA[$_] & 0xff;
		push @sum_data, ($ptrA[$_]>>8) & 0xff;
	}
	#各チャンネルのアドレス（メイン）
	if($intro) {
		for (0..7) {
			push @sum_data, $ptrI[$_] & 0xff;
			push @sum_data, ($ptrI[$_]>>8) & 0xff;
		}
	}

	$num *= 8;
	$j = $num;
	$i = $startARAM + @sum_data - ($intro?32:16);
	$sum_data[$num++] = $i & 0xff;
	$sum_data[$num++] = ($i >> 8) & 0xff;
	$i = $startARAM + @sum_data - 16;
	$sum_data[$num++] = $i & 0xff;
	$sum_data[$num++] = ($i >> 8) & 0xff;
	$sum_data[$num++] = 0xff;
	$sum_data[$num++] = 0;
	$i = $startARAM + $j + 2;
	$sum_data[$num++] = $i & 0xff;
	$sum_data[$num++] = ($i >> 8) & 0xff;
}



sub ReadSnesAddress {
	my ($pc_addr) = @_;
	local *FILE = $_[1];
	seek FILE, $pc_addr, 0;
	read FILE, my $buf, 1;
	my $snes_addr = unpack("C",$buf);
	read FILE, $buf, 1;
	$snes_addr += unpack("C",$buf)*0x100;
	read FILE, $buf, 1;
	$snes_addr += unpack("C",$buf)*0x10000;
	return $snes_addr;
}


#create msc
sub Msc {
	my $msc_file = $rom;
	$msc_file =~ s/\.smc$/.msc/i;
	open (MSC, ">$msc_file");
	for (0x01..0xfe) {
		my $i = sprintf("%x",$_);
		next unless($msc{$i});
		my $title = $msc{$i};
		$title =~ s/\.txt$//i;
		print MSC "$i\t0\t$title\n";
		print MSC "$i\t1\t$title\n";
	}
	close(MSC);
}




