;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 / blobdiff