* scm/output-gnome.scm:

* scm/output-svg.scm: Fix font scaling.

diff --git a/ChangeLog b/ChangeLog
index 58cd7e701159d22514aa6992b6ef81cc807f1df6..25f78f26d9d9029aa99bdac7eac118e719bcc480 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-03-02  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+       * scm/output-gnome.scm:
+       * scm/output-svg.scm: Fix font scaling.
+
 2005-03-01  Jan Nieuwenhuizen  <janneke@gnu.org>
 
        * ly/titling-init.ly (tagline): Use Engraving.  Add comment about

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 85bf5db019dbe36baf5f627ed9d8dce96469551a..7f32974b7f7093787f084e860b8b2084db24647b 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -269,6 +269,10 @@ possibly turned off."
   (apply format (cons (current-error-port) (cons string rest)))
   (force-output (current-error-port)))
 
+(define-public (debugf string . rest)
+  (if #f
+      (apply stderr (cons string rest))))
+
 (define (index-cell cell dir)
   (if (equal? dir 1)
       (cdr cell)
@@ -305,20 +309,28 @@ possibly turned off."
    ((equal? (ly:unit) "pt") (/ 72.0 72.27))
    (else (error "unknown unit" (ly:unit)))))
 
-;;; font
+;;; FONT may be font smob, or pango font string...
 (define-public (font-name-style font)
-  ;; FIXME: ughr, (ly:font-name) sometimes also has Style appended.
-  (let* ((font-name (ly:font-name font))
-        (full-name (if font-name font-name (ly:font-file-name font)))
-        (name-style (string-split full-name #\-)))
-    ;; FIXME: ughr, barf: feta-alphabet is actually emmentaler
-    (if (string-prefix? "feta-alphabet" full-name)
-       (list "emmentaler"
-             (substring  full-name (string-length "feta-alphabet")))
-       (if (not (null? (cdr name-style)))
+      ;; FIXME: ughr, (ly:font-name) sometimes also has Style appended.
+      (let* ((font-name (ly:font-name font))
+            (full-name (if font-name font-name (ly:font-file-name font)))
+            (name-style (string-split full-name #\-)))
+       ;; FIXME: ughr, barf: feta-alphabet is actually emmentaler
+       (if (string-prefix? "feta-alphabet" full-name)
+           (list "emmentaler"
+                 (substring  full-name (string-length "feta-alphabet")))
+           (if (not (null? (cdr name-style)))
            name-style
            (append name-style '("Regular"))))))
 
+(define-public (font-size font)
+  (let* ((designsize (ly:font-design-size font))
+        (magnification (* (ly:font-magnification font)))
+        (scaling (* magnification designsize)))
+    (debugf "scaling:~S\n" scaling)
+    (debugf "magnification:~S\n" magnification)
+    (debugf "design:~S\n" designsize)
+    scaling))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm
index df46b48b61a780eb4b61b06c181e0df26bd30763..83ce839bae5ee07f72aa99a8d9c1a6b52b272281 100644 (file)
--- a/scm/output-gnome.scm
+++ b/scm/output-gnome.scm
@@ -4,10 +4,8 @@
 ;;;; 
 ;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
 
-;;; TODO:
-;;;
-;;;  * font selection: name, size, design size
-;;;  * font scaling
+;;;; TODO:
+;;;;
 ;;;;  * .cff MUST NOT be in fc's fontpath.
 ;;;;    - workaround: remove mf/out from ~/.fonts.conf,
 ;;;;      instead add ~/.fonts and symlink all /mf/out/*otf there.
@@ -108,9 +106,6 @@ lilypond -fgnome input/simple-song.ly
   (apply format (cons (current-error-port) (cons string rest)))
   (force-output (current-error-port)))
 
-(define (debugf string . rest)
-  (if #f
-      (apply stderr (cons string rest))))
 
 (define (utf8 i)
   (cond
@@ -144,23 +139,19 @@ lilypond -fgnome input/simple-song.ly
     (string=? (substring family 0 (min (string-length family) 10))
              "emmentaler")))
 
+;;; FONT may be font smob, or pango font string
 (define (pango-font-name font)
-  (debugf "FONT-NAME:~S:~S\n" (ly:font-name font) (ly:font-design-size font))
-  (debugf (apply format (append '(#f "PANGO-NAME:~a, ~a\n") (font-name-style font))))
-  (apply format (append '(#f "~a, ~a") (font-name-style font))))
-
-(define (pango-font-size font)
-  (let* ((designsize (ly:font-design-size font))
-        (magnification (* (ly:font-magnification font)))
-        ;; FIXME
-        ;;(scaling (* output-scale magnification designsize)))
-        (scaling (* 1.4 output-scale magnification designsize)))
-    ;;(debugf "OPS:~S\n" ops)
-    (debugf "scaling:~S\n" scaling)
-    (debugf "magnification:~S\n" magnification)
-    (debugf "design:~S\n" designsize)
-    
-    scaling))
+  (if (string? font)
+      (list font "Regular")
+      (apply format (append '(#f "~a, ~a") (font-name-style font)))))
+
+;;; FONT may be font smob, or pango font string
+(define (canvas-font-size font)
+  ;; FIXME: 1.85?
+  (* 1.85
+     (if (string? font)
+        12
+        (* output-scale (font-size font)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Wrappers from guile-gnome TLA
@@ -329,10 +320,11 @@ lilypond -fgnome input/simple-song.ly
      (placebox (car x) (cadr x)
               (make <gnome-canvas-text>
                 #:parent (canvas-root)
+                ;;#:x 0.0 #:y (if (music-font? font) 0.15 0.69)
                 #:x 0.0 #:y 0.0
                 #:anchor 'west
                 #:font (pango-font-name font)
-                #:size-points 12
+                #:size-points (canvas-font-size font)
                 #:size-set #t
                 #:text
                 (integer->utf8-string
@@ -389,20 +381,12 @@ lilypond -fgnome input/simple-song.ly
       #:join-style 'round)))
 
 (define (text font s)
-  (debugf "FONT:~S\n" font)
-  (debugf "FONT:~S\n" (pango-font-name font))
-
   (make <gnome-canvas-text>
     #:parent (canvas-root)
-    ;; ugh, experimental placement corections
-    ;; #:x 0.0 #:y 0.0
-    #:x 0.0 #:y (if (music-font? font) 0.15 0.69)
+    #:x 0.0 #:y 0.0
     #:anchor (if (music-font? font) 'west 'south-west)
     #:font (pango-font-name font)
-    ;; FIXME: points
-    #:size-points (pango-font-size font)
-    ;;  or pixels?
-;;    #:size (inexact->exact (round (pango-font-size font)))
+    #:size-points (canvas-font-size font)
     #:size-set #t
     #:text (if (integer? s)
               (integer->utf8-string s)
@@ -414,6 +398,6 @@ lilypond -fgnome input/simple-song.ly
     #:x 0.0 #:y 0.0
     #:anchor 'west
     #:font pango-font-description
-    #:size-points 12
+    #:size-points (canvas-font-size pango-font-description)
     #:size-set #t
     #:text string))

diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 78c7cc2a4b76b208ad9e4d9908092aeef6dc85cc..6df234922d8081a0341672028da440f1c8514371 100644 (file)
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -8,7 +8,6 @@
 ;;;; http://www.w3.org/TR/SVG12/ -- page, pageSet in draft
 
 ;;;; TODO:
-;;;;  * font selection: name, size, design size
 ;;;;  * .cff MUST NOT be in fc's fontpath.
 ;;;;    - workaround: remove mf/out from ~/.fonts.conf,
 ;;;;      instead add ~/.fonts and symlink all /mf/out/*otf there.
@@ -32,10 +31,6 @@
 ;; FIXME: 2?
 (define output-scale (* 2 scale-to-unit))
 
-(define (debugf string . rest)
-  (if #f
-      (apply stderr (cons string rest))))
-
 (define (dispatch expr)
   (let ((keyword (car expr)))
     (cond
@@ -86,15 +81,6 @@
 (define (sqr x)
   (* x x))
 
-(define (font-size font)
-  (let* ((designsize (ly:font-design-size font))
-        (magnification (* (ly:font-magnification font)))
-        (scaling (* output-scale magnification designsize)))
-    (debugf "scaling:~S\n" scaling)
-    (debugf "magnification:~S\n" magnification)
-    (debugf "design:~S\n" designsize)
-    scaling))
-
 (define (integer->entity integer)
   (format #f "&#x~x;" integer))
 
@@ -105,17 +91,21 @@
   (apply string-append
         (map (lambda (x) (char->entity x)) (string->list string))))
 
-;; FIXME: font can be pango font-name or smob
-;;        determine size and style properly.
+;;; FONT may be font smob, or pango font string
 (define (svg-font font)
-  (let ((name-style (if (string? font) (list font "Regular")
+  (let ((name-style (if (string? font)
+                       (list font "Regular")
                        (font-name-style font)))
-       (size (if (string? font) 12 (font-size font)))
-       (anchor "west"))
-    (format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;"
-           (car name-style)
-           (cadr name-style)
-           size anchor)))
+           (size (svg-font-size font))
+           (anchor "west"))
+       (format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;"
+               (car name-style) (cadr name-style) size anchor)))
+
+;;; FONT may be font smob, or pango font string
+(define (svg-font-size font)
+  (if (string? font)
+      12
+      (* output-scale (font-size font))))
 
 (define (fontify font expr)
    (entity 'text expr (cons 'style (svg-font font))))