* scm/markup.scm:

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

diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm
index 2251f26ca13b5eed29c1789dfea3c52e67c9777b..244b37d4ab683fb489affe82fb05a4bf356da203 100644 (file)
--- a/scm/output-gnome.scm
+++ b/scm/output-gnome.scm
@@ -2,10 +2,15 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c)  2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+
+;;;; 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.
+;;;;    - bug in fontconfig/freetype/pango?
 
-;;; TODO:
-;;;
 ;;;  * check: blot+scaling
 ;;;  * Figure out and fix font scaling and character placement
 ;;;  * EC font package: add missing X font directories and AFMs
@@ -101,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
@@ -118,7 +120,7 @@ lilypond -fgnome input/simple-song.ly
           (list (+ #xe0 x)
                 (+ #x80 (quotient y #x40))
                 (+ #x80 (modulo y #x40))))))
-   (else (begin (stderr "programming-error: utf-8 too big:~x\n" i)
+   (else (begin (stderr "programming-error: utf8 too big:~x\n" i)
                (list (integer->char 32))))))
 
 (define (integer->utf8-string integer)
@@ -133,51 +135,23 @@ lilypond -fgnome input/simple-song.ly
    (map (lambda (x) (char->utf8-string x)) (string->list string))))
 
 (define (music-font? font)
-  (let ((encoding (ly:font-encoding font))
-       (family (font-family font)))
-    (or (memq encoding '(fetaMusic fetaBraces))
-       (string=? (substring family 0 (min (string-length family) 10))
-                 "emmentaler"))))
-
-;; FIXME
-(define-public (otf-name-mangling font family)
-  ;; Hmm, family is emmentaler20/26?
-  (if (string=? (substring family 0 (min (string-length family) 10))
-               "emmentaler")
-      (string-append "LilyPond " (substring family 10))
-      (if (string=? family "aybabtu")
-         "LilyPondBraces"
-         family)))
+  (let ((family (car (font-name-style font))))
+    (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 "FONT-FAMILY:~S:~S\n" (font-family font) (otf-name-mangling font (font-family font)))
-  (otf-name-mangling font (font-family font)))
-
-(define (pango-font-size font)
-  (let* ((designsize (ly:font-design-size font))
-        (magnification (* (ly:font-magnification font)))
-        
-        ;;font-name: "GNU-LilyPond-feta-20"
-        ;;font-file-name: "feta20"
-        ;;pango-font-name: "lilypond-feta, regular 32"
-        ;;OPS:2.61
-        ;;scaling:29.7046771653543
-        ;;magnification:0.569055118110236
-        ;;design:20.0
-        
-        ;; ugh, experimental sizing
-        ;; where does factor ops come from?
-        ;; Hmm, design size: 26/20 
-        (ops 2.60)
-        
-        (scaling (* ops 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 (modified-font-metric-font-scaling font)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Wrappers from guile-gnome TLA
@@ -346,18 +320,18 @@ 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 postscript-font-name
                 #:font (pango-font-name font)
-                #:size-points 12
+                #:size-points (canvas-font-size font)
                 #:size-set #t
                 #:text
                 (integer->utf8-string
                  (ly:font-glyph-name-to-charcode font (caddr x))))))
    x-y-named-glyphs))
 
-(define (grob-cause grob)
+(define (grob-cause offset grob)
   grob)
 
 ;; WTF is this in every backend?
@@ -407,17 +381,24 @@ lilypond -fgnome input/simple-song.ly
       #:join-style 'round)))
 
 (define (text font s)
-
   (make <gnome-canvas-text>
     #:parent (canvas-root)
-    ;; ugh, experimental placement corections
-    ;; #:x 0.0 #:y 0.0
+    ;;#:x 0.0 #:y 0.0
     #:x 0.0 #:y (if (music-font? font) 0.15 0.69)
     #:anchor (if (music-font? font) 'west 'south-west)
     #:font (pango-font-name font)
-    #:size-points (pango-font-size font)
+    #:size-points (canvas-font-size font)
     #:size-set #t
     #:text (if (integer? s)
               (integer->utf8-string s)
               (string->utf8-string s))))
 
+(define (utf8-string pango-font-description string)
+  (make <gnome-canvas-text>
+    #:parent (canvas-root)
+    #:x 0.0 #:y 0.0
+    #:anchor 'west
+    #:font pango-font-description
+    #:size-points (canvas-font-size pango-font-description)
+    #:size-set #t
+    #:text string))