Editing 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: &quot;-&quot; (minor)=en dash, &quot;dim&quot; (diminished)=&quot;o&quot;, &quot;semidim&quot; (half diminished)=&quot;ø&quot; (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).

<lilypond 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
>>
</lilypond>