From a1614949f9db4c9e1da87856597e3239bcbec187 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 30 May 2004 13:39:45 +0000 Subject: [PATCH 1/1] * scm/music-functions.scm (def-grace-function): move macros from ly/music-functions-init.ly * lily/paper-outputter.cc (Paper_outputter): move scheme_calls to framework-tex.scm * scm/framework-tex.scm (dump-line): new file. High level interface for output (pages, systems, header). * lily/include/page.hh (class Page): add is_last_ field. * lily/paper-outputter.cc (print_smob): smobify Paper_outputter. * lily/paper-book.cc (split_string): new function (output): output multiple formats, i.e. --format=ps,tex * lily/paper-outputter.cc (Paper_outputter): take format argument. --- ChangeLog | 23 +++- lily/include/page.hh | 4 +- lily/include/paper-book.hh | 11 +- lily/include/paper-outputter.hh | 31 ++---- lily/page.cc | 26 ++++- lily/paper-book.cc | 183 ++++++++++++++++++++------------ lily/paper-outputter.cc | 148 ++++++++++---------------- ly/music-functions-init.ly | 17 --- scm/framework-tex.scm | 181 +++++++++++++++++++++++++++++++ scm/lily.scm | 7 +- scm/music-functions.scm | 21 ++++ scm/output-tex.scm | 137 ++---------------------- 12 files changed, 444 insertions(+), 345 deletions(-) create mode 100644 scm/framework-tex.scm diff --git a/ChangeLog b/ChangeLog index 4dba19523b..5591eed334 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,9 +1,17 @@ -2004-05-30 Nicolas Sceaux +2004-05-30 Han-Wen Nienhuys - * ly/music-functions-init.ly (addlyrics): set the 'origin property - with the location argument in music function definitions. + * scm/music-functions.scm (def-grace-function): move macros from + ly/music-functions-init.ly -2004-05-30 Han-Wen Nienhuys + * lily/paper-outputter.cc (Paper_outputter): move scheme_calls to + framework-tex.scm + + * scm/framework-tex.scm (dump-line): new file. High level + interface for output (pages, systems, header). + + * lily/include/page.hh (class Page): add is_last_ field. + + * lily/paper-outputter.cc (print_smob): smobify Paper_outputter. * lily/paper-book.cc (split_string): new function (output): output multiple formats, i.e. --format=ps,tex @@ -19,7 +27,12 @@ * lily/clef-engraver.cc (create_clef): remove Staff_symbol_referencer::set_position() call. - + +2004-05-30 Nicolas Sceaux + + * ly/music-functions-init.ly (addlyrics): set the 'origin property + with the location argument in music function definitions. + 2004-05-29 Han-Wen Nienhuys * lily/staff-symbol-engraver.cc (acknowledge_grob): remove item -> diff --git a/lily/include/page.hh b/lily/include/page.hh index 338bec2941..cc351ac076 100644 --- a/lily/include/page.hh +++ b/lily/include/page.hh @@ -20,8 +20,9 @@ class Page public: Output_def *paper_; // todo: make private? Output_def * bookpaper () const; - static int page_count_; + static Real MIN_COVERAGE_; + int number_; int line_count_; SCM lines_; @@ -30,6 +31,7 @@ public: SCM copyright_; SCM tagline_; + bool is_last_; /* actual height filled with text. */ Real height_; diff --git a/lily/include/paper-book.hh b/lily/include/paper-book.hh index 7975a5aa9a..16aa45f983 100644 --- a/lily/include/paper-book.hh +++ b/lily/include/paper-book.hh @@ -22,11 +22,20 @@ struct Score_lines void gc_mark (); }; +/* + + DOCME. + +*/ class Paper_book { DECLARE_SMOBS (Paper_book, ); - Real height_; + SCM lines_; + SCM pages_; + + + Real height_; // what is this variable for? SCM copyright_; SCM tagline_; public: diff --git a/lily/include/paper-outputter.hh b/lily/include/paper-outputter.hh index cffab8cfb8..730748dd0a 100644 --- a/lily/include/paper-outputter.hh +++ b/lily/include/paper-outputter.hh @@ -16,37 +16,28 @@ #include "lily-guile.hh" #include "protected-scm.hh" -/** - Interface for a Grob to output itself; The Paper_score contains a - pointer to a Paper_outputter, and this enables every grob to output - itself. - - The Paper_outputter contains a reference to an output stream - (Paper_stream). */ - +/* + Glue between the backend (grobs, systems, pages) and the output file. + proxy for Scheme backends. +*/ class Paper_outputter { - bool verbatim_scheme_b_; SCM output_module_; - Protected_scm file_; + SCM file_; String filename_; - - void output_expr (SCM expr, Offset o); - void output_metadata (Output_def *, SCM); - void output_music_output_def (Output_def* odef); public: - Paper_outputter (String nm, String format); - ~Paper_outputter (); + DECLARE_SMOBS(Paper_outputter,); - void dump_scheme (SCM); +public: + SCM dump_string (SCM); void output_scheme (SCM scm); + Paper_outputter (String nm, String format); + SCM scheme_to_string (SCM); void output_stencil (Stencil); - void output_header (Output_def*, SCM, int, bool); - void output_line (SCM, Offset*, bool); - void output_page (Page*, bool); }; Paper_outputter* get_paper_outputter (String,String); +DECLARE_UNSMOB(Paper_outputter, outputter); #endif /* PAPER_OUTPUTTER_HH */ diff --git a/lily/page.cc b/lily/page.cc index a3dcdb6d10..b84131a677 100644 --- a/lily/page.cc +++ b/lily/page.cc @@ -16,7 +16,6 @@ #include "warn.hh" -int Page::page_count_ = 0; Real Page::MIN_COVERAGE_ = 0.66; Page::Page (Output_def *paper, int number) @@ -32,9 +31,7 @@ Page::Page (Output_def *paper, int number) height_ = 0; line_count_ = 0; - - page_count_++; - + is_last_ = false; header_ = scm_call_2 (paper_->c_variable ("make-header"), paper_->self_scm (), scm_int2num (number_)); @@ -207,9 +204,28 @@ Page::text_height () const LY_DEFINE (ly_page_paper_lines, "ly:page-paper-lines", 1, 0, 0, (SCM page), - "Return paper-lines from PAGE.") + "Return paper-lines from @var{page}.") { Page *p = unsmob_page (page); SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page"); return p->lines_; } + +LY_DEFINE (ly_page_stencil, "ly:page-stencil", + 1, 0, 0, (SCM page), + "Return stencil for @var{page}.") +{ + Page *p = unsmob_page (page); + SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page"); + return p->to_stencil ().smobbed_copy (); +} + + +LY_DEFINE (ly_page_last_p, "ly:page-last?", + 1, 0, 0, (SCM page), + "Is @var{page} the last one?") +{ + Page *p = unsmob_page (page); + SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page"); + return ly_bool2scm (p->is_last_); +} diff --git a/lily/paper-book.cc b/lily/paper-book.cc index c379fb090c..4ff0703274 100644 --- a/lily/paper-book.cc +++ b/lily/paper-book.cc @@ -37,6 +37,8 @@ stencil2line (Stencil stil, bool is_title = false) Paper_book::Paper_book () { + pages_ = SCM_EOL; + lines_ = SCM_EOL; copyright_ = SCM_EOL; tagline_ = SCM_EOL; header_ = SCM_EOL; @@ -66,6 +68,8 @@ Paper_book::mark_smob (SCM smob) if (b->bookpaper_) scm_gc_mark (b->bookpaper_->self_scm ()); scm_gc_mark (b->header_); + scm_gc_mark (b->pages_); + scm_gc_mark (b->lines_); return b->tagline_; } @@ -105,8 +109,17 @@ split_string (String s, char c) return rv; } - +SCM +dump_fields () +{ + SCM fields = SCM_EOL; + for (int i = dump_header_fieldnames_global.size (); i--; ) + fields + = scm_cons (ly_symbol2scm (dump_header_fieldnames_global[i].to_str0 ()), + fields); + return fields; +} /* TODO: there is too much code dup, and the interface is not @@ -120,7 +133,7 @@ Paper_book::output (String outname) return; /* Generate all stencils to trigger font loads. */ - SCM pages = this->pages (); + pages (); Array output_formats = split_string (output_format_global, ','); @@ -128,25 +141,92 @@ Paper_book::output (String outname) { String format = output_formats[i]; Paper_outputter *out = get_paper_outputter (outname + "." + output_formats[i], format); - int page_count = scm_ilength (pages); + + + SCM scopes = SCM_EOL; if (ly_c_module_p (header_)) scopes = scm_cons (header_, scopes); - out->output_header (bookpaper_, scopes, page_count, false); + String func_nm = output_format_global; + func_nm = "output-framework-" + func_nm; + + SCM func = ly_scheme_function (func_nm.to_str0 ()); + scm_apply_0 (func, scm_list_n (out->self_scm (), + self_scm (), + scopes, + dump_fields (), + scm_makfrom0str (outname.to_str0 ()), + SCM_UNDEFINED + )) ; + + scm_gc_unprotect_object (out->self_scm ()); + } +} - for (SCM s = pages; s != SCM_EOL; s = ly_cdr (s)) - { - Page *p = unsmob_page (ly_car (s)); - progress_indication ("[" + to_string (p->number_)); - out->output_page (p, ly_cdr (s) == SCM_EOL); - progress_indication ("]"); - } - out->output_scheme (scm_list_1 (ly_symbol2scm ("end-output"))); - progress_indication ("\n"); - } +void +Paper_book::classic_output (String outname) +{ + String format = "tex"; + Paper_outputter *out = get_paper_outputter (outname + "." + format, format); + + /* Generate all stencils to trigger font loads. */ + lines (); + + + // ugh code dup + SCM scopes = SCM_EOL; + if (ly_c_module_p (header_)) + scopes = scm_cons (header_, scopes); + + if (ly_c_module_p (score_lines_[0].header_)) + scopes = scm_cons (score_lines_[0].header_, scopes); + //end ugh + + String func_nm = output_format_global; + func_nm = "output-classic-framework-" + func_nm; + + SCM func = ly_scheme_function (func_nm.to_str0 ()); + scm_apply_0 (func, scm_list_n (out->self_scm (), + self_scm (), + scopes, + dump_fields (), + scm_makfrom0str (outname.to_str0 ()), + SCM_UNDEFINED + )) ; + + progress_indication ("\n"); +} + + + + +LY_DEFINE(ly_paper_book_pages, "ly:paper-book-pages", + 1,0,0, + (SCM pb), + "Return pages in book PB.") +{ + return unsmob_paper_book(pb)->pages (); +} + + +LY_DEFINE(ly_paper_book_lines, "ly:paper-book-lines", + 1,0,0, + (SCM pb), + "Return lines in book PB.") +{ + return unsmob_paper_book (pb)->lines (); +} + + +LY_DEFINE(ly_paper_book_book_paper, "ly:paper-book-book-paper", + 1,0,0, + (SCM pb), + "Return pages in book PB.") +{ + return unsmob_paper_book(pb)->bookpaper_->self_scm (); } Stencil @@ -184,51 +264,6 @@ Paper_book::title (int i) return title; } -void -Paper_book::classic_output (String outname) -{ - String format = "tex"; - Paper_outputter *out = get_paper_outputter (outname + "." + format, format); - - Output_def * p = bookpaper_; - while (p && p->parent_) - p = p->parent_; - - // ugh code dup - SCM scopes = SCM_EOL; - if (ly_c_module_p (header_)) - scopes = scm_cons (header_, scopes); - - if (ly_c_module_p (score_lines_[0].header_)) - scopes = scm_cons (score_lines_[0].header_, scopes); - //end ugh - - out->output_header (p, scopes, 0, true); - - SCM top_lines = score_lines_.top ().lines_; - Paper_line *first = unsmob_paper_line (scm_vector_ref (top_lines, - scm_int2num (0))); - Offset o (0, -0.5 * first->dim ()[Y_AXIS]); - int line_count = SCM_VECTOR_LENGTH (top_lines); - for (int i = 0; i < line_count; i++) - { - /* In classic compatibility TeX tracks how large things are, and - advances the Y pos for us. If we advance it too, we get too - much space. - - FIXME: vague... why is TeX is different from other ouput - backends, why not fix the TeX backend? -- jcn */ - if (format == "tex") - o = Offset (0, 0); - - out->output_line (scm_vector_ref (top_lines, scm_int2num (i)), - &o, i == line_count - 1); - } - - out->output_scheme (scm_list_1 (ly_symbol2scm ("end-output"))); - progress_indication ("\n"); -} - /* calculate book height, #lines, stencils. */ void Paper_book::init () @@ -276,29 +311,34 @@ Paper_book::init () SCM Paper_book::lines () { + if (ly_c_pair_p (lines_)) + return lines_; + int score_count = score_lines_.size (); - SCM lines = SCM_EOL; for (int i = 0; i < score_count; i++) { Stencil title = this->title (i); if (!title.is_empty ()) - lines = ly_snoc (stencil2line (title, true), lines); - lines = scm_append (scm_list_2 (lines, scm_vector_to_list (score_lines_[i].lines_))); + lines_ = scm_cons (stencil2line (title, true), lines_); + + lines_ = scm_append (scm_list_2 (scm_vector_to_list (score_lines_[i].lines_), lines_)); } - //debug helper; ughr + lines_ = scm_reverse (lines_); + int i = 0; - for (SCM s = lines; s != SCM_EOL; s = ly_cdr (s)) + for (SCM s = lines_; s != SCM_EOL; s = ly_cdr (s)) unsmob_paper_line (ly_car (s))->number_ = ++i; - return lines; + return lines_; } SCM Paper_book::pages () { - init (); - Page::page_count_ = 0; + if (ly_c_pair_p (pages_)) + return pages_; + init (); Output_def *paper = bookpaper_; Page *page = new Page (paper, 1); @@ -324,7 +364,6 @@ Paper_book::pages () if (unsmob_stencil (copyright_)) page->copyright_ = copyright_; - SCM pages = SCM_EOL; int page_count = SCM_VECTOR_LENGTH ((SCM) breaks); int line = 1; @@ -344,14 +383,18 @@ Paper_book::pages () all = ly_cdr (all); line++; } - pages = scm_cons (page->self_scm (), pages); + if (i == page_count-1) + page->is_last_ = true; + + pages_ = scm_cons (page->self_scm (), pages_); } /* Tagline on last page. */ if (unsmob_stencil (tagline_)) page->tagline_ = tagline_; - return scm_reverse (pages); + pages_ = scm_reverse (pages_); + return pages_; } static SCM diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc index f091341def..f7533b6c65 100644 --- a/lily/paper-outputter.cc +++ b/lily/paper-outputter.cc @@ -30,11 +30,17 @@ #include "string-convert.hh" #include "warn.hh" +#include "ly-smobs.icc" + // JUNKME extern SCM stencil2line (Stencil* stil, bool is_title = false); Paper_outputter::Paper_outputter (String filename, String format) { + file_ = SCM_EOL; + output_module_ = SCM_EOL; + smobify_self (); + filename_ = filename; file_ = scm_open_file (scm_makfrom0str (filename.to_str0 ()), scm_makfrom0str ("w")); @@ -45,113 +51,43 @@ Paper_outputter::Paper_outputter (String filename, String format) Paper_outputter::~Paper_outputter () { - scm_close_port (file_); - file_ = SCM_EOL; -} - -void -Paper_outputter::output_scheme (SCM scm) -{ - scm_display (scm_eval (scm, output_module_), file_); } -void -Paper_outputter::output_metadata (Output_def *paper, SCM scopes) +SCM +Paper_outputter::mark_smob (SCM x) { - SCM fields = SCM_EOL; - for (int i = dump_header_fieldnames_global.size (); i--; ) - fields - = scm_cons (ly_symbol2scm (dump_header_fieldnames_global[i].to_str0 ()), - fields); - - File_name file_name (filename_); - file_name.ext_ = ""; - String basename = file_name.to_string (); - output_scheme (scm_list_n (ly_symbol2scm ("output-scopes"), - paper->self_scm (), - ly_quote_scm (scopes), - ly_quote_scm (fields), - scm_makfrom0str (basename.to_str0 ()), - SCM_UNDEFINED)); + Paper_outputter * p = (Paper_outputter*) SCM_CELL_WORD_1(x); + scm_gc_mark (p->output_module_); + return p->file_; } -void -Paper_outputter::output_header (Output_def * bookpaper, - SCM scopes, - int page_count, - bool is_classic) +int +Paper_outputter::print_smob (SCM x, SCM p, scm_print_state*) { - String creator = gnu_lilypond_version_string (); - creator += " (http://lilypond.org)"; - time_t t (time (0)); - String time_stamp = ctime (&t); - time_stamp = time_stamp.left_string (time_stamp.length () - 1) - + " " + *tzname; - output_scheme (scm_list_n (ly_symbol2scm ("header"), - scm_makfrom0str (creator.to_str0 ()), - scm_makfrom0str (time_stamp.to_str0 ()), - bookpaper->self_scm (), // FIXME. - scm_int2num (page_count), - ly_bool2scm (is_classic), - SCM_UNDEFINED)); - - output_metadata (bookpaper, scopes); - output_scheme (scm_list_2 (ly_symbol2scm ("define-fonts"), - bookpaper->self_scm ())); - output_scheme (scm_list_1 (ly_symbol2scm ("header-end"))); + scm_puts ("#", p); + return 1; } -void -Paper_outputter::output_line (SCM line, Offset *origin, bool is_last) -{ - Paper_line *p = unsmob_paper_line (line); - Offset dim = p->dim (); - if (dim[Y_AXIS] > 50 CM) - { - programming_error (to_string ("Improbable line height: %f", - dim[Y_AXIS])); - dim[Y_AXIS] = 50 CM; - } - - output_scheme (scm_list_3 (ly_symbol2scm ("start-system"), - ly_quote_scm (ly_offset2scm (*origin)), - ly_quote_scm (ly_offset2scm (dim)))); - - output_stencil (p->to_stencil ()); - - (*origin)[Y_AXIS] += dim[Y_AXIS]; - output_scheme (scm_list_2 (ly_symbol2scm ("stop-system"), - ly_bool2scm (is_last))); +SCM +Paper_outputter::dump_string (SCM scm) +{ + return scm_display (scm,file_); } -void -Paper_outputter::output_page (Page *p, bool is_last) +SCM +Paper_outputter::scheme_to_string (SCM scm) { - Stencil page_stencil = p->to_stencil (); - output_scheme (scm_list_1 (ly_symbol2scm ("start-page"))); - output_scheme (scm_list_3 (ly_symbol2scm ("start-system"), - ly_quote_scm (ly_offset2scm (Offset (0, 0))), - ly_quote_scm (ly_offset2scm (Offset (0, 0))))); - - - output_stencil (page_stencil); - - output_scheme (scm_list_2 (ly_symbol2scm ("stop-system"), SCM_BOOL_T)); - output_scheme (scm_list_2 (ly_symbol2scm ("stop-page"), - ly_bool2scm (is_last - && !unsmob_stencil (p->footer_)))); + return scm_eval (scm, output_module_); } void -Paper_outputter::output_music_output_def (Output_def *odef) +Paper_outputter::output_scheme (SCM scm) { - output_scheme (scm_list_2 (ly_symbol2scm ("output-paper-def"), - odef->self_scm ())); + dump_string (scheme_to_string (scm)); } - void paper_outputter_dump (void * po, SCM x) { @@ -163,8 +99,8 @@ paper_outputter_dump (void * po, SCM x) void Paper_outputter::output_stencil (Stencil stil) { - interpret_stencil_expression (stil.expr (), paper_outputter_dump, - (void*) this, Offset (0,0)); + interpret_stencil_expression (stil.expr (), paper_outputter_dump, + (void*) this, Offset (0,0)); } Paper_outputter* @@ -175,3 +111,35 @@ get_paper_outputter (String outname, String f) return new Paper_outputter (outname, f); } + +IMPLEMENT_SMOBS(Paper_outputter); +IMPLEMENT_DEFAULT_EQUAL_P(Paper_outputter); + +LY_DEFINE(ly_outputter_dump_string, "ly:outputter-dump-stencil", + 2, 0,0, (SCM outputter, SCM stencil), + "Dump stencil @var{expr} onto @var{outputter}." + ) +{ + Paper_outputter* po = unsmob_outputter (outputter); + Stencil *st = unsmob_stencil (stencil); + + SCM_ASSERT_TYPE(po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + SCM_ASSERT_TYPE(st, stencil, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + + po->output_stencil (*st); + + return SCM_UNSPECIFIED; +} + + +LY_DEFINE(ly_outputter_dump_stencil, "ly:outputter-dump-string", + 2, 0, 0, (SCM outputter, SCM str), + "Dump @var{str} onto @var{outputter}.") +{ + Paper_outputter* po = unsmob_outputter (outputter); + SCM_ASSERT_TYPE(po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + SCM_ASSERT_TYPE(ly_c_string_p (str), str, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + + return po->dump_string (str); + return SCM_UNSPECIFIED; +} diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index 9ff677973e..e13994fe3f 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -1,14 +1,5 @@ \version "2.3.2" -#(defmacro-public def-music-function (args signature . body) - "Helper macro for `ly:make-music-function'. -Syntax: - (def-music-function (location arg1 arg2 ...) (arg1-type? arg2-type? ...) - ...function body...) -" - `(ly:make-music-function (list ,@signature) - (lambda (,@args) - ,@body))) applymusic = #(def-music-function (location func music) (procedure? ly:music?) (func music)) @@ -18,14 +9,6 @@ addlyrics = #(def-music-function (location music lyrics) (ly:music? ly:music?) 'origin location 'elements (list music lyrics))) -#(defmacro def-grace-function (start stop) - `(def-music-function (location music) (ly:music?) - (make-music 'GraceMusic - 'origin location - 'element (make-music 'SequentialMusic - 'elements (list (ly:music-deep-copy ,start) - music - (ly:music-deep-copy ,stop)))))) grace = #(def-grace-function startGraceMusic stopGraceMusic) acciaccatura = #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic) appoggiatura = #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic) diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm new file mode 100644 index 0000000000..5db44ada38 --- /dev/null +++ b/scm/framework-tex.scm @@ -0,0 +1,181 @@ + + +(define-module (scm framework-tex)) + +(use-modules (ice-9 regex) + (ice-9 string-fun) + (ice-9 format) + (guile) + (srfi srfi-13) + (scm output-tex) + (lily)) + + +(define (define-fonts bookpaper) + (string-append + "\\def\\lilypondpaperunit{mm}" ;; UGH. FIXME. + (tex-number-def "lilypondpaper" 'outputscale + (number->string (exact->inexact + (ly:bookpaper-outputscale bookpaper)))) + (tex-string-def "lilypondpapersize" 'papersize + (eval 'papersize (ly:output-def-scope bookpaper))) + + (apply string-append + (map (lambda (x) (font-load-command bookpaper x)) + (ly:bookpaper-fonts bookpaper) + )))) + +(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))) + + (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))) + (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n") + (string-append "\\def\\" prefix (symbol->tex-key key) + "{" (output-tex-string str) "}%\n"))) + +(define (header creator time-stamp bookpaper page-count classic?) + (string-append + "% Generated by " creator "\n" + "% at " time-stamp "\n" + (if classic? + (tex-string-def "lilypond" 'classic "1") + "") + ;; FIXME: duplicated in every backend + "\\def\\lilypondtagline{Engraved by LilyPond (version " + (lilypond-version)")}\n" + + ;; FIXME + ;; this is -of course- severely broken, (--hwn) + (tex-string-def "lilypondpaper" 'linewidth + (ly:number->string (/ 18 0.175))) ; 18 cm. + (tex-string-def "lilypondpaper" 'interscoreline + (ly:number->string 0.0)) + )) + +(define (header-end) + (string-append + "\\def\\scaletounit{ " + (number->string (cond + ((equal? (ly:unit) "mm") (/ 72.0 25.4)) + ((equal? (ly:unit) "pt") (/ 72.0 72.27)) + (else (error "unknown unit" (ly:unit))) + )) + " mul }%\n" + "\\ifx\\lilypondstart\\undefined\n" + " \\input lilyponddefs\n" + "\\fi\n" + "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n" + "\\lilypondstart\n" + "\\lilypondspecial\n" + "\\lilypondpostscript\n")) + + +(define (dump-page putter page) + (ly:outputter-dump-string + putter + "\n\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n") + (ly:outputter-dump-stencil putter (ly:page-stencil page)) + (ly:outputter-dump-string + putter + (if (ly:page-last? page) + "}\\vss\n}\n\\vfill\n" + "}\\vss\n}\n\\vfill\\lilypondpagebreak\n"))) + + +(define (dump-line putter line last?) + (ly:outputter-dump-string + putter + (string-append "\\leavevmode\n\\lybox{0}{0}{0}{" + (ly:number->string (ly:paper-line-height line)) + "}{")) + + (ly:outputter-dump-stencil putter (ly:paper-line-stencil line)) + (ly:outputter-dump-string + putter + (if last? + "}\\interscoreline\n" + "}%\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)) + (pages (ly:paper-book-pages book)) + ) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + (header "creator" + "timestamp" + bookpaper + (length pages) + #f + ) + + (output-scopes scopes fields basename) + (define-fonts bookpaper) + (header-end))) + + (for-each + (lambda (page) + (dump-page outputter page)) + pages) + (ly:outputter-dump-string outputter "\\lilypondend\n") + )) + +(define-public (output-classic-framework-tex outputter book scopes fields basename) + (let* + ((bookpaper (ly:paper-book-book-paper book)) + (lines (ly:paper-book-lines book)) + (last-line (car (last-pair lines)))) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + (header "creator" + "timestamp" + bookpaper + (length lines) + #f) + + (output-scopes scopes fields basename) + (define-fonts bookpaper) + (header-end))) + + (for-each + (lambda (line) + (dump-line outputter line (eq? line last-line))) + lines) + (ly:outputter-dump-string outputter "\\lilypondend\n") + )) + + + diff --git a/scm/lily.scm b/scm/lily.scm index f5e7790917..1dba8fdc59 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -380,14 +380,11 @@ L1 is copied, L2 not. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; output -(use-modules - ;(scm output-sketch) - ;(scm output-sodipodi) - ;(scm output-pdftex) - +(use-modules (scm framework-tex) ) + (define output-tex-module (make-module 1021 (list (resolve-interface '(scm output-tex))))) (define output-ps-module diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 62235b68ff..e63f9579a2 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -580,6 +580,27 @@ without context specification. Called from parser." (if (vector? props) (vector-reverse-map execute-1 props)))) + + +(defmacro-public def-grace-function (start stop) + `(def-music-function (location music) (ly:music?) + (make-music 'GraceMusic + 'origin location + 'element (make-music 'SequentialMusic + 'elements (list (ly:music-deep-copy ,start) + music + (ly:music-deep-copy ,stop)))))) + +(defmacro-public def-music-function (args signature . body) + "Helper macro for `ly:make-music-function'. +Syntax: + (def-music-function (location arg1 arg2 ...) (arg1-type? arg2-type? ...) + ...function body...) +" + `(ly:make-music-function (list ,@signature) + (lambda (,@args) + ,@body))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; switch it on here, so parsing and init isn't checked (too slow!) ;; diff --git a/scm/output-tex.scm b/scm/output-tex.scm index 461165da0e..17a0578e69 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -32,9 +32,6 @@ header placebox bezier-sandwich - start-system - stop-system - stop-last-system horizontal-line filledbox round-filled-box @@ -44,8 +41,6 @@ draw-line define-origin no-origin - start-page - stop-page )) (use-modules (ice-9 regex) @@ -69,24 +64,10 @@ (string-encode-integer (inexact->exact (round (* 1000 (ly:font-magnification font))))))) -(define (define-fonts bookpaper) - (string-append - "\\def\\lilypondpaperunit{mm}" ;; UGH. FIXME. - (tex-number-def "lilypondpaper" 'outputscale - (number->string (exact->inexact - (ly:bookpaper-outputscale bookpaper)))) - (tex-string-def "lilypondpapersize" 'papersize - (eval 'papersize (ly:output-def-scope bookpaper))) - - (apply string-append - (map (lambda (x) (font-load-command bookpaper x)) - (ly:bookpaper-fonts bookpaper) - )))) - (define (unknown) "%\n\\unknown\n") -(define (symbol->tex-key sym) +(define-public (symbol->tex-key sym) (regexp-substitute/global #f "_" (output-tex-string (symbol->string sym)) 'pre "X" 'post) ) @@ -99,62 +80,10 @@ (define (number-pair->param o) (string-append (number->param (car o)) (number->param (cdr o)))) -(define (tex-string-def prefix key str) - (if (equal? "" (sans-surrounding-whitespace (output-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"))) - -(define (tex-number-def prefix key number) +(define-public (tex-number-def prefix key number) (string-append "\\def\\" prefix (symbol->tex-key key) (string->param number) "%\n")) -(define (output-paper-def paper) - (apply - string-append - (module-map - (lambda (sym var) - (let ((val (variable-ref var)) - (key (symbol->tex-key sym))) - - (cond - ((string? val) - (tex-string-def "lilypondpaper" sym val)) - ((number? val) - (tex-number-def "lilypondpaper" sym - (if (integer? val) - (number->string val) - (number->string (exact->inexact val))))) - (else "")))) - - (ly:output-def-scope pd)))) - -(define (output-scopes paper 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))) - - (if (and (memq sym fields) (string? val)) - (header-to-file basename sym val)) - - (cond - ((string? val) - (tex-string-def "lilypond" sym val)) - ((number? val) - (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 (blank) "") @@ -184,7 +113,7 @@ (define (symmetric-x-triangle t w h) (embedded-ps (list 'symmetric-x-triangle t w h))) -(define (font-load-command bookpaper font) +(define-public (font-load-command bookpaper font) (string-append "\\font\\" (font-command font) "=" (ly:font-filename font) @@ -204,7 +133,7 @@ (set! fn (string-append fn "." key)) ) (display - (format "writing header field `~a' to `~a'..." + (format "Writing header field `~a' to `~a'..." key (if (equal? "-" fn) "" fn) ) @@ -238,43 +167,8 @@ (define (repeat-slash w a t) (embedded-ps (list 'repeat-slash w a t))) -(define (header-end) - (string-append - "\\def\\scaletounit{ " - (number->string (cond - ((equal? (ly:unit) "mm") (/ 72.0 25.4)) - ((equal? (ly:unit) "pt") (/ 72.0 72.27)) - (else (error "unknown unit" (ly:unit))) - )) - " mul }%\n" - "\\ifx\\lilypondstart\\undefined\n" - " \\input lilyponddefs\n" - "\\fi\n" - "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n" - "\\lilypondstart\n" - "\\lilypondspecial\n" - "\\lilypondpostscript\n")) - -(define (header creator time-stamp bookpaper page-count classic?) - (string-append - "% Generated by " creator "\n" - "% at " time-stamp "\n" - (if classic? - (tex-string-def "lilypond" 'classic "1") - "") - ;; FIXME: duplicated in every backend - "\\def\\lilypondtagline{Engraved by LilyPond (version " - (lilypond-version)")}\n" - - ;; FIXME - ;; this is -of course- severely broken, (--hwn) - (tex-string-def "lilypondpaper" 'linewidth - (ly:number->string (/ 18 0.175))) ; 18 cm. - (tex-string-def "lilypondpaper" 'interscoreline - (ly:number->string 0.0)) - )) - -(define (output-tex-string s) + +(define-public (output-tex-string s) ;; todo: rename (if (ly:get-option 'safe) (regexp-substitute/global #f "\\\\" (regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post ) @@ -304,18 +198,6 @@ (define (bezier-sandwich l thick) (embedded-ps (list 'bezier-sandwich `(quote ,l) thick))) -(define (start-system origin dim) - (string-append - "\\leavevmode\n" - "\\lybox" (number-pair->param origin) (number-pair->param dim) - "{%\n")) - -(define (stop-system last?) - (if last? - "}%\n" - ;; FIXME: still used by lilypond.py for --preview - "}%\n%\n\\interscoreline\n%\n")) - ;; WTF is this in every backend? (define (horizontal-line x1 x2 th) (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th))) @@ -377,10 +259,3 @@ ;; no-origin not yet supported by Xdvi (define (no-origin) "") -(define (start-page) - "\n\\vbox to 0pt{\n") - -(define (stop-page last?) - (if last? - "\\vss\n}\n\\vfill\n" - "\\vss\n}\n\\vfill\\lilypondpagebreak\n")) -- 2.39.2