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