X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=5d96ecb179be690a0930a48c51ec4dfb72cddc8e;hb=34da245dd0722ef0c6fb4afef935c18549aef146;hp=745b42f940c005527d58369dc4cc9d99d09c670b;hpb=21a579724638e56c6b473bc80112b74712ad6349;p=lilypond.git

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 745b42f940..5d96ecb179 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -127,17 +127,7 @@ circle of diameter 0 (ie sharp corners)."
 
 (define-markup-command (whiteout layout props arg) (markup?)
   "Provide a white underground for @var{arg}"
-  (let* ((stil (interpret-markup layout props arg))
-	 (white
-	  (interpret-markup layout props
-			    (make-with-color-markup
-			     white
-			     (make-filled-box-markup
-			      (ly:stencil-extent stil X)
-			      (ly:stencil-extent stil Y)
-			      0.0)))))
-
-    (ly:stencil-add white stil)))
+  (stencil-whiteout (interpret-markup layout props arg)))
 
 (define-markup-command (pad-markup layout props padding arg) (number? markup?)
   "Add space around a markup object."
@@ -416,6 +406,28 @@ determines the space between each markup in @var{args}."
      space
      (remove ly:stencil-empty? stencils))))
 
+(define-markup-command (concat layout props args) (markup-list?)
+  "Concatenate @var{args} in a horizontal line, without spaces inbetween.
+Strings and simple markups are concatenated on the input level, allowing
+ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
+equivalent to @code{\"fi\"}."
+
+  (define (concat-string-args arg-list)
+    (fold-right (lambda (arg result-list)
+                  (let ((result (if (pair? result-list)
+                                    (car result-list)
+                                  '())))
+                    (if (and (pair? arg) (eqv? (car arg) simple-markup))
+                      (set! arg (cadr arg)))
+                    (if (and (string? result) (string? arg))
+                        (cons (string-append arg result) (cdr result-list))
+                      (cons arg result-list))))
+                '()
+                arg-list))
+
+  (interpret-markup layout
+                    (prepend-alist-chain 'word-space 0 props)
+                    (make-line-markup (concat-string-args args))))
 
 (define (wordwrap-stencils stencils
 			   justify base-space line-width text-dir)
@@ -577,7 +589,7 @@ line-width, where X is the number of staff spaces."
       (ly:make-stencil '()  '(1 . -1) '(1 . -1)))))
 
 (define-markup-command (justify-field layout props symbol) (symbol?)
--   (let* ((m (chain-assoc-get symbol props)))
+   (let* ((m (chain-assoc-get symbol props)))
      (if (string? m)
       (interpret-markup layout props
        (list justify-string-markup m))
@@ -1227,7 +1239,7 @@ figured bass notation"
          (stem-glyph (and (> log 0)
 			  (ly:round-filled-box
 			   (ordered-cons (car attach-off)
-					 (+ (car attach-off)  (* (- dir) stem-thickness)))
+					 (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
 			   (cons (min stemy (cdr attach-off))
 				 (max stemy (cdr attach-off)))
 			   (/ stem-thickness 3))))
@@ -1339,21 +1351,26 @@ and/or @code{extra-offset} properties. "
 (define-markup-command (fraction layout props arg1 arg2) (markup? markup?)
   "Make a fraction of two markups."
   (let* ((m1 (interpret-markup layout props arg1))
-         (m2 (interpret-markup layout props arg2)))
+         (m2 (interpret-markup layout props arg2))
+         (factor (magstep (chain-assoc-get 'font-size props 0)))
+         (boxdimen (cons (* factor -0.05) (* factor 0.05)))
+         (padding (* factor 0.2))
+         (baseline (* factor 0.6))
+         (offset (* factor 0.75)))
     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
     (let* ((x1 (ly:stencil-extent m1 X))
            (x2 (ly:stencil-extent m2 X))
-           (line (ly:round-filled-box (interval-union x1 x2) '(-0.05 . 0.05) 0.0))
+           (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
            ;; should stack mols separately, to maintain LINE on baseline
-           (stack (stack-lines -1 0.2 0.6 (list m1 line m2))))
+           (stack (stack-lines DOWN padding baseline (list m1 line m2))))
       (set! stack
 	    (ly:stencil-aligned-to stack Y CENTER))
       (set! stack
 	    (ly:stencil-aligned-to stack X LEFT))
       ;; should have EX dimension
       ;; empirical anyway
-      (ly:stencil-translate-axis stack 0.75 Y))))
+      (ly:stencil-translate-axis stack offset Y))))