\version "2.14.2"

\header {
  title = "Test of String numbering"
  subtitle = "E9th Pedal Steel Guitar"
  arranger = "Anders Eriksson"
  
}

%% ---------------------------------
%% http://lsr.dsi.unimi.it/LSR/Item?id=768
%% ---------------------------------

deleteArticulations =  #(define-music-function (parser location music) (ly:music?)
(music-filter
   (lambda (evt)
      (not (memq (ly:music-property evt 'name) (list 'FingeringEvent 
                                                     'StrokeFingerEvent
                                                     'StringNumberEvent))))
   music))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   
#(define (name-of music)
 (ly:music-property music 'name))

#(define (delete-comments s)
"Delete in a string, all substrings begining with % bis the end of line."
(let ((delete? #f))
  (string-delete s 
      (lambda (c)
        (case c
          ((#\%) (set! delete? #t))
          ((#\newline)(set! delete? #f)))
         delete?))))
         
#(define (expand-chars s)
"Transforme in a string, *15x for example, in xxxxxxxxxxxxxxx (15 times)"
(let ((len (string-length s))
      (star-pos #f)
      (count-str ""))
 (if (> len 0)     
  (let loop ((i 0))
    (let ((c (string-ref s i))
          (reset (lambda ()
                    (set! star-pos #f)
                    (set! count-str ""))))
      (cond 
         ((eq? c #\*) (set! star-pos i))          
         ((char-numeric? c)
            (if star-pos (set! count-str (string-append count-str (string c)))))
         ((char-alphabetic? c)
            (if star-pos (if (string-null? count-str)
               (reset)
               (let* ((count (string->number count-str))
                      (replace-str (make-string count c))) 
                 (set! s (string-replace s replace-str star-pos (1+ i)))
                 (set! len (string-length s))
                 (set! i (+ star-pos count))
                 (reset)))))
         (else (if star-pos (reset)))))           
    (if (< i (1- len)) (loop (1+ i)))))
  s))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% general methode for adding articulations.
%% event-name : articulation event name : 'FingeringEvent for ex.
%% property-name : main property of event-name : 'digit for fingerings.
%% min max : range number for a digit : 0-5 for fingerings.
#(define (add-articulation event-name property-name min max music finger-str)         
(let* ((pre-str (expand-chars (delete-comments finger-str)))
       (my-character-set (char-set-adjoin char-set:letter+digit #\+ #\- #\'))
       (filter-str (string-filter pre-str my-character-set))
       (str-list (string->list filter-str))
       (str-list->current-char-code (lambda () 
                        (if (null? str-list) 0 (char->integer (car str-list)))))
       (char-code (str-list->current-char-code))
       (next-char-code (lambda ()
                           (set! str-list (cdr str-list))
                           (set! char-code (str-list->current-char-code)))))

  (define (set-dir dir); "+" return 1, "-" return -1. To call with (set-dir 0).
      (cond ((= char-code (char->integer #\+))
                      (next-char-code)
                      (set-dir 1))
            ((= char-code (char->integer #\-))
                      (next-char-code)
                      (set-dir -1))
            (else dir)))
  (music-map
     (lambda (evt)
        (if (and (eq? (name-of evt) 'NoteEvent)
                 (not (= char-code 0)))          
           (let*((dir (set-dir 0))
                 (apostrophe-code (char->integer #\'))
                 (tweaks? (and (= char-code apostrophe-code)
                               (let loop ((text-list '()))
                                  (next-char-code) 
                                  (if (and (> char-code 0)  
                                           (not (= char-code apostrophe-code)))
                                    (loop (cons (integer->char char-code) 
                                                text-list))
                                    (list (cons 
                                        (quote text)
                                        (reverse-list->string text-list)))))))
                 (i (if tweaks? min (- char-code (char->integer #\0)))))
              (if (and (>= i min)(<= i max))
                (ly:music-set-property! evt 'articulations (append
                  (list (make-music
                          event-name
                          'tweaks tweaks?
                          'direction dir                         
                          property-name i ))
                  (ly:music-property evt 'articulations))))                
              (if (not (= char-code 0))(next-char-code))))
        evt)
     music)))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% addFingering adds the first digit founded in fingerStr, adds
%% it as a fingering to the first note found in music and so on.
%% Just enter a letter if you don't want fingering for certain notes.         
%% You can also
%% -> add a direction ("+" = UP,"-" = DOWN).
%% -> add a substitution fingering by enclosing several digits between 2
%%    apostrophes, with - (minus) as separator char, like that '1-2-3'.
%% -> add comments at the end of the line. Start them with a percent sign (%).

addFingering =  #(define-music-function (parser location music fingerStr) 
                                                             (ly:music? string?)     
(add-articulation 'FingeringEvent 'digit 0 5 music fingerStr))

addStrokeFinger = #(define-music-function (parser location music fingerStr) 
                                                             (ly:music? string?)
(add-articulation 'StrokeFingerEvent 'digit 1 4 music fingerStr))

addStringNumber = #(define-music-function (parser location music fingerStr) 
                                                             (ly:music? string?) 
(add-articulation 'StringNumberEvent 'string-number 0 9 music fingerStr))

%% end of addFingering

melody = \relative c' {
  <c e>4 <d f> <e g> 
}

\score {
  <<
    \new Staff { \addStringNumber \melody
                 #"
                  +'9'+'6' +'7'+'6B' +'6'+'5'
  		"
    }
  >>
}