lily/grob.cc

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