- (ly:warning "Harp pedal diagram does not contain a divider (usually after third pedal).")
- (if (not (equal? (cdr info) '(3)))
- (ly:warning "Harp pedal diagram contains dividers at positions ~a. Normally, there is only one divider after the third pedal." (cdr info))))))
-
-
-(define (make-harp-pedal layout props pedal-list)
- "Make a harp pedals diagram markup"
-
- (harp-pedal-check pedal-list)
-
- (let* ((size (chain-assoc-get 'size props 1.2))
- (details (chain-assoc-get 'harp-pedal-details props '()))
- (dy (* size (assoc-get 'box-offset details 0.8))) ; offset of the box center from the line
- (line-width (* (ly:output-def-lookup layout 'line-thickness)
- (chain-assoc-get 'thickness props 0.5)))
- (box-width (* size (assoc-get 'box-width details 0.4)))
- (box-hheight (* size (/ (assoc-get 'box-height details 1.0) 2))) ; half the box-height, saves some divisions by 2
- (spacebeforedivider (* size (assoc-get 'space-before-divider details 0.8))) ; full space between boxes before the first divider
- (spaceafterdivider (* size (assoc-get 'space-after-divider details 0.8))) ; full space between boxes
- (circle-thickness (* (ly:output-def-lookup layout 'line-thickness)
- (assoc-get 'circle-thickness details 0.5)))
- (circle-x-padding (* size (assoc-get 'circle-x-padding details 0.15)))
- (circle-y-padding (* size (assoc-get 'circle-y-padding details 0.2)))
- (box-x-dimensions (lambda (prev-x p space) (cons (+ prev-x space)
- (+ prev-x space box-width))))
- (box-y-dimensions (lambda (prev-x p space) (cons (- (* p dy) box-hheight)
- (+ (* p dy) box-hheight))))
- (divider-stencil (lambda (xpos) (make-line-stencil line-width
- xpos (- 0 dy box-hheight)
- xpos (+ dy box-hheight))))
- (result (let process-pedal ((remaining pedal-list)
- (prev-x 0)
- (stencils '())
- (circled #f)
- (space spacebeforedivider))
- ; Terminal condition of the recursion, return (final-x . stencil-list)
- (if (null? remaining)
- (cons (+ prev-x space) (reverse stencils))
-
- (case (car remaining)
- ((1 0 -1) ; Pedal up/neutral/down
- (let* ((p (car remaining))
- (stencil (make-filled-box-stencil
- (box-x-dimensions prev-x p space)
- (box-y-dimensions prev-x p space)))
- (pedal-stencil
- (if circled
- (ellipse-stencil stencil circle-thickness
- circle-x-padding circle-y-padding)
- stencil))
- (new-prev-x (+ prev-x space box-width)))
- (process-pedal (cdr remaining) new-prev-x
- (cons pedal-stencil stencils) #f space)))
- ((#\|) ; Divider line
- (let* ((xpos (+ prev-x space))
- (stencil (divider-stencil xpos))
- (new-prev-x (+ prev-x space)))
- (process-pedal (cdr remaining) new-prev-x
- (cons stencil stencils)
- circled spaceafterdivider)))
- ((#\o) ; Next pedal should be circled
- (process-pedal (cdr remaining) prev-x stencils #t space))
- (else
- (ly:warning "Unhandled entry in harp-pedal: ~a"
- (car remaining))
- (process-pedal (cdr remaining)
- prev-x stencils circled space))))))
- (final-x (car result))
- (stencils (cdr result)))
- ; Add the horizontal line and combine all stencils:
- (apply ly:stencil-add
- (cons
- (make-line-stencil line-width 0 0 final-x 0)
- stencils))))
-