--- /dev/null
+
+\version "2.15.10"
+
+\header {
+ texidoc = "unpure-pure containers take two arguments: an unpure property and
+a pure property. The pure property is evaluated (and cached) for all
+pure calculations, and the unpure is evaluated for all unpure calculations.
+In this regtest, there are three groups of two eighth notes. In the first
+group, the second note should move to accommodate the flag, whereas it should
+not in the second group because it registers the flag as being higher. The
+flag, however, remains at the Y-offset dictated by ly:flag::calc-y-offset.
+In the third set of two 8th notes, the flag should be pushed up to a Y-offset
+of 8.
+"
+}
+
+\relative c'' {
+ \stemUp \autoBeamOff
+ d,8 eis'
+ \once \override Flag #'Y-offset =
+ #(ly:make-unpure-pure-container ly:flag::calc-y-offset 8)
+ d,8 eis'!
+ \once \override Flag #'Y-offset = #8
+ d,8 eis'!
+}
#include "stencil.hh"
#include "system.hh"
#include "warn.hh"
+#include "unpure-pure-container.hh"
static bool
pure_staff_priority_less (Grob *const &g1, Grob *const &g2);
#include "main.hh"
#include "simple-closure.hh"
#include "spanner.hh"
+#include "unpure-pure-container.hh"
#include "warn.hh"
/*
target_alist = scm_acons (symbol, new_value, target_alist);
bool ok = true;
- if (!ly_is_procedure (new_value)
- && !is_simple_closure (new_value))
- ok = type_check_assignment (symbol, new_value,
- ly_symbol2scm ("backend-type?"));
+ bool pc = is_unpure_pure_container (new_value);
+ SCM vals[] = {pc ? unpure_pure_container_unpure_part (new_value) : new_value,
+ pc ? unpure_pure_container_pure_part (new_value) : SCM_BOOL_F};
+
+ for (int i = 0; i < 2; i++)
+ if (!ly_is_procedure (vals[i])
+ && !is_simple_closure (vals[i]))
+ ok = ok && type_check_assignment (symbol, vals[i],
+ ly_symbol2scm ("backend-type?"));
/*
tack onto alist. We can use set_car, since
#include "performance.hh"
#include "spanner.hh"
#include "stream-event.hh"
+#include "unpure-pure-container.hh"
void
init_func_doc ()
ly_add_type_predicate ((void *) &unsmob_moment, "Moment");
ly_add_type_predicate ((void *) &unsmob_paper_score, "Paper_score");
ly_add_type_predicate ((void *) &unsmob_performance, "Performance");
+ ly_add_type_predicate ((void *) &is_unpure_pure_container, "unpure pure container");
ly_add_type_predicate ((void *) &is_axis, "axis");
ly_add_type_predicate ((void *) &is_number_pair, "number pair");
#include "program-option.hh"
#include "profile.hh"
#include "simple-closure.hh"
+#include "unpure-pure-container.hh"
#include "warn.hh"
#include "protected-scm.hh"
{
if (!ly_is_procedure (v)
&& !is_simple_closure (v)
+ && !is_unpure_pure_container (v)
&& v != ly_symbol2scm ("calculation-in-progress"))
type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
if (do_internal_type_checking_global && scm_is_pair (handle))
{
SCM val = scm_cdr (handle);
- if (!ly_is_procedure (val) && !is_simple_closure (val))
+ if (!ly_is_procedure (val) && !is_simple_closure (val) && !is_unpure_pure_container (val))
type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
check_interfaces_for_property (this, sym);
}
#endif
+ if (is_unpure_pure_container (val))
+ val = unpure_pure_container_unpure_part (val);
if (ly_is_procedure (val)
|| is_simple_closure (val))
{
Grob::internal_get_pure_property (SCM sym, int start, int end) const
{
SCM val = internal_get_property_data (sym);
- if (ly_is_procedure (val))
+ if (ly_is_procedure (val) || is_unpure_pure_container (val))
return call_pure_function (val, scm_list_1 (self_scm ()), start, end);
if (is_simple_closure (val))
return evaluate_with_simple_closure (self_scm (),
{
SCM val = scm_cdr (s);
if (ly_is_procedure (val)
- || is_simple_closure (val))
+ || is_simple_closure (val)
+ || is_unpure_pure_container (val))
{
Grob *me = ((Grob *)this);
val = me->try_callback_on_alist (&me->object_alist_, sym, val);
--- /dev/null
+/*
+ This file is part of LilyPond, the GNU music typesetter.
+
+ Copyright (C) 2005--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ LilyPond is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ LilyPond is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#ifndef UNPURE_PURE_CONTAINER_HH
+#define UNPURE_PURE_CONTAINER_HH
+
+#include "lily-guile.hh"
+
+bool is_unpure_pure_container (SCM s);
+SCM unpure_pure_container_unpure_part (SCM smob);
+SCM unpure_pure_container_pure_part (SCM smob);
+SCM ly_make_unpure_pure_container (SCM, SCM);
+
+#endif /* UNPURE_PURE_CONTAINER_HH */
#include "staff-symbol-referencer.hh"
#include "text-interface.hh"
#include "warn.hh"
+#include "unpure-pure-container.hh"
System::System (System const &src)
: Spanner (src)
--- /dev/null
+/*
+ This file is part of LilyPond, the GNU music typesetter.
+
+ Copyright (C) 2011 Mike Solomon <mike@apollinemike.com>
+
+
+ LilyPond is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ LilyPond is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+*/
+#include "unpure-pure-container.hh"
+
+#include "grob.hh"
+
+static scm_t_bits unpure_pure_container_tag;
+
+bool
+is_unpure_pure_container (SCM s)
+{
+ return (SCM_NIMP (s) && SCM_CELL_TYPE (s) == unpure_pure_container_tag);
+}
+
+SCM
+unpure_pure_container_unpure_part (SCM smob)
+{
+ LY_ASSERT_TYPE (is_unpure_pure_container, smob, 1);
+ return (SCM) SCM_CELL_WORD_1 (smob);
+}
+
+SCM
+unpure_pure_container_pure_part (SCM smob)
+{
+ LY_ASSERT_TYPE (is_unpure_pure_container, smob, 1);
+ return (SCM) SCM_CELL_WORD_2 (smob);
+}
+
+LY_DEFINE (ly_unpure_pure_container_p, "ly:unpure-pure-container?",
+ 1, 0, 0, (SCM clos),
+ "Is @var{clos} an unpure pure container?")
+{
+ return scm_from_bool (is_unpure_pure_container (clos));
+}
+
+LY_DEFINE (ly_make_unpure_pure_container, "ly:make-unpure-pure-container",
+ 1, 1, 0, (SCM unpure, SCM pure),
+ "Make an unpure-pure container. @var{unpure} should be an unpure"
+ " expression, and @var{pure} should be a pure expression. If @var{pure}"
+ " is ommitted, the value of @var{unpure} will be used twice.")
+{
+ SCM z;
+
+ if (pure == SCM_UNDEFINED)
+ pure = unpure;
+
+ SCM_NEWSMOB2 (z, unpure_pure_container_tag, SCM_UNPACK (unpure), SCM_UNPACK (pure));
+ return z;
+}
+
+LY_DEFINE (ly_unpure_pure_container_unpure_part, "ly:unpure-pure-container-unpure-part",
+ 1, 0, 0, (SCM pc),
+ "Return the unpure part of @var{pc}.")
+{
+ LY_ASSERT_TYPE (is_unpure_pure_container, pc, 1);
+ return unpure_pure_container_unpure_part (pc);
+}
+
+LY_DEFINE (ly_unpure_pure_container_pure_part, "ly:unpure-pure-container-pure-part",
+ 1, 0, 0, (SCM pc),
+ "Return the pure part of @var{pc}.")
+{
+ LY_ASSERT_TYPE (is_unpure_pure_container, pc, 1);
+ return unpure_pure_container_pure_part (pc);
+}
+
+int
+print_unpure_pure_container (SCM s, SCM port, scm_print_state *)
+{
+ scm_puts ("#<unpure-pure-container ", port);
+ scm_display (unpure_pure_container_unpure_part (s), port);
+ scm_puts (" ", port);
+ scm_display (unpure_pure_container_pure_part (s), port);
+ scm_puts (" >", port);
+ return 1;
+}
+
+SCM
+pure_mark (SCM pure)
+{
+ scm_gc_mark (unpure_pure_container_unpure_part (pure));
+ scm_gc_mark (unpure_pure_container_pure_part (pure));
+ return pure;
+}
+
+void init_unpure_pure_container ()
+{
+ unpure_pure_container_tag = scm_make_smob_type ("unpure-pure-container", 0);
+ scm_set_smob_mark (unpure_pure_container_tag, pure_mark);
+ scm_set_smob_print (unpure_pure_container_tag, print_unpure_pure_container);
+};
+
+ADD_SCM_INIT_FUNC (unpure_pure_container, init_unpure_pure_container);
(let ((extent-callback (ly:grob-property-data grob 'Y-extent)))
(not (eq? #f
(or
+ (ly:unpure-pure-container? extent-callback)
(pair? extent-callback)
(memq extent-callback pure-functions)
(and
(assq stencil pure-print-to-height-conversions)
(ly:stencil? stencil)))))))))
+;; hideous code dup below - to be cleaned up when call pure functino
+;; is eliminated and lilypond works entirely from unpure-pure-containers
+
(define-public (call-pure-function unpure args start end)
- (if (ly:simple-closure? unpure)
- (ly:eval-simple-closure (car args) unpure start end)
- (if (not (procedure? unpure))
- unpure
- (if (memq unpure pure-functions)
- (apply unpure args)
- (let ((pure (assq unpure pure-conversions-alist)))
- (if pure
- (apply (cdr pure)
- (append
- (list (car args) start end)
- (cdr args)))))))))
+ (if (ly:unpure-pure-container? unpure)
+ (let ((unpure (ly:unpure-pure-container-pure-part unpure)))
+ (if (ly:simple-closure? unpure)
+ (ly:eval-simple-closure (car args) unpure start end)
+ (if (not (procedure? unpure))
+ unpure
+ (apply (cdr pure)
+ (append
+ (list (car args) start end)
+ (cdr args))))))
+ (if (ly:simple-closure? unpure)
+ (ly:eval-simple-closure (car args) unpure start end)
+ (if (not (procedure? unpure))
+ unpure
+ (if (memq unpure pure-functions)
+ (apply unpure args)
+ (let ((pure (assq unpure pure-conversions-alist)))
+ (if pure
+ (apply (cdr pure)
+ (append
+ (list (car args) start end)
+ (cdr args))))))))))
projects / lilypond.git / commitdiff