(define-public (select-head-glyph style log)
"Select a note head glyph string based on note head style @var{style}
and duration-log @var{log}."
- (case style
- ;; "default" style is directly handled in note-head.cc as a
- ;; special case (HW says, mainly for performance reasons).
- ;; Therefore, style "default" does not appear in this case
- ;; statement. -- jr
- ((xcircle) "2xcircle")
- ((harmonic) "0harmonic")
- ((harmonic-black) "2harmonic")
- ((harmonic-mixed) (if (<= log 1) "0harmonic"
- "2harmonic"))
- ((baroque)
- ;; Oops, I actually would not call this "baroque", but, for
- ;; backwards compatibility to 1.4, this is supposed to take
- ;; brevis, longa and maxima from the neo-mensural font and all
- ;; other note heads from the default font. -- jr
- (if (< log 0)
- (string-append (number->string log) "neomensural")
- (number->string log)))
- ((altdefault)
- ;; Like default, but brevis is drawn with double vertical lines
- (if (= log -1)
- (string-append (number->string log) "double")
- (number->string log)))
- ((mensural)
- (string-append (number->string log) (symbol->string style)))
- ((petrucci)
- (if (< log 0)
- (string-append (number->string log) "mensural")
- (string-append (number->string log) (symbol->string style))))
- ((blackpetrucci)
- (if (< log 0)
- (string-append (number->string log) "blackmensural")
- (string-append (number->string log) (symbol->string style))))
- ((semipetrucci)
- (if (< log 0)
- (string-append (number->string log) "semimensural")
- (string-append (number->string log) "petrucci")))
- ((neomensural)
- (string-append (number->string log) (symbol->string style)))
- ((kievan)
- (string-append (number->string log) "kievan"))
- (else
- (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
- (symbol->string style)
- (string-append (number->string (max 0 log))
- (symbol->string style))))))
+ (if (symbol? style)
+ (case style
+ ;; "default" style is directly handled in note-head.cc as a
+ ;; special case (HW says, mainly for performance reasons).
+ ;; Therefore, style "default" does not appear in this case
+ ;; statement. -- jr
+ ;; Though we not to care if style is '(), see below. -- harm
+ ((xcircle) "2xcircle")
+ ((harmonic) "0harmonic")
+ ((harmonic-black) "2harmonic")
+ ((harmonic-mixed) (if (<= log 1) "0harmonic"
+ "2harmonic"))
+ ((baroque)
+ ;; Oops, I actually would not call this "baroque", but, for
+ ;; backwards compatibility to 1.4, this is supposed to take
+ ;; brevis, longa and maxima from the neo-mensural font and all
+ ;; other note heads from the default font. -- jr
+ (if (< log 0)
+ (string-append (number->string log) "neomensural")
+ (number->string log)))
+ ((altdefault)
+ ;; Like default, but brevis is drawn with double vertical lines
+ (if (= log -1)
+ (string-append (number->string log) "double")
+ (number->string log)))
+ ((mensural)
+ (string-append (number->string log) (symbol->string style)))
+ ((petrucci)
+ (if (< log 0)
+ (string-append (number->string log) "mensural")
+ (string-append (number->string log) (symbol->string style))))
+ ((blackpetrucci)
+ (if (< log 0)
+ (string-append (number->string log) "blackmensural")
+ (string-append (number->string log) (symbol->string style))))
+ ((semipetrucci)
+ (if (< log 0)
+ (string-append (number->string log) "semimensural")
+ (string-append (number->string log) "petrucci")))
+ ((neomensural)
+ (string-append (number->string log) (symbol->string style)))
+ ((kievan)
+ (string-append (number->string log) "kievan"))
+ (else
+ (if (string-match "vaticana*|hufnagel*|medicaea*"
+ (symbol->string style))
+ (symbol->string style)
+ (string-append (number->string (max 0 log))
+ (symbol->string style)))))
+ ;; 'vaticana-ligature-interface has a 'glyph-name-property for NoteHead.
+ ;; Probably best to return an empty list here, if called in a context
+ ;; without setting 'style, i.e. 'style is '(), to avoid a scheme-error.
+ '()))
(define-public (note-head::calc-glyph-name grob)
(let* ((style (ly:grob-property grob 'style))
- (log (if (string-match "kievan*" (symbol->string style))
+ (log (if (and (symbol? style)
+ (string-match "kievan*" (symbol->string style)))
(min 3 (ly:grob-property grob 'duration-log))
(min 2 (ly:grob-property grob 'duration-log)))))
(select-head-glyph style log)))
(ly:stencil-aligned-to
(make-parenthesis-stencil y-extent
half-thickness
- (- width)
- angularity)
+ width
+ angularity
+ -1)
Y CENTER)
X RIGHT))
(lp-x-extent
(make-parenthesis-stencil y-extent
half-thickness
width
- angularity)
+ angularity
+ 1)
Y CENTER)
X LEFT))
(rp-x-extent
callback itself, or an unpure-pure-container).
Function @var{func} accepts a grob and returns a value that is added
-to the value resulting from @var{data}. Optional arguments @var{plus}
-and @var{valid?} default to @code{+} and @code{number?} respectively
-and allow for using a different underlying accumulation/type.
+to the value resulting from @var{data}. Optional argument @var{plus}
+defaults to @code{+} but may be changed to allow for using a different
+underlying accumulation.
If @var{data} is @code{#f} or @code{'()}, it is not included in the sum."
(cond ((or (not data) (null? data))
func)
- ((or (ly:unpure-pure-container func)
- (ly:unpure-pure-container data))
+ ((or (ly:unpure-pure-container? func)
+ (ly:unpure-pure-container? data))
(ly:make-unpure-pure-container
(lambda rest
(plus (apply ly:unpure-call func rest)
(define-public (stroke-finger::calc-text grob)
(let ((event (event-cause grob)))
(or (ly:event-property event 'text #f)
- (vector-ref (ly:grob-property grob 'digit-names)
- (1- (max 1
- (min 5 (ly:event-property event 'digit))))))))
+ (let ((digit-names (ly:grob-property grob 'digit-names)))
+ (vector-ref digit-names
+ (1- (max 1
+ (min (vector-length digit-names)
+ (ly:event-property event 'digit)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; outer let to trigger suicide
(let ((sten (ly:hairpin::print grob)))
(if (grob::is-live? grob)
- (let* ((decresc? (eq? (ly:grob-property grob 'grow-direction) LEFT))
+ (let* ((decresc? (eqv? (ly:grob-property grob 'grow-direction) LEFT))
(thick (ly:grob-property grob 'thickness 0.1))
(thick (* thick (layout-line-thickness grob)))
(xex (ly:stencil-extent sten X))
the extents of @code{BreakAlignment} grobs associated with the left and
right bounds of a @code{MeasureCounter} spanner. Broken measures are
numbered in parentheses."
- (let* ((num (markup (number->string (ly:grob-property grob 'count-from))))
+ (let* ((num (make-simple-markup
+ (number->string (ly:grob-property grob 'count-from))))
(orig (ly:grob-original grob))
(siblings (ly:spanner-broken-into orig)) ; have we been split?
(num
X)))
num))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HorizontalBracketText
+
+(define-public (ly:horizontal-bracket-text::print grob)
+ (let ((text (ly:grob-property grob 'text)))
+ (if (or (null? text)
+ (equal? text "")
+ (equal? text empty-markup))
+ (begin
+ (ly:grob-suicide! grob)
+ '())
+ (let* ((orig (ly:grob-original grob))
+ (siblings (ly:spanner-broken-into orig))
+ (text
+ (if (or (null? siblings)
+ (eq? grob (car siblings)))
+ text
+ (if (string? text)
+ (string-append "(" text ")")
+ (make-parenthesize-markup text)))))
+ (grob-interpret-markup grob text)))))
+
+(define-public (ly:horizontal-bracket-text::calc-direction grob)
+ (let* ((bracket (ly:grob-object grob 'bracket))
+ (bracket-dir (ly:grob-property bracket 'direction DOWN)))
+ bracket-dir))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; make-engraver helper macro
projects / lilypond.git / blobdiff