scm/harp-pedals.scm

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