\version "2.14.2" #(define ((offset-control-points offsets function) grob) (let ((coords (function grob))) (if (null? offsets) coords (map (lambda (x y) (coord-translate x y)) coords offsets)))) #(define ((shape-curve offsets function) grob) (let* ( ;; have we been split? (orig (ly:grob-original grob)) ;; if yes, get the split pieces (our siblings) (siblings (if (ly:grob? orig) (ly:spanner-broken-into orig) '() )) (total-found (length siblings)) (grob-name (assoc-get 'name (assoc-get 'meta (ly:grob-basic-properties grob))))) (define (helper sibs offs) (if (and (eq? (car sibs) grob) (pair? offs)) ((offset-control-points (car offs) function) grob) (if (pair? offs) (helper (cdr sibs) (cdr offs)) ((offset-control-points '() function) grob)))) ; standardize input so #'((dx1 . dy1) . . . ) ; and #'( ((dx1 . dy1) . . . ) ) possible (if (not (list? (car offsets))) (set! offsets (list offsets))) ; warnings (if (not (= (length offsets) total-found)) (if (= 0 total-found) (if (pair? (cdr offsets)) (ly:warning "~a is unbroken, modifications for ~a pieces requested" grob-name (length offsets))) (if (eq? (last siblings) grob) ; print warning only once (ly:warning "~a is broken into ~a pieces, modifications for ~a requested~%" grob-name total-found (length offsets))))) (if (>= total-found 2) (helper siblings offsets) ((offset-control-points (car offsets) function) grob)))) shapeSlur = #(define-music-function (parser location offsets) (list?) #{ \once \override Slur #'control-points = #(shape-curve offsets ly:slur::calc-control-points) #}) shapePhrasingSlur = #(define-music-function (parser location offsets) (list?) #{ \once \override Slur #'control-points = #(shape-curve offsets ly:slur::calc-control-points) #}) shapeTie = #(define-music-function (parser location offsets) (list?) #{ \once \override Tie #'control-points = #(shape-curve offsets ly:tie::calc-control-points) #}) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% SLURS \markup { \underline "Default Slurs" } \relative c'' { d4( d' b g g,8 f' e d c2) \bar "||" d4( d' b g \break g,8 f' e d c2) } \markup { \underline "Modified" } \relative c'' { %% UNBROKEN %% remove semicolon to see warning \shapeSlur #'( ((0 . -2.5) (-1 . 3.5) (0 . 0) (0 . -2.5)) ;() ) d4( d' b g g,8 f' e d c2) \bar "||" %% BROKEN %% warning will show \shapeSlur #'( ((0 . -2.5) (0 . 1.5) (0 . 1) (0 . -1)) () () ) d4(^"(1st half only)" d' b g \break g,8 f' e d c2) \bar "||" %% both halves of the slur are modified \shapeSlur #'( ((0 . -2.5) (0 . 1.5) (0 . 1) (0 . -1)) ((1 . 2) (0 . 1) (0 . 1) (0 . 0)) ) d4(^"(both halves)" d' b g \break g,8 f' e d c2) } %% TIES \relative c'' { cis1~ cis \shapeTie #'((0 . 0) (0 . 1) (0 . 1) (0 . 0)) cis~ cis \shapeTie #'((0 . 0) (0 . 1) (0 . 1) (0 . 0)) cis~ \break cis \shapeTie #'( () ((-0.25 . 0) (0 . -0.25) (0 . -0.25) (0 . -1)) ) cis~ \break cis } \markup { \underline "PhrasingSlurs" } \relative c'' { %% UNBROKEN %% remove semicolon to see warning \shapePhrasingSlur #'( ((0 . -2.5) (-1 . 3.5) (0 . 0) (0 . -2.5)) ;() ) d4\( d' b g g,8 f' e d c2\) \bar "||" %% BROKEN %% warning will show \shapePhrasingSlur #'( ((0 . -2.5) (0 . 1.5) (0 . 1) (0 . -1)) () () ) d4\(^"(1st half only)" d' b g \break g,8 f' e d c2\) \bar "||" %% both halves of the slur are modified \shapePhrasingSlur #'( ((0 . -2.5) (0 . 1.5) (0 . 1) (0 . -1)) ((1 . 2) (0 . 1) (0 . 1) (0 . 0)) ) d4\(^"(both halves)" d' b g \break g,8 f' e d c2\) } \paper { indent = 0 ragged-right = ##t }