From c8a2b2102813a6556090a228771eaecef6f0b19c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 2 Mar 2005 10:00:33 +0000 Subject: [PATCH] * scm/output-gnome.scm: * scm/output-svg.scm: Fix font scaling. --- ChangeLog | 5 ++++ scm/lily-library.scm | 32 ++++++++++++++++++-------- scm/output-gnome.scm | 54 ++++++++++++++++---------------------------- scm/output-svg.scm | 36 +++++++++++------------------ 4 files changed, 59 insertions(+), 68 deletions(-) diff --git a/ChangeLog b/ChangeLog index 58cd7e7011..25f78f26d9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2005-03-02 Jan Nieuwenhuizen + + * scm/output-gnome.scm: + * scm/output-svg.scm: Fix font scaling. + 2005-03-01 Jan Nieuwenhuizen * ly/titling-init.ly (tagline): Use Engraving. Add comment about diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 85bf5db019..7f32974b7f 100644 --- 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 df46b48b61..83ce839bae 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -4,10 +4,8 @@ ;;;; ;;;; (c) 2004--2005 Jan Nieuwenhuizen -;;; 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 #: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 #: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 78c7cc2a4b..6df234922d 100644 --- 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)))) -- 2.39.2