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.
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):
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)"
\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 >
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 ());
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++)
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 ());
#
# 2. are not included with teTeX
#
-SAUTER_FONTS = cmbxti8
+SAUTER_FONTS = cmbxti8 ecbm14 ecrm12
MORE_SAUTER_FONTS = cmbx14 cmbx17 \
cmbxti12 cmbxti14 \
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 {
"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
;;;; (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 ?
+;; 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"))))
)))
(#(* * 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
(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)))
;;; 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))
(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)
(define (tex-font? fontname)
(equal? (substring fontname 0 2) "cm"))
-
-
;;; 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 (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)
(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 :-)
(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
(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))
(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))
(string-append
(header (string-append "GNU LilyPond (" (lilypond-version) "), ")
(strftime "%c" (localtime (current-time))))
- LATIN1-ENCODING-COMMANDS
;;; ugh
(ps-string-def
"lilypond" 'tagline
" "
(ly:number->string dy)
" draw_zigzag_line "))
+
+(define (start-page)
+ "\n%start page\n")
+
+(define (stop-page last?)
+ "\n%showpage\n")
(define this-module (current-module))
+;;; Output interface entry
+(define-public (tex-output-expression expr port)
+ (display (eval expr this-module) port ))
+
;;;;;;;;
;;;;;;;; DOCUMENT ME!
;;;;;;;;
(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?
;; 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"))
projects / lilypond.git / commitdiff