#!/usr/bin/perl
# abc2chord.pl
# 19 Sep 2000 Anselm Lingnau <anselm@strathspey.de>

# Macabc2chord.pl
# Modified to be used as a MacPerl droplet with output file selection
# 26 September 2000 Robert Bley-Vroman <vroman@hawaii.edu>
# With improvements by R B-V and Frank Nordberg <frnordbe@online.no>
# For information on MacPerl http://macperl.com/

#!perl -w

$keep = "XTMK";  # String of headers to keep
$chord = q{"([^"]*)"}; # Pattern for chords
$bar = q{(:?\|+\s*\[\d|:?\|+\d|:?\[*\|+\]*:?|::)}; # Pattern for barlines
$chordfile = StandardPutFile('Save as: ', 'chords.abc');

use Mac::StandardFile; # User chooses output file with standard dialog box:

$chordfile->sfGood() or die; # Exit if no file selected, e.g. user cancels

open(OUT, '>' . $chordfile->sfFile()) or die; # Exit if file cannot be opened, e.g. file in use

# Extract headers and chords; write to chord file:
while (<>) {
  unless (/^%/) { # Remove % comment lines
     # Keep only header lines listed in $keep:
    if (($header) = /^([A-Z]|[a-z]):/) {
      print OUT if $header =~ /[$keep]/o;
      next;
    }
    $_ .= <> while /\\$/; # Merge continued lines
    $_ = join(' ', /$chord|$bar/g); # Extract chords and barlines
    s/^ *//; s/ +/ /g; # Remove extraneous whitespace
    s/\| \|/| - |/g; # Add placeholders for no-chord bars
    s/$bar $bar/\1 - \2/g; # Add placeholders for subsequent no-chord bars
    while (s/([^ ]*) ($bar) - /\1 \2 \1 /g) {} # Replace placeholders with previous chord.
    print OUT $_, "\n";
  }
}

MacPerl::SetFileInfo('R*ch', 'TEXT', $chordfile->sfFile()); # Set creator code and file type.
  # Creator codes:
  # TeachText: 'ttxt'
  # BBEdit: 'R*ch'
  # BarFly: 'Bfly'
  # ClarisWorks: 'BOBO'
  # SaintEdit: 'SNTE'
  # Netscape: 'MOSS'

close(OUT);