From: David Nalesnik <david.nalesnik@gmail.com>
Date: Fri, 12 Apr 2013 23:40:45 +0000 (-0500)
Subject: Issue 3313: Add the command \offset
X-Git-Tag: release/2.17.29-1~18
X-Git-Url: https://git.donarmstrong.com/?p=lilypond.git;a=commitdiff_plain;h=a82d8622e6b1be36169de7d2fe1f9aa88618933b

Issue 3313: Add the command \offset

The ability to offset values of various properties would be a useful
enhancement of LilyPond.  Currently, this is possible for default values
of the property 'control-points using the \shape command.  The following
patch seeks to generalize the application of offsets to grob properties.
Both overrides and tweaks are supported, on the model of \shape and
\alterBroken.

Offsets are currently limited to three data types: number, number-pair,
and number-pair-list (this last is defined by this patch and represents
the type used, for example, by 'control-points).  Offsets are limited to
the properties listed in the grob descriptions contained in
`scm/define-grobs.scm'.  Offsets will be reckoned against an override
currently in effect; otherwise, the default setting from the grob
description will be used.
---

diff --git a/input/regression/offsets.ly b/input/regression/offsets.ly
new file mode 100644
index 0000000000..5348972403
--- /dev/null
+++ b/input/regression/offsets.ly
@@ -0,0 +1,73 @@
+\version "2.17.28"
+
+\header {
+  texidoc = "The @code{\\offset} command may be used to displace various properties
+from the default settings contained in grob descriptions.  Settings which may be
+offset are limited to those of type @code{number}, @code{number-pair}, or
+@code{number-pair-list}.  Most of the following examples begin with the grob in its
+default appearance.  The command is demonstrated as a tweak and as an override."
+}
+
+\layout {
+  ragged-right = ##t
+  indent = 0
+}
+
+\relative c' {
+
+  %% ARPEGGIO %%
+  % default
+  <c e g b>1\arpeggio
+  <c e g b>1-\offset #'positions #'(-1 . 1) \arpeggio
+  \bar "||"
+
+  %% BREATHING SIGN %%
+  % default
+  c1 \breathe
+  c1
+  \once \offset #'Y-offset #1 BreathingSign
+  \breathe
+  \bar "||"
+
+  %% DYNAMICS %%
+  % default
+  c1\f
+  \once \offset #'X-offset #-1 DynamicText
+  c1\f
+  % DynamicLineSpanner
+  c1-\offset #'padding #1 \f
+  \bar "||"
+
+  %% BEAMS %%
+  % default
+  c'8 d e f
+  \once \offset #'positions #'(-1 . -1) Voice.Beam
+  c8 d e f
+  % same effect as an offset of '(-2 . -2)
+  \once \offset #'positions #-2 Beam
+  c8 d e f
+  \override Beam.breakable = ##t
+  c8-\offset #'positions #'((-1 . -3) (-3 . -1)) [ d e f
+  \break
+  g8 f e d] c-\offset #'beam-thickness #0.48 [ d e f]
+  \bar "||"
+
+  %% TEXT SPANNERS %%
+  c4\startTextSpan d e f\stopTextSpan
+  \once \offset #'dash-fraction #'(0.1 0.3) TextSpanner
+  \once \offset #'staff-padding #'(1.0 2.0) TextSpanner
+  c4\startTextSpan d e f
+  \break
+  c4 d e f\stopTextSpan
+  \bar "||"
+
+  %% SLURS %%
+  % this duplicates the effect of the \shape command
+  \offset #'control-points #'(
+   ((0 . 0) (0 . 1) (0 . 2) (0 . 1))
+   ((1 . 0) (0 . 4) (0 . 4) (0 . 0))
+   ) Slur
+  c4-\offset #'line-thickness #'(0 10) ( d e f
+  \break
+  c4 d e f)
+}
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index f47cd1d214..d33bf9da81 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -694,6 +694,26 @@ octaveCheck =
    (make-music 'RelativeOctaveCheck
                'pitch pitch))
 
+offset =
+#(define-music-function (parser location property offsets item)
+  (symbol-list-or-symbol? scheme? symbol-list-or-music?)
+   (_i "Offset the default value of @var{property} of @var{item} by
+@var{offsets}.  If @var{item} is a string, the result is
+@code{\\override} for the specified grob type.  If @var{item} is
+a music expression, the result is the same music expression with an
+appropriate tweak applied.")
+  (if (ly:music? item)
+      #{ \tweak #property #(offsetter property offsets) #item #}
+      (if (check-grob-path item parser location
+                                #:default 'Bottom
+                                #:min 2
+                                #:max 2)
+          #{
+            \override #item . #property =
+              #(offsetter property offsets)
+          #}
+          (make-music 'Music))))
+
 omit =
 #(define-music-function (parser location item) (symbol-list-or-music?)
    (_i "Set @var{item}'s @samp{stencil} property to @code{#f},
diff --git a/scm/c++.scm b/scm/c++.scm
index 8f4986a257..a131e7f342 100644
--- a/scm/c++.scm
+++ b/scm/c++.scm
@@ -25,6 +25,10 @@
   (and (pair? x)
        (number? (car x)) (number? (cdr x))))
 
+(define-public (number-pair-list? x)
+  (and (list? x)
+       (every number-pair? x)))
+
 (define-public (fraction? x)
   (and (pair? x)
        (index? (car x)) (index? (cdr x))))
diff --git a/scm/lily.scm b/scm/lily.scm
index 4a63be9908..9e47fc0df7 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -662,6 +662,7 @@ messages into errors.")
     (,number-or-pair? . "number or pair")
     (,number-or-string? . "number or string")
     (,number-pair? . "pair of numbers")
+    (,number-pair-list? . "list of number pairs")
     (,rhythmic-location? . "rhythmic location")
     (,scheme? . "any type")
     (,string-or-pair? . "string or pair")
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index afcdb843e7..ccecf4b43d 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -2081,3 +2081,95 @@ Broken measures are numbered in parentheses."
                     (cdr break-alignment-L-ext))))
            X)))
     num))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following are used by the \offset function
+
+(define (find-value-to-offset prop self alist)
+  "Return the first value of the property @var{prop} in the property alist
+@var{alist} @em{after} having found @var{self}."
+  (let ((segment (member (cons prop self) alist)))
+    (if (not segment)
+        (assoc-get prop alist)
+        (assoc-get prop (cdr segment)))))
+
+(define (offset-multiple-types arg offsets)
+  "Displace @var{arg} by @var{offsets} if @var{arg} is a number, a
+number pair, or a list of number pairs.  If @var{offsets} is an empty
+list or if there is a type-mismatch, @var{arg} will be returned."
+  (cond
+    ((and (number? arg) (number? offsets))
+     (+ arg offsets))
+    ((and (number-pair? arg)
+          (or (number? offsets)
+              (number-pair? offsets)))
+     (coord-translate arg offsets))
+    ((and (number-pair-list? arg) (number-pair-list? offsets))
+     (map
+       (lambda (x y) (coord-translate x y))
+       arg offsets))
+    (else arg)))
+
+(define-public (offsetter property offsets)
+  "Apply @var{offsets} to the default values of @var{property} of @var{grob}.
+Offsets are restricted to immutable properties and values of type @code{number},
+@code{number-pair}, or @code{number-pair-list}."
+  (define (self grob)
+    (let* ((immutable (ly:grob-basic-properties grob))
+           ; We need to search the basic-properties alist for our property to
+           ; obtain values to offset.  Our search is complicated by the fact that
+           ; calling the music function `offset' as an override conses a pair to
+           ; the head of the alist.  This pair must be discounted.  The closure it
+           ; contains is named `self' so it can be easily recognized.  If `offset'
+           ; is called as a tweak, the basic-property alist is unaffected.
+           (target (find-value-to-offset property self immutable))
+           ; if target is a procedure, we need to apply it to our grob to calculate
+           ; values to offset.
+           (vals
+             (if (procedure? target)
+                 (target grob)
+                 target))
+           (can-type-be-offset?
+             (or (number? vals)
+                 (number-pair? vals)
+                 (number-pair-list? vals))))
+
+      (if can-type-be-offset?
+          ; '(+inf.0 . -inf.0) would offset to itself.  This will be confusing to a
+          ; user unaware of the default value of the property, so issue a warning.
+          (if (equal? empty-interval vals)
+              (ly:warning "default '~a of ~a is ~a and can't be offset"
+                property grob vals)
+              (let* ((orig (ly:grob-original grob))
+                     (siblings
+                       (if (ly:spanner? grob)
+                           (ly:spanner-broken-into orig)
+                           '()))
+                     (total-found (length siblings))
+                     ; Since there is some flexibility in input syntax,
+                     ; structure of `offsets' is normalized.
+                     (offsets
+                       (if (or (not (pair? offsets))
+                               (number-pair? offsets)
+                               (and (number-pair-list? offsets)
+                                    (number-pair-list? vals)))
+                           (list offsets)
+                           offsets)))
+
+                (define (helper sibs offs)
+                  ; apply offsets to the siblings of broken spanners
+                  (if (pair? offs)
+                      (if (eq? (car sibs) grob)
+                          (offset-multiple-types vals (car offs))
+                          (helper (cdr sibs) (cdr offs)))
+                      vals))
+
+                (if (>= total-found 2)
+                    (helper siblings offsets)
+                    (offset-multiple-types vals (car offsets)))))
+
+              (begin
+                (ly:warning "the property '~a of ~a cannot be offset" property grob)
+                vals))))
+    ; return the closure named `self'
+    self)