* scm/output-svg.scm: Fix font scaling.
+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
(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)
((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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (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.
(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
(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
(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
#: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)
#: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))
;;;; 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.
;; 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
(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))
(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))))