\version "2.12.3"

% Written by Chris Maden, <URL: http://crism.maden.org/ >.
% Released into the public domain.
% Disclaimer: good enough for me; may not be good enough for you.

% (duration-equals? dur1 dur2)
% Returns #t if all duration components are equal, #f otherwise.
#(define (duration-equals? dur1 dur2)
  (let ((factor1 (ly:duration-factor dur1))
        (factor2 (ly:duration-factor dur2)))
   (and
    (=
     (ly:duration-log dur1)
     (ly:duration-log dur2))
    (=
     (ly:duration-dot-count dur1)
     (ly:duration-dot-count dur2))
    (=
     (car factor1)
     (car factor2))
    (=
     (cdr factor1)
     (cdr factor2)))))

% (swing-eighth chord is-first)
% Changes the duration of all the notes in a chord.  If is-first is
% true, it alters the duration to be 2 0 2 3 (a quarter-note triplet),
% and if false, to 3 0 2 3 (an eighth-note triplet).  It does not
% actually check that the chord is composed entirely or even partly of
% eighth notes.
#(define (swing-eighth chord is-first)
  (let ((duration (if is-first
                   (ly:make-duration 2 0 2 3)
                   (ly:make-duration 3 0 2 3))))
   (make-music
    'EventChord
    'elements
    (map (lambda (note)
          (ly:music-set-property! note 'duration duration)
          note)
     (ly:music-property chord 'elements)))))

% (swing-eighths straight swung in-pair)
% Recurses through a set of straight notes, building up a swung
% series.  Uses in-pair as an internal semaphore.
% Does not work with unpaired eighth notes, nor does it look for
% chords with different duration notes.
#(define (swing-eighths straight swung in-pair)
  (if (null? straight)
   swung
   (let
    ((event (car straight)))
    (let
     ((is-eighth (and
                  (eq?
                   (ly:music-property
                    event
                    'name)
                   'EventChord)
                  (duration-equals?
                   (ly:music-property
                    (car (ly:music-property
                          event
                          'elements))
                    'duration)
                   (ly:make-duration 3 0 1 1)))))
     (swing-eighths
      (cdr
       straight)
      (append
       swung
       (if is-eighth
        (list (swing-eighth event (not in-pair)))
        (list event)))
      (and (not in-pair) is-eighth))))))

% \sw music
% Turns a series of notes into two tagged sequences (tagged 'layout
% and 'midi)
% The 'layout tagged sequence is unaltered.  The 'midi tagged sequence
% has pairs of eighth notes turned into swung triplets.
sw = #(define-music-function (parser location notes) (ly:music?)
       (let ((swing (make-music
                     'SequentialMusic
                     'elements
                     (list
                      (make-music
                       'RelativeOctaveMusic
                       'element
                       (make-music
                        'SequentialMusic
                        'elements
                        (swing-eighths
                         (ly:music-deep-copy
                          (ly:music-property
                           (ly:music-property
                            (car (ly:music-property
                                  notes
                                  'elements))
                            'element)
                           'elements))
                         '()
                         #f)))))))
        #{
          \tag #'layout { $notes }
          \tag #'midi { $swing }
        #}
      )
     )