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