From d74aff465ddeb01e9f21886e733e797cfc52f787 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 1 Dec 2002 15:49:59 +0000 Subject: [PATCH] * lily/font-interface.cc (get-font): take alist chain i.s.o. alist argument * scm/music-functions.scm (display-music): new function (music-map): change arg order. * input/regression/new-markup-syntax.scm: new file * lily/parser.yy (markup): add \markup { .. } syntax. * scm/new-markup.scm (override-markup): new function (lookup-markup): new function (music-markup): new function (lookup-markup-command): use markup-signature to store argument format for parser. * lily/lexer.ll: preliminary \markup syntax. --- ChangeLog | 21 +++++ VERSION | 2 +- input/regression/music-map.ly | 10 +- input/regression/new-markup-syntax.scm | 16 ++++ lily/font-interface.cc | 38 +++----- lily/include/my-lily-lexer.hh | 1 + lily/lexer.ll | 79 +++++++++++++++- lily/my-lily-lexer.cc | 1 + lily/parser.yy | 121 +++++++++++++++++++------ scm/bass-figure.scm | 8 +- scm/music-functions.scm | 19 ++-- scm/new-markup.scm | 65 ++++++++++--- 12 files changed, 295 insertions(+), 86 deletions(-) create mode 100644 input/regression/new-markup-syntax.scm diff --git a/ChangeLog b/ChangeLog index e0afc34206..ba427b3ca2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2002-12-01 Han-Wen Nienhuys + + * lily/font-interface.cc (get-font): take alist chain i.s.o. alist + argument + + * scm/music-functions.scm (display-music): new function + (music-map): change arg order. + + * input/regression/new-markup-syntax.scm: new file + + * lily/parser.yy (markup): add \markup { .. } syntax. + + * scm/new-markup.scm (override-markup): new function + (lookup-markup): new function + (music-markup): new function + (lookup-markup-command): use markup-signature to store argument + format for parser. + + * lily/lexer.ll: preliminary \markup syntax. + + 2002-11-30 Heikki Junes * make/lilypond.mandrake.spec.in: remove extra %changelog entries, diff --git a/VERSION b/VERSION index 60fe3bf00f..5306b48366 100644 --- a/VERSION +++ b/VERSION @@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=7 PATCH_LEVEL=8 -MY_PATCH_LEVEL= +MY_PATCH_LEVEL=hwn1 # Use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/input/regression/music-map.ly b/input/regression/music-map.ly index b92b85386b..ab7a2e5986 100644 --- a/input/regression/music-map.ly +++ b/input/regression/music-map.ly @@ -3,13 +3,13 @@ texidoc = "With @code{music-map}, you can apply functions operating on a single -piece of music to an entire music expression. In this example, the -scripts and dynamics of the first measure of music are applied to the -2nd measure. " +piece of music to an entire music expression. In this example, the the +function @code{notes-to-skip} changes a note to a skip. When applied +to an entire music expression in the 1st measure, the scripts and +dynamics are left over. These are put onto the 2nd measure." } - \version "1.7.8" #(define (notes-to-skip m) @@ -33,7 +33,7 @@ foobar = \notes \transpose c c' { c4-\>-^ c4-^ c4-\!-^ c4-^ } \notes \relative c'' \context Voice { \foobar - < \apply #(lambda (x) (music-map x notes-to-skip)) + < \apply #(lambda (x) (music-map notes-to-skip x)) \foobar { d2 d2 } > }} diff --git a/input/regression/new-markup-syntax.scm b/input/regression/new-markup-syntax.scm new file mode 100644 index 0000000000..f91d9c3cf8 --- /dev/null +++ b/input/regression/new-markup-syntax.scm @@ -0,0 +1,16 @@ +\header { +texidoc = "New markup syntax." + +} +\version "1.7.8" + + +\score { + \notes \transpose c d +%\apply #display-music + { + \property Voice.TextScript \set #'molecule-callback = #brew-new-markup-molecule + eses'-\markup { foo \bold bar \column < baz bazr > + \override #'(font-family . music) \lookup #"noteheads-0" + } } +} diff --git a/lily/font-interface.cc b/lily/font-interface.cc index f8fbf0dfaf..65d4c6a5a8 100644 --- a/lily/font-interface.cc +++ b/lily/font-interface.cc @@ -49,15 +49,10 @@ MAKE_SCHEME_CALLBACK(Font_interface, get_property_alist_chain, 1); SCM Font_interface::get_property_alist_chain (SCM grob) { - Grob * g = unsmob_grob (grob); SCM_ASSERT_TYPE(g, grob, SCM_ARG1, __FUNCTION__, "grob"); return font_alist_chain (g); - } - - - /* todo: split up this func, reuse in text_item? @@ -86,33 +81,28 @@ LY_DEFINE(ly_font_interface_get_default_font, } LY_DEFINE(ly_font_interface_get_font,"ly:get-font", 2, 0, 0, - (SCM grob, SCM alist), - "Return a font metric satisfying the font-qualifiers in @var{alist}. - - -The font object represents the metric information of a font. Every font -that is loaded into LilyPond can be accessed via Scheme. - -LilyPond only needs to know the dimension of glyph to be able to process -them. This information is stored in font metric files. LilyPond can read -two types of font-metrics: @TeX{} Font Metric files (TFM files) and -Adobe Font Metric files (AFM files). LilyPond will always try to load -AFM files first since they are more versatile. - -") + (SCM grob, SCM chain), + "Return a font metric satisfying the font-qualifiers in the alist chain @var{chain}.\n" +"\n" +"The font object represents the metric information of a font. Every font\n" +"that is loaded into LilyPond can be accessed via Scheme. \n" +"\n" +"LilyPond only needs to know the dimension of glyph to be able to process\n" +"them. This information is stored in font metric files. LilyPond can read\n" +"two types of font-metrics: @TeX{} Font Metric files (TFM files) and\n" +"Adobe Font Metric files (AFM files). LilyPond will always try to load\n" +"AFM files first since they are more versatile.\n" +"\n" +"An alist chain is a list of alists.\n") { Grob * gr = unsmob_grob (grob); SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob"); - Font_metric*fm= - Font_interface::get_font (gr, gh_cons (alist, - Font_interface::font_alist_chain (gr))); - + Font_metric*fm = Font_interface::get_font (gr, chain); return fm->self_scm(); } - Font_metric * Font_interface::get_font (Grob *me, SCM chain) { diff --git a/lily/include/my-lily-lexer.hh b/lily/include/my-lily-lexer.hh index e52d22573b..fcd89d07ec 100644 --- a/lily/include/my-lily-lexer.hh +++ b/lily/include/my-lily-lexer.hh @@ -59,6 +59,7 @@ public: SCM lookup_identifier (String s); void push_note_state (); + void push_markup_state (); void push_figuredbass_state (); void push_chord_state (); void push_lyric_state (); diff --git a/lily/lexer.ll b/lily/lexer.ll index dd55bf7b7e..39c9ce81d7 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -53,6 +53,8 @@ void strip_trailing_white (String&); void strip_leading_white (String&); String lyric_fudge (String s); +SCM +lookup_markup_command (String s); bool valid_version_b (String s); @@ -78,6 +80,7 @@ SCM scan_fraction (String); SCM (* scm_parse_error_handler) (void *); + %} %option c++ @@ -97,7 +100,7 @@ SCM (* scm_parse_error_handler) (void *); %x figures %x quote %x longcomment - +%x markup A [a-zA-Z] AA {A}|_ @@ -251,7 +254,7 @@ HYPHEN -- exit (1); } -# { //embedded scm +# { //embedded scm //char const* s = YYText () + 1; char const* s = here_str0 (); int n = 0; @@ -434,8 +437,64 @@ HYPHEN -- } +{ + \" { + start_quote (); + } + {NOTECOMMAND} { + String str (YYText() + 1); + SCM s = lookup_markup_command (str); + + if (gh_pair_p (s)) { + yylval.scm = gh_car(s); + SCM tag = gh_cdr(s); + if (tag == ly_symbol2scm("markup0")) + return MARKUP_HEAD_MARKUP0; + else if (tag == ly_symbol2scm ("markup0-markup1")) + return MARKUP_HEAD_MARKUP0_MARKUP1; + else if (tag == ly_symbol2scm ("markup-list0")) + return MARKUP_HEAD_LIST0; + else if (tag == ly_symbol2scm ("scm0")) + return MARKUP_HEAD_SCM0; + else if (tag == ly_symbol2scm ("scm0-scm1")) + return MARKUP_HEAD_SCM0_SCM1; + else if (tag == ly_symbol2scm ("scm0-markup1")) + return MARKUP_HEAD_SCM0_MARKUP1; + else if (tag == ly_symbol2scm ("scm0-scm1-markup2")) + return MARKUP_HEAD_SCM0_SCM1_MARKUP2; + else { + ly_display_scm (s); + assert(false); + } + } else + return scan_escaped_word (str); + } + {WORD} { + /* ugr. This sux. */ + String s (YYText ()); + if (s == "__") + return yylval.i = EXTENDER; + if (s == "--") + return yylval.i = HYPHEN; + s = lyric_fudge (s); + + char c = s[s.length () - 1]; + if (c == '{' || c == '}') // brace open is for not confusing dumb tools. + here_input ().warning ( + _ ("Brace found at end of lyric. Did you forget a space?")); + yylval.scm = scm_makfrom0str (s.to_str0 ()); + return STRING; + } + {WHITE} { + + } + . { + return YYText ()[0]; + } +} + <> { @@ -539,6 +598,12 @@ My_lily_lexer::push_lyric_state () yy_push_state (lyrics); } +void +My_lily_lexer::push_markup_state () +{ + yy_push_state (markup); +} + void My_lily_lexer::pop_state () { @@ -735,3 +800,13 @@ avoid_silly_flex_induced_gcc_warnings () yy_top_state (); avoid_silly_flex_induced_gcc_warnings (); } + +SCM +lookup_markup_command (String s) +{ + static SCM proc ; + if (!proc) + proc = scm_c_eval_string ("lookup-markup-command"); + + return scm_call_1 (proc, scm_makfrom0str (s.to_str0 ())); +} diff --git a/lily/my-lily-lexer.cc b/lily/my-lily-lexer.cc index d84fb082e3..2c1faf4cfb 100644 --- a/lily/my-lily-lexer.cc +++ b/lily/my-lily-lexer.cc @@ -52,6 +52,7 @@ static Keyword_ent the_key_tab[]={ {"lyrics", LYRICS}, {"key", KEY}, {"mark", MARK}, + {"markup", MARKUP}, {"once", ONCE}, {"pitch", PITCH}, {"time", TIME_T}, diff --git a/lily/parser.yy b/lily/parser.yy index 012e2be3d1..ae8f3226d3 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -274,6 +274,13 @@ yylex (YYSTYPE *s, void * v) %token UNSIGNED %token REAL +%token MARKUP +%token MARKUP_HEAD_MARKUP0 MARKUP_HEAD_SCM0_MARKUP1 MARKUP_HEAD_MARKUP0_MARKUP1 +%token MARKUP_HEAD_SCM0 MARKUP_HEAD_SCM0_MARKUP1 MARKUP_HEAD_SCM0_SCM1_MARKUP2 MARKUP_HEAD_SCM0_SCM1 + +%token MARKUP_IDENTIFIER MARKUP_HEAD_LIST0 +%type markup markup_line markup_list markup_list_body full_markup + %type output_def %type lilypond_header lilypond_header_body %type open_event_parens close_event_parens open_event close_event @@ -452,6 +459,9 @@ identifier_init: $$ = $1->self_scm (); scm_gc_unprotect_object ($$); } + | full_markup { + $$ = $1; + } | output_def { $$ = $1->self_scm (); scm_gc_unprotect_object ($$); @@ -1617,6 +1627,12 @@ gen_text_def: t->set_spot (THIS->here_input ()); $$ = t; } + | full_markup { + Music *t = MY_MAKE_MUSIC("TextScriptEvent"); + t->set_mus_property ("text", $1); + t->set_spot (THIS->here_input ()); + $$ = t; + } | string { Music *t = MY_MAKE_MUSIC("TextScriptEvent"); t->set_mus_property ("text", $1); @@ -2140,6 +2156,70 @@ questions: ; + +full_markup: + MARKUP + { THIS->lexer_->push_markup_state (); } + markup + { $$ = $3; + THIS->lexer_->pop_state (); + } + ; + +markup: + STRING { + static SCM simple; + if (!simple) + simple = scm_c_eval_string ("simple-markup"); + + $$ = scm_list_n (simple, $1, SCM_UNDEFINED); + } + | MARKUP_HEAD_MARKUP0 markup { + $$ = scm_list_n ($1, $2, SCM_UNDEFINED); + } + | MARKUP_HEAD_SCM0_MARKUP1 SCM_T markup { + $$ = scm_list_n ($1, $2, $3, SCM_UNDEFINED); + } + | markup_line { + $$ = $1; + } + | MARKUP_HEAD_LIST0 markup_list { + $$ = scm_list_n ($1,$2, SCM_UNDEFINED); + } + | MARKUP_HEAD_SCM0 embedded_scm { + $$ = scm_list_n ($1, $2, SCM_UNDEFINED); + } + | MARKUP_HEAD_SCM0_SCM1_MARKUP2 embedded_scm embedded_scm markup { + $$ = scm_list_n ($1, $2, $3, $4, SCM_UNDEFINED); + } + | MARKUP_IDENTIFIER { + $$ = $1; + } + + ; + +markup_list: + '<' markup_list_body '>' { $$ = scm_reverse_x ($2, SCM_EOL); } + ; + +markup_line: + '{' markup_list_body '}' { + static SCM line ; + if (!line) + line = scm_c_eval_string ("line-markup"); + + $$ = scm_list_n (line, scm_reverse_x ($2, SCM_EOL), SCM_UNDEFINED); + } + ; + +markup_list_body: + /**/ { $$ = SCM_EOL; } + | markup_list_body markup { + $$ = gh_cons ($2, $1) ; + } + ; + + %% void @@ -2184,6 +2264,13 @@ My_lily_parser::beam_check (SCM dur) } + +bool +markup_p (SCM x) +{ + return gh_pair_p (x) + && SCM_BOOL_F != scm_object_property (gh_car (x), ly_symbol2scm ("markup-signature")); +} /* It is a little strange, to have this function in this file, but otherwise, we have to import music classes into the lexer. @@ -2220,36 +2307,10 @@ My_lily_lexer::try_special_identifiers (SCM * destination, SCM sid) *destination = p->self_scm(); return MUSIC_OUTPUT_DEF_IDENTIFIER; + } else if (markup_p (sid)) { + *destination = sid; + return MARKUP_IDENTIFIER; } + return -1; } -#if 0 - -markup: - STRING { - $$ = scm_list_n (scm_c_eval_string ("simple-markup"), $1, SCM_UNDEFINED); - } - | MARKUP_HEAD0 markup - | MARKUP_HEAD1 SCM_T markup - | MARKUP_HEAD2 markup - | MARKUP_LIST_HEAD - | MARKUP_LIST_HEAD - | markup_list { - $$ = $1 - ; - -markup_list: - '<' markup_list_body '>' { $$ = scm_reverse_x ($1, SCM_EOL); } - ; - -markup_line: - '{' markup_list_body '}' { $$ = .. scm_reverse_x ($1, SCM_EOL); } - - ; -markup_list_body: - /**/ { $$ = SCM_EOL; } - markup_list_body markup { - $$ = gh_cons ($2, $1) ; - } - ; -#endif diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm index dee09c7391..b6230ee53b 100644 --- a/scm/bass-figure.scm +++ b/scm/bass-figure.scm @@ -5,8 +5,12 @@ (define (brew-one-figure grob fig-music) "Brew a single column for a music figure" (let* ( - (mf (ly:get-font grob '( (font-family . music) ))) - (nf (ly:get-font grob '( (font-family . number) ))) + (mf (ly:get-font grob (cons '((font-family . music)) + Font_interface::get_property_alist_chain + ))) + (nf (ly:get-font grob + (cons '((font-family . number)) + Font_interface::get_property_alist_chain))) (mol (ly:make-molecule '() '(0 . 0) '(0 . 1.0))) (fig (ly:get-mus-property fig-music 'figure)) (acc (ly:get-mus-property fig-music 'alteration)) diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 01e84057bf..7250dac3af 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -12,21 +12,27 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-public (music-map music function) +(define-public (music-map function music) "Apply @var{function} to @var{music} and all of the music it contains. " (let* ((es (ly:get-mus-property music 'elements)) (e (ly:get-mus-property music 'element)) ) (ly:set-mus-property! music 'elements - (map (lambda (y) (music-map y function)) es)) + (map (lambda (y) (music-map function y)) es)) (if (ly:music? e) - (ly:set-mus-property! music 'element (music-map e function))) + (ly:set-mus-property! music 'element (music-map function e))) (function music) )) +(define-public (display-one-music music) + (display music) + music + ) - +(define-public (display-music arg) + (music-map display-one-music arg)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -38,13 +44,12 @@ (e (ly:get-mus-property music 'element)) (n (ly:music-name music)) (f (lambda (x) (shift-duration-log x shift dot))) + (d (ly:get-mus-property music 'duration)) ) ;; FIXME: broken by the great music rename. - (if (or (equal? n "Note_req") - (equal? n "Rest_req")) + (if (ly:duration? d) (let* ( - (d (ly:get-mus-property music 'duration)) (cp (ly:duration-factor d)) (nd (ly:make-duration (+ shift (ly:duration-log d)) (+ dot (duration-dot-count d)) diff --git a/scm/new-markup.scm b/scm/new-markup.scm index 78cbb7779a..dcd7407d48 100644 --- a/scm/new-markup.scm +++ b/scm/new-markup.scm @@ -8,7 +8,7 @@ (define-public (line-markup grob props . rest) (stack-molecules X 1 1.0 - (map (lambda (x) (interpret_markup grob props x)) (car rest))) + (map (lambda (x) (interpret-markup grob props x)) (car rest))) ) (define (combine-molecule-list lst) @@ -17,37 +17,71 @@ )) (define-public (combine-markup grob props . rest) - (combine-molecule-list (map (lambda (x) (interpret_markup grob props x)) (car rest)))) + (combine-molecule-list (map (lambda (x) (interpret-markup grob props x)) (car rest)))) (define-public (bold-markup grob props . rest) - (interpret_markup grob (cons '((font-series . bold)) props) (car rest)) + (interpret-markup grob (cons (cons '(font-series . bold) (car props)) (cdr props)) (car rest)) ) (define-public (column-markup grob props . rest) (stack-molecules Y -1 0.0 - (map (lambda (x) (interpret_markup grob props x)) (car rest))) + (map (lambda (x) (interpret-markup grob props x)) (car rest))) ) -;; todo. Use macro? -(map - (lambda (x) +(define-public (music-markup grob props . rest) + (ly:find-glyph-by-name + (ly:get-font grob (cons '((font-family . music)) props)) + (car rest)) + ) + +(define-public (lookup-markup grob props . rest) + "Lookup a glyph by name." + (ly:find-glyph-by-name + (ly:get-font grob props) + (car rest)) + ) - (set-object-property! - (eval (string->symbol (string-append (symbol->string x) "-markup")) (current-module)) - 'markup-function? #t)) +(define-public (override-markup grob props . rest) + "Tack the 1st args in REST onto PROPS." + (interpret-markup grob (cons (list (car rest)) props) + (cadr rest))) + +(map (lambda (x) + (set-object-property! (car x) 'markup-signature (cdr x)) + ) + (list (cons bold-markup 'markup0) + (cons column-markup 'markup-list0) + (cons line-markup 'markup-list0) + (cons combine-markup 'markup0-markup1) + (cons simple-markup 'markup0) + (cons music-markup 'scm0) + (cons override-markup 'scm0-markup1) + (cons lookup-markup 'scm0) + )) + +(define markup-module (current-module)) + +(define-public (lookup-markup-command code) + (let* + ( (sym (string->symbol (string-append code "-markup"))) + (var (module-local-variable markup-module sym)) + ) + (if (eq? var #f) + #f + (cons (variable-ref var) (object-property (variable-ref var) 'markup-signature)) + ) + )) - '(simple column bold combine line ) - ) (define-public (brew-new-markup-molecule grob) - (interpret_markup grob + (interpret-markup grob (Font_interface::get_property_alist_chain grob) (ly:get-grob-property grob 'text) ) ) -(define (interpret_markup grob props markup) +(define (interpret-markup grob props markup) (let* ( (func (car markup)) @@ -57,9 +91,10 @@ (apply func (cons grob (cons props args)) ) )) + (define (new-markup? x) (markup-function? (car x)) ) (define (markup-function? x) - (object-property 'markup-function? x)) + (object-property 'markup-signature? x)) -- 2.39.2