Fix some bugs in the dynamic engraver and PostScript backend

[lilypond.git] / scm / define-markup-commands.scm

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index a127c9030f2046a63db5ef005649dffeeb1b71aa..1a940b13834e8c2dd79b0b60a367b82c9a1b28f2 100644 (file)
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -118,6 +118,12 @@ circle of diameter 0 (ie sharp corners)."
   (ly:round-filled-box
    xext yext blot))
 
+(define-markup-command (rotate layout props ang arg) (number? markup?)
+  "Rotate object with @var{ang} degrees around its center."
+  (let* ((stil (interpret-markup layout props arg)))
+    (ly:stencil-rotate stil ang 0 0)))
+
+
 (define-markup-command (whiteout layout props arg) (markup?)
   "Provide a white underground for @var{arg}"
   (let* ((stil (interpret-markup layout props
@@ -679,7 +685,8 @@ alignment accordingly."
                     x y)))
 
 
-(define-markup-command (pad-to-box layout props x-ext y-ext arg) (number-pair? number-pair? markup?)
+(define-markup-command (pad-to-box layout props x-ext y-ext arg)
+  (number-pair? number-pair? markup?)
   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space"
 
   (let*
@@ -692,6 +699,17 @@ alignment accordingly."
                     (interval-union y-ext y))))
 
 
+(define-markup-command (hcenter-in layout props length arg)
+  (number? markup?)
+  "Center @var{arg} horizontally within a box of extending
+@var{length}/2 to the left and right."
+
+  (interpret-markup layout props
+                   (make-pad-to-box-markup
+                    (cons (/ length -2) (/ length 2))
+                    '(0 . 0)
+                    (make-hcenter-markup arg))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property
@@ -1134,24 +1152,47 @@ figured bass notation"
 (define-markup-command (note-by-number layout props log dot-count dir) (number? number? number?)
   "Construct a note symbol, with stem.  By using fractional values for
 @var{dir}, you can obtain longer or shorter stems."
+  (define (get-glyph-name-candidates dir log style)
+    (map (lambda (dir-name)
+     (format "noteheads.~a~a~a" dir-name (min log 2)
+            (if (and (symbol? style)
+                     (not (equal? 'default style)))
+                (symbol->string style)
+                "")))
+        (list (if (= dir UP) "u" "d")
+              "s")))
+                  
+  (define (get-glyph-name font cands)
+    (if (null? cands)
+     ""
+     (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
+        (get-glyph-name font (cdr cands))
+        (car cands))))
+    
   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
-        (size (chain-assoc-get 'font-size props 0))
-         (stem-length (* (magstep size) (max 3 (- log 1))))
-         (head-glyph (ly:font-get-glyph
-                     font
-                     (string-append "noteheads.s" (number->string (min log 2)))))
-         (stem-thickness 0.13) ;; TODO: should scale with font-size. 
+        (size-factor (magstep (chain-assoc-get 'font-size props 0)))
+        (style (chain-assoc-get 'style props '()))
+         (stem-length (*  size-factor (max 3 (- log 1))))
+         (head-glyph-name (get-glyph-name font (get-glyph-name-candidates dir log style)))
+         (head-glyph (ly:font-get-glyph font head-glyph-name))
+        (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
+         (stem-thickness (* size-factor 0.13))
          (stemy (* dir stem-length))
-         (attachx (if (> dir 0)
-                      (- (cdr (ly:stencil-extent head-glyph X)) stem-thickness)
-                      0))
-         (attachy (* (magstep size) (* dir 0.28)))
+         (attach-off (cons (interval-index
+                           (ly:stencil-extent head-glyph X)
+                           (* dir (car attach-indices)))
+                          (* dir       ; fixme, this is inconsistent between X & Y.
+                             (interval-index
+                              (ly:stencil-extent head-glyph Y)
+                              (cdr attach-indices)))))
          (stem-glyph (and (> log 0)
                          (ly:round-filled-box
-                          (cons attachx (+ attachx  stem-thickness))
-                          (cons (min stemy attachy)
-                                (max stemy attachy))
+                          (ordered-cons (car attach-off)
+                                        (+ (car attach-off)  (* (- dir) stem-thickness)))
+                          (cons (min stemy (cdr attach-off))
+                                (max stemy (cdr attach-off)))
                           (/ stem-thickness 3))))
+        
          (dot (ly:font-get-glyph font "dots.dot"))
          (dotwid (interval-length (ly:stencil-extent dot X)))
          (dots (and (> dot-count 0)
@@ -1166,7 +1207,7 @@ figured bass notation"
                                          (string-append "flags."
                                                         (if (> dir 0) "u" "d")
                                                         (number->string log)))
-                       (cons (+ attachx (/ stem-thickness 2)) stemy)))))
+                       (cons (+ (car attach-off) (/ stem-thickness 2)) stemy)))))
     (if flaggl
         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
     (if (ly:stencil? stem-glyph)
@@ -1226,6 +1267,17 @@ A negative @var{amount} indicates raising, see also @code{\\raise}.
                             (- amount) Y))
 
 
+(define-markup-command (translate-scaled layout props offset arg) (number-pair? markup?)
+  "Translate @var{arg} by @var{offset}, scaling the offset by the @code{font-size}."
+
+  (let*
+      ((factor (magstep (chain-assoc-get 'font-size props 0)))
+       (scaled (cons (* factor (car offset))
+                    (* factor (cdr offset)))))
+    
+  (ly:stencil-translate (interpret-markup layout props arg)
+                       scaled)))
+
 (define-markup-command (raise layout props amount arg) (number? markup?)
   "
 Raise @var{arg}, by the distance @var{amount}.