Makes Kievan notation more modular.
--- /dev/null
+\version "2.17.4"
+
+\header {
+ texidoc = "LilyPond typesets Kievan notation.
+"
+}
+
+\score {
+ <<
+ \new KievanVoice = "melody" \transpose c c' {
+ \cadenzaOn
+ c4 c8 c8[ d8] c4 c2 b,\longa
+ \bar "k"
+ }
+ \new Lyrics \lyricsto "melody" {
+ Го -- спо -- ди по -- ми -- луй.
+ }
+ >>
+}
ragged-right = ##t
}
-pattern = <<
- \new Voice {
+pattern =
+#(define-music-function (parser location name style) (markup? ly:context-mod?)
+#{ <<
+ s1^#name
+ \new Voice \with #style {
\override Stem.direction = #UP
e'4 e'2. e'1 e'\breve*1/2 e'\longa*1/4
}
- \new Voice {
+ \new Voice \with #style {
\override Stem.direction = #DOWN
g4 g2. g1 g\breve*1/2 g\longa*1/4
}
->>
+>> #})
+patternStyle =
+#(define-music-function (parser location style) (symbol?)
+ #{
+ \pattern #(symbol->string style) \with {
+ \override NoteHead.style = #style
+ }
+ #})
\transpose c c {
\clef C
- \override Staff.NoteHead.style = #'default
- s1*0^\markup { "default" }
- \pattern
-
- \override Staff.NoteHead.style = #'altdefault
- s1*0^\markup { "altdefault" }
- \pattern
+ \patternStyle default
+ \patternStyle altdefault
\break
- \override Staff.NoteHead.style = #'baroque
- s1*0^\markup { "baroque" }
- \pattern
-
- \override Staff.NoteHead.style = #'neomensural
- s1*0^\markup { "neomensural" }
- \pattern
+ \patternStyle baroque
+ \patternStyle neomensural
\break
- \override Staff.NoteHead.style = #'mensural
- s1*0^\markup { "mensural" }
- \pattern
-
- \override Staff.NoteHead.style = #'petrucci
- s1*0^\markup { "petrucci" }
- \pattern
+ \patternStyle mensural
+ \patternStyle petrucci
\break
- \override Staff.NoteHead.style = #'harmonic
- s1*0^\markup { "harmonic" }
- \pattern
-
- \override Staff.NoteHead.style = #'harmonic-black
- s1*0^\markup { "harmonic-black" }
- \pattern
+ \patternStyle harmonic
+ \patternStyle harmonic-black
\break
- \override Staff.NoteHead.style = #'harmonic-mixed
- s1*0^\markup { "harmonic-mixed" }
- \pattern
-
- \override Staff.NoteHead.style = #'diamond
- s1*0^\markup { "diamond" }
- \pattern
+ \patternStyle harmonic-mixed
+ \patternStyle diamond
\break
- \override Staff.NoteHead.style = #'cross
- s1*0^\markup { "cross" }
- \pattern
-
- \override Staff.NoteHead.style = #'xcircle
- s1*0^\markup { "xcircle" }
- \pattern
+ \patternStyle cross
+ \patternStyle xcircle
\break
- \override Staff.NoteHead.style = #'triangle
- s1*0^\markup { "triangle" }
- \pattern
-
- \override Staff.NoteHead.style = #'slash
- s1*0^\markup { "slash" }
- \pattern
+ \patternStyle triangle
+ \patternStyle slash
\break
- \override Staff.NoteHead.style = #'kievan
- s1*0^\markup { "kievan" }
- \pattern
+ \pattern "kievan" \with { \kievanOn }
}
DECLARE_SCHEME_CALLBACK (offset_callback, (SCM element));
DECLARE_SCHEME_CALLBACK (calc_direction, (SCM));
DECLARE_SCHEME_CALLBACK (calc_beaming, (SCM));
+ DECLARE_SCHEME_CALLBACK (calc_length, (SCM));
+ DECLARE_SCHEME_CALLBACK (pure_calc_length, (SCM, SCM, SCM));
DECLARE_SCHEME_CALLBACK (calc_stem_begin_position, (SCM));
DECLARE_SCHEME_CALLBACK (pure_calc_stem_begin_position, (SCM, SCM, SCM));
DECLARE_SCHEME_CALLBACK (calc_stem_end_position, (SCM));
if (!head_count (me))
return false;
- extract_grob_set (me, "note-heads", heads);
- SCM style = heads[0]->get_property ("style");
- return style != ly_symbol2scm ("kievan") && scm_to_int (me->get_property ("duration-log")) >= 1;
+ return scm_to_int (me->get_property ("duration-log")) >= 1;
}
MAKE_SCHEME_CALLBACK (Stem, pure_height, 3)
return pos;
}
+
+MAKE_SCHEME_CALLBACK (Stem, pure_calc_length, 3);
+SCM
+Stem::pure_calc_length (SCM smob, SCM /*start*/, SCM /*end*/)
+{
+ Grob *me = unsmob_grob (smob);
+ Real beg = robust_scm2double (me->get_pure_property ("stem-begin-position", 0, INT_MAX), 0.0);
+ Real res = fabs (internal_calc_stem_end_position (me, false) - beg);
+ return scm_from_double (res);
+}
+
+MAKE_SCHEME_CALLBACK (Stem, calc_length, 1);
+SCM
+Stem::calc_length (SCM smob)
+{
+ Grob *me = unsmob_grob (smob);
+ if (unsmob_grob (me->get_object ("beam")))
+ {
+ me->programming_error ("ly:stem::calc-length called but will not be used for beamed stem.");
+ return scm_from_double (0.0);
+ }
+
+ Real beg = robust_scm2double (me->get_property ("stem-begin-position"), 0.0);
+ Real res = fabs (internal_calc_stem_end_position (me, true) - beg);
+ return scm_from_double (res);
+}
+
bool
Stem::is_valid_stem (Grob *me)
{
%% Set glyph styles.
\override NoteHead.style = #'kievan
+ \override Stem.X-offset = #stem::kievan-offset-callback
+ \override Stem.stencil = ##f
+ \override Flag.stencil = ##f
\override Rest.style = #'mensural
\override Accidental.glyph-name-alist = #alteration-kievan-glyph-name-alist
\override Dots.style = #'kievan
\override Slur.stencil = ##f
+ \override Stem.length = #0.0
+ \override Beam.positions = #beam::get-kievan-positions
+ \override Beam.quantized-positions = #beam::get-kievan-quantized-positions
+ \override NoteHead.duration-log = #note-head::calc-kievan-duration-log
%% There are beams in Kievan notation, but they are invoked manually
autoBeaming = ##f
\revert AccidentalCautionary.stencil
}
+%% kievan
+kievanOn = {
+ \override NoteHead.style = #'kievan
+ \override Stem.X-offset = #stem::kievan-offset-callback
+ \override Stem.stencil = ##f
+ \override Flag.stencil = ##f
+ \override Rest.style = #'mensural
+ \override Accidental.glyph-name-alist = #alteration-kievan-glyph-name-alist
+ \override Dots.style = #'kievan
+ \override Slur.stencil = ##f
+ \override Stem.length = #0.0
+ \override Beam.positions = #beam::get-kievan-positions
+ \override Beam.quantized-positions = #beam::get-kievan-quantized-positions
+ \override NoteHead.duration-log = #note-head::calc-kievan-duration-log
+}
+kievanOff = {
+ \revert NoteHead.style
+ \revert Stem.X-offset
+ \revert Stem.stencil
+ \revert Rest.style
+ \revert Accidental.glyph-name-alist
+ \revert Dots.style
+ \revert Slur.stencil
+ \revert Flag.stencil
+ \revert Stem.length
+ \revert Beam.positions
+ \revert Beam.quantized-positions
+ \revert NoteHead.duration-log
+}
%% merging
(beam-gap . ,ly:beam::calc-beam-gap)
(minimum-length . ,ly:beam::calc-minimum-length)
(neutral-direction . ,DOWN)
- (positions . ,beam::get-positions)
+ (positions . ,beam::place-broken-parts-individually)
(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 . ,beam::get-quantized-positions)
+ (quantized-positions . ,ly:beam::set-stem-lengths)
(shorten . ,ly:beam::calc-stem-shorten)
(vertical-skylines . ,ly:grob::vertical-skylines-from-stencil)
(direction . ,ly:stem::calc-direction)
(duration-log . ,stem::calc-duration-log)
- (length . ,stem::length)
+ (length . ,ly:stem::calc-length)
(neutral-direction . ,DOWN)
(positioning-done . ,ly:stem::calc-positioning-done)
(stem-info . ,ly:stem::calc-stem-info)
(,ly:slur::outside-slur-callback . ,ly:slur::pure-outside-slur-callback)
(,ly:stem::calc-stem-begin-position . ,ly:stem::pure-calc-stem-begin-position)
(,ly:stem::calc-stem-end-position . ,ly:stem::pure-calc-stem-end-position)
- (,stem::length . ,stem::pure-length)
+ (,ly:stem::calc-length . ,ly:stem::pure-calc-length)
(,ly:stem::height . ,ly:stem::pure-height)
(,ly:stem-tremolo::calc-y-offset . ,ly:stem-tremolo::pure-calc-y-offset)
(,ly:system::height . ,ly:system::calc-pure-height)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; beam slope
+;; even though kievan noteheads do not have stems, their
+;; invisible stems help with beam placement
+;; this assures that invisible stems for kievan notes are aligned
+;; to the center of kievan noteheads. that is thus where the beams'
+;; x extrema will fall
+(define-public (stem::kievan-offset-callback grob)
+ (let* ((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)
+ '()))
+ (note-head-w (if (not (null? first-note-head))
+ (ly:grob-extent first-note-head first-note-head X)
+ '(0 . 0))))
+ (interval-center note-head-w)))
+
+
;; 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))))
+(define-public (beam::get-kievan-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)
+ '()))
+ (next-stem (if (not (null? stems))
+ (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))
+ (first-nh-height (ly:grob::stencil-height first-note-head))
+ (next-nh-height (ly:grob::stencil-height next-note-head))
+ (left-height (if (= direction DOWN)
+ (+ (car first-nh-height) 0.75)
+ (- (cdr first-nh-height) 0.75)))
+ (right-height (if (= direction DOWN)
+ (+ (car next-nh-height) 0.75)
+ (- (cdr next-nh-height) 0.75))))
+ (cons (+ left-pos left-height) (+ right-pos right-height))))
+
+(define-public (beam::get-kievan-quantized-positions grob)
+ (let* ((pos (ly:grob-property grob 'positions))
+ (stems (ly:grob-object grob 'stems))
+ (stems-grobs (if (not (null? stems))
+ (ly:grob-array->list stems)
+ '())))
+ (for-each
+ (lambda (g)
+ (ly:grob-set-property! g 'stem-begin-position 0)
+ (ly:grob-set-property! g 'length 0))
+ stems-grobs)
+ pos))
;; calculates each slope of a broken beam individually
(define-public (beam::place-broken-parts-individually grob)
(ly:duration-log
(ly:event-property (event-cause grob) 'duration)))
-(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))
- (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)))))
-
-(define-public (stem::pure-length grob beg end)
- (let* ((ss (ly:staff-symbol-staff-space grob))
- (beg (ly:grob-pure-property grob 'stem-begin-position 0 1000)))
- (abs (- (ly:stem::pure-calc-stem-end-position grob 0 2147483646) beg))))
-
(define (stem-stub::do-calculations grob)
(and (ly:grob-property (ly:grob-parent grob X) 'cross-staff)
(not (ly:grob-property (ly:grob-parent grob X) 'transparent))))
(if (interval-empty? (interval-intersection stem_ph my_ph)) #f (coord-translate stem_ph dist)))
#f))
-;; FIXME: NEED TO FIND A BETTER WAY TO HANDLE KIEVAN NOTATION
+(define-public (note-head::calc-kievan-duration-log grob)
+ (min 3
+ (ly:duration-log
+ (ly:event-property (event-cause grob) 'duration))))
+
(define-public (note-head::calc-duration-log grob)
- (let ((style (ly:grob-property grob 'style)))
- (if (and (symbol? style) (string-match "kievan*" (symbol->string style)))
- (min 3
- (ly:duration-log
- (ly:event-property (event-cause grob) 'duration)))
- (min 2
- (ly:duration-log
- (ly:event-property (event-cause grob) 'duration))))))
+ (min 2
+ (ly:duration-log
+ (ly:event-property (event-cause grob) 'duration))))
(define-public (dots::calc-dot-count grob)
(ly:duration-dot-count
projects / lilypond.git / commitdiff