\version "2.19.48"

%#(define (t->m t)
%   "Return the current moment of translator object @var{t}."
%   (ly:context-current-moment (ly:translator-context t)))

%% The following three definitions are soso down to ugly
%% They work with limited testings, but should be replaced/reworked.

#(define (replace-adjacent-duplicates lst rl)
  "Takes a list of strings. Puts out a list where every adjactent duplicate is
transformed into an empty-string."
  (if (null? lst)
      (append-map
        (lambda (l) (cons (car l) (make-list (length (cdr l)) "")))
        (reverse rl))
      ;; split-at-predicate is not public and probably too expensive
      (let ((splitted-list ((@@ (lily) split-at-predicate) string=? lst)))
        (replace-adjacent-duplicates
          (cdr splitted-list)
          (cons (car splitted-list) rl)))))
  
#(define (moments-diff-list moments-list)
  "Takes a list of moments. Puts out a list where the difference between each 
moments is calculated via ly:moment-sub."
  (remove
    (lambda (mom) (equal? mom ZERO-MOMENT))
    (reverse
      (fold 
        (lambda (a b rl) (cons (ly:moment-sub b a) rl))
        (list (car moments-list))
        moments-list
        (cdr moments-list)))))

#(define (moment->duration-string moment lst)
  "Transforms a list of moments into strings representing a duration and then
suitable for make-note-markup."
  (cond ((and (null? lst) (= (ly:moment-main-denominator moment) 1))
         ;; This is buggy and will not work for longer (dotted) notes
         ;; Too tired ...
         (let* ((denom (ly:moment-main-denominator moment))
                (num (ly:moment-main-numerator moment)))
           (case num
             ((8) "maxima")
             ((4) "longa")
             ((2) "breve")
             ((1) "1")
             (else 
               (cond ((and (> num 8) (= 4 (remainder num 8)))
                      "maxima.")
                     ((and (> num 4) (= 2 (remainder num 4)))
                      "longa.")
                     ((and (> num 2) (= 1 (remainder num 2)))
                      "breve.")
                     ((and (> num 1) (= 0 (remainder num 1)))
                      "breve.")
                     (else 
                       (begin
                         (ly:warning "not defined for moment ~a" moment)
                         "foo")))))))
        ((and (not (null? lst))
              (equal? ZERO-MOMENT (car lst)))
         (format #f "~a~a" 
           (cdar (remove ly:moment? lst)) 
           (make-string (1- (length (remove ly:moment? lst))) #\.)))
        (else
          (let* ((denom (ly:moment-main-denominator moment))
                 (num (ly:moment-main-numerator moment)))
            (if (= 1 denom num)
                (format #f "1~a"  
                  (make-string (length (remove ly:moment? lst)) #\.))
                (let ((new-moment 
                        (fraction->moment 
                          (cons (floor (/ num 2)) (/ denom 2)))))
                  (moment->duration-string
                    new-moment
                    (append
                      (list new-moment (cons (remainder num 2) denom))
                      lst))))))))

%% The idea:
%% Assemble all moments where note-events start into a list.
%% Calculate the difference between each those moments. In order to get
%% durations as a duration-string for make-note-markup.
%% Replace every string in this list with "" if it is a duplicate.
%% Create TextScript-grobs at every note-event, but kill them if text is ""
%%
%% Will most likely not work for tuplets. Not tested, though.
Lute_tab_duration_engraver =
#(lambda (context)
   (let ((m-n '())
         (grobs '())
         (ev '()))
     (make-engraver
       ;((initialize translator)
       ; (format 1 "\n\n~16a: (initialize)\n" (t->m translator)))
       ;((start-translation-timestep translator)
       ; (format 1 "~16a: (start-translation-timestep)\n" (t->m translator)))
       (listeners
         ((note-event engraver event)
          ;(format 1 "~16a: detected this note event: ~a\n " 
          ;    (t->m engraver) event)
          (set! m-n (cons (ly:context-current-moment context) m-n))
          (set! ev (cons event ev))))
       ;(acknowledgers
       ;  ((note-head-interface engraver grob source-engraver)
       ;   (format 1 "~16a: saw ~a coming from ~a\n"
       ;           (t->m engraver) grob source-engraver)))
       ;(end-acknowledgers
       ;  ((beam-interface engraver grob source-engraver)
       ;   (format 1 "~16a: saw end of ~a coming from ~a\n"
       ;           (t->m engraver) grob source-engraver)))
       ((process-music translator)
        ;(format 1 "~16a: (process-music)\n" (t->m translator))
        (if (member (ly:context-current-moment context) m-n)
            (let ((grob 
                    (ly:engraver-make-grob translator 'TextScript (car ev))))
              (set! grobs (cons grob grobs)))))
       ;((process-acknowledged translator)
       ; (format 1 "~16a: (process-acknowledged)\n" (t->m translator)))
       ((stop-translation-timestep translator)
       ; (format 1 "~16a: (stop-translation-timestep)\n" (t->m translator))
       ;; needs to be here, otherwise the moments are not completely collected
        (let* ((moments-diffs
                (moments-diff-list (reverse m-n)))
               (moment-diff-strings
                 (map
                   (lambda (x)
                     (moment->duration-string x '()))
                   moments-diffs)))
          (for-each
            (lambda (g strg)
              (if (string-null? strg)
                  (ly:grob-suicide! g)
                  (begin
                    (ly:grob-set-property! g 'direction UP)
                    (ly:grob-set-property! g 'text 
                      (markup #:override '(style . mensural) #:note strg UP)))))
            (reverse grobs)
            (append
             (replace-adjacent-duplicates moment-diff-strings '())
             ;; Urgh, not that nice to add this here, and it may be wrong :((
             (list 
               (ly:duration->string (ly:event-property (car ev) 'duration)))))))
          ((finalize translator)
           (set! ev '())
           (set! grobs '())))))
       
%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%

%% first example

notes = 
\relative c'' {
  \time 3/4
  
  \partial 4.
  
  a8 r a |
  <f d>4. 
  f8 <g e>4 |
  
  \break
  
  \time 4/4
  
  c1 |
  cis2 d4 ees8 e16 f32 fis64 g64 |
  gis16 a16 bes8 c cis d ees e f |
  fis g gis a bes b 
  c16..
  cis64
  d8
}

\score {
  <<
   \new Staff \new Voice \notes
   
   \new TabStaff \new TabVoice \notes
   
   \new TabStaff
     <<
       \new TabVoice \notes
       \new TabVoice \repeat unfold 28 a8
     >>
  >>
  \layout {
    \context {
      \TabStaff
      \consists \Lute_tab_duration_engraver
      % Use letters to indicate frets
      tablatureFormat = #fret-letter-tablature-format
      % Usual string tuning for 6-course Baroque lute
      stringTunings = \stringTuning <a d' f' a' d'' f''>
      
      % Choose a suitable font for fret letters
      \override TabNoteHead.font-name = #"Fronimo Gavotta"
      \override Flag.style = #'straight
      \revert TextScript.stencil
    }
    \context {
      \TabVoice
      \consists "Fingering_engraver"
      \consists "New_fingering_engraver"
      \revert Slur.stencil
      \textLengthOn
    }
  }
}

%% second example

m = { 
  \compressFullBarRests 
  c'\maxima \longa \breve 1 2 4 8 16 32 
  \maxima. \longa. \breve. 1. 2. 4. 8. 16. 32.
}

<<
  \new MensuralVoice \m
  \new TabStaff 
    \with { \consists \Lute_tab_duration_engraver \revert TextScript.stencil }
  \new TabVoice \m
>>