Customized italian style chords
Implements a personalized way to write chords (in italian). The format is: (root)(root alteration)(root modifier)(root other)_(bass)(bass alteration).(duration)(dots)*(ratio numerator)/(ratio denominator) -Chords must be written in a long string. -Note names and alterations must be written in italian. -Correspondances between alteration codes and engraved symbols are: d=sharp, dd=double sharp, b=flat, bb=double flat (you can change them in the snippet). -Correspondances between modifier codes and engraved symbols are: "-" (minor)=en dash, "dim" (diminished)="o", "semidim" (half diminished)="ø" (you can change them in the snippet). -(root other) is free text. -The chord duration follows the standard lilypond format, you can also add dots and a fraction for the ratio multiplier. -If a bass is present, the chord is written in fractional form with numerator=root and denominator=bass (like italian style music sheets).
\version "2.24.0"
%Il formato dell'accordo è <radice>_<basso>.<durata con eventuali punti di valore>*<num>/<den>.
%music-map prende la musica come se fosse un albero e ci applica <funzione> in modo gerarchico a partire dalle foglie.
%I parametri passati via via a <funzione> dunque partono dalle singole foglie (LyricEvent) per poi passare al livello superiore (SequentialMusic)
%che comprende la lista dei LyricEvent (le singole foglie sono passate di nuovo ma questa volta raggruppate in una lista).
%Se modifico un livello basso, ritrovo la modifica a tutti i livelli superiori.
%Nel mio caso ho un unico evento di tipo LyricEvent che è la stringa contenente tutti gli accordi.
%Da questa stringa devo isolare i singoli accordi e aggiungerli in una lista di LyricEvent (opportunamente modificati).
%La lista dei LyricEvent poi va sostituita nel livello superiore SequentialMusic sotto la voce 'elements.
%Visto che con la prima chiamata costruisco la lista e con la seconda sostituisco 'elements di SequentialMusic,
%ho bisogno di una variabile globale che mi memorizzi la lista tra la prima e la seconda chiamata.
%
%Per capire bene come funziona music-map si può aggiungere all'inizio e alla fine della funzione il debug
% (display "MUSIC IN\n")
% (display (ly:music-property stringa-in 'name))
% (display " ")
% (display (length (ly:music-property stringa-in 'elements)))
% (display "\n")
% (display-scheme-music stringa-in)
% (display "\n")
%
% (display "MUSIC OUT\n")
% (display (ly:music-property stringa-out 'name))
% (display " ")
% (display (length (ly:music-property stringa-out 'elements)))
% (display "\n")
% (display-scheme-music stringa-out)
% (display "\n")
%
%Per visualizzare come viene memorizzata la musica in lylipond si usa la funzione
% (display-scheme-music <variabile>)
\language "italiano"
AccordiMio =
#(define-music-function (stringa-in) (ly:music?)
(define stringa-out "")
(set! stringa-out (music-map elabora-stringa-accordi stringa-in))
stringa-out
)
%variabili globali
#(begin
(define lista "")
(define durata 4)
(define numpunti 0)
(define num 1)
(define den 1)
)
#(define (elabora-stringa-accordi stringa-in)
(define stringa-out "")
(define elemento "")
(define p 0)
(define s "")
;imposto l'uscita uguale all'ingresso (nel caso non debba modificare nulla)
(set! stringa-out stringa-in)
;quando la stringa-in è al livello di LyricEvent...
(when (eq? (ly:music-property stringa-in 'name) 'LyricEvent)
;ricavo la stringa con tutti gli accordi
(set! elemento (ly:music-property stringa-in 'text))
;sostituisco i caratteri non stampabili (#\tab, #\return e #\newline) con lo spazio
(do ((p 0 (+ p 1))) ((>= p (string-length elemento)))
(cond
((equal? #\tab (string-ref elemento p)) (set! s (string-append s " ")))
((equal? #\return (string-ref elemento p)) (set! s (string-append s " ")))
((equal? #\newline (string-ref elemento p)) (set! s (string-append s " ")))
(else (set! s (string-append s (string (string-ref elemento p)))))
)
)
(set! elemento s)
;cancello gli spazi multipli
(set! s "")
(set! elemento (string-trim-both elemento))
(do ((p 0 (+ p 1))) ((>= p (string-length elemento))) ;parto dal primo carattere, non può essere uno spazio perché prima ho fatto il trim (dunque nel primo carattere non leggerò mai il carattere p-1 che non esiste)
(cond
((equal? #\space (string-ref elemento p)) (when (not (equal? #\space (string-ref elemento (- p 1)))) (set! s (string-append s (string (string-ref elemento p))))))
((not (equal? #\space (string-ref elemento p))) (set! s (string-append s (string (string-ref elemento p)))))
)
)
(set! elemento s)
;costruisco la lista dei LyricEvent in uscita
(set! lista (map elabora-accordo (string-split elemento #\ )))
)
;quando la stringa-in è al livello 'SequentialMusic...
(when (eq? (ly:music-property stringa-in 'name) 'SequentialMusic)
;sostituisco 'elements con la lista formata da tanti LyricEvent
(ly:music-set-property! stringa-out 'elements lista)
)
;ritorna stringa-out
stringa-out
)
#(define (elabora-accordo stringa-in)
(define stringa-out "")
;definisce le variabili per il parsing dell'accordo
(define radice-basso "")
(define durata-punti-num-den "")
(define durata-punti "")
(define durata-num-den "")
;durata è una variabile globale
;numpunti è una variabile globale
;num è una variabile globale
;den è una variabile globale
(define durataexp 0)
(define num-den "")
(define tmp "")
;definisce la variabili di cui si compone l'accordo
(define accordo "")
(define puntatore 0)
(define radice "")
(define radice-alterazione "") ;d, dd, b, bb
(define radice-modificatore "") ;dim, semidim, minore
(define radice-altro "")
(define basso "")
(define basso-alterazione "") ;d, dd, b, bb
;definisce i divisori
(define DIV-DURATA #\.)
(define DIV-SCALA #\*)
(define DIV-FRAZIONE #\/)
(define DIV-BASSO #\_)
;definisce i modificatori
(define MOD-DIMINUITO "dim")
(define MOD-SEMIDIMINUITO "semidim")
(define MOD-MINORE "-")
;definisce le alterazioni (si segue la notazione standard di Lylipond)
(define ALT-DIESIS "d")
(define ALT-DOPPIODIESIS "dd")
(define ALT-BEMOLLE "b")
(define ALT-DOPPIOBEMOLLE "bb")
;definisce i markup
(define MKP-SEMIDIMINUITO (markup (#:raise 1 "ø")))
(define MKP-DIMINUITO (markup (#:raise 1 "o")))
(define MKP-MINORE (markup (#:simple (ly:wide-char->utf-8 #x2013)))) ;il trattino è EN DASH
(define MKP-DOPPIODIESIS (markup (#:line (#:raise 1.5 (#:doublesharp)))))
(define MKP-DOPPIOBEMOLLE (markup (#:line (#:raise 0.5 (#:doubleflat)))))
(define MKP-DIESIS (markup (#:line (#:raise 1 (#:sharp)))))
(define MKP-BEMOLLE (markup (#:line (#:raise 0.5 (#:flat)))))
;PARSING DELL'ACCORDO
(set! tmp (string-split stringa-in DIV-DURATA)) ;divido l'accordo dalla durata (il delimitatore di string-split deve essere di tipo char)
(set! radice-basso (car tmp))
(when (>= (length tmp) 2) ;quando ho uno (o più) punti allora ho anche la durata
;resetta durata, numpunti, num, den
(set! durata 4)
(set! numpunti 0)
(set! num 1)
(set! den 1)
;parsing della durata
(set! durata-punti-num-den (string-join (cdr tmp) (make-string 1 DIV-DURATA))) ;ricompongo la parte della durata compresi i punti (il delimitatore di string-join deve essere di tipo string)
(set! tmp (string-split durata-punti-num-den DIV-SCALA)) ;divido la durata dalla frazione
(set! durata-punti (car tmp))
(when (= (length tmp) 2) ;quando ho (esattamente) un asterisco allora ho anche la frazione
;parsing del num e del den
(set! num-den (cadr tmp))
(set! tmp (string-split num-den DIV-FRAZIONE)) ;divido num da den
(set! num (string->number (car tmp)))
(when (= (length tmp) 2) ;quando ho (esattamente) una barra allora ho anche il den
(set! den (string->number (cadr tmp)))
)
)
;parsing della durata e del numpunti
(set! tmp (string-split durata-punti DIV-DURATA)) ;divido la durata dai punti di valore
(set! durata (string->number (car tmp)))
(set! numpunti (- (length tmp) 1)) ;conto i punti di valore
)
;parsing della radice e del basso
(set! tmp (string-split radice-basso DIV-BASSO)) ;divido la radice dal basso
(set! radice (car tmp))
(when (= (length tmp) 2) ;quando ho (esattamente) un underscore allora ho anche il basso
(set! basso (cadr tmp))
)
;PARSING DELLA RADICE
;sostituisci i simboli di alterazione (bemolle, doppio bemolle, diesis, doppio diesis) e i modificatori (minore, dim e semidim)
(set! tmp radice)
(when (not (string-null? tmp))
;gestisci il caso "s" come skip
(when (equal? "s" tmp)
(set! radice "")
(set! tmp "")
)
;se c'è il modificatore semidiminuito, impostalo e cancellalo
(when (string-contains tmp MOD-SEMIDIMINUITO)
(set! radice-modificatore MKP-SEMIDIMINUITO)
(set! tmp (ly:string-substitute MOD-SEMIDIMINUITO "" tmp))
)
;se c'è il modificatore diminuito, impostalo e cancellalo
(when (string-contains tmp MOD-DIMINUITO)
(set! radice-modificatore MKP-DIMINUITO)
(set! tmp (ly:string-substitute MOD-DIMINUITO "" tmp))
)
;ricava il nome della nota (primi 2 caratteri o primi 3 se la nota è SOL), impostala e cancellala
(when (>= (string-length tmp) 2)
(set! puntatore 2)
(when (equal? "so" (substring tmp 0 puntatore))
(set! puntatore 3)
)
(set! radice (substring tmp 0 puntatore))
(set! radice (markup (#:simple (string-upcase radice))))
(set! tmp (substring tmp puntatore (string-length tmp)))
)
;se c'è il modificatore minore, impostalo e cancellalo (devo farlo dopo che ho cancellato la nota altrimenti rischio di confondere la m di minore con la m di mi)
(when (string-contains tmp MOD-MINORE)
(set! radice-modificatore MKP-MINORE)
(set! tmp (ly:string-substitute MOD-MINORE "" tmp))
)
;verifica che la stringa abbia almeno 2 caratteri, ricava le alterazioni doppie (che ora stanno nei caratteri iniziali) e poi le cancella
(when (>= (string-length tmp) 2)
(cond
((equal? ALT-DOPPIODIESIS (substring tmp 0 (string-length ALT-DOPPIODIESIS))) (set! radice-alterazione MKP-DOPPIODIESIS) (set! tmp (substring tmp (string-length ALT-DOPPIODIESIS) (string-length tmp))))
((equal? ALT-DOPPIOBEMOLLE (substring tmp 0 (string-length ALT-DOPPIOBEMOLLE))) (set! radice-alterazione MKP-DOPPIOBEMOLLE) (set! tmp (substring tmp (string-length ALT-DOPPIOBEMOLLE) (string-length tmp))))
)
)
;verifica che la stringa abbia almeno 1 carattere, ricava le alterazioni singole (che ora stanno nei caratteri iniziali) e poi le cancella
(when (>= (string-length tmp) 1)
(cond
((equal? ALT-DIESIS (substring tmp 0 (string-length ALT-DIESIS))) (set! radice-alterazione MKP-DIESIS) (set! tmp (substring tmp (string-length ALT-DIESIS) (string-length tmp))))
((equal? ALT-BEMOLLE (substring tmp 0 (string-length ALT-BEMOLLE))) (set! radice-alterazione MKP-BEMOLLE) (set! tmp (substring tmp (string-length ALT-BEMOLLE) (string-length tmp))))
)
)
;ricava tutto il resto
(set! radice-altro (markup (#:simple tmp)))
)
;PARSING DEL BASSO
;sostituisci i simboli di alterazione (bemolle, doppio bemolle, diesis, doppio diesis)
(set! tmp basso)
(when (not (string-null? tmp))
;ricava il nome della nota (primi 2 caratteri o primi 3 se la nota è SOL), impostala e cancellala
(set! puntatore 2)
(when (equal? "so" (substring tmp 0 puntatore))
(set! puntatore 3)
)
(set! basso (substring tmp 0 puntatore))
(set! basso (markup (#:simple (string-upcase basso))))
(set! tmp (substring tmp puntatore (string-length tmp)))
;verifica che la stringa abbia almeno 2 caratteri, ricava le alterazioni doppie (che ora stanno nei caratteri iniziali) e poi le cancella
(when (>= (string-length tmp) 2)
(cond
((equal? ALT-DOPPIODIESIS (substring tmp 0 (string-length ALT-DOPPIODIESIS))) (set! basso-alterazione MKP-DOPPIODIESIS) (set! tmp (substring tmp (string-length ALT-DOPPIODIESIS) (string-length tmp))))
((equal? ALT-DOPPIOBEMOLLE (substring tmp 0 (string-length ALT-DOPPIOBEMOLLE))) (set! basso-alterazione MKP-DOPPIOBEMOLLE) (set! tmp (substring tmp (string-length ALT-DOPPIOBEMOLLE) (string-length tmp))))
)
)
;verifica che la stringa abbia almeno 1 carattere, ricava le alterazioni singole (che ora stanno nei caratteri iniziali) e poi le cancella
(when (>= (string-length tmp) 1)
(cond
((equal? ALT-DIESIS (substring tmp 0 (string-length ALT-DIESIS))) (set! basso-alterazione MKP-DIESIS) (set! tmp (substring tmp (string-length ALT-DIESIS) (string-length tmp))))
((equal? ALT-BEMOLLE (substring tmp 0 (string-length ALT-BEMOLLE))) (set! basso-alterazione MKP-BEMOLLE) (set! tmp (substring tmp (string-length ALT-BEMOLLE) (string-length tmp))))
)
)
)
;CALCOLA LA DURATA
;converti la durata in esponente della potenza di 2
(set! durataexp (ly:intlog2 durata))
;DEBUG
;(display (string-append "RADICE=" (markup->string radice) ", RADICE-ALT=" (markup->string radice-alterazione) ", RADICE-MOD=" (markup->string radice-modificatore) ", RADICE-ALTRO=" (markup->string radice-altro) ", BASSO=" (markup->string basso) ", BASSO-ALT=" (markup->string basso-alterazione) "\nDURATAEXP=" (number->string durataexp) ", NUMPUNTI=" (number->string numpunti) ", NUM=" (number->string num) ", DEN=" (number->string den) "\n\n"))
;costruisce l'accordo radice
(set! radice (markup #:concat (radice radice-alterazione radice-modificatore radice-altro)))
;costruisce l'accordo basso
(set! basso (markup #:concat (basso basso-alterazione)))
;costruisce la frazione
(if (string-null? (markup->string basso))
(set! accordo radice)
(set! accordo (markup #:line (#:fraction radice basso)))
)
;imposta e ritorna la stringa in uscita
(set! stringa-out (make-music 'LyricEvent 'duration (ly:make-duration durataexp numpunti num den) 'text accordo))
stringa-out
)
Accordi = \new Lyrics { \override LyricText.font-name = "JazzChords"
\lyricmode { \AccordiMio {
" soldd-7_rebb.4 s.8 do
redim7 misemidim7"
}
}
}
Melodia = \new Staff \new Voice { do'8 8 8 8 8 8 8 8 }
Parole = \new Lyrics \lyricmode { uno4 due tre quattro }
<<
\Accordi
\Melodia
\Parole
>>
