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