
use MIDI;
use strict;
use warnings;
my $patNo;
my $rowNo=0;
my $patMult = 0;
my $lastRow = 0;
my @columns;
my $emptyRow = "^ROW (?'row'..)";
my $fullRow = "^ROW (?'row'..)";
my $rowLength = 4;
my $rowSpeed = $rowLength;
my $expansion ;
my $noiseType= 0;
my @lastNote;
my @dpcmSamples;
my $last = "";
my @dpcmTransTable;
my @midiEvents;
my @midiOffs;
my @skip;
my @sweepOn = (0,0,0);
my @dpcmNames;

sub max ($$) { $_[$_[0] < $_[1]] }
sub min ($$) { $_[$_[0] > $_[1]] }

print "Unnamed Famitracker Text -> MIDINES converter\n";
print "by jmr - EARLY BETA - 2016-11-22\n";

my $file = shift @ARGV or die "Need to get text file on the command line\n";
open(my $data, '<', $file) or die "Could not open '$file' $!\n";
# if (@ARGV){
	# @dpcmTransTable = @ARGV;
# }


print "Ticks per beat (default = 24): ";
my $tickInput = <STDIN>; 
chomp $tickInput; 
if ($tickInput=~/\d+/ eq ''){
	$tickInput = 24;
}

#push @midiEvents,['control_change', 0, 4, 13, 127];
 my $header = 1;
 my $firstSample = 1;
while (my $line = <$data>) {
	chomp $line;
	if ($header == 1){
		if ($line=~/^DPCMDEF *\d+ *\d+ "(.+)"/){
			push @dpcmNames, $1;
		}
		
		if ($line=~/^KEYDPCM *(\d*) *(?'DcOct'\d*) *(?'DcNote'\d*) *(?'DcSamp'\d*) *(?'DcSpeed'\d*) *(?'DcLoop'\d*) *(\d*)/){
			if (($firstSample == 1) && ($#dpcmNames > 0)){
				my $printNum = $#dpcmNames+1;
				print "This song has $printNum DPCM sample(s)! Would you like to remap them to MIDINES samples? (Y or N): ";
				my $choice = <STDIN>; 
				chomp $choice; 
				if  (($choice eq "Y") || ($choice eq "y")){
					print "Assign each sample, number 0 - 255. \n";
					for (my $j=0;$j<=$#dpcmNames;$j++){
						print "$dpcmNames[$j]: ";
						my $choice = <STDIN>; 
						chomp $choice;
						$choice=~/(\d*)/;
						if (($1 eq '') || ($1 > 255)) {$dpcmTransTable[$j]=$j;}
						else {$dpcmTransTable[$j] = $1;}				
					}
				}
				$firstSample = 0;
			}
			my $dpcmNoteNum = $+{DcOct} * 12 + $+{DcNote};
			if(@dpcmTransTable[$+{DcSamp}]){
				$dpcmSamples[$dpcmNoteNum][0] = @dpcmTransTable[$+{DcSamp}];
			}
			else {
				$dpcmSamples[$dpcmNoteNum][0] = $+{DcSamp}; 
			}
			$dpcmSamples[$dpcmNoteNum][1] = $+{DcSpeed};
			$dpcmSamples[$dpcmNoteNum][2] = $+{DcLoop};
		}
		elsif ($line=~/EXPANSION *(\d*)/){
			$expansion = $1;
		}
		elsif ($line=~/^TRACK *(\d+) *(\d+) *(\d+)/){
			$patMult = $1;
			$rowLength = max($2,4);
			$rowSpeed = $2;
			my $tempo = sprintf "%.0f", ($tickInput*$rowSpeed*(100000/6)*(150/$3));
			push @midiEvents,['set_tempo', 0, $tempo ];
			#turn off sweep
			push @midiEvents,['control_change', 0, 0, 13, 0]; 
			push @midiEvents,['control_change', 0, 1, 13, 0]; 
			
		}
		elsif ($line=~/^COLUMNS : (.*)/){
			@columns = split / /, $1;
			for (my $j=0;$j<=$#columns;$j++){
				push @lastNote, 256;
			}

			for (my $j=1;$j<=$#columns+1;$j++){
				$emptyRow .= " : \\.\\.\\. \\.\\. \\.";
				$fullRow .= " : (?'ch".$j."n'...) (?'ch".$j."i'..) (?'ch".$j."v'.)";
			
				for (my $i=1;$i<=$columns[$j-1];$i++){
					$emptyRow .= " \\.\\.\\.";
					$fullRow .= " (?'ch".$j."e".$i."'...)";
				}
			}
			$header = 0;
		}
		
	}
	else {
		if ($line=~qr/$emptyRow/) {
			if ($skip[0] == 0){
				$rowNo++;
			}
		}
		elsif ($line=~qr/$fullRow/) {
			if ($skip[0] == 0){
				push @midiEvents,['note_off', $rowNo*$rowSpeed+1, 23, 0, 0];
				$rowNo=0;
				push @midiEvents,@midiOffs;
				undef(@midiOffs);

				
				for (my $j=1;$j<=$#columns;$j++){
					my $name = "ch".$j."v";
					pushVol($+{$name},$j-1);
					for (my $i=1;$i<=$columns[$j-1];$i++){
						my $name = "ch".$j."e".$i;
						pushEff($+{$name},$j-1);
					}
				}
				
				pushNote($+{ch1n},0);
				pushNote($+{ch2n},1);
				pushNote($+{ch3n},2);
				pushNoise($+{ch4n},3);
				pushDPCM($+{ch5n},4);
				 for (my $j=6;$j<=$#columns;$j++){
					 my $name = "ch".$j."n";
					 pushNote($+{$name},$j-1);
				 }
				
		   
				push @midiEvents,['note_off', $rowSpeed-1, 23, 0, 0];
			}
		}
		elsif ($line=~/^PATTERN (?'patno'..)/){
			$patNo = hex($+{patno})*$patMult;
			$skip[0] = 0;
		}
	}
}
close $data;
$file =~ s{\.[^.]+$}{}; # removes extension

#clean out extra events!
for (my $i=0;$i<=$#midiEvents;$i++){
	if (($midiEvents[$i][2] == 23) && ($midiEvents[$i][0] eq 'note_off')){
		if($i!=$#midiEvents){$midiEvents[$i+1][1] += $midiEvents[$i][1];}
		splice @midiEvents, $i, 1;
		$i--;
	}
}

my $midiTrack = MIDI::Track->new({ 'events' => \@midiEvents });
my $opus = MIDI::Opus->new(
	{ 'format' => 0, 'ticks' => $rowSpeed*$tickInput, 'tracks' => [ $midiTrack ] } );
$opus->write_to_file( "$file.mid" );
#$midiTrack->dump();

sub pushNote {
	my($note, $channel) = @_;
	my $offset = 24;
	if ($channel == 2) {
		$offset = 12;
	} 

	if($note eq "...") {}
	elsif ($note eq "---"){
		if ($lastNote[$channel] != 256) {
			push @midiEvents,['note_off', 0, $channel, $lastNote[$channel], 127];
			if ($sweepOn[$channel] == 1){push @midiEvents,['control_change', 0, $channel, 13, 0];} #disable sweep
			@lastNote[$channel] = 256;
		}
	}
	elsif ($note eq "==="){
		#note release here
	}
	else {
		$note =~ s/-//;
		$note =~ s/#/s/;
		if ($lastNote[$channel] != 256) {
			push @midiOffs,['note_off', 0, $channel, $lastNote[$channel], 127];
		}
		#this makes sense for general midi but adds needless ticks with midines.
		#elsif ($lastNote[$channel] == $MIDI::note2number{$note}+$offset) {
		#	push @midiEvents,['note_off', 0, $channel, $lastNote[$channel], 127];
		#}
		push @midiEvents,['note_on', 0, $channel, $MIDI::note2number{$note}+$offset,127];
		if ($sweepOn[$channel] == 1){push @midiEvents,['control_change', 0, $channel, 13, 0];} #disable sweep
		@lastNote[$channel] = $MIDI::note2number{$note}+$offset;
	}

}

sub pushDPCM {
	my($note, $channel) = @_;
	my $offset = 0;
	if ($channel == 2) {$offset = 12;} 

	if($note eq "...") {}
	elsif ($note eq "---" || $note eq "==="){
		if ($lastNote[$channel] != 256) {
			push @midiEvents,['note_off', 0, $channel, $lastNote[$channel], 127];
			@lastNote[$channel] = 256;
		}
	}
	else {
		$note =~ s/-//;
		$note =~ s/#/s/;
		my $dpcmNoteNum = $MIDI::note2number{$note};
		if ($lastNote[$channel] != 256) {
			push @midiOffs,['note_off', 0, $channel, $lastNote[$channel], 127]; #if any other note, put note off later
		}
		elsif ($lastNote[$channel] == $dpcmSamples[$dpcmNoteNum][0]) {
			push @midiEvents,['note_off', 0, $channel, $lastNote[$channel], 127]; #if same note, put note off now.
		}
		my $dpcmSpeedCC =  $dpcmSamples[$dpcmNoteNum][1]*8 + 4;
		my $dpcmLoopCC =  $dpcmSamples[$dpcmNoteNum][2] * 80;
		
		push @midiEvents,['control_change', 0, $channel, 4, $dpcmLoopCC];
		push @midiEvents,['control_change', 0, $channel, 3, $dpcmSpeedCC];
		#print $dpcmSamples[$dpcmNoteNum][0]&0x80; print "\n";
		push @midiEvents,['control_change', 0, $channel, 14, ($dpcmSamples[$dpcmNoteNum][0]&0x80)*0.75];
		push @midiEvents,['note_on', 0, $channel, ($dpcmSamples[$dpcmNoteNum][0])&0x7f,127];
		@lastNote[$channel] = $dpcmSamples[$dpcmNoteNum][0];
	}
}

sub pushNoise {
	my($note, $channel) = @_;
	if($note eq "...") {}
	elsif ($note eq "---"){
		if ($lastNote[$channel] != 256) {
			push @midiEvents,['note_off', 0, $channel, $lastNote[$channel], 127];

			@lastNote[$channel] = 256;

		}
	}
	elsif ($note eq "==="){
		#note release here
	}
	else {
		$note =~/(.)-#/;
	    my $noiseNote = 47 - hex($1) + 48*$noiseType;
		if ($lastNote[$channel] != 256) {
			push @midiOffs,['note_off', 0, $channel, $lastNote[$channel], 127];
		}
			push @midiEvents,['note_on', 0, $channel, $noiseNote,127];
		@lastNote[$channel] = $noiseNote;
	}
}


sub pushVol {
	my($vol, $channel) = @_;
	if($vol eq ".") {}
	else {
		$vol = ((hex($vol)+1)*8)-1;
		push @midiEvents,['control_change', 0, $channel, 7, $vol];
	}
}

sub pushEff {
	my($eff, $channel) = @_;
	if($eff eq "...") {}
	else {
		$eff =~/(.)(..)/;
		if ($1 eq "V") {   #duty cycle + noise type
			my $mod;
			if ($channel == 3) {
				$noiseType = $2;
			}
			if ( ( ($expansion & 0x01) == 0x01) && (($channel == 5) || ($channel == 6)) ){
				$mod = ((hex($2)+1)*16)-1;
			}
			else {
				$mod = ((hex($2)+1)*32)-1;
			}
			push @midiEvents,['control_change', 0, $channel, 1, $mod];
		}
		elsif ($1 eq "P") {   #duty cycle + noise type
			my $pitch = (hex($2) - 128)*4;
			push @midiEvents,['pitch_wheel_change', 0, $channel, $pitch];
		}
		elsif ($1 eq "Z") {
			my $dacVal = hex($2);
			push @midiEvents,['control_change', 0, $channel, 2, $dacVal];
		}
		elsif ($1 eq "F") {
			if (hex($2) <= 31){
				$rowSpeed = $rowLength * max(1,hex($2));
			}
		}
		elsif ($1 eq "D") {
			$skip[0] = 1;
			$skip[1] = $2;
		}
		elsif ($1 eq "H") {
			$sweepOn[$channel] = 1;
			$2=~/(.)(.)/;
			push @midiEvents,['control_change', 0, $channel, 13, 127]; #enable sweep
			push @midiEvents,['control_change', 0, $channel, 14, 127]; #up sweep
			push @midiEvents,['control_change', 0, $channel, 15, 0];
			#push @midiEvents,['control_change', 0, $channel, 15, (hex($1)&7)*16];  #midines doesn't like this.
			push @midiEvents,['control_change', 0, $channel, 16, (hex($2)&7)*16]; #up sweep
		}
		elsif ($1 eq "I") {
			$sweepOn[$channel] = 1;
			$2=~/(.)(.)/;
			push @midiEvents,['control_change', 0, $channel, 13, 127]; #enable sweep
			push @midiEvents,['control_change', 0, $channel, 14, 0]; #up sweep
			push @midiEvents,['control_change', 0, $channel, 15, 0];
			#push @midiEvents,['control_change', 0, $channel, 15, (hex($1)&7)*16];  #midines doesn't like this.
			push @midiEvents,['control_change', 0, $channel, 16, (hex($2)&7)*16]; 
		}
		else {
			if ($1 ne $last ){
				print "Effect $1xx is not supported!\n";
			}
			$last = $1;
		}
	}	
}



