]> git.donarmstrong.com Git - lilypond.git/commitdiff
(define-fonts):
authorjanneke <janneke>
Sun, 4 Apr 2004 22:11:02 +0000 (22:11 +0000)
committerjanneke <janneke>
Sun, 4 Apr 2004 22:11:02 +0000 (22:11 +0000)
(fontify): Update.

ChangeLog
scm/output-ps.scm
scm/output-tex.scm

index edc6bcec3f51f171f29d852a8ac51e3a293f6579..ce7154f8323232cc9d834b9aacc321d5b2465fed 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-04-05  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+       * scm/output-ps.scm (define-fonts):
+       (fontify): Update.
+
 2004-04-04  Han-Wen Nienhuys   <hanwen@xs4all.nl>
 
        * po/fr.po: update.
index d4918db3a17daf0fbda9789e60c512969a79a197..942937e2dd7b32a1d81bc924f27ceb93956b3ac0 100644 (file)
@@ -70,7 +70,6 @@
 ;; alist containing fontname -> fontcommand assoc (both strings)
 (define page-count 0)
 (define page-number 0)
-(define font-name-alist '())
 
 ;; /lilypondpaperoutputscale 1.75729901757299 def
 ;;/lily-output-units 2.83464  def  %% milimeter
    (ly:number->string (* 10 thick))
    " ] 0 draw_dashed_slur"))
 
-(define (define-fonts internal-external-name-mag-pairs)
+(define (font-command font)
+  (string-append
+   "magfont"
+   (string-encode-integer
+    (hashq (ly:font-name font) 1000000))
+   "m"
+   (string-encode-integer
+    (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
+
+(define (define-fonts paper font-list)
 
   (define (fontname->designsize fontname)
     (let ((i (string-index fontname char-numeric?)))
   (define (define-font command fontname scaling)
     (string-append
      "/" command " { /" fontname " findfont "
+     ;; FIXME
      (ly:number->string scaling) " output-scale div scalefont } bind def\n"))
+     ;;(ly:number->string scaling) " scalefont } bind def\n"))
 
   (define (reencode-font raw encoding command)
     (string-append
        fontname 'pre "GNU-LilyPond-" 1 2 "-" 3 'post))
      (else fontname)))
                         
-  ;;  (define (font-load-command name-mag command)
-  (define (font-load-command fonts)
-    (let* ((key-name-size (car lst))
-          (value (cdr lst))
-          (value-name-size (car value))
-          (command (font-command font))
+  (define (font-load-command paper font)
+
+;; fontname "feta20"
+;; command "magfontGNMWomXVo"
+;; mangled "GNU-LilyPond-feta-20"
+;; designsize 0.569055118110236
+;; foo-design 20
+;; magnification 0.569055118110236
+;; ops 1.75729901757299
+;; scaling 20.0
+
+;; fontname "cmr8"
+;; command "magfontUIJQomTVo"
+;; mangled "cmr8.pfb"
+;; designsize 0.564574183197548
+;; foo-design 8
+;; magnification 0.564574183197548
+;; ops 1.75729901757299
+;; scaling 7.87450656184296
+    
+    (let* ((command (font-command font))
           (fontname (ly:font-name font))
           (mangled (possibly-mangle-fontname fontname))
           (encoding (assoc-get fontname font-encoding-alist))
           (designsize (ly:font-design-size font))
-          (fontsize (cdr value-name-size))
-          (scaling (* fontsize designsize)))
+          (magnification (* (ly:font-magnification font)))
+          (foo-design (fontname->designsize fontname))
+          (ops (ly:paper-lookup paper 'outputscale))
+          ;; FIXME this magic is about right ...
+          (scaling (* ops ops magnification designsize foo-design)))
 
       (if
        #f
        (begin
         (newline)
-        (format (current-error-port) "key-name-size ~S\n" key-name-size)
-        (format (current-error-port) "value ~S\n" value)
-        (format (current-error-port) "value-name-size ~S\n" value-name-size)
-        (format (current-error-port) "command ~S\n" command)
-        (format (current-error-port) "designsize ~S\n" designsize)
         (format (current-error-port) "fontname ~S\n" fontname)
+        (format (current-error-port) "command ~S\n" command)
         (format (current-error-port) "mangled ~S\n" mangled)
-        (format (current-error-port) "fontsize ~S\n" fontsize)
+        (format (current-error-port) "designsize ~S\n" designsize)
+        (format (current-error-port) "foo-design ~S\n" foo-design)
+        (format (current-error-port) "magnification ~S\n" magnification)
+        (format (current-error-port) "ops ~S\n" ops)
         (format (current-error-port) "scaling ~S\n" scaling)))
       
       (if encoding
             (reencode-font raw encoding command)))
          (define-font command mangled scaling))))
   
-  (define (ps-encoded-fontswitch name-mag-pair)
-    (let* ((key (car name-mag-pair))
-          (value (cdr name-mag-pair))
-          (fontname (car value))
-          (scaling (cdr value)))
-      (cons key (cons value
-                     (string-append
-                      "lilyfont" fontname "-" (ly:number->string scaling))))))
-
-  (set! font-name-alist
-       (map ps-encoded-fontswitch internal-external-name-mag-pairs))
-  (apply string-append (map font-load-command font-name-alist)))
+  (apply string-append
+        (map (lambda (x) (font-load-command paper x)) font-list)))
 
 (define (define-origin file line col) "")
 
   (string-append (ly:numbers->string (list breapth width depth height))
                 " draw_box"))
 
-(define (fontify name-mag-pair exp)
-
-  (define (select-font name-mag-pair)
-    (let ((c (assoc name-mag-pair font-name-alist)))
-      
-      (if c
-         (string-append (cddr c) " setfont ")
-         (begin
-           (ly:warn
-            (format "Programming error: No such font: ~S" name-mag-pair))
-           ""))))
-  
-  (string-append (select-font name-mag-pair) exp))
+(define (fontify font exp)
+  (string-append (font-command font) " setfont " exp))
 
 (define (header creator time-stamp page-count-)
   (set! page-count page-count-)
   (let ((prefix "lilypondpaper"))
     
     (define (scope-entry->string key var)
-      (let ((val (variable-ref var)))
-       (cond
-        ((string? val) (ps-string-def prefix key val))
-        ((number? val) (ps-number-def prefix key val))
-        (else ""))))
+      (if (variable-bound? var)
+         (let ((val (variable-ref var)))
+           (cond
+            ((string? val) (ps-string-def prefix key val))
+            ((number? val) (ps-number-def prefix key val))
+            (else "")))
+         ""))
       
     (apply
      string-append
index 344c40e04b1f90405c410f3cc4f6576b5a9bca05..c30d9a4ab2e67cbb316781e4c7b0fd2c9b842017 100644 (file)
 
 (define (define-fonts paper font-list)
   (apply string-append
-        (map (lambda (x)
-               (font-load-command paper x))
-             font-list)
-        ))
-
-;;
-;; urg, how can exp be #unspecified?  -- in sketch output
-;;
-;; set! returns #<unspecified>  --hwn
-;;
+        (map (lambda (x) (font-load-command paper x)) font-list)))
+
 (define (fontify font exp)
-  (string-append "\\" (font-command font)
-                exp))
+  (string-append "\\" (font-command font) exp))
 
 (define (unknown) 
   "%\n\\unknown\n")