test direction override too.

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 39f16ea5261b67b9d7580b1e0e34affcc4caa12d..62b43cebc260a13f4f2ec3402c99ba9475dbe4df 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 (define-public (stack-stencils axis dir padding stils)
   "Stack stencils STILS in direction AXIS, DIR, using PADDING."
@@ -100,9 +100,16 @@ encloses the contents.
         (y-ext (ly:stencil-extent stencil 1))
         (diameter (max (- (cdr x-ext) (car x-ext))
                        (- (cdr y-ext) (car y-ext))))
-        (radius (+ (/ diameter 2) padding thickness)))
+        (radius (+ (/ diameter 2) padding thickness))
+        (circle (make-circle-stencil radius thickness #f)))
+
     (ly:stencil-add
-     (centered-stencil stencil) (make-circle-stencil radius thickness #f))))
+     stencil
+     (ly:stencil-translate circle
+                          (cons
+                           (interval-center x-ext)
+                           (interval-center y-ext))))))
+
 
 (define-public (fontify-text font-metric text)
   "Set TEXT with font FONT-METRIC, returning a stencil."
@@ -111,13 +118,32 @@ encloses the contents.
      `(text ,font-metric ,text) (car b) (cdr b))))
      
 (define-public (fontify-text-white scale font-metric text)
-  "Set TEXT with scale factor s"
+  "Set TEXT with scale factor SCALE"
   (let* ((b (ly:text-dimension font-metric text))
         ;;urg -- workaround for using ps font
          (c `(white-text ,(* 2 scale) ,text)))
     ;;urg -- extent is not from ps font, but we hope it's close
     (ly:make-stencil c (car b) (cdr b))))
 
+(define-public (stencil-with-color stencil color)
+  (ly:make-stencil
+   (list 'color color (ly:stencil-expr stencil))
+   (ly:stencil-extent stencil X)
+   (ly:stencil-extent stencil Y)))
+  
+(define-public (stencil-whiteout stencil)
+  (let*
+      ((x-ext (ly:stencil-extent stencil X))
+       (y-ext (ly:stencil-extent stencil Y))
+
+       )
+    
+    (ly:stencil-add
+     (stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
+                        white)
+     stencil)
+    ))
+
 (define-public (dimension-arrows destination) 
   "Draw twosided arrow from here to @var{destination}"
   
@@ -279,6 +305,7 @@ grestore
          (write-system-signatures basename (cdr paper-systems) (1+ count))))))
 
 
+(use-modules (scm paper-system))
 (define-public (write-system-signature filename paper-system)
   (define (float? x)
     (and (number? x) (inexact? x)))
@@ -309,14 +336,6 @@ grestore
              rest))
        expr))
   
-  (define (music-cause grob)
-    (let*
-       ((cause (ly:grob-property  grob 'cause)))
-      
-      (cond
-       ((ly:music? cause) cause)
-       ((ly:grob? cause) (music-cause cause))
-       (else #f))))
 
   (define (pythonic-string expr)
     "escape quotes and slashes for python consumption"
@@ -325,14 +344,23 @@ grestore
   (define (pythonic-pair expr)
     (format "(~a,~a)"
            (car expr) (cdr expr)))
-                   
+
+
+  (define (raw-string expr)
+    "escape quotes and slashes for python consumption"
+    (regexp-substitute/global #f "[@\n]" (format "~a" expr) 'pre " " 'post))
+
+  (define (raw-pair expr)
+    (format "~a ~a"
+           (car expr) (cdr expr)))
+  
   (define (found-grob expr)
     (let*
        ((grob (car expr))
         (rest (cdr expr))
         (collected '())
-        (cause (music-cause grob))
-        (input (if (ly:music? cause) (ly:music-property cause 'origin) #f))
+        (cause (event-cause grob))
+        (input (if (ly:stream-event? cause) (ly:event-property cause 'origin) #f))
         (location (if (ly:input-location? input) (ly:input-file-line-char-column input) '()))
 
         (x-ext (ly:grob-extent grob system-grob X))
@@ -344,12 +372,12 @@ grestore
                               rest)
 
       (format output
-             "['~a', '~a', ~a, ~a, '~a'],\n"
+             "~a@~a@~a@~a@~a\n"
              (cdr (assq 'name (ly:grob-property grob 'meta) ))
-             (pythonic-string location)
-             (pythonic-pair (if (interval-empty? x-ext) '(1 . -1) x-ext))
-             (pythonic-pair (if (interval-empty? y-ext) '(1 . -1) y-ext))
-             (pythonic-string collected))
+             (raw-string location)
+             (raw-pair (if (interval-empty? x-ext) '(1 . -1) x-ext))
+             (raw-pair (if (interval-empty? y-ext) '(1 . -1) y-ext))
+             (raw-string collected))
       ))
 
   (define (interpret-for-signature escape collect expr)
@@ -379,5 +407,8 @@ grestore
                 output)
        (interpret-for-signature found-grob (lambda (x) #f)
                                 (ly:stencil-expr
-                                 (paper-system-stencil paper-system))))))
+                                 (paper-system-stencil paper-system)))))
+
+  ;; should be superfluous, but leaking "too many open files"?
+  (close-port output))