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