From 1240e56210d98fee7a4664585d21cc6854877b93 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 9 Mar 2004 11:48:01 +0000 Subject: [PATCH] * 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. --- ChangeLog | 14 ++++ input/test/title-markup.ly | 3 +- lily/font-select.cc | 5 +- lily/paper-book.cc | 1 + lily/parser.yy | 2 + mf/GNUmakefile | 2 +- ps/lilyponddefs.ps | 26 ++++++++ scm/define-markup-commands.scm | 4 ++ scm/font.scm | 34 +++++----- scm/lily.scm | 4 +- scm/output-ps.scm | 115 +++++++++++++++------------------ scm/output-tex.scm | 35 ++++------ 12 files changed, 134 insertions(+), 111 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8e831bb0c3..3a05626927 100644 --- a/ChangeLog +++ b/ChangeLog @@ -4,6 +4,20 @@ 2004-03-09 Jan Nieuwenhuizen + * 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): diff --git a/input/test/title-markup.ly b/input/test/title-markup.ly index e5a86c004c..9abe85dfba 100644 --- a/input/test/title-markup.ly +++ b/input/test/title-markup.ly @@ -34,6 +34,7 @@ spaceTest = \markup { "two space chars" } 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)" @@ -66,7 +67,7 @@ spaceTest = \markup { "two space chars" } \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 > diff --git a/lily/font-select.cc b/lily/font-select.cc index 2321f5a058..3ea24a0b1e 100644 --- a/lily/font-select.cc +++ b/lily/font-select.cc @@ -133,7 +133,10 @@ properties_to_font_size_family (SCM fonts, SCM alist_chain) 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 ()); diff --git a/lily/paper-book.cc b/lily/paper-book.cc index c43899c270..eaeaf4a27e 100644 --- a/lily/paper-book.cc +++ b/lily/paper-book.cc @@ -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_); + fprintf (stderr, "pages: %f\n", book_height / page->text_height ()); #if ONE_SCORE_PER_PAGE for (int i = 0; i < score_count; i++) diff --git a/lily/parser.yy b/lily/parser.yy index 3723bf4347..80ba7a4fe4 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -454,7 +454,9 @@ toplevel_expression: default_rendering (sc->music_, id->self_scm (), head, outname); +#ifndef PAGE_LAYOUT scm_gc_unprotect_object (id->self_scm ()); +#endif } #ifndef PAGE_LAYOUT scm_gc_unprotect_object (sc->self_scm ()); diff --git a/mf/GNUmakefile b/mf/GNUmakefile index 88ffb17f82..753ceb7024 100644 --- a/mf/GNUmakefile +++ b/mf/GNUmakefile @@ -38,7 +38,7 @@ MFTRACE_FLAGS=$(if $(ENCODING_FILE),--encoding $(ENCODING_FILE),) # # 2. are not included with teTeX # -SAUTER_FONTS = cmbxti8 +SAUTER_FONTS = cmbxti8 ecbm14 ecrm12 MORE_SAUTER_FONTS = cmbx14 cmbx17 \ cmbxti12 cmbxti14 \ diff --git a/ps/lilyponddefs.ps b/ps/lilyponddefs.ps index c0d15a1bb5..ff80432b9f 100644 --- a/ps/lilyponddefs.ps +++ b/ps/lilyponddefs.ps @@ -59,6 +59,32 @@ output-scale output-scale scale grestore } bind def +%% http://bibliofile.mc.duke.edu/gww/fonts/postscript-utilities/encoding-vectors.html + +%/FONTLENGTH 256 bind def + +% 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 { diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index fdf0013a4f..aa1d61e38b 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -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)) +(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 diff --git a/scm/font.scm b/scm/font.scm index b74af0546a..df716c4366 100644 --- a/scm/font.scm +++ b/scm/font.scm @@ -5,32 +5,26 @@ ;;;; (c) 2000--2004 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +(define-public (magstep x) + (exp (* (/ x 6) (log 2)))) + ;; 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 - (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")))) @@ -92,7 +86,11 @@ or ))) (#(* * 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 diff --git a/scm/lily.scm b/scm/lily.scm index c2a0430bc5..41aea4a744 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -106,12 +106,12 @@ (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))) -(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))) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 24b259d369..7553e2f1de 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -36,7 +36,7 @@ ;;; 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)) @@ -61,34 +61,13 @@ (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) - (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) @@ -105,8 +84,6 @@ (define (tex-font? fontname) (equal? (substring fontname 0 2) "cm")) - - ;;; Output-interface functions (define (beam width slope thick blot) (string-append @@ -162,6 +139,31 @@ (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) @@ -170,6 +172,8 @@ (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 :-) @@ -178,20 +182,6 @@ (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 @@ -202,15 +192,18 @@ (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))) - - (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)) @@ -270,21 +263,10 @@ (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)) - - (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)) @@ -432,7 +414,6 @@ (string-append (header (string-append "GNU LilyPond (" (lilypond-version) "), ") (strftime "%c" (localtime (current-time)))) - LATIN1-ENCODING-COMMANDS ;;; ugh (ps-string-def "lilypond" 'tagline @@ -455,3 +436,9 @@ " " (ly:number->string dy) " draw_zigzag_line ")) + +(define (start-page) + "\n%start page\n") + +(define (stop-page last?) + "\n%showpage\n") diff --git a/scm/output-tex.scm b/scm/output-tex.scm index f4aa7b7cf2..4e8b6e0b10 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -19,6 +19,10 @@ (define this-module (current-module)) +;;; Output interface entry +(define-public (tex-output-expression expr port) + (display (eval expr this-module) port )) + ;;;;;;;; ;;;;;;;; DOCUMENT ME! ;;;;;;;; @@ -121,25 +125,11 @@ (define (select-font name-mag-pair) (let ((c (assoc name-mag-pair font-name-alist))) - (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? @@ -350,13 +340,10 @@ ;; 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? - "\n}\n" - "\n}\n\\newpage\n")) + "\n%}\n" + "\n%}\n\\newpage\n")) -- 2.39.2