X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=5dbc5d2f5254b61bd4e3bd4c42b4143807501812;hb=7d870a2890deabfa746d2c17038a00fa9afb8897;hp=789ae29f7139803e35d7097c2e23c1b4881bf33c;hpb=7b215091cc974bd45e068563c826f77bd9faea9b;p=lilypond.git

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 789ae29f71..5dbc5d2f52 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2000--2009  Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2011  Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -45,27 +45,19 @@
 ;;;     using `chain-assoc-get' (more on that below)
 ;;;
 ;;;   args...
-;;;     the command arguments. There are restrictions on the
-;;;     possible arguments for a markup command.
-;;;     First, arguments are distinguished according to their type:
-;;;       1) a markup (or a string), corresponding to type predicate `markup?'
-;;;       2) a list of markups, corresponding to type predicate `markup-list?'
-;;;       3) any scheme object, corresponding to type predicates such as
-;;;       `list?', 'number?', 'boolean?', etc.
-;;;     The supported arrangements of arguments, according to their type, are:
-;;;       - no argument
-;;;       - markup
-;;;       - scheme
-;;;       - markup, markup
-;;;       - markup-list
-;;;       - scheme, scheme
-;;;       - scheme, markup
-;;;       - scheme, scheme, markup
-;;;       - scheme, scheme, markup, markup
-;;;       - scheme, markup, markup
-;;;       - scheme, scheme, scheme
-;;;     This combinations are hard-coded in the lexer and in the parser
-;;;     (lily/lexer.ll and lily/parser.yy)
+;;;     the command arguments.
+;;;     There is no limitation on the order of command arguments.
+;;;     However, markup functions taking a markup as their last
+;;;     argument are somewhat special as you can apply them to a
+;;;     markup list, and the result is a markup list where the
+;;;     markup function (with the specified leading arguments) has
+;;;     been applied to every element of the original markup list.
+;;;
+;;;     Since replicating the leading arguments for applying a
+;;;     markup function to a markup list is cheap mostly for
+;;;     Scheme arguments, you avoid performance pitfalls by just
+;;;     using Scheme arguments for the leading arguments of markup
+;;;     functions that take a markup as their last argument.
 ;;;
 ;;;   args-signature
 ;;;     the arguments signature, i.e. a list of type predicates which
@@ -277,30 +269,31 @@ Create a beam with the specified parameters.
 (define-markup-command (underline layout props arg)
   (markup?)
   #:category font
-  #:properties ((thickness 1))
+  #:properties ((thickness 1) (offset 2))
   "
 @cindex underlining text
 
 Underline @var{arg}.  Looks at @code{thickness} to determine line
-thickness and y-offset.
+thickness, and @code{offset} to determine line y-offset.
 
 @lilypond[verbatim,quote]
-\\markup {
-  default
-  \\hspace #2
-  \\override #'(thickness . 2)
-  \\underline {
-    underline
-  }
+\\markup \\fill-line {
+  \\underline \"underlined\"
+  \\override #'(offset . 5)
+  \\override #'(thickness . 1)
+  \\underline \"underlined\"
+  \\override #'(offset . 1)
+  \\override #'(thickness . 5)
+  \\underline \"underlined\"
 }
 @end lilypond"
-  (let* ((thick (* (ly:output-def-lookup layout 'line-thickness)
-                   thickness))
+  (let* ((thick (ly:output-def-lookup layout 'line-thickness))
+         (underline-thick (* thickness thick))
          (markup (interpret-markup layout props arg))
          (x1 (car (ly:stencil-extent markup X)))
          (x2 (cdr (ly:stencil-extent markup X)))
-         (y (* thick -2))
-         (line (make-line-stencil thick x1 y x2 y)))
+         (y (* thick (- offset)))
+         (line (make-line-stencil underline-thick x1 y x2 y)))
     (ly:stencil-add markup line)))
 
 (define-markup-command (box layout props arg)
@@ -477,6 +470,7 @@ Create a box of the same height as the space in the current font."
 (define-markup-command (hspace layout props amount)
   (number?)
   #:category align
+  #:properties ((word-space))
   "
 @cindex creating horizontal spaces in text
 
@@ -491,9 +485,10 @@ Create an invisible object taking up horizontal space @var{amount}.
   three
 }
 @end lilypond"
-  (if (> amount 0)
-      (ly:make-stencil "" (cons 0 amount) '(-1 . 1))
-      (ly:make-stencil "" (cons amount amount) '(-1 . 1))))
+  (let ((corrected-space (- amount word-space)))
+    (if (> corrected-space 0)
+	(ly:make-stencil "" (cons 0 corrected-space) '(0 . 0))
+	(ly:make-stencil "" (cons corrected-space corrected-space) '(0 . 0)))))
 
 ;; todo: fix negative space
 (define-markup-command (vspace layout props amount)
@@ -518,8 +513,8 @@ of @var{amount} multiplied by 3.
 @end lilypond"
   (let ((amount (* amount 3.0)))
     (if (> amount 0)
-        (ly:make-stencil "" (cons -1 1) (cons 0 amount))
-        (ly:make-stencil "" (cons -1 1) (cons amount amount)))))
+        (ly:make-stencil "" (cons 0 0) (cons 0 amount))
+        (ly:make-stencil "" (cons 0 0) (cons amount amount)))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -618,6 +613,137 @@ grestore
 		 str))
    '(0 . 0) '(0 . 0)))
 
+(define-markup-command (path layout props thickness commands) (number? list?)
+  #:category graphic
+  #:properties ((line-cap-style 'round)
+		(line-join-style 'round)
+		(filled #f))
+  "
+@cindex paths, drawing
+@cindex drawing paths
+Draws a path with line thickness @var{thickness} according to the
+directions given in @var{commands}.  @var{commands} is a list of
+lists where the @code{car} of each sublist is a drawing command and
+the @code{cdr} comprises the associated arguments for each command.
+
+Line-cap styles and line-join styles may be customized by
+overriding the @code{line-cap-style} and @code{line-join-style}
+properties, respectively.  Available line-cap styles are
+@code{'butt}, @code{'round}, and @code{'square}.  Available
+line-join styles are @code{'miter}, @code{'round}, and
+@code{'bevel}.
+
+The property @code{filled} specifies whether or not the path is
+filled with color.
+
+There are seven commands available to use in the list
+@code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto},
+@code{rlineto}, @code{curveto}, @code{rcurveto}, and
+@code{closepath}.  Note that the commands that begin with @emph{r}
+are the relative variants of the other three commands.
+
+The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and
+@code{rlineto} take 2 arguments; they are the X and Y coordinates
+for the destination point.
+
+The commands @code{curveto} and @code{rcurveto} create cubic
+Bézier curves, and take 6 arguments; the first two are the X and Y
+coordinates for the first control point, the second two are the X
+and Y coordinates for the second control point, and the last two
+are the X and Y coordinates for the destination point.
+
+The @code{closepath} command takes zero arguments and closes the
+current subpath in the active path.
+
+Note that a sequence of commands @emph{must} begin with a
+@code{moveto} or @code{rmoveto} to work with the SVG output.
+
+@lilypond[verbatim,quote]
+samplePath =
+  #'((moveto 0 0)
+     (lineto -1 1)
+     (lineto 1 1)
+     (lineto 1 -1)
+     (curveto -5 -5 -5 5 -1 0)
+     (closepath))
+
+\\markup {
+  \\path #0.25 #samplePath
+}
+@end lilypond"
+  (let* ((half-thickness (/ thickness 2))
+	 (current-point '(0 . 0))
+	 (set-point (lambda (lst) (set! current-point lst)))
+	 (relative? (lambda (x)
+		      (string-prefix? "r" (symbol->string (car x)))))
+	 ;; For calculating extents, we want to modify the command
+	 ;; list so that all coordinates are absolute.
+	 (new-commands (map (lambda (x)
+			      (cond
+				;; for rmoveto, rlineto
+				((and (relative? x) (eq? 3 (length x)))
+				 (let ((cp (cons
+					     (+ (car current-point)
+						(second x))
+					     (+ (cdr current-point)
+						(third x)))))
+				   (set-point cp)
+				   (list (car cp)
+					 (cdr cp))))
+				;; for rcurveto
+				((and (relative? x) (eq? 7 (length x)))
+				 (let* ((old-cp current-point)
+					(cp (cons
+					      (+ (car old-cp)
+						 (sixth x))
+					      (+ (cdr old-cp)
+						 (seventh x)))))
+				   (set-point cp)
+				   (list (+ (car old-cp) (second x))
+					 (+ (cdr old-cp) (third x))
+					 (+ (car old-cp) (fourth x))
+					 (+ (cdr old-cp) (fifth x))
+					 (car cp)
+					 (cdr cp))))
+				;; for moveto, lineto
+				((eq? 3 (length x))
+				 (set-point (cons (second x)
+						  (third x)))
+				 (drop x 1))
+				;; for curveto
+				((eq? 7 (length x))
+				 (set-point (cons (sixth x)
+						  (seventh x)))
+				 (drop x 1))
+				;; keep closepath for filtering;
+				;; see `without-closepath'.
+				(else x)))
+			    commands))
+	 ;; path-min-max does not accept 0-arg lists,
+	 ;; and since closepath does not affect extents, filter
+	 ;; out those commands here.
+	 (without-closepath (filter (lambda (x)
+				      (not (equal? 'closepath (car x))))
+				    new-commands))
+	 (extents (path-min-max
+		    ;; set the origin to the first moveto
+		    (list (list-ref (car without-closepath) 0)
+			  (list-ref (car without-closepath) 1))
+		    without-closepath))
+	 (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
+	 (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
+	 (command-list (fold-right append '() commands)))
+
+    ;; account for line thickness
+    (set! X-extent (interval-widen X-extent half-thickness))
+    (set! Y-extent (interval-widen Y-extent half-thickness))
+
+    (ly:make-stencil
+      `(path ,thickness `(,@',command-list)
+	     ',line-cap-style ',line-join-style ,filled)
+      X-extent
+      Y-extent)))
+
 (define-markup-command (score layout props score)
   (ly:score?)
   #:category music
@@ -751,14 +877,16 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols.
   (make-simple-markup ""))
 
 ;; helper for justifying lines.
-(define (get-fill-space word-count line-width text-widths)
+(define (get-fill-space word-count line-width word-space text-widths)
   "Calculate the necessary paddings between each two adjacent texts.
-	The lengths of all texts are stored in @var{text-widths}.
-	The normal formula for the padding between texts a and b is:
-	padding = line-width/(word-count - 1) - (length(a) + length(b))/2
-	The first and last padding have to be calculated specially using the
-	whole length of the first or last text.
-	Return a list of paddings."
+  The lengths of all texts are stored in @var{text-widths}.
+  The normal formula for the padding between texts a and b is:
+  padding = line-width/(word-count - 1) - (length(a) + length(b))/2
+  The first and last padding have to be calculated specially using the
+  whole length of the first or last text.
+  All paddings are checked to be at least word-space, to ensure that
+  no texts collide.
+  Return a list of paddings."
   (cond
    ((null? text-widths) '())
 
@@ -767,23 +895,27 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols.
     (cons
      (- (- (/ line-width (1- word-count)) (car text-widths))
 	(/ (car (cdr text-widths)) 2))
-     (get-fill-space word-count line-width (cdr text-widths))))
+     (get-fill-space word-count line-width word-space (cdr text-widths))))
    ;; special case last padding
    ((= (length text-widths) 2)
     (list (- (/ line-width (1- word-count))
 	     (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
    (else
-    (cons
-     (- (/ line-width (1- word-count))
-	(/ (+ (car text-widths) (car (cdr text-widths))) 2))
-     (get-fill-space word-count line-width (cdr text-widths))))))
+    (let ((default-padding
+            (- (/ line-width (1- word-count))
+               (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
+      (cons
+       (if (> word-space default-padding)
+           word-space
+           default-padding)
+       (get-fill-space word-count line-width word-space (cdr text-widths)))))))
 
 (define-markup-command (fill-line layout props args)
   (markup-list?)
   #:category align
   #:properties ((text-direction RIGHT)
-		(word-space 1)
-		(line-width #f))
+                (word-space 0.6)
+                (line-width #f))
   "Put @var{markups} in a horizontal line of width @var{line-width}.
 The markups are spaced or flushed to fill the entire line.
 If there are no arguments, return an empty stencil.
@@ -806,52 +938,58 @@ If there are no arguments, return an empty stencil.
 }
 @end lilypond"
   (let* ((orig-stencils (interpret-markup-list layout props args))
-	 (stencils
-	  (map (lambda (stc)
-		 (if (ly:stencil-empty? stc)
-		     point-stencil
-		     stc)) orig-stencils))
-	 (text-widths
-	  (map (lambda (stc)
-		 (if (ly:stencil-empty? stc)
-		     0.0
-		     (interval-length (ly:stencil-extent stc X))))
-	       stencils))
-	 (text-width (apply + text-widths))
-	 (word-count (length stencils))
-	 (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
-	 (fill-space
-	 	(cond
-			((= word-count 1)
-				(list
-					(/ (- line-width text-width) 2)
-					(/ (- line-width text-width) 2)))
-			((= word-count 2)
-				(list
-					(- line-width text-width)))
-			(else
-				(get-fill-space word-count line-width text-widths))))
-	 (fill-space-normal
-	  (map (lambda (x)
-		 (if (< x word-space)
-		     word-space
-		     x))
-	       fill-space))
-
-	 (line-stencils (if (= word-count 1)
-			    (list
-			     point-stencil
-			     (car stencils)
-			     point-stencil)
-			    stencils)))
-
-    (if (= text-direction LEFT)
-	(set! line-stencils (reverse line-stencils)))
+         (stencils
+          (map (lambda (stc)
+                 (if (ly:stencil-empty? stc)
+                     point-stencil
+                     stc)) orig-stencils))
+         (text-widths
+          (map (lambda (stc)
+                 (if (ly:stencil-empty? stc)
+                     0.0
+                     (interval-length (ly:stencil-extent stc X))))
+               stencils))
+         (text-width (apply + text-widths))
+         (word-count (length stencils))
+         (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
+         (fill-space
+          (cond
+           ((= word-count 1)
+            (list
+             (/ (- line-width text-width) 2)
+             (/ (- line-width text-width) 2)))
+           ((= word-count 2)
+            (list
+             (- line-width text-width)))
+           (else
+            (get-fill-space word-count line-width word-space text-widths))))
+
+         (line-contents (if (= word-count 1)
+                            (list
+                             point-stencil
+                             (car stencils)
+                             point-stencil)
+                            stencils)))
 
     (if (null? (remove ly:stencil-empty? orig-stencils))
-	empty-stencil
-	(stack-stencils-padding-list X
-				     RIGHT fill-space-normal line-stencils))))
+        empty-stencil
+        (begin
+          (if (= text-direction LEFT)
+              (set! line-contents (reverse line-contents)))
+          (set! line-contents
+                (stack-stencils-padding-list
+                 X RIGHT fill-space line-contents))
+          (if (> word-count 1)
+              ;; shift s.t. stencils align on the left edge, even if
+              ;; first stencil had negative X-extent (e.g. center-column)
+              ;; (if word-count = 1, X-extents are already normalized in
+              ;; the definition of line-contents)
+              (set! line-contents
+                    (ly:stencil-translate-axis
+                     line-contents
+                     (- (car (ly:stencil-extent (car stencils) X)))
+                     X)))
+          line-contents))))
 
 (define-markup-command (line layout props args)
   (markup-list?)
@@ -1781,7 +1919,7 @@ may be any property supported by @rinternals{font-interface},
 }
 @end lilypond"
   (interpret-markup layout
-                    (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
+                    (cons '((font-size . -5) (font-encoding . fetaText)) props)
                     arg))
 
 (define-markup-command (abs-fontsize layout props size arg)
@@ -1909,7 +2047,7 @@ some punctuation; it has no letters.
   }
 }
 @end lilypond"
-  (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
+  (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
 
 (define-markup-command (roman layout props arg)
   (markup?)
@@ -2114,7 +2252,7 @@ done in a different font.  The recommended font for this is bold and italic.
 }
 @end lilypond"
   (interpret-markup
-   layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
+   layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
 
 (define-markup-command (text layout props arg)
   (markup?)
@@ -2241,6 +2379,32 @@ normal text font, no matter what font was used earlier.
 ;; symbols.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define-markup-command (musicglyph layout props glyph-name)
+  (string?)
+  #:category music
+  "@var{glyph-name} is converted to a musical symbol; for example,
+@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
+the music font.  See @ruser{The Feta font} for a complete listing of
+the possible glyphs.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\musicglyph #\"f\"
+  \\musicglyph #\"rests.2\"
+  \\musicglyph #\"clefs.G_change\"
+}
+@end lilypond"
+  (let* ((font (ly:paper-get-font layout
+				  (cons '((font-encoding . fetaMusic)
+					  (font-name . #f))
+
+						 props)))
+	 (glyph (ly:font-get-glyph font glyph-name)))
+    (if (null? (ly:stencil-expr glyph))
+	(ly:warning (_ "Cannot find glyph ~a") glyph-name))
+
+    glyph))
+
 (define-markup-command (doublesharp layout props)
   ()
   #:category music
@@ -2408,33 +2572,6 @@ Use the filled head if @var{filled} is specified.
 				     props))
      name)))
 
-(define-markup-command (musicglyph layout props glyph-name)
-  (string?)
-  #:category music
-  "@var{glyph-name} is converted to a musical symbol; for example,
-@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
-the music font.  See @ruser{The Feta font} for a complete listing of
-the possible glyphs.
-
-@lilypond[verbatim,quote]
-\\markup {
-  \\musicglyph #\"f\"
-  \\musicglyph #\"rests.2\"
-  \\musicglyph #\"clefs.G_change\"
-}
-@end lilypond"
-  (let* ((font (ly:paper-get-font layout
-				  (cons '((font-encoding . fetaMusic)
-					  (font-name . #f))
-
-						 props)))
-	 (glyph (ly:font-get-glyph font glyph-name)))
-    (if (null? (ly:stencil-expr glyph))
-	(ly:warning (_ "Cannot find glyph ~a") glyph-name))
-
-    glyph))
-
-
 (define-markup-command (lookup layout props glyph-name)
   (string?)
   #:category other
@@ -2557,7 +2694,7 @@ and continue with double letters.
          ; backward slashes might use slope and point in the other direction!
          (dy (* mag (if forward 0.4 -0.4)))
          (number-stencil (interpret-markup layout
-                                           (prepend-alist-chain 'font-encoding 'fetaNumber props)
+                                           (prepend-alist-chain 'font-encoding 'fetaText props)
                                            (number->string num)))
          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
          (center (interval-center (ly:stencil-extent number-stencil Y)))
@@ -2622,36 +2759,39 @@ figured bass notation.
   (slashed-digit-internal layout props num #f font-size thickness))
 
 ;; eyeglasses
-(define eyeglassesps
-     "0.15 setlinewidth
-      -0.9 0 translate
-      1.1 1.1 scale
-      1.2 0.7 moveto
-      0.7 0.7 0.5 0 361 arc
-      stroke
-      2.20 0.70 0.50 0 361 arc
-      stroke
-      1.45 0.85 0.30 0 180 arc
-      stroke
-      0.20 0.70 moveto
-      0.80 2.00 lineto
-      0.92 2.26 1.30 2.40 1.15 1.70 curveto
-      stroke
-      2.70 0.70 moveto
-      3.30 2.00 lineto
-      3.42 2.26 3.80 2.40 3.65 1.70 curveto
-      stroke")
+(define eyeglassespath
+  '((moveto 0.42 0.77)
+    (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
+    (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
+    (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
+    (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
+    (closepath)
+    (moveto 2.07 0.77)
+    (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
+    (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
+    (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
+    (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
+    (closepath)
+    (moveto 1.025 0.935)
+    (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
+    (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
+    (moveto -0.68 0.77)
+    (rlineto 0.66 1.43)
+    (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
+    (moveto 2.07 0.77)
+    (rlineto 0.66 1.43)
+    (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
 
 (define-markup-command (eyeglasses layout props)
-  () 
+  ()
   #:category other
   "Prints out eyeglasses, indicating strongly to look at the conductor.
 @lilypond[verbatim,quote]
 \\markup { \\eyeglasses }
 @end lilypond"
   (interpret-markup layout props
-    (make-with-dimensions-markup '(-0.61 . 3.22) '(0.2 . 2.41)
-      (make-postscript-markup eyeglassesps))))
+    (make-override-markup '(line-cap-style . butt)
+      (make-path-markup 0.15 eyeglassespath))))
 
 (define-markup-command (left-brace layout props size)
   (number?)
@@ -3146,6 +3286,53 @@ Draw vertical brackets around @var{arg}.
         (m (interpret-markup layout props arg)))
     (bracketify-stencil m Y th (* 2.5 th) th)))
 
+(define-markup-command (parenthesize layout props arg)
+  (markup?)
+  #:category graphic
+  #:properties ((angularity 0)
+		(padding)
+		(size 1)
+		(thickness 1)
+		(width 0.25))
+  "
+@cindex placing parentheses around text
+
+Draw parentheses around @var{arg}.  This is useful for parenthesizing
+a column containing several lines of text.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\line {
+    \\parenthesize {
+      \\column {
+        foo
+        bar
+      }
+    }
+    \\override #'(angularity . 2) {
+      \\parenthesize {
+        \\column {
+          bah
+          baz
+        }
+      }
+    }
+  }
+}
+@end lilypond"
+  (let* ((markup (interpret-markup layout props arg))
+	 (scaled-width (* size width))
+	 (scaled-thickness
+	  (* (chain-assoc-get 'line-thickness props 0.1)
+	     thickness))
+	 (half-thickness
+	  (min (* size 0.5 scaled-thickness)
+	       (* (/ 4 3.0) scaled-width)))
+	 (padding (chain-assoc-get 'padding props half-thickness)))
+    (parenthesize-stencil
+     markup half-thickness scaled-width angularity padding)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Delayed markup evaluation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3179,6 +3366,36 @@ when @var{label} is not found."
      x-ext
      y-ext)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; scaling
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-markup-command (scale layout props factor-pair arg)
+  (number-pair? markup?)
+  #:category graphic
+  "
+@cindex scaling markup
+@cindex mirroring markup
+
+Scale @var{arg}.  @var{factor-pair} is a pair of numbers
+representing the scaling-factor in the X and Y axes.
+Negative values may be used to produce mirror images.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\line {
+    \\scale #'(2 . 1)
+    stretched
+    \\scale #'(1 . -1)
+    mirrored
+  }
+}
+@end lilypond"
+  (let ((stil (interpret-markup layout props arg))
+	(sx (car factor-pair))
+	(sy (cdr factor-pair)))
+    (ly:stencil-scale stil sx sy)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Markup list commands
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;