From 85903f628e511db028313c3fd44b8412806ca36d Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Tue, 22 Sep 2015 15:02:12 +0200 Subject: [PATCH] Issue 4620/3: Add grob::compose-function and grob::offset-function Those are the main replacements for the uses of ly:make-simple-closure in lily/grob-closure.cc. --- scm/output-lib.scm | 48 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 9b885eb9a2..f525a1ebad 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -967,7 +967,53 @@ and duration-log @var{log}." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; - +(define-public (grob::compose-function func data) + "This creates a callback entity to be stored in a grob property, +based on the grob property data @var{data} (which can be plain data, a +callback itself, or an unpure-pure-container). + +Function or unpure-pure-container @var{func} accepts a grob and a +value and returns another value. Depending on the type of @var{data}, +@var{func} is used for building a grob callback or an +unpure-pure-container." + (if (or (ly:unpure-pure-container? func) + (ly:unpure-pure-container? data)) + (ly:make-unpure-pure-container + (lambda (grob) (ly:unpure-call func grob (ly:unpure-call data grob))) + (lambda (grob start end) + (ly:pure-call func grob start end + (ly:pure-call data grob start end)))) + (lambda (grob) (ly:unpure-call func grob (ly:unpure-call data grob))))) + +(define*-public (grob::offset-function func data + #:optional (plus +)) + "This creates a callback entity to be stored in a grob property, +based on the grob property data @var{data} (which can be plain data, a +callback itself, or an unpure-pure-container). + +Function @var{func} accepts a grob and returns a value that is added +to the value resulting from @var{data}. Optional arguments @var{plus} +and @var{valid?} default to @code{+} and @code{number?} respectively +and allow for using a different underlying accumulation/type. + +If @var{data} is @code{#f} or @code{'()}, it is not included in the sum." + (cond ((or (not data) (null? data)) + func) + ((or (ly:unpure-pure-container func) + (ly:unpure-pure-container data)) + (ly:make-unpure-pure-container + (lambda rest + (plus (apply ly:unpure-call func rest) + (apply ly:unpure-call data rest))) + (lambda rest + (plus (apply ly:pure-call func rest) + (apply ly:pure-call data rest))))) + ((or (procedure? func) + (procedure? data)) + (lambda rest + (plus (apply ly:unpure-call func rest) + (apply ly:unpure-call data rest)))) + (else (plus func data)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; falls/doits -- 2.39.2