From d448af4c1c7b7285b16e407f67ab67b0976a40be Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 21 Jun 2004 16:03:15 +0000 Subject: [PATCH] * buildscripts/guile-gnome.sh: Build without gcc libtool version juggling. * scm/framework-gnome.scm: Cleanups. Resurrect +/- canvas scaling. Add popup menu with grob properties. * lily/grob-scheme.cc (ly:grob-properties): (ly:grob-basic-properties): New function. * lily/stencil.cc (interpret_stencil_expression): Comment-out "no-origin" call. Fixes -fps output. * scm/output-ps.scm (no-origin): Add dummy implementation. * scm/output-gnome.scm (define-origin): Remove (grob-cause): Add. * scm/output-ps.scm (scm): * scm/output-tex.scm (scm): Remove define-origin from exports list. (define-origin): Remove. * scm/output-gnome.scm (define-origin): * scm/lily.scm (ly:all-output-backend-commands): Remove define-origin. Add grob-cause. --- ChangeLog | 28 +++ buildscripts/guile-gnome.sh | 46 ++-- lily/font-interface.cc | 7 +- lily/grob-scheme.cc | 23 ++ lily/grob.cc | 470 +++++++++++++++--------------------- lily/include/grob.hh | 4 + lily/parse-scm.cc | 9 + lily/stencil.cc | 5 + ly/init.ly | 14 +- scm/framework-gnome.scm | 183 ++++++++------ scm/lily.scm | 8 +- scm/output-gnome.scm | 9 +- scm/output-ps.scm | 6 +- scm/output-tex.scm | 32 +-- 14 files changed, 425 insertions(+), 419 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5274bd4156..b1da6c1cab 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,31 @@ +2004-06-21 Jan Nieuwenhuizen + + * buildscripts/guile-gnome.sh: Build without gcc libtool version + juggling. + + * scm/framework-gnome.scm: Cleanups. Resurrect +/- canvas scaling. + Add popup menu with grob properties. + + * lily/grob-scheme.cc (ly:grob-properties): + (ly:grob-basic-properties): New function. + + * lily/stencil.cc (interpret_stencil_expression): Comment-out + "no-origin" call. Fixes -fps output. + + * scm/output-ps.scm (no-origin): Add dummy implementation. + + * scm/output-gnome.scm (define-origin): Remove + (grob-cause): Add. + + * scm/output-ps.scm (scm): + * scm/output-tex.scm (scm): Remove define-origin from exports list. + (define-origin): Remove. + + * scm/output-gnome.scm (define-origin): + + * scm/lily.scm (ly:all-output-backend-commands): Remove + define-origin. Add grob-cause. + 2004-06-21 Heikki Junes * buildscripts/lilypond-words.py: add ly/portugues.ly. diff --git a/buildscripts/guile-gnome.sh b/buildscripts/guile-gnome.sh index 72806075f9..48d640511f 100644 --- a/buildscripts/guile-gnome.sh +++ b/buildscripts/guile-gnome.sh @@ -15,12 +15,15 @@ set -ex # Where user built stuff will be installed OPT=$HOME/usr/pkg -if [ -x /usr/bin/gcc34 ] ;then - export GCC=gcc34 -fi - -if [ -x /usr/bin/gcc-3.4 ] ;then - export GCC=gcc-3.4 +# Please state your love for the autotools today +if [ "$I_LOVE_AUTOTOOLS" = "no" ]; then + MY_LIBTOOL=$(dpkg -l libtool | tail -1 | awk '{ print $3 }') + PANGO_LIBTOOL=1.5.6-1 + if [ -x /usr/bin/gcc34 ] ;then + GCC34=gcc34 + elif [ -x /usr/bin/gcc-3.4 ] ;then + GCC34=gcc-3.4 + fi fi export AUTOMAKE=automake-1.8 @@ -28,16 +31,6 @@ export ACLOCAL=aclocal-1.8 export AUTOCONF=$(which autoconf2.50) export AUTOHEADER=$(which autoheader2.50) -MY_LIBTOOL=$(dpkg -l libtool | tail -1 | awk '{ print $3 }') -PANGO_LIBTOOL=1.5.6-1 - -# Please state your love for the autotools today -if [ -z "$I_LOVE_AUTOTOOLS" ]; then - I_LOVE_AUTOTOOLS=no -else - I_LOVE_AUTOTOOLS=yes -fi - if [ -z "$AUTOCONF" ]; then unset AUTOCONF fi @@ -111,7 +104,7 @@ rm -rf $OPT/g-wrap sh autogen.sh --noconfigure mkdir =build cd =build -../configure --prefix=$OPT/g-wrap +../configure --prefix=$OPT/g-wrap --enable-maintainer-mode make install # not a good idea @@ -135,13 +128,6 @@ cd src tla get guile-gnome-devel@gnu.org--2004/libgnomecanvas--dev libgnomecanvas rm -rf $OPT/guile-gnome -if false; then - libtoolize --copy --force - $AUTOHEADER - $ACLOCAL - $AUTOMAKE --copy --force - $AUTOCONF -fi sh autogen.sh --noconfigure mkdir ../=build cd ../=build @@ -150,8 +136,6 @@ export GUILE_LOAD_PATH=$OPT/g-wrap/share/guile/site:$GUILE_LOAD_PATH export LD_LIBRARY_PATH=$OPT/g-wrap/lib:$LD_LIBRARY_PATH PKG_CONFIG_PATH=$OPT/g-wrap/lib/pkgconfig:$PKG_CONFIG_PATH -../src/configure --prefix=$OPT/guile-gnome - # Using libtool < 1.6.0 together with gcc-3.4 may trigger this problem: # # If a tag has not been given, and we're using a compiler which is @@ -159,8 +143,14 @@ PKG_CONFIG_PATH=$OPT/g-wrap/lib/pkgconfig:$PKG_CONFIG_PATH # infer the compiler from the first word of the command line passed # to libtool. # -# Use gcc-3.3 or libtool-1.6.0 -make install CC=$GCC G_WRAP_MODULE_DIR=$OPT/g-wrap/share/guile/site +if [ -z "$GCC34" ]; then + # Use libtool-1.5.6, gcc-3.{2,3} without -O2, + CFLAGS='-O -g' ../src/configure --prefix=$OPT/guile-gnome --enable-maintainer-mode +else + # or use gcc-3.4 with libtool-1.6.0 + CC=$GCC34 ../src/configure --prefix=$OPT/guile-gnome --enable-maintainer-mode +fi +make install G_WRAP_MODULE_DIR=$OPT/g-wrap/share/guile/site GUILE_LOAD_PATH=$OPT/guile-gnome/share/guile:$GUILE_LOAD_PATH LD_LIBRARY_PATH=$OPT/guile-gnome/lib:$LD_LIBRARY_PATH diff --git a/lily/font-interface.cc b/lily/font-interface.cc index f8ff01ab65..31ddd6bc6d 100644 --- a/lily/font-interface.cc +++ b/lily/font-interface.cc @@ -21,8 +21,8 @@ Font_interface::get_default_font (Grob *me) Font_metric *fm = unsmob_metrics (me->get_property ("font")); if (!fm) { - - SCM defaults = me->get_paper ()->lookup_variable (ly_symbol2scm ("font-defaults")); + SCM defaults + = me->get_paper ()->lookup_variable (ly_symbol2scm ("font-defaults")); SCM chain = me->get_property_alist_chain (defaults); fm = select_font (me->get_paper (), chain); @@ -46,7 +46,8 @@ LY_DEFINE (ly_font_interface_get_default_font, "ly:get-default-font", SCM Font_interface::text_font_alist_chain (Grob *g) { - SCM defaults = g->get_paper ()->lookup_variable (ly_symbol2scm ("text-font-defaults")); + SCM defaults + = g->get_paper ()->lookup_variable (ly_symbol2scm ("text-font-defaults")); return g->get_property_alist_chain (defaults); } diff --git a/lily/grob-scheme.cc b/lily/grob-scheme.cc index 7b37fecab7..ce1438f064 100644 --- a/lily/grob-scheme.cc +++ b/lily/grob-scheme.cc @@ -111,6 +111,28 @@ LY_DEFINE (ly_grob_parent, "ly:grob-parent", return par ? par->self_scm () : SCM_EOL; } +LY_DEFINE (ly_grob_properties, "ly:grob-properties", + 1, 0, 0, (SCM grob), + "Get the mutable proprerties of @var{grob}.") +{ + Grob *g = unsmob_grob (grob); + SCM_ASSERT_TYPE (g, grob, SCM_ARG1, __FUNCTION__, "grob"); + + /* FIXME: uhg? copy/read only? */ + return g->mutable_property_alist_; +} + +LY_DEFINE (ly_grob_basic_properties, "ly:grob-basic-properties", + 1, 0, 0, (SCM grob), + "Get the immutable properties of @var{grob}.") +{ + Grob *g = unsmob_grob (grob); + SCM_ASSERT_TYPE (g, grob, SCM_ARG1, __FUNCTION__, "grob"); + + /* FIXME: uhg? copy/read only? */ + return g->immutable_property_alist_; +} + LY_DEFINE (ly_grob_system, "ly:grob-system", 1, 0, 0, (SCM g), "Return the System Grob of @var{g}.") @@ -200,3 +222,4 @@ LY_DEFINE (ly_item_break_dir, "ly:item-break-dir", SCM_ASSERT_TYPE (me, it, SCM_ARG1, __FUNCTION__, "Item"); return scm_int2num (me->break_status_dir ()); } + diff --git a/lily/grob.cc b/lily/grob.cc index a2f74e1040..acdc6b0d3f 100644 --- a/lily/grob.cc +++ b/lily/grob.cc @@ -29,62 +29,52 @@ #include "ly-smobs.icc" -/* -TODO: +/* TODO: -remove dynamic_cast and put this code into respective - subclass. -*/ + - remove dynamic_cast and put this code into respective + subclass. */ #define HASH_SIZE 3 #define INFINITY_MSG "Infinity or NaN encountered" Grob::Grob (SCM basicprops) { - /* - fixme: default should be no callback. - */ + /* FIXME: default should be no callback. */ self_scm_ = SCM_EOL; - pscore_=0; + pscore_= 0; status_ = 0; original_ = 0; immutable_property_alist_ = basicprops; mutable_property_alist_ = SCM_EOL; - /* - We do smobify_self () as the first step. Since the object lives on - the heap, none of its SCM variables are protected from GC. After - smobify_self (), they are. - */ + /* We do smobify_self () as the first step. Since the object lives + on the heap, none of its SCM variables are protected from + GC. After smobify_self (), they are. */ smobify_self (); - - SCM meta = get_property ("meta"); if (ly_c_pair_p (meta)) { SCM ifs = scm_assoc (ly_symbol2scm ("interfaces"), meta); - /* - Switch off interface checks for the moment. - */ + /* Switch off interface checks for the moment. */ bool itc = internal_type_checking_global_b; internal_type_checking_global_b = false; internal_set_property (ly_symbol2scm ("interfaces"), ly_cdr (ifs)); internal_type_checking_global_b = itc; } - - /* - TODO: - - destill this into a function, so we can re-init the immutable - properties with a new BASICPROPS value after creation. Convenient - eg. when using \override with StaffSymbol. */ - + + /* TODO: + + - destill this into a function, so we can re-init the immutable + properties with a new BASICPROPS value after + creation. Convenient eg. when using \override with + StaffSymbol. */ + char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"}; char const*xnames[] = {"X-extent", "Y-extent"}; char const*enames[] = {"X-extent-callback", "Y-extent-callback"}; - + for (int a = X_AXIS; a <= Y_AXIS; a++) { SCM l = get_property (onames[a]); @@ -95,29 +85,24 @@ Grob::Grob (SCM basicprops) dim_cache_[a].offsets_left_ = scm_ilength (l); } else - { - programming_error ("[XY]-offset-callbacks must be a list"); - } + programming_error ("[XY]-offset-callbacks must be a list"); SCM cb = get_property (enames[a]); SCM xt = get_property (xnames[a]); - - /* - Should change default to empty? - */ + + /* Should change default to empty? */ if (is_number_pair (xt)) cb = xt; else if (cb != SCM_BOOL_F && !ly_c_procedure_p (cb) && !ly_c_pair_p (cb) && ly_c_procedure_p (get_property ("print-function"))) cb = stencil_extent_proc; - + dim_cache_[a].dimension_ = cb; } - } -Grob::Grob (Grob const&s) +Grob::Grob (Grob const &s) : dim_cache_ (s.dim_cache_) { original_ = (Grob*) &s; @@ -125,11 +110,9 @@ Grob::Grob (Grob const&s) immutable_property_alist_ = s.immutable_property_alist_; mutable_property_alist_ = SCM_EOL; - - /* - No properties are copied. That is the job of handle_broken_dependencies. - */ - + + /* No properties are copied. That is the job of + handle_broken_dependencies. */ status_ = s.status_; pscore_ = 0; @@ -140,8 +123,7 @@ Grob::~Grob () { } - -MAKE_SCHEME_CALLBACK (Grob,stencil_extent,2); +MAKE_SCHEME_CALLBACK (Grob, stencil_extent, 2); SCM Grob::stencil_extent (SCM element_smob, SCM scm_axis) { @@ -149,27 +131,24 @@ Grob::stencil_extent (SCM element_smob, SCM scm_axis) Axis a = (Axis) ly_scm2int (scm_axis); Stencil *m = s->get_stencil (); - Interval e ; + Interval e; if (m) e = m->extent (a); return ly_interval2scm (e); } -Output_def* -Grob::get_paper () const +Output_def * +Grob::get_paper () const { return pscore_ ? pscore_->paper_ : 0; } -/* - Recursively track all dependencies of this Grob. The - status_ field is used as a mark-field. It is marked with - BUSY during execution of this function, and marked with FINAL - when finished. +/* Recursively track all dependencies of this Grob. The status_ field + is used as a mark-field. It is marked with BUSY during execution + of this function, and marked with FINAL when finished. - FUNCPTR is the function to call to update this element. -*/ + FUNCPTR is the function to call to update this element. */ void Grob::calculate_dependencies (int final, int busy, SCM funcname) { @@ -181,21 +160,17 @@ Grob::calculate_dependencies (int final, int busy, SCM funcname) programming_error ("Element is busy, come back later"); return; } - - status_= busy; + + status_ = busy; for (SCM d = get_property ("dependencies"); ly_c_pair_p (d); d = ly_cdr (d)) - { - unsmob_grob (ly_car (d)) - ->calculate_dependencies (final, busy, funcname); - } + unsmob_grob (ly_car (d))->calculate_dependencies (final, busy, funcname); - SCM proc = internal_get_property (funcname); if (ly_c_procedure_p (proc)) scm_call_1 (proc, this->self_scm ()); - + status_ = final; } @@ -203,50 +178,48 @@ Stencil * Grob::get_stencil () const { if (!is_live ()) - { - return 0; - } - - SCM mol = get_property ("stencil"); - if (unsmob_stencil (mol)) - return unsmob_stencil (mol); + return 0; + + SCM stil = get_property ("stencil"); + if (unsmob_stencil (stil)) + return unsmob_stencil (stil); + + stil = get_uncached_stencil (); - mol = get_uncached_stencil (); - if (is_live ()) { - Grob *me = (Grob*)this; - me->set_property ("stencil", mol); + Grob *me = (Grob*) this; + me->set_property ("stencil", stil); } - - return unsmob_stencil (mol); + + return unsmob_stencil (stil); } SCM -Grob::get_uncached_stencil ()const +Grob::get_uncached_stencil () const { SCM proc = get_property ("print-function"); - SCM mol = SCM_EOL; - if (ly_c_procedure_p (proc)) - mol = scm_apply_0 (proc, scm_list_n (this->self_scm (), SCM_UNDEFINED)); - - if (Stencil *m = unsmob_stencil (mol)) + SCM stil = SCM_EOL; + if (ly_c_procedure_p (proc)) + stil = scm_apply_0 (proc, scm_list_n (this->self_scm (), SCM_UNDEFINED)); + + if (Stencil *m = unsmob_stencil (stil)) { if (to_boolean (get_property ("transparent"))) - mol = Stencil (m->extent_box (), SCM_EOL).smobbed_copy (); - else - { - SCM expr = scm_list_3 (ly_symbol2scm ("grob-cause"), self_scm(), m->expr ()); - mol = Stencil (m->extent_box (),expr). smobbed_copy (); - } - } + stil = Stencil (m->extent_box (), SCM_EOL).smobbed_copy (); + else + { + SCM expr = scm_list_3 (ly_symbol2scm ("grob-cause"), self_scm(), + m->expr ()); + stil = Stencil (m->extent_box (),expr). smobbed_copy (); + } + } - return mol; + return stil; } /* - VIRTUAL STUBS */ @@ -262,12 +235,11 @@ Grob::get_system () const } void -Grob::add_dependency (Grob*e) +Grob::add_dependency (Grob *e) { if (e) - { - Pointer_group_interface::add_grob (this, ly_symbol2scm ("dependencies"),e); - } + Pointer_group_interface::add_grob (this, ly_symbol2scm ("dependencies"), + e); else programming_error ("Null dependency added"); } @@ -275,71 +247,54 @@ Grob::add_dependency (Grob*e) void Grob::handle_broken_dependencies () { - Spanner * sp = dynamic_cast (this); + Spanner *sp = dynamic_cast (this); if (original_ && sp) return; if (sp) - { - /* - This is the original spanner. We use a special function - because some Spanners have enormously long lists in their - properties. - */ - for (SCM s = mutable_property_alist_; ly_c_pair_p (s); - s = ly_cdr (s)) - { - sp->substitute_one_mutable_property (ly_caar (s), - ly_cdar (s)); - } - } + /* THIS, SP is the original spanner. We use a special function + because some Spanners have enormously long lists in their + properties, and a special function fixes FOO */ + for (SCM s = mutable_property_alist_; ly_c_pair_p (s); s = ly_cdr (s)) + sp->substitute_one_mutable_property (ly_caar (s), ly_cdar (s)); System *system = get_system (); if (is_live () - && system && common_refpoint (system, X_AXIS) && common_refpoint (system, Y_AXIS)) - { - substitute_mutable_properties (system ? system->self_scm () : SCM_UNDEFINED, - mutable_property_alist_); - } + && system && common_refpoint (system, X_AXIS) + && common_refpoint (system, Y_AXIS)) + substitute_mutable_properties (system + ? system->self_scm () : SCM_UNDEFINED, + mutable_property_alist_); else if (dynamic_cast (this)) - { - substitute_mutable_properties (SCM_UNDEFINED, mutable_property_alist_); - } + substitute_mutable_properties (SCM_UNDEFINED, mutable_property_alist_); else - { - /* - This element is `invalid'; it has been removed from all - dependencies, so let's junk the element itself. - - do not do this for System, since that would remove references - to the originals of score-grobs, which get then GC'd (a bad - thing.) - - */ - suicide (); - } + /* THIS element is `invalid'; it has been removed from all + dependencies, so let's junk the element itself. + + Do not do this for System, since that would remove references + to the originals of score-grobs, which get then GC'd (a bad + thing). */ + suicide (); } -/* - Note that we still want references to this element to be - rearranged, and not silently thrown away, so we keep pointers - like {broken_into_{drul,array}, original} +/* Note that we still want references to this element to be + rearranged, and not silently thrown away, so we keep pointers like + {broken_into_{drul, array}, original} */ void Grob::suicide () { if (!is_live ()) - return; + return; - mutable_property_alist_ = SCM_EOL; immutable_property_alist_ = SCM_EOL; set_extent (SCM_EOL, Y_AXIS); set_extent (SCM_EOL, X_AXIS); - for (int a= X_AXIS; a <= Y_AXIS; a++) + for (int a = X_AXIS; a <= Y_AXIS; a++) { dim_cache_[a].offset_callbacks_ = SCM_EOL; dim_cache_[a].offsets_left_ = 0; @@ -349,67 +304,52 @@ Grob::suicide () void Grob::handle_prebroken_dependencies () { - /* - Don't do this in the derived method, since we want to keep access to - mutable_property_alist_ centralized. - */ + /* Don't do this in the derived method, since we want to keep access to + mutable_property_alist_ centralized. */ if (original_) { - Item * it = dynamic_cast (this); + Item *it = dynamic_cast (this); substitute_mutable_properties (scm_int2num (it->break_status_dir ()), - original_->mutable_property_alist_); + original_->mutable_property_alist_); } } -Grob* -Grob::find_broken_piece (System*) const +Grob * +Grob::find_broken_piece (System *) const { return 0; } -/* - translate in one direction -*/ +/* Translate in one direction. */ void Grob::translate_axis (Real y, Axis a) { if (isinf (y) || isnan (y)) programming_error (_ (INFINITY_MSG)); else - { - dim_cache_[a].offset_ += y; - } -} + dim_cache_[a].offset_ += y; +} -/* - Find the offset relative to D. If D equals THIS, then it is 0. - Otherwise, it recursively defd as - - OFFSET_ + PARENT_L_->relative_coordinate (D) -*/ +/* Find the offset relative to D. If D equals THIS, then it is 0. + Otherwise, it recursively defd as + + OFFSET_ + PARENT_L_->relative_coordinate (D) */ Real -Grob::relative_coordinate (Grob const*refp, Axis a) const +Grob::relative_coordinate (Grob const *refp, Axis a) const { if (refp == this) return 0.0; - /* - We catch PARENT_L_ == nil case with this, but we crash if we did - not ask for the absolute coordinate (ie. REFP == nil.) - - */ + /* We catch PARENT_L_ == nil case with this, but we crash if we did + not ask for the absolute coordinate (ie. REFP == nil.) */ if (refp == dim_cache_[a].parent_) return get_offset (a); - else - return get_offset (a) + dim_cache_[a].parent_->relative_coordinate (refp, a); -} + return get_offset (a) + dim_cache_[a].parent_->relative_coordinate (refp, a); +} - -/* - Invoke callbacks to get offset relative to parent. -*/ +/* Invoke callbacks to get offset relative to parent. */ Real Grob::get_offset (Axis a) const { @@ -417,7 +357,7 @@ Grob::get_offset (Axis a) const while (dim_cache_[a].offsets_left_) { int l = --me->dim_cache_[a].offsets_left_; - SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_, scm_int2num (l)); + SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_, scm_int2num (l)); SCM retval = scm_call_2 (cb, self_scm (), scm_int2num (a)); Real r = ly_scm2double (retval); @@ -426,123 +366,102 @@ Grob::get_offset (Axis a) const programming_error (INFINITY_MSG); r = 0.0; } - me->dim_cache_[a].offset_ +=r; + me->dim_cache_[a].offset_ += r; } return dim_cache_[a].offset_; } - bool -Grob::is_empty (Axis a)const +Grob::is_empty (Axis a) const { - return ! (ly_c_pair_p (dim_cache_[a].dimension_) || - ly_c_procedure_p (dim_cache_[a].dimension_)); + return ! (ly_c_pair_p (dim_cache_[a].dimension_) + || ly_c_procedure_p (dim_cache_[a].dimension_)); } Interval -Grob::extent (Grob * refp, Axis a) const +Grob::extent (Grob *refp, Axis a) const { Real x = relative_coordinate (refp, a); - - Dimension_cache * d = (Dimension_cache *)&dim_cache_[a]; - Interval ext ; + Dimension_cache *d = (Dimension_cache *) &dim_cache_[a]; + Interval ext; if (ly_c_pair_p (d->dimension_)) ; else if (ly_c_procedure_p (d->dimension_)) - { - /* - FIXME: add doco on types, and should typecheck maybe? - */ - d->dimension_= scm_call_2 (d->dimension_, self_scm (), scm_int2num (a)); - } + /* FIXME: add doco on types, and should typecheck maybe? */ + d->dimension_= scm_call_2 (d->dimension_, self_scm (), scm_int2num (a)); else return ext; if (!ly_c_pair_p (d->dimension_)) return ext; - + ext = ly_scm2interval (d->dimension_); SCM extra = get_property (a == X_AXIS - ? "extra-X-extent" - : "extra-Y-extent"); + ? "extra-X-extent" + : "extra-Y-extent"); - /* - signs ? - */ + /* Signs ? */ if (ly_c_pair_p (extra)) { - ext[BIGGER] += ly_scm2double (ly_cdr (extra)); - ext[SMALLER] += ly_scm2double (ly_car (extra)); + ext[BIGGER] += ly_scm2double (ly_cdr (extra)); + ext[SMALLER] += ly_scm2double (ly_car (extra)); } - + extra = get_property (a == X_AXIS - ? "minimum-X-extent" - : "minimum-Y-extent"); + ? "minimum-X-extent" + : "minimum-Y-extent"); if (ly_c_pair_p (extra)) - { - ext.unite (Interval (ly_scm2double (ly_car (extra)), - ly_scm2double (ly_cdr (extra)))); - } + ext.unite (Interval (ly_scm2double (ly_car (extra)), + ly_scm2double (ly_cdr (extra)))); ext.translate (x); - + return ext; } -/* - Find the group-element which has both #this# and #s# -*/ -Grob * -Grob::common_refpoint (Grob const* s, Axis a) const +/* Find the group-element which has both #this# and #s# */ +Grob * +Grob::common_refpoint (Grob const *s, Axis a) const { - /* - I don't like the quadratic aspect of this code, but I see no other - way. The largest chain of parents might be 10 high or so, so - it shouldn't be a real issue. */ + /* I don't like the quadratic aspect of this code, but I see no + other way. The largest chain of parents might be 10 high or so, + so it shouldn't be a real issue. */ for (Grob const *c = this; c; c = c->dim_cache_[a].parent_) - for (Grob const * d = s; d; d = d->dim_cache_[a].parent_) + for (Grob const *d = s; d; d = d->dim_cache_[a].parent_) if (d == c) - return (Grob*)d; + return (Grob*) d; return 0; } - Grob * -common_refpoint_of_list (SCM elist, Grob *common, Axis a) +common_refpoint_of_list (SCM elist, Grob *common, Axis a) { for (; ly_c_pair_p (elist); elist = ly_cdr (elist)) - { - Grob * s = unsmob_grob (ly_car (elist)); - if (!s) - continue; - if (common) - common = common->common_refpoint (s, a); - else - common = s; - } + if (Grob *s = unsmob_grob (ly_car (elist))) + { + if (common) + common = common->common_refpoint (s, a); + else + common = s; + } return common; } - - Grob * -common_refpoint_of_array (Link_array const &arr, Grob *common, Axis a) +common_refpoint_of_array (Link_array const &arr, Grob *common, Axis a) { - for (int i = arr.size () ; i--; ) - { - Grob * s = arr[i]; - if (!s) - continue; - - if (common) - common = common->common_refpoint (s, a); - else - common = s; - } + for (int i = arr.size (); i--; ) + if (Grob *s = arr[i]) + { + if (common) + common = common->common_refpoint (s, a); + else + common = s; + } return common; } @@ -553,7 +472,7 @@ Grob::name () const SCM meta = get_property ("meta"); SCM nm = scm_assoc (ly_symbol2scm ("name"), meta); nm = (ly_c_pair_p (nm)) ? ly_cdr (nm) : SCM_EOL; - return ly_c_symbol_p (nm) ? ly_symbol2string (nm) : classname (this); + return ly_c_symbol_p (nm) ? ly_symbol2string (nm) : classname (this); } void @@ -561,7 +480,8 @@ Grob::add_offset_callback (SCM cb, Axis a) { if (!has_offset_callback (cb, a)) { - dim_cache_[a].offset_callbacks_ = scm_cons (cb, dim_cache_[a].offset_callbacks_); + dim_cache_[a].offset_callbacks_ + = scm_cons (cb, dim_cache_[a].offset_callbacks_); dim_cache_[a].offsets_left_ ++; } } @@ -572,7 +492,6 @@ Grob::has_extent_callback (SCM cb, Axis a)const return scm_equal_p (cb, dim_cache_[a].dimension_) == SCM_BOOL_T; } - bool Grob::has_offset_callback (SCM cb, Axis a)const { @@ -599,18 +518,18 @@ Grob::fixup_refpoint (SCM smob) for (int a = X_AXIS; a < NO_AXES; a ++) { Axis ax = (Axis)a; - Grob * parent = me->get_parent (ax); + Grob *parent = me->get_parent (ax); if (!parent) continue; - + if (parent->get_system () != me->get_system () && me->get_system ()) { - Grob * newparent = parent->find_broken_piece (me->get_system ()); + Grob *newparent = parent->find_broken_piece (me->get_system ()); me->set_parent (newparent, ax); } - if (Item * i = dynamic_cast (me)) + if (Item *i = dynamic_cast (me)) { Item *parenti = dynamic_cast (parent); @@ -619,7 +538,7 @@ Grob::fixup_refpoint (SCM smob) Direction my_dir = i->break_status_dir () ; if (my_dir!= parenti->break_status_dir ()) { - Item *newparent = parenti->find_prebroken_piece (my_dir); + Item *newparent = parenti->find_prebroken_piece (my_dir); me->set_parent (newparent, ax); } } @@ -632,23 +551,19 @@ void Grob::warning (String s)const { SCM cause = self_scm (); - while (Grob * g = unsmob_grob (cause)) - { - cause = g->get_property ("cause"); - } + while (Grob *g = unsmob_grob (cause)) + cause = g->get_property ("cause"); if (Music *m = unsmob_music (cause)) - { - m->origin ()->warning (s); - } + m->origin ()->warning (s); else ::warning (s); } void -Grob::programming_error (String s)const +Grob::programming_error (String s) const { - s = "Programming error: " + s; + s = "Programming error: " + s; warning (s); } @@ -657,36 +572,32 @@ Grob::programming_error (String s)const SMOB funcs ****************************************************/ - - IMPLEMENT_SMOBS (Grob); IMPLEMENT_DEFAULT_EQUAL_P (Grob); SCM Grob::mark_smob (SCM ses) { - Grob * s = (Grob*) SCM_CELL_WORD_1 (ses); + Grob *s = (Grob*) SCM_CELL_WORD_1 (ses); scm_gc_mark (s->immutable_property_alist_); - for (int a =0 ; a < 2; a++) + for (int a = 0 ; a < 2; a++) { scm_gc_mark (s->dim_cache_[a].offset_callbacks_); scm_gc_mark (s->dim_cache_[a].dimension_); - - /* - don't mark the parents. The pointers in the mutable property - list form two tree like structures (one for X relations, one - for Y relations). Marking these can be done in limited stack - space. If we add the parents, we will jump between X and Y in - an erratic manner, leading to much more recursion depth (and - core dumps if we link to pthreads.) - */ + + /* Do not mark the parents. The pointers in the mutable + property list form two tree like structures (one for X + relations, one for Y relations). Marking these can be done + in limited stack space. If we add the parents, we will jump + between X and Y in an erratic manner, leading to much more + recursion depth (and core dumps if we link to pthreads). */ } - + if (s->original_) scm_gc_mark (s->original_->self_scm ()); - s->do_derived_mark (); + s->do_derived_mark (); return s->mutable_property_alist_; } @@ -694,13 +605,11 @@ int Grob::print_smob (SCM s, SCM port, scm_print_state *) { Grob *sc = (Grob *) ly_cdr (s); - + scm_puts ("#name ().to_str0 (), port); + scm_puts ((char *) sc->name ().to_str0 (), port); - /* - don't try to print properties, that is too much hassle. - */ + /* Do not print properties, that is too much hassle. */ scm_puts (" >", port); return 1; } @@ -711,8 +620,6 @@ Grob::do_derived_mark () const return SCM_EOL; } - - void Grob::discretionary_processing () { @@ -726,14 +633,13 @@ Grob::internal_has_interface (SCM k) return scm_c_memq (k, ifs) != SCM_BOOL_F; } - -/** Return Array of Grobs in SCM list L */ +/** Return Array of Grobs in SCM list LST */ Link_array -ly_scm2grobs (SCM l) +ly_scm2grobs (SCM lst) { Link_array arr; - for (SCM s = l; ly_c_pair_p (s); s = ly_cdr (s)) + for (SCM s = lst; ly_c_pair_p (s); s = ly_cdr (s)) { SCM e = ly_car (s); arr.push (unsmob_grob (e)); @@ -785,7 +691,7 @@ ADD_INTERFACE (Grob, "grob-interface", "Mutable properties are variables that are specific to one grob. Typically, " "lists of other objects, or results from computations are stored in" "mutable properties: every call to set-grob-property (or its C++ equivalent) " - "sets a mutable property. " + "sets a mutable property. " , "X-offset-callbacks Y-offset-callbacks X-extent-callback stencil cause " diff --git a/lily/include/grob.hh b/lily/include/grob.hh index 314418ad1e..e3506c4071 100644 --- a/lily/include/grob.hh +++ b/lily/include/grob.hh @@ -47,7 +47,11 @@ private: protected: SCM immutable_property_alist_; SCM mutable_property_alist_; + + /* BARF */ friend class Spanner; + friend SCM ly_grob_properties (SCM); + friend SCM ly_grob_basic_properties (SCM); void substitute_mutable_properties (SCM, SCM); char status_; diff --git a/lily/parse-scm.cc b/lily/parse-scm.cc index 5156ae6623..77bf401435 100644 --- a/lily/parse-scm.cc +++ b/lily/parse-scm.cc @@ -1,3 +1,12 @@ +/* + parse-scm -- + + source file of the GNU LilyPond music typesetter + + (c) 2004 Han-Wen Nienhuys +*/ + + #include #include "ly-module.hh" diff --git a/lily/stencil.cc b/lily/stencil.cc index e81e228bed..e0604dbb12 100644 --- a/lily/stencil.cc +++ b/lily/stencil.cc @@ -220,7 +220,12 @@ interpret_stencil_expression (SCM expr, (*func) (func_arg, scm_list_2 (head, grob)); interpret_stencil_expression (ly_caddr (expr), func, func_arg, o); +#if 0 //FIXME: why do we need, this + endless loop? -- jcn (*func) (func_arg, scm_list_1 (ly_symbol2scm ("no-origin"))); +#else +#endif + //expr = ly_cadddr (expr); + return; } else { diff --git a/ly/init.ly b/ly/init.ly index d718f81ac3..416673bdad 100644 --- a/ly/init.ly +++ b/ly/init.ly @@ -1,4 +1,4 @@ -% Toplevel initialisation file. +%% Toplevel initialisation file. #(define-public point-and-click #f) #(define-public midi-debug #f) @@ -15,10 +15,10 @@ #(define $globalheader #f) \maininput -% there is a problem at the end of the input file +%% there is a problem at the end of the input file %% -%% above and below message is to compensate for look ahead of the parser. +%% Above and below comments compensate for the parser's look-ahead. %% #(if (and (ly:get-option 'old-relative) @@ -27,15 +27,15 @@ (ly:warn (string-append "\n" input-file-name ": old relative compatibility was not used." - )))% there is a problem at the end of the input file + )))%% there is a problem at the end of the input file #(if (pair? toplevel-scores) - (ly:parser-print-book parser (apply ly:make-book $defaultbookpaper $globalheader toplevel-scores))) + (ly:parser-print-book parser + (apply ly:make-book $defaultbookpaper $globalheader toplevel-scores))) #(if (ly:get-option 'verbose) (begin (gc) - (write (gc-stats) (current-error-port)) - )) + (write (gc-stats) (current-error-port)))) diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index 031cb3c972..cd701d279b 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -12,30 +12,15 @@ (use-modules (guile) (oop goops) (lily)) (use-modules + (srfi srfi-2) (ice-9 regex) (gnome gtk) - (gnome gtk gdk-event)) - -;; the name of the module will change to canvas rsn -(if (resolve-module '(gnome gw canvas)) - (use-modules (gnome gw canvas)) - (use-modules (gnome gw libgnomecanvas))) - -(define-public (output-framework-gnome outputter book scopes fields basename) - (newline (current-error-port)) - -; ;; Hmm, -; (let ((port (ly:outputter-get-output-port outputter))) -; (remove port) -; (close port)) + (gnome gtk gdk-event) + (gnome gw canvas)) +(define-public (output-framework outputter book scopes fields basename) (gnome-main book)) - -;; WTF? -- jcn -;; Yay, I *finally* found it! -(define-public output-framework output-framework-gnome) - (define SCROLLBAR-SIZE 20) (define BUTTON-HEIGHT 25) (define PANELS-HEIGHT 80) @@ -45,12 +30,13 @@ (define-public output-scale OUTPUT-SCALE) (define (stderr string . rest) - ;; debugging - (if #f - (begin - (apply format (cons (current-error-port) (cons string rest))) - (force-output (current-error-port))))) + (apply format (cons (current-error-port) (cons string rest))) + (force-output (current-error-port))) +(define (debugf string . rest) + (if #f + (stderr (cons string rest)))) + (define-class () (page-stencils ;;#:init-value '#() #:init-keyword #:page-stencils #:accessor page-stencils) @@ -60,8 +46,8 @@ (page-number #:init-value 0 #:accessor page-number) (pixels-per-unit #:init-value PIXELS-PER-UNIT #:accessor pixels-per-unit) (text-items #:init-value '() #:accessor text-items) - (location #:init-value #f #:accessor location) - (item-locations #:init-value (make-hash-table 31) #:accessor item-locations) + (grob #:init-value #f #:accessor grob) + (item-grobs #:init-value (make-hash-table 31) #:accessor item-grobs) (window-width #:init-keyword #:window-width #:accessor window-width) (window-height #:init-keyword #:window-height #:accessor window-height) (canvas-width #:init-keyword #:canvas-width #:accessor canvas-width) @@ -103,20 +89,15 @@ (add hbox button) ;; signals - (gtype-instance-signal-connect - button 'clicked (lambda (b) (gtk-main-quit))) - (gtype-instance-signal-connect - next 'clicked (lambda (b) (dump-page go (1+ (page-number go))))) - (gtype-instance-signal-connect - prev 'clicked (lambda (b) (dump-page go (1- (page-number go))))) - (gtype-instance-signal-connect - (window go) 'key-press-event key-press-event) + (connect button 'clicked (lambda (b) (gtk-main-quit))) + (connect next 'clicked (lambda (b) (dump-page go (1+ (page-number go))))) + (connect prev 'clicked (lambda (b) (dump-page go (1- (page-number go))))) + (connect (window go) 'key-press-event + (lambda (w e) (key-press-event go w e))) (show-all (window go)))) -(define-public global-go #f) - (define (gnome-main book) (let* ((book-paper (ly:paper-book-book-paper book)) (hsize (ly:output-def-lookup book-paper 'hsize)) @@ -142,6 +123,7 @@ desktop-height)))) ;; ugh. The GOOPS doc promises this is called automagically. + ;; possibly a goops 1.6.4 problem (initialize go) (map ly:pango-add-afm-decoder @@ -152,9 +134,6 @@ (dump-page go 0) - ;; ugh - (set! global-go go) - (gtk-main))) (define (dump-page go number) @@ -167,12 +146,12 @@ (new-canvas go) (set! (page-number go) number) - ;; no destroy method for gnome-canvas-text? + ;; no destroy method for gnome-canvas-text yet. ;;(map destroy (gtk-container-get-children main-canvas)) ;;(map destroy text-items) (set! (text-items go) '()) - (stderr "page-stencil ~S: ~S\n" + (debugf "page-stencil ~S: ~S\n" (page-number go) (vector-ref (page-stencils go) (page-number go))) @@ -200,9 +179,9 @@ ifs) (define (spawn-editor location) - (let* ((line (car location)) - (column (cadr location)) - (file-name (caddr location)) + (let* ((file-name (car location)) + (line (cadr location)) + (column (caddr location)) (template (substring (get-x-editor) 0)) ;; Adhere to %l %c %f? @@ -216,7 +195,7 @@ 'post) 'pre (number->string line) 'post))) - (stderr "spawning: ~s\n" command) + (debugf "spawning: ~s\n" command) (if (= (primitive-fork) 0) (let ((command-list (string-split command #\ )));; (get-ifs)))) (apply execlp command-list) @@ -224,34 +203,89 @@ (define location-callback spawn-editor) -;;(define (item-event item event . data) -(define-public (item-event item event . data) +(define (get-location grob) + (and-let* ((p? (procedure? point-and-click)) + (g grob) + (cause (ly:grob-property grob 'cause)) + (music-origin (if (ly:music? cause) + (ly:music-property cause 'origin) + ;; How come # [and '()] + ;; are #t? :-( + #f))) + (if (ly:input-location? music-origin) + (ly:input-location music-origin) + #f))) + +;;;(define (item-event go grob item event) +(define (item-event go item event) (case (gdk-event:type event) ((enter-notify) (gobject-set-property item 'fill-color "red")) ((leave-notify) (gobject-set-property item 'fill-color "black")) ((button-press) - - ;;FIXME - (let ((location (hashq-ref (item-locations global-go) item #f))) - - (if location - (location-callback location) - (stderr "no location\n")))) - ((2button-press) (gobject-set-property item 'fill-color "red"))) + (let ((button (gdk-event-button:button event))) + (cond + ((= button 1) + (and-let* ((grob (hashq-ref (item-grobs go) item #f)) + (location (get-location grob))) + (location-callback location))) + ((= button 2) + + (and-let* + ((grob (hashq-ref (item-grobs go) item #f))) + + (let ((properties (ly:grob-properties grob)) + (basic-properties (ly:grob-basic-properties grob)) + (x (inexact->exact (gdk-event-button:x-root event))) + (y (inexact->exact (gdk-event-button:y-root event)))) + + (debugf "GROB: ~S\n" grob) + (debugf "PROPERTIES: ~S\n" properties) + (debugf "BASIC PROPERTIES: ~S\n" basic-properties) + + (let ((window (make )) + (vbox (make )) + (button (make #:label "Ok"))) + + (add window vbox) + (connect button 'clicked (lambda (b) (destroy window))) + + (for-each + (lambda (x) + (let ((button (make + #:xalign 0.0 + #:label + (string-append + (symbol->string (car x)) + ": " + (format #f "~S" (cdr x)))))) + (set-size-request button 150 BUTTON-HEIGHT) + (add vbox button))) + properties) + (add vbox button) + + ;; FIXME: how to do window placement? + ;; - no effect: + (move window x y) + (show-all window) + ;; - shows actual movement: + (move window x y) + ))))))) + + ((2button-press) (gobject-set-property item 'fill-color "green"))) #t) -(define (scale-canvas factor) - (set! pixels-per-unit (* pixels-per-unit factor)) - (set-pixels-per-unit main-canvas pixels-per-unit) +(define (scale-canvas go factor) + (set! (pixels-per-unit go) (* (pixels-per-unit go) factor)) + (set-pixels-per-unit (canvas go) (pixels-per-unit go)) (for-each (lambda (x) (let ((scale (gobject-get-property x 'scale)) (points (gobject-get-property x 'size-points))) ;;(gobject-set-property x 'scale pixels-per-unit) (gobject-set-property x 'size-points (* points factor)))) - text-items)) + (text-items go))) -(define (key-press-event item event . data) +(define (key-press-event go item event) (let ((keyval (gdk-event-key:keyval event)) (mods (gdk-event-key:modifiers event))) (cond ((and (or (eq? keyval gdk:q) @@ -260,18 +294,16 @@ (gtk-main-quit)) ((and #t ;;(null? mods) (eq? keyval gdk:plus)) - (scale-canvas 2)) + (scale-canvas go 2)) ((and #t ;; (null? mods) (eq? keyval gdk:minus)) - (scale-canvas 0.5)) + (scale-canvas go 0.5)) ((or (eq? keyval gdk:Page-Up) (eq? keyval gdk:BackSpace)) - ;;FIXME - (dump-page global-go (1- (page-number global-go)))) + (dump-page go (1- (page-number go)))) ((or (eq? keyval gdk:Page-Down) (eq? keyval gdk:space)) - ;;FIXME - (dump-page global-go (1+ (page-number global-go))))) + (dump-page go (1+ (page-number go))))) #f)) (define (new-canvas go) @@ -292,16 +324,21 @@ (module-define! m 'output-scale output-scale) (set! output-gnome-module m))) output-gnome-module) - + (define-public (gnome-output-expression go expr) (let* ((m (get-output-gnome-module go)) (result (eval expr m))) (cond - ((and (pair? result) - (eq? (car result) 'location)) - (set! (location go) (cdr result))) + ((ly:grob? result) (set! (grob go) result)) ((is-a? result ) - (gtype-instance-signal-connect result 'event item-event) - (if (location go) - (hashq-set! (item-locations go) result (location go))))))) + + ;; AAARGH; grobs happen after stencils + ;; (connect result 'event (lambda (w e) (item-event go (grob go) w e))) + (connect result 'event (lambda (w e) (item-event go w e))) + (if (grob go) + (hashq-set! (item-grobs go) result (grob go))) + (set! (grob go) #f) + + (if (is-a? result ) + (set! (text-items go) (cons result (text-items go)))))))) diff --git a/scm/lily.scm b/scm/lily.scm index 558da6d475..be8817c90f 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -415,13 +415,15 @@ L1 is copied, L2 not. zigzag-line )) -;; TODO: generate this list by registering the output-backend-commands -;; output-backend-commands should have docstrings. +;; TODO: +;; - generate this list by registering the output-backend-commands +;; output-backend-commands should have docstrings. +;; - remove hard copies in output-ps output-tex (define-public (ly:all-output-backend-commands) "Return list of output backend commands." '( comment - define-origin + grob-cause no-origin placebox unknown diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 025b10afdd..93fa0e322e 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -244,6 +244,9 @@ lilypond-bin -fgnome input/simple-song.ly (define (horizontal-line x1 x2 thickness) (filledbox (- x1) (- x2 x1) (* .5 thickness) (* .5 thickness))) -(define (define-origin file line col) - (if (procedure? point-and-click) - (list 'location line col file))) +;;(define (define-origin file line col) +;; (if (procedure? point-and-click) +;; (list 'location line col file))) + +(define (grob-cause grob) + grob) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index aa36662364..4f352a68c1 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -17,6 +17,8 @@ (define-module (scm output-ps) #:re-export (quote) + + ;; JUNK this -- see lily.scm: ly:all-output-backend-commands #:export (unknown blank dot @@ -40,7 +42,6 @@ tuplet polygon draw-line - define-origin no-origin )) @@ -267,3 +268,6 @@ (define (grob-cause grob) "") + +(define (no-origin) + "") \ No newline at end of file diff --git a/scm/output-tex.scm b/scm/output-tex.scm index 80b3bea144..c75994d0c3 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -20,6 +20,8 @@ (define-module (scm output-tex) #:re-export (quote) + + ;; JUNK this -- see lily.scm: ly:all-output-backend-commands #:export (unknown blank dot @@ -43,7 +45,6 @@ tuplet polygon draw-line - define-origin no-origin grob-cause )) @@ -178,26 +179,19 @@ (define (draw-line thick fx fy tx ty) (embedded-ps (list 'draw-line thick fx fy tx ty))) -(define (define-origin file line col) - "") - ;; no-origin not yet supported by Xdvi (define (no-origin) "") (define (grob-cause grob) (if (procedure? point-and-click) - - (let* - ((cause (ly:grob-property grob 'cause)) - (music-origin (if (ly:music? cause) - (ly:music-property cause 'origin) - #f)) - (location (if (ly:input-location? music-origin) - (ly:input-location music-origin) - #f))) - - (if (pair? location) - (string-append "\\special{src:" ;;; \\string ? - (apply point-and-click location) "}") - "")) - "")) + (let* ((cause (ly:grob-property grob 'cause)) + (music-origin (if (ly:music? cause) + (ly:music-property cause 'origin))) + (location (if (ly:input-location? music-origin) + (ly:input-location music-origin)))) + (if (pair? location) + ;;; \\string ? + (string-append "\\special{src:" + (apply point-and-click location) "}") + "")) + "")) -- 2.39.2