summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog11
-rw-r--r--lily/include/paper-book.hh3
-rw-r--r--lily/ly-module.cc2
-rw-r--r--lily/paper-book.cc84
-rw-r--r--lily/score.cc17
-rw-r--r--ps/lilyponddefs.ps13
-rw-r--r--scm/framework-ps.scm206
-rw-r--r--scm/framework-tex.scm47
-rw-r--r--scm/lily.scm1
-rw-r--r--scm/output-ps.scm177
-rw-r--r--scm/output-tex.scm44
-rw-r--r--scm/page-layout.scm5
12 files changed, 341 insertions, 269 deletions
diff --git a/ChangeLog b/ChangeLog
index 5591eed334..96a8fe44a7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
2004-05-30 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * 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<Output_def*> (def)))
+ SCM context = ly_run_translator (music_, def->self_scm ());
+ if (dynamic_cast<Global_context*> (unsmob_context (context)))
{
- SCM context = ly_run_translator (music_, def->self_scm ());
- if (dynamic_cast<Global_context*> (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)
+ string<?))))
+
+ (string-append
+ (apply string-append (map font-load-encoding encodings))
+ (apply string-append
+ (map (lambda (x) (font-load-command x)) font-list)))))
+
+;; FIXME: duplicated in other output backends
+;; FIXME: silly interface name
+(define (output-variables paper)
+ ;; 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"
+ ))
+
+(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) "<stdout>" 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)
- string<?))))
-
- (string-append
- (apply string-append (map font-load-encoding encodings))
- (apply string-append
- (map (lambda (x) (font-load-command x)) font-list)))))
-
(define (define-origin file line col) "")
(define (dot x y radius)
@@ -268,26 +193,6 @@
(string-append (ly:numbers->string (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) "<stdout>" 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
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-08 20:26:30 +0000