#!/usr/bin/perl
my $RCS_Id = '$Id: skel1.pl,v 1.1 2006/07/19 08:54:04 jv Exp $ ';

# Author          : Johan Vromans
# Created On      : Tue Sep 11 17:04:55 2007
# Last Modified By: Johan Vromans
# Last Modified On: Tue Aug  2 09:58:01 2011
# Update Count    : 78
# Status          : Unknown, Use with caution!

################ Common stuff ################

use strict;
use warnings;

# Package or program libraries, if appropriate.
# $LIBDIR = $ENV{'LIBDIR'} || '/usr/share/lib/sample';
# use lib qw($LIBDIR);
# require 'common.pl';

################ Setup  ################

# Process command line options, config files, and such.
my $options = app_setup("rg2ly", "0.01");

################ Presets ################

$options->{trace} = 1   if $options->{debug};
$options->{verbose} = 1 if $options->{trace};

################ Activate ################

main($options);

################ The Process ################

sub main {
    my ($options) = @_;
    @ARGV = qw(-) unless @ARGV;
    lyabsrel($_, $options) foreach @ARGV;
}

################ Subroutines ################

my $rel;

sub lyabsrel {
    my ($file, $o) = @_;

    my $fh = \*STDIN;
    open($fh, "<", $file) unless $file eq "-";
    die("$file: $!\n") unless $fh;

    while ( <$fh> ) {
	next if /^%/;
	next if /^\s*\\break\s*$/;
	if ( $options->{relative} ) {
	    if ( /^(\s+).+\|\s*$/ ) {
		if ( defined $rel ) {
		    $_ = "  " . $_;
		}
		else {
		    $_ = $1 . '\relative ' . $options->{relative} .
		      ' { ' . "\n  " . $_;
		}
		$rel = $1;
		s/(?<= )([a-g](?:[ei]s)?)([',]*)(?=[ \d.])/nextnote($1,$2)/eg;
	    }
	    elsif ( defined $rel && !/^%/ ) {
		$_ = $rel."}\n".$_;
		nextnote(undef);
		undef $rel;
	    }
	}
    }
    continue {
	print;
    }
    close($fh) unless $fh eq "-";
}

sub abspitch {
    my ($pitch, $mod) = @_;
    $pitch = ord($pitch) - ord("a");
    $pitch += 7 if $pitch < 2;
    $mod = 0 + ($mod =~ tr/\'/\'/) - ($mod =~ tr/,/,/);
    $pitch + 7 * $mod;
}

my $prevpitch;

sub nextnote {
    my ($pitch, $mod) = @_;
    undef $prevpitch, return unless defined $pitch;
    unless ( defined $prevpitch ) {
	$prevpitch = abspitch($pitch, $mod);
	# warn("=> $pitch$mod -> $prevpitch\n");
	return "$pitch$mod";;
    }
    my $p = abspitch($pitch, $mod);
    my $p0 = $p;
    $mod = "";
    if ( $p < $prevpitch ) {
	$prevpitch = $p, return $pitch if $p >= $prevpitch - 3;
	while ( $p < $prevpitch ) {
	    $mod .= ",";
	    $p += 7;
	}
    }
    elsif ( $p > $prevpitch ) {
	$prevpitch = $p, return $pitch if $p <= $prevpitch + 3;
	while ( $p > $prevpitch ) {
	    $mod .= "'";
	    $p -= 7;
	}
    }
    $prevpitch = $p0;
    return $pitch.$mod;
}

################ Options and Configuration ################

use Getopt::Long 2.13;
use File::Spec;
use Carp;

# Package name.
my $my_package;
# Program name and version.
my ($my_name, $my_version);
my %configs;

sub app_setup {
    my ($appname, $appversion, %args) = @_;
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally

    # Package name.
    $my_package = $args{package};
    # Program name and version.
    if ( defined $appname ) {
	($my_name, $my_version) = ($appname, $appversion);
    }
    else {
	($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
	# Tack '*' if it is not checked in into RCS.
	$my_version .= '*' if length('$Locker:  $ ') > 12;
    }

    %configs =
      ( sysconfig  => File::Spec->catfile ("/", "etc", lc($my_name) . ".conf"),
	userconfig => File::Spec->catfile($ENV{HOME}, ".".lc($my_name), "conf"),
	config     => "." . lc($my_name) .".conf",
#	config     => lc($my_name) .".conf",
      );

    my $options =
      {
       verbose		=> 0,		# verbose processing
       ### ADD OPTIONS HERE ###
       relative		=> '',		# make notes relative

       # Development options (not shown with -help).
       debug		=> 0,		# debugging
       trace		=> 0,		# trace (show process)

       # Service.
       _package		=> $my_package,
       _name		=> $my_name,
       _version		=> $my_version,
       _stdin		=> \*STDIN,
       _stdout		=> \*STDOUT,
       _stderr		=> \*STDERR,
       _argv		=> [ @ARGV ],
      };

    # Colled command line options in a hash, for they will be needed
    # later.
    my $clo = {};

    # Sorry, layout is a bit ugly...
    if ( !GetOptions
	 ($clo,

	  ### ADD OPTIONS HERE ###
	  'relative=s',

	  # Configuration handling.
	  'config=s',
	  'noconfig',
	  'sysconfig=s',
	  'nosysconfig',
	  'userconfig=s',
	  'nouserconfig',
	  'define|D=s%' => sub { $clo->{$_[1]} = $_[2] },

	  # Standard options.
	  'ident'		=> \$ident,
	  'help|?'		=> \$help,
	  'verbose',
	  'trace',
	  'debug',
	 ) )
    {
	# GNU convention: message to STDERR upon failure.
	app_usage(\*STDERR, 2);
    }
    # GNU convention: message to STDOUT upon request.
    app_usage(\*STDOUT, 0) if $help;
    app_ident(\*STDOUT) if $ident;

    # If the user specified a config, it must exist.
    # Otherwise, set to a default.
    for my $config ( qw(sysconfig userconfig config) ) {
	for ( $clo->{$config} ) {
	    if ( defined($_) ) {
		croak("$_: $!\n") if ! -r $_;
		next;
	    }
	    $_ = $configs{$config};
	    undef($_) unless -r $_;
	}
	app_config($options, $clo, $config);
    }

    # Plug in command-line options.
    @{$options}{keys %$clo} = values %$clo;

    $options;
}

sub app_ident {
    my ($fh) = @_;
    print {$fh} ("This is ",
		 $my_package
		 ? "$my_package [$my_name $my_version]"
		 : "$my_name version $my_version",
		 "\n");
}

sub app_usage {
    my ($fh, $exit) = @_;
    app_ident($fh);
    print ${fh} <<EndOfUsage;
Usage: $0 [options]
    --relative=CXX	make notes relative to CXX
    ### ADD OPTIONS HERE ###

Configuration options:
    --config=CFG	project specific config file ($configs{config})
    --noconfig		don't use a project specific config file
    --userconfig=CFG	user specific config file ($configs{userconfig})
    --nouserconfig	don't use a user specific config file
    --sysconfig=CFG	system specific config file ($configs{sysconfig})
    --nosysconfig	don't use a system specific config file
    --define key=value  define or override a configuration option
Missing default configuration files are silently ignored.

Miscellaneous options:
    --help		this message
    --ident		show identification
    --verbose		verbose information
EndOfUsage
    exit $exit if defined $exit;
}

sub app_config {
    my ($options, $opts, $config) = @_;
    return if $opts->{"no$config"};
    my $cfg = $opts->{$config};
    return unless defined $cfg && -s $cfg;
    my $verbose = $opts->{verbose} || $opts->{trace} || $opts->{debug};
    warn("Loading $config: $cfg\n") if $verbose;

    # Process config data, filling $options ...
}