Tools for Frets on Fire Song Creators

#!/usr/bin/perl #------------------------------------------------------------------------------------ #- Copyright (C) 2006, 2007 Bernhard Schelling (barna@nukular.ch) #- #- This program is free software; you can redistribute it and/or modify #- it under the terms of the GNU General Public License as published by #- the Free Software Foundation; either version 2 of the License, or #- (at your option) any later version. #- #- This program is distributed in the hope that it will be useful, #- but WITHOUT ANY WARRANTY; without even the implied warranty of #- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #- GNU General Public License for more details. #- #- You should have received a copy of the GNU General Public License #- along with this program; if not, write to the Free Software #- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA #------------------------------------------------------------------------------------ use strict; my $maxsize = 1024*512; my (%in, %incontent, %intype); &ParseForm(); my $error = ""; my $usedtool = 0; #banned users print "Content-type: text/plain\n\nbanned" and exit if ($ENV{'REMOTE_ADDR'} eq "134.214.161.92") or ($ENV{'REMOTE_ADDR'} eq "90.2.237.95") or ($ENV{'REMOTE_ADDR'} eq "86.212.85.34"); #validate data if (defined $in{'sngshift'}) { $in{'sngshift'} = int($in{'sngshift'}); } if (defined $in{'bpm'}) { $in{'bpm'} = int($in{'bpm'}); } if (defined $in{'shift'}) { $in{'shift'} = int($in{'shift'}); } #start tools eval { if (($in{'sngfile0'}) or ($in{'sngfile1'}) or ($in{'sngfile2'}) or ($in{'sngfile3'})) { $error = &DecodeSNGFile(); $usedtool = 1; } elsif ($in{'doconvert'}) { $error = "You must specify a SNG file to convert!"; $usedtool = 1; } elsif ($in{'datatoobig'}) { $error = "File is too big"; } elsif ($in{'midfileshift'}) { $error = &ShiftMIDFile(); $usedtool = 3; } elsif ($in{'doshift'}) { $error = "You must specify a MIDI file to shift!"; $usedtool = 3; } elsif ($in{'midfileskillchange'}) { $error = &ChangeSkillMIDFile(); $usedtool = 4; } elsif ($in{'doskillchange'}) { $error = "You must specify a MIDI file to change!"; $usedtool = 4; } elsif ($in{'midfileskillduplicate'}) { $error = &DuplicateSkillMIDFile(); $usedtool = 5; } elsif ($in{'doskillduplicate'}) { $error = "You must specify a MIDI file to change!"; $usedtool = 5; } elsif ($in{'showsource'}) { &ShowSource(); exit; } elsif ($in{'showsourcecmd'}) { &ShowSourceCMD(); exit; } elsif ($in{'downloadcmdwin32'}) { &DownloadCMDWin32(); exit; } }; if ($@) { $error = $@; $error =~ s/\n//; $error =~ s/handle GLOB$.*?$/input file/; $error =~ s/ at.*/\./; } &ToolLog("INDEX", ($error ? "Err:".$error : ($ENV{'HTTP_REFERER'} ? "Ref:".$ENV{'HTTP_REFERER'} : "") ) ); print "Content-type: text/html\n\n"; print "Tools for Frets on Fire Song Creators\n"; print "\n"; print "\n"; print ""; print "

"; if ($error) { print "

".$error."

"; } print ""; print ""; print "

Freetar Hero SNG to Frets on Fire MID converter

"; print ""; print ""; print "

Frets on Fire MID Note Shifter

"; print ""; print ""; print "

Frets on Fire Skill Changer

"; print ""; print ""; print "

Frets on Fire Track Duplicator

"; print "

Written in Perl by [GoE]Barna (The Guardians of Eternity - Nukular Design - Peng2illa)
Source - Source Command Line Version - Command Line Version Win32-EXE

"; print ""; print ""; exit; sub DecodeSNGFile { if (length($incontent{'sngfile0'}) > $maxsize) { return "File is too big"; } if (length($incontent{'sngfile1'}) > $maxsize) { return "File is too big"; } if (length($incontent{'sngfile2'}) > $maxsize) { return "File is too big"; } if (length($incontent{'sngfile3'}) > $maxsize) { return "File is too big"; } my @sng; my $bpm = 100; my @lines = split(/\n/, $incontent{'sngfile0'}); foreach (@lines) { if (/([0-9]+\.?[0-9]*)<\/BeatsPerSecond>/i) { $bpm = $1*6.25; } } my @lines = split(/\n/, $incontent{'sngfile1'}); foreach (@lines) { if (/([0-9]+\.?[0-9]*)<\/BeatsPerSecond>/i) { $bpm = $1*6.25; } } my @lines = split(/\n/, $incontent{'sngfile2'}); foreach (@lines) { if (/([0-9]+\.?[0-9]*)<\/BeatsPerSecond>/i) { $bpm = $1*6.25; } } my @lines = split(/\n/, $incontent{'sngfile3'}); foreach (@lines) { if (/([0-9]+\.?[0-9]*)<\/BeatsPerSecond>/i) { $bpm = $1*6.25; } } if (int($in{'bpm'})) { $bpm = int($in{'bpm'}); } undef @lines; if (@sng == 0) { return "Could not find any notes in the uploaded file(s)
Is it a correct file in the Freetar Hero SNG format?"; } my (%eon,%eoff,@datalocation); my $max = 0; foreach my $n (@sng) { my $non = int(@$n[0]*1000000); my $noff = int((@$n[0]+@$n[1])*1000000); if ($noff == $non) { $noff += 0.115*1000000; } push @{ $eon{$non} }, int(@$n[2]); push @{ $eoff{$noff} }, int(@$n[2]); if ($noff > $max) { $max = $noff; } push @datalocation, $non; push @datalocation, $noff; } @datalocation = sort {$a <=> $b} @datalocation; use MIDI; my $ticks = 480; if ($bpm < 10) { $bpm = 10; } if ($bpm > 1000) { $bpm = 1000; } my @events = ( ['set_tempo', 0, 60000_000/$bpm], # 6000 = 10 BPM | 600 = 100 BPM | 300 = 200 BPM ); my $musec = ($ticks/60)*$bpm/1000000; my $sngshift = 0; if (int($in{'sngshift'})) { $sngshift = int($in{'sngshift'}); } $sngshift *= 1000; my $lastevent = 0; my $notes = 0; foreach my $i (@datalocation) { my $eventtime = int(($i+$sngshift)*$musec); if (defined $eon{$i}) { for (1..@{$eon{$i}}) { my $n = shift(@{$eon{$i}}); push @events, ['note_on' , ($eventtime-$lastevent), 0, $n, 127]; $lastevent = $eventtime; $notes++; } } if (defined $eoff{$i}) { for (1..@{$eoff{$i}}) { my $n = shift(@{$eoff{$i}}); push @events, ['note_off' , ($eventtime-$lastevent), 0, $n, 127]; $lastevent = $eventtime; } } } my $click_track = MIDI::Track->new({ 'events' => \@events }); my $opus = MIDI::Opus->new( { 'format' => 0, 'ticks' => $ticks, 'tracks' => [ $click_track ] } ); &PrintDownloadHeader("notes.mid"); binmode(STDOUT); $opus->write_to_handle( *STDOUT{IO} ); &ToolLog("SNG2MID", "SNGs:".$in{'sngfile0'}."|".$in{'sngfile1'}."|".$in{'sngfile2'}."|".$in{'sngfile3'}); exit; } sub ShiftMIDFile { if (length($incontent{'midfileshift'}) > $maxsize) { return "File is too big"; } unless (int($in{'shift'})) { return "You need to specify a shift value"; } open my $fh, "<", \$incontent{'midfileshift'} or die; my $shift = int($in{'shift'}); use MIDI; binmode($fh); my $opus = MIDI::Opus->new( { 'from_handle' => $fh , 'no_parse' => 0 } ); my $msec = 0; my @tracks = $opus->tracks(); my @outtracks; my $parselimit = scalar(@tracks); restarttracks: for (my $i=0;$i<$parselimit;$i++) { my $t = $tracks[$i]; my @events = $t->events(); my $numevents = scalar($t->events); if ($shift) { my $shiftleft = $shift; for (my $x=0;$x<$numevents;$x++) { my $e = $events[$x]; if ($msec == 0) { if ($e->[0] eq "set_tempo") { $msec = ($opus->ticks/60)*(60000000 / $e->[2])/1000; goto restarttracks; } } elsif (($e->[0] eq "note_on") or ($e->[0] eq "note_off")) { if (($shiftleft > 0) or ($e->[1] > 0-$shiftleft*$msec)) { $e->[1] += $shiftleft*$msec; push (@outtracks, $tracks[$i]); $x = $numevents; } elsif ($e->[1] > 0) { $shiftleft += $e->[1]/$msec; $e->[1] = 0; } } if ($x == $numevents-1) { push (@outtracks, $tracks[$i]); } } } unless ($shift) { push (@outtracks, $tracks[$i]) if ($numevents != 0); } } my $opusout = MIDI::Opus->new( { 'format' => 0, 'ticks' => $opus->ticks, 'tracks' => \@outtracks } ); &PrintDownloadHeader("notes.mid"); binmode(STDOUT); $opusout->write_to_handle( *STDOUT{IO} ); &ToolLog("SHIFT", "Mid:".$in{'midfileshift'}."|Shift:".$shift); exit; } sub ChangeSkillMIDFile { if ((($in{'amazing'} eq $in{'medium'}) or ($in{'amazing'} eq $in{'easy'}) or ($in{'amazing'} eq $in{'supaeasy'}) or ($in{'medium'} eq $in{'easy'}) or ($in{'medium'} eq $in{'supaeasy'}) or ($in{'easy'} eq $in{'supaeasy'})) && (!defined $in{'allowmerge'})) { return "You must allow merging if you select the same target skill multiple times"; } if (length($incontent{'midfileskillchange'}) > $maxsize) { return "File is too big"; } open my $fh, "<", \$incontent{'midfileskillchange'} or die; use MIDI; binmode($fh); my $opus = MIDI::Opus->new( { 'from_handle' => $fh , 'no_parse' => 0 } ); my $msec = 0; my @tracks = $opus->tracks(); my @outtracks; my $parselimit = scalar(@tracks); for (my $i=0;$i<$parselimit;$i++) { my $t = $tracks[$i]; my @events = $t->events(); my $numevents = scalar($t->events); for (my $x=0;$x<$numevents;$x++) { my $e = $events[$x]; if (($e->[0] eq "note_on") or ($e->[0] eq "note_off")) { if (($e->[3] >= 96) && ($e->[3] < 96+12)) { if ($in{'amazing'} eq "2") { $e->[3]-=12; } if ($in{'amazing'} eq "1") { $e->[3]-=24; } if ($in{'amazing'} eq "0") { $e->[3]-=36; } } elsif (($e->[3] >= 84) && ($e->[3] < 84+12)) { if ($in{'medium'} eq "3") { $e->[3]+=12; } if ($in{'medium'} eq "1") { $e->[3]-=12; } if ($in{'medium'} eq "0") { $e->[3]-=24; } } elsif (($e->[3] >= 72) && ($e->[3] < 72+12)) { if ($in{'easy'} eq "3") { $e->[3]+=24; } if ($in{'easy'} eq "2") { $e->[3]+=12; } if ($in{'easy'} eq "0") { $e->[3]-=12; } } elsif (($e->[3] >= 60) && ($e->[3] < 60+12)) { if ($in{'supaeasy'} eq "3") { $e->[3]+=36; } if ($in{'supaeasy'} eq "2") { $e->[3]+=24; } if ($in{'supaeasy'} eq "1") { $e->[3]+=12; } } } } push (@outtracks, $tracks[$i]) if ($numevents != 0); } my $opusout = MIDI::Opus->new( { 'format' => 0, 'ticks' => $opus->ticks, 'tracks' => \@outtracks } ); &PrintDownloadHeader("notes.mid"); binmode(STDOUT); $opusout->write_to_handle( *STDOUT{IO} ); &ToolLog("SKILL", "Mid:".$in{'midfileskillchange'}."|A:".$in{'amazing'}."|M:".$in{'medium'}."|E:".$in{'easy'}."|S:".$in{'supaeasy'}); exit; } sub DuplicateSkillMIDFile { if (length($incontent{'midfileskillduplicate'}) > $maxsize) { return "File is too big"; } open my $fh, "<", \$incontent{'midfileskillduplicate'} or die; use MIDI; binmode($fh); my $opus = MIDI::Opus->new( { 'from_handle' => $fh , 'no_parse' => 0 } ); my $msec = 0; my @tracks = $opus->tracks(); my @outtracks; my $parselimit = scalar(@tracks); my $o = 0; for (my $i=0;$i<$parselimit;$i++) { my $t = $tracks[$i]; my @events = $t->events(); my $numevents = scalar($t->events); if ($numevents) { $outtracks[$o] = MIDI::Track->new(); for (my $x=0;$x<$numevents;$x++) { my $e = $events[$x]; $outtracks[$o]->new_event( $e->[0] , $e->[1] , $e->[2] , $e->[3] , $e->[4] ); if (($e->[0] eq "note_on") or ($e->[0] eq "note_off")) { my $nn = 0; if (($e->[3] >= 96) && ($e->[3] < 96+12) && ($in{'source'} eq "3")) { if ($in{'target'} eq "2") { $nn = $e->[3]-12; } if ($in{'target'} eq "1") { $nn = $e->[3]-24; } if ($in{'target'} eq "0") { $nn = $e->[3]-36; } } elsif (($e->[3] >= 84) && ($e->[3] < 84+12) && ($in{'source'} eq "2")) { if ($in{'target'} eq "3") { $nn = $e->[3]+12; } if ($in{'target'} eq "1") { $nn = $e->[3]-12; } if ($in{'target'} eq "0") { $nn = $e->[3]-24; } } elsif (($e->[3] >= 72) && ($e->[3] < 72+12) && ($in{'source'} eq "1")) { if ($in{'target'} eq "3") { $nn = $e->[3]+24; } if ($in{'target'} eq "2") { $nn = $e->[3]+12; } if ($in{'target'} eq "0") { $nn = $e->[3]-12; } } elsif (($e->[3] >= 60) && ($e->[3] < 60+12) && ($in{'source'} eq "0")) { if ($in{'target'} eq "3") { $nn = $e->[3]+36; } if ($in{'target'} eq "2") { $nn = $e->[3]+24; } if ($in{'target'} eq "1") { $nn = $e->[3]+12; } } if ($nn) { $outtracks[$o]->new_event( $e->[0] , 0 ,$e->[2] , $nn , $e->[4] ); } } } } } my $opusout = MIDI::Opus->new( { 'format' => 0, 'ticks' => $opus->ticks, 'tracks' => \@outtracks } ); &PrintDownloadHeader("notes.mid"); binmode(STDOUT); $opusout->write_to_handle( *STDOUT{IO} ); &ToolLog("DUPLIC", "Mid:".$in{'midfileskillduplicate'}."|S:".$in{'source'}."|T:".$in{'target'}); exit; } sub PrintDownloadHeader { print "Content-Type: application/force-download\n"; print "Content-Type: application/octet-stream\n"; print "Content-Type: application/download\n"; print "Pragma: public\n"; print "Expires: 0\n"; print "Cache-Control: must-revalidate, post-check=0, pre-check=0\n"; # use the Content-Disposition header to supply a recommended filename and # force the browser to display the save dialog. print "Content-Disposition: attachment; filename=".$_[0].";\n"; print "Content-Transfer-Encoding: binary\n"; #print "Content-Length: 123\n"; #unknown at that time print "\n"; } sub ParseForm { my $Buffer = ""; if (int($ENV{'CONTENT_LENGTH'}) > $maxsize*3) { $in{'datatoobig'} = 1; return; } #cancel and return at this point if submitted data is very large if ($ENV{'CONTENT_TYPE'} ne "application/octet-stream") { if ((substr($ENV{'CONTENT_TYPE'}, 0, 29) eq "multipart/form-data; boundary") and ($ENV{'REQUEST_METHOD'} eq "POST")) { my $data; binmode STDIN; read STDIN, $data, $ENV{'CONTENT_LENGTH'}; # find key $data =~ /(\-+?[a-z0-9]+?)\r\n/i; my $key = $1; my @pieces = split(/$key/,$data); shift @pieces; pop @pieces; foreach my $p (@pieces) { if($p =~ /^[\r\n]{1,2}Content-Disposition: form-data; name="([^"]*?)"[\r\n]{1,2}[\r\n]{1,2}(.*)[\r\n]{1,2}/is) { ### Form field my $Name = $1; my $Value = $2; $Value =~ tr/+/ /; $Value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $Value =~ s/\r//g; $Value =~ s/^\s+//g; $Value =~ s/\s+$//g; $in{$Name} = $Value; } elsif($p =~ /^[\r\n]{1,2}Content-Disposition: form-data; name="(.*?)"; filename="([^"]+?)"[\r\n]{1,2}Content-type: (.*?)[\r\n]{1,2}[\r\n]{1,2}(.*)[\r\n]{1,2}/is) { ### File with content type my $Name = $1; my $filename = $2; my $ctype = $3; my $content = $4; if ($ctype =~ /text/i) { $content =~ s/\r\n/\n/gi; $content =~ s/\r/\n/gi; } $filename =~ s/.*\\//; $filename =~ s/.*\///; $in{$Name} = $filename; $intype{$Name} = $ctype; $incontent{$Name} = $content; } elsif($p =~ /^[\r\n]{1,2}Content-Disposition: form-data; name="(.*?)"; filename="([^"]+?)"[\r\n]{1,2}[\r\n]{1,2}(.*)[\r\n]{1,2}/is) { ### File without content type my $Name = $1; my $filename = $2; my $content = $3; $filename =~ s/.*\\//; $filename =~ s/.*\///; $in{$Name} = $filename; $intype{$Name} = "unknown"; $incontent{$Name} = $content; } } } else { if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $Buffer, $ENV{'CONTENT_LENGTH'}); } } } my (@Pairs, $Pair, $Name, $Value); if (length($Buffer)) { $Buffer.="&"; } if ($ENV{'QUERY_STRING'}) { $Buffer.=$ENV{'QUERY_STRING'}; } @Pairs = split(/&/, $Buffer); foreach $Pair (@Pairs) { my ($Name, $Value) = split(/=/, $Pair); $Value =~ tr/+/ /; $Value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $Value =~ s/\r//g; $Value =~ s/^\s+//g; $Value =~ s/\s+$//g; if (defined $in{$Name}) { $in{$Name}.= ":".$Value; } else { $in{$Name} = $Value; } } } sub ToolLog { my ($mode, $comment) = @_; open(LOG, ">>foftools.log"); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; printf LOG "%04d-%02d-%02d %02d\:%02d\t".$ENV{'REMOTE_ADDR'}."\t".$ENV{'HTTP_USER_AGENT'}."\t".$mode.($comment ? "\t".$comment : "")."\n", ($year+1900), ($mon+1), $mday, $hour,$min; close(LOG); } sub ShowSource { print "Content-type: text/plain\n\n"; open(SRC, "<".$ENV{'SCRIPT_FILENAME'}); print while (); close(SRC); &ToolLog("SOURCE"); } sub ShowSourceCMD { print "Content-type: text/plain\n\n"; open(SRC, "); close(SRC); &ToolLog("SOURCE"); } sub DownloadCMDWin32 { print "Content-Type: application/zip\n"; print "Content-Length: ".(-s "foftoolscmd-win32.zip")."\n"; PrintDownloadHeader("foftoolscmd-win32.zip"); open(SRC, "); close(SRC); &ToolLog("DLCMDWIN32"); }