From 326d10399091bd821918dfe9b2328360a8df0d3f Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 30 May 2004 15:29:18 +0000 Subject: [PATCH] * lily/ly-module.cc (LY_DEFINE): bugfix. * lily/paper-book.cc (book_title): separate function for the book title. * scm/page-layout.scm (default-book-title): only account for markup fields. * scm/framework-ps.scm: new file. Move high level interface from output-ps.scm * scm/framework-tex.scm (dump-line): new file. High level interface for output (pages, systems, header). * lily/paper-book.cc (split_string): new function (output): output multiple formats, i.e. --format=ps,tex * scm/output-ps.scm (output-scopes): dump variables directly. (define-fonts): rewrite for new interface * ps/lilyponddefs.ps: remove lilypondpaper redefinitions. --- ChangeLog | 11 ++ lily/include/paper-book.hh | 3 +- lily/ly-module.cc | 2 +- lily/paper-book.cc | 84 +++++++++++---- lily/score.cc | 17 +-- ps/lilyponddefs.ps | 13 --- scm/framework-ps.scm | 206 +++++++++++++++++++++++++++++++++++++ scm/framework-tex.scm | 47 +++++---- scm/lily.scm | 1 + scm/output-ps.scm | 177 ++----------------------------- scm/output-tex.scm | 44 +++----- scm/page-layout.scm | 5 +- 12 files changed, 341 insertions(+), 269 deletions(-) create mode 100644 scm/framework-ps.scm diff --git a/ChangeLog b/ChangeLog index 5591eed334..96a8fe44a7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,16 @@ 2004-05-30 Han-Wen Nienhuys + * lily/ly-module.cc (LY_DEFINE): bugfix. + + * lily/paper-book.cc (book_title): separate function for the book + title. + + * scm/page-layout.scm (default-book-title): only account for + markup fields. + + * scm/framework-ps.scm: new file. Move high level interface from + output-ps.scm + * scm/music-functions.scm (def-grace-function): move macros from ly/music-functions-init.ly diff --git a/lily/include/paper-book.hh b/lily/include/paper-book.hh index 16aa45f983..b1c8a5a5fc 100644 --- a/lily/include/paper-book.hh +++ b/lily/include/paper-book.hh @@ -47,7 +47,8 @@ public: SCM lines (); SCM pages (); - Stencil title (int); + Stencil book_title (); + Stencil score_title (int); void classic_output (String); void init (); void output (String); diff --git a/lily/ly-module.cc b/lily/ly-module.cc index 9c30b6ed96..6b2317eaad 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -135,7 +135,7 @@ LY_DEFINE(ly_modules_lookup, "ly:modules-lookup", "Lookup @var{sym} in the list @var{modules}, returning the " "first occurence. If not found, return @var{default}, or @code{#f}.") { - for (SCM s = modules; SCM_MODULEP (s); s = ly_cdr (s)) + for (SCM s = modules; ly_c_pair_p (s); s = ly_cdr (s)) { SCM mod = ly_car (s); SCM v = scm_sym2var (sym, scm_module_lookup_closure (mod), SCM_UNDEFINED); diff --git a/lily/paper-book.cc b/lily/paper-book.cc index 4ff0703274..dfbb55d6e5 100644 --- a/lily/paper-book.cc +++ b/lily/paper-book.cc @@ -229,14 +229,43 @@ LY_DEFINE(ly_paper_book_book_paper, "ly:paper-book-book-paper", return unsmob_paper_book(pb)->bookpaper_->self_scm (); } +/* + +TODO: resurrect more complex user-tweaks for titling . + +*/ +Stencil +Paper_book::book_title () +{ + SCM title_func = bookpaper_->lookup_variable (ly_symbol2scm ("book-title")); + Stencil title; + + SCM scopes = SCM_EOL; + if (ly_c_module_p (header_)) + scopes = scm_cons (header_, scopes); + + + SCM tit = SCM_EOL; + if (ly_c_procedure_p (title_func)) + tit = scm_call_2 (title_func, + bookpaper_->self_scm (), + scopes); + + if (unsmob_stencil (tit)) + title = *unsmob_stencil (tit); + + if (!title.is_empty ()) + title.align_to (Y_AXIS, UP); + + return title; +} + + + Stencil -Paper_book::title (int i) +Paper_book::score_title (int i) { - SCM user_title = bookpaper_->lookup_variable (ly_symbol2scm ("user-title")); - SCM book_title = bookpaper_->lookup_variable (ly_symbol2scm ("book-title")); - SCM score_title = bookpaper_->lookup_variable (ly_symbol2scm ("score-title")); - SCM field = (i == 0 ? ly_symbol2scm ("bookTitle") - : ly_symbol2scm ("scoreTitle")); + SCM title_func = bookpaper_->lookup_variable (ly_symbol2scm ("score-title")); Stencil title; @@ -247,23 +276,27 @@ Paper_book::title (int i) if (ly_c_module_p (score_lines_[i].header_)) scopes = scm_cons (score_lines_[i].header_, scopes); - //end ugh - - SCM s = ly_modules_lookup (scopes, field, SCM_BOOL_F); - if (s != SCM_BOOL_F) - title = *unsmob_stencil (scm_call_2 (user_title, - bookpaper_->self_scm (), - s)); - else - title = *unsmob_stencil (scm_call_2 (i == 0 ? book_title : score_title, - bookpaper_->self_scm (), - scopes)); + //end ugh + + SCM tit = SCM_EOL; + if (ly_c_procedure_p (title_func)) + tit =scm_call_2 (title_func, + bookpaper_->self_scm (), + scopes); + + if (unsmob_stencil (tit)) + title = *unsmob_stencil (tit); + + if (!title.is_empty ()) title.align_to (Y_AXIS, UP); return title; } + + + /* calculate book height, #lines, stencils. */ void Paper_book::init () @@ -273,9 +306,13 @@ Paper_book::init () /* Calculate the full book height. Hmm, can't we cache system heights while making stencils? */ height_ = 0; + Stencil btitle = book_title (); + if (!btitle.is_empty ()) + height_ += btitle.extent (Y_AXIS).length (); + for (int i = 0; i < score_count; i++) { - Stencil title = this->title (i); + Stencil title = score_title (i); if (!title.is_empty ()) height_ += title.extent (Y_AXIS).length (); @@ -313,15 +350,20 @@ Paper_book::lines () { if (ly_c_pair_p (lines_)) return lines_; - + + Stencil title = book_title (); + if (!title.is_empty ()) + lines_ = scm_cons (stencil2line (title, true), lines_); + int score_count = score_lines_.size (); for (int i = 0; i < score_count; i++) { - Stencil title = this->title (i); + Stencil title = score_title (i); if (!title.is_empty ()) lines_ = scm_cons (stencil2line (title, true), lines_); - lines_ = scm_append (scm_list_2 (scm_vector_to_list (score_lines_[i].lines_), lines_)); + SCM line_list = scm_vector_to_list (score_lines_[i].lines_); // guh. + lines_ = scm_append (scm_list_2 (scm_reverse (line_list), lines_)); } lines_ = scm_reverse (lines_); diff --git a/lily/score.cc b/lily/score.cc index d3bc525fc1..7757b6a37d 100644 --- a/lily/score.cc +++ b/lily/score.cc @@ -244,17 +244,18 @@ Score::book_rendering (String outname, scaled = def->self_scm (); scm_gc_unprotect_object (scaled); } + + /* + TODO: fix or junk --no-paper. + */ - if (!(no_paper_global_b && dynamic_cast (def))) + SCM context = ly_run_translator (music_, def->self_scm ()); + if (dynamic_cast (unsmob_context (context))) { - SCM context = ly_run_translator (music_, def->self_scm ()); - if (dynamic_cast (unsmob_context (context))) + SCM s = ly_format_output (context, out); + if (s != SCM_UNDEFINED) { - SCM s = ly_format_output (context, out); - if (s != SCM_UNDEFINED) - { - systems = s; - } + systems = s; } } diff --git a/ps/lilyponddefs.ps b/ps/lilyponddefs.ps index 60252c745c..edd8448155 100644 --- a/ps/lilyponddefs.ps +++ b/ps/lilyponddefs.ps @@ -62,19 +62,6 @@ end } bind def -/start-page -{ -} bind def - -/stop-page -{ - showpage -} bind def - -/stop-last-page -{ -} bind def - /start-system % x y { gsave diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm new file mode 100644 index 0000000000..69311a4ad9 --- /dev/null +++ b/scm/framework-ps.scm @@ -0,0 +1,206 @@ + +(define-module (scm framework-ps)) + +(use-modules (ice-9 regex) + (ice-9 string-fun) + (ice-9 format) + (guile) + (srfi srfi-13) + (scm output-ps) + (lily)) + +(define (tex-font? fontname) + (equal? (substring fontname 0 2) "cm")) + + +(define (define-fonts bookpaper) + + (define font-list (ly:bookpaper-fonts bookpaper)) + (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 plain encoding command) + (let ((coding-vector (get-coding-command encoding))) + (string-append + plain " " coding-vector " /" command " reencode-font\n" + "/" command "{ /" command " findfont 1 scalefont } bind def\n"))) + + (define (guess-ps-fontname basename) + "We do not have the FontName, try to guess is from basename." + (cond + ((tex-font? basename) + ;; FIXME: we need proper Fontmap for the bluesky CM*, EC* fonts. + ;; Only the fonts that we trace in mf/ are in our own FontMap. + (string-append basename ".pfb")) + (else (string-append basename ".pfa")) + )) + + (define (font-load-command font) + (let* ((specced-font-name (ly:font-name font)) + (fontname (if specced-font-name + specced-font-name + (guess-ps-fontname (ly:font-filename font)))) + + (coding-alist (ly:font-encoding-alist font)) + (input-encoding (assoc-get 'input-name coding-alist)) + (font-encoding (assoc-get 'output-name coding-alist)) + (command (ps-font-command font)) + ;; FIXME -- see (ps-font-command ) + (plain (ps-font-command font #f)) + (designsize (ly:font-design-size font)) + (magnification (* (ly:font-magnification font))) + (ops (ly:output-def-lookup bookpaper 'outputscale)) + (scaling (* ops magnification designsize))) + + (string-append + (define-font plain fontname scaling) + (if (or (equal? input-encoding font-encoding) + ;; guh + (equal? font-encoding "fetaBraces") + (equal? font-encoding "fetaNumber") + (equal? font-encoding "fetaMusic") + (equal? font-encoding "parmesanMusic")) + "" + (reencode-font plain input-encoding command))))) + + (define (font-load-encoding encoding) + (let ((filename (get-coding-filename encoding))) + (ly:kpathsea-gulp-file filename))) + + (let* ((encoding-list (map (lambda (x) + (assoc-get 'input-name + (ly:font-encoding-alist x))) + font-list)) + (encodings (uniq-list (sort-list (filter string? encoding-list) + stringstring, mostly + (define (value->string val) + (cond + ((string? val) (string-append "(" val ")")) + ((symbol? val) (symbol->string val)) + ((number? val) (number->string val)) + (else ""))) + + (define (output-entry ps-key ly-key) + (string-append + "/" ps-key " " (value->string (ly:output-def-lookup paper ly-key)) " def \n")) + + (string-append + "/lily-output-units 2.83464 def %% milimeter \n" + "% /lily-output-units 0.996264 def %% true points.\n" + (output-entry "staff-line-thickness" 'linethickness) + (output-entry "line-width" 'linewidth) + (output-entry "paper-size" 'papersize) + (output-entry "staff-height" 'staffheight) ;junkme. + "/output-scale " + (number->string (ly:output-def-lookup paper 'outputscale)) + " lily-output-units mul def \n" + )) + +(define (header paper page-count classic?) + (string-append + "%!PS-Adobe-3.0\n" + "%%Creator: creator time-stamp \n" + "%%Pages: " (number->string page-count) "\n" + "%%PageOrder: Ascend\n" + "%%DocumentPaperSizes: " (ly:output-def-lookup paper 'papersize) "\n" + ;;(string-append "GNU LilyPond (" (lilypond-version) "), ") + ;; (strftime "%c" (localtime (current-time)))) + ;; FIXME: duplicated in every backend + (ps-string-def + "lilypond" 'tagline + (string-append "Engraved by LilyPond (version " (lilypond-version) ")")) + )) + +(define (dump-page outputter page page-number page-count) + (ly:outputter-dump-string outputter + (string-append + "%%Page: " (number->string page-number) " " (number->string page-count) "\n" + "0 0 start-system { " + "set-ps-scale-to-lily-scale " + "\n")) + (ly:outputter-dump-stencil outputter (ly:page-stencil page)) + (ly:outputter-dump-string outputter + "} stop-system \nshowpage\n") ) + + +(define-public (output-framework-ps outputter book scopes fields basename) + (let* + ((bookpaper (ly:paper-book-book-paper book)) + (pages (ly:paper-book-pages book)) + (pageno 0) + (page-count (length pages)) + ) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + (header bookpaper + (length pages) + #f) + + (output-variables bookpaper) + (ly:gulp-file "music-drawing-routines.ps") + (ly:gulp-file "lilyponddefs.ps") + (define-fonts bookpaper) + )) + + (for-each + (lambda (page) + (set! pageno (1+ pageno)) + (dump-page outputter page pageno page-count)) + pages) + (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n") + )) + + +(define (dump-line outputter system) + (ly:outputter-dump-string + outputter + " start-system {\n set-ps-scale-to-lily-scale\n") + (ly:outputter-dump-stencil outputter (ly:page-line-stencil system)) + (ly:outputter-dump-string + outputter + "} stop-system\n")) + + +(define-public (output-classic-framework-ps outputter book scopes fields basename) + (let* + ((bookpaper (ly:paper-book-book-paper book)) + (lines (ly:paper-book-lines book)) + (pageno 0) + (page-count (length lines)) + ) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + (header bookpaper + (length pages) + #f) + + (output-variables bookpaper) + (ly:gulp-file "music-drawing-routines.ps") + (ly:gulp-file "lilyponddefs.ps") + (define-fonts bookpaper) + )) + + (for-each + (lambda (line) + (set! pageno (1+ pageno)) + (dump-line outputter line)) ; pageno page-count)) + lines) + (ly:outputter-dump-string outputter "\n") + )) + diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm index 5db44ada38..1c1b897de6 100644 --- a/scm/framework-tex.scm +++ b/scm/framework-tex.scm @@ -25,39 +25,48 @@ (ly:bookpaper-fonts bookpaper) )))) +(define-public (header-to-file fn key val) + (set! key (symbol->string key)) + (if (not (equal? "-" fn)) + (set! fn (string-append fn "." key)) + ) + (display + (format "Writing header field `~a' to `~a'..." + key + (if (equal? "-" fn) "" fn) + ) + (current-error-port)) + (if (equal? fn "-") + (display val) + (display val (open-file fn "w")) + ) + (display "\n" (current-error-port)) + "" ) + + (define (output-scopes scopes fields basename) (define (output-scope scope) (apply string-append (module-map - (lambda (sym var) - (let (;;(val (variable-ref var)) - (val (if (variable-bound? var) (variable-ref var) '"")) - (tex-key (symbol->string sym))) + (lambda (sym var) + (let ((val (if (variable-bound? var) (variable-ref var) "")) + ) (if (and (memq sym fields) (string? val)) (header-to-file basename sym val)) - - (cond - ((string? val) - (tex-string-def "lilypond" sym val)) - - ((number? val) ;why? - (tex-number-def "lilypond" sym - (if (integer? val) - (number->string val) - (number->string (exact->inexact val))))) - - (else "")))) + "")) scope))) (apply string-append (map output-scope scopes))) + + (define (tex-string-def prefix key str) - (if (equal? "" (sans-surrounding-whitespace (output-tex-string str))) + (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str))) (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n") (string-append "\\def\\" prefix (symbol->tex-key key) - "{" (output-tex-string str) "}%\n"))) + "{" (sanitize-tex-string str) "}%\n"))) (define (header creator time-stamp bookpaper page-count classic?) (string-append @@ -123,7 +132,6 @@ "}%\n")) ) -;; todo: only pass BOOK, FIELDS arguments (define-public (output-framework-tex outputter book scopes fields basename) (let* ((bookpaper (ly:paper-book-book-paper book)) @@ -140,7 +148,6 @@ #f ) - (output-scopes scopes fields basename) (define-fonts bookpaper) (header-end))) diff --git a/scm/lily.scm b/scm/lily.scm index 1dba8fdc59..264f4be59a 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -381,6 +381,7 @@ L1 is copied, L2 not. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; output (use-modules (scm framework-tex) + (scm framework-ps) ) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index e9ad248e45..575c96d8fb 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -19,8 +19,6 @@ #:re-export (quote) #:export (define-fonts unknown - output-paper-def - output-scopes select-font blank dot @@ -62,10 +60,6 @@ (srfi srfi-13) (lily)) -;;; Global vars -(define page-count 0) -(define page-number 0) - ;;; helper functions, not part of output interface (define (escape-parentheses s) (regexp-substitute/global #f "(^|[^\\])([\\(\\)])" s 'pre 1 "\\" 2 'post)) @@ -78,7 +72,7 @@ (escape-parentheses text)) ;; FIXME: lily-def -(define (ps-string-def prefix key val) +(define-public (ps-string-def prefix key val) (string-append "/" prefix (symbol->string key) " (" (escape-parentheses val) ") def\n")) @@ -89,9 +83,6 @@ (ly:number->string (exact->inexact val))))) (string-append "/" prefix (symbol->string key) " " s " def\n"))) -(define (tex-font? fontname) - (equal? (substring fontname 0 2) "cm")) - ;;; ;;; Lily output interface, PostScript implementation --- cleanup and docme @@ -118,7 +109,7 @@ (define (char font i) (string-append - (font-command font) " setfont " + (ps-font-command font) " setfont " "(\\" (ly:inexact->string i 8) ") show" )) (define (comment s) @@ -147,7 +138,9 @@ (ly:number->string (* 10 thick)) " ] 0 draw_dashed_slur")) -(define (font-command font . override-coding) +; todo: merge with tex-font-command? + +(define-public (ps-font-command font . override-coding) (let* ((name (ly:font-filename font)) (magnify (ly:font-magnification font)) (coding-alist (ly:font-encoding-alist font)) @@ -169,74 +162,6 @@ "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))) (if (not coding-command) "" (string-append "e" coding-command))))) -(define (define-fonts bookpaper) - - (define font-list (ly:bookpaper-fonts bookpaper)) - (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 plain encoding command) - (let ((coding-vector (get-coding-command encoding))) - (string-append - plain " " coding-vector " /" command " reencode-font\n" - "/" command "{ /" command " findfont 1 scalefont } bind def\n"))) - - (define (guess-ps-fontname basename) - "We do not have the FontName, try to guess is from basename." - (cond - ((tex-font? basename) - ;; FIXME: we need proper Fontmap for the bluesky CM*, EC* fonts. - ;; Only the fonts that we trace in mf/ are in our own FontMap. - (string-append basename ".pfb")) - (else (string-append basename ".pfa")) - )) - - (define (font-load-command font) - (let* ((specced-font-name (ly:font-name font)) - (fontname (if specced-font-name - specced-font-name - (guess-ps-fontname (ly:font-filename font)))) - - (coding-alist (ly:font-encoding-alist font)) - (input-encoding (assoc-get 'input-name coding-alist)) - (font-encoding (assoc-get 'output-name coding-alist)) - (command (font-command font)) - ;; FIXME -- see (font-command ) - (plain (font-command font #f)) - (designsize (ly:font-design-size font)) - (magnification (* (ly:font-magnification font))) - (ops (ly:output-def-lookup bookpaper 'outputscale)) - (scaling (* ops magnification designsize))) - - (string-append - (define-font plain fontname scaling) - (if (or (equal? input-encoding font-encoding) - ;; guh - (equal? font-encoding "fetaBraces") - (equal? font-encoding "fetaNumber") - (equal? font-encoding "fetaMusic") - (equal? font-encoding "parmesanMusic")) - "" - (reencode-font plain input-encoding command))))) - - (define (font-load-encoding encoding) - (let ((filename (get-coding-filename encoding))) - (ly:kpathsea-gulp-file filename))) - - (let* ((encoding-list (map (lambda (x) - (assoc-get 'input-name - (ly:font-encoding-alist x))) - font-list)) - (encodings (uniq-list (sort-list (filter string? encoding-list) - stringstring (list breapth width depth height)) " draw_box")) -(define (header creator time-stamp paper page-count- classic?) - (set! page-count page-count-) - (set! page-number 0) - (string-append - "%!PS-Adobe-3.0\n" - "%%Creator: " creator " " time-stamp "\n" - "%%Pages: " (number->string page-count) "\n" - "%%PageOrder: Ascend\n" - "%%DocumentPaperSizes: " (ly:output-def-lookup paper 'papersize) "\n" - ;;(string-append "GNU LilyPond (" (lilypond-version) "), ") - ;; (strftime "%c" (localtime (current-time)))) - ;; FIXME: duplicated in every backend - (ps-string-def - "lilypond" 'tagline - (string-append "Engraved by LilyPond (version " (lilypond-version) ")")) - )) - -(define (header-end) - "") - ;; WTF is this in every backend? (define (horizontal-line x1 x2 th) (draw-line th x1 0 x2 0)) @@ -302,58 +207,7 @@ (define (no-origin) "") -;; FIXME: duplictates output-scopes, duplicated in other backends -;; FIXME: silly interface name -(define (output-paper-def pd) - (let ((prefix "lilypondpaper")) - - (define (scope-entry->string key var) - (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 - (module-map scope-entry->string (ly:output-def-scope pd))))) - -;; FIXME: duplicated in other output backends -;; FIXME: silly interface name -(define (output-scopes paper scopes fields basename) - (let ((prefix "lilypond")) - - ;; FIXME: duplicates output-paper's scope-entry->string, mostly - (define (value->string val) - (cond - ((string? val) (string-append "(" val ")")) - ((symbol? val) (symbol->string val)) - ((number? val) (number->string val)) - (else ""))) - - (define (output-entry ps-key ly-key) - (string-append - "/" ps-key " " (value->string (ly:output-def-lookup paper ly-key)) " def \n")) - - (string-append - "/lily-output-units 2.83464 def %% milimeter \n" - "% /lily-output-units 0.996264 def %% true points.\n" - (output-entry "staff-line-thickness" 'linethickness) - (output-entry "line-width" 'linewidth) - (output-entry "paper-size" 'papersize) - (output-entry "staff-height" 'staffheight) ;junkme. - "/output-scale " - (number->string (ly:output-def-lookup paper 'outputscale)) - " lily-output-units mul def \n" - - (ly:gulp-file "music-drawing-routines.ps") - (ly:gulp-file "lilyponddefs.ps") - - ))) - (define (placebox x y s) (string-append @@ -376,20 +230,12 @@ (ly:numbers->string (list x y width height blotdiam)) " draw_round_box")) -(define (start-system origin dim) - (string-append - "\n" (ly:number-pair->string origin) " start-system\n" - "{\n" - "set-ps-scale-to-lily-scale\n")) (define (stem breapth width depth height) ; FIXME: use draw_round_box. (string-append (ly:numbers->string (list breapth width depth height)) " draw_box" )) -(define (stop-system last?) - "} stop-system\n") - (define (symmetric-x-triangle thick w h) (string-append (ly:numbers->string (list h w thick)) @@ -424,7 +270,7 @@ (string-append s " ")) (string-append - (font-command font) " setfont " + (ps-font-command font) " setfont " (string-join (reverse commands))) )) @@ -441,14 +287,3 @@ (ly:number->string dx) " " (ly:number->string dy) " draw_zigzag_line")) - -(define (start-page) - (set! page-number (+ page-number 1)) - (string-append - "%%Page: " (number->string page-number) " " (number->string page-count) "\n" - "start-page\n")) - -(define (stop-page last?) - (if last? - "\nstop-last-page\n" - "\nstop-page\n")) diff --git a/scm/output-tex.scm b/scm/output-tex.scm index 17a0578e69..7ca908aac1 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -7,13 +7,14 @@ ;; (debug-enable 'backtrace) + +;; the public interface is tight. +;; It has to be, because user-code is evalled with this module. + (define-module (scm output-tex) #:re-export (quote) - #:export (define-fonts - font-command + #:export (font-command unknown - output-paper-def - output-scopes blank dot beam @@ -25,11 +26,7 @@ symmetric-x-triangle ez-ball comment - end-output - experimental-on repeat-slash - header-end - header placebox bezier-sandwich horizontal-line @@ -64,12 +61,13 @@ (string-encode-integer (inexact->exact (round (* 1000 (ly:font-magnification font))))))) + (define (unknown) "%\n\\unknown\n") (define-public (symbol->tex-key sym) (regexp-substitute/global - #f "_" (output-tex-string (symbol->string sym)) 'pre "X" 'post) ) + #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) ) (define (string->param string) (string-append "{" string "}")) @@ -127,24 +125,7 @@ (define (ez-ball c l b) (embedded-ps (list 'ez-ball c l b))) -(define (header-to-file fn key val) - (set! key (symbol->string key)) - (if (not (equal? "-" fn)) - (set! fn (string-append fn "." key)) - ) - (display - (format "Writing header field `~a' to `~a'..." - key - (if (equal? "-" fn) "" fn) - ) - (current-error-port)) - (if (equal? fn "-") - (display val) - (display val (open-file fn "w")) - ) - (display "\n" (current-error-port)) - "" - ) + (define (embedded-ps expr) (let ((ps-string @@ -168,7 +149,7 @@ (embedded-ps (list 'repeat-slash w a t))) -(define-public (output-tex-string s) ;; todo: rename +(define-public (sanitize-tex-string s) ;; todo: rename (if (ly:get-option 'safe) (regexp-substitute/global #f "\\\\" (regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post ) @@ -179,9 +160,9 @@ (define (lily-def key val) (let ((tex-key (regexp-substitute/global - #f "_" (output-tex-string key) 'pre "X" 'post)) + #f "_" (sanitize-tex-string key) 'pre "X" 'post)) - (tex-val (output-tex-string val))) + (tex-val (sanitize-tex-string val))) (if (equal? (sans-surrounding-whitespace tex-val) "") (string-append "\\let\\" tex-key "\\undefined\n") (string-append "\\def\\" tex-key "{" tex-val "}%\n")))) @@ -225,7 +206,6 @@ ;; LaTeX gets in the way, and we need to remap ;; nonprintable chars. - (input-enc-name #f) ;; (assoc-get 'input-name (ly:font-encoding-alist font) )) ) @@ -233,7 +213,7 @@ (if (string? input-enc-name) (string-append "\\inputencoding{" input-enc-name "}") "{}") - (output-tex-string + (sanitize-tex-string (if (vector? mapping) (reencode-string mapping s) s)) diff --git a/scm/page-layout.scm b/scm/page-layout.scm index 999c094748..15c14fcc0f 100644 --- a/scm/page-layout.scm +++ b/scm/page-layout.scm @@ -220,11 +220,12 @@ ; titling. (define-public (default-book-title paper scopes) "Generate book title from header strings." + (define (get sym) (let ((x (ly:modules-lookup scopes sym))) - (if (and x (not (unspecified? x))) x ""))) - + (if (markup? x) x ""))) + (let ((props (page-properties paper))) (interpret-markup -- 2.39.2