1/* Part of plumdrum
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(dynam, []).

dynam spine format for Humdrum

This module provides the humdrum hook predicate hum_data_hook//2 to enable parsing of the dynam and db spine type.

The dynam interpretation provides the following data term type:

dynam ---> st(loudness)  % marking, forte, piano etc
         ; dy(progress, process)
         ; ed(editorial)
         ; rest
         ; accent
         ; subito
         ; sforz.

loudness ---> mf  % mezzoforte
            ; mp  % mezzopiano
            ; f(N:natural) % N forte marks
            ; p(N:natural) % N piano marks.
progress ---> begin; cont; end.
process  ---> crescendo; diminuendo.
editorial ---> explicit; published.

The db interpretation simply produces floating point numbers encoding loudness in decibels.

db == float.

*/

   52:- use_module(library(dcg_core)).   53:- use_module(library(dcg_macros)).   54:- use_module(library(humdrum)).   55:- use_module(library(humdrum/humutils)).   56
   57:- set_prolog_flag(double_quotes,codes).   58
   59humdrum:hum_data_hook(dynam,Sigs) --> !, seqmap(dynam,Sigs).
   60humdrum:hum_data_hook(db,DB) --> !, float(DB).
   61
   62dynam(st(f(N))) --> "f", !, rep_shared(M,"f"), {succ(M,N)}.
   63dynam(st(p(N))) --> "p", !, rep_shared(M,"p"), {succ(M,N)}.
   64dynam(st(mf))   --> "mf".
   65dynam(st(mp))   --> "mp".
   66
   67dynam(rest)   --> "r".
   68dynam(accent) --> "v".
   69dynam(subito) --> "s".
   70dynam(sforz)  --> "z".
   71
   72dynam(ed(explicit)) --> "X".
   73dynam(ed(published)) --> "x".
   74
   75dynam(dy(begin,crescendo))  --> "<".
   76dynam(dy(cont,crescendo))   --> "(".
   77dynam(dy(end,crescendo))    --> "[".
   78dynam(dy(begin,diminuendo)) --> ">".
   79dynam(dy(cont,diminuendo))  --> ")".
   80dynam(dy(end,diminuendo))   --> "]"