scm/harp-pedals.scm

   1 ;;;; harp-pedals.scm --
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2008 Reinhold Kainhofer <reinhold@kainhofer.com>
   6
   7
   8 ;;;; More verbose version, which takes a list of directions. It's commented
   9 ;;;; out, because it has some issues (see below) and does not add any new
  10 ;;;; functionality over \harp-pedal
  11 ;; (define-builtin-markup-command (harp-pedal-verbose layout props pedal-list) (list?)
  12 ;;   music ; markup type
  13 ;;   ((size 1.0)
  14 ;;    (harp-pedal-details)
  15 ;;    (thickness 0.5))
  16 ;;   "Make a harp pedal diagram containing the directions indicated in @var{pedal-list}.
  17 ;;
  18 ;;   For example,
  19 ;;
  20 ;; @example
  21 ;; \\markup \\pedal-diagram-verbose #'(1 0 -1 #\\| 0 0 1 1)
  22 ;; \\markup \\pedal-diagram-verbose #(list UP CENTER DOWN #\\| CENTER CENTER UP UP)
  23 ;; @end example
  24 ;; "
  25 ;;   (make-harp-pedal layout props pedal-list))
  26
  27
  28 (define-builtin-markup-command (harp-pedal layout props definition-string) (string?)
  29   instrument-specific-markup ; markup type for the documentation!
  30   ((size 1.0)
  31    (harp-pedal-details)
  32    (thickness 0.5))
  33   "Make a harp pedal diagram.
  34
  35 Possible elements in @var{definition-string}:
  36
  37 @table @code
  38 @item ^
  39 pedal is up
  40 @item -
  41 pedal is neutral
  42 @item v
  43 pedal is down
  44 @item |
  45 vertical divider line
  46 @item o
  47 the following pedal should be circled (indicating a change)
  48 @end table
  49
  50 The function also checks if the string has the typical form of three
  51 pedals, then the divider and then the remaining four pedals. If not it
  52 prints out a warning. However, in any case, it will also print each symbol
  53 in the order as given. This means you can place the divider (even multiple
  54 dividers) anywhere you want, but you'll have to live with the warnings.
  55
  56 The appearance of the diagram can be tweaked inter alia using the size property
  57 of the TextScript grob (@code{\\override Voice.TextScript #'size = #0.3}) for
  58 the overall, the thickness property
  59 (@code{\\override Voice.TextScript #'thickness = #3}) for the line thickness of
  60 the horizontal line and the divider. The remaining configuration (box sizes,
  61 offsets and spaces) is done by the harp-pedal-details  list of properties
  62 (@code{\\override Voice.TextScript #'harp-pedal-details #'box-width = #1}).
  63 It contains the following settings: @code{box-offset} (vertical shift of the
  64 box center for up/down pedals), @code{box-width}, @code{box-height},
  65 @code{space-before-divider} (the spacing between two boxes before the
  66 divider) and @code{space-after-divider} (box spacing after the divider).
  67
  68 @lilypond[verbatim,quote]
  69 \\markup \\harp-pedal #\"^-v|--ov^\"
  70 @end lilypond
  71 "
  72
  73 ;; There is also a \harp-pedal-verbose version, which
  74 ;; takes a list of -1/0/1 directions and a possible |. Unfortunately, it has some
  75 ;; caveats:
  76 ;;   1) the | cannot be given as a string "|" but as a character #\| and
  77 ;;      the "o" has to be given as #\o.
  78 ;;   2) if one wants to use directions like UP, CENTER or DOWN, one cannot use
  79 ;;      '(UP DOWN CENTER #\| ....), because the contents of that list are
  80 ;;      never evaluated to -1/0/1. Instead one has to explicitly create a
  81 ;;      list like (list UP DOWN CENTER #\| ....)
  82
  83   (make-harp-pedal layout props (harp-pedals-parse-string definition-string)))
  84
  85
  86 (define (harp-pedals-parse-string definition-string)
  87  "Parse a harp pedals diagram string and return a list containing 1, 0, -1, #\\o or #\\|"
  88   (map (lambda (c)
  89     (case c
  90       ((#\^) 1)
  91       ((#\v) -1)
  92       ((#\-) 0)
  93       ((#\| #\o) c)
  94       (else c)))
  95     (string->list definition-string)))
  96
  97 (define (harp-pedal-info pedal-list)
  98   (let check ((pedals pedal-list)
  99               (pedalcount 0)
 100               (dividerpositions '()))
 101     (if (null? pedals)
 102       (cons pedalcount (reverse dividerpositions))
 103
 104       (case (car pedals)
 105         ((-1 0 1) (check (cdr pedals) (+ pedalcount 1) dividerpositions))
 106         ((#\|)    (check (cdr pedals) pedalcount (cons pedalcount dividerpositions)))
 107         (else     (check (cdr pedals) pedalcount dividerpositions))))))
 108
 109 (define (harp-pedal-check pedal-list)
 110   "Perform some sanity checks for harp pedals (7 pedals, divider after third)"
 111   (let ((info (harp-pedal-info pedal-list)))
 112     ; 7 pedals:
 113     (if (not (equal? (car info) 7))
 114       (ly:warning "Harp pedal diagram contains ~a pedals rather than the usual 7." (car info)))
 115     ; One divider after third pedal:
 116     (if (null? (cdr info))
 117       (ly:warning "Harp pedal diagram does not contain a divider (usually after third pedal).")
 118       (if (not (equal? (cdr info) '(3)))
 119         (ly:warning "Harp pedal diagram contains dividers at positions ~a. Normally, there is only one divider after the third pedal." (cdr info))))))
 120
 121
 122 (define (make-harp-pedal layout props pedal-list)
 123   "Make a harp pedals diagram markup"
 124
 125
 126   ; FIXME the size variable should be defined by a prop. lookup
 127   (harp-pedal-check pedal-list)
 128
 129   (let* ((size (chain-assoc-get 'size props 1.2))
 130         (details (chain-assoc-get 'harp-pedal-details props '()))
 131         (dy (* size (assoc-get 'box-offset details 0.8))) ; offset of the box center from the line
 132         (line-width (* (ly:output-def-lookup layout 'line-thickness)
 133                        (chain-assoc-get 'thickness props 0.5)))
 134         (box-width (* size (assoc-get 'box-width details 0.4)))
 135         (box-hheight (* size (/ (assoc-get 'box-height details 1.0) 2))) ; half the box-height, saves some divisions by 2
 136         (spacebeforedivider (* size (assoc-get 'space-before-divider details 0.8))) ; full space between boxes before the first divider
 137         (spaceafterdivider (* size (assoc-get 'space-after-divider details 0.8))) ; full space between boxes
 138         ;(spacebeforedivider (/ (+ box-width (* 8 spaceafterdivider)) 8))
 139         (box-x-dimensions (lambda (prev-x p space) (cons (+ prev-x space)
 140                                                    (+ prev-x space box-width))))
 141         (box-y-dimensions (lambda (prev-x p space) (cons (- (* p dy) box-hheight)
 142                                                          (+ (* p dy) box-hheight))))
 143         (divider-stencil (lambda (xpos) (make-line-stencil line-width xpos (- 0 dy box-hheight) xpos (+ dy box-hheight))))
 144         (result (let process-pedal  ((remaining pedal-list)
 145                                      (prev-x 0)
 146                                      (stencils '())
 147                                      (circled #f)
 148                                      (space spacebeforedivider))
 149           ; Terminal condition of the recursion, return (final-x . stencil-list)
 150           (if (null? remaining)
 151             (cons (+ prev-x space) stencils)
 152
 153             (case (car remaining)
 154               ((1 0 -1)  ; Pedal up/neutral/down
 155                   (let* ((p (car remaining))
 156                         (stencil (make-filled-box-stencil
 157                                    (box-x-dimensions prev-x p space)
 158                                    (box-y-dimensions prev-x p space)))
 159                                    ;(circle-stencil (if circled (rounded-box-stencil stencil 0.05 0.3 0.1 ) stencil))
 160                                    (circle-stencil (if circled (circle-stencil stencil 0.05 0.2 ) stencil))
 161                         (new-prev-x (+ prev-x space box-width)))
 162                       (process-pedal (cdr remaining) new-prev-x (cons circle-stencil stencils) #f space)))
 163               ((#\|)  ; Divider line
 164                   (let* ((xpos (+ prev-x space))
 165                          (stencil (divider-stencil xpos))
 166                          (new-prev-x (+ prev-x space)))
 167                     (process-pedal (cdr remaining) new-prev-x (cons stencil stencils) circled spaceafterdivider)))
 168               ((#\o)  ; Next pedal should be circled
 169                   (process-pedal (cdr remaining) prev-x stencils #t space))
 170               (else
 171                   (ly:warning "Unhandled entry in harp-pedal: ~a" (car remaining))
 172                   (process-pedal (cdr remaining) prev-x stencils circled space))))))
 173         (final-x (car result))
 174         (stencils (reverse (cdr result))))
 175     ; Add the horizontal line and combine all stencils:
 176     (apply ly:stencil-add
 177       (cons
 178         (make-line-stencil line-width 0 0 final-x 0)
 179         stencils))))
 180