lily/score-element.cc

   1 /*
   2   score-elem.cc -- implement Score_element
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9
  10 #include <string.h>
  11 #include <math.h>
  12
  13 #include "input-smob.hh"
  14 #include "libc-extension.hh"
  15 #include "group-interface.hh"
  16 #include "misc.hh"
  17 #include "paper-score.hh"
  18 #include "paper-def.hh"
  19 #include "lookup.hh"
  20 #include "molecule.hh"
  21 #include "score-element.hh"
  22 #include "debug.hh"
  23 #include "spanner.hh"
  24 #include "line-of-score.hh"
  25 #include "item.hh"
  26 #include "paper-column.hh"
  27 #include "molecule.hh"
  28 #include "misc.hh"
  29 #include "paper-outputter.hh"
  30 #include "dimension-cache.hh"
  31 #include "side-position-interface.hh"
  32 #include "item.hh"
  33
  34 #include "ly-smobs.icc"
  35
  36 /*
  37 TODO:
  38
  39 remove dynamic_cast<Spanner,Item> and put this code into respective
  40   subclass.
  41 */
  42
  43
  44 #define INFINITY_MSG "Infinity or NaN encountered"
  45
  46 Score_element::Score_element(SCM basicprops)
  47 {
  48   /*
  49     fixme: default should be no callback.
  50    */
  51
  52   pscore_l_=0;
  53   lookup_l_ =0;
  54   status_i_ = 0;
  55   original_l_ = 0;
  56   immutable_property_alist_ =  basicprops;
  57   mutable_property_alist_ = SCM_EOL;
  58
  59   smobify_self ();
  60
  61   char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"};
  62   char const*enames[] = {"X-extent-callback", "Y-extent-callback"};
  63
  64   for (int a = X_AXIS; a <= Y_AXIS; a++){
  65     SCM l = get_elt_property (onames[a]);
  66
  67     if (scm_ilength (l) >=0)
  68       {
  69         dim_cache_[a].offset_callbacks_ = l;
  70         dim_cache_[a].offsets_left_ = scm_ilength (l);
  71       }
  72     else
  73       {
  74         programming_error ("[XY]-offset-callbacks must be a list");
  75       }
  76
  77     SCM cb = get_elt_property (enames[a]);
  78
  79     /*
  80       Should change default to be empty?
  81      */
  82     if (!gh_procedure_p (cb) && !gh_pair_p (cb))
  83       cb = molecule_extent_proc;
  84
  85     dim_cache_[a].dimension_ = cb;
  86   }
  87 }
  88
  89
  90 Score_element::Score_element (Score_element const&s)
  91    : dim_cache_ (s.dim_cache_)
  92 {
  93   original_l_ =(Score_element*) &s;
  94   immutable_property_alist_ = s.immutable_property_alist_;
  95   mutable_property_alist_ = SCM_EOL;
  96
  97   status_i_ = s.status_i_;
  98   lookup_l_ = s.lookup_l_;
  99   pscore_l_ = s.pscore_l_;
 100
 101   smobify_self ();
 102 }
 103
 104 Score_element::~Score_element()
 105 {
 106   /*
 107     do nothing scm-ish and no unprotecting here.
 108    */
 109 }
 110
 111
 112 SCM
 113 Score_element::get_elt_property (const char *nm) const
 114 {
 115   SCM sym = ly_symbol2scm (nm);
 116   return get_elt_property (sym);
 117 }
 118
 119 SCM
 120 Score_element::get_elt_property (SCM sym) const
 121 {
 122   SCM s = scm_sloppy_assq(sym, mutable_property_alist_);
 123   if (s != SCM_BOOL_F)
 124     return gh_cdr (s);
 125
 126   s = scm_sloppy_assq (sym, immutable_property_alist_);
 127   return (s == SCM_BOOL_F) ? SCM_EOL : gh_cdr (s);
 128 }
 129
 130 /*
 131   Remove the value associated with KEY, and return it. The result is
 132   that a next call will yield SCM_UNDEFINED (and not the underlying
 133   `basic' property.
 134 */
 135 SCM
 136 Score_element::remove_elt_property (const char* key)
 137 {
 138   SCM val = get_elt_property (key);
 139   if (val != SCM_EOL)
 140     set_elt_property (key, SCM_EOL);
 141   return val;
 142 }
 143
 144 void
 145 Score_element::set_elt_property (const char* k, SCM v)
 146 {
 147   SCM s = ly_symbol2scm (k);
 148   set_elt_property (s, v);
 149 }
 150
 151 /*
 152   Puts the k, v in the immutable_property_alist_, which is convenient for
 153   storing variables that are needed during the breaking process. (eg.
 154   Line_of_score::rank : int )
 155  */
 156 void
 157 Score_element::set_immutable_elt_property (const char*k, SCM v)
 158 {
 159   SCM s = ly_symbol2scm (k);
 160   set_immutable_elt_property (s, v);
 161 }
 162
 163 void
 164 Score_element::set_immutable_elt_property (SCM s, SCM v)
 165 {
 166   immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_);
 167   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s);
 168 }
 169 void
 170 Score_element::set_elt_property (SCM s, SCM v)
 171 {
 172   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 173 }
 174
 175
 176 MAKE_SCHEME_CALLBACK(Score_element,molecule_extent,2);
 177 SCM
 178 Score_element::molecule_extent (SCM element_smob, SCM scm_axis)
 179 {
 180   Score_element *s = unsmob_element (element_smob);
 181   Axis a = (Axis) gh_scm2int (scm_axis);
 182
 183   Molecule m = s->get_molecule ();
 184   return ly_interval2scm ( m.extent(a));
 185 }
 186
 187 MAKE_SCHEME_CALLBACK(Score_element,preset_extent,2);
 188
 189 SCM
 190 Score_element::preset_extent (SCM element_smob, SCM scm_axis)
 191 {
 192   Score_element *s = unsmob_element (element_smob);
 193   Axis a = (Axis) gh_scm2int (scm_axis);
 194
 195   SCM ext = s->get_elt_property ((a == X_AXIS)
 196                                  ? "extent-X"
 197                                  : "extent-Y");
 198
 199   if (gh_pair_p (ext))
 200     {
 201       Real l = gh_scm2double (gh_car (ext));
 202       Real r = gh_scm2double (gh_cdr (ext));
 203       l *= s->paper_l ()->get_var ("staffspace");
 204       r *= s->paper_l ()->get_var ("staffspace");
 205       return ly_interval2scm (Interval (l, r));
 206     }
 207
 208   return ly_interval2scm ( Interval ());
 209 }
 210
 211
 212
 213 Paper_def*
 214 Score_element::paper_l ()  const
 215 {
 216  return pscore_l_ ? pscore_l_->paper_l_ : 0;
 217 }
 218
 219 Lookup const *
 220 Score_element::lookup_l () const
 221 {
 222   /*
 223     URG junkthis, caching is clumsy.
 224    */
 225   if (!lookup_l_)
 226     {
 227       Score_element * urg = (Score_element*)this;
 228       SCM sz = urg->remove_elt_property ("font-size");
 229       int i = (gh_number_p (sz))
 230         ? gh_scm2int  (sz)
 231         : 0;
 232
 233       urg->lookup_l_ =  (Lookup*)pscore_l_->paper_l_->lookup_l (i);
 234     }
 235   return lookup_l_;
 236 }
 237
 238 void
 239 Score_element::calculate_dependencies (int final, int busy, SCM funcname)
 240 {
 241   assert (status_i_ >=0);
 242
 243   if (status_i_ >= final)
 244     return;
 245
 246   if (status_i_== busy)
 247     {
 248       programming_error ("Element is busy, come back later");
 249       return;
 250     }
 251
 252   status_i_= busy;
 253
 254   for (SCM d=  get_elt_property ("dependencies"); gh_pair_p (d); d = gh_cdr (d))
 255     {
 256       unsmob_element (gh_car (d))
 257         ->calculate_dependencies (final, busy, funcname);
 258     }
 259
 260   // ughugh.
 261   String s = ly_symbol2string (funcname);
 262   SCM proc = get_elt_property (s.ch_C());
 263   if (gh_procedure_p (proc))
 264     gh_call1 (proc, this->self_scm ());
 265
 266   status_i_= final;
 267
 268 }
 269
 270 Molecule
 271 Score_element::get_molecule ()  const
 272 {
 273   SCM proc = get_elt_property ("molecule-callback");
 274
 275   SCM mol = SCM_EOL;
 276   if (gh_procedure_p (proc))
 277     mol = gh_apply (proc, gh_list (this->self_scm (), SCM_UNDEFINED));
 278
 279
 280   SCM origin =get_elt_property ("origin");
 281   if (!unsmob_input (origin))
 282     origin =ly_symbol2scm ("no-origin");
 283
 284   if (gh_pair_p (mol))
 285     {
 286       // ugr.
 287         mol = gh_cons (gh_list (origin, gh_car (mol), SCM_UNDEFINED), gh_cdr (mol));
 288     }
 289
 290
 291   Molecule m (create_molecule (mol));
 292
 293   /*
 294     This is almost the same as setting molecule-callback to #f, but
 295     this retains the dimensions of this element, which means that you
 296     can erase elements individually.  */
 297   if (to_boolean (get_elt_property ("transparent")))
 298     m = Molecule (m.extent_box (), SCM_EOL);
 299
 300   return m;
 301 }
 302
 303
 304 /*
 305
 306   VIRTUAL STUBS
 307
 308  */
 309 void
 310 Score_element::do_break_processing()
 311 {
 312 }
 313
 314
 315
 316
 317
 318 MAKE_SCHEME_CALLBACK(Score_element,brew_molecule,1)
 319
 320 /*
 321   ugh.
 322  */
 323 SCM
 324 Score_element::brew_molecule (SCM smob)
 325 {
 326   Score_element * sc = unsmob_element (smob);
 327   SCM glyph = sc->get_elt_property ("glyph");
 328   if (gh_string_p (glyph))
 329     {
 330       return sc->lookup_l ()->afm_find (String (ly_scm2string (glyph))).create_scheme ();
 331     }
 332   else
 333     {
 334       return SCM_EOL;
 335     }
 336 }
 337
 338
 339 Line_of_score *
 340 Score_element::line_l() const
 341 {
 342   return 0;
 343 }
 344
 345 void
 346 Score_element::add_dependency (Score_element*e)
 347 {
 348   if (e)
 349     {
 350       Pointer_group_interface ::add_element (this, "dependencies",e);
 351
 352     }
 353   else
 354     programming_error ("Null dependency added");
 355 }
 356
 357
 358
 359
 360 /**
 361       Do break substitution in S, using CRITERION. Return new value.
 362       CRITERION is either a SMOB pointer to the desired line, or a number
 363       representing the break direction. Do not modify SRC.
 364 */
 365 SCM
 366 Score_element::handle_broken_smobs (SCM src, SCM criterion)
 367 {
 368  again:
 369   Score_element *sc = unsmob_element (src);
 370   if (sc)
 371     {
 372       if (gh_number_p (criterion))
 373         {
 374           Item * i = dynamic_cast<Item*> (sc);
 375           Direction d = to_dir (criterion);
 376           if (i && i->break_status_dir () != d)
 377             {
 378               Item *br = i->find_prebroken_piece (d);
 379               return  (br) ? br->self_scm () : SCM_UNDEFINED;
 380             }
 381         }
 382       else
 383         {
 384           Line_of_score * line
 385             = dynamic_cast<Line_of_score*> (unsmob_element (criterion));
 386           if (sc->line_l () != line)
 387             {
 388               sc = sc->find_broken_piece (line);
 389
 390             }
 391
 392           /* now: !sc || (sc && sc->line_l () == line) */
 393           if (!sc)
 394             return SCM_UNDEFINED;
 395
 396           /* now: sc && sc->line_l () == line */
 397           if (!line
 398               || (sc->common_refpoint (line, X_AXIS)
 399                   && sc->common_refpoint (line, Y_AXIS)))
 400             {
 401               return sc->self_scm ();
 402             }
 403           return SCM_UNDEFINED;
 404         }
 405     }
 406   else if (gh_pair_p (src))
 407     {
 408       SCM oldcar =gh_car (src);
 409       /*
 410         UGH! breaks on circular lists.
 411       */
 412       SCM newcar = handle_broken_smobs (oldcar, criterion);
 413       SCM oldcdr = gh_cdr (src);
 414
 415       if (newcar == SCM_UNDEFINED
 416           && (gh_pair_p (oldcdr) || oldcdr == SCM_EOL))
 417         {
 418           /*
 419             This is tail-recursion, ie.
 420
 421             return handle_broken_smobs (cdr, criterion);
 422
 423             We don't want to rely on the compiler to do this.  Without
 424             tail-recursion, this easily crashes with a stack overflow.  */
 425           src =  oldcdr;
 426           goto again;
 427         }
 428
 429       SCM newcdr = handle_broken_smobs (oldcdr, criterion);
 430       return gh_cons (newcar, newcdr);
 431     }
 432   else
 433     return src;
 434
 435   return src;
 436 }
 437
 438 void
 439 Score_element::handle_broken_dependencies()
 440 {
 441   Spanner * s= dynamic_cast<Spanner*> (this);
 442   if (original_l_ && s)
 443     return;
 444
 445   if (s)
 446     {
 447       for (int i = 0;  i< s->broken_into_l_arr_ .size (); i++)
 448         {
 449           Score_element * sc = s->broken_into_l_arr_[i];
 450           Line_of_score * l = sc->line_l ();
 451           sc->mutable_property_alist_ =
 452             handle_broken_smobs (mutable_property_alist_,
 453                                  l ? l->self_scm () : SCM_UNDEFINED);
 454         }
 455     }
 456
 457
 458   Line_of_score *line = line_l();
 459
 460   if (line && common_refpoint (line, X_AXIS) && common_refpoint (line, Y_AXIS))
 461     {
 462       mutable_property_alist_
 463         = handle_broken_smobs (mutable_property_alist_,
 464                                line ? line->self_scm () : SCM_UNDEFINED);
 465     }
 466   else if (dynamic_cast <Line_of_score*> (this))
 467     {
 468       mutable_property_alist_ = handle_broken_smobs (mutable_property_alist_,
 469                                             SCM_UNDEFINED);
 470     }
 471   else
 472     {
 473       /*
 474         This element is `invalid'; it has been removed from all
 475         dependencies, so let's junk the element itself.
 476
 477         do not do this for Line_of_score, since that would remove
 478         references to the originals of score-elts, which get then GC'd
 479         (a bad thing.)
 480       */
 481       suicide();
 482     }
 483 }
 484
 485 /*
 486  Note that we still want references to this element to be
 487  rearranged, and not silently thrown away, so we keep pointers
 488  like {broken_into_{drul,array}, original}
 489 */
 490 void
 491 Score_element::suicide ()
 492 {
 493   mutable_property_alist_ = SCM_EOL;
 494   immutable_property_alist_ = SCM_EOL;
 495
 496   set_extent_callback (SCM_EOL, Y_AXIS);
 497   set_extent_callback (SCM_EOL, X_AXIS);
 498
 499   for (int a= X_AXIS; a <= Y_AXIS; a++)
 500     {
 501       dim_cache_[a].offset_callbacks_ = SCM_EOL;
 502       dim_cache_[a].offsets_left_ = 0;
 503     }
 504 }
 505
 506 void
 507 Score_element::handle_prebroken_dependencies()
 508 {
 509 }
 510
 511 Score_element*
 512 Score_element::find_broken_piece (Line_of_score*) const
 513 {
 514   return 0;
 515 }
 516
 517 void
 518 Score_element::translate_axis (Real y, Axis a)
 519 {
 520   if (isinf (y) || isnan (y))
 521     programming_error (_(INFINITY_MSG));
 522   else
 523     {
 524       dim_cache_[a].offset_ += y;
 525     }
 526 }
 527
 528 Real
 529 Score_element::relative_coordinate (Score_element const*refp, Axis a) const
 530 {
 531   if (refp == this)
 532     return 0.0;
 533
 534   /*
 535     We catch PARENT_L_ == nil case with this, but we crash if we did
 536     not ask for the absolute coordinate (ie. REFP == nil.)
 537
 538    */
 539   if (refp == dim_cache_[a].parent_l_)
 540     return get_offset (a);
 541   else
 542     return get_offset (a) + dim_cache_[a].parent_l_->relative_coordinate (refp, a);
 543 }
 544
 545 Real
 546 Score_element::get_offset (Axis a) const
 547 {
 548   Score_element *me = (Score_element*) this;
 549   while (dim_cache_[a].offsets_left_)
 550     {
 551       int l = --me->dim_cache_[a].offsets_left_;
 552       SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_,  gh_int2scm (l));
 553       SCM retval = gh_call2 (cb, self_scm (), gh_int2scm (a));
 554
 555       Real r =  gh_scm2double (retval);
 556       if (isinf (r) || isnan (r))
 557         {
 558           programming_error (INFINITY_MSG);
 559           r = 0.0;
 560         }
 561       me->dim_cache_[a].offset_ +=r;
 562     }
 563   return dim_cache_[a].offset_;
 564 }
 565
 566
 567 MAKE_SCHEME_CALLBACK(Score_element,point_dimension_callback,2);
 568 SCM
 569 Score_element::point_dimension_callback (SCM , SCM )
 570 {
 571   return ly_interval2scm ( Interval (0,0));
 572 }
 573
 574 bool
 575 Score_element::empty_b (Axis a)const
 576 {
 577   return ! (gh_pair_p (dim_cache_[a].dimension_ ) ||
 578             gh_procedure_p (dim_cache_[a].dimension_ ));
 579 }
 580
 581 /*
 582   TODO: add
 583
 584     Score_element *refpoint
 585
 586   to arguments?
 587  */
 588 Interval
 589 Score_element::extent (Score_element * refp, Axis a) const
 590 {
 591   Real x = relative_coordinate (refp, a);
 592
 593
 594   Dimension_cache * d = (Dimension_cache *)&dim_cache_[a];
 595   Interval ext ;
 596   if (gh_pair_p (d->dimension_))
 597     ;
 598   else if (gh_procedure_p (d->dimension_))
 599     {
 600       /*
 601         FIXME: add doco on types, and should typecheck maybe?
 602        */
 603       d->dimension_= gh_call2 (d->dimension_, self_scm(), gh_int2scm (a));
 604     }
 605   else
 606     return ext;
 607
 608   ext = ly_scm2interval (d->dimension_);
 609
 610   SCM extra = get_elt_property (a == X_AXIS
 611                                 ? "extra-extent-X"
 612                                 : "extra-extent-Y");
 613
 614   /*
 615     signs ?
 616    */
 617   Real s = paper_l ()->get_var ("staffspace");
 618   if (gh_pair_p (extra))
 619     {
 620       ext[BIGGER] +=  s * gh_scm2double (gh_cdr (extra));
 621       ext[SMALLER] +=  s * gh_scm2double (gh_car (extra));
 622     }
 623
 624   extra = get_elt_property (a == X_AXIS
 625                                 ? "minimum-extent-X"
 626                                 : "minimum-extent-Y");
 627   if (gh_pair_p (extra))
 628     {
 629       ext.unite (Interval (s * gh_scm2double (gh_car (extra)),
 630                            s * gh_scm2double (gh_cdr (extra))));
 631     }
 632
 633   ext.translate (x);
 634
 635   return ext;
 636 }
 637
 638
 639 Score_element*
 640 Score_element::parent_l (Axis a) const
 641 {
 642   return  dim_cache_[a].parent_l_;
 643 }
 644
 645 Score_element *
 646 Score_element::common_refpoint (Score_element const* s, Axis a) const
 647 {
 648   /*
 649     I don't like the quadratic aspect of this code, but I see no other
 650     way. The largest chain of parents might be 10 high or so, so
 651     it shouldn't be a real issue. */
 652   for (Score_element const *c = this; c; c = c->dim_cache_[a].parent_l_)
 653     for (Score_element const * d = s; d; d = d->dim_cache_[a].parent_l_)
 654       if (d == c)
 655         return (Score_element*)d;
 656
 657   return 0;
 658 }
 659
 660
 661 Score_element *
 662 Score_element::common_refpoint (SCM elist, Axis a) const
 663 {
 664   Score_element * common = (Score_element*) this;
 665   for (; gh_pair_p (elist); elist = gh_cdr (elist))
 666     {
 667       Score_element * s = unsmob_element (gh_car (elist));
 668       if (s)
 669         common = common->common_refpoint (s, a);
 670     }
 671
 672   return common;
 673 }
 674
 675 String
 676 Score_element::name () const
 677 {
 678   SCM nm = get_elt_property ("name");
 679
 680   return  nm == SCM_EOL ? classname (this) :ly_scm2string (nm) ;
 681 }
 682
 683 void
 684 Score_element::add_offset_callback (SCM cb, Axis a)
 685 {
 686   if (!has_offset_callback_b (cb, a))
 687   {
 688     dim_cache_[a].offset_callbacks_ = gh_cons (cb, dim_cache_[a].offset_callbacks_ );
 689     dim_cache_[a].offsets_left_ ++;
 690   }
 691 }
 692
 693 bool
 694 Score_element::has_extent_callback_b (SCM cb, Axis a)const
 695 {
 696   return scm_equal_p (cb, dim_cache_[a].dimension_);
 697 }
 698
 699
 700 bool
 701 Score_element::has_extent_callback_b (Axis a) const
 702 {
 703   return gh_procedure_p (dim_cache_[a].dimension_);
 704 }
 705
 706 bool
 707 Score_element::has_offset_callback_b (SCM cb, Axis a)const
 708 {
 709   return scm_memq (cb, dim_cache_[a].offset_callbacks_) != SCM_BOOL_F;
 710 }
 711
 712 void
 713 Score_element::set_extent_callback (SCM dc, Axis a)
 714 {
 715   dim_cache_[a].dimension_ =dc;
 716 }
 717
 718 void
 719 Score_element::set_parent (Score_element *g, Axis a)
 720 {
 721   dim_cache_[a].parent_l_ = g;
 722 }
 723
 724 MAKE_SCHEME_CALLBACK(Score_element,fixup_refpoint,1);
 725 SCM
 726 Score_element::fixup_refpoint (SCM smob)
 727 {
 728   Score_element *me = unsmob_element (smob);
 729   for (int a = X_AXIS; a < NO_AXES; a ++)
 730     {
 731       Axis ax = (Axis)a;
 732       Score_element * parent = me->parent_l (ax);
 733
 734       if (!parent)
 735         continue;
 736
 737       if (parent->line_l () != me->line_l () && me->line_l ())
 738         {
 739           Score_element * newparent = parent->find_broken_piece (me->line_l ());
 740           me->set_parent (newparent, ax);
 741         }
 742
 743       if (Item * i  = dynamic_cast<Item*> (me))
 744         {
 745           Item *parenti = dynamic_cast<Item*> (parent);
 746
 747           if (parenti && i)
 748             {
 749               Direction  my_dir = i->break_status_dir () ;
 750               if (my_dir!= parenti->break_status_dir())
 751                 {
 752                   Item *newparent =  parenti->find_prebroken_piece (my_dir);
 753                   me->set_parent (newparent, ax);
 754                 }
 755             }
 756         }
 757     }
 758   return smob;
 759 }
 760
 761
 762
 763 /****************************************************
 764   SMOB funcs
 765  ****************************************************/
 766
 767
 768 IMPLEMENT_UNSMOB(Score_element, element);
 769 IMPLEMENT_SMOBS(Score_element);
 770 IMPLEMENT_DEFAULT_EQUAL_P(Score_element);
 771
 772 SCM
 773 Score_element::mark_smob (SCM ses)
 774 {
 775   Score_element * s = (Score_element*) SCM_CELL_WORD_1(ses);
 776   scm_gc_mark (s->immutable_property_alist_);
 777   scm_gc_mark (s->mutable_property_alist_);
 778
 779   for (int a =0 ; a < 2; a++)
 780     {
 781       scm_gc_mark (s->dim_cache_[a].offset_callbacks_);
 782       scm_gc_mark (s->dim_cache_[a].dimension_);
 783     }
 784
 785   if (s->parent_l (Y_AXIS))
 786     scm_gc_mark (s->parent_l (Y_AXIS)->self_scm ());
 787   if (s->parent_l (X_AXIS))
 788     scm_gc_mark (s->parent_l (X_AXIS)->self_scm ());
 789
 790   if (s->original_l_)
 791     scm_gc_mark (s->original_l_->self_scm ());
 792   return s->do_derived_mark ();
 793 }
 794
 795 int
 796 Score_element::print_smob (SCM s, SCM port, scm_print_state *)
 797 {
 798   Score_element *sc = (Score_element *) gh_cdr (s);
 799
 800   scm_puts ("#<Score_element ", port);
 801   scm_puts ((char *)sc->name ().ch_C(), port);
 802
 803   /*
 804     don't try to print properties, that is too much hassle.
 805    */
 806   scm_puts (" >", port);
 807   return 1;
 808 }
 809
 810 SCM
 811 Score_element::do_derived_mark ()
 812 {
 813   return SCM_EOL;
 814 }
 815
 816
 817 SCM
 818 ly_set_elt_property (SCM elt, SCM sym, SCM val)
 819 {
 820   Score_element * sc = unsmob_element (elt);
 821
 822   if (!gh_symbol_p (sym))
 823     {
 824       error ("Not a symbol");
 825       ly_display_scm (sym);
 826       return SCM_UNSPECIFIED;
 827     }
 828
 829   if (sc)
 830     {
 831       sc->set_elt_property (sym, val);
 832     }
 833   else
 834     {
 835       error ("Not a score element");
 836       ly_display_scm (elt);
 837     }
 838
 839   return SCM_UNSPECIFIED;
 840 }
 841
 842
 843 SCM
 844 ly_get_elt_property (SCM elt, SCM sym)
 845 {
 846   Score_element * sc = unsmob_element (elt);
 847
 848   if (sc)
 849     {
 850       return sc->get_elt_property (sym);
 851     }
 852   else
 853     {
 854       error ("Not a score element");
 855       ly_display_scm (elt);
 856     }
 857   return SCM_UNSPECIFIED;
 858 }
 859
 860
 861 void
 862 Score_element::discretionary_processing()
 863 {
 864 }
 865
 866
 867
 868 SCM
 869 spanner_get_bound (SCM slur, SCM dir)
 870 {
 871   return dynamic_cast<Spanner*> (unsmob_element (slur))->get_bound (to_dir (dir))->self_scm ();
 872 }
 873
 874
 875
 876 static SCM interfaces_sym;
 877 static void
 878 init_functions ()
 879 {
 880   interfaces_sym = scm_permanent_object (ly_symbol2scm ("interfaces"));
 881
 882   scm_make_gsubr ("ly-get-elt-property", 2, 0, 0, (Scheme_function_unknown)ly_get_elt_property);
 883   scm_make_gsubr ("ly-set-elt-property", 3, 0, 0, (Scheme_function_unknown)ly_set_elt_property);
 884   scm_make_gsubr ("ly-get-spanner-bound", 2 , 0, 0, (Scheme_function_unknown) spanner_get_bound);
 885 }
 886
 887 bool
 888 Score_element::has_interface (SCM k)
 889 {
 890   SCM ifs = get_elt_property (interfaces_sym);
 891
 892   return scm_memq (k, ifs) != SCM_BOOL_F;
 893 }
 894
 895 void
 896 Score_element::set_interface (SCM k)
 897 {
 898   if (has_interface (k))
 899     return ;
 900   else
 901     {
 902       set_elt_property (interfaces_sym,
 903                         gh_cons  (k, get_elt_property (interfaces_sym)));
 904     }
 905 }
 906
 907
 908 ADD_SCM_INIT_FUNC(scoreelt, init_functions);
 909