]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/output-lib.scm
Issue 5064 Let analysis brackets support text
[lilypond.git] / scm / output-lib.scm
index dcec6ae939b162c26c7c0734de5b5095b852d81a..8df9b56ef2489c4bcbd6737c71523016bf405d27 100644 (file)
 (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)))
@@ -1197,7 +1205,7 @@ and draws the stencil based on its coordinates.
   ;; 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))
@@ -1504,7 +1512,8 @@ parent or the parent has no setting."
 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
@@ -1539,6 +1548,33 @@ numbered in parentheses."
              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