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