]> git.donarmstrong.com Git - lilypond.git/commitdiff
* lily/font-select.cc (properties_to_font_size_family): Fix
authorJan Nieuwenhuizen <janneke@gnu.org>
Tue, 9 Mar 2004 11:48:01 +0000 (11:48 +0000)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 9 Mar 2004 11:48:01 +0000 (11:48 +0000)
warning message.

* Experimental PostScript latin1 encoding:

* mf/GNUmakefile (SAUTER_FONTS): Add ecmb14 ecrm12.

* scm/output-ps.scm: Experimental encoding using reencode-font.
* scm/font.scm: Add latin1 `font-shape'.

* scm/define-markup-commands.scm (latin-i): New font-shape command.

* ps/lilyponddefs.ps (reencode-font): New function.

12 files changed:
ChangeLog
input/test/title-markup.ly
lily/font-select.cc
lily/paper-book.cc
lily/parser.yy
mf/GNUmakefile
ps/lilyponddefs.ps
scm/define-markup-commands.scm
scm/font.scm
scm/lily.scm
scm/output-ps.scm
scm/output-tex.scm

index 8e831bb0c3056b103661fd6630f4c7a678376485..3a0562692753daf28fdfe921e3a0106afd2ab1c4 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -4,6 +4,20 @@
 
 2004-03-09  Jan Nieuwenhuizen  <janneke@gnu.org>
 
 
 2004-03-09  Jan Nieuwenhuizen  <janneke@gnu.org>
 
+       * lily/font-select.cc (properties_to_font_size_family): Fix
+       warning message.
+
+       * Experimental PostScript latin1 encoding:
+       
+       * mf/GNUmakefile (SAUTER_FONTS): Add ecmb14 ecrm12.
+
+       * scm/output-ps.scm: Experimental encoding using reencode-font.
+       * scm/font.scm: Add latin1 `font-shape'.
+       
+       * scm/define-markup-commands.scm (latin-i): New font-shape command. 
+
+       * ps/lilyponddefs.ps (reencode-font): New function.
+
        * lily/paper-book.cc (get_pages): Simplistic page breaking.
 
        * scm/output-tex.scm (start-page):
        * lily/paper-book.cc (get_pages): Simplistic page breaking.
 
        * scm/output-tex.scm (start-page):
index e5a86c004c8759a0e5dd6f0b88f7c973dab32c9e..9abe85dfbac45c8b1bc5bf229bcb29d55f14f995 100644 (file)
@@ -34,6 +34,7 @@ spaceTest = \markup { "two space chars" }
     texidoc = "Make titles using markup (WIP)."
     
     %dedication = "För my dør Lily"
     texidoc = "Make titles using markup (WIP)."
     
     %dedication = "För my dør Lily"
+    % ugh: encoding char-size
     dedication = "For my öòóôõø so dear Lily"
     title = "Title"
     subtitle = "(and (the) subtitle)"
     dedication = "For my öòóôõø so dear Lily"
     title = "Title"
     subtitle = "(and (the) subtitle)"
@@ -66,7 +67,7 @@ spaceTest = \markup { "two space chars" }
        \column <
            %\fill-line #linewidth < \huge \bigger \bold \title >
             \override #'(baseline-skip . 4) \column <
        \column <
            %\fill-line #linewidth < \huge \bigger \bold \title >
             \override #'(baseline-skip . 4) \column <
-               \fill-line < \dedication >
+               \fill-line < \latin-i \dedication >
                \fill-line < \huge\bigger\bigger\bigger\bigger \bold \title >
                 \override #'(baseline-skip . 3) \column <
                     \fill-line < \large\bigger\bigger \bold \subtitle >
                \fill-line < \huge\bigger\bigger\bigger\bigger \bold \title >
                 \override #'(baseline-skip . 3) \column <
                     \fill-line < \large\bigger\bigger \bold \subtitle >
index 2321f5a0588cc533b82e27f636f4bc651d0ac8d7..3ea24a0b1e620f064a4af96c413faf659e03fec9 100644 (file)
@@ -133,7 +133,10 @@ properties_to_font_size_family (SCM fonts, SCM alist_chain)
       return qname;
     }
 
       return qname;
     }
 
-  warning (_ ("couldn't find any font size family satisfying "));
+  warning (_f ("cannot find font for: (%s %s %s)",
+              ly_symbol2string (series).to_str0 (),
+              ly_symbol2string (shape).to_str0 (),
+              ly_symbol2string (family).to_str0 ()));
   
   scm_write (scm_list_n (shape, series , family, 
                         SCM_UNDEFINED), scm_current_error_port ());
   
   scm_write (scm_list_n (shape, series , family, 
                         SCM_UNDEFINED), scm_current_error_port ());
index c43899c270090e6ff229e1940d4e0d2d2d0ac24e..eaeaf4a27e2bb435332e35eea56c10be3cb16751 100644 (file)
@@ -157,6 +157,7 @@ Paper_book::get_pages ()
   Page *page = new Page (paper);
   fprintf (stderr, "book_height: %f\n", book_height);
   fprintf (stderr, "vsize: %f\n", page->vsize_);
   Page *page = new Page (paper);
   fprintf (stderr, "book_height: %f\n", book_height);
   fprintf (stderr, "vsize: %f\n", page->vsize_);
+  fprintf (stderr, "pages: %f\n", book_height / page->text_height ());
 
 #if ONE_SCORE_PER_PAGE
   for (int i = 0; i < score_count; i++)
 
 #if ONE_SCORE_PER_PAGE
   for (int i = 0; i < score_count; i++)
index 3723bf4347c6a687bb9d605184e3b81926820854..80ba7a4fe491659926c09a369ebab6c2f1e05004 100644 (file)
@@ -454,7 +454,9 @@ toplevel_expression:
        
                   default_rendering (sc->music_, id->self_scm (), head, outname);
                                                
        
                   default_rendering (sc->music_, id->self_scm (), head, outname);
                                                
+#ifndef PAGE_LAYOUT
                   scm_gc_unprotect_object (id->self_scm ());
                   scm_gc_unprotect_object (id->self_scm ());
+#endif
                }
 #ifndef PAGE_LAYOUT
                scm_gc_unprotect_object (sc->self_scm ());
                }
 #ifndef PAGE_LAYOUT
                scm_gc_unprotect_object (sc->self_scm ());
index 88ffb17f82fadff4aa02e142d68de9464499d18a..753ceb7024ef0dc1961aadb2003073a8d3dce3d8 100644 (file)
@@ -38,7 +38,7 @@ MFTRACE_FLAGS=$(if $(ENCODING_FILE),--encoding $(ENCODING_FILE),)
 #
 # 2. are not included with teTeX
 #
 #
 # 2. are not included with teTeX
 #
-SAUTER_FONTS = cmbxti8
+SAUTER_FONTS = cmbxti8 ecbm14 ecrm12
 
 MORE_SAUTER_FONTS = cmbx14 cmbx17 \
         cmbxti12 cmbxti14 \
 
 MORE_SAUTER_FONTS = cmbx14 cmbx17 \
         cmbxti12 cmbxti14 \
index c0d15a1bb5bb64efc05d7e87a639989479a7bd59..ff80432b9f8697e6b6d73acfa2ca6f6d8b12c1db 100644 (file)
@@ -59,6 +59,32 @@ output-scale output-scale scale
        grestore
 } bind def
 
        grestore
 } bind def
 
+%% http://bibliofile.mc.duke.edu/gww/fonts/postscript-utilities/encoding-vectors.html
+
+%/FONTLENGTH 256 bind def
+
+%<font> <encoding> <name> reencode-font
+/reencode-dict 5 dict def
+/reencode-font
+{
+    reencode-dict
+    begin
+    /name exch def
+    /encoding exch def
+    /base-font exch def
+    % note: Needs ps level 2
+    /font base-font maxlength dict def
+    base-font {
+        exch dup dup /FID ne exch /Encoding ne and
+        { exch font 3 1 roll put }
+        { pop pop } ifelse
+    } forall
+    font /FontName name put
+    font /Encoding encoding put
+    name font definefont pop
+    end
+} bind def
+
 /start-system % height
 {
        dup base-line-skip gt {
 /start-system % height
 {
        dup base-line-skip gt {
index fdf0013a4ffa8843ef978f92edd8915d540b1536..aa1d61e38ba3a4cc62aefd141626f6230dc710c1 100644 (file)
@@ -154,6 +154,10 @@ some punctuation. It doesn't have any letters.  "
   "Set font shape to @code{caps}."
   (interpret-markup paper (prepend-alist-chain 'font-shape 'caps props) arg))
 
   "Set font shape to @code{caps}."
   (interpret-markup paper (prepend-alist-chain 'font-shape 'caps props) arg))
 
+(def-markup-command (latin-i paper props arg) (markup?)
+  "TEST latin1 encoding."
+  (interpret-markup paper (prepend-alist-chain 'font-shape 'latin1 props) arg))
+
 (def-markup-command (dynamic paper props arg) (markup?)
   "Use the dynamic font.  This font only contains s, f, m, z, p, and
 r.  When producing phrases, like ``piu f'', the normal words (like
 (def-markup-command (dynamic paper props arg) (markup?)
   "Use the dynamic font.  This font only contains s, f, m, z, p, and
 r.  When producing phrases, like ``piu f'', the normal words (like
index b74af0546ad61559a87128cbdc220eaccc4e79d5..df716c43668dc3723cb5d89a8b97a76ebd06a878 100644 (file)
@@ -5,32 +5,26 @@
 ;;;; (c)  2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;;;; (c)  2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
+(define-public (magstep x)
+  (exp (* (/ x 6) (log 2))))
+
 ;; Should separate default sizes
 ;; into separate list/alist ?
 
 ;; Should separate default sizes
 ;; into separate list/alist ?
 
+;; FIXME docstring for paper20-font-vector 
+  """ Entries have the following format
 
 
-"
-Each entry in this vector has the following format
-
-
- (cons
-  #(QUALIFIERS)
-  (cons DEFAULT-SIZE
-        #(SIZE-FONT-ENTRIES... ) ))
+  ( #(SERIES SHAPE FAMILY)  .
+    (DEFAULT-SIZE . #(SIZE-FONT-ENTRY... ) ))
 
 
-where each SIZE-FONT-ENTRY is
+where SIZE-FONT-ENTRY is
 
 
-  (cons DESIGN-SIZE FONT-NAME)
+  (DESIGN-SIZE FONT-NAME)
 
 or
 
 
 or
 
-  (cons DESIGN-SIZE (list FONT-NAME1 FONT-NAME2 .. )) 
-
-"
-
-(define-public (magstep x)
-  (exp (* (/ x 6) (log 2))))
-
+  (DESIGN-SIZE (FONT-NAME1 FONT-NAME2 ... ))"""
+  
 (define-public paper20-font-vector
   '((#(medium upright number) .
      (10 . #((10.0  . "feta-nummer10"))))
 (define-public paper20-font-vector
   '((#(medium upright number) .
      (10 . #((10.0  . "feta-nummer10"))))
@@ -92,7 +86,11 @@ or
                )))
     (#(* * math) .
      (10.0 . #((10.0 . "msam10"))))
                )))
     (#(* * math) .
      (10.0 . #((10.0 . "msam10"))))
-     ))
+    ;; testing ps-encoding
+    (#(medium latin1 roman) .
+     (10.0 . #((12.0 . "ecrm12"))))
+    (#(bold latin1 roman) .
+     (10.0 . #((14.0 . "ecbm14"))))))
 
 (define (scale-font-entry entry factor)
   (cons
 
 (define (scale-font-entry entry factor)
   (cons
index c2a0430bc51f694b311467444a6c877b0a7402fc..41aea4a7449617fef651b3e521b6b57a1b5ef243 100644 (file)
          (uniqued-alist (cdr alist) (cons (car alist) acc)))))
 
 
          (uniqued-alist (cdr alist) (cons (car alist) acc)))))
 
 
-(define (assoc-get key alist)
+(define-public (assoc-get key alist)
   "Return value if KEY in ALIST, else #f."
   (let ((entry (assoc key alist)))
     (if entry (cdr entry) #f)))
   
   "Return value if KEY in ALIST, else #f."
   (let ((entry (assoc key alist)))
     (if entry (cdr entry) #f)))
   
-(define (assoc-get-default key alist default)
+(define-public (assoc-get-default key alist default)
   "Return value if KEY in ALIST, else DEFAULT."
   (let ((entry (assoc key alist)))
     (if entry (cdr entry) default)))
   "Return value if KEY in ALIST, else DEFAULT."
   (let ((entry (assoc key alist)))
     (if entry (cdr entry) default)))
index 24b259d369f82e67bdb34f04bb9813bfa5f173c7..7553e2f1de4a357eca3fbfeb2979172bed41609a 100644 (file)
@@ -36,7 +36,7 @@
 
 ;;; Lily output interface, PostScript implementation --- cleanup and docme
 
 
 ;;; Lily output interface, PostScript implementation --- cleanup and docme
 
-;;; Module entry
+;;; Output interface entry
 (define-public (ps-output-expression expr port)
   (display (expression->string expr) port))
 
 (define-public (ps-output-expression expr port)
   (display (expression->string expr) port))
 
   (cons (+ (car a) (car b))
        (+ (cdr a) (cdr b))))
 
   (cons (+ (car a) (car b))
        (+ (cdr a) (cdr b))))
 
-(define LATIN1-ENCODING-ALIST
-  '(("ö" . "oumlaut")
-    ("ò" . "ograve")
-    ("ó" . "oacute")
-    ("ô" . "ocircumflex")
-    ("õ" . "otilde")
-    ("ø" . "oslash")))
-
-(define LATIN1-ENCODING-COMMANDS
-  "/oumlaut { (o) show gsave -1 0 rmoveto (\\177) show grestore } bind def
-/ograve { (o) show gsave -1 0 rmoveto (\\022) show grestore } def
-/oacute { (o) show gsave -1 0 rmoveto (\\023) show grestore } def
-/ocircumflex { (o) show gsave -1 0 rmoveto (^) show grestore } def
-/otilde { (o) show gsave -1 0 rmoveto (~) show grestore } def
-/oslash { (o) show gsave -1 0 rmoveto (\\034) show grestore } def
-")
-
+;; WIP
+(define font-encoding-alist
+  '(("ecrm12" . "ISOLatin1Encoding")
+    ("ecmb12" . "ISOLatin1Encoding")))
+                
 (define (ps-encoding text)
 (define (ps-encoding text)
-  (let ((s (escape-parentheses text)))
-    (define (helper alist-list s)
-      (if (not (pair? alist-list))
-         s
-         (helper (cdr alist-list)
-                 (regexp-substitute/global
-                  #f (caar alist-list) s
-                  'pre (string-append ") show " (cdar alist-list) " (")
-                  'post))))
-    (helper LATIN1-ENCODING-ALIST s)))
+  (escape-parentheses text))
 
 ;; FIXME: lily-def
 (define (ps-string-def prefix key val)
 
 ;; FIXME: lily-def
 (define (ps-string-def prefix key val)
 (define (tex-font? fontname)
   (equal? (substring fontname 0 2) "cm"))
 
 (define (tex-font? fontname)
   (equal? (substring fontname 0 2) "cm"))
 
-
-
 ;;; Output-interface functions
 (define (beam width slope thick blot)
   (string-append
 ;;; Output-interface functions
 (define (beam width slope thick blot)
   (string-append
   (define (fontname->designsize fontname)
     (let ((i (string-index fontname char-numeric?)))
       (string->number (substring fontname i))))
   (define (fontname->designsize fontname)
     (let ((i (string-index fontname char-numeric?)))
       (string->number (substring fontname i))))
+  
+  (define (define-font command fontname scaling)
+    (string-append
+     "/" command " { /" fontname " findfont "
+     (ly:number->string scaling) " output-scale div scalefont } bind def\n"))
+
+  (define (reencode-font raw encoding command)
+    (string-append
+     raw " " encoding " /" command " reencode-font\n"
+     "/" command "{ /" command " findfont 1 scalefont } bind def\n"))
+         
+  ;; frobnicate NAME to jibe with external definitions.
+  (define (possibly-mangle-fontname fontname)
+    (cond
+     ((tex-font? fontname)
+      ;; FIXME: we need proper Fontmap for CM fonts, like so:
+      ;; /CMR10 (cmr10.pfb); 
+      ;; (string-upcase fontname)
+      (string-append fontname ".pfb"))
+     ((or (equal? (substring fontname 0 4) "feta")
+         (equal? (substring fontname 0 4) "parm"))
+      (regexp-substitute/global
+       #f "(feta|parmesan)([a-z-]*)([0-9]+)"
+       fontname 'pre "GNU-LilyPond-" 1 2 "-" 3 'post))
+     (else fontname)))
                         
   ;;  (define (font-load-command name-mag command)
   (define (font-load-command lst)
                         
   ;;  (define (font-load-command name-mag command)
   (define (font-load-command lst)
           (value-name-size (car value))
           (command (cdr value))
           (fontname (car value-name-size))
           (value-name-size (car value))
           (command (cdr value))
           (fontname (car value-name-size))
+          (mangled (possibly-mangle-fontname fontname))
+          (encoding (assoc-get fontname font-encoding-alist))
           (designsize (if (tex-font? fontname)
                           (/ 12 (fontname->designsize fontname))
                           ;; This is about 12/20 :-)
           (designsize (if (tex-font? fontname)
                           (/ 12 (fontname->designsize fontname))
                           ;; This is about 12/20 :-)
           (scaling (* 12 (/ fontsize designsize)))
           (scaling (/ fontsize (/ designsize 12))))
 
           (scaling (* 12 (/ fontsize designsize)))
           (scaling (/ fontsize (/ designsize 12))))
 
-      ;; frobnicate NAME to jibe with external definitions.
-      (define (possibly-mangle-fontname fontname)
-       (cond
-        ((tex-font? fontname)
-         ;; FIXME: we need proper Fontmap for CM fonts, like so:
-         ;; /CMR10 (cmr10.pfb); 
-         ;; (string-upcase fontname)
-         (string-append fontname ".pfb"))
-        ((or (equal? (substring fontname 0 4) "feta")
-             (equal? (substring fontname 0 8) "parmesan"))
-         (regexp-substitute/global
-          #f "(feta|parmesan)([a-z-]*)([0-9]+)"
-          fontname 'pre "GNU-LilyPond-" 1 2 "-" 3 'post))
-        (else fontname)))
       (if
        #f
        (begin
       (if
        #f
        (begin
         (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) "designsize ~S\n" designsize)
         (format (current-error-port) "fontname ~S\n" fontname)
+        (format (current-error-port) "mangled ~S\n" mangled)
         (format (current-error-port) "fontsize ~S\n" fontsize)
         (format (current-error-port) "scaling ~S\n" scaling)))
         (format (current-error-port) "fontsize ~S\n" fontsize)
         (format (current-error-port) "scaling ~S\n" scaling)))
-        
-      (string-append
-       "/" command
-       " { /" (possibly-mangle-fontname fontname) " findfont "
-       (ly:number->string scaling)
-       "output-scale div scalefont setfont } bind def \n")))
-    
+      
+      (if encoding
+         ;; FIXME: should rather tag encoded font
+         (let ((raw (string-append command "-raw")))
+           (string-append
+            (define-font raw mangled scaling)
+            (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))
   (define (ps-encoded-fontswitch name-mag-pair)
     (let* ((key (car name-mag-pair))
           (value (cdr name-mag-pair))
     (let ((c (assoc name-mag-pair font-name-alist)))
       
       (if c
     (let ((c (assoc name-mag-pair font-name-alist)))
       
       (if c
-         (string-append " " (cddr c) " ")
+         (string-append " " (cddr c) " setfont ")
          (begin
            (ly:warn
             (format "Programming error: No such font: ~S" name-mag-pair))
          (begin
            (ly:warn
             (format "Programming error: No such font: ~S" name-mag-pair))
-           
-           (display "FAILED\n" (current-error-port))
-           (if #f ;(pair? name-mag-pair))
-               (display (object-type (car name-mag-pair)) (current-error-port))
-               (write name-mag-pair (current-error-port)))
-           (if #f ;  (pair? font-name-alist)
-               (display
-                (object-type (caaar font-name-alist)) (current-error-port))
-               (write font-name-alist (current-error-port)))
-
-           ;; (format #f "\n%FAILED: (select-font ~S)\n" name-mag-pair))
            ""))))
   
   (string-append (select-font name-mag-pair) exp))
            ""))))
   
   (string-append (select-font name-mag-pair) exp))
   (string-append
    (header (string-append "GNU LilyPond (" (lilypond-version) "), ")
           (strftime "%c" (localtime (current-time))))
   (string-append
    (header (string-append "GNU LilyPond (" (lilypond-version) "), ")
           (strftime "%c" (localtime (current-time))))
-   LATIN1-ENCODING-COMMANDS
   ;;; ugh
    (ps-string-def
     "lilypond" 'tagline
   ;;; ugh
    (ps-string-def
     "lilypond" 'tagline
     " "
     (ly:number->string dy)
     " draw_zigzag_line "))
     " "
     (ly:number->string dy)
     " draw_zigzag_line "))
+
+(define (start-page)
+  "\n%start page\n")
+
+(define (stop-page last?)
+  "\n%showpage\n")
index f4aa7b7cf2bf216d4e9835105028276961d5cddc..4e8b6e0b10e6b4ccb4b28dc5982cf209fef29195 100644 (file)
 
 (define this-module (current-module))
 
 
 (define this-module (current-module))
 
+;;; Output interface entry
+(define-public (tex-output-expression expr port)
+  (display (eval expr this-module) port ))
+
 ;;;;;;;;
 ;;;;;;;; DOCUMENT ME!
 ;;;;;;;;
 ;;;;;;;;
 ;;;;;;;; DOCUMENT ME!
 ;;;;;;;;
 
 (define (select-font name-mag-pair)
   (let ((c (assoc name-mag-pair font-name-alist)))
 
 (define (select-font name-mag-pair)
   (let ((c (assoc name-mag-pair font-name-alist)))
-
     (if c
        (string-append "\\" (cddr c))
        (begin
     (if c
        (string-append "\\" (cddr c))
        (begin
-         (ly:warn (string-append
-                   "Programming error: No such font known "
-                   (car name-mag-pair) " "
-                   (ly:number->string (cdr name-mag-pair))))
-         
-         (display "FAILED\n" (current-error-port))
-         (if #f ;(pair? name-mag-pair))
-             (display (object-type (car name-mag-pair)) (current-error-port))
-             (write name-mag-pair (current-error-port)))
-         (if #f ;  (pair? font-name-alist)
-             (display
-              (object-type (caaar font-name-alist)) (current-error-port))
-             (write font-name-alist (current-error-port)))
-
-         ;; (format #f "\n%FAILED: (select-font ~S)\n" name-mag-pair))
+         (ly:warn
+          (format "Programming error: No such font: ~S" name-mag-pair))
          ""))))
 
 ;; top-of-file, wtf?  ugh: tagline?
          ""))))
 
 ;; top-of-file, wtf?  ugh: tagline?
 ;; no-origin not yet supported by Xdvi
 (define (no-origin) "")
 
 ;; no-origin not yet supported by Xdvi
 (define (no-origin) "")
 
-(define-public (tex-output-expression expr port)
-  (display (eval expr this-module) port ))
-
-(define-public (start-page)
-  "\n\\vbox{\n")
+(define (start-page)
+  "\n%\\vbox{\n")
 
 
-(define-public (stop-page last?)
+(define (stop-page last?)
   (if last?
   (if last?
-      "\n}\n"
-      "\n}\n\\newpage\n"))
+      "\n%}\n"
+      "\n%}\n\\newpage\n"))