X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffont.scm;h=a17dc3be6921e37010b23ff827f2907956c1fe0e;hb=ffe9abeff111a8342ab82e6f203aa405336e010b;hp=8552faf065556a944c15c74e0b4358f1b88e96e1;hpb=5cbe821608ec464ea8f418cba15f012b9b1cad80;p=lilypond.git

diff --git a/scm/font.scm b/scm/font.scm
index 8552faf065..a17dc3be69 100644
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -1,267 +1,419 @@
-;;;
-;;; font.scm -- implement Font stuff
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;; 
-;;; (c) 2000 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-
-	 
-
-
-(define style-to-font-alist
-  `(
-    (finger . ((font-family . number) (font-relative-size . -3)))
-    (volta . ((font-family . number) (font-relative-size . -2)))
-    (timesig . ((font-family .  number) (font-relative-size . 0)))
-    (mmrest . ((font-family . number) (font-relative-size . -1)))
-    (mark . ((font-family . number) (font-relative-size . 1)))
-    (script . ((font-family . roman) (font-relative-size . -1)))
-    (large . ((font-family . roman) (font-relative-size . 1)))
-    (Large . ((font-series . bold) (font-family . roman) (font-relative-size . 2)))
-    (dynamic . ((font-series . bold) (font-family . dynamic) (font-relative-size . 0)))
-    
-))
-
-(define (font-field name font-descr)
-      (list-ref
-       font-descr
-       (cond
-	((eq? name 'font-relative-size)  0)
-	((eq? name 'font-series) 1)
-	((eq? name 'font-shape) 2)
-	((eq? name 'font-family) 3)
-	((eq? name 'font-name) 4)
-	((eq? name 'font-point-size-size) 5)
-	)
-       ))
-
-  
-;; return that part of LIST for which PRED is true.
-(define (filter-list pred? list)
-  (if (null? list) '()
-      (let* (
-	     (rest  (filter-list pred? (cdr list)))
-	     )
-	(if (pred?  (car list))
-	    (cons (car list)  rest)
-	    rest
-	    )
-	)
-      )
+;; As an excercise, do it with records.
+;; Should use GOOPS, really.
+
+;; TODO:
+;;
+;; lookup-font should be written in  C.
+;;
+;; should dump tree to .texi as internal documentation
+;; 
+;; * should extract design sizes from fonts: fonts should 
+;; be read off the disk, on demand, something like:
+;;  
+;; cmr -> ((font-load "cmr6") (font-load "cmr8")  .. )
+;;
+
+(define-class <Font-tree-element>
+  ()
   )
 
-;; return those descriptions from FONT-DESCR-LIST whose FIELD-NAME matches VALUE
-
-;;;;;;;;; TODO TODO . (should not use filtering?)
-;; this is bad, since we generate garbage every font-lookup.
-;; otoh, if the qualifiers is narrow enough , we don't generate much garbage.
-;;o
-
+(define-class <Font-tree-leaf> (<Font-tree-element>)
+  (default-size #:init-keyword #:default-size)
+  (size-vector  #:init-keyword #:size-vector))
+
+(define-class <Font-tree-node> (<Font-tree-element>)
+  (qualifier #:init-keyword #:qualifier  #:accessor font-qualifier)
+  (default #:init-keyword #:default #:accessor font-default)
+  (children #:init-keyword #:children #:accessor font-children))
+
+(define (make-font-tree-leaf size size-font-vector)
+  (make <Font-tree-leaf> #:default-size size #:size-vector size-font-vector))
+
+(define (make-font-tree-node
+	 qualifier default)
+  (make <Font-tree-node>
+     #:qualifier qualifier
+     #:default default 
+     #:children (make-hash-table 11)))
+
+(define-method (display (leaf <Font-tree-leaf>) port)
+  (map (lambda (x) (display x port))
+   (list
+    "Font-size-family: \n"
+     (slot-ref leaf 'default-size) 
+     (slot-ref leaf 'size-vector) )))
+  
+(define-method (display (node <Font-tree-node>) port)
+  
+    (map
+     (lambda (x)
+       (display x port))
+     
+     (list
+      "Font_node { \nqual: "
+      (font-qualifier node)
+      "(def: "
+      (font-default node)
+      ") {\n"))
+    (for-each 
+     (lambda (x)
+       (display "\n")
+       (display (car x) port)
+       (display "=" port)
+       (display (cdr x) port))
+     (hash-table->alist (font-children node)))
+    (display "} } \n"))
+
+
+(define default-qualifier-order
+  '(font-encoding font-family font-shape font-series))
+
+(define-method (add-font (node <Font-tree-node>) fprops size-family)
+  (define (assoc-delete key alist)
+    (assoc-remove! (list-copy alist) key))
+  (define (make-node fprops size-family)
+    (if (null? fprops)
+	(make-font-tree-leaf (car size-family) (cdr size-family))
+	(let*
+	    ((qual (next-qualifier default-qualifier-order fprops)))
+	  (make-font-tree-node qual
+			       (assoc-get qual fprops)))
+	))
+  (define (next-qualifier order props)
+    (cond
+     ((and (null? props) (null? order))
+      #f)
+     ((null? props) (car order))
+     ((null? order) (caar props))
+     (else
+      (if (assoc-get (car order) props)
+	  (car order)
+	  (next-qualifier (cdr order) props))
+      )))
+
+  (let*
+      ((q (font-qualifier node))
+       (d (font-default node))
+       (v (assoc-get q fprops d))
+       (new-fprops (assoc-delete q fprops))
+       (child (hashq-ref (slot-ref node 'children)
+			 v #f)))
+
+
+    (if (not child)
+	(begin
+	  (set! child (make-node new-fprops size-family))
+	  (hashq-set! (slot-ref node 'children) v child)))
+    (if (pair? new-fprops)
+	(add-font child new-fprops size-family))))
+
+
+(define-method (add-font (node <Font-tree-leaf>) fprops size-family)
+  (throw "must add to node, not leaf"))
+
+
+(define-method (g-lookup-font (node <Font-tree-node>) alist-chain)
+  (let*
+	((qual (font-qualifier node))
+	 (def (font-default node))
+	 (val (chain-assoc-get qual alist-chain def))
+	 (desired-child (hashq-ref (font-children node) val)))
+
+    (if desired-child
+	(g-lookup-font desired-child alist-chain)
+	(g-lookup-font (hashq-ref (font-children node) def) alist-chain)
+	)))
+
+(define-method (g-lookup-font (node <Font-tree-leaf>) alist-chain)
+  node)
+
+;; two step call  is handy for debugging.
+(define (lookup-font node alist-chain)
+  (g-lookup-font node alist-chain))
+
+;
+; Each size family is a vector of fonts, loaded with a delay.
+; The vector should be sorted according to ascending design size.
+;
+
+(define-public (add-music-fonts node factor)
+  (for-each
+   (lambda (x)
+     (add-font node
+	       (list (cons 'font-encoding (car x)))
+	       (cons (* factor (cadr x))
+		     (caddr x))))
+   `((fetaNumber 10
+	     #(,(delay (ly:font-load "feta-nummer4"))
+	       ,(delay (ly:font-load "feta-nummer6"))
+	       ,(delay (ly:font-load "feta-nummer8"))
+	       ,(delay (ly:font-load "feta-nummer10"))
+	       ,(delay (ly:font-load "feta-nummer12"))
+	       ,(delay (ly:font-load "feta-nummer16"))))
+     (fetaDynamic 14.0  #(,(delay (ly:font-load "feta-din6"))
+		      ,(delay (ly:font-load "feta-din8"))
+		      ,(delay (ly:font-load "feta-din10"))
+		      ,(delay (ly:font-load "feta-din12"))
+		      ,(delay (ly:font-load "feta-din14"))
+		      ,(delay (ly:font-load "feta-din17"))
+		      ))
+     (fetaMusic 20.0
+	    #(,(delay (ly:make-virtual-font
+		       (ly:font-load "feta11")
+		       (ly:font-load "parmesan11")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta13")
+		       (ly:font-load "parmesan13")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta14")
+		       (ly:font-load "parmesan14")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta16")
+		       (ly:font-load "parmesan16")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta18")
+		       (ly:font-load "parmesan18")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta20")
+		       (ly:font-load "parmesan20")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta23")
+		       (ly:font-load "parmesan23")))
+	      ,(delay (ly:make-virtual-font
+		       (ly:font-load "feta26")
+		       (ly:font-load "parmesan26")))
+	      ))
+     
+     (fetaBraces 15 #(,(delay
+		     (ly:make-virtual-font
+		      (ly:font-load "feta-braces-a")
+		      (ly:font-load "feta-braces-b")
+		      (ly:font-load "feta-braces-c")
+		      (ly:font-load "feta-braces-d")
+		      (ly:font-load "feta-braces-e")
+		      (ly:font-load "feta-braces-f")
+		      (ly:font-load "feta-braces-g")
+		      (ly:font-load "feta-braces-h")
+		      (ly:font-load "feta-braces-i"))
+		     ))))))
+       
+
+(define-public (add-cmr-fonts node factor)
+  (add-font
+   node
+   '((font-encoding . TeX-math))
+   `(,(* factor 10) . #(,(delay (ly:font-load "msam10")))))
+  
+  (for-each
+   (lambda (x)
+     (add-font
+      node
+      `((font-encoding . TeX-text)
+	(font-series . ,(vector-ref (car x) 2))
+	(font-shape . ,(vector-ref (car x) 1))
+	(font-family . ,(vector-ref (car x) 0)))
+      (cons (* factor (cadr x))
+	    (cddr x))
+      ))
+   `((#(roman upright medium) .
+      (10.0 . #(,(delay (ly:font-load "cmr6"))
+		,(delay (ly:font-load "cmr8")) 
+		,(delay (ly:font-load "cmr10"))
+		,(delay (ly:font-load "cmr17"))
+		)))
+
+     (#(roman upright bold) .
+      (10.0 . #(,(delay (ly:font-load "cmbx6"))
+		,(delay (ly:font-load "cmbx8"))
+		,(delay (ly:font-load "cmbx10"))
+		,(delay (ly:font-load "cmbx12"))
+		)))
+     
+     (#(roman italic medium) .
+      (10.0 . #(,(delay (ly:font-load "cmti7"))
+		,(delay (ly:font-load "cmti10"))
+		,(delay (ly:font-load "cmti12"))
+		)))
+     (#(roman italic bold) .
+      (10.0 . #(,(delay (ly:font-load "cmbxti8"))
+		,(delay (ly:font-load "cmbxti10"))
+		,(delay (ly:font-load "cmbxti14"))
+		)))
+     
+     (#(roman caps medium) .
+      (10.0 . #(,(delay (ly:font-load "cmcsc10")))))
+
+     (#(roman upright bold-narrow ) .
+      (10.0 . #(,(delay (ly:font-load "cmb10"))
+		)))
+     
+     (#(sans upright medium) .
+      (10.0  . #(,(delay (ly:font-load "cmss8"))
+		 ,(delay (ly:font-load "cmss10"))
+		 ,(delay (ly:font-load "cmss12"))
+		 ,(delay (ly:font-load "cmss17"))
+		 )))
+     (#(typewriter upright medium) .
+      (10.0 . #(,(delay (ly:font-load "cmtt8"))
+		,(delay (ly:font-load "cmtt10"))
+		,(delay (ly:font-load "cmtt12"))
+		)))))
+
+  ;; lmodern: super-cm using metapost
+  ;; lm.map: Reencoding, at fontlevel for TeX ?:
+  ;; cork-lmb10 LMRomanDemi10-Regular "enccorklm ReEncodeFont" <cork-lm.enc <lmb10.pf
+  
+  (for-each
+   (lambda (x)
+     (add-font
+      node
+      `((font-encoding . ec)
+	(font-series . ,(vector-ref (car x) 2))
+	(font-shape . ,(vector-ref (car x) 1))
+	(font-family . ,(vector-ref (car x) 0)))
+      (cons (* factor (cadr x))
+	    (cddr x))
+      ))
 
-;;; kut kut, het lukt gewoon niet, vandaag:
+;;; super-cm, aka lmodern (on Debian) seems rather broken:
+;;; * no usable TFM files  (no lmr10.tfm, only cork-lmr10.tfm)
+;;; * broken AFM files:
+;;;    - invalid keyword 'Generated'
+;;;    - lists FontEncoding Fontspecific  -- duh
+;;; revert to ec-fonts-mftraced for now
+;;; make this easily switchable?
+   
+;;;    `((#(roman upright medium) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmr6"))
+;;; 		,(delay (ly:font-load "lmr8")) 
+;;; 		,(delay (ly:font-load "lmr10"))
+;;; 		,(delay (ly:font-load "lmr17")))))
+
+;;;      (#(roman upright bold) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmbx6"))
+;;; 		,(delay (ly:font-load "lmbx8"))
+;;; 		,(delay (ly:font-load "lmbx10"))
+;;; 		,(delay (ly:font-load "lmbx12")))))
+     
+;;;      (#(roman italic medium) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmri7"))
+;;; 		,(delay (ly:font-load "lmri10"))
+;;; 		,(delay (ly:font-load "lmri12")))))
+;;;      (#(roman italic bold) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmbi8"))
+;;; 		,(delay (ly:font-load "lmbi10"))
+;;; 		,(delay (ly:font-load "lmbi14")))))
+     
+;;;      (#(roman caps medium) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmcs10")))))
+
+;;;      (#(roman upright bold-narrow ) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmb10")))))
+     
+;;;      (#(sans upright medium) .
+;;;       (10.0  . #(,(delay (ly:font-load "lmss8"))
+;;; 		 ,(delay (ly:font-load "lmss10"))
+;;; 		 ,(delay (ly:font-load "lmss12"))
+;;; 		 ,(delay (ly:font-load "lmss17")))))
+;;;      (#(sans upright bold) .
+;;;       (10.0  . #(,(delay (ly:font-load "lmssbx10")))))
+     
+;;;      (#(typewriter upright medium) .
+;;;       (10.0 . #(,(delay (ly:font-load "lmtt8"))
+;;; 		,(delay (ly:font-load "lmtt10"))
+;;; 		,(delay (ly:font-load "lmtt12"))))))))
+   `((#(roman upright medium) .
+      (10.0 . #(,(delay (ly:font-load "ecrm6"))
+		,(delay (ly:font-load "ecrm8")) 
+		,(delay (ly:font-load "ecrm10"))
+		,(delay (ly:font-load "ecrm17"))))) 
+     (#(roman upright bold) .
+      (10.0 . #(,(delay (ly:font-load "ecbx6"))
+		,(delay (ly:font-load "ecbx8"))
+		,(delay (ly:font-load "ecbx10"))
+		,(delay (ly:font-load "ecbx12"))))) 
+     (#(roman italic medium) .
+      (10.0 . #(,(delay (ly:font-load "ecti7"))
+		,(delay (ly:font-load "ecti10"))
+		,(delay (ly:font-load "ecti12")))))
+     (#(roman italic bold) .
+      (10.0 . #(,(delay (ly:font-load "ecbi8"))
+		,(delay (ly:font-load "ecbi10"))
+		,(delay (ly:font-load "ecbi14")))))
+     (#(roman caps medium) .
+      (10.0 . #(,(delay (ly:font-load "eccc10")))))
+     (#(roman slanted-caps medium) .
+      (10.0 . #(,(delay (ly:font-load "ecsc10")))))
+     (#(roman upright bold-narrow ) .
+      (10.0 . #(,(delay (ly:font-load "ecrb10")))))
+     (#(sans upright medium) .
+      (10.0  . #(,(delay (ly:font-load "ecss8"))
+		 ,(delay (ly:font-load "ecss10"))
+		 ,(delay (ly:font-load "ecss12"))
+		 ,(delay (ly:font-load "ecss17")))))
+     (#(typewriter upright medium) .
+      (10.0 . #(,(delay (ly:font-load "ectt8"))
+		,(delay (ly:font-load "ectt10"))
+		,(delay (ly:font-load "ectt12"))))))))
 
-;;;couldn't find font satisfying ((font-family . roman) (font-shape . upright) (font-relative-size . -3))
 
+  
 
-(define (filter-field field-name value font-descr-alist)
-    (if (string? value)
-      (let ((err (current-error-port)))
-	(display "\nignoring string qualifier: " err)
-	(display value err)
-	(display "\n" err)	  
-	font-descr-alist)
-      (filter-list
-       (lambda (x) (eq? value (font-field field-name (car x))))
-       font-descr-alist)
-      ))
+;; (display (make-font-tree 1.0))
 
-(define paper20-style-sheet-alist
-  '(
-    ((0 medium upright music feta 20) . "feta20")
-    ((-1 medium upright music feta 16) . "feta16")
-    ((-2 medium upright music feta 13) . "feta13")
-    ((-3 medium upright music feta 13) . "feta11")
-    ((-4 medium upright music feta 13) . "feta11")
-    ((1 medium upright music feta 23) . "feta23")
-    ((2 medium upright music feta 26) . "feta26")
-    ((0 medium upright braces feta-braces 20) . "feta-braces20")
-    ((0 medium italic roman cmti 10) . "cmti10")
-    ((1 medium italic roman cmti 12) . "cmti12")
-    ((3 bold italic dynamic feta 10) . "feta-din13")
-    ((2 bold italic dynamic feta 10) . "feta-din13")
-    ((1 bold italic dynamic feta 10) . "feta-din12")
-    ((0 bold italic dynamic feta 10) . "feta-din10")
-    ((-1 bold italic dynamic feta 10) . "feta-din8")
-    ((-2 bold italic dynamic feta 10) . "feta-din7")
-    ((-3 bold italic dynamic feta 10) . "feta-din6")
-    ((-4 bold italic dynamic feta 10) . "feta-din5")
-    ((-5 bold italic dynamic feta 10) . "feta-din4")
-    ((3 medium upright number feta-nummer 13) . "feta-nummer13")
-    ((2 medium upright number feta-nummer 13) . "feta-nummer13")
-    ((1 medium upright number feta-nummer 12) . "feta-nummer12")
-    ((0 medium upright number feta-nummer 10) . "feta-nummer10")
-    ((-1 medium upright number feta-nummer 8) . "feta-nummer8")
-    ((-2 medium upright number feta-nummer 6) . "feta-nummer6")
-    ((-3 medium upright number feta-nummer 5) . "feta-nummer5")
-    ((-4 medium upright number feta-nummer 4) . "feta-nummer4")
-    ((0 medium upright roman cmr 10) . "cmr10")
-    ((1 medium upright roman cmr 12) . "cmr12")
-    ((-1 medium upright roman cmr 8) . "cmr8" )
-    ((-2 medium upright roman cmr 7) . "cmr7" )
-    ((-3 medium upright roman cmr 6) . "cmr6" )
-    ((-4 medium upright roman cmr 5) . "cmr5" )
-    ((-5 medium upright roman cmr 4) . "cmr4" )
-    ((2 bold upright roman cmbx 10) . "cmbx10")
-    ((1 bold upright roman cmbx 12) . "cmbx12")
-    ((-3 medium upright math msam 10) . "msam10")
-    ((-2 medium upright math msam 10) . "msam10")
-    ((-1 medium upright math msam 10) . "msam10")
-    ((0 medium upright math msam 10) . "msam10")
-    ))
-
-
-;; return a FONT-DESCR with relative size incremented by INCREMENT 
-(define (change-relative-size font-desc increment)
-  (cons (+ increment (car font-desc)) (cdr font-desc))
+;; Century Schoolbook fonts filenames on Debian/Sid
+(define-public (add-century-schoolbook-fonts node factor)
+  
+  (add-font node
+	    '((font-family . roman)
+	      (font-shape . upright)
+	      (font-series . medium)
+	      (font-encoding . latin1))
+	    `(10.0 . #(,(delay (ly:font-load "uncr8a")))))
+  
+  (add-font node
+	    '((font-family . roman)
+	      (font-shape . italic)
+	      (font-series . medium)
+	      (font-encoding . latin1))
+	    `(10.0 . #(,(delay (ly:font-load "uncri8a")))))
+  
+  (add-font node
+	    '((font-family . roman)
+	      (font-shape . upright)
+	      (font-series . bold)
+	      (font-encoding . latin1))
+	    `(10.0 . #(,(delay (ly:font-load "uncb8a")))))
+  
+  (add-font node
+	    '((font-family . roman)
+	      (font-shape . italic)
+	      (font-series . bold)
+	      (font-encoding . latin1))
+	    `(10.0 . #(,(delay (ly:font-load "uncbi8a")))))
   )
 
-;; map a  function FUNC over the keys of an alist LIST, leaving the vals. 
-(define (map-alist-keys func list)
-  (if (null?  list)
-      '()
-      (cons (cons (func (caar list)) (cdar list))
-	    (map-alist-keys func (cdr list)))
-      ))
- 
-;; map a function FUNC over the vals of  LIST, leaving the keys. 
-(define (map-alist-vals func list)
-  (if (null?  list)
-      '()
-      (cons (cons  (caar list) (func (cdar list)))
-	    (map-alist-vals func (cdr list)))
-      ))
 
-(define (change-style-sheet-relative-size sheet x)
-  (map-alist-keys (lambda (descr) (change-relative-size descr  x)) sheet))
-
-
-;; make style sheet for each paper version.
-(define style-sheet-alist
-  (map-alist-vals (lambda (x) (change-style-sheet-relative-size
-			       paper20-style-sheet-alist x))
-		  '((paper11 . -3)
-		    (paper13 . -2)
-		    (paper16 . -1)
-		    (paper20 . 0)
-		    (paper23 . 1)
-		    (paper26 . 2)
-		    ))
-  )
+(define-public (make-cmr-tree factor)
+  (let
+      ((n (make-font-tree-node 'font-encoding 'fetaMusic)))
 
-
-(define (font-regexp-to-font-name paper regexp)
-  (let ((style-sheet (cdr (assoc paper style-sheet-alist))))
-    (let loop ((fonts style-sheet))
-      (if (string-match regexp (caar fonts))
-	  (cdar fonts)
-	  (if (pair? (cdr fonts))
-	      (loop (cdr fonts))
-	      '())))))
-
-;; reduce the font list by successively applying a font-qualifier.
-(define (qualifiers-to-fontname  qualifiers font-descr-alist)
-  (if (null? qualifiers)
-      (if (null? font-descr-alist)
-	  ""  
-	  (cdar font-descr-alist))	; return the topmost.
-      
-      (qualifiers-to-fontname
-       (cdr qualifiers)
-       (filter-field (caar qualifiers) (cdar qualifiers) font-descr-alist)
-      )
+    (add-music-fonts n factor)
+    (add-cmr-fonts n factor)
+    n
   ))
 
-(define (properties-to-font-name paper properties-alist)
-  (let*  (
-	  (fonts (cdr (assoc paper style-sheet-alist)))
-
-	  ;; change order to change priorities of qualifiers.
-	  (q-order    '(font-name font-family font-series font-shape font-point-size font-relative-size))
-	  (rawqualifiers (map (lambda (x) (assoc x  properties-alist))
-			      q-order))
-			
-	  (qualifiers (filter-list pair? rawqualifiers))
-	  (fontnm     (qualifiers-to-fontname qualifiers fonts))
-	  (err (current-error-port))
-	  )
-
-    (if (eq? fontnm "")
-	(begin
-	  (display "\ncouldn't find font satisfying " err)
-	  (display qualifiers err)
-	  (display "\n" err)	  
-	  "cmr10"
-	  )
-	fontnm)
-	
-
-    ))
-
-
-(define markup-abbrev-to-properties-alist
-  (append
-   '(
-     (rows . ((align . 0)))
-     (lines . ((align . 1)))
-     (roman . ((font-family . roman)))
-     (music . ((font-family . music)))
-     (finger . ((font-style . finger)))
-     (bold . ((font-series . bold)))
-     (italic . ((font-shape . italic)))
-     (named . ((lookup . name)))
-     (super . ((raise . 1) (font-relative-size . -1)))
-     (sub . ((raise . -1) (font-relative-size . -1)))
-     (text . ((lookup . value)))
-     )
-   (map (lambda (x) (cons (car x) (cons 'font-style (car x))))
-	style-to-font-alist)))
-  
-(define (markup-to-properties markup)
-  ;;(display "markup: `")
-  ;;(display markup)
-  ;;(display "'\n")
-  (if (pair? markup)
-      (list markup)
-      (let ((entry (assoc markup markup-abbrev-to-properties-alist)))
-	(if entry (cdr entry)
-	    (list (cons markup #t))))))
-
-; fixme, how's this supposed to work?
-; and why don't we import font-setting from elt?
-(define (style-to-font-name paper style)
-  (let* ((entry (assoc style style-to-font-alist))
-	 (qs (if entry (cdr entry) '()))
-	 (sheet (cdr (assoc paper style-sheet-alist)))
-	 (fontnm (qualifiers-to-fontname qs sheet))
-	 (err (current-error-port)))
-    (if (eq? fontnm "")
-	(begin
-	  (display "\ncouldn't find font satisfying " err)
-	  (display qs err)
-	  (display "\n" err)	  
-	  "cmr10")
-	fontnm)))
-
-			    
 
+(define-public (make-century-schoolbook-tree factor)
 
-; (define (test-module)
-;  (display (filter-list pair? '(1 2 (1 2) (1 .2)))
-;(display (filter-field 'font-name 'cmbx paper20-style-sheet-alist))
+  (let
+      ((n (make-font-tree-node 'font-encoding 'fetaMusic)))
 
-; (display (qualifiers-to-fontname '((font-name . cmbx)) paper20-style-sheet-alist))
-; (display (style-to-font-name 'paper20 'large))
-; )
+    (add-music-fonts n factor)
+    (add-century-schoolbook-fonts n factor)
+    n
+  ))
 
 
+(define-public (magstep x)
+  (exp (* (/ x 6) (log 2))))