From b66c86c98f3c0a00acab3b4664bb14e0913368a3 Mon Sep 17 00:00:00 2001 From: Aleksandr Andreev Date: Sun, 9 Sep 2012 17:44:16 -0500 Subject: [PATCH] Fix beaming in Kievan notation Issue 2492 --- lily/beam.cc | 12 +++++ scm/define-grobs.scm | 4 +- scm/output-lib.scm | 107 +++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 117 insertions(+), 6 deletions(-) diff --git a/lily/beam.cc b/lily/beam.cc index 32bf7c3bd4..814d5def3c 100644 --- a/lily/beam.cc +++ b/lily/beam.cc @@ -284,6 +284,18 @@ Beam::calc_direction (SCM smob) dir = to_dir (stem->get_property_data ("direction")); else dir = to_dir (stem->get_property ("default-direction")); + + extract_grob_set (stem, "note-heads", heads); + /* default position of Kievan heads with beams is down + placing this here avoids warnings downstream */ + if (heads.size()) + { + if (heads[0]->get_property ("style") == ly_symbol2scm ("kievan")) + { + if (dir == CENTER) + dir = DOWN; + } + } } } diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index cc83a365a8..b66bca7550 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -393,12 +393,12 @@ (beam-gap . ,ly:beam::calc-beam-gap) (minimum-length . ,ly:beam::calc-minimum-length) (neutral-direction . ,DOWN) - (positions . ,beam::place-broken-parts-individually) + (positions . ,beam::get-positions) (springs-and-rods . ,ly:beam::calc-springs-and-rods) (X-positions . ,ly:beam::calc-x-positions) ;; this is a hack to set stem lengths, if positions is set. - (quantized-positions . ,ly:beam::set-stem-lengths) + (quantized-positions . ,beam::get-quantized-positions) (shorten . ,ly:beam::calc-stem-shorten) (vertical-skylines . ,ly:grob::vertical-skylines-from-stencil) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 3ced3354cd..8f81340e6d 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -61,6 +61,93 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; beam slope +;; sets position of beams for Kievan notation +(define-public (beam::get-positions grob) + (let* ((stems (ly:grob-object grob 'stems)) + (stems-grobs (if (not (null? stems)) + (ly:grob-array->list stems) + '())) + (first-stem (if (not (null? stems-grobs)) + (car stems-grobs) + '())) + (note-heads (if (not (null? first-stem)) + (ly:grob-object first-stem 'note-heads) + '())) + (note-heads-grobs (if (not (null? note-heads)) + (ly:grob-array->list note-heads) + '())) + (first-note-head (if (not (null? note-heads-grobs)) + (car note-heads-grobs) + '())) + (style (if (not (null? first-note-head)) + (ly:grob-property first-note-head 'style) + '()))) + (if (and (symbol? style) (string-match "kievan*" (symbol->string style))) + (let* ((next-stem (cadr stems-grobs)) + (next-note-heads (if (not (null? next-stem)) + (ly:grob-object next-stem 'note-heads) + '())) + (next-note-heads-grobs (if (not (null? next-note-heads)) + (ly:grob-array->list next-note-heads) + '())) + (next-note-head (if (not (null? next-note-heads-grobs)) + (car next-note-heads-grobs) + '())) + (left-pos (ly:grob-property first-note-head 'Y-offset)) + (right-pos (ly:grob-property next-note-head 'Y-offset)) + (direction (ly:grob-property grob 'direction)) + (left-height (if (= direction DOWN) + (+ (car (ly:grob::stencil-height first-note-head)) 0.75) + (- (cdr (ly:grob::stencil-height first-note-head)) 0.75))) + (right-height (if (= direction DOWN) + (+ (car (ly:grob::stencil-height next-note-head)) 0.75) + (- (cdr (ly:grob::stencil-height next-note-head)) 0.75)))) + (cons (+ left-pos left-height) (+ right-pos right-height))) + (beam::place-broken-parts-individually grob)))) + +(define-public (beam::get-quantized-positions grob) + (let* ((stems (ly:grob-object grob 'stems)) + (stems-grobs (if (not (null? stems)) + (ly:grob-array->list stems) + '())) + (first-stem (if (not (null? stems-grobs)) + (car stems-grobs) + '())) + (note-heads (if (not (null? first-stem)) + (ly:grob-object first-stem 'note-heads) + '())) + (note-heads-grobs (if (not (null? note-heads)) + (ly:grob-array->list note-heads) + '())) + (first-note-head (if (not (null? note-heads-grobs)) + (car note-heads-grobs) + '())) + (style (if (not (null? first-note-head)) + (ly:grob-property first-note-head 'style) + '()))) + (if (and (symbol? style) (string-match "kievan*" (symbol->string style))) + (let* ((next-stem (cadr stems-grobs)) + (next-note-heads (if (not (null? next-stem)) + (ly:grob-object next-stem 'note-heads) + '())) + (next-note-heads-grobs (if (not (null? next-note-heads)) + (ly:grob-array->list next-note-heads) + '())) + (next-note-head (if (not (null? next-note-heads-grobs)) + (car next-note-heads-grobs) + '())) + (left-pos (ly:grob-property first-note-head 'Y-offset)) + (right-pos (ly:grob-property next-note-head 'Y-offset)) + (direction (ly:grob-property grob 'direction)) + (left-height (if (= direction DOWN) + (+ (car (ly:grob::stencil-height first-note-head)) 0.75) + (- (cdr (ly:grob::stencil-height first-note-head)) 0.75))) + (right-height (if (= direction DOWN) + (+ (car (ly:grob::stencil-height next-note-head)) 0.75) + (- (cdr (ly:grob::stencil-height next-note-head)) 0.75)))) + (cons (+ left-pos left-height) (+ right-pos right-height))) + (ly:beam::set-stem-lengths grob)))) + ;; calculates each slope of a broken beam individually (define-public (beam::place-broken-parts-individually grob) (ly:beam::quanting grob '(+inf.0 . -inf.0) #f)) @@ -119,13 +206,25 @@ (define-public (stem::length grob) (let* ((ss (ly:staff-symbol-staff-space grob)) (beg (ly:grob-property grob 'stem-begin-position)) - (beam (ly:grob-object grob 'beam))) - (if (null? beam) - (abs (- (ly:stem::calc-stem-end-position grob) beg)) + (beam (ly:grob-object grob 'beam)) + (note-heads (ly:grob-object grob 'note-heads)) + (note-heads-grobs (if (not (null? note-heads)) + (ly:grob-array->list note-heads) + '())) + (first-note-head (if (not (null? note-heads-grobs)) + (car note-heads-grobs) + '())) + (style (if (not (null? first-note-head)) + (ly:grob-property first-note-head 'style) + '()))) + (cond + ((and (symbol? style) (string-match "kievan*" (symbol->string style))) 0.0) + ((null? beam) (abs (- (ly:stem::calc-stem-end-position grob) beg))) + (else (begin (ly:programming-error "stem::length called but will not be used for beamed stem.") - 0.0)))) + 0.0))))) (define-public (stem::pure-length grob beg end) (let* ((ss (ly:staff-symbol-staff-space grob)) -- 2.39.5