From: Jan Nieuwenhuizen Date: Sat, 21 Oct 2000 01:28:45 +0000 (+0200) Subject: patch::: 1.3.96.jcn4 X-Git-Tag: release/1.3.97~7 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c26d3ace597521dcc473ae70d9a058f6783d2c88;p=lilypond.git patch::: 1.3.96.jcn4 1.3.96.jcn4 =========== * Added new code for font selection and scm text markup. Only used for testing in \textscript SCM. See input/test/markup.ly. --- diff --git a/CHANGES b/CHANGES index e96d44c89e..bc926e0c50 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,9 @@ +1.3.96.jcn4 +=========== + +* Added new code for font selection and scm text markup. Only used + for testing in \textscript SCM. See input/test/markup.ly. + 1.3.96.jcn3 =========== diff --git a/VERSION b/VERSION index a09a984736..f6e5bfab63 100644 --- a/VERSION +++ b/VERSION @@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=3 PATCH_LEVEL=96 -MY_PATCH_LEVEL=jcn3 +MY_PATCH_LEVEL=jcn4 # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/input/test/markup.ly b/input/test/markup.ly new file mode 100644 index 0000000000..23647e7c84 --- /dev/null +++ b/input/test/markup.ly @@ -0,0 +1,24 @@ +% +% Test new font selection and scm text markup +% + +\score{ + \notes\relative c''{ + a-"text" + b-\textscript #"texta" + c-\textscript #'(bold "textb") + d-\textscript #'(lines "een" "twee" "drie") + e-\textscript #'(lines (bold "een") + (rows "en" "dat" "is" ((family . "orator") "2")) + (italic "drie")) + } + \paper{ + linewidth = -1.\mm; + \translator{ + \ScoreContext + TextScript \push #'style-sheet = #'paper16 + TextScript \push #'font-family = #'roman + TextScript \pop #'no-spacing-rods + } + } +} diff --git a/lily/include/musical-request.hh b/lily/include/musical-request.hh index e928984f3b..da3d1c484c 100644 --- a/lily/include/musical-request.hh +++ b/lily/include/musical-request.hh @@ -66,16 +66,17 @@ protected: VIRTUAL_COPY_CONS(Music); }; -class Text_script_req : public Script_req { +class Text_script_req : public Script_req +{ public: - String text_str_; + String text_str_; // to be deprecated + String style_str_; // to be deprecated + + SCM text_scm_; - // should be generic property of some kind.. - String style_str_; protected: VIRTUAL_COPY_CONS(Music); virtual bool do_equal_b (Request const*)const; - }; diff --git a/lily/include/text-item.hh b/lily/include/text-item.hh new file mode 100644 index 0000000000..1f8beff7dd --- /dev/null +++ b/lily/include/text-item.hh @@ -0,0 +1,25 @@ +/* + text-item.hh -- declare Text_item + + source file of the GNU LilyPond music typesetter + + (c) 1998--2000 Han-Wen Nienhuys + Jan Nieuwenhuizen + */ + +#ifndef TEXT_ITEM +#define TEXT_ITEM + +#include "lily-guile.hh" +#include "molecule.hh" + +class Text_item +{ +public: + DECLARE_SCHEME_CALLBACK (brew_molecule, (SCM)); + static Molecule text2molecule (Score_element *me, SCM text, SCM properties); + static Molecule string2molecule (Score_element *me, SCM text, SCM properties); + static Molecule markup_sentence2molecule (Score_element *me, SCM markup_sentence, SCM properties); +}; + +#endif /* TEXT_ITEM */ diff --git a/lily/lookup.cc b/lily/lookup.cc index 62ad7fbb91..ef4089ca36 100644 --- a/lily/lookup.cc +++ b/lily/lookup.cc @@ -197,6 +197,8 @@ Lookup::frame (Box b, Real thick) /* + JUNKME + TODO: THIS IS UGLY. Since the user has direct access to TeX marcos, that currently provide the only way to do @@ -236,7 +238,7 @@ sanitise_TeX_string (String text) } /** - TODO! + JUNKME */ String sanitise_PS_string (String t) @@ -245,7 +247,7 @@ sanitise_PS_string (String t) } /** -TODO: move into Text_item. UGH: paper_l argument shoudl be junked. + JUNKME */ Molecule Lookup::text (String style, String text, Paper_def *paper_l) diff --git a/lily/parser.yy b/lily/parser.yy index 8d64ac3d47..1a1021ea96 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -1064,6 +1064,12 @@ verbose_request: $$ = ts_p; } + | TEXTSCRIPT embedded_scm { + Text_script_req *ts_p = new Text_script_req; + ts_p->text_scm_ = $2; + ts_p->set_spot (THIS->here_input ()); + $$ = ts_p; + } | SPANREQUEST bare_int STRING { Span_req * sp_p = new Span_req; sp_p->span_dir_ = Direction($2); diff --git a/lily/text-engraver.cc b/lily/text-engraver.cc index 2a30a0a6fb..c16f43d46d 100644 --- a/lily/text-engraver.cc +++ b/lily/text-engraver.cc @@ -122,8 +122,14 @@ Text_engraver::do_process_music () if (r->get_direction ()) Side_position::set_direction (text, r->get_direction ()); - text->set_elt_property ("text", - ly_str02scm ( r->text_str_.ch_C ())); + if (r->text_str_.length_i ()) + text->set_elt_property ("text", + ly_str02scm ( r->text_str_.ch_C ())); + else + { + text->set_elt_property ("text", r->text_scm_); + text->set_elt_property ("scm-text", r->text_scm_); + } if (r->style_str_.length_i ()) text->set_elt_property ("style", ly_str02scm (r->style_str_.ch_C())); diff --git a/lily/text-item.cc b/lily/text-item.cc index feca94f884..7d242ed48e 100644 --- a/lily/text-item.cc +++ b/lily/text-item.cc @@ -3,45 +3,138 @@ source file of the GNU LilyPond music typesetter - (c) 1998--2000 Han-Wen Nienhuys - + (c) 1998--2000 Han-Wen Nienhuys + Jan Nieuwenhuizen */ -#include "debug.hh" -#include "molecule.hh" +#include "text-item.hh" #include "paper-def.hh" #include "lookup.hh" #include "staff-symbol-referencer.hh" +#include "staff-symbol-referencer.hh" +#include "main.hh" +#include "all-font-metrics.hh" +#include "afm.hh" + +/* + text: string | (markup sentence) + markup: markup-symbol | (markup-symbol . parameter) + sentence: text | sentence text + + + Properties: + + * Font: + ---* Type: + ------* Series: medium, bold + ------* Shape: upright, italic, slanted + ------* Family: roman, music, orator, typewriter + + ---* Size: + ------* size: ...,-2,-1,0,1,2,... (style-sheet -> cmrXX, fetaXX) + ------* points: 11,13,16,20,23,26 (for feta) + ------* magnification: UNSIGNED -struct Text_item + * Typesetting: + ---* kern: INT (staff-space) + ---* align: horizontal/vertical / lines / rows + */ +Molecule +Text_item::text2molecule (Score_element *me, SCM text, SCM properties) { - DECLARE_SCHEME_CALLBACK( brew_molecule, (SCM)); -}; + if (gh_string_p (text)) + return string2molecule (me, text, properties); + else if (gh_list_p (text)) + { + if (!gh_pair_p (gh_car (text)) && gh_string_p (gh_car (text))) + return string2molecule (me, gh_car (text), properties); + else + return markup_sentence2molecule (me, text, properties); + } + return Molecule (); +} +Molecule +Text_item::string2molecule (Score_element *me, SCM text, SCM properties) +{ + SCM f = me->get_elt_property ("get-font-name"); + SCM style = me->get_elt_property ("style-sheet"); + SCM font_name = gh_call2 (f, style, properties); + String font_str = "roman"; + if (gh_string_p (font_name)) + font_str = ly_scm2string (font_name); + + SCM magnification = me->get_elt_property ("font-magnification"); -MAKE_SCHEME_CALLBACK(Text_item,brew_molecule,1); + Font_metric* metric_l = 0; + if (gh_number_p (magnification)) + metric_l = all_fonts_global_p->find_scaled (font_str, + gh_scm2int (magnification)); + else + metric_l = all_fonts_global_p->find_font (font_str); -SCM -Text_item::brew_molecule (SCM sm) + SCM list = gh_list (ly_symbol2scm ("text"), text, SCM_UNDEFINED); + list = fontify_atom (metric_l, list); + + return Molecule (metric_l->text_dimension (ly_scm2string (text)), list); +} + +Molecule +Text_item::markup_sentence2molecule (Score_element *me, SCM markup_sentence, + SCM properties) { - Score_element * s = unsmob_element (sm); + SCM markup = gh_car (markup_sentence); + SCM sentence = gh_cdr (markup_sentence); + SCM f = me->get_elt_property ("markup-to-properties"); - SCM style = s->get_elt_property ("style"); - String st = gh_string_p (style) ? ly_scm2string (style) : ""; - SCM txt = s-> get_elt_property ("text"); - String t = gh_string_p (txt) ? ly_scm2string (txt) : ""; + SCM p = gh_cons (gh_call1 (f, markup), properties); - Molecule mol = s->paper_l ()->lookup_l(0)->text (st, t, s->paper_l ()); + Axis align = X_AXIS; + SCM a = scm_assoc (ly_symbol2scm ("align"), p); + if (gh_pair_p (a) && gh_number_p (gh_cdr (a))) + align = (Axis)gh_scm2int (gh_cdr (a)); - SCM space = s->get_elt_property ("word-space"); + Molecule mol; + while (gh_pair_p (sentence)) + { + Molecule m = text2molecule (me, gh_car (sentence), p); + if (!m.empty_b ()) + mol.add_at_edge (align, align == X_AXIS ? RIGHT : DOWN, m, 0); + sentence = gh_cdr (sentence); + } + return mol; +} + +MAKE_SCHEME_CALLBACK (Text_item, brew_molecule, 1); +SCM +Text_item::brew_molecule (SCM smob) +{ + Score_element *me = unsmob_element (smob); + + SCM text = me->get_elt_property ("scm-text"); + Molecule mol; + if (text == SCM_EOL) + { + SCM style = me->get_elt_property ("style"); + String st = gh_string_p (style) ? ly_scm2string (style) : ""; + SCM text = me->get_elt_property ("text"); + String t = gh_string_p (text) ? ly_scm2string (text) : ""; + + mol = me->paper_l ()->lookup_l (0)->text (st, t, me->paper_l ()); + } + else + mol = text2molecule (me, text, + gh_append2 (me->immutable_property_alist_, + me->mutable_property_alist_)); + + SCM space = me->get_elt_property ("word-space"); if (gh_number_p (space)) { Molecule m; m.set_empty (false); - mol.add_at_edge (X_AXIS, RIGHT, m, gh_scm2double (space)* - Staff_symbol_referencer::staff_space (s)); + mol.add_at_edge (X_AXIS, RIGHT, m, gh_scm2double (space) + * Staff_symbol_referencer::staff_space (me)); } return mol.create_scheme (); } - diff --git a/ly/declarations.ly b/ly/declarations.ly index 452bc2b2ca..21bafc0db1 100644 --- a/ly/declarations.ly +++ b/ly/declarations.ly @@ -5,6 +5,7 @@ maxima = \duration #'( -3 0 ) #(begin (eval-string (ly-gulp-file "slur.scm")) + (eval-string (ly-gulp-file "font.scm")) (eval-string (ly-gulp-file "generic-property.scm")) (eval-string (ly-gulp-file "basic-properties.scm")) ) @@ -50,7 +51,6 @@ papersize = "a4" \include "property.ly" - unusedEntry = \notes { c4 } % reset default duration % music = "\melodic\relative c" diff --git a/ly/engraver.ly b/ly/engraver.ly index 79b9632739..4b65ba68ed 100644 --- a/ly/engraver.ly +++ b/ly/engraver.ly @@ -851,6 +851,8 @@ ScoreContext = \translator { (no-spacing-rods . #t) (interfaces . (text-script-interface text-item-interface side-position-interface)) (padding . 0.5) + (get-font-name . ,get-font-name) + (markup-to-properties . ,markup-to-properties) (name . "TextScript") ) TextSpanner = #`( diff --git a/scm/font.scm b/scm/font.scm new file mode 100644 index 0000000000..f8fc42abcb --- /dev/null +++ b/scm/font.scm @@ -0,0 +1,97 @@ +;;; +;;; font.scm -- implement Font stuff +;;; +;;; source file of the GNU LilyPond music typesetter +;;; +;;; (c) 2000 Jan Nieuwenhuizen +;;; + + +;; corresponding properties: +;; +;; font-series font-shape font-family font-name font-size font-points +;; +(define style-sheet-alist + '( + (paper16 . ( + ("medium upright music feta 0 16" . "feta16") + ("medium upright music feta -1 13" . "feta13") + ("medium upright music feta -2 11" . "feta11") + ("medium upright music feta 1 20" . "feta20") + ("medium upright music feta 2 23" . "feta23") + ("medium upright orator feta-nummer 0 8" . "feta-nummer8") + ("medium upright orator feta-nummer -4 4" . "feta-nummer4") + ("medium upright roman cmr 0 8" . "cmr8") + ("medium upright roman cmr 1 10" . "cmr10") + ("bold upright roman cmbx 0 8" . "cmbx8") + ("bold upright roman cmbx 1 10" . "cmbx10") + ("medium italic roman cmbx 0 8" . "cmbx8") + ("medium italic roman cmbx 1 10" . "cmbx10") + )) + (paper20 . ( + ("medium upright music feta 0 20" . "feta20") + ("medium upright music feta -1 16" . "feta16") + ("medium upright music feta -2 13" . "feta13") + ("medium upright music feta 1 23" . "feta23") + ("medium upright music feta 2 26" . "feta26") + ("medium upright orator feta-nummer 0 10" . "feta-nummer10") + ("medium upright orator feta-nummer -4 5" . "feta-nummer5") + ("medium upright roman cmr 0 10" . "cmr10") + ("medium upright roman cmr 1 12" . "cmr12") + ("bold upright roman cmbx 0 10" . "cmbx10") + ("bold upright roman cmbx 1 12" . "cmbx12") + ("medium italic roman cmbx 0 10" . "cmbx10") + ("medium italic roman cmbx 1 12" . "cmbx12") + )) + )) + +(define (get-font-name style properties-alist) + (let ((font-regexp + (let loop ((p '(font-series font-shape font-family font-name font-size font-points)) (s "")) + (let* ((key (if (pair? p) (car p) p)) + (entry (assoc key properties-alist)) + (value (if entry (cdr entry) "[^ ]+"))) + (if (pair? (cdr p)) + (loop (cdr p) (string-append s value " ")) + (string-append (string-append s value)))))) + (style-sheet (cdr (assoc style style-sheet-alist)))) + ;;(display "regex: `") + ;;(display font-regexp) + ;;(display "'") + ;;(newline) + (let loop ((fonts style-sheet)) + ;;(display "font: `") + ;;(display (caar fonts)) + ;;(display "' = ") + ;;(display (cdar fonts)) + ;;(newline) + (if (string-match font-regexp (caar fonts)) + (cdar fonts) + (if (pair? (cdr fonts)) + (loop (cdr fonts)) + '()))))) + +(define markup-to-properties-alist + '((series . font-series) + (shape . font-shape) + (family . font-family) + (name . font-name) + (size . font-size) + (point . font-point))) + +(define markup-abbrev-to-properties-alist + '((rows . (align . 0)) + (lines . (align . 1)) + (roman . (font-family . "roman")) + (music . (font-family . "music")) + (bold . (font-series . "bold")) + (italic . (font-shape . "italic")))) + +(define (markup-to-properties markup) + ;;(display "markup: ") + ;;(display markup) + ;;(newline) + (if (pair? markup) + (cons (cdr (assoc (car markup) markup-to-properties-alist)) (cdr markup)) + (cdr (assoc markup markup-abbrev-to-properties-alist)))) +