diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..870678d --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +*.pdf +*.ly +*.ps +.precomp +blib diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..43c4b5b --- /dev/null +++ b/.travis.yml @@ -0,0 +1,5 @@ +--- +sudo: false +language: perl6 +perl6: + - latest diff --git a/META6.json b/META6.json new file mode 100644 index 0000000..867622d --- /dev/null +++ b/META6.json @@ -0,0 +1,36 @@ +{ + "perl" : "6.*", + "name" : "ABC", + "version" : "0.7.2", + "auth" : "zef:colomon", + "description" : "Toolkit for dealing with ABC music notation", + "depends" : [ "File::Temp" ], + "license" : "Artistic-2.0", + "provides" : { + "abc2ly" : "bin/abc2ly", + "abc2book" : "bin/abc2book", + "abctranspose" : "bin/abctranspose", + "abcoctave" : "bin/abcoctave", + "abc2tuneindex" : "bin/abc2tuneindex", + "ABC::Duration" : "lib/ABC/Duration.rakumod", + "ABC::Pitched" : "lib/ABC/Pitched.rakumod", + "ABC::Header" : "lib/ABC/Header.rakumod", + "ABC::Grammar" : "lib/ABC/Grammar.rakumod", + "ABC::Note" : "lib/ABC/Note.rakumod", + "ABC::Stem" : "lib/ABC/Stem.rakumod", + "ABC::KeyInfo" : "lib/ABC/KeyInfo.rakumod", + "ABC::Utils" : "lib/ABC/Utils.rakumod", + "ABC::Tune" : "lib/ABC/Tune.rakumod", + "ABC::Rest" : "lib/ABC/Rest.rakumod", + "ABC::Tuplet" : "lib/ABC/Tuplet.rakumod", + "ABC::BrokenRhythm" : "lib/ABC/BrokenRhythm.rakumod", + "ABC::Chord" : "lib/ABC/Chord.rakumod", + "ABC::LongRest" : "lib/ABC/LongRest.rakumod", + "ABC::GraceNotes" : "lib/ABC/GraceNotes.rakumod", + "ABC::Context" : "lib/ABC/Context.rakumod", + "ABC::Actions" : "lib/ABC/Actions.rakumod", + "ABC::ToLilypond" : "lib/ABC/ToLilypond.rakumod" + }, + "source-type" : "git", + "source-url" : "git://github.com/colomon/ABC.git" +} diff --git a/README b/README deleted file mode 100644 index e69de29..0000000 diff --git a/README.md b/README.md new file mode 100644 index 0000000..d8f04fb --- /dev/null +++ b/README.md @@ -0,0 +1,40 @@ +# ABC + +This module is a set of tools for dealing with [ABC music notation](https://abcnotation.com/wiki/abc:standard:v2.1) files in Raku (formerly known as Perl 6). This includes a grammar for most of the notation format (the standard has a lot of twisty corners, and we do not support all of them), Raku data structures for representing them, and some useful utilities. + +```raku +my $music = q:to; + X:044 + T:Elsie Marley + B:Robin Williamson, "Fiddle Tunes" (New York 1976) + N:"printed by Robert Petrie in 1796 and is + N:"described by him as a 'bumpkin'." + Z:Nigel Gatherer + M:6/8 + L:1/8 + K:G + BAB G2G|G2g gdc|BAB G2G|=F2f fcA| + BAB G2G|G2g gdB|c2a B2g|A2=f fcA:| + ABC-end + +my $match = ABC::Grammar.parse($music, :rule, :actions(ABC::Actions.new)); +ok $match, 'tune recognized'; +isa-ok $match.ast, ABC::Tune, 'and ABC::Tune created'; +ok $match.ast.header.is-valid, "ABC::Tune's header is valid"; +is $match.ast.music.elems, 57, '$match.ast.music has 57 elements'; +``` + +There are several scripts in bin/ built on the library: + +* abc2ly: converts an ABC file to the Lilypond ly format, then invokes Lilypond on it to create high quality sheet music. If you install ABC using zef you should just be able to say ```abc2ly wedding.abc```to convert ```wedding.abc``` to ```wedding.pdf``` via Lilypond file ```wedding.ly``` + + NOTE: Lilypond also has an abc2ly script; last time I tried it it produced + hideous looking output from Lilypond. If you've got both installed, you will + have to make sure the Raku bin of abc2ly appears first in your PATH. + +* abc2book: Given an ABC file and a simple “book” instructions file (our own format), this makes a book PDF. This uses Lilypond for music formatting, LaTeX for table of contents and index of tunes, and qpdf to stitch the results together into one file. This is still pretty experimental, but has produced one published book, [The Fiddle Music of Newfoundland & Labrador Volume 1, Revised 2020 Edition](https://fmnl1.nltrad.ca) + +* abctranspose: Simple tool for transposing ABC files. + +* abcoctave: Simple tool for shifting the octave of ABC files. + diff --git a/bin/abc2book b/bin/abc2book new file mode 100755 index 0000000..03b1078 --- /dev/null +++ b/bin/abc2book @@ -0,0 +1,666 @@ +#!/usr/bin/env perl6 + +use v6; +use ABC::Grammar; +use ABC::Actions; +use ABC::ToLilypond; +use File::Temp; + +my $paper-size = "letter"; # or switch to "a4" for European paper +my $index-external = True; + +# This program always uses the external programs lilypond and qpdf for +# generating music notation. +# If $index-external is True, then it also uses pdftotext, latex, & dvipdf. + +# The index code that follows is incorporated from the Lilypond +# Snippet Repository, http://lsr.di.unimi.it/LSR/Item?id=763 + +sub write-index-snippet($out) { + $out.say: q:to/end-snippet/; + %% defined later, in a closure + #(define-public (add-index-item! markup-symbol text sorttext) #f) + #(define-public (index-items) #f) + + #(let ((index-item-list (list))) + (set! add-index-item! + (lambda (markup-symbol text sorttext) + (let ((label (gensym "index"))) + (set! index-item-list + ;; We insert index items sorted from the beginning on and do + ;; not sort them later - this saves pretty much computing time + (insert-alphabetical-sorted! (list label markup-symbol text sorttext) + index-item-list)) + (make-music 'EventChord + 'page-marker #t + 'page-label label + 'elements (list (make-music 'LabelEvent + 'page-label label)))))) + (set! index-items (lambda () + index-item-list))) + + #(define (insert-alphabetical-sorted! iitem ilist) + (if + (null? ilist) (list iitem) + (if + (string-ci, :$actions); + die "Did not match ABC grammar: last tune understood:\n { $actions.current-tune }" unless $match; + @( $match.ast ); +} + +sub start-bookpart($out, $title-string) { + my ($title, $subtitle) = $title-string.trim.split(":").map(*.trim); + + $out.say: "\\bookpart \{"; + $out.say: "\\header \{"; + $out.say: " title = \"{ sanitize-quotation-marks($title) }\""; + $out.say: " subtitle = \"{ sanitize-quotation-marks($subtitle) }\"" if $subtitle; + $out.say: "\}"; + + my $full-title = sanitize-quotation-marks($title-string.trim); + $out.say: qq{\\tocItem \\markup \\bold "$full-title"}; +} + +sub read-block(@book) { + my @block; + + while +@book { + my $line = @book[0]; + if $line ~~ / ^ \h+ \S / { + @block.push: $line.trim-leading; + @book.shift; + } else { + last; + } + } + + @block; +} + +sub write-lyric($out, @lines) { + $out.say: "\\noPageBreak"; + $out.say: "\\markup \\fill-line \{"; + $out.say: " \\column \\column-lines \{"; + for @lines -> $line { + $out.say: " \\italic \\line \{ { sanitize-quotation-marks($line) } \}"; + } + $out.say: " }"; + $out.say: "}"; +} + +sub write-text($out, @lines, :$centered) { + if $centered { + $out.say: "\\markup \\fill-line \{"; + $out.say: " \\center-column \\wordwrap-lines \{"; + } else { + $out.say: "\\markuplist \{"; + $out.say: " \\wordwrap-lines \{"; + } + for @lines -> $line { + $out.say: " { sanitize-quotation-marks($line) }"; + } + $out.say: " }"; + $out.say: "}"; +} + +sub make-index-sorting-name($full-name) { + my $name = $full-name; + $name.=subst(/ ^ "(" /, ""); + $name.=subst(/ ^ "A" \s+ /, ""); + $name.=subst(/ ^ "The" \s+ /, ""); + $name.=subst(/ ^ "La" \s+ /, ""); + $name.=subst(/ ^ "Le" \s+ /, ""); + $name.=subst(/ ^ "É" /, "E"); + $name; +} + +sub make-latex-name($full-name) { + my $name = $full-name; + $name.=subst(/ "&" /, "\\&", :global); + $name.=subst(/ "#" /, "\\#", :global); + $name.=subst(/ "＃" /, "\\#", :global); # Unicode full width number sign + $name; +} + +sub number-pages($pdf-file) { + my $proc = run "qpdf", "--show-npages", $pdf-file.Str, :out; + $proc.out.slurp(:close).comb(/ \d+ /).first; +} + +sub latex-to-pdf(IO::Path $tex-file) { + run "latex", '-output-directory=' ~ $tex-file.dirname.Str, + '-output-format=pdf', + $tex-file.Str; + # run "dvips", $tex-file.extension("dvi").Str; + # run "ps2pdf", $tex-file.extension("ps").Str; + $tex-file.extension("pdf"); +} + +sub make-blank-page($tempdir) { + my $blank-tex = IO::Path.new(basename => "blank.tex", dirname => $tempdir); + my $out = $blank-tex.open(:w); + $out.say: q:to/END/; + \documentclass[letterpaper]{article} + \usepackage[pass]{geometry} + \begin{document} + \shipout\hbox{} + \end{document} + END + + return latex-to-pdf($blank-tex); +} + +sub make-external-toc($tempdir, $pdf-file, @toc-extra-items, $toc-copyright, $toc-tools) { + # Following assumes one-page TOC, if more something more complicated + # will be needed. + + my @toc-items = @toc-extra-items; + + my $text = qqx/pdftotext -layout -f 1 -l 1 $pdf-file -/; + my @unsorted-index; + for $text.comb(/ ^^ \h* (\V+) \h+ (\d+) $$ /, :match) -> $match { + @toc-items.push(make-latex-name($match[0].Str.trim) => ~$match[1]); + } + + my $toc-tex = IO::Path.new(basename => "toc.tex", dirname => $tempdir); + my $out = $toc-tex.open(:w); + $out.say: q:to/END/; + \documentclass[12pt]{book} + \renewcommand{\familydefault}{\sfdefault} + \pagestyle{empty} + \usepackage[letterpaper, margin=1in, bindingoffset=.5in]{geometry} + \begin{document} + \hspace{0pt} + \vfill + \center{\bfseries{\huge Contents}} + \vspace{.5in} + END + + my $grouping = ""; + for @toc-items -> $toc-item { + my ($line-grouping, $section) = $toc-item.key.split(/ ':' \s+/); + if $section { + if $grouping ne $line-grouping { + $grouping = $line-grouping; + $out.say: '\contentsline {chapter}{' ~ $grouping ~ '}{' ~ $toc-item.value ~ '}\endgraf'; + } + $out.say: '\contentsline {section}{' ~ $section ~ '}{' ~ $toc-item.value ~ '}\endgraf'; + } else { + $out.say: '\contentsline {chapter}{' ~ $toc-item.key ~ '}{' ~ $toc-item.value ~ '}\endgraf'; + } + } + + $out.say: q:to/END/; + \vfill + END + + if $toc-copyright { + $out.say: qq:!c:!f:to/END/; + \\begin{center} + \\copyright \\ $toc-copyright + \\end{center} + END + } + + if $toc-tools { + $out.say: qq:!c:!f:to/END/; + \\begin{center} + $toc-tools + + Typesetting by abc2book, Lilypond, and \\LaTeX + \\end{center} + END + } + $out.say: q:to/END/; + \hspace{0pt} + \end{document} + END + $out.close; + + my $temp-file = IO::Path.new(basename => "temp.pdf", dirname => $tempdir); + run "qpdf", "--empty", + "--pages", + $pdf-file, "2-z", + "--", + ~$temp-file; + $temp-file.move($pdf-file); + + return latex-to-pdf($toc-tex); +} + +sub make-external-index($pdf-file, %tunes-hash) { + my $N = 0; + for 1..* -> $n { + my $text = qqx/pdftotext -layout -f $n -l $n $pdf-file -/; + if $text ~~ / "Alphabetical Index" / { + $N = $n; + last; + } + } + + my $text = qqx/pdftotext -layout -f $N $pdf-file -/; + my @unsorted-index; + for $text.comb(/ "ZYXXY" (\d+) "ZYXXY" \s+ (\d+) /, :match) -> $match { + my $X = $match[0]; + my $page-number = $match[1]; + my @names = %tunes-hash{$X}.header.get("T").map({ sanitize-quotation-marks($_.value) }); + for @names -> $name { + @unsorted-index.push(make-index-sorting-name($name) => $name => $page-number); + } + } + + dd $N; + + my $out = "index.tex".IO.open(:w); + $out.say: q:to/END/; + \documentclass[10pt]{article} + \usepackage{multicol} + + \usepackage[letterpaper, margin=1in, bindingoffset=.5in]{geometry} + + \begin{document} + + \begin{multicols}{2} + [ + \begin{center} + { \large \textbf{ Index of Tune Names } } + \end{center} + ] + + END + + $out.say: "\\setcounter\{page\}\{$N\}"; + + my $last-first-letter = ""; + for @unsorted-index.sort({ $_.key }) -> $tune { + my $first-letter = $tune.key.substr(0, 1); + if $last-first-letter ne $first-letter { + $out.say: "\\begin\{center\}"; + $out.say: "\{ \\large \\textbf\{ $first-letter \} \}"; + $out.say: "\\end\{center\}"; + } + $out.say: make-latex-name($tune.value.key) ~ ", " ~ $tune.value.value ~ " \\\\"; + $last-first-letter = $first-letter; + } + + $out.say: q:to/END/; + \end{multicols} + \end{document} + END + $out.close; + + run "latex", "index.tex"; + + # run "dvipdf", "index.dvi"; # this used to work, but update broke dvidpf? + run "dvips", "index.dvi"; + run "ps2pdf", "index.ps"; + + $pdf-file.IO.move("temp.pdf"); + run "qpdf", "--empty", $pdf-file, "--pages", "temp.pdf", "1-{$N-1}", "index.pdf", "--"; +} + +sub get-tonic-from-first-stem(@events) { + for @events -> $event { + if $event.key eq "stem" { + given $event.value { + when ABC::Note { + return $event.value.basenote.uc; + } + when ABC::Stem { + return $event.value.notes.map(*.basenote.uc).join('/'); + } + die "What is this?!"; + } + } + } + + die "Unable to find stem"; +} + +sub get-tonic($abc) { + for $abc.music.kv -> $i, $event { + if $event.key eq "gracing" && $event.value eq "fine" { + return get-tonic-from-first-stem($abc.music[$i..*]); + } + } + + get-tonic-from-first-stem($abc.music.reverse); +} + +multi sub MAIN($abc-file, $book-file, :$no-cover?, :$tunes-in-toc?, :$notes-file?) { + my $ly-file; + $ly-file = $book-file ~ ".ly"; + if $book-file ~~ /^(.*) ".book"/ { + $ly-file = $0 ~ ".ly"; + } + + my %notes; + my %dates; + if $notes-file { + my $note; + my $index; + for $notes-file.IO.lines() { + when / ^ 'X:' \s* (\d+) / { + if $note { + %notes{$index}.push: $note; + $note = Nil; + } + $index = $0; + } + when / ^ 'DATE:' \s* / { + say $/.postmatch; + %dates{$index}.push: $/.postmatch.trim; + } + when / \S / { + $note ~= $_ ~ " "; + } + default { + if $note { + %notes{$index}.push: $note; + $note = Nil; + } + } + } + } + + $*ERR.say: "Reading $abc-file / $book-file, writing $ly-file"; + + my $abc-in = open $abc-file, :r or die "Unable to open $abc-file"; + my @tunes = TuneStreamToTunes($abc-in); + $abc-in.close; + + my %tunes-hash; + for @tunes -> $tune { + my $x = $tune.header.get-first-value("X"); + %tunes-hash{$x} = $tune; + } + + my $book-in = open $book-file, :r or die "Unable to open $book-file"; + my $out = open $ly-file, :w or die "Unable to open $ly-file"; + + start-lilypond($out, $paper-size); + $out.say: '#(set-global-staff-size 17)'; + + # Basic structure of this bit borrowed from Ralph Palmer + # This should keep post-tune text close to its tune, + # while making most blank space between tunes. + $out.say: q:to/END/; + \paper { + print-all-headers = ##t + + %%%%% paper size %%%%% + top-margin = 0.5\in + + %%%%% print both sides of paper %%%%% + two-sided = ##t + + %%%%% margins %%%%% + inner-margin = 1.06\in % larger margin for binder holes + outer-margin = 0.5\in + + NonMusicalPaperColumn.page-break-permission = ##f + ragged-last-bottom = ##t + + %%%%% spacing commands - I had to play with these, esp. stretchability %%%%% + + system-system-spacing = #'((basic-distance . 12) + (minimum-distance . 8) + (padding . 1) + (stretchability . 5)) + + markup-markup-spacing = #'((basic-distance . 1) + (padding . 0.5) + (stretchability . 60)) + + score-markup-spacing = #'((basic-distance . 2) + (padding . 1) + (stretchability . 1)) + + first-page-number = 0 + } + END + + $out.say: "\\markuplist \\table-of-contents"; + $out.say: "\\pageBreak"; + + write-index-snippet($out); + + # my $log = open :w, $*SPEC.devnull; + my $log = open :w, "abc2ly.log"; + + my %index-first-letters; + my $front-cover-file; + my $title-page-file; + my $intro-file; + my $back-cover-file; + my @toc-extra-items; + my $toc-copyright; + my $toc-tools; + + my @book = $book-in.lines; + my $in-part = False; + while +@book { + given @book.shift { + when /^ (\d+) / { + my $X = ~$0; + my $abc = %tunes-hash{$X}; + + my @names = $abc.header.get("T").map({ sanitize-quotation-marks($_.value) }); + $out.say: "\\markup \{ \\vspace #2 \}"; + + $out.say: qq{\\tocItem \\markup "@names[0]"} if $tunes-in-toc && @names; + + for @names -> $name { + my $index-sorting-name = make-index-sorting-name($name); + my $display-name = $index-external ?? "ZYXXY" ~ $X ~ "ZYXXY" !! $name; + $out.say: qq{\\indexItem #"$index-sorting-name" \\markup "$display-name"}; + %index-first-letters{substr($index-sorting-name, 0, 1)} = 1; + last if $index-external; # no need to write more than one name + } + + if %notes{$X} { + if %dates{$X} { + tune-to-score($abc, $out, $log, %notes{$X}, subtitle => %dates{$X}); + } else { + tune-to-score($abc, $out, $log, %notes{$X}); + } + } else { + tune-to-score($abc, $out, $log); + } + } + + when /^ "Part:" (.*) / { + $out.say: "}" if $in-part; + start-bookpart($out, $0.trim); + $in-part = True; + } + + when /^ "Lyric:" / { + write-lyric($out, read-block(@book)); + } + + when /^ "Text:" / { + write-text($out, read-block(@book)); + } + + when /^ "Center:" / { + write-text($out, read-block(@book), :centered); + } + + when /^ "Substitute:" \s+ (\S+) \s+ (\S+)/ { + add-substitute(~$0, ~$1); + } + + when /^ "Substitute:" \s+ (\S+)/ { + add-substitute(~$0, ""); + } + + when /^ "TitleSkip:" \s+ (\S+)/ { + add-title-skip(~$0); + } + + when / ^ "Command:" \s+ (\S.*) $ / { + $out.say: ~$0; + } + + when / ^ "FrontCover:" \s+ (\S.*) $ / { + $front-cover-file = ~$0; + } + + when / ^ "BackCover:" \s+ (\S.*) $ / { + $back-cover-file = ~$0; + } + + when / ^ "Intro:" \s+ (\S.*) $ / { + $intro-file = ~$0; + } + + when / ^ "TitlePage:" \s+ (\S.*) $ / { + $title-page-file = ~$0; + } + + when / ^ "TOC:" \s+ (.+) \s+ (\S+) \s* $ / { + @toc-extra-items.push(~$0 => ~$1); + } + + when / ^ "TOC-Copyright:" \s+ (.*) $ / { + $toc-copyright = ~$0; + } + + when / ^ "TOC-Tools:" \s+ (.*) $ / { + $toc-tools = ~$0; + } + } + } + + $out.say: "}" if $in-part; + + $out.say: qq{\\pageBreak}; + $out.say: qq{\\tocItem \\markup \\bold "Index of Tunes by Name"}; + $out.say: q{ \markuplist \index}; + if !$index-external { + for %index-first-letters.keys -> $letter { + $out.say: qq{ \\indexSection #"$letter" \\markup { "$letter" }} + } + } + + $out.close; + $book-in.close; + + qqx/lilypond $ly-file/; + + my $pdf-file = $ly-file.subst(/ ".ly" /, ".pdf"); + + my $tempdir = tempdir(); + dd $tempdir; + + my $blank-pdf = make-blank-page($tempdir); + + my $toc-file = make-external-toc($tempdir, $pdf-file, @toc-extra-items, $toc-copyright, $toc-tools); + + if $index-external { + make-external-index($pdf-file, %tunes-hash); + } + + sub merge-pdfs(@pdfs, $result-file) { + my $temp-file = IO::Path.new(basename => "temp.pdf", dirname => $tempdir); + # say ("qpdf", "--warning-exit-0", "--empty", + # "--pages", |@pdfs.map(*.Str), "--", + # ~$temp-file).join(" "); + run "qpdf", "--warning-exit-0", "--empty", + "--pages", |@pdfs.map(*.Str), "--", + ~$temp-file; + $temp-file.move($result-file); + } + + # if $intro-file { + # my $temp-file = IO::Path.new(basename => "temp.pdf", dirname => $tempdir); + # run "qpdf", "--empty", + # "--pages", + # $pdf-file, "1", + # $intro-file, + # $pdf-file, "2-z", + # "--", + # ~$temp-file; + # $temp-file.move($pdf-file); + # } + + my @pdfs; + @pdfs.push($front-cover-file) if $front-cover-file && !$no-cover; + if $title-page-file { + @pdfs.push($title-page-file); + @pdfs.push($blank-pdf) unless number-pages($title-page-file) %% 2; + } + @pdfs.push($toc-file); + @pdfs.push($blank-pdf) unless number-pages($toc-file) %% 2; + if $intro-file { + @pdfs.push($intro-file); + @pdfs.push($blank-pdf) unless number-pages($intro-file) %% 2; + } + @pdfs.push($pdf-file); + @pdfs.push($back-cover-file) if $back-cover-file && !$no-cover; + merge-pdfs(@pdfs, $pdf-file) if @pdfs > 1; + + $*ERR.say: "Unrecognized gracings: " ~ GetUnrecognizedGracings().keys.join(", ") if GetUnrecognizedGracings(); +} + + + diff --git a/bin/abc2ly b/bin/abc2ly new file mode 100755 index 0000000..7b212b6 --- /dev/null +++ b/bin/abc2ly @@ -0,0 +1,170 @@ +#!/usr/bin/env perl6 + +use v6; +use ABC::Grammar; +use ABC::Actions; +use ABC::ToLilypond; + +my $paper-size = "letter"; # or switch to "a4" for European paper + +sub TunesToLilypondStream(@tunes, $out, :$fancy?) { + start-lilypond($out, $paper-size); + if $fancy { + $out.say: Q:to/END/; + \paper { + print-all-headers = ##t + top-margin = 1\in + left-margin = 1\in + right-margin = 1\in + indent = 0 + tagline = #ff + } + END + } else { + $out.say: "\\paper \{ print-all-headers = ##t ragged-bottom = ##t \}"; + } + +# my $log = open :w, $*SPEC.devnull; + my $log = open :w, "abc2ly.log"; + for @tunes -> $tune { + tune-to-score($tune, $out, $log); + } +} + +sub TuneStreamToTunes($in) { + my $actions = ABC::Actions.new; + my $match = ABC::Grammar.parse($in.slurp-rest, :rule, :$actions); + die "Did not match ABC grammar: last tune understood:\n { $actions.current-tune }" unless $match; + @( $match.ast ); +} + +sub TuneStreamToLilypondStream($in, $out, $filter = *, :$fancy?) { + my @tunes = TuneStreamToTunes($in); + TunesToLilypondStream(@tunes.grep($filter), $out, :$fancy); +} + +# This is from https://rosettacode.org/wiki/Longest_common_prefix#Perl_6 +# Bit wonky looking but seems to work! +sub longest-common-prefix(@s) { + substr @s[0], 0, [+] [\and] [Zeqv] |@s».ords +} + +sub TunesStreamToScore($in, $out) { + my $actions = ABC::Actions.new; + my $match = ABC::Grammar.parse($in.slurp-rest, :rule, :$actions); + die "Did not match ABC grammar: last tune understood:\n { $actions.current-tune }" unless $match; + my @tunes = @( $match.ast ); + + my @names = @tunes.map({ $_.header.get-first-value("T") }); + my $name = longest-common-prefix(@names).trim; + dd $name; + @names .= map(-> $full-name { $full-name.substr($name.chars).trim }); + dd @names; + + start-lilypond($out, $paper-size); + $out.say: "\\paper \{ print-all-headers = ##t ragged-bottom = ##t \}"; + + $out.say: "\\score \{"; + $out.say: '<<'; + + for @tunes Z, @names -> ($tune, $name) { + dd $name; + $*ERR.say: "Working on { $tune.header.get-first-value("T") // $tune.header.get-first-value("X") }"; + + $out.say: "\\new Staff "; + TuneBodyToLilypondStream($tune, $out, prefix => qq[\\set Staff.instrumentName = "$name"]); + } + + $out.say: '>>'; + HeaderToLilypond(@tunes[0].header, $out, title => $name); + $out.say: "}\n\n"; +} + +multi sub MAIN() { + TuneStreamToLilypondStream($*IN, $*OUT); +} + +multi sub MAIN($first-abc-file, *@other-abc-files, :x($index)?, :$o?, :$mc?, :$fancy?, :$score?) { + my @abc-files = $first-abc-file, |@other-abc-files; + for @abc-files -> $abc-file { + my $ly-file; + if $o { + $ly-file = $o; + } else { + $ly-file = $abc-file ~ ".ly"; + if $abc-file ~~ /^(.*) ".abc"/ { + $ly-file = $0 ~ ".ly"; + } + } + $*ERR.say: "Reading $abc-file, writing $ly-file"; + + my $in = open $abc-file, :r or die "Unable to open $abc-file"; + my $out = open $ly-file, :w or die "Unable to open $ly-file"; + + if $score { + TunesStreamToScore($in, $out); + } elsif $index { + TuneStreamToLilypondStream($in, $out, -> $tune { $tune.header.get-first-value("X") == $index }, :$fancy); + } else { + TuneStreamToLilypondStream($in, $out, :$fancy); + } + + if $mc { + $out.say: '\markup {'; + $out.say: ' \fill-line { "For more information on these tunes, please see http://midlandceltic.org/ws2011/" }'; + $out.say: '}'; + } + + $out.close; + $in.close; + + run "lilypond", $ly-file; + } + + $*ERR.say: "Unrecognized gracings: " ~ GetUnrecognizedGracings().keys.join(", ") if GetUnrecognizedGracings(); +} + +sub good-filename-base($name) { + my $title = $name; + $title .= subst(/ \s | '?' | '!' | "'" | '*' | '^' | '(' | ')' | '"' | '#' | '[' | ']' /, "_", :global); + + $title .= subst(/<[àáâäaãåā]>/, "a", :global); + $title .= subst(/<[èéêëēėę]>/, "e", :global); + $title .= subst(/<[îïíīįì]>/, "i", :global); + $title .= subst(/<[ôöòóøōõ]>/, "o", :global); + $title .= subst(/<[ûüùúū]>/, "u", :global); + $title .= subst(/<[ÀÁÂÄAÃÅĀ]>/, "A", :global); + $title .= subst(/<[ÈÉÊËĒĖĘ]>/, "E", :global); + $title .= subst(/<[ÎÏÍĪĮÌ]>/, "I", :global); + $title .= subst(/<[ÔÖÒÓØŌÕ]>/, "O", :global); + $title .= subst(/<[ÛÜÙÚŪ]>/, "U", :global); + + $title .= subst(/'æ'/, "ae", :global); + $title .= subst(/'Æ'/, "AE", :global); + $title .= subst(/'œ'/, "oe", :global); + $title .= subst(/'Œ'/, "OE", :global); + $title .= subst(/"&"/, "and", :global); + $title .= subst(rx{'/'}, "-", :global); + $title .= subst(/ <:!ASCII> /, "_", :global); + $title .= subst(":", "_-", :global); + $title .= subst(";", "_-", :global); + $title .= subst(",", "_-", :global); + + $title; +} + +multi sub MAIN($abc-file, :$split!, :$fancy?) { + my $abc-in = open $abc-file, :r or die "Unable to open $abc-file"; + my @tunes = TuneStreamToTunes($abc-in); + $abc-in.close; + + for @tunes -> $tune { + my $title = $tune.header.get-first-value("T"); + my $filename-base = good-filename-base($title); + my $ly-filename = ($filename-base ~ ".ly").IO; + my $out = open $ly-filename, :w or die "Unable to open $ly-filename"; + TunesToLilypondStream([$tune], $out, :$fancy); + } + + $*ERR.say: "Unrecognized gracings: " ~ GetUnrecognizedGracings().keys.join(", ") if GetUnrecognizedGracings(); +} \ No newline at end of file diff --git a/bin/abc2tuneindex b/bin/abc2tuneindex new file mode 100755 index 0000000..a629dbd --- /dev/null +++ b/bin/abc2tuneindex @@ -0,0 +1,24 @@ +#!/usr/bin/env raku + +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; +use ABC::KeyInfo; + +sub MAIN() { + my $actions = ABC::Actions.new; + my $match = ABC::Grammar.parse($*IN.slurp-rest, :rule, :$actions); + die "Did not match ABC grammar: last tune understood:\n { $actions.current-tune }" unless $match; + my @tunes = @( $match.ast ); + for @tunes -> $tune { + my $index-number = $tune.header.get-first-value("X"); + my $title = $tune.header.get-first-value("T"); + say "$index-number $title"; + } +} diff --git a/bin/abcoctave b/bin/abcoctave new file mode 100755 index 0000000..fd32523 --- /dev/null +++ b/bin/abcoctave @@ -0,0 +1,63 @@ +#!/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}]"; } + when 'chord_or_text' { + my $chord = $element.value.Str(); + $chord = '"' ~ $chord ~ '"' unless $chord ~~ / '"' /; + print $chord; + #$element.value ~~ ABC::Chord ?? $element.value !! '"' ~ $element.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, :$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); +} \ No newline at end of file diff --git a/bin/abctranspose b/bin/abctranspose new file mode 100755 index 0000000..58e5e34 --- /dev/null +++ b/bin/abctranspose @@ -0,0 +1,73 @@ +#!/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; +use ABC::KeyInfo; + +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}]"; } + when 'gracing' { + given $element.value { + when '.' { print "."; } + print "+{$element.value}+"; + } + } + when 'chord_or_text' { print qq/"{$element.value}"/; } + when 'nth_repeat' { + print '[' ~ $element.value; + } + print $element.value ~~ ABC::Pitched ?? ~$element.value.transpose(&shifter) !! $element.value; + } + } +} + +sub Transpose($in, $out, $new-key-name, %old-key, %new-key, %shift, $shift) { + sub transpose($accidental, $basenote, $octave) { + my $ordinal = pitch-to-ordinal(%old-key, $accidental, $basenote, $octave); + ordinal-to-pitch(%new-key, %shift{$basenote.uc}, $ordinal + $shift, $accidental ne ""); + } + + my $actions = ABC::Actions.new; + + my $match = ABC::Grammar.parse($in.slurp-rest, :rule, :$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") }"; + $tune.header.set-key($new-key-name); + print-header($out, $tune.header); + print-music($out, $tune.music, &transpose); + } +} + +multi sub MAIN() { + Transpose($*IN, $*OUT, "D", {}, {"F" => "^", "C" => "^"}, ("A".."G" Z=> "B".."G", "A").hash, +2); +} + +multi sub MAIN($original-key-name, $new-key-name, Int $shift) { + my @notes = "A".."G"; + my $original-key = ABC::KeyInfo.new($original-key-name); + my $new-key = ABC::KeyInfo.new($new-key-name); + Transpose($*IN, $*OUT, $new-key-name, $original-key.key, $new-key.key, + ($original-key.scale-names Z=> $new-key.scale-names).hash, $shift); +} + +multi sub MAIN(Int $shift) { + Transpose($*IN, $*OUT, $shift); +} diff --git a/bin/tootorial b/bin/tootorial new file mode 100644 index 0000000..654553d --- /dev/null +++ b/bin/tootorial @@ -0,0 +1,137 @@ +#!/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; +use ABC::KeyInfo; + +my %note-to-pitch = ( + "C" => 60, + "D" => 62, + "E" => 64, + "F" => 65, + "G" => 67, + "A" => 69, + "B" => 71, + "c" => 72, + "d" => 74, + "e" => 76, + "f" => 77, + "g" => 79, + "a" => 81, + "b" => 83 +); + +my %pitch-to-fingering = ( + 60 => (1,1,1,1,1,1), # hack, please remove before real use!!!!! + 61 => (1,1,1,1,1,1), # hack, please remove before real use!!!!! + 62 => (1,1,1,1,1,1), + 63 => (1,1,1,1,1,2), + 64 => (1,1,1,1,1,0), + 65 => (1,1,1,1,2,0), + 66 => (1,1,1,1,0,0), + 67 => (1,1,1,0,0,0), + 68 => (1,1,2,0,0,0), + 69 => (1,1,0,0,0,0), + 70 => (1,2,0,0,0,0), + 71 => (1,0,0,0,0,0), + 72 => (0,1,1,0,0,0), + 73 => (0,0,0,0,0,0), + 74 => (0,1,1,1,1,1), + 75 => (1,1,1,1,1,2), + 76 => (1,1,1,1,1,0), + 77 => (1,1,1,1,2,0), + 78 => (1,1,1,1,0,0), + 79 => (1,1,1,0,0,0), + 80 => (1,1,2,0,0,0), + 81 => (1,1,0,0,0,0), + 82 => (1,2,0,0,0,0), + 83 => (1,0,0,0,0,0), + 84 => (2,0,0,0,0,0), + 85 => (0,0,0,0,0,0), +); + +sub get-pitch-number(ABC::Note $abc-pitch) { + my $pitch-number = %note-to-pitch{$abc-pitch.basenote}; + + given $abc-pitch.accidental { + when "^^" { $pitch-number += 2 } + when "^" { $pitch-number += 1 } + when "_" { $pitch-number -= 1 } + when "__" { $pitch-number -= 2 } + } + + my $octave = 0; + given $abc-pitch.octave { + when !*.defined { } # skip if no additional octave info + when /\,/ { $octave -= $abc-pitch.octave.chars } + when /\'/ { $octave += $abc-pitch.octave.chars } + } + + $pitch-number + $octave * 12; +} + +sub ConvertStemPitch($stem, $out) { + my $pitch = get-pitch-number($stem); + $out.say: $pitch ~ "," ~ $stem.ticks ~ "," ~ %pitch-to-fingering{$pitch}.join(","); +} + +# class TuneConvertor { +# has $.context; +# +# method new($key, $meter, $length) { +# self.bless(:context(Context.new($key, $meter, $length))); +# } +# +# +# method Convert(@elements, $out) { +# for @elements -> $element { +# given $element.key { +# when "stem" { +# given $element.value { +# when ABC::Note { +# $.context.ConvertStemPitch($element.value, $out); +# } +# die "Cannot handle stem type { $element.value.WHAT }"; +# } +# } +# } +# +# } +# } +# } + +sub TuneStreamToCSV($in, $out) { + my $actions = ABC::Actions.new; + my $match = ABC::Grammar.parse($in.slurp, :rule, :$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") }"; + + $out.say: "pitch,duration,T1,T2,T3,B1,B2,B3"; + my @notes := stream-of-notes($tune); + for @notes -> $note { + given $note { + when ABC::Note { ConvertStemPitch($note, $out); } + } + say ~$note; + } + } +} + +multi sub MAIN($input-abc-file, $output-csv-file) { + my $in = open $input-abc-file, :r or die "Unable to open $input-abc-file"; + my $out = open $output-csv-file, :w or die "Unable to open $output-csv-file"; + + TuneStreamToCSV($in, $out); + + $out.close; + $in.close; +} diff --git a/dg-check.pl b/dg-check.raku similarity index 91% rename from dg-check.pl rename to dg-check.raku index e78b11b..a34c249 100644 --- a/dg-check.pl +++ b/dg-check.raku @@ -1,6 +1,6 @@ use v6; -BEGIN { push @*INC, "lib" } +use lib 'lib'; use ABC; my @matches = $*IN.slurp.comb(m/ /, :match); @@ -33,6 +33,6 @@ my %key_signature = key_signature(%header); - my @trouble = @notes.map({apply_key_signature(%key_signature, .)}).grep({!%dg_notes.exists(lc($_))}); + my @trouble = @notes.map({apply_key_signature(%key_signature, .)}).grep({!%dg_notes{lc($_)}:exists}); say @trouble.perl; } diff --git a/lib/ABC.pm b/lib/ABC.pm deleted file mode 100644 index 2c53866..0000000 --- a/lib/ABC.pm +++ /dev/null @@ -1,148 +0,0 @@ -use v6; - -grammar ABC -{ - regex header_field_name { \w } - regex header_field_data { \N* } - regex header_field { ^^ ':' \s* $$ } - regex header { [ \v]+ } - - regex basenote { <[a..g]+[A..G]> } - regex octave { \'+ | \,+ } - regex accidental { '^' | '^^' | '_' | '__' | '=' } - regex pitch { ? ? } - - regex tie { '-' } - regex note_length { [\d* ['/' \d*]? ] | '/' } - regex note { ? ? } - regex stem { | [ '[' + ']' ] } - - regex rest_type { <[x..z]> } - regex rest { ? } - - regex grace_note { ? } # as note, but without tie - regex grace_note_stem { | [ '[' + ']' ] } - regex acciaccatura { '/' } - regex grace_notes { '{' ? + '}' } - - regex long_gracing { '+' + '+' } - regex gracing { '.' | '~' | } - - regex spacing { \h+ } - - regex broken_rhythm_bracket { ['<'+ | '>'+] } - regex broken_rhythm { * * } - - regex nth_repeat_num { + [[',' | '-'] +]* } - regex nth_repeat_text { '"' .*? '"' } - regex nth_repeat { '[' [ | ] } - regex end_nth_repeat { ']' } - - regex element { | | | | - | | | } - - regex barline { ':|:' | '|:' | '|' | ':|' | '::' } - - regex bar { + ? } - - regex line_of_music { ? + } - - regex music { [ \s*\v?]+ } - - regex tune {
} -} - -sub header_hash($header_match) -{ - gather for $header_match - { - take $_..Str => $_..Str; - } -} - -sub key_signature($key_signature_name) -{ - my %keys = ( - 'C' => 0, - 'G' => 1, - 'D' => 2, - 'A' => 3, - 'E' => 4, - 'B' => 5, - 'F#' => 6, - 'C#' => 7, - 'F' => -1, - 'Bb' => -2, - 'Eb' => -3, - 'Ab' => -4, - 'Db' => -5, - 'Gb' => -6, - 'Cb' => -7 - ); - - # <[a..g]+[A..G]> should be ('#' | 'b')? \h* (\w*) /; - die "Illegal key signature\n" unless $match ~~ Match; - my $lookup = [~] $match.uc, $match[0]; - my $sharps = %keys{$lookup}; - - if ($match[1].defined) { - given ~($match[1]) { - when "" { } - when /^maj/ { } - when /^ion/ { } - when /^mix/ { $sharps -= 1; } - when /^dor/ { $sharps -= 2; } - when /^m/ { $sharps -= 3; } - when /^aeo/ { $sharps -= 3; } - when /^phr/ { $sharps -= 4; } - when /^loc/ { $sharps -= 5; } - when /^lyd/ { $sharps += 1; } - default { die "Unknown mode {$match[1]} requested"; } - } - } - - my @sharp_notes = ; - my %hash; - - given $sharps { - when 1..7 { for ^$sharps -> $i { %hash{@sharp_notes[$i]} = "^"; } } - when -7..-1 { for ^(-$sharps) -> $i { %hash{@sharp_notes[6-$i]} = "_"; } } - } - - return %hash; -} - -sub apply_key_signature(%key_signature, $pitch) -{ - my $resulting_note = ""; - if $pitch - { - $resulting_note ~= $pitch.Str; - } - else - { - $resulting_note ~= %key_signature{$pitch.uc} - if (%key_signature.exists($pitch.uc)); - } - $resulting_note ~= $pitch.Str; - $resulting_note ~= $pitch.Str if $pitch; - return $resulting_note; -} - -class ABCHeader -{ - -} - -class ABCBody -{ - -} - -class ABCTune -{ - has $.header; - has $.body; - -} \ No newline at end of file diff --git a/lib/ABC/Actions.rakumod b/lib/ABC/Actions.rakumod new file mode 100644 index 0000000..7469ed5 --- /dev/null +++ b/lib/ABC/Actions.rakumod @@ -0,0 +1,222 @@ +use v6; + +use ABC::Header; +use ABC::Tune; +use ABC::Duration; +use ABC::Note; +use ABC::Rest; +use ABC::Tuplet; +use ABC::BrokenRhythm; +use ABC::Chord; +use ABC::LongRest; +use ABC::GraceNotes; + +class ABC::Actions { + has $.current-tune = ""; + + method header_field($/) { + if $ eq "T" { + $*ERR.say: "Parsing " ~ $; + $!current-tune = $ ~ "\n"; + } + + make ~$ => ~$; + } + + method interior_header_field($/) { + make ~$ => ~$; + } + + method header($/) { + my $header = ABC::Header.new; + for @( $ ) -> $field { + $header.add-line($field.ast.key, $field.ast.value); + } + make $header; + } + + method note_length($/) { + if $ { + if $ ~~ List { + make duration-from-parse($, $[0]); + } else { + make duration-from-parse($, $); + } + } else { + make duration-from-parse($); + } + } + + method mnote($/) { + make ABC::Note.new(~($ // ""), + ~$, + ~($ // ""), + $.ast, + ?$); + } + + method stem($/) { + if @( $ ) == 1 { + make $[0].ast; + } else { + make ABC::Stem.new(@( $ )>>.ast, $.ast, ?$); + } + } + + method rest($/) { + make ABC::Rest.new(~$, $.ast); + } + + method multi_measure_rest($/) { + make ABC::LongRest.new(~($ // 1)); + } + + method tuplet($/) { + make ABC::Tuplet.new(+@( $ ), @( $ )>>.ast); + } + + method nth_repeat_num($/) { + my @nums = $/.subst("-", "..").EVAL; + make @nums.Set; + } + + method nth_repeat($/) { + make ($ // $).ast; + } + + method broken_rhythm($/) { + make ABC::BrokenRhythm.new($[0].ast, + ~$, + ~$, + ~$, + $[1].ast); + } + + method grace_note($/) { + make ABC::Note.new(~($ // ""), + ~$, + ~($ // ""), + $.ast, + False); + } + + method grace_note_stem($/) { + if @( $ ) == 1 { + make $[0].ast; + } else { + make ABC::Stem.new(@( $ )>>.ast); + } + } + + method grace_notes($/) { + make ABC::GraceNotes.new(?$, @( $ )>>.ast); + } + + + method inline_field($/) { + make ~$/ => ~$/; + } + + method long_gracing($/) { + make ~$/; + } + + method gracing($/) { + make $/ ?? $/.ast !! ~$/; + } + + method slur_begin($/) { + make ~$/; + } + + method slur_end($/) { + make ~$/; + } + + method chord($/) { + # say "hello?"; + # say $/[0].WHAT; + # say $/[0].perl; + make ABC::Chord.new(~$/, ~($/ // ""), ~($/ // ""), + ~($/ // ""), ~($/ // "")); + } + + method chord_or_text($/) { + my @chords = $/.flatmap({ $_.ast }); + my @texts = $/.flatmap({ ~$_ }); + make (@chords, @texts).flat.list; + } + + method element($/) { + my $type; + for { + $type = $_ if $/{$_}; + } + # say $type ~ " => " ~ $/{$type}.ast.WHAT; + + my $ast = $type => ~$/{$type}; + # say :$ast.perl; + # say $/{$type}.ast.perl; + # say $/{$type}.ast.WHAT; + if $/{$type}.ast ~~ ABC::Duration | ABC::LongRest | ABC::GraceNotes | Pair | Str | List | Set { + $ast = $type => $/{$type}.ast; + } + make $ast; + } + + method barline($/) { + make "barline" => ~$/; + } + + method bar($/) { + $!current-tune ~= ~$/; + my @bar = @( $ )».ast; + if $ { + @bar.push($.ast); + } + make @bar; + } + + method line_of_music($/) { + my @line; + if $ { + @line.push($.ast); + } + my @bars = @( $ )>>.ast; + for @bars -> $bar { + for $bar.list { + @line.push($_); + } + } + @line.push("endline" => ""); + $!current-tune ~= "\n"; + make @line; + } + + method music($/) { + my @music; + # $*ERR.say: "Started music action"; + for @( $/.caps ) { + # $*ERR.say: ~$_.key ~ " => " ~ ~$_.value; + when *.key eq "line_of_music" { + for $_.value.ast { + @music.push($_); + } + } + when *.key eq "interior_header_field" { + @music.push("inline_field" => $_.value.ast); + } + } + # state $count = 0; + # die if ++$count == 10; + make @music; + } + + method tune($/) { + make ABC::Tune.new($
.ast, $.ast); + } + + method tune_file($/) { + make @( $ )>>.ast; + } +} diff --git a/lib/ABC/BrokenRhythm.rakumod b/lib/ABC/BrokenRhythm.rakumod new file mode 100644 index 0000000..86e27fa --- /dev/null +++ b/lib/ABC/BrokenRhythm.rakumod @@ -0,0 +1,63 @@ +use v6; + +use ABC::Duration; +use ABC::Pitched; +use ABC::Note; +use ABC::Stem; + +class ABC::BrokenRhythm does ABC::Duration does ABC::Pitched { + has $.stem1; + has $.gracing1; + has $.broken-rhythm; + has $.gracing2; + has $.stem2; + + method new($stem1, $gracing1, $broken-rhythm, $gracing2, $stem2) { + self.bless(:$stem1, :$gracing1, :$broken-rhythm, :$gracing2, :$stem2, + :ticks($stem1.ticks + $stem2.ticks)); + } + + method broken-factor() { + 1 / 2 ** $.broken-rhythm.chars.Int; + } + + method broken-direction-forward() { + $.broken-rhythm ~~ /\>/; + } + + sub new-rhythm($note, $ticks) { + given $note { + when ABC::Note { + ABC::Note.new($note.accidental, + $note.basenote, + $note.octave, + ABC::Duration.new(:$ticks), + $note.is-tie); + } + when ABC::Stem { ABC::Stem.new($note.notes.map({ new-rhythm($_, $ticks); })); } + } + } + + method effective-stem1() { + new-rhythm($.stem1, self.broken-direction-forward ?? $.stem1.ticks * (2 - self.broken-factor) + !! $.stem1.ticks * self.broken-factor); + } + + method effective-stem2() { + new-rhythm($.stem2, self.broken-direction-forward ?? $.stem2.ticks * self.broken-factor + !! $.stem2.ticks * (2 - self.broken-factor)); + } + + method Str() { + # Handle gracings here, too + $.stem1 ~ $.broken-rhythm ~ $.stem2; + } + + method transpose($pitch-changer) { + ABC::BrokenRhythm.new($.stem1.transpose($pitch-changer), + $.gracing1, + $.broken-rhythm, + $.gracing2, + $.stem2.transpose($pitch-changer)); + } +} diff --git a/lib/ABC/Chord.rakumod b/lib/ABC/Chord.rakumod new file mode 100644 index 0000000..f977926 --- /dev/null +++ b/lib/ABC/Chord.rakumod @@ -0,0 +1,50 @@ +use v6; +use ABC::Pitched; + +class ABC::Chord does ABC::Pitched { + has $.main-note; + has $.main-accidental; + has $.main-type; + has $.bass-note; + has $.bass-accidental; + + method new($main-note, $main-accidental, $main-type, $bass-note, $bass-accidental) { + self.bless(:$main-note, :$main-accidental, :$main-type, :$bass-note, :$bass-accidental); + } + + method Str() { + '"' ~ $.main-note + ~ $.main-accidental + ~ $.main-type + ~ ($.bass-note ?? '/' ~ $.bass-note ~ $.bass-accidental !! "") + ~ '"'; + } + + method perl() { + "ABC::Chord.new({ $.main-note.perl }, { $.main-accidental.perl }, { $.main-type.perl }, { $.bass-note.perl }, { $.bass-accidental.perl })"; + } + + method transpose($pitch-changer) { + sub change-chord($note, $accidental) { + my $note-accidental; + given $accidental { + when '#' { $note-accidental = '^' } + when 'b' { $note-accidental = '_' } + $note-accidental = '='; + } + my ($new-accidental, $new-note, $new-octave) = $pitch-changer($note-accidental, $note, ""); + given $new-accidental { + when '^' { $new-accidental = '#' } + when '_' { $new-accidental = 'b' } + when '=' { $new-accidental = '' } + when '' { $new-accidental = '' } + die "Unable to handle $new-accidental in a chord name"; + } + ($new-note.uc, $new-accidental); + } + + my ($main-note, $main-accidental) = change-chord($.main-note, $.main-accidental); + my ($bass-note, $bass-accidental) = change-chord($.bass-note, $.bass-accidental); + ABC::Chord.new($main-note, $main-accidental, $.main-type, $bass-note, $bass-accidental); + } +} \ No newline at end of file diff --git a/lib/ABC/Context.rakumod b/lib/ABC/Context.rakumod new file mode 100644 index 0000000..eb66149 --- /dev/null +++ b/lib/ABC/Context.rakumod @@ -0,0 +1,37 @@ +use ABC::KeyInfo; + +class ABC::Context { + has $.key-name; + has $.key-info; + has $.meter; + has $.length; + has %.accidentals; + + multi method new($key-name, $meter, $length, :$current-key-info) { + self.bless(:$key-name, + :key-info(ABC::KeyInfo.new($key-name, :$current-key-info)), + :$meter, + :$length); + } + + multi method new(ABC::Context $other) { + self.bless(:key-name($other.key-name), + :key-info(ABC::KeyInfo.new($other.key-name)), + :meter($other.meter), + :length($other.length)); + } + + method bar-line () { + %.accidentals = (); + } + + method working-accidental($abc-pitch) { + if $abc-pitch.accidental { + %.accidentals{$abc-pitch.basenote.uc} = $abc-pitch.accidental; + } + + %.accidentals{$abc-pitch.basenote.uc} || ($.key-info.key{$abc-pitch.basenote.uc} // ""); + } + +} + diff --git a/lib/ABC/Duration.rakumod b/lib/ABC/Duration.rakumod new file mode 100644 index 0000000..0ebb83b --- /dev/null +++ b/lib/ABC/Duration.rakumod @@ -0,0 +1,33 @@ +use v6; + +role ABC::Duration { + has $.ticks; + + multi sub duration-from-parse($top) is export { #OK + ABC::Duration.new(:ticks(($top ?? +~$top !! 1).Int)); + } + + multi sub duration-from-parse($top, $bottom) is export { #OK + # $*ERR.say: :$top.perl; + # $*ERR.say: :$bottom.perl; + ABC::Duration.new(:ticks(($top ?? +~$top !! 1).Int / ($bottom ?? +~$bottom !! 2).Int)); + } + + method duration-to-str() { + given $.ticks { + when 1 { ""; } + when 1/2 { "/"; } + when Int { .Str; } + when Rat { + if $_.denominator == 1 { + ~$_.numerator; + } elsif $_.numerator == 1 { + "/" ~ $_.denominator; + } else { + $_.numerator ~ "/" ~ $_.denominator; + } + } + die "Duration must be Int or Rat, but it's { .WHAT }"; + } + } +} diff --git a/lib/ABC/GraceNotes.rakumod b/lib/ABC/GraceNotes.rakumod new file mode 100644 index 0000000..349210d --- /dev/null +++ b/lib/ABC/GraceNotes.rakumod @@ -0,0 +1,21 @@ +use v6; + +use ABC::Pitched; + +class ABC::GraceNotes does ABC::Pitched { + has $.acciaccatura; + has @.notes; + + method new($acciaccatura, @notes) { + die "GraceNotes must have at least one note" if +@notes == 0; + self.bless(:$acciaccatura, :@notes); + } + + method Str() { + '{' ~ ($.acciaccatura ?? '/' !! '') ~ @.notes.join('') ~ '}'; + } + + method transpose($pitch-changer) { + ABC::GraceNotes.new($.acciaccatura, @.notes>>.transpose($pitch-changer)); + } +} diff --git a/lib/ABC/Grammar.rakumod b/lib/ABC/Grammar.rakumod new file mode 100644 index 0000000..b8580b6 --- /dev/null +++ b/lib/ABC/Grammar.rakumod @@ -0,0 +1,126 @@ +use v6; +# use Grammar::Tracer; + +# Originally based on https://web.archive.org/web/20120201072612/http://www.norbeck.nu/abc/bnf/abc20bnf.htm + +grammar ABC::Grammar +{ + regex comment { \h* '%' \N* $$ } + regex comment_line { ^^ } + + token header_field_name { \w } + token header_field_data { <-[ % \v ]>* } + token header_field { ^^ ':' \h* ? $$ } + token header { [[ | ] \v+]+ } + + token basenote { <[a..g]+[A..G]> } + token octave { "'"+ | ","+ } + token accidental { '^^' | '^' | '__' | '_' | '=' } + token pitch { ? ? } + + token tie { '-' } + token number { + } + token note_length_denominator { '/' ? } + token note_length { ? ? } + token mnote { ? } + token stem { | [ '[' \h* [ \h* ]+ ']' ? ] } + + token rest_type { <[x..z]> } + token rest { } + token multi_measure_rest { 'Z' ? } + + token slur_begin { '(' } + token slur_end { ')' } + + token grace_note { } # as mnote, but without tie + token grace_note_stem { | [ '[' + ']' ] } + token acciaccatura { '/' } + token grace_notes { '{' ? + '}' } + + token long_gracing_text { [ | '.' | ')' | '(']+ } + token long_gracing { ['+' '+'] | ['!' '!'] } + token gracing { '.' | '~' | '!+!' | '!>!' | <[ H .. Y ]> | <[ h .. w ]> | } + + token spacing { \h+ } + + token broken_rhythm_bracket { ['<'+ | '>'+] } + token b_elem { | | | } + token broken_rhythm { * * } + + token t_elem { | | | | } + # token tuplet { '('(+) {} [* ] ** { +$0 } ? } + # If the previous line fails, you can use the next rule to get the most common cases + # next block makes the most common cases work + # token tuplet { '(' (+) {} (* )*? ? } + token tuplet { ['(2' \h* [\h* * ] ** 2 ? ] + | ['(3' \h* [\h* * ] ** 3 ? ] + | ['(4' \h* [\h* * ] ** 4 ? ] + | ['(5' \h* [\h* * ] ** 5 ? ] } + + token nth_repeat_num { + [[',' | '-'] +]* } + token nth_repeat_text { '"' .*? '"' } + token nth_repeat { ['[' [ | ]] | [ ] } + token end_nth_repeat { ']' } + + regex inline_field { '[' ':' $=[.*?] ']' } + + token chord_accidental { '#' | 'b' | '=' } + token chord_type { [ | | '+' | '-' ]+ } + token chord_newline { '\n' | ';' } + token chord { ? ? + [ '/' ? ]? * } + token non_quote { <-["]> } + token text_expression { [ '^' | '<' | '>' | '_' | '@' ]? + } + token chord_or_text { '"' [ | ] [ [ | ] ]* '"' } + + token element { | | | | | + | + | | | | + | | | } + + token barline { '||' | '|]' | '[|' | ':|:' | '|:' | '|' | ':|' | '::' | '||:' | '&' } + + token bar { + ? } + + token line_of_music { ? + '\\'? ? $$ } + + token interior_header_field_name { < K M L w P > } + token interior_header_field_data { <-[ % \v ]>* } + token interior_header_field { ^^ ':' \h* ? $$ } + + token music { [[ | | ] \s*]+ } + + token tune {
} + + token tune_file { \s* [ \s*]+ } + + token clef { [ ["clef=" [ | ]] | ] ? ["+8" | "-8"]? [\h+ "octave=" ]? [\h+ ]? } + token clef-note { "G" | "C" | "F" | "P" } + token clef-name { "treble" | "alto" | "tenor" | "baritone" | "bass" | "mezzo" | "soprano" | "perc" | "none" } + token clef-line { <[1..5]> } + token clef-octave { ['+' | '-']? \d+ } + token clef-middle { "middle=" } + + token key { [ [ [\h+ ]?] | | "HP" | "Hp" ] \h* } + token key-def { ? [\h* ]? [\h+ ]* } + token mode { | | | | | | | | } + token minor { "m" ["in" ["o" ["r"]?]?]? } # m, min, mino, minor - all modes are case insensitive + token major { "maj" ["o" ["r"]?]? } + token lydian { "lyd" ["i" ["a" ["n"]?]?]? } # major with sharp 4th + token ionian { "ion" ["i" ["a" ["n"]?]?]? } # =major + token mixolydian { "mix" ["o" ["l" ["y" ["d" ["i" ["a" ["n"]?]?]?]?]?]?]? } # major with flat 7th + token dorian { "dor" ["i" ["a" ["n"]?]?]? } # minor with sharp 6th + token aeolian { "aeo" ["l" ["i" ["a" ["n"]?]?]?]? } # =minor + token phrygian { "phr" ["y" ["g" ["i" ["a" ["n"]?]?]?]?]? } # minor with flat 2nd + token locrian { "loc" ["r" ["i" ["a" ["n"]?]?]?]? } # minor with flat 2nd and 5th + token global-accidental { } # e.g. ^f =c _b +} + +sub header_hash($header_match) #OK +{ + gather for $header_match + { + take $_..Str => $_..Str; + } +} + diff --git a/lib/ABC/Header.rakumod b/lib/ABC/Header.rakumod new file mode 100644 index 0000000..180abc4 --- /dev/null +++ b/lib/ABC/Header.rakumod @@ -0,0 +1,35 @@ +use v6; + +class ABC::Header { + has @.lines; # array of Pairs representing each line of the ABC header + + method add-line($name, $data) { + self.lines.push($name => $data); + } + + method set-key($new-key) { + my $found = False; + self.lines = self.lines.grep(*.key ne "K"); # remove old key signatures + self.lines.push("K" => $new-key); + } + + method get($name) { + self.lines.grep({ .key eq $name }); + } + + method get-first-value($name) { + my $pair = self.lines.first({ .key eq $name }); + $pair ?? $pair.value !! Any; + } + + method is-valid() { + self.lines.elems > 1 + && self.lines[0].key eq "X" + && self.get("T").elems > 0 + && self.get("M").elems == 1 + && self.get("L").elems == 1 + && self.get("X").elems == 1 + && self.get("K").elems == 1 + && self.lines[*-1].key eq "K"; + } +} \ No newline at end of file diff --git a/lib/ABC/KeyInfo.rakumod b/lib/ABC/KeyInfo.rakumod new file mode 100644 index 0000000..baf0a7e --- /dev/null +++ b/lib/ABC/KeyInfo.rakumod @@ -0,0 +1,99 @@ +use v6; +use ABC::Grammar; + +#SHOULD: rename parcel to list? +sub parcel-first-if-needed($a) { + $a ~~ List ?? $a[0] !! $a; +} + +class ABC::KeyInfo { + has %.key; + has $.clef; + has $.octave-shift; + has $.basenote; + + method new($key-field, :$current-key-info) { + # say "K: $key-field"; + my $match = ABC::Grammar.parse($key-field, :rule); + # say :$match.perl; + die "Illegal key signature $key-field\n" unless $match; + + my %key-info; + my $clef-info = "treble"; + my $octave-shift = 0; + if $current-key-info { + %key-info = $current-key-info.key; + $clef-info = $current-key-info.clef; + $octave-shift = $current-key-info.octave-shift; + } + + if $match { + %key-info = (); + my %keys = ( + 'C' => 0, + 'G' => 1, + 'D' => 2, + 'A' => 3, + 'E' => 4, + 'B' => 5, + 'F' => -1, + ); + + # say $match.perl; + # my $lookup = $match.uc; + # say :$lookup.perl; + my $sharps = %keys{$match.uc}; + if $match { + given ~$match { + when "#" { $sharps += 7; } + when "b" { $sharps -= 7; } + } + } + + if $match { + given parcel-first-if-needed($match) { + when so . { } + when so . { } + when so . { $sharps -= 1; } + when so . { $sharps -= 2; } + when so . { $sharps -= 3; } + when so . { $sharps -= 3; } + when so . { $sharps -= 4; } + when so . { $sharps -= 5; } + when so . { $sharps += 1; } + default { die "Unknown mode $_ requested"; } + } + } + + my @sharp_notes = ; + + given $sharps { + when 1..7 { for ^$sharps -> $i { %key-info{@sharp_notes[$i]} = "^"; } } + when -7..-1 { for ^(-$sharps) -> $i { %key-info{@sharp_notes[6-$i]} = "_"; } } + } + + if $match { + for $match.list -> $ga { + %key-info{$ga.uc} = ~$ga; + } + } + } + + if $match { + my $clef = parcel-first-if-needed($match); + $clef-info = ~($clef // $clef); + if $match { + $octave-shift = $match.Int; + } else { + $octave-shift = 0; + } + } + + self.bless(:key(%key-info), :clef($clef-info), :octave-shift($octave-shift) :basenote($match.uc)); + } + + method scale-names is export { + ($.basenote .. "G", "A".."G").flat[^7]; + } + +} diff --git a/lib/ABC/LongRest.rakumod b/lib/ABC/LongRest.rakumod new file mode 100644 index 0000000..2b4076a --- /dev/null +++ b/lib/ABC/LongRest.rakumod @@ -0,0 +1,13 @@ +use v6; + +class ABC::LongRest { + has $.measures_rest; + + method new($measures_rest) { + self.bless(:measures_rest(+$measures_rest)); + } + + method Str() { + "Z" ~ $.measures_rest; + } +} \ No newline at end of file diff --git a/lib/ABC/Note.rakumod b/lib/ABC/Note.rakumod new file mode 100644 index 0000000..96eded5 --- /dev/null +++ b/lib/ABC/Note.rakumod @@ -0,0 +1,32 @@ +use v6; + +use ABC::Duration; +use ABC::Pitched; + +class ABC::Note does ABC::Duration does ABC::Pitched { + has $.accidental; + has $.basenote; + has $.octave; + has $.is-tie; + + method new($accidental, $basenote, $octave, ABC::Duration $duration, $is-tie) { + self.bless(:$accidental, :$basenote, :$octave, :ticks($duration.ticks), :$is-tie); + } + + method pitch() { + $.accidental ~ $.basenote ~ $.octave; + } + + method Str() { + $.pitch ~ self.duration-to-str ~ ($.is-tie ?? "-" !! ""); + } + + method perl() { + "ABC::Note.new({ $.accidental.perl }, { $.basenote.perl }, { $.octave.perl }, { $.ticks.perl }, { $.is-tie.perl })"; + } + + method transpose($pitch-changer) { + my ($new-accidental, $new-basenote, $new-octave) = $pitch-changer($.accidental, $.basenote, $.octave); + ABC::Note.new($new-accidental, $new-basenote, $new-octave, self, $.is-tie); + } +} diff --git a/lib/ABC/Pitched.rakumod b/lib/ABC/Pitched.rakumod new file mode 100644 index 0000000..231744a --- /dev/null +++ b/lib/ABC/Pitched.rakumod @@ -0,0 +1,5 @@ +use v6; + +role ABC::Pitched { + method transpose($pitch-changer) { ... } +} diff --git a/lib/ABC/Rest.rakumod b/lib/ABC/Rest.rakumod new file mode 100644 index 0000000..94e47d1 --- /dev/null +++ b/lib/ABC/Rest.rakumod @@ -0,0 +1,15 @@ +use v6; + +use ABC::Duration; + +class ABC::Rest does ABC::Duration { + has $.type; + + method new($type, ABC::Duration $duration) { + self.bless(:$type, :ticks($duration.ticks)); + } + + method Str() { + $.type ~ self.duration-to-str; + } +} \ No newline at end of file diff --git a/lib/ABC/Stem.rakumod b/lib/ABC/Stem.rakumod new file mode 100644 index 0000000..0a2f7b7 --- /dev/null +++ b/lib/ABC/Stem.rakumod @@ -0,0 +1,22 @@ +use v6; + +use ABC::Duration; +use ABC::Pitched; + +class ABC::Stem does ABC::Duration does ABC::Pitched { + has @.notes; + has $.is-tie; + + method new(@notes, ABC::Duration $duration, $is-tie) { + die "Stem must have at least one note" if +@notes == 0; + self.bless(:@notes, :ticks(@notes>>.ticks.max * $duration.ticks), :$is-tie); + } + + method Str() { + "[" ~ @.notes.join("") ~ "]" ~ ($.is-tie ?? "-" !! ""); + } + + method transpose($pitch-changer) { + ABC::Stem.new(@.notes>>.transpose($pitch-changer), self, $.is-tie); + } +} diff --git a/lib/ABC/ToLilypond.rakumod b/lib/ABC/ToLilypond.rakumod new file mode 100644 index 0000000..63c4bfe --- /dev/null +++ b/lib/ABC/ToLilypond.rakumod @@ -0,0 +1,716 @@ +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; +use ABC::KeyInfo; +use ABC::Context; + +my $use-ABC-line-breaks = True; # false will use Lilypond's judgment + +my %accidental-map = ( '' => "", + '=' => "", + '^' => "is", + '^^' => "isis", + '_' => "es", + '__' => "eses" ); + +my %octave-map = ( -3 => ",,", + -2 => ",", + -1 => "", + 0 => "'", + 1 => "''", + 2 => "'''" ); + +my %unrecognized_gracings; +my %substitutes; +my %title-skips; + +my $spacing-comment = ''; # '%{ spacing %}'; + +sub start-lilypond($out, $paper-size) is export { + $out.say: '\\version "2.19.83"'; + $out.say: "#(set-default-paper-size \"{$paper-size}\")"; + $out.say: '#(define-bar-line ".|:-|." "|." ".|:" ".|")'; +} + +sub sanitize-quotation-marks($string, :$escape-number-sign?) is export { + my $s = $string; + $s.=subst(/^^ '"' (\S)/, {"“$0"}, :global); + $s.=subst(/ '"' (\S)/, {"“$0"}, :global); + $s.=subst(/'"'/, "”", :global); + $s.=subst(/"'s" $/, {"’s"}, :global); + $s.=subst(/"'s" /, {"’s"}, :global); + $s.=subst(/"'"(\S)/, {"‘$0"}, :global); + $s.=subst(/"'"/, "’", :global); + $s.=subst(/ "#" /, "＃", :global) if $escape-number-sign; + + my @subs = %substitutes.keys; + $s.=subst(/ (@subs) /, { %substitutes{$0} }, :global); + + $s; +} + +class LilypondContext { + has ABC::Context $.context; + + method new($key-name, $meter, $length, :$current-key-info) { + self.bless(context => ABC::Context.new($key-name, $meter, $length, :$current-key-info)); + } + + method bar-line { $.context.bar-line; } + + method get-Lilypond-pitch(ABC::Note $abc-pitch) { + my $real-accidental = $.context.working-accidental($abc-pitch); + + my $octave = +($abc-pitch.basenote ~~ 'a'..'z') + $.context.key-info.octave-shift; + given $abc-pitch.octave { + when !*.defined { } # skip if no additional octave info + when /\,/ { $octave -= $abc-pitch.octave.chars } + when /\'/ { $octave += $abc-pitch.octave.chars } + } + + $abc-pitch.basenote.lc ~ %accidental-map{$real-accidental} ~ %octave-map{$octave}; + } + + method get-Lilypond-duration(ABC::Duration $abc-duration) { + my $ticks = $abc-duration.ticks.Rat * $.context.length; + my $dots = ""; + given $ticks.numerator { + when 3 { $dots = "."; $ticks *= 2/3; } + when 7 { $dots = ".."; $ticks *= 4/7; } + } + die "Don't know how to handle duration { $abc-duration.ticks }" unless is-a-power-of-two($ticks); + die "Don't know how to handle duration { $abc-duration.ticks }" if $ticks > 4; + if $ticks == 4 { + "\\longa" ~ $dots; + } elsif $ticks == 2 { + "\\breve" ~ $dots; + } else { + $ticks.denominator ~ $dots; + } + } + + method meter-to-string() { + given $.context.meter { + when "none" { "" } + when "C" { "\\time 4/4" } + when "C|" { "\\time 2/2" } + when "3/4" { "\\time 3/4 \\set Timing.beamExceptions = #'()"} + when "6/4" { "\\time 6/4 \\set Timing.beatStructure = 2,2,2"} + "\\time { $.context.meter } "; + } + } + + method ticks-in-measure() { + given $.context.meter { + when "C" | "C|" { 1 / $.context.length; } + when "none" { Inf } + $.context.meter / $.context.length; + } + } + + method get-Lilypond-measure-length() { + given $.context.meter.trim { + when "C" | "C|" | "4/4" { "1" } + when "3/4" | 6/8 { "2." } + when "2/4" { "2" } + } + } + + method key-to-string() { + my $sf = $.context.key-info.key.flatmap({ "{.key}{.value}" }).sort.Str.lc; + my $major-key-name; + given $sf { + when "" { $major-key-name = "c"; } + when "f^" { $major-key-name = "g"; } + when "c^ f^" { $major-key-name = "d"; } + when "c^ f^ g^" { $major-key-name = "a"; } + when "c^ d^ f^ g^" { $major-key-name = "e"; } + when "a^ c^ d^ f^ g^" { $major-key-name = "b"; } + when "a^ c^ d^ e^ f^ g^" { $major-key-name = "fis"; } + when "a^ b^ c^ d^ e^ f^ g^" { $major-key-name = "cis"; } + when "b_" { $major-key-name = "f"; } + when "b_ e_" { $major-key-name = "bes"; } + when "a_ b_ e_" { $major-key-name = "ees"; } + when "a_ b_ d_ e_" { $major-key-name = "aes"; } + when "a_ b_ d_ e_ g_" { $major-key-name = "des"; } + when "a_ b_ c_ d_ e_ g_" { $major-key-name = "ges"; } + when "a_ b_ c_ d_ e_ f_ g_" { $major-key-name = "ces"; } + } + "\\key $major-key-name \\major\n"; + } + + method clef-to-string() { + my $lilypond-clef = "treble"; + given $.context.key-info.clef { + when not .defined { } + when "treble" | "alto" | "tenor" | "bass" { $lilypond-clef = ~$.context.key-info.clef; } + } + "\\clef $lilypond-clef"; + } +} + +sub get-field-if-there($header, $field) { + my @things = $header.get($field)>>.value; + ?@things ?? @things[0] !! ""; +} + +class TuneConvertor { + has $.context; + has $.log; + + method new($key, $meter, $length, $log) { + self.bless(:context(LilypondContext.new($key, $meter, $length)), :$log); + } + + # MUST: this is context dependent too + method Duration($element) { + $element.value ~~ ABC::Duration ?? $element.value.ticks !! 0; + } + + method StemPitchToLilypond($stem) { + given $stem { + when ABC::Note { + $.context.get-Lilypond-pitch($stem) + } + + when ABC::Stem { + "<" ~ $stem.notes.map({ + $.context.get-Lilypond-pitch($_) ~ ($_.is-tie ?? '~' !! '') + }).join(' ') ~ ">" + } + + die "Unrecognized alleged stem: " ~ $stem.perl; + } + } + + method StemToLilypond($stem, $suffix = "") { + " " ~ self.StemPitchToLilypond($stem) + ~ $.context.get-Lilypond-duration($stem) + ~ ($stem.is-tie ?? '~' !! '') + ~ $suffix + ~ " "; + } + + method WrapBar($lilypond-bar, $duration, :$might-be-parital?) { + my $ticks-in-measure = $.context.ticks-in-measure; + my $result = ""; + + if $ticks-in-measure == Inf { + $result ~= "\\cadenzaOn "; + + my @chunks = $lilypond-bar.split($spacing-comment); + for @chunks -> $chunk { + if $chunk !~~ /"["/ && $chunk.comb(/\d+/).grep(* > 4) > 1 { + $result ~= $chunk.subst(/ \s/, { "[ " }) ~ "]"; + } else { + $result ~= $chunk; + } + } + + $result ~= " \\cadenzaOff"; + } else { + if $might-be-parital && $duration % $ticks-in-measure != 0 { + my $note-length = 1 / $.context.context.length; + my $count = $duration % $ticks-in-measure; + if $count ~~ Rat { + die "Strange partial measure found: $lilypond-bar" unless is-a-power-of-two($count.denominator); + + while $count.denominator > 1 { + $note-length *= 2; # makes twice as short + $count *= 2; # makes twice as long + } + } + $result = "\\partial { $note-length }*{ $count } "; + } + $result ~= $lilypond-bar; + } + + $result; + } + + sub token-is-space($token) { + # this probably needs to get smarter about barline + so $token.key eq "spacing" | "endline" | "barline" | "end_nth_repeat" | "inline_field"; + } + + method SectionToLilypond(@elements, $out, :$first-bar-might-need-partial?, :$next-section-is-repeated?) { + my $first-bar = True; + my $notes = ""; + my $lilypond = ""; + my $duration = 0; + my $chord-duration = 0; + my $suffix = ""; + my $in-slur = False; + for @elements.kv -> $i, $element { + $duration += self.Duration($element); + $chord-duration += self.Duration($element); + given $element.key { + when "stem" { + $lilypond ~= self.StemToLilypond($element.value, $suffix); + $suffix = ""; + } + when "rest" { + $lilypond ~= " r{ $.context.get-Lilypond-duration($element.value) }$suffix "; + $suffix = ""; + } + when "tuplet" { + given $element.value.tuple { + when 2 { $lilypond ~= " \\times 3/2 \{"; } + when 3 { $lilypond ~= " \\times 2/3 \{"; } + when 4 { $lilypond ~= " \\times 3/4 \{"; } + $lilypond ~= " \\times 2/{ $element.value.tuple } \{"; + } + $lilypond ~= self.StemToLilypond($element.value.notes[0], "["); + for 1..($element.value.notes - 2) -> $i { + $lilypond ~= self.StemToLilypond($element.value.notes[$i]); + } + $lilypond ~= self.StemToLilypond($element.value.notes[*-1], "]"); + $lilypond ~= " } "; + $suffix = ""; + } + when "broken_rhythm" { + $lilypond ~= self.StemToLilypond($element.value.effective-stem1, $suffix); + # MUST: handle interior graciings + $lilypond ~= self.StemToLilypond($element.value.effective-stem2); + $suffix = ""; + } + when "gracing" { + given $element.value { + when "~" { $suffix ~= "\\turn"; } + when "." { $suffix ~= "\\staccato"; } + when "T" { $suffix ~= "\\trill"; } + when "P" { $suffix ~= "\\prall"; } + when "L" { $suffix ~= "\\accent"; } + when "!>!" { $suffix ~= "\\accent"; } + when "+" { $suffix ~= "-+"; } + when "!+!" { $suffix ~= "-+"; } + when "segno" { $lilypond ~= '\\mark \\markup { \\musicglyph #"scripts.segno" }'; } + when "coda" { $lilypond ~= '\\mark \\markup { \\musicglyph #"scripts.coda" }'; } + when "D.C." { $lilypond ~= '\\mark "D.C."'; } + when "D.S." { $lilypond ~= '\\mark "D.S."'; } + # when "D.C." { $suffix ~= '^\\markup { \\bold " D.C." } '; } + # when "D.S." { $suffix ~= '^\\markup { \\bold " D.S." } '; } + when "fine" { $suffix ~= '^\\markup { \\center-align { Fine } } '; } + when "breath" { $lilypond ~= '\\breathe'; } + when "crescendo(" | "<(" { $suffix ~= "\\<"; } + when "crescendo)" | "<)" { $suffix ~= "\\!"; } + when "diminuendo(" | ">(" { $suffix ~= "\\>"; } + when "diminuendo)" | ">)" { $suffix ~= "\\!"; } + when /^p+$/ | "mp" | "mf" | /^f+$/ | "fermata" | "accent" | "trill" | "sfz" | "marcato" + { $suffix ~= "\\" ~ $element.value; } + when "tenuto" { $suffix ~= "--"; } + $*ERR.say: "Unrecognized gracing: " ~ $element.value.perl; + %unrecognized_gracings{~$element.value} = 1; + } + } + when "barline" { + $notes ~= self.WrapBar($lilypond, $duration, + :might-be-parital($first-bar && $first-bar-might-need-partial)); + $first-bar = False; + + my $need-special = $next-section-is-repeated; + if $need-special && $i + 1 < @elements + && @elements[$i+1..*-1].grep({ !token-is-space($_) }) { + $need-special = False; + } + + given $element.value { + when "||" { $notes ~= $need-special ?? ' \\bar ".|:-||"' !! ' \\bar "||"'; } + when "|]" { $notes ~= $need-special ?? ' \\bar ".|:-|."' !! ' \\bar "|."'; } + default { + # $notes ~= ' \\bar "|"'; # this should be automatic -- except when this is wrong!! + } + } + $notes ~= "\n"; + $lilypond = ""; + $duration = 0; + $.context.bar-line; + } + when "inline_field" { + given $element.value.key { + when "K" { + $!context = LilypondContext.new($element.value.value, + $!context.context.meter, + $!context.context.length, + :current-key-info($!context.context.key-info)); + $lilypond ~= $!context.key-to-string; + $lilypond ~= $!context.clef-to-string; + } + when "M" { + $!context = LilypondContext.new($!context.context.key-name, + $element.value.value, + $!context.context.length); + $lilypond ~= $!context.meter-to-string; + } + when "L" { + $!context = LilypondContext.new($!context.context.key-name, + $!context.context.meter, + $element.value.value); + } + } + } + when "slur_begin" { + $suffix ~= "("; + $in-slur = True; + } + when "slur_end" { + $lilypond .= subst(/(\s+)$/, { ")$_" }) if $in-slur; + $*ERR.say: "Warning: End-slur found without begin-slur" unless $in-slur; + $in-slur = False; + } + when "multi_measure_rest" { + $lilypond ~= "\\compressFullBarRests R" + ~ $!context.get-Lilypond-measure-length + ~ "*" + ~ $element.value.measures_rest ~ " "; + } + when "chord_or_text" { + for @($element.value) -> $chord_or_text { + if $chord_or_text ~~ ABC::Chord { + $suffix ~= '^' ~ $chord_or_text ~ " "; + } else { + given $element.value { + when /^ '^'(.*)/ { $suffix ~= '^"' ~ $0 ~ '" ' } + } + } + } + } + when "grace_notes" { + $*ERR.say: "Unused suffix in grace note code: $suffix" if $suffix; + + $lilypond ~= $element.value.acciaccatura ?? "\\acciaccatura \{" !! "\\grace \{"; + if $element.value.notes == 1 { + $lilypond ~= self.StemToLilypond($element.value.notes[0], ""); + } else { + $lilypond ~= self.StemToLilypond($element.value.notes[0], "["); + for 1..^($element.value.notes - 1) { + $lilypond ~= self.StemToLilypond($element.value.notes[$_], ""); + } + $lilypond ~= self.StemToLilypond($element.value.notes[*-1], "]"); + } + $lilypond ~= " \} "; + + $suffix = ""; + } + when "spacing" { $lilypond ~= $spacing-comment } + when "endline" { $lilypond ~= "\\break \\noPageBreak" if $use-ABC-line-breaks; } + # .say; + } + } + + $out.say: "\{"; + $notes ~= self.WrapBar($lilypond, $duration, + :might-be-parital($first-bar && $first-bar-might-need-partial)); + $first-bar = False; + $out.say: $notes; + $out.say: " \}"; + } + + method BodyToLilypond(@elements, $out, :$prefix?) { + $out.say: "\{"; + $out.say: $prefix if $prefix; + + # if tune contains M: none sections, turn off barnumber display + if @elements.grep({ $_.key eq "inline_field" && $_.value.key eq "M" && $_.value.value eq "none" }) { + $out.say: "\\override Score.BarNumber.break-visibility = ##(#f #f #f)"; + } + + $out.print: $.context.key-to-string; + $out.say: "\\accidentalStyle modern-cautionary"; + $out.print: $.context.clef-to-string; + $out.print: $.context.meter-to-string; + + sub element-to-marker($element) { + given $element.key { + when "nth_repeat" { $element.value; } + when "barline" { + if $element.value ne "|" { + $element.value; + } else { + ""; + } + } + default { ""; } + } + } + + my $outer-self = self; + + class SectionInfo { + has $.start-index; + has $.end-index; + + method is-ending { @elements[self.start-index].key eq "nth_repeat"; } + + method is-space { + @elements[self.start-index..self.end-index].grep({ token-is-space($_) }) + == @elements[self.start-index..self.end-index] + } + + method starts-with-repeat { + so element-to-marker(@elements[self.start-index]) eq "|:" | "::" | ":|:"; + } + method ends-with-repeat { + so element-to-marker(@elements[self.end-index]) eq ":|" | "::" | ":|:"; + } + + method total-duration { + [+] (self.start-index..self.end-index).map(-> $i { $outer-self.Duration(@elements[$i])}); + } + + method first-bar-duration { + my $i = self.starts-with-repeat ?? self.start-index + 1 !! self.start-index; + my $duration = 0; + while $i < +@elements { + last if @elements[$i].key eq "barline"; + $duration += $outer-self.Duration(@elements[$i++]); + } + $duration; + } + } + + sub sections-to-lilypond(@sections, :$next-section-is-repeated?, :$first-bar-might-need-partial?) { + my $start = @sections[0].start-index; + $.log.say: "start = $start, +elements = { +@elements }"; + ++$start if @elements[$start].key eq "barline"; + $.log.say: "outputing $start to {@sections[*-1].end-index} { $next-section-is-repeated ?? 'Next section repeated' !! '' }"; + self.SectionToLilypond(@elements[$start .. @sections[*-1].end-index], + $out, :$next-section-is-repeated, :$first-bar-might-need-partial); + } + + my $start-of-section = 0; + my @sections; + for @elements.kv -> $i, $element { + next if $i == $start-of-section; + given element-to-marker($element) { + when /\d/ { + @sections.push(SectionInfo.new(start-index => $start-of-section, + end-index => $i-1)); + $start-of-section = $i; + } + when '|:' { + @sections.push(SectionInfo.new(start-index => $start-of-section, + end-index => $i-1)); + $start-of-section = $i; + } + when '::' | ':|:' { + @sections.push(SectionInfo.new(start-index => $start-of-section, + end-index => $i)); + $start-of-section = $i; + } + when '|]' | '||' | ':|' { + @sections.push(SectionInfo.new(start-index => $start-of-section, + end-index => $i)); + $start-of-section = $i+1; + } + } + } + @sections.push(SectionInfo.new(start-index => $start-of-section, + end-index => @elements - 1)); + + write-sections(@sections); + + sub write-section($section) { + $.log.say: "{$section.start-index} => {$section.end-index}" + ~ " {@elements[$section.start-index]} / {@elements[$section.end-index]}" + ~ " {$section.is-space ?? "SPACING" !! ""}"; + } + + sub write-sections(@sections) { + for @sections -> $section { + write-section($section); + } + } + + sub output-sections(@sections, :$next-section-is-repeated?, :$first-bar-might-need-partial?) { + $.log.say: "******************************** start cluster of sections"; + write-sections(@sections); + return unless @sections; + my @endings; + for @sections.kv -> $i, $section { + @endings.push($i) if $section.is-ending; + } + if @endings { + my $volta-count = 2; + # SHOULD: use endings to figure out right volta count + $out.print: "\\repeat volta $volta-count "; + sections-to-lilypond(@sections[0..^@endings[0]], :$next-section-is-repeated, + :$first-bar-might-need-partial); + $out.say: "\\alternative \{"; + for @endings.rotor(2=>-1) -> ($a, $b) { + $.log.say: "ending is $a => $b"; + sections-to-lilypond(@sections[$a..^$b], :$next-section-is-repeated); + } + sections-to-lilypond(@sections[@endings[*-1]..(*-1)], :$next-section-is-repeated); + $out.say: "\}"; + } elsif @sections.grep(*.ends-with-repeat) { + $out.print: "\\repeat volta 2 "; + sections-to-lilypond(@sections, :$next-section-is-repeated, + :$first-bar-might-need-partial); + } else { + sections-to-lilypond(@sections, :$next-section-is-repeated, + :$first-bar-might-need-partial); + } + } + + my $first-bar-might-need-partial = @sections + && 0 < @sections[0].first-bar-duration < $.context.ticks-in-measure; + if $first-bar-might-need-partial && +@sections > 1 { + if @sections[0].total-duration + @sections[1].first-bar-duration == $.context.ticks-in-measure { + $first-bar-might-need-partial = False; + } + } + + # delete empty sections from the end of the tune + while @sections && @sections[*-1].is-space { + @sections.pop; + } + + my $in-endings = False; + my @section-cluster; + for @sections -> $section { + if $in-endings { + if $section.is-ending || $section.is-space { + @section-cluster.push($section); + } else { + output-sections(@section-cluster, + :next-section-is-repeated($section.starts-with-repeat), + :$first-bar-might-need-partial); + $first-bar-might-need-partial = False; + @section-cluster = (); + @section-cluster.push($section); + $in-endings = False; + } + } else { + if @section-cluster && $section.starts-with-repeat { + # output everything up to the current section + output-sections(@section-cluster, :next-section-is-repeated(True), + :$first-bar-might-need-partial); + $first-bar-might-need-partial = False; + @section-cluster = (); + } + + @section-cluster.push($section); + } + + if !$in-endings { + if $section.is-ending { + $in-endings = True; + } else { + if $section.ends-with-repeat { + output-sections(@section-cluster, :next-section-is-repeated(True), + :$first-bar-might-need-partial); + $first-bar-might-need-partial = False; + @section-cluster = (); + } + } + } + } + if @section-cluster { + output-sections(@section-cluster, :$first-bar-might-need-partial); + $first-bar-might-need-partial = False; + } + + $out.say: "\}"; + } + +} + +sub TuneBodyToLilypondStream($tune, $out, :$prefix?, :$log?) is export { + my $key = $tune.header.get-first-value("K"); + my $meter = $tune.header.get-first-value("M"); + my $length = $tune.header.get-first-value("L") // default-length-from-meter($meter); + my $convertor = TuneConvertor.new($key, $meter, $length, $log // (open :w, $*SPEC.devnull)); + $convertor.BodyToLilypond($tune.music, $out, :$prefix); +} + +sub HeaderToLilypond(ABC::Header $header, $out, :$title?, :$subtitle?) is export { + $out.say: "\\header \{"; + + my $working-title = $title // $header.get-first-value("T") // "Unworking-titled"; + + my @skips = %title-skips.keys; + $working-title.=subst(/ (@skips) /, "", :global); + + $working-title = sanitize-quotation-marks($working-title); + $out.say: " title = \" $working-title \""; + my $composer = sanitize-quotation-marks(get-field-if-there($header, "C")); + my $origin = sanitize-quotation-marks(get-field-if-there($header, "O")); + if $origin { + if $origin ~~ m:i/^for/ { + $out.say: qq/ dedication = "$origin"/; + } else { + if $composer { + $composer ~= " ($origin)"; + } else { + $composer = $origin; + } + } + } + $out.say: qq/ composer = "{ sanitize-quotation-marks($composer) }"/ if $composer; + if $subtitle { + $out.say: " subtitle = " ~ '"' ~ $subtitle ~ '"'; + } else { + $out.say: " subtitle = ##f"; + } + + $out.say: "}"; +} + +sub tune-to-score($tune, $out, $log, @notes = $tune.header.get("N").map(*.value), :$subtitle?) is export { + $*ERR.say: "Working on { $tune.header.get-first-value("T") // $tune.header.get-first-value("X") }"; + $log.say: "Working on { $tune.header.get-first-value("T") // $tune.header.get-first-value("X") }"; + $out.say: "\\score \{"; + + TuneBodyToLilypondStream($tune, $out, :$log); + HeaderToLilypond($tune.header, $out, :$subtitle); + + $out.say: "}\n\n"; + + if @notes { + for @notes -> $note { + next if $note ~~ / ^ \s* $ /; + + $out.say: q:to/END/; + \noPageBreak + \markup \fill-line { + \center-column \wordwrap-lines { + END + + $out.say: " " ~ sanitize-quotation-marks($note, :escape-number-sign); + + $out.say: q:to/END/; + } + } + + END + } + } else { + # This was to allow breaks between tunes even if the tune + # ended with a linebreak and didn't have a note. Now + # trying to just avoid ending on a linebreak! + + # $out.say: q:to/END/; + # \markup \fill-line { } + # END + } +} + +sub GetUnrecognizedGracings() is export { + %unrecognized_gracings +} + +sub add-substitute($look-for, $replace-with) is export { + %substitutes{$look-for} = $replace-with; +} + +sub add-title-skip($look-for) is export { + %title-skips{$look-for} = 1; +} + diff --git a/lib/ABC/Tune.rakumod b/lib/ABC/Tune.rakumod new file mode 100644 index 0000000..f61f5dd --- /dev/null +++ b/lib/ABC/Tune.rakumod @@ -0,0 +1,21 @@ +use v6; +use ABC::Header; +use ABC::Pitched; + +class ABC::Tune { + has $.header; + has @.music; + + multi method new(ABC::Header $header, @music) { + self.bless(:$header, :@music); + } + + method transpose(Int $steps-up) { + sub transpose-element($element) { + $element.key => ($element.value ~~ ABC::Pitched) ?? $element.transpose($steps-up) + !! $element.value; + } + + ABC::Tune.new($.header, @.music.map({ transpose-element($_); })); + } +} \ No newline at end of file diff --git a/lib/ABC/Tuplet.rakumod b/lib/ABC/Tuplet.rakumod new file mode 100644 index 0000000..9f23707 --- /dev/null +++ b/lib/ABC/Tuplet.rakumod @@ -0,0 +1,43 @@ +use v6; + +use ABC::Duration; +use ABC::Pitched; + +class ABC::Tuplet does ABC::Duration does ABC::Pitched { + has $.p; + has $.q; + has @.notes; + + multi method new($p, @notes) { + self.new($p, default-q($p), @notes); + } + + multi method new($p, $q, @notes) { + die "Tuplet must have at least one note" if +@notes == 0; + self.bless(:$p, :$q, :@notes, :ticks($q/$p * [+] @notes>>.ticks)); + } + + sub default-q($p) { + given $p { + when 3 | 6 { 2; } + when 2 | 4 | 8 { 3; } + default { 2; } # really need to know the time signature for this! + } + } + + method Str() { + my $q = $.q != default-q($.p) ?? $.q !! ""; + my $r = @.notes != $.p ?? +@.notes !! ""; + if $q eq "" && $r eq "" { + "(" ~ $.p ~ @.notes.join(""); + } else { + "(" ~ $.p ~ ":" ~ $q ~ ":" ~ $r ~ @.notes.join(""); + } + } + + method transpose($pitch-changer) { + ABC::Tuplet.new($.tuple, @.notes>>.transpose($pitch-changer)); + } + + method tuple() { $.p; } # for backwards compatibility, probably needs to go in the long run +} diff --git a/lib/ABC/Utils.rakumod b/lib/ABC/Utils.rakumod new file mode 100644 index 0000000..230a83e --- /dev/null +++ b/lib/ABC/Utils.rakumod @@ -0,0 +1,241 @@ +use v6; +use ABC::Grammar; +use ABC::Context; +use ABC::Note; + +package ABC::Utils { + sub str-to-stem($note) is export { + my $match = ABC::Grammar.parse($note, :rule, :actions(ABC::Actions.new)); + $match.ast; + } + + sub element-to-str($element-pair) is export { + given $element-pair.key { + when "gracing" { + given $element-pair.value { + when '.' | '~' { $element-pair.value; } + '+' ~ $element-pair.value ~ '+'; + } + } + when "inline_field" { '[' ~ $element-pair.value.key ~ ':' ~ $element-pair.value.value ~ ']'; } + when "chord_or_text" { + $element-pair.value.flatmap({ + when Str { '"' ~ $_ ~ '"'; } + ~$_; + }).join('') ; + } + when "endline" { "\n"; } + when "nth_repeat" { + $element-pair.value ~~ Set ?? "[" ~ $element-pair.value.keys.join(",") + !! "[" ~ $element-pair.value.perl; + } + ~$element-pair.value; + } + } + + + sub apply_key_signature(%key_signature, $pitch) is export + { + my $resulting_note = ""; + if $pitch + { + $resulting_note ~= $pitch.Str; + } + else + { + if %key_signature{$pitch.uc}:exists { + $resulting_note ~= %key_signature{$pitch.uc}; + } + } + $resulting_note ~= $pitch.Str; + $resulting_note ~= $pitch.Str if $pitch; + return $resulting_note; + } + + sub is-a-power-of-two($n) is export { + if $n ~~ Rat { + is-a-power-of-two($n.numerator) && is-a-power-of-two($n.denominator); + } else { + !($n +& ($n - 1)); + } + } + + my %notename-to-ordinal = ( + C => 0, + D => 2, + E => 4, + F => 5, + G => 7, + A => 9, + B => 11, + c => 12, + d => 14, + e => 16, + f => 17, + g => 19, + a => 21, + b => 23 + ); + + sub to-note-and-number($basenote, $octave-symbol) is export { + my $octave = $basenote ~~ /<[A..G]>/ ?? 5 !! 6; + for $octave-symbol.comb { + when "," { $octave-- } + when "'" { $octave++ } + } + ($basenote.uc, $octave); + } + + sub from-note-and-number($basenote, $octave-number) is export { + if $octave-number <= 5 { + ($basenote.uc, "," x (5 - $octave-number)); + } else { + ($basenote.lc, "'" x ($octave-number - 6)) + } + } + + sub pitch-to-ordinal(%key, $accidental, $basenote, $octave) is export { + my $ord = %notename-to-ordinal{$basenote}; + given $accidental || %key{$basenote.uc} || "" { + when /^ "^"+ $/ { $ord += $_.chars; } + when /^ "_"+ $/ { $ord -= $_.chars; } + } + given $octave { + when /^ "'"+ $/ { $ord += $_.chars * 12} + when /^ ","+ $/ { $ord -= $_.chars * 12} + when "" { } + die "Unable to recognize octave $octave"; + } + $ord; + } + + sub ordinal-to-pitch(%key, $basenote, $ordinal, $keep-accidental = False) is export { + my $octave = 0; + my $working-ordinal = %notename-to-ordinal{$basenote.uc}; + while $ordinal + 5 < $working-ordinal { + $working-ordinal -= 12; + $octave -= 1; + } + while $working-ordinal + 5 < $ordinal { + $working-ordinal += 12; + $octave += 1; + } + + my $key-accidental = %key{$basenote.uc} || "="; + my $working-accidental; + given $ordinal - $working-ordinal { + when -2 { $working-accidental = "__"; } + when -1 { $working-accidental = "_"; } + when 0 { $working-accidental = "="; } + when 1 { $working-accidental = "^"; } + when 2 { $working-accidental = "^^"; } + die "Too far away from note: $ordinal vs $working-ordinal"; + } + if !$keep-accidental && ($key-accidental eq $working-accidental) { + $working-accidental = ""; + } + if $octave > 0 { + ($working-accidental, $basenote.lc, "'" x ($octave - 1)); + } else { + ($working-accidental, $basenote.uc, "," x -$octave); + } + } + + sub stream-of-notes($tune) is export { + my $key = $tune.header.get-first-value("K"); + my $meter = $tune.header.get-first-value("M"); + my $length = $tune.header.get-first-value("L") // "1/8"; + + my $context = ABC::Context.new($key, $meter, $length); + my @elements = $tune.music; + + my $repeat-position = 0; + my $repeat-context = ABC::Context.new($context); + my $repeat-count = 1; + my $in-nth-repeat = False; + my $i = 0; + gather while ($i < @elements) { + given @elements[$i].key { + when "stem" { + my $stem = @elements[$i].value; + take ABC::Note.new($context.working-accidental($stem), + $stem.basenote, + $stem.octave, + $stem, + $stem.is-tie); + } + when "tuplet" { + my $tuplet = @elements[$i].value; + for $tuplet.notes -> $note { + take ABC::Note.new($context.working-accidental($note), + $note.basenote, + $note.octave, + ABC::Duration.new(:ticks(2 / $tuplet.tuple * $note.ticks)), + $note.is-tie); + } + } + when "broken_rhythm" { + my $br = @elements[$i].value; + for ($br.effective-stem1, $br.effective-stem2) -> $stem { + take ABC::Note.new($context.working-accidental($stem), + $stem.basenote, + $stem.octave, + $stem, + $stem.is-tie); + } + } + when "nth_repeat" { + $in-nth-repeat = True; + if $repeat-count !(elem) @elements[$i].value { + # this is an ending for some other repeat, skip it + $i++ while ($i < @elements + && !(@elements[$i].key eq "barline" + && @elements[$i].value eq ":|" | ":|:")); + } + } + when "end_nth_repeat" { + $in-nth-repeat = False; + } + when "barline" { + given @elements[$i].value { + when ":|" | ":|:" { + if $in-nth-repeat || $repeat-count == 1 { + $context = ABC::Context.new($repeat-context); + $i = $repeat-position; + $repeat-count++; + } else { + # treat :| as :|: because it is sometimes used as such by mistake + $repeat-context = ABC::Context.new($context); + $repeat-position = $i; + $repeat-count = 1; + } + $in-nth-repeat = False; + } + when "|:" { + $repeat-context = ABC::Context.new($context); + $repeat-position = $i; + $repeat-count = 1; + $in-nth-repeat = False; + } + } + $context.bar-line; + } + when "chord_or_text" { } + when "spacing" { } + when "endline" { } + take @elements[$i].key; + } + $i++; + } + } + + sub default-length-from-meter($meter) is export { + if $meter ~~ m{(\d+ '/' \d+)} { + $0.Rat < 3/4 ?? "1/16" !! "1/8"; + } else { + "1/8"; + } + } +} + + diff --git a/playing.pl b/playing.raku similarity index 72% rename from playing.pl rename to playing.raku index de252f3..8f65e13 100644 --- a/playing.pl +++ b/playing.raku @@ -1,6 +1,6 @@ use v6; -BEGIN { push @*INC, "lib" } +use lib 'lib'; use ABC; my $abc = q«X:64 @@ -24,8 +24,8 @@ { for $bar { - when . { take .[0]; take .[1]; } - when . { take .; } + when . { take .[0]; take .[1]; } + when . { take .; } } } } @@ -33,4 +33,6 @@ my %header = header_hash($match
); my %key_signature = key_signature(%header); -@notes.map({say . ~ " => " ~ apply_key_signature(%key_signature, .)}); +for @notes { + say . ~ " => " ~ apply_key_signature(%key_signature, .); +} diff --git a/r-star.abc b/r-star.abc new file mode 100644 index 0000000..88ecd2e --- /dev/null +++ b/r-star.abc @@ -0,0 +1,47 @@ +X:24 +T:Tali Foster's +M:6/8 +L:1/8 +C:Solomon Foster +O: For Tali Foster, 199?-2009 +R:Jig +K:G major +D|:+mp+ ~G3 DGB|ded cAF|~B3 DGB|ABG FED| +~G3 DGB|ded cAF|d>ed cAF|[1 AGF G2D:|[2 AGF GBd| +|:+ff+ ~g3 dgg|efg edB|~a3 ef^g|afe ^cBA| +~g3 dgg|egg dBG|d>ed cAF|[1 AGF GBd:|[2 AGF G3|] + +X:25 +T:The Star of Rakudo +M:2/2 +L:1/8 +C:Solomon Foster +R:Reel +K:G major +zA|:BAGB cBAc|decd BAGE|DEGA BA(3Bcd|~e3f edBA| +BAGB cBAc|decd BAGE|DEGA BABd|egdB G3A:| +|:B~g3 c~a3|bagb aged|DEGA BABd|~e3f edBA| +B~g3 c~a3|bagb aged|DEGA BABd|egdB G3A:| + +X:4 +L:1/8 +M:6/8 +T:transition from Father Kelly's into Frost Is All Over +S:Great Lakes Ceili Band +K:G +FAd fed|cAF G2z|[K:D]+accent+dzf edc|dAF GFE| + +X:5 +T:Sydney Pittman's Tune +O:Rufus Guinchard, from the playing of Sydney Pittman +M:6/8 +L:1/8 +K:G +e2 a a2 g|e2 a a2f|g2 g g2 f|e2 f g3| +a2 g f2 e|d2 B G2 A|B2 d d2 B|A3 A3:| +|:e2 g e2 d|B2 A G2D|G2 B d2 B| [M:9/8] A2 B d3 d3| +[M:6/8] e2 g e2 d|B2 A G2 D|G2 B d2 B|A3 A3:| + + + + diff --git a/t/01-regexes.rakutest b/t/01-regexes.rakutest new file mode 100644 index 0000000..fd5d75b --- /dev/null +++ b/t/01-regexes.rakutest @@ -0,0 +1,576 @@ +use v6; +use Test; +use ABC::Grammar; + +{ + my $match = ABC::Grammar.parse('"Cmin"', :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"Cmin" is a chord'; + is $match, "Cmin", '"Cmin" is chord Cmin'; + is $match[0], "C", '"Cmin" has base note C'; + is $match[0], "min", '"Cmin" has chord_type "min"'; +} + +{ + my $match = ABC::Grammar.parse('"1"', :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"1" is a chord or text'; + is $match, "1", '"1" is text 1'; +} + +{ + my $match = ABC::Grammar.parse("^A,", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"^A," is a pitch'; + is $match, "A", '"^A," has base note A'; + is $match, ",", '"^A," has octave ","'; + is $match, "^", '"^A," has accidental "#"'; +} + +{ + my $match = ABC::Grammar.parse("_B", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"_B" is a pitch'; + is $match, "B", '"_B" has base note B'; + is $match, Nil, '"_B" has no octave'; + is $match, "_", '"_B" has accidental "_"'; +} + +{ + my $match = ABC::Grammar.parse("C''", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"note" is a pitch'; + is $match, "C", '"note" has base note C'; + is $match, "''", '"note" has octave two-upticks'; + is $match, Nil, '"note" has no accidental'; +} + +{ + my $match = ABC::Grammar.parse("=d,,,", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"=d,,," is a pitch'; + is $match, "d", '"=d,,," has base note d'; + is $match, ",,,", '"=d,,," has octave ",,,"'; + is $match, "=", '"=d,,," has accidental "="'; +} + +{ + my $match = ABC::Grammar.parse("2", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"2" is a note length'; + is $match, "2", '"2" has note length 2'; +} + +{ + my $match = ABC::Grammar.parse("^^e2", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"^^e2" is a note'; + is $match, "e", '"^^e2" has base note e'; + is $match, Nil, '"^^e2" has no octave'; + is $match, "^^", '"^^e2" has accidental "^^"'; + is $match, "2", '"^^e2" has note length 2'; +} + +{ + my $match = ABC::Grammar.parse("__f'/", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"__f/" is a note'; + is $match, "f", '"__f/" has base note f'; + is $match, "'", '"__f/" has octave tick'; + is $match, "__", '"__f/" has accidental "__"'; + is $match, "/", '"__f/" has note length /'; +} + +{ + my $match = ABC::Grammar.parse("G,2/3", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"G,2/3" is a note'; + is $match, "G", '"G,2/3" has base note G'; + is $match, ",", '"G,2/3" has octave ","'; + is $match, Nil, '"G,2/3" has no accidental'; + is $match, "2/3", '"G,2/3" has note length 2/3'; +} + +{ + my $match = ABC::Grammar.parse("z2/3", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"z2/3" is a rest'; + is $match, "z", '"z2/3" has base rest z'; + is $match, "2/3", '"z2/3" has note length 2/3'; +} + +{ + my $match = ABC::Grammar.parse("y/3", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"y/3" is a rest'; + is $match, "y", '"y/3" has base rest y'; + is $match, "/3", '"y/3" has note length 2/3'; +} + +{ + my $match = ABC::Grammar.parse("x", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"x" is a rest'; + is $match, "x", '"x" has base rest x'; + is $match, "", '"x" has no note length'; +} + +{ + my $match = ABC::Grammar.parse("v", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"v" is an element'; + is $match, "v", '"v" gracing is v'; +} + +{ + my $match = ABC::Grammar.parse("T", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"T" is an element'; + is $match, "T", '"T" gracing is T'; +} + +{ + my $match = ABC::Grammar.parse("+trill+", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"+trill+" is an element'; + is $match, "+trill+", '"+trill+" gracing is +trill+'; +} + +{ + my $match = ABC::Grammar.parse("!trill!", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"!trill!" is an element'; + is $match, "!trill!", '"!trill!" gracing is !trill!'; +} + +{ + my $match = ABC::Grammar.parse("~", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"~" is an element'; + is $match, "~", '"~" gracing is ~'; +} + +{ + my $match = ABC::Grammar.parse("z/", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"z/" is an element'; + is $match, "z", '"z/" has base rest z'; + is $match, "/", '"z/" has length "/"'; +} + +{ + my $match = ABC::Grammar.parse("(", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"(" is an element'; + is $match, '(', '"(" is a slur begin'; +} + +{ + my $match = ABC::Grammar.parse(")", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '")" is an element'; + is $match, ')', '")" is a slur end'; +} + +{ + my $match = ABC::Grammar.parse("_D,5/4", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"_D,5/4" is an element'; + is $match[0], "D", '"_D,5/4" has base note D'; + is $match[0], ",", '"_D,5/4" has octave ","'; + is $match[0], "_", '"_D,5/4" is flat'; + is $match[0], "5/4", '"_D,5/4" has note length 5/4'; +} + +{ + my $match = ABC::Grammar.parse("A>^C'", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"A>^C" is a broken rhythm'; + is $match[0][0], "A", 'first note is A'; + is $match[0][0], Nil, 'first note has no octave'; + is $match[0][0], Nil, 'first note has no accidental'; + is $match[0][0], "", 'first note has no length'; + is $match, ">", 'angle is >'; + is $match[1][0], "C", 'second note is C'; + is $match[1][0], "'", 'second note has octave tick'; + is $match[1][0], "^", 'second note is sharp'; + is $match[1][0], "", 'second note has no length'; +} + +{ + my $match = ABC::Grammar.parse("d'+p+<<<+accent+_B", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"d+p+<<<+accent+_B" is a broken rhythm'; + given $match + { + is .[0][0], "d", 'first note is d'; + is .[0][0], "'", 'first note has an octave tick'; + is .[0][0], Nil, 'first note has no accidental'; + is .[0][0], "", 'first note has no length'; + is .[0], "+p+", 'first gracing is +p+'; + is ., "<<<", 'angle is <<<'; + is .[0], "+accent+", 'second gracing is +accent+'; + is .[1][0], "B", 'second note is B'; + is .[1][0], Nil, 'second note has no octave'; + is .[1][0], "_", 'second note is flat'; + is .[1][0], "", 'second note has no length'; + } +} + +{ + my $match = ABC::Grammar.parse("(3abc", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"(3abc" is a tuplet'; + is ~$match, "(3abc", '"(3abc" was the portion matched'; + is +@( $match ), 3, 'Three notes matched'; + is $match[0], "a", 'first note is a'; + is $match[1], "b", 'second note is b'; + is $match[2], "c", 'third note is c'; +} + +{ + my $match = ABC::Grammar.parse("(3 ab c", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"(3 ab c" is a tuplet'; + is ~$match, "(3 ab c", '"(3 ab c" was the portion matched'; + is +@( $match ), 3, 'Three notes matched'; + is $match[0], "a", 'first note is a'; + is $match[1], "b", 'second note is b'; + is $match[2], "c", 'third note is c'; +} + +{ + my $match = ABC::Grammar.parse("(5abcde", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"(5abcde" is a tuplet'; + is ~$match, "(5abcde", '"(5abcde" was the portion matched'; + is +@( $match ), 5, 'Three notes matched'; + is $match[0], "a", 'first note is a'; + is $match[1], "b", 'second note is b'; + is $match[2], "c", 'third note is c'; + is $match[3], "d", 'fourth note is d'; + is $match[4], "e", 'fifth note is e'; +} + +{ + my $match = ABC::Grammar.parse("[a2bc]3", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"[a2bc]3" is a stem'; + is ~$match, "[a2bc]3", '"[a2bc]3" was the portion matched'; + is +@( $match ), 3, 'Three notes matched'; + is $match[0], "a2", 'first note is a2'; + is $match[1], "b", 'second note is b'; + is $match[2], "c", 'third note is c'; + is $match, "3", 'correct duration'; + nok ?$match, 'not tied'; +} + +{ + my $match = ABC::Grammar.parse("[a2bc]3-", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"[a2bc]3-" is a stem'; + is ~$match, "[a2bc]3-", '"[a2bc]3-" was the portion matched'; + is +@( $match ), 3, 'Three notes matched'; + is $match[0], "a2", 'first note is a2'; + is $match[1], "b", 'second note is b'; + is $match[2], "c", 'third note is c'; + is $match, "3", 'correct duration'; + ok ?$match, 'tied'; +} + +{ + my $match = ABC::Grammar.parse("[A3 D3 ]", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, '"[A3 D3 ]" is a stem'; + is ~$match, "[A3 D3 ]", '"[A3 D3 ]" was the portion matched'; + is +@( $match ), 2, 'Two notes matched'; + is $match[0], "A3", 'first note is A3'; + is $match[1], "D3", 'second note is D3'; + nok ?$match, 'not tied'; +} + +# (3 is the only case that works currently. :( +# { +# my $match = ABC::Grammar.parse("(2abcd", :rule); +# isa-ok $match, Match, '"(2ab" is a tuple'; +# is ~$match, "(2ab", '"(2ab" was the portion matched'; +# is $match[0], "a", 'first note is a'; +# is $match[1], "b", 'second note is b'; +# } + +for ':|:', '|:', '|', ':|', '::', '|]' +{ + my $match = ABC::Grammar.parse($_, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, "barline $_ recognized"; + is $match, $_, "barline $_ is correct"; +} + +{ + my $match = ABC::Grammar.parse("g>ecgece/f/g/e/|", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'bar recognized'; + is $match, "g>ecgece/f/g/e/|", "Entire bar was matched"; + is $match.flatmap(~*), "g>e c g e c e/ f/ g/ e/", "Each element was matched"; + is $match, "|", "Barline was matched"; +} + +{ + my $match = ABC::Grammar.parse("g>ecg ec e/f/g/e/ |", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'bar recognized'; + is $match, "g>ecg ec e/f/g/e/ |", "Entire bar was matched"; + is $match.flatmap(~*), "g>e c g e c e/ f/ g/ e/ ", "Each element was matched"; + is $match, "|", "Barline was matched"; +} + +{ + my $line = "g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ |"; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; + is $match[1], " d/c/B/A/ Gd BG B/c/d/B/ |", "Second bar is correct"; + # say $match.perl; +} + +{ + my $line = "g>ecg ec e/f/g/e/ |1 d/c/B/A/ Gd BG B/c/d/B/ |"; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; + is $match[1], "1 d/c/B/A/ Gd BG B/c/d/B/ |", "Second bar is correct, even with stupid hacky |1 ending marker"; + # say $match.perl; +} + +{ + my $line = "|A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 ::"; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0], "A/B/c/A/ c>d e>deg |", "First bar is correct"; + is $match[1], " dB/A/ gB +trill+A2 +trill+e2 ::", "Second bar is correct"; + is $match, "|", "Initial barline matched"; + # say $match.perl; +} + +{ + my $line = 'g>ecg ec e/f/g/e/ |[2-3 d/c/B/A/ {Gd} BG B/c/d/B/ |'; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; + is $match[1], '[2-3 d/c/B/A/ {Gd} BG B/c/d/B/ |', "Second bar is correct"; + # say $match.perl; +} + +{ + my $match = ABC::Grammar.parse("[K:F]", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'inline field recognized'; + is $match, "[K:F]", "Entire string was matched"; + is $match, "K", "Correct field name found"; + is $match, "F", "Correct field value found"; +} + +{ + my $match = ABC::Grammar.parse("[M:3/4]", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'inline field recognized'; + is $match, "[M:3/4]", "Entire string was matched"; + is $match, "M", "Correct field name found"; + is $match, "3/4", "Correct field value found"; +} + +{ + my $match = ABC::Grammar.parse(" % this is a comment", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'comment line recognized'; + is $match, " % this is a comment", "Entire string was matched"; +} + +{ + my $match = ABC::Grammar.parse("% this is a comment", :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'comment line recognized'; + is $match, "% this is a comment", "Entire string was matched"; +} + +{ + my $line = "g>ecg ec e/f/g/e/ | d/c/B/A/ [K:F] Gd BG B/c/d/B/ |"; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; + is $match[1], " d/c/B/A/ [K:F] Gd BG B/c/d/B/ |", "Second bar is correct"; + ok @( $match[1] ).grep("[K:F]"), "Key change got recognized"; + # say $match.perl; +} + +{ + my $line = "g>ecg ec e/f/g/e/ | d/c/B/A/ [M:C] Gd BG B/c/d/B/ |"; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; + is $match[1], " d/c/B/A/ [M:C] Gd BG B/c/d/B/ |", "Second bar is correct"; + ok @( $match[1] ).grep("[M:C]"), "Meter change got recognized"; + # say $match.perl; +} + +{ + my $line = "| [K:F] Gd BG [B/c/d/B/]|"; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[0][1], "[K:F]", "Key signature change is correctly captured"; + # is $match[1], " d/c/B/A/ [K:F] Gd BG B/c/d/B/ |", "Second bar is correct"; +} + +{ + my $line = 'E2 CE GCEG|c4 B3 ^F|(A2 G2) =F2 D2|C4 {B,C}E2 D>E|[1 (D4 C2) z2:|[2 (D4 C2) z3/2 [G/2D/2]|'; + my $match = ABC::Grammar.parse($line, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'line of music recognized'; + is $match, $line, "Entire line was matched"; + is $match[5][0], "[2", "nth repeat works"; +} + +{ + my $music = q«A/B/c/A/ +trill+c>d e>deg | GG +trill+B>c d/B/A/G/ B/c/d/B/ | + A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 :: + g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ | + g/f/e/d/ c/d/e/f/ gc e/f/g/e/ | dB/A/ gB +trill+A2 +trill+e2 :|»; + my $match = ABC::Grammar.parse($music, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'music recognized'; + is $match.elems, 4, "Four lines matched"; +} + +{ + my $music = q«% Comment +X:64 +T:Cuckold Come Out o' the Amrey +S:Northumbrian Minstrelsy +M:4/4 +L:1/8 +K:D +»; + my $match = ABC::Grammar.parse($music, :rule
); + isa-ok $match, Match, 'Got a match'; + ok $match, 'header recognized'; + is $match.elems, 6, "Six fields matched"; + is $match.flatmap({ . }), "X T S M L K", "Got the right field names"; +} + +{ + my $music = q«X:64 +T:Cuckold Come Out o' the Amrey +S:Northumbrian Minstrelsy +M:4/4 +L:1/8 +K:D +A/B/c/A/ +trill+c>d e>deg | GG +trill+B>c d/B/A/G/ B/c/d/B/ | +A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 :: % test comment +g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ | +g/f/e/d/ c/d/e/f/ gc e/f/g/e/ | dB/A/ gB +trill+A2 +trill+e2 :| +»; + my $match = ABC::Grammar.parse($music, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'tune recognized'; + given $match
+ { + is ..elems, 6, "Six fields matched"; + is ..flatmap({ . }), "X T S M L K", "Got the right field names"; + } + is $match.elems, 4, "Four lines matched"; +} + +{ + my $music = q«X:1 +T:Are You Coming From The Races? +O:from the playing of Frank Maher +M:2/4 +L:1/8 +R:Single +K:D +DE|:F2 F2|AF ED|E2 EF|ED DE|F2 F2|AF ED|E2 D2| +|[1 D2 DE:|[2 D2 dc|:B2 Bc|BA FG|AB AF| +AF dc|B2 Bc|BA FA|B2 A2|[1 A2 dc:|[2 A2 + +X:2 +T:Bride's Jig +O:from the playing of Frank Maher +M:2/4 +L:1/8 +R:Single +K:Edor +|:B E2 G|FE D2|E>F GA|Bc BA|B E2 G|FE D2|E>F GE|A2 A2:| +|:AB cd|e4|AB cB|BA FA|AB cd|e4|AB cB|A2 A2:| +»; + my $match = ABC::Grammar.parse($music, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'tune_file recognized'; + + is $match.elems, 2, 'found two tunes'; + is $match[0].elems, 3; + is $match[1].elems, 2; +} + +{ + my $music = q«X:1 +T:Are You Coming From The Races? +O:from the playing of Frank Maher +M:2/4 +L:1/8 +R:Single +K:D +DE|:F2 F2|AF ED|E2 EF|ED DE|F2 F2|AF ED|E2 D2| +|[1 D2 DE:|[2 D2 dc|:B2 Bc|BA FG|AB AF| +AF dc|B2 Bc|BA FA|B2 A2|[1 A2 dc:|[2 A2 + +X:2 +T:Bride's Jig +O:from the playing of Frank Maher +M:2/4 +L:1/8 +R:Single +K:Edor +|:B E2 G|FE D2|E>F GA|Bc BA|B E2 G|FE D2|E>F GE|A2 A2:| +|:AB cd|e4|AB cB|BA FA|AB cd|e4|AB cB|A2 A2:|»; + my $match = ABC::Grammar.parse($music, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'tune_file recognized'; + + is $match.elems, 2, 'found two tunes'; + is $match[0].elems, 3; + is $match[1].elems, 2; +} + +{ + my $music = q«X:1 +T:Canon in D +C:Pachelbel +M:2/2 +L:1/8 +K:D +"D" DFAd "A" CEAc|"Bm" B,DFB "F#m" A,CFA|"G" B,DGB "D" A,DFA|"G" B,DGB "A" CEAc| +"D" f4 "A" e4|"Bm" d4 "F#m" c4|"G" B4 "D" A4|"G" B4 "A" c4| +»; + my $match = ABC::Grammar.parse($music, :rule); + isa-ok $match, Match, 'Got a match'; + ok $match, 'tune_file recognized'; + + is $match.elems, 1, 'found one tune'; + is $match[0].elems, 2, "with two lines of music"; +} + +done-testing; diff --git a/t/01-regexes.t b/t/01-regexes.t deleted file mode 100644 index c0f3396..0000000 --- a/t/01-regexes.t +++ /dev/null @@ -1,249 +0,0 @@ -use v6; -use Test; -use ABC; - -plan *; - -{ - my $match = "^A," ~~ m/ /; - isa_ok $match, Match, '"^A," is a pitch'; - is $match, "A", '"^A," has base note A'; - is $match, ",", '"^A," has octave ","'; - is $match, "^", '"^A," has accidental "#"'; -} - -{ - my $match = "_B" ~~ m/ /; - isa_ok $match, Match, '"_B" is a pitch'; - is $match, "B", '"_B" has base note B'; - is $match, "", '"_B" has octave ""'; - is $match, "_", '"_B" has accidental "_"'; -} - -{ - my $match = "C''" ~~ m/ /; - isa_ok $match, Match, '"note" is a pitch'; - is $match, "C", '"note" has base note C'; - is $match, "''", '"note" has octave two-upticks'; - is $match, "", '"note" has accidental ""'; -} - -{ - my $match = "=d,,," ~~ m/ /; - isa_ok $match, Match, '"=d,,," is a pitch'; - is $match, "d", '"=d,,," has base note d'; - is $match, ",,,", '"=d,,," has octave ",,,"'; - is $match, "=", '"=d,,," has accidental "="'; -} - -{ - my $match = "^^e2" ~~ m/ /; - isa_ok $match, Match, '"^^e2" is a note'; - is $match, "e", '"^^e2" has base note e'; - is $match, "", '"^^e2" has octave ""'; - is $match, "^^", '"^^e2" has accidental "^^"'; - is $match, "2", '"^^e2" has note length 2'; -} - -{ - my $match = "__f'/" ~~ m/ /; - isa_ok $match, Match, '"__f/" is a note'; - is $match, "f", '"__f/" has base note f'; - is $match, "'", '"__f/" has octave tick'; - is $match, "__", '"__f/" has accidental "__"'; - is $match, "/", '"__f/" has note length /'; -} - -{ - my $match = "G,2/3" ~~ m/ /; - isa_ok $match, Match, '"G,2/3" is a note'; - is $match, "G", '"G,2/3" has base note G'; - is $match, ",", '"G,2/3" has octave ","'; - is $match, "", '"G,2/3" has no accidental'; - is $match, "2/3", '"G,2/3" has note length 2/3'; -} - -{ - my $match = "z2/3" ~~ m/ /; - isa_ok $match, Match, '"z2/3" is a rest'; - is $match, "z", '"z2/3" has base rest z'; - is $match, "2/3", '"z2/3" has note length 2/3'; -} - -{ - my $match = "y/3" ~~ m/ /; - isa_ok $match, Match, '"y/3" is a rest'; - is $match, "y", '"y/3" has base rest y'; - is $match, "/3", '"y/3" has note length 2/3'; -} - -{ - my $match = "x" ~~ m/ /; - isa_ok $match, Match, '"x" is a rest'; - is $match, "x", '"x" has base rest x'; - is $match, "", '"x" has no note length'; -} - -{ - my $match = "+trill+" ~~ m/ /; - isa_ok $match, Match, '"+trill+" is an element'; - is $match, "+trill+", '"+trill+" gracing is +trill+'; -} - -{ - my $match = "~" ~~ m/ /; - isa_ok $match, Match, '"~" is an element'; - is $match, "~", '"~" gracing is ~'; -} - -{ - my $match = "z/" ~~ m/ /; - isa_ok $match, Match, '"z/" is an element'; - is $match, "z", '"z/" has base rest z'; - is $match, "/", '"z/" has length "/"'; -} - -{ - my $match = "_D,5/4" ~~ m/ /; - isa_ok $match, Match, '"_D,5/4" is an element'; - is $match, "D", '"_D,5/4" has base note D'; - is $match, ",", '"_D,5/4" has octave ","'; - is $match, "_", '"_D,5/4" is flat'; - is $match, "5/4", '"_D,5/4" has note length 5/4'; -} - -{ - my $match = "A>^C'" ~~ m/ /; - isa_ok $match, Match, '"A>^C" is a broken rhythm'; - is $match[0], "A", 'first note is A'; - is $match[0], "", 'first note has no octave'; - is $match[0], "", 'first note has no accidental'; - is $match[0], "", 'first note has no length'; - is $match, ">", 'angle is >'; - is $match[1], "C", 'second note is C'; - is $match[1], "'", 'second note has octave tick'; - is $match[1], "^", 'second note is sharp'; - is $match[1], "", 'second note has no length'; -} - -{ - my $match = "d'+p+<<<+accent+_B" ~~ m/ /; - isa_ok $match, Match, '"d+p+<<<+accent+_B" is a broken rhythm'; - given $match - { - is .[0], "d", 'first note is d'; - is .[0], "'", 'first note has an octave tick'; - is .[0], "", 'first note has no accidental'; - is .[0], "", 'first note has no length'; - is .[0], "+p+", 'first gracing is +p+'; - is ., "<<<", 'angle is <<<'; - is .[0], "+accent+", 'second gracing is +accent+'; - is .[1], "B", 'second note is B'; - is .[1], "", 'second note has no octave'; - is .[1], "_", 'second note is flat'; - is .[1], "", 'second note has no length'; - } -} - -for ':|:', '|:', '|', ':|', '::' -{ - my $match = $_ ~~ m/ /; - isa_ok $match, Match, "barline $_ recognized"; - is $match, $_, "barline $_ is correct"; -} - -{ - my $match = "g>ecgece/f/g/e/|" ~~ m/ /; - isa_ok $match, Match, 'bar recognized'; - is $match, "g>ecgece/f/g/e/|", "Entire bar was matched"; - is $match.map(~*), "g>e c g e c e/ f/ g/ e/", "Each element was matched"; - is $match, "|", "Barline was matched"; -} - -{ - my $match = "g>ecg ec e/f/g/e/ |" ~~ m/ /; - isa_ok $match, Match, 'bar recognized'; - is $match, "g>ecg ec e/f/g/e/ |", "Entire bar was matched"; - is $match.map(~*), "g>e c g e c e/ f/ g/ e/ ", "Each element was matched"; - is $match, "|", "Barline was matched"; -} - -{ - my $line = "g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ |"; - my $match = $line ~~ m/ /; - isa_ok $match, Match, 'line of music recognized'; - is $match, $line, "Entire line was matched"; - is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; - is $match[1], " d/c/B/A/ Gd BG B/c/d/B/ |", "Second bar is correct"; - # say $match.perl; -} - -{ - my $line = "|A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 ::"; - my $match = $line ~~ m/ /; - isa_ok $match, Match, 'line of music recognized'; - is $match, $line, "Entire line was matched"; - is $match[0], "A/B/c/A/ c>d e>deg |", "First bar is correct"; - is $match[1], " dB/A/ gB +trill+A2 +trill+e2 ::", "Second bar is correct"; - is $match, "|", "Initial barline matched"; - # say $match.perl; -} - -{ - my $line = 'g>ecg ec e/f/g/e/ |[2-3 d/c/B/A/ {Gd} BG B/c/d/B/ |'; - my $match = $line ~~ m/ /; - isa_ok $match, Match, 'line of music recognized'; - is $match, $line, "Entire line was matched"; - is $match[0], "g>ecg ec e/f/g/e/ |", "First bar is correct"; - is $match[1], '[2-3 d/c/B/A/ {Gd} BG B/c/d/B/ |', "Second bar is correct"; - # say $match.perl; -} - -{ - my $music = q«A/B/c/A/ +trill+c>d e>deg | GG +trill+B>c d/B/A/G/ B/c/d/B/ | - A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 :: - g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ | - g/f/e/d/ c/d/e/f/ gc e/f/g/e/ | dB/A/ gB +trill+A2 +trill+e2 :|»; - my $match = $music ~~ m/ /; - isa_ok $match, Match, 'music recognized'; - is $match.elems, 4, "Four lines matched"; -} - -{ - my $music = q«X:64 -T:Cuckold Come Out o' the Amrey -S:Northumbrian Minstrelsy -M:4/4 -L:1/8 -K:D -»; - my $match = $music ~~ m/ /; - isa_ok $match, Match, 'header recognized'; - is $match.elems, 6, "Six fields matched"; - is $match.map(*.), "X T S M L K", "Got the right field names"; -} - -{ - my $music = q«X:64 -T:Cuckold Come Out o' the Amrey -S:Northumbrian Minstrelsy -M:4/4 -L:1/8 -K:D -A/B/c/A/ +trill+c>d e>deg | GG +trill+B>c d/B/A/G/ B/c/d/B/ | -A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 :: -g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ | -g/f/e/d/ c/d/e/f/ gc e/f/g/e/ | dB/A/ gB +trill+A2 +trill+e2 :| -»; - my $match = $music ~~ m/ /; - isa_ok $match, Match, 'tune recognized'; - given $match
- { - is ..elems, 6, "Six fields matched"; - is ..map(*.), "X T S M L K", "Got the right field names"; - } - is $match.elems, 4, "Four lines matched"; - say $match; -} - -done_testing; \ No newline at end of file diff --git a/t/02-key.rakutest b/t/02-key.rakutest new file mode 100644 index 0000000..d23d5d6 --- /dev/null +++ b/t/02-key.rakutest @@ -0,0 +1,94 @@ +use v6; +use Test; +use ABC::Grammar; +use ABC::Utils; +use ABC::KeyInfo; + +{ + my $key = ABC::KeyInfo.new("D"); + is $key.key.elems, 2, "D has two sharps"; + is $key.key, "^", "F is sharp"; + is $key.key, "^", "C is sharp"; + ok !$key.clef.defined || $key.clef eq "treble" , "no clef defined"; + is $key.octave-shift, 0, "octave-shift is 0"; +} + +{ + my $key = ABC::KeyInfo.new("D bass"); + is $key.key.elems, 2, "D has two sharps"; + is $key.key, "^", "F is sharp"; + is $key.key, "^", "C is sharp"; + is $key.clef, "bass", "Recognized bass clef"; +} + +{ + my $key = ABC::KeyInfo.new("Dmix"); + is $key.key.elems, 1, "Dmix has one sharp"; + is $key.key, "^", "F is sharp"; +} + +{ + my $key = ABC::KeyInfo.new("Am"); + is $key.key.elems, 0, "Am has no sharps or flats"; +} + +{ + my $key = ABC::KeyInfo.new("Ddor"); + is $key.key.elems, 0, "Ddor has no sharps or flats"; +} + +{ + my $key = ABC::KeyInfo.new("Ador"); + is $key.key.elems, 1, "Ador has one sharp"; + is $key.key, "^", "F is sharp"; +} + +{ + my $key = ABC::KeyInfo.new("Amix"); + is $key.key.elems, 2, "Amix has two sharps"; + is $key.key, "^", "F is sharp"; + is $key.key, "^", "C is sharp"; +} + +{ + my $key = ABC::KeyInfo.new("C#m"); + is $key.key.elems, 4, "C#m has four sharps"; + is $key.key, "^", "F is sharp"; + is $key.key, "^", "C is sharp"; + is $key.key, "^", "G is sharp"; + is $key.key, "^", "D is sharp"; +} + +{ + my $key = ABC::KeyInfo.new("C#"); + is $key.key.elems, 7, "C# has seven sharps"; + is $key.key, "^", "F is sharp"; + is $key.key, "^", "C is sharp"; + is $key.key, "^", "G is sharp"; + is $key.key, "^", "D is sharp"; + is $key.key, "^", "A is sharp"; + is $key.key, "^", "E is sharp"; + is $key.key, "^", "B is sharp"; +} + +{ + my $key = ABC::KeyInfo.new("C ^f _b"); + is $key.key.elems, 2, "C ^f _b has two thingees"; + is $key.key, "^", "F is sharp"; + is $key.key, "_", "B is flat"; +} + +{ + my $key = ABC::KeyInfo.new("C#m"); + is apply_key_signature($key.key, ABC::Grammar.parse("f", :rule)), "^f", "f => ^f"; + is apply_key_signature($key.key, ABC::Grammar.parse("C", :rule)), "^C", "C => ^C"; + is apply_key_signature($key.key, ABC::Grammar.parse("G", :rule)), "^G", "G => ^G"; + is apply_key_signature($key.key, ABC::Grammar.parse("d", :rule)), "^d", "d => ^d"; + is apply_key_signature($key.key, ABC::Grammar.parse("_f", :rule)), "_f", "_f => _f"; + is apply_key_signature($key.key, ABC::Grammar.parse("=C", :rule)), "=C", "=C => =C"; + is apply_key_signature($key.key, ABC::Grammar.parse("^G", :rule)), "^G", "^G => ^G"; + is apply_key_signature($key.key, ABC::Grammar.parse("^^d", :rule)), "^^d", "^^d => ^^d"; + is apply_key_signature($key.key, ABC::Grammar.parse("b'", :rule)), "b'", "b' => b'"; +} + +done-testing; diff --git a/t/02-key.t b/t/02-key.t deleted file mode 100644 index 7d0940d..0000000 --- a/t/02-key.t +++ /dev/null @@ -1,78 +0,0 @@ -use v6; -use Test; -use ABC; - -plan *; - -{ - my %key = key_signature("D"); - is %key.elems, 2, "D has two sharps"; - is %key, "^", "F is sharp"; - is %key, "^", "C is sharp"; -} - -{ - my %key = key_signature("Dmix"); - is %key.elems, 1, "Dmix has one sharp"; - is %key, "^", "F is sharp"; -} - -{ - my %key = key_signature("Am"); - is %key.elems, 0, "Am has no sharps or flats"; -} - -{ - my %key = key_signature("Ddor"); - is %key.elems, 0, "Ddor has no sharps or flats"; -} - -{ - my %key = key_signature("Ador"); - is %key.elems, 1, "Ador has one sharp"; - is %key, "^", "F is sharp"; -} - -{ - my %key = key_signature("Amix"); - is %key.elems, 2, "Amix has two sharps"; - is %key, "^", "F is sharp"; - is %key, "^", "C is sharp"; -} - -{ - my %key = key_signature("C#m"); - is %key.elems, 4, "C#m has four sharps"; - is %key, "^", "F is sharp"; - is %key, "^", "C is sharp"; - is %key, "^", "G is sharp"; - is %key, "^", "D is sharp"; -} - -{ - my %key = key_signature("C#"); - is %key.elems, 7, "C# has seven sharps"; - is %key, "^", "F is sharp"; - is %key, "^", "C is sharp"; - is %key, "^", "G is sharp"; - is %key, "^", "D is sharp"; - is %key, "^", "A is sharp"; - is %key, "^", "E is sharp"; - is %key, "^", "B is sharp"; -} - -{ - my %key = key_signature("C#m"); - is apply_key_signature(%key, ("f" ~~ m/ /).), "^f", "f => ^f"; - is apply_key_signature(%key, ("C" ~~ m/ /).), "^C", "C => ^C"; - is apply_key_signature(%key, ("G" ~~ m/ /).), "^G", "G => ^G"; - is apply_key_signature(%key, ("d" ~~ m/ /).), "^d", "d => ^d"; - is apply_key_signature(%key, ("_f" ~~ m/ /).), "_f", "_f => _f"; - is apply_key_signature(%key, ("=C" ~~ m/ /).), "=C", "=C => =C"; - is apply_key_signature(%key, ("^G" ~~ m/ /).), "^G", "^G => ^G"; - is apply_key_signature(%key, ("^^d" ~~ m/ /).), "^^d", "^^d => ^^d"; - is apply_key_signature(%key, ("b'" ~~ m/ /).), "b'", "b' => b'"; -} - - -done_testing; \ No newline at end of file diff --git a/t/03-file.rakutest b/t/03-file.rakutest new file mode 100644 index 0000000..aee332c --- /dev/null +++ b/t/03-file.rakutest @@ -0,0 +1,18 @@ +use v6; +use Test; +use ABC::Grammar; + +{ + my $match = ABC::Grammar.parse(slurp("samples.abc"), :rule); + ok $match, 'samples.abc is a valid tune file'; + is @( $match ).elems, 3, "Three tunes were found"; + + my @titles = @( $match ).flatmap({ @( .
).grep({ . eq "T" })[0] }).flatmap({ . }); + + is +@titles, 3, "Three titles were found"; + is @titles[0], "Cuckold Come Out o' the Amrey", "First is Cuckold"; + is @titles[1], "Elsie Marley", "Second is Elsie Marley"; + is @titles[2], "Peacock Followed the Hen. JWDM.07", "Third is Peacock"; +} + +done-testing; diff --git a/t/04-header.rakutest b/t/04-header.rakutest new file mode 100644 index 0000000..d0bbb0b --- /dev/null +++ b/t/04-header.rakutest @@ -0,0 +1,128 @@ +use v6; +use Test; +use ABC::Header; + +isa-ok ABC::Header.new, ABC::Header, "Can create ABC::Header object"; + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + is $a.lines.elems, 1, "One line now present in ABC::Header"; + + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + is $a.lines.elems, 3, "Three lines now present in ABC::Header"; + + is $a.get("T").elems, 2, "Two T lines found"; + is $a.get("T")[0].value, "The Star of Rakudo", "First title correct"; + is $a.get("T")[1].value, "Michaud's Favorite", "Second title correct"; + + nok $a.is-valid, "Not valid because its missing a bunch of needed fields"; + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + nok $a.is-valid, "Not valid because its still missing the key signature"; + $a.add-line("K", "G"); + ok $a.is-valid, "Now valid!"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("K", "G"); + $a.add-line("L", "1/8"); + nok $a.is-valid, "Not valid, all fields present but K is not the last"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too many Ms"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("L", "1/8"); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too few Ms"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too few Ls"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + $a.add-line("L", "1/8"); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too many Ls"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + $a.add-line("X", 1); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too many Xs"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + $a.add-line("X", 1); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, X not first"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("T", "The Star of Rakudo"); + $a.add-line("T", "Michaud's Favorite"); + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + $a.add-line("K", "G"); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too many Ks"; +} + +{ + my $a = ABC::Header.new; + $a.add-line("X", 1); + $a.add-line("M", "2/2"); + $a.add-line("L", "1/8"); + $a.add-line("X", 1); + $a.add-line("K", "G"); + nok $a.is-valid, "Not valid, too few Ts"; +} + +done-testing; diff --git a/t/05-actions.rakutest b/t/05-actions.rakutest new file mode 100644 index 0000000..6d78c65 --- /dev/null +++ b/t/05-actions.rakutest @@ -0,0 +1,336 @@ +use v6; +use Test; +use ABC::Header; +use ABC::Tune; +use ABC::Grammar; +use ABC::Actions; +use ABC::Note; +use ABC::Stem; +use ABC::Rest; +use ABC::Tuplet; +use ABC::BrokenRhythm; +use ABC::Chord; + +{ + my $match = ABC::Grammar.parse('F#', :rule, :actions(ABC::Actions.new)); + ok $match, 'chord recognized'; + isa-ok $match.ast, ABC::Chord, '$match.ast is an ABC::Chord'; + is $match.ast.main-note, "F", "Pitch F"; + is $match.ast.main-accidental, "#", "...sharp"; +} + +{ + my $match = ABC::Grammar.parse('Bbmin/G#', :rule, :actions(ABC::Actions.new)); + ok $match, 'chord recognized'; + isa-ok $match.ast, ABC::Chord, '$match.ast is an ABC::Chord'; + is $match.ast.main-note, "B", "Pitch B"; + is $match.ast.main-accidental, "b", "...flat"; + is $match.ast.main-type, "min", "...min"; + is $match.ast.bass-note, "G", "over G"; + is $match.ast.bass-accidental, "#", "...#"; +} + +{ + my $match = ABC::Grammar.parse('"F#"', :rule, :actions(ABC::Actions.new)); + ok $match, 'chord_or_text recognized'; + isa-ok $match.ast[0], ABC::Chord, '$match.ast[0] is an ABC::Chord'; + is $match.ast[0].main-note, "F", "Pitch F"; + is $match.ast[0].main-accidental, "#", "...sharp"; +} + +{ + my $match = ABC::Grammar.parse('{gf}', :rule, :actions(ABC::Actions.new)); + ok $match, 'grace_notes recognized'; + isa-ok $match.ast, ABC::GraceNotes, '$match.ast is an ABC::GraceNotes'; + nok $match.ast.acciaccatura, "It's not an acciaccatura"; + is $match.ast.notes[0].pitch, "g", "Pitch g found"; + is $match.ast.notes[1].pitch, "f", "Pitch g found"; +} + +{ + my $match = ABC::Grammar.parse('"F#"', :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, Pair, '$match.ast is a Pair'; + is $match.ast.key, "chord_or_text", '$match.ast.key is "chord_or_text"'; + is $match.ast.value[0].main-note, "F", "Pitch F"; + is $match.ast.value[0].main-accidental, "#", "...sharp"; +} + +{ + my $match = ABC::Grammar.parse('"^Bb whistle"', :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, Pair, '$match.ast is a Pair'; + is $match.ast.key, "chord_or_text", '$match.ast.key is "chord_or_text"'; + isa-ok $match.ast.value[0], Str, "And it's text"; + is $match.ast.value[0], "^Bb whistle", '$match.ast.value[0] is ^Bb whistle'; +} + +{ + my $match = ABC::Grammar.parse("e3", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Note, '$match.ast is an ABC::Note'; + is $match.ast.pitch, "e", "Pitch e"; + is $match.ast.ticks, 3, "Duration 3 ticks"; +} + +{ + my $match = ABC::Grammar.parse("e", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Note, '$match.ast is an ABC::Note'; + is $match.ast.pitch, "e", "Pitch e"; + is $match.ast.ticks, 1, "Duration 1 ticks"; +} + +{ + my $match = ABC::Grammar.parse("^e,/", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Note, '$match.ast is an ABC::Note'; + is $match.ast.pitch, "^e,", "Pitch ^e,"; + is $match.ast.ticks, 1/2, "Duration 1/2 ticks"; +} + +{ + my $match = ABC::Grammar.parse("[a2bc]3", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Stem, '$match.ast is an ABC::Stem'; + is $match.ast.notes[0], "a2", "Pitch 1 a"; + is $match.ast.notes[1], "b", "Pitch 2 b"; + is $match.ast.notes[2], "c", "Pitch 3 c"; + is $match.ast.ticks, 6, "Duration 6 ticks"; + nok $match.ast.is-tie, "Not tied"; +} + +{ + my $match = ABC::Grammar.parse("[a2bc]/-", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Stem, '$match.ast is an ABC::Stem'; + is $match.ast.notes[0], "a2", "Pitch 1 a"; + is $match.ast.notes[1], "b", "Pitch 2 b"; + is $match.ast.notes[2], "c", "Pitch 3 c"; + is $match.ast.ticks, 1, "Duration 1 tick"; + ok $match.ast.is-tie, "Tied"; +} + +{ + my $match = ABC::Grammar.parse("z/", :rule, :actions(ABC::Actions.new)); + ok $match, 'rest recognized'; + isa-ok $match.ast, ABC::Rest, '$match.ast is an ABC::Rest'; + is $match.ast.type, "z", "Rest is z"; + is $match.ast.ticks, 1/2, "Duration 1/2 ticks"; +} + +{ + my $match = ABC::Grammar.parse("F3/2", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Note, '$match.ast is an ABC::Note'; + is $match.ast.pitch, "F", "Pitch F"; + is $match.ast.ticks, 3/2, "Duration 3/2 ticks"; +} + +{ + my $match = ABC::Grammar.parse("F2/3", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, ABC::Note, '$match.ast is an ABC::Note'; + is $match.ast.pitch, "F", "Pitch F"; + is $match.ast.ticks, 2/3, "Duration 2/3 ticks"; +} + +{ + my $match = ABC::Grammar.parse("(3abc", :rule, :actions(ABC::Actions.new)); + ok $match, 'tuplet recognized'; + isa-ok $match.ast, ABC::Tuplet, '$match.ast is an ABC::Tuplet'; + is $match.ast.tuple, "3", "It's a triplet"; + is $match.ast.ticks, 2, "Duration 2 ticks"; + is +$match.ast.notes, 3, "Three internal note"; + ok $match.ast.notes[0] ~~ ABC::Stem | ABC::Note, "First internal note is of the correct type"; + is $match.ast.notes, "a b c", "Notes are correct"; +} + +{ + my $match = ABC::Grammar.parse("a>~b", :rule, :actions(ABC::Actions.new)); + ok $match, 'broken rhythm recognized'; + isa-ok $match.ast, ABC::BrokenRhythm, '$match.ast is an ABC::BrokenRhythm'; + is $match.ast.ticks, 2, "total duration is two ticks"; + isa-ok $match.ast.effective-stem1, ABC::Note, "effective-stem1 is a note"; + is $match.ast.effective-stem1.pitch, "a", "first pitch is a"; + is $match.ast.effective-stem1.ticks, 1.5, "first duration is 1 + 1/2"; + isa-ok $match.ast.effective-stem2, ABC::Note, "effective-stem2 is a note"; + is $match.ast.effective-stem2.pitch, "b", "first pitch is a"; + is $match.ast.effective-stem2.ticks, .5, "second duration is 1/2"; +} + +{ + my $match = ABC::Grammar.parse("a<<, :actions(ABC::Actions.new)); + ok $match, 'broken rhythm recognized'; + isa-ok $match.ast, ABC::BrokenRhythm, '$match.ast is an ABC::BrokenRhythm'; + is $match.ast.ticks, 2, "total duration is two ticks"; + isa-ok $match.ast.effective-stem1, ABC::Note, "effective-stem1 is a note"; + is $match.ast.effective-stem1.pitch, "a", "first pitch is a"; + is $match.ast.effective-stem1.ticks, 1/8, "first duration is 1/8"; + isa-ok $match.ast.effective-stem2, ABC::Note, "effective-stem2 is a note"; + is $match.ast.effective-stem2.pitch, "b", "first pitch is a"; + is $match.ast.effective-stem2.ticks, 15/8, "second duration is 1 + 7/8"; +} + +{ + my $match = ABC::Grammar.parse("[K:F]", :rule, :actions(ABC::Actions.new)); + ok $match, 'inline field recognized'; + # isa-ok $match.ast, ABC::BrokenRhythm, '$match.ast is an ABC::BrokenRhythm'; + is $match, "K", "field type is K"; + is $match, "F", "field value is K"; +} + +{ + my $match = ABC::Grammar.parse("+fff+", :rule, :actions(ABC::Actions.new)); + ok $match, 'long gracing recognized'; + isa-ok $match.ast, Str, '$match.ast is a Str'; + is $match.ast, "fff", "gracing is fff"; +} + +{ + my $match = ABC::Grammar.parse("+fff+", :rule, :actions(ABC::Actions.new)); + ok $match, 'long gracing recognized'; + isa-ok $match.ast, Str, '$match.ast is a Str'; + is $match.ast, "fff", "gracing is fff"; +} + +{ + my $match = ABC::Grammar.parse("~", :rule, :actions(ABC::Actions.new)); + ok $match, 'gracing recognized'; + isa-ok $match.ast, Str, '$match.ast is a Str'; + is $match.ast, "~", "gracing is ~"; +} + +{ + my $match = ABC::Grammar.parse("+fff+", :rule, :actions(ABC::Actions.new)); + ok $match, 'long gracing recognized'; + is $match.ast.key, "gracing", '$match.ast.key is gracing'; + isa-ok $match.ast.value, Str, '$match.ast.value is a Str'; + is $match.ast.value, "fff", "gracing is fff"; +} + +{ + my $music = q«X:64 +T:Cuckold Come Out o' the Amrey +S:Northumbrian Minstrelsy +M:4/4 +L:1/8 +K:D +»; + my $match = ABC::Grammar.parse($music, :rule
, :actions(ABC::Actions.new)); + ok $match, 'tune recognized'; + isa-ok $match.ast, ABC::Header, '$match.ast is an ABC::Header'; + is $match.ast.get("T").elems, 1, "One T field found"; + is $match.ast.get("T")[0].value, "Cuckold Come Out o' the Amrey", "And it's correct"; + ok $match.ast.is-valid, "ABC::Header is valid"; +} + +{ + my $match = ABC::Grammar.parse("e3", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + isa-ok $match.ast, Pair, '$match.ast is a Pair'; + is $match.ast.key, "stem", "Stem found"; + isa-ok $match.ast.value, ABC::Note, "Value is note"; +} + +{ + my $match = ABC::Grammar.parse("G2g gdc|", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + is $match.ast.elems, 7, '$match.ast has seven elements'; + is $match.ast[3].key, "stem", "Fourth is stem"; + is $match.ast[*-1].key, "barline", "Last is barline"; +} + +{ + my $match = ABC::Grammar.parse("G2g gdc", :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; + is $match.ast.elems, 6, '$match.ast has six elements'; + is $match.ast[3].key, "stem", "Fourth is stem"; + is $match.ast[*-1].key, "stem", "Last is stem"; +} + +{ + my $music = q«BAB G2G|G2g gdc|1BAB G2G|2=F2f fcA| +BAB G2G|G2g gdB|c2a B2g|A2=f fcA:| +»; + + my $match = ABC::Grammar.parse($music, :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; +# say $match.ast.perl; + is $match.ast.elems, 59, '$match.ast has 59 elements'; + # say $match.ast.elems; + # say $match.ast[28].WHAT; + # say $match.ast[28].perl; + is $match.ast[22].key, "nth_repeat", "21st is nth_repeat"; + isa-ok $match.ast[22].value, Set, "21st value is a Set"; + ok $match.ast[22].value ~~ (set 2), "21st is '2'"; + is $match.ast[30].key, "endline", "29th is endline"; + is $match.ast[*-1].key, "endline", "Last is endline"; +} + +{ + my $music = q«BAB G2G|G2g gdc|BAB G2G|=F2f fcA| +BAB G2G|G2g gdB|c2a B2g|A2=f fcA:| +»; + + my $match = ABC::Grammar.parse($music, :rule, :actions(ABC::Actions.new)); + ok $match, 'element recognized'; +# say $match.ast.perl; + is $match.ast.elems, 57, '$match.ast has 57 elements'; + # say $match.ast.elems; + # say $match.ast[28].WHAT; + # say $match.ast[28].perl; + is $match.ast[28].key, "endline", "29th is endline"; + is $match.ast[*-1].key, "endline", "Last is endline"; +} + +{ + my $music = q:to; + X:044 + T:Elsie Marley + B:Robin Williamson, "Fiddle Tunes" (New York 1976) + N:"printed by Robert Petrie in 1796 and is + N:"described by him as a 'bumpkin'." + Z:Nigel Gatherer + M:6/8 + L:1/8 + K:G + BAB G2G|G2g gdc|BAB G2G|=F2f fcA| + BAB G2G|G2g gdB|c2a B2g|A2=f fcA:| + ABC-end + + my $match = ABC::Grammar.parse($music, :rule, :actions(ABC::Actions.new)); + ok $match, 'tune recognized'; + isa-ok $match.ast, ABC::Tune, 'and ABC::Tune created'; + ok $match.ast.header.is-valid, "ABC::Tune's header is valid"; + is $match.ast.music.elems, 57, '$match.ast.music has 57 elements'; +} + +{ + my $match = ABC::Grammar.parse(slurp("samples.abc"), :rule, :actions(ABC::Actions.new)); + ok $match, 'samples.abc is a valid tune file'; + # say $match.ast.perl; + is @( $match ).elems, 3, "Three tunes were found"; + # is @( $match.ast )[0].elems, 3, "Three tunes were found"; + isa-ok @( $match.ast )[0][0], ABC::Tune, "First is an ABC::Tune"; +} + +{ + my $music = q«X:1 +T:Canon in D +C:Pachelbel +M:2/2 +L:1/8 +K:D +"D" DFAd "A" CEAc|"Bm" B,DFB "F#m" A,CFA|"G" B,DGB "D" A,DFA|"G" B,DGB "A" CEAc| +"D" f4 "A" e4|"Bm" d4 "F#m" c4|"G" B4 "D" A4|"G" B4 "A" c4|»; + my $match = ABC::Grammar.parse($music, :rule, :actions(ABC::Actions.new)); + isa-ok $match, Match, 'Got a match'; + ok $match, 'tune_file recognized'; + + is $match.elems, 1, 'found one tune'; + is $match[0].elems, 2, "with two lines of music"; +} + + +done-testing; diff --git a/t/06-duration.rakutest b/t/06-duration.rakutest new file mode 100644 index 0000000..0497910 --- /dev/null +++ b/t/06-duration.rakutest @@ -0,0 +1,16 @@ +use v6; +use Test; +use ABC::Duration; + +is duration-from-parse("2", "3").ticks.perl, (2/3).perl, "2/3 works properly"; +ok duration-from-parse("2", "3") ~~ ABC::Duration, "2/3 generates an object which does Duration"; +is duration-from-parse(Any, Any).ticks.perl, (1/2).perl, "/ works properly"; +ok duration-from-parse(Any, Any) ~~ ABC::Duration, "/ generates an object which does Duration"; + +is duration-from-parse("1", Any).ticks.perl, (1/2).perl, "1/ works properly"; +is duration-from-parse(Any, "2").ticks.perl, (1/2).perl, "/2 works properly"; + +is duration-from-parse("1").ticks.perl, (1).perl, "1 works properly"; +is duration-from-parse(Any).ticks.perl, (1).perl, "'' works properly"; + +done-testing; diff --git a/t/07-stringify.rakutest b/t/07-stringify.rakutest new file mode 100644 index 0000000..259b5a8 --- /dev/null +++ b/t/07-stringify.rakutest @@ -0,0 +1,53 @@ +use v6; +use Test; + +use ABC::Grammar; +use ABC::Header; +use ABC::Tune; +use ABC::Duration; +use ABC::Note; +use ABC::Rest; +use ABC::Tuplet; +use ABC::BrokenRhythm; +use ABC::Chord; +use ABC::LongRest; +use ABC::GraceNotes; +use ABC::Actions; +use ABC::Utils; + +my @simple-cases = ("a", "B,", "c'''", "^D2-", "_E,,/", "^^f/4", "=G3", + "z3", "y/3", "x", "Z10", + "[ceg]", "[D3/2d3/2]", "[A,2F2]", + "(3abc", "(5A/B/C/D/E/", + "a>b", "^c/4 $test-case { + my $match = ABC::Grammar.parse($test-case, :rule, :actions(ABC::Actions.new)); + ok $match, "$test-case parsed"; + my $object = $match.ast.value; + # say $object.perl; + is ~$object, $test-case, "Stringified version matches"; +} + +for |@simple-cases, |@tricky-cases -> $test-case { + my $match = ABC::Grammar.parse($test-case, :rule, :actions(ABC::Actions.new)); + ok $match, "$test-case parsed"; + is element-to-str($match.ast), $test-case, "element-to-str version matches"; +} + +# my @notes = .for({ str-to-stem($_) }); +# is ABC::Tuplet.new(3, 2, @notes[^2]), "(3::2ab2", "triplet with only two notes"; +# is ABC::Tuplet.new(3, 2, @notes[^4]), "(3::4ab2c/d", "triplet with four notes"; +# is ABC::Tuplet.new(3, 3, @notes[^4]), "(3:3:4ab2c/d", "triplet with four notes and a weird rhythm"; + +done-testing; \ No newline at end of file diff --git a/t/08-transpose.rakutest b/t/08-transpose.rakutest new file mode 100644 index 0000000..4022802 --- /dev/null +++ b/t/08-transpose.rakutest @@ -0,0 +1,171 @@ +use v6; +use Test; + +use ABC::Grammar; +use ABC::Header; +use ABC::Tune; +use ABC::Duration; +use ABC::Note; +use ABC::Rest; +use ABC::Tuplet; +use ABC::BrokenRhythm; +use ABC::Chord; +use ABC::LongRest; +use ABC::GraceNotes; +use ABC::Actions; +use ABC::Utils; +use ABC::Pitched; +use ABC::KeyInfo; + +sub transpose(Str $test, $pitch-changer) { + my $match = ABC::Grammar.parse($test, :rule, :actions(ABC::Actions.new)); + if $match { + given $match.ast.value { + when Positional { $_>>.transpose($pitch-changer); } + when ABC::Pitched { $_.transpose($pitch-changer); } + die "Don't know how to transpose { $_.WHAT }"; + } + } +} + +sub up-octave($accidental, $basenote, $octave) { + if $octave ~~ /","/ { + return ($accidental, $basenote, $/.postmatch); + } elsif $octave ~~ /"'"/ || $basenote ~~ // { + return ($accidental, $basenote, $octave ~ "'"); + } else { + return ($accidental, $basenote.lc, $octave); + } +} + +is transpose("A", &up-octave), "a", "Octave bump to A yields a"; +is transpose("a", &up-octave), "a'", "Octave bump to a yields a'"; +is transpose("a''2", &up-octave), "a'''2", "Octave bump to a'' yields a'''"; +is transpose("A,-", &up-octave), "A-", "Octave bump to A, yields A"; +is transpose("A,,", &up-octave), "A,", "Octave bump to A,, yields A,"; +is transpose("[C,Eg]", &up-octave), "[Ceg']", "Octave bump to [C,Eg] yields [Ceg']"; +is transpose("[C,Eg]", &up-octave), "[Ceg']", "Octave bump to [C,Eg] yields [Ceg']"; +is transpose("(3C,Eg", &up-octave), "(3Ceg'", "Octave bump to (3C,Eg yields (3Ceg'"; +is transpose("A, :actions(ABC::Actions.new)); + if $match { + pitch-to-ordinal(%key, $match.ast.accidental, $match.ast.basenote, $match.ast.octave); + } +} + +{ + my %key = ABC::KeyInfo.new("C").key; + is pitch2ordinal(%key, "C"), 0, "C ==> 0"; + is pitch2ordinal(%key, "D"), 2, "D ==> 2"; + is pitch2ordinal(%key, "E"), 4, "E ==> 4"; + is pitch2ordinal(%key, "F"), 5, "F ==> 5"; + is pitch2ordinal(%key, "G"), 7, "G ==> 7"; + is pitch2ordinal(%key, "A"), 9, "A ==> 9"; + is pitch2ordinal(%key, "B"), 11, "B ==> 11"; + is pitch2ordinal(%key, "c"), 12, "c ==> 12"; + is pitch2ordinal(%key, "=A"), 9, "=A ==> 9"; + is pitch2ordinal(%key, "^A"), 10, "^A ==> 10"; + is pitch2ordinal(%key, "_A"), 8, "_A ==> 8"; + is pitch2ordinal(%key, "^^A"), 11, "^^A ==> 11"; + is pitch2ordinal(%key, "__A"), 7, "__A ==> 7"; + is pitch2ordinal(%key, "^^G,,,"), -27, "^^G,,, ==> -27"; + is pitch2ordinal(%key, "d'''"), 50, "d''' ==> 50"; + + %key = ABC::KeyInfo.new("Ab").key; + is pitch2ordinal(%key, "C"), 0, "C ==> 0"; + is pitch2ordinal(%key, "D"), 1, "D ==> 1"; + is pitch2ordinal(%key, "E"), 3, "E ==> 3"; + is pitch2ordinal(%key, "F"), 5, "F ==> 5"; + is pitch2ordinal(%key, "G"), 7, "G ==> 7"; + is pitch2ordinal(%key, "A"), 8, "A ==> 8"; + is pitch2ordinal(%key, "B"), 10, "B ==> 10"; + is pitch2ordinal(%key, "c"), 12, "c ==> 12"; + is pitch2ordinal(%key, "=A"), 9, "=A ==> 9"; + is pitch2ordinal(%key, "^A"), 10, "^A ==> 10"; + is pitch2ordinal(%key, "_A"), 8, "_A ==> 8"; + is pitch2ordinal(%key, "^^A"), 11, "^^A ==> 11"; + is pitch2ordinal(%key, "__A"), 7, "__A ==> 7"; + is pitch2ordinal(%key, "^^G,,,"), -27, "^^G,,, ==> -27"; + is pitch2ordinal(%key, "d'''"), 49, "d''' ==> 49"; + + %key = ABC::KeyInfo.new("C").key; + is ordinal-to-pitch(%key, "C", 0), " C ", "0/C => C"; + is ordinal-to-pitch(%key, "D", 0), "__ D ", "0/D => __D"; + is ordinal-to-pitch(%key, "B", 0), "^ B ,", "0/B => ^B,"; + is ordinal-to-pitch(%key, "C", 1), "^ C ", "1/C => ^C"; + is ordinal-to-pitch(%key, "D", 1), "_ D ", "1/D => _D"; + is ordinal-to-pitch(%key, "B", 1), "^^ B ,", "1/B => ^^B,"; + is ordinal-to-pitch(%key, "C", -1), "_ C ", "-1/C => _C"; + is ordinal-to-pitch(%key, "B", -1), " B ,", "-1/B => B,"; + is ordinal-to-pitch(%key, "C", -12), " C ,", "-12/C => C,"; + is ordinal-to-pitch(%key, "D", -12), "__ D ,", "-12/D => __D,"; + is ordinal-to-pitch(%key, "B", -12), "^ B ,,", "-12/B => ^B,,"; + is ordinal-to-pitch(%key, "C", 11), "_ c ", "11/C => _c"; + is ordinal-to-pitch(%key, "B", 11), " B ", "11/B => B"; + is ordinal-to-pitch(%key, "C", 12), " c ", "12/C => c"; + is ordinal-to-pitch(%key, "D", 12), "__ d ", "12/D => __d"; + is ordinal-to-pitch(%key, "B", 12), "^ B ", "12/B => ^B"; + is ordinal-to-pitch(%key, "C", 13), "^ c ", "1/C => ^c"; + is ordinal-to-pitch(%key, "D", 13), "_ d ", "1/D => _d"; + is ordinal-to-pitch(%key, "B", 13), "^^ B ", "1/B => ^^B"; + is ordinal-to-pitch(%key, "C", 23), "_ c '", "23/C => _c'"; + is ordinal-to-pitch(%key, "B", 23), " b ", "23/B => b"; + is ordinal-to-pitch(%key, "C", 24), " c '", "24/C => c'"; + is ordinal-to-pitch(%key, "D", 24), "__ d '", "24/D => __d'"; + is ordinal-to-pitch(%key, "B", 24), "^ b ", "24/B => ^b"; + is ordinal-to-pitch(%key, "C", 25), "^ c '", "25/C => ^c'"; + is ordinal-to-pitch(%key, "D", 25), "_ d '", "25/D => _d'"; + is ordinal-to-pitch(%key, "B", 25), "^^ b ", "25/B => ^^b"; +} + +sub e-flat-to-d($accidental, $basenote, $octave) { + my %e-flat = ABC::KeyInfo.new("Eb").key; + my %d = ABC::KeyInfo.new("D").key; + my $ordinal = pitch-to-ordinal(%e-flat, $accidental, $basenote, $octave); + my $basenote-in-d = $basenote.uc eq "A" ?? "G" !! ($basenote.ord - 1).chr.uc; + ordinal-to-pitch(%d, $basenote-in-d, $ordinal - 1); +} + +is transpose("A", &e-flat-to-d), "G", "Eb to D on A yields G"; +is transpose("a", &e-flat-to-d), "g", "Eb to D on a yields g"; +is transpose("a''2", &e-flat-to-d), "g''2", "Eb to D on a'' yields g''"; +is transpose("A,-", &e-flat-to-d), "G,-", "Eb to D on A,- yields G,-"; +is transpose("[_EG_B]", &e-flat-to-d), "[DFA]", "Eb to D on [_EG_B] yields [DFA]"; +is transpose("[EGB]", &e-flat-to-d), "[DFA]", "Eb to D on [EGB] yields [DFA]"; +is transpose("(3C,Eg", &e-flat-to-d), "(3B,,Df", "Eb to D on (3C,Eg yields (3B,,Df"; +is transpose("=A($accidental, $basenote, $octave) { + my $ordinal = pitch-to-ordinal(%.current-from, $accidental, $basenote, $octave); + my $basenote-in-new-key = "A".ord + ($basenote.uc.ord - "A".ord + $.pitch-name-shift) % 7; + ordinal-to-pitch(%.current-to, $basenote-in-new-key, $ordinal + $.half-step-shift); + } +} + + +done-testing; diff --git a/t/09-context.rakutest b/t/09-context.rakutest new file mode 100644 index 0000000..6beac14 --- /dev/null +++ b/t/09-context.rakutest @@ -0,0 +1,63 @@ +use v6; +use Test; +use ABC::Context; +use ABC::Grammar; +use ABC::Actions; + +{ + my $context = ABC::Context.new("C", "4/4", "1/8"); + + my $match = ABC::Grammar.parse("abcdefgab^c_dcd", :rule, :actions(ABC::Actions.new)); + isa-ok $match, Match, 'Got a match'; + ok $match, 'bar recognized'; + + # first run loads up C# and Db + for (@($match.ast) Z ("" xx 9, "^", "_", "^", "_").flat).flat -> $note, $desired-accidental { + my $accidental = $context.working-accidental($note.value); + is $accidental, $desired-accidental; + } + + # second run still has them + for (@($match.ast) Z ("", "", "^", "_", "", "", "", "", "", "^", "_", "^", "_")).flat -> $note, $desired-accidental { + my $accidental = $context.working-accidental($note.value); + is $accidental, $desired-accidental; + } + + $context.bar-line; + + # and now we've reset to the initial state + for (@($match.ast) Z ("" xx 9, "^", "_", "^", "_").flat).flat -> $note, $desired-accidental { + my $accidental = $context.working-accidental($note.value); + is $accidental, $desired-accidental; + } +} + +{ + my $context = ABC::Context.new("C#", "4/4", "1/8"); + + my $match = ABC::Grammar.parse("abcdefgab^c_dcd", :rule, :actions(ABC::Actions.new)); + isa-ok $match, Match, 'Got a match'; + ok $match, 'bar recognized'; + + # first run loads up C# and Db + for (@($match.ast) Z ("^" xx 9, "^", "_", "^", "_").flat).flat -> $note, $desired-accidental { + my $accidental = $context.working-accidental($note.value); + is $accidental, $desired-accidental; + } + + # second run still has them + for (@($match.ast) Z ("^", "^", "^", "_", "^", "^", "^", "^", "^", "^", "_", "^", "_")).flat -> $note, $desired-accidental { + my $accidental = $context.working-accidental($note.value); + is $accidental, $desired-accidental; + } + + $context.bar-line; + + # and now we've reset to the initial state + for (@($match.ast) Z ("^" xx 9, "^", "_", "^", "_").flat).flat -> $note, $desired-accidental { + my $accidental = $context.working-accidental($note.value); + is $accidental, $desired-accidental; + } +} + +done-testing; diff --git a/t/10-utils.rakutest b/t/10-utils.rakutest new file mode 100644 index 0000000..bd7d22f --- /dev/null +++ b/t/10-utils.rakutest @@ -0,0 +1,36 @@ +use v6; +use Test; +use ABC::Utils; + +is default-length-from-meter("4/4"), "1/8", "4/4 defaults to eighth note"; +is default-length-from-meter("2/2"), "1/8", "2/2 defaults to eighth note"; +is default-length-from-meter("3/4"), "1/8", "3/4 defaults to eighth note"; +is default-length-from-meter("6/8"), "1/8", "6/8 defaults to eighth note"; +is default-length-from-meter("2/4"), "1/16", "2/4 defaults to sixteenth note"; +is default-length-from-meter("C"), "1/8", "Common time defaults to eighth note"; +is default-length-from-meter("C|"), "1/8", "Cut time defaults to eighth note"; +is default-length-from-meter(""), "1/8", "No meter defaults to eighth note"; +is default-length-from-meter("none"), "1/8", "No meter defaults to eighth note"; + +for flat 'A'..'G' X 2..8 -> $note, $octave-number { + my ($pitch, $symbol) = from-note-and-number($note, $octave-number); + my ($computed-note, $computed-number) = to-note-and-number($pitch, $symbol); + is $computed-note, $note, "Note is correct after round trip through note-and-symbol"; + is $computed-number, $octave-number, "Octave number is correct after round trip through note-and-symbol"; +} + +my %key; +is pitch-to-ordinal(%key, "", "C", ""), 0, "Middle C is correct"; +is pitch-to-ordinal(%key, "^", "B", ","), 0, "B-sharp below middle C is correct"; +is pitch-to-ordinal(%key, "__", "D", ""), 0, "D-double-flat above middle C is correct"; +is pitch-to-ordinal(%key, "", "c", ""), 12, "Third space C is correct"; +is pitch-to-ordinal(%key, "^", "B", ""), 12, "Middle line B-sharp is correct"; +is pitch-to-ordinal(%key, "__", "d", ""), 12, "Fourth line D-double-flat is correct"; +is ordinal-to-pitch(%key, "C", 0), ("", "C", ""), "Middle C translates back okay"; +is ordinal-to-pitch(%key, "B", 0), ("^", "B", ","), "B-sharp below middle C translates back okay"; +is ordinal-to-pitch(%key, "D", 0), ("__", "D", ""), "D-double-flat above middle C translates back okay"; +is ordinal-to-pitch(%key, "C", 12), ("", "c", ""), "Third space C translates back okay"; +is ordinal-to-pitch(%key, "B", 12), ("^", "B", ""), "Middle line B-sharp translates back okay"; +is ordinal-to-pitch(%key, "D", 12), ("__", "d", ""), "Fourth line D-double-flat translates back okay"; + +done-testing; \ No newline at end of file diff --git a/wedding.abc b/wedding.abc new file mode 100644 index 0000000..96c339b --- /dev/null +++ b/wedding.abc @@ -0,0 +1,53 @@ +X:1 +T:Canon in D +C:Pachelbel +M:2/2 +L:1/8 +K:D +"D" DFAd "A" CEAc|"Bm" B,DFB "F#m" A,CFA|"G" B,DGB "D" A,DFA|"G" B,DGB "A" CEAc| +"D" f4 "A" e4|"Bm" d4 "F#m" c4|"G" B4 "D" A4|"G" B4 "A" c4| +d4 c4|B4 A4|G4 F4|G4 E4| +(D2 F2) (A2 G2)|(F2 D2) (F2 E2)|(D2 B,2) (D2 A2)|(G2 B2) (A2 G2)| +(F2 D2) (E2 c2)|(d2 f2) (a2 A2)|(B2 G2) (A2 F2)|D2 d2 +trill+d3c| +dcdD CAEF|DdcB cfab|gfeg fedc|BAGF EGFE| +DEFG AEAG|FBAG AGFE|DB,Bc dcBA|GFEB ABAG| +Fz f2 e4|z2 d2 f4|b4 a4|b4 c'4| +d'2 d2 c4|z2 B2 d4|d6 d2|d2 g2 e2 a2| +(af/g/) (af/g/) a/(A/B/c/ d/e/f/g/)|(fd/e/) f(F/G/)(A/B/A/G/ A/F/G/A/)| +(GB/A/ GF/E/) (F/E/D/E/ F/G/A/B/)|(GB/A/ Bc/d/) (A/B/c/d/ e/f/g/a/)| +(fd/e/ fe/d/) (e/c/d/e/ f/e/d/c/)|(dB/c/) d(D/E/)(F/G/F/E/ F/d/c/d/)| +(Bd/c/ BA/G/) (A/G/F/G/ A/B/c/d/)|(Bd/c/ dc/B/) (c/d/e/d/ c/d/B/c/)| +dz3 cz3|Bz3 dz3|Dz3 Dz3|Dz3 Ez3|+fermata+D8|] + +X:2 +T:Bridal March +C:Wagner +M:2/4 +L:1/8 +K:G +[D2d2][D3/2d3/2][D/d/]|[D2d2][D2d2]|[D4d4]|[D4d4]| +|:"G" (D2 G) z/G/|G3z|"G" (D2 "D" A) z/F/|"G" G3z|"G" (D2 G>c| +"C" c2 B>A|"G" G2 F>G|"D" A3)z|"G" (D2 G) z/G/|G3z|"G" (D2 "D" A) z/F/|"G" G3z|"G" (D2 G>B|"Bm" d2 "G" B>G)| +("Am" E2 "C" A>B|"G" G3) G|"C" c2 BA|"Am" E2 E2|"D" F2 "G" G>A|"D" A3 d| +"C" c2 BA|"Am" E2 E2|"D" F2 "G" G>A|"D" A4| +"G" (D2 G) z/G/|G3z|"G" (D2 "D" A) z/F/|"G" G3z| +"G" (D2 G>B|"Bm" d2 "G" B>G)|("Am" E2 "C" A>B|"G" G4) :| + +X:3 +T:Wedding March from Midsummer Night's Dream +C:Mendelssohn +M:4/4 +L:1/8 +K:C +z6 (3CCC|C4 z2 (3CCC|C4 z2 (3CCC|[C2E2] (3[CE][CE][CE] [C2E2] (3[CE][CE][CE]| +[C2E2G2] (3[CEG][CEG][CEG] [C2E2G2] (3[CEG][CEG][CEG]| +"Am" c4 "B" B3 ^F|("B/E" A2 "Em" G2) "Dm/F" =F2 D2|"C/G" C4 {B,C}"G" D2 G,>D|"C" E2 "^no chord" CE GCEG| +"Am" c4 "B" B3 ^F|("B/E" A2 "Em" G2) "Dm/F" =F2 D2|"C/G" C4 {B,C}E2 "G" D>E|("G" D4 "C" C2) (3CCC| +"^no chord" C2 (3CEG c2 (3CCC|C2 (3EGc e2 (3CCC|[C2E2] (3EGc e2 (3Gce|g2 (3Gce g2 (3ceg | +"Am" c4 "B" B3 ^F|("B/E" A2 "Em" G2) "Dm/F" =F2 D2|"C/G" C4 {B,C}"G" D2 G,>D|"C" E2 "^no chord" CE GCEG| +"Am" c4 "B" B3 ^F|("B/E" A2 "Em" G2) "Dm/F" =F2 D2|"C/G" C4 {B,C}E2 "G" D>E|("G" D4 "C" C2) "^no chord" (3CCC| +|: "C" c4 c3c|("C/G" e2 "Bdim/G" d2) B2 G2|"C" G3c "C/E" c3e|("C/G" e2 "Bdim/G" d2) B2 G2| +"C" G3e "C/E" e3g|("F" g4 "Dm/F" f2) "F" e2|"F" d2 ("Faug" ^c>e "F#dim" d2) "D/F#" A>c|"G" B2 "^no chord" G2 A2 B2| +"Am" c4 "B" B3 ^F|("B/E" A2 "Em" G2) "Dm/F" =F2 D2|"C/G" C4 {B,C}"G" D2 G,>D|"C" E2 "^no chord" CE GCEG| +"Am" c4 "B" B3 ^F|("B/E" A2 "Em" G2) "Dm/F" =F2 D2|"C/G" C4 {B,C}E2 "G" D>E|[1 ("G" D4 "C" C2) z2:|[2 ("G" D4 "C" C4) |] +