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