%
% Based on:
% http://lsr.dsi.unimi.it/LSR/Item?id=445
%
% Also helped:
% http://lsr.dsi.unimi.it/LSR/Item?id=266
%

#(set-global-staff-size 16)

#(define (octave-shift note step)
  "Shift octave for note by step."
  (let* ((new-note (ly:music-deep-copy note))
         (new-pitch
            (ly:make-pitch
               (+ step (ly:pitch-octave (ly:music-property note 'pitch)))
               (ly:pitch-notename (ly:music-property note 'pitch))
               (ly:pitch-alteration (ly:music-property note 'pitch)))))
        (set! (ly:music-property new-note 'pitch) new-pitch)
        new-note))


#(define (no-octaved-pitch? elements pitch)
  "Checks if 'target' pitch does exist in elements."
  (if (null? elements)
      #t
      (let ((p (ly:music-property (car elements) 'pitch)))
           (if (and (eq? (ly:music-property (car elements) 'name) 'NoteEvent)
                    (eqv? (ly:pitch-octave pitch) (ly:pitch-octave p))
                    (eqv? (ly:pitch-notename pitch) (ly:pitch-notename p))
                    (eqv? (ly:pitch-alteration pitch) (ly:pitch-alteration p)))
               #f
               (no-octaved-pitch? (cdr elements) pitch)))))


#(define (octaviate-chord elements oct-step thresh)
  "Walks through elements 'NoteEvent by 'NoteEvent
   and octaviates pitch by oct-step
   if this pitch 'exceeds' given threshold
   and there is no pitch in a chord
   which (pitch) equals to 'target' pitch."
  (let ((exceeds? (if (< 0 oct-step) < >))
        (whole-chord elements))
    (let loop ((elts elements))
       (cond ((null? elts) elts)
             ((and (eq? (ly:music-property (car elts) 'name) 'NoteEvent)
                   (exceeds? (ly:pitch-steps (ly:music-property (car elts) 'pitch))
                             thresh)
                   (no-octaved-pitch? whole-chord
                                      (ly:music-property
                                          (octave-shift (car elts) oct-step)
                                          'pitch)))
                  (cons (octave-shift (car elts) oct-step)
                        (loop (cdr elts))))
             (else (cons (car elts) (loop (cdr elts))))))))


#(define (octaviate music oct-step thresh)
  (if (eq? (ly:music-property music 'name) 'EventChord)
      (ly:music-set-property! music 'elements
                (octaviate-chord (ly:music-property music 'elements) oct-step thresh)))
  music)


makeOctaves =
#(define-music-function (parser location step thresh mus)
      (integer? integer? ly:music?)
  (music-map (lambda (x) (octaviate x step thresh)) mus))


octaviateUpIfExceeds =
#(define-music-function (parser location thresh mus)
      (integer? ly:music?)
 #{
   \makeOctaves #1 #$thresh $mus
 #})


octaviateDownIfExceeds =
#(define-music-function (parser location thresh mus)
      (integer? ly:music?)
 #{
   \makeOctaves #-1 #$thresh $mus
 #})


melOne = \relative c, {
  <dis dis'>8( e dis')~ dis8.( cis16 b8
  \times 2/3 { ais' ~ ais, gis' } dis) cis( dis <dis dis''>)
}

\relative c' {
  \clef "bass"
  \time 3/8
  \key gis \minor
  %
  \override Score.RehearsalMark #'self-alignment-X = #LEFT
  %
  \mark\markup "As is"
  \melOne
  \break
  %
  \mark\markup "Up if below -6"
  \octaviateUpIfExceeds #-6
    \melOne
  \break
  %
  \mark\markup "Down if above -6"
  \octaviateDownIfExceeds #-6
    \melOne
  \break
  %
  \mark\markup "Down then Up"
  \octaviateUpIfExceeds #-6 \octaviateDownIfExceeds #-6
    \melOne
}


\paper {
  indent = 0
  line-width = 10\cm
}

\header { tagline = "" }

% vim: set ts=2: