\version "2.19.13"

%% for nicer displaying
#(use-modules (ice-9 pretty-print))

%% Define the language, if you want, needs to be a string.
%% If not set the default will be used.
%% TODO: How to read out the used language directly from:
%% \language "what-ever"
%% ?
which-language = "deutsch"

#(define which-language
;; tests whether 'which-language' is defined already and if 'which-language' is
;; part of 'language-pitch-names', see define-note-names.scm
;; if not, use 'default-language' (netherlands), see declarations-init.ly
   (if (defined? 'which-language)
       (let ((possible-languages (map car language-pitch-names)))
         ;(write possible-languages)
         (if (member (string->symbol which-language) possible-languages)
             which-language
             (ly:error "specified language, \"~a\", does not exist" 
                       which-language)))
       default-language))
 
%% Ofcourse this means the input language has to be 'which-language'
\language \which-language

#(define used-notenames 
;; returns a subset of 'language-pitch-names', specified by which-language.
;; key and value are exchanged
;; i.e. the alist is from type '((pitch . name) ... )
   (map
     (lambda (e) (reverse-interval e))
     (assoc-get 
       (string->symbol which-language) 
           language-pitch-names)))

%#(pretty-print used-notenames)

#(define (get-pitch elt)
   (ly:music-property elt 'pitch))
   
#(define (get-duration elt)
   (ly:music-property elt 'duration))
       
#(define (extract-pitches lst)
;; 'lst' is supposed to be a list of music, p.e. created via 
;; 'extract-named-music'.
;; 'extract-pitches' puts out a list of pitch-duration pairs.
;; EventChords are special-cased in a nested list.
    (define (helper lst-1 result) 
      (cond
       ((null? lst-1) result)
       ((ly:pitch? (get-pitch (car lst-1)))
        (set! result (append result 
                             (list (cons (get-pitch (car lst-1)) 
                                         (get-duration (car lst-1))))))
        (helper (cdr lst-1) result))
       ((ly:music-property (car lst-1) 'elements)
        (append
         (if (music-is-of-type? (car lst-1) 'event-chord)
             (append result 
                     (list 
                       (helper (ly:music-property (car lst-1) 'elements) '())))
             (helper (ly:music-property (car lst-1) 'elements) result))
         (helper (cdr lst-1) '())))
       (else (helper (cdr lst-1) result))))
   ;(pretty-print (helper lst '()))
   (helper lst '()))
   
#(define (pitchname-duration pitch-duration)
;; 'pitch-duration' is supposed to be a list of pitch-duration-pairs
;; 'pitchname-duration' outputs a list of string-duration-pairs, where the 
;; string is the note-name in the curently used language, looked up in
;; 'used-notenames', octave-signs are added.
   (let* ((pitch (car pitch-duration))
          (dur (cdr pitch-duration))
          (pitch-octaves (ly:pitch-octave pitch))
          (pitch-notename (ly:pitch-notename pitch))
          (pitch-alteration (ly:pitch-alteration pitch))
          ;; create a pitch with alteration, name but 
          ;; octave set to -1
          ;; this ensures the possibility to look it up in 
          ;; 'used-notenames'
          (p (ly:make-pitch -1 pitch-notename pitch-alteration))
          (pitch-name-strg 
             (symbol->string (assoc-get p used-notenames)))
          ;; recreate the octave-notation
          ;; TODO: does this apply for all languages?
          ;; lack of knowledge here, so ...
          (octave-sign
            (cond ((< pitch-octaves 0)
                   (string-concatenate 
                     (make-list (1- (abs pitch-octaves)) ",")))
                  ((= pitch-octaves 0) "'")
                  ((> pitch-octaves 0)
                   (string-concatenate 
                     (make-list (1+ (abs pitch-octaves)) "'")))))
          (absolute-pitch-name 
            (string-append pitch-name-strg octave-sign)))
     (cons absolute-pitch-name dur)))
    
#(define (output-lyrics pitchname-duration-ls)
;; 'output-lyrics' returns a list of LyricEvents.
;; 'text and 'duration are taken from 'pitchname-duration-ls'
;; directly or processed from there.
;; If an EventChord occurs, a center-columned markup is built.
   (map
     (lambda (e)
       (let ((txt-dur-list
               (if (list? e)
                   (let* ((name-dur-ls (map pitchname-duration e))
                          ;; get duration from first note-event of an 
                          ;; event-chord should be sufficient!?
                          (first-dur (cdar e))
                          (mrkp-args (reverse (map car name-dur-ls)))
                          (mrkp 
                            (make-override-markup '(baseline-skip . 2.3)
                              (make-center-column-markup 
                                mrkp-args))))
                      (cons mrkp first-dur))
                   (pitchname-duration e))))
       (make-lyric-event (car txt-dur-list) (cdr txt-dur-list))))
     pitchname-duration-ls))
        
noteNameToLyric =
#(define-music-function (parser location music) (ly:music?)
;; Returns a list of lyric-events containing the NoteNames found 
;; in 'music'.
   (let* ((lst (output-lyrics 
                 (extract-pitches
                  (extract-named-music music '(EventChord NoteEvent))))))
     $(make-sequential-music lst)))
     
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% EXAMPLE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%

music = 
\relative c' { 
	c,, cis d dis e f fis g gis a ais b c 
	cis d dis e f fis g gis a ais b c
	\tuplet 3/2 { b4 b b }
	%% TODO:
	%% doesn't work with \repeat unfold
	%\repeat unfold 2 cisis4
	\repeat volta 2 { cis d dis e f fis g gis a ais b c }
	\alternative {
		{ \transpose c cis'' <c e g> }
		{ d }
	}
	%% TODO:
	%% fails for simultaneuos music
	%<< { c' e } \\ { e, g } >>
}

<<
  \new Staff 
    \music
  \new Lyrics {
    \set stanza = 
      \markup 
        \vcenter 
        \rounded-box 
        \tiny 
        \override #'(baseline-skip . 1.8)
        \center-column { "language" "is" \which-language }
    \noteNameToLyric \music
  }
>>