* scm/define-markup-commands.scm (text): add \text markup command.

[lilypond.git] / scm / output-lib.scm

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 759727bb06962b5c76f1680d5020e1844cba7aff..5ef27d02c2c450985e659ee3e432798ad221fc0e 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -15,11 +15,13 @@
 ;; The TabNoteHead tablatureFormat callback.
 ;; Compute the text grob-property
 (define-public (fret-number-tablature-format string tuning pitch)
-  (number->string
-   (- (ly:pitch-semitones pitch)
-      (list-ref tuning
-               ;; remove 1 because list index starts at 0 and guitar string at 1. 
-                (- string 1)))))
+  (make-whiteout-markup
+   (make-vcenter-markup  
+    (number->string
+     (- (ly:pitch-semitones pitch)
+       (list-ref tuning
+                 ;; remove 1 because list index starts at 0 and guitar string at 1. 
+                 (- string 1)))))))
 
 ;; The 5-string banjo has got a extra string, the fifth (duh), wich
 ;; starts at the fifth fret on the neck. Frets on the fifth string
@@ -28,11 +30,13 @@
 ;;   on the banjo neck.
 ;; We solve this by defining a new fret-number-tablature function:
 (define-public (fret-number-tablature-format-banjo string tuning pitch)
+  (make-whiteout-markup
+   (make-vcenter-markup  
     (let ((fret (- (ly:pitch-semitones pitch) (list-ref tuning (- string 1)))))
-        (number->string (cond
-            ((and (> fret 0) (= string 5))
-                (+ fret 5))
-            (else fret)))))
+      (number->string (cond
+                      ((and (> fret 0) (= string 5))
+                       (+ fret 5))
+                      (else fret)))))))
 
 (define-public (hammer-print-function grob)
   (let* ((note-collums (ly:grob-property grob 'note-columns))
@@ -64,12 +68,13 @@
       (let ((x (/ (- (cdr (ly:stencil-extent slur 0)) 
                      (/ (cdr (ly:stencil-extent text 0)) 2.0))
                   -2.0)))
-       
-        (ly:stencil-set-extent! text 0 (cons x x))
-        (ly:stencil-align-to! text 0 1)))))
-
-;; (ly:stencil-combine-at-edge slur 1 1 text -0.6)
 
+       (set! text
+             (ly:make-stencil (ly:stencil-expr text)
+                              (cons x x)
+                              (ly:stencil-extent text Y)))
+       
+        (ly:stencil-aligned-to text X RIGHT)))))
 
 
 (define-public guitar-tuning '(4 -1 -5 -10 -15 -20))
@@ -91,23 +96,13 @@
 
 ;;; end of tablature functions
 
+(define-public (make-stencil-boxer thickness padding callback)
+  "Return function that adds a box around the grob passed as argument."
+  (lambda (grob) (box-stencil (callback grob) thickness padding)))
 
-(define-public (make-stencil-boxer line-thick x-padding y-padding callback)
-  "Makes a routine that adds a box around the grob parsed as argument"
-  (define (stencil-boxer grob)
-    (let* ((mol (callback grob))
-          (x-ext (interval-widen (ly:stencil-extent mol 0) x-padding))
-          (y-ext (interval-widen (ly:stencil-extent mol 1) y-padding))
-          (x-rule (make-filled-box-stencil (interval-widen x-ext line-thick)
-                                           (cons 0 line-thick)))
-          (y-rule (make-filled-box-stencil (cons 0 line-thick) y-ext)))
-      
-      (set! mol (ly:stencil-combine-at-edge mol 0 1 y-rule x-padding))
-      (set! mol (ly:stencil-combine-at-edge mol 0 -1 y-rule x-padding))
-      (set! mol (ly:stencil-combine-at-edge mol 1 1 x-rule 0))  
-      (set! mol (ly:stencil-combine-at-edge mol 1 -1 x-rule 0))
-      mol))
-  stencil-boxer)
+(define-public (make-stencil-circler thickness padding callback)
+  "Return function that adds a circle around the grob passed as argument."
+  (lambda (grob) (circle-stencil (callback grob) thickness padding)))
 
 (define-public (arg->string arg)
   (cond ((number? arg) (ly:inexact->string arg 10))
@@ -115,21 +110,15 @@
        ((symbol? arg) (string-append "\"" (symbol->string arg) "\""))))
 
 (define-public (print-circled-text-callback grob)
-  (let*
-      ((text (ly:grob-property grob 'text))
-       (layout (ly:grob-layout grob))
-       (defs (ly:output-def-lookup layout 'text-font-defaults))
-       (props (ly:grob-alist-chain grob defs))
-       (circle (Text_interface::interpret_markup layout props 
-                                                (make-circle-markup
-                                                 1.0 0.1)))
-       (text-stencil
-       (Text_interface::interpret_markup layout props text)))
-
-    (ly:stencil-align-to! text-stencil X CENTER)
-    (ly:stencil-align-to! text-stencil Y CENTER)
-    (ly:stencil-add text-stencil circle)
-  ))
+  (let* ((text (ly:grob-property grob 'text))
+        (layout (ly:grob-layout grob))
+        (defs (ly:output-def-lookup layout 'text-font-defaults))
+        (props (ly:grob-alist-chain grob defs))
+        (circle (Text_interface::interpret_markup
+                 layout props (make-draw-circle-markup 0.8 0.1 #f)))
+        (text-stencil (Text_interface::interpret_markup layout props text)))
+    
+    (ly:stencil-add (centered-stencil text-stencil) circle)))
 
 
 ;;(define (mm-to-pt x)
@@ -173,6 +162,10 @@
         (number->string duration)))
     ((mensural)
      (string-append (number->string duration) (symbol->string style)))
+    ((petrucci)
+     (if (< duration 0)
+        (string-append (number->string duration) "mensural")
+        (string-append (number->string duration) (symbol->string style))))
     ((neomensural)
      (string-append (number->string duration) (symbol->string style)))
     ((default)
@@ -258,7 +251,7 @@ centered, X==1 is at the right, X == -1 is at the left."
                         ("bracket" . (() . "bracket"))  ))))
 
     (if (equal? result #f)
-       (ly:warn "Unknown bar glyph: `~S'" glyph)
+       (ly:warning (_ "unknown bar glyph: `~S'" glyph))
        (index-cell (cdr result) dir))))
 
 (define-public (shift-right-at-line-begin g)
@@ -289,3 +282,20 @@ centered, X==1 is at the right, X == -1 is at the left."
 (define-public darkcyan    '(0.5 0.5 0.0))
 (define-public darkmagenta '(0.5 0.0 0.5))
 (define-public darkyellow  '(0.0 0.5 0.5))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Pitch Trill Heads
+
+(define (parenthesize-elements grob)
+  (let*
+      ((elts (ly:grob-property grob 'elements))
+       (x-ext (ly:relative-group-extent elts grob X))
+       (font (ly:grob-default-font grob))
+       (lp (ly:font-get-glyph font "accidentals.leftparen"))
+       (rp (ly:font-get-glyph font "accidentals.rightparen"))
+       (padding 0.1))
+
+    (ly:stencil-add
+     (ly:stencil-translate-axis lp (- (car x-ext) padding) X)
+     (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X))
+  ))