\version "2.11. 55"

\paper {
  ragged-right = ##f
}

% The following defines a new markup command 
%      \harp-pedal #"^-v|--v^" 
% for harp pedal diagrams. Possible values in the string are:
%   ^ ... pedal is up
%   - ... pedal is neutral
%   v ... pedal is down
%   | ... vertical divider line
% The function does not check if the string has the typical form of three
% pedals, then the divider and then the remaining four pedals. Instead it 
% simply prints each symbol in the order as given. This means you can place
% the divider (even multiple dividers) anywhere you want.
% 
% There is also a \harp-pedal-verbose version, which 
% takes a list of directions and a possible |. Unfortunately, it has some
% caveats:
%   1) the | cannot be given as a string "|", but as a character #\|
%   2) if one wants to use directions like UP, CENTER or DOWN, one cannot use
%      '(UP DOWN CENTER #\| ....), because the contents of that list are 
%      never evaluated. Instead one has to explicitly create a list like
%      (list UP DOWN CENTER #\| ....)

#(define-markup-command (harp-pedal-verbose layout props pedal-list) (list?)
  "Make a harp pedal diagram containing the directions indicated in @var{pedal-list}.

  For example,

@example
\\markup \\pedal-diagram-verbose #'(1 0 -1 #\\| 0 0 1 1)
\\markup \\pedal-diagram-verbose #(list UP CENTER DOWN #\\| CENTER CENTER UP UP)
@end example
"
  (make-harp-pedal layout props pedal-list))


#(define-markup-command (harp-pedal layout props definition-string) (string?)
  "Make a harp pedal diagram.  For example, say

@example
\\markup \\harp-pedal #\"^-v|^^^^\"
@end example
"
  (make-harp-pedal layout props (harp-pedals-parse-string definition-string)))


#(define (harp-pedals-parse-string definition-string)
 "Parse a harp pedals diagram string and return a list containing 1, 0, -1 or #\\|"
  (map (lambda (c) 
    (case c
      ((#\^) 1)
      ((#\v) -1)
      ((#\-) 0)
      ((#\|) #\|)
      (else c)))
    (string->list definition-string)))


#(define (make-harp-pedal layout props pedal-list)
  "Make a harp pedals diagram markup"
       
  ; FIXME the size variable should be defined by a prop. lookup
  (define sz 1.2)
       
  ; TODO is it worth adding a thickness variable here?
  (let* ((x (* sz 4))
        (y (* sz 2))
        (box-width (* sz 0.4))
        (box-height (* sz 1))
        (space (* sz 0.5))
        (box-x-dimensions (lambda (prev-x p) (cons (+ prev-x space) 
                                             (+ prev-x space box-width))))
        (box-y-dimensions (lambda (prev-x p) (cons (+ (- y (/ box-height 2)) p) 
                                                   (+ y (/ box-height 2) p))))
        (divider-command (lambda (xpos) (list 'draw-line 0.2 xpos 0 xpos (* y 2))))
        (result (let process-pedal  ((remaining pedal-list)
                                     (prev-x 0)
                                     (stencils '()))
          (if (null? remaining)
            (cons prev-x stencils) 
      
            (case (car remaining)
              ((1 0 -1) 
                 (let* ((p (car remaining))
                        (stencil (make-filled-box-stencil
                                  (box-x-dimensions prev-x p) (box-y-dimensions prev-x p)))
                          (new-prev-x (+ prev-x space box-width space)))
                      (process-pedal (cdr remaining) new-prev-x (cons stencil stencils))))
                ((#\|)
                    (let* ((xpos (+ prev-x space))
                           (stencil (ly:make-stencil (divider-command xpos)))
                           (new-prev-x (+ prev-x (* 2 space))))
                      (process-pedal (cdr remaining) new-prev-x (cons stencil stencils))))
                (else
                  (display "unhandled entry in harp-pedal:")
                  (display (car remaining))
                  (newline)
                  (process-pedal (cdr remaining) prev-x stencils))))))
        (final-x (car result))
        (stencils (reverse (cdr result))))
    ; Add the horizontal line and combine all stencils:
    (apply ly:stencil-add 
        (cons
          (ly:make-stencil (list 'draw-line 0.2  0 y final-x y)) 
          stencils))))



\relative c'' {
  c1^\markup \harp-pedal #"^v-|vv^-"
  c1_\markup \harp-pedal-verbose #'(1 -1 0 #\| -1 -1 1 0)
  c1^\markup \harp-pedal-verbose #(list UP DOWN CENTER #\| DOWN DOWN UP CENTER)
  % invalid pedal specifications, which still should be handled gracefully:
  c1^\markup \harp-pedal #""
  c1^\markup \harp-pedal #"asfdvx"
}