Help language development. Donate to The Perl Foundation

ABC zef:colomon last updated on 2021-03-20

bin/abcoctave
#!/usr/bin/env perl6

use v6;
use ABC::Header;
use ABC::Tune;
use ABC::Grammar;
use ABC::Actions;
use ABC::Duration; #OK
use ABC::Note;
use ABC::LongRest;
use ABC::Utils;

sub print-header($out, $header) {
    for $header.lines -> $header-line {
        say $header-line.key ~ ":" ~ $header-line.value;
    }
}

sub print-music($out, @music, &shifter) {
    for @music -> $element {
        given $element.key {
            when 'endline' { say ""; }
            when 'inline_field' { print "[{$element.value.key}:{$element.value.value}]"; }
            print $element.value ~~ ABC::Pitched ?? ~$element.value.transpose(&shifter) !! $element.value;
        }
    }
}

sub Transpose($in, $out, $shift) {
    sub shift-octave($accidental, $basenote, $octave) {
        my ($note, $number) = to-note-and-number($basenote, $octave);
        my ($new-note, $new-octave) = from-note-and-number($note, $number + $shift);
        ($accidental, $new-note, $new-octave);
    }

    my $actions = ABC::Actions.new;
    my $match = ABC::Grammar.parse($in.slurp, :rule<tune_file>, :$actions);
    die "Did not match ABC grammar: last tune understood:\n { $actions.current-tune }" unless $match;

    for @( $match.ast ) -> $tune {
        $*ERR.say: "Working on { $tune.header.get-first-value("T") // $tune.header.get-first-value("X") }";
        print-header($out, $tune.header);
        print-music($out, $tune.music, &shift-octave);
    }
}

multi sub MAIN("up") {
    Transpose($*IN, $*OUT, +1);
}

multi sub MAIN("down") {
    Transpose($*IN, $*OUT, - 1);
}

multi sub MAIN(Int $shift) {
    Transpose($*IN, $*OUT, $shift);
}