scm/harp-pedals.scm

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