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