lily/grob.cc

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