% lilyExp / temaTransform.ly
% CC-BY-SA markuslepper.eu 20181210


\include "deutsch.ly"
\version "2.16.0"

% ---------------------------------------------------------------------

%{
    The lilypond scheme functions defined herein allow to extract segments from and
    insert segments into a music structure. They are very useful when composing fugues etc.
    directly as lilypond input.

    The function signatures are:

    mbExtract music  from to     --> deliver the indicated segment.
    mbRemove  music  from to     --> cut out the indicated segment (= the complement to mbExtract).
    mbInsert  music  at  music   --> insert the second music into the first, shifting the
                                         rest after the point of insertion to the right.
    mbReplace music  at  music   --> insert the second music into the first, overwriting the 
                                         rest after the point of insertion.

    ATTENTION: The time points "from" and "to" must be the start times of notes/pauses in 
    the music structure. Otherwise an automated split of one note in two would be necessary,
    which is NOT implemented here


    ATTENTION: We did NOT find a global constant definition for "Rational Max Value" and
    use inline "99/1" instead.


    ATTENTION: The tests work fine with lilypond 2.16.0 But we get many times
"programming error: music has no duration
continuing, cross fingers"


The code has been inspired by
http://lilypond.org/doc/v2.18/Documentation/extending/doubling-a-note-with-slurs-_0028example_0029

Further infos used were 
http://lilypond.org/doc/v2.18/Documentation/extending/scheme-tutorial
-> http://www.schemers.org/Documents/Standards/R5RS/
-> http://www.schemers.org/Documents/Standards/R5RS/HTML/
-> http://www.gnu.org/software/guile/
%}



% phase zero: no music written out yet
% cases
%     cursor   after
%     |--------|----
%     |from   (|to  |to)
%         |from
%     special case:
%           |to 

#(define (mbCut0 notes from to cursor res)
     (if (null? notes)
         res
         (let*((rest (mbNextEvent (cdr notes)))
               (note (car notes))
               (dura (ly:moment-main (ly:music-duration-length note)))
               (after(+ cursor dura))
               )
               (cond ((= cursor from)
                      (if (< to after)
                          (mbCut00 note (- to from))
                          (mbCut1 rest to after (list (ly:music-deep-copy note)))
                      ))
                     ((< from after)
                      (let*(newnote (ly:music-deep-copy note))
                           (X (set! (ly:music-property newnote 'duration) 
                                    (- (min after to) from)) )
                           (if (< to after)
                               ('newnote)
                               (mbCut1 rest to after (list newnote)))
                      ))
                     (else (mbCut0 rest from to after res))
               )
            )
      )
 )


% phase one: currently writing out
% cases
%     cursor   after
%     |--------|----
%     |to
%         |to
%              |to |to

#(define (mbCut1 notes to cursor res)
     (if (null? notes)
         res
         (let*((rest (mbNextEvent (cdr notes)))
               (note (car notes))
               (dura (ly:moment-main (ly:music-duration-length note)))
               (after(+ cursor dura))
              )
              (cond ((= cursor to) res)
                    ((< to after)  (append res (list(mbCut00 note (- to cursor)))) )
                    (else (mbCut1 rest to after 
                            (append res (list (ly:music-deep-copy note)))))
              ))
     )
 )

#(define (mbCut00 note length)
        (let*((newnote (ly:music-deep-copy note))
              (X (set! (ly:music-property newnote 'duration)
                       (ly:make-duration 0 0 length) 
                 ))
             )
             (list newnote))
 )



mbExtract = #(define-music-function (parser location music from to)
                                    (ly:music? number? number?)
   "Extract the notes from music which lie between from and to.
    (Partial inclusion of duration values currently not supported!)"
     (make-music 'SequentialMusic 'elements
      (mbCut0 (mbNextEvent (list music)) from to 0/1 '() )
     )
  )

mbRemove = #(define-music-function (parser location music from to)
                                    (ly:music? number? number?)
   "Remove the notes from music which lie between from and to.
    (Partial inclusion of duration values currently not supported!)"
   (make-music 'SequentialMusic 'elements
      (append
        (mbCut0 (mbNextEvent (list music)) 0/1 from  0/1 '() )
        (mbCut0 (mbNextEvent (list music)) to 99/1   0/1 '() )
      )
   )
)

mbInsert = #(define-music-function (parser location music at musicIN)
                                    (ly:music? number? ly:music?)
   "Insert the second music into the first at the given position.
    (Partial inclusion of duration values currently not supported!)"
   (make-music 'SequentialMusic 'elements
      (append
        (mbCut0 (mbNextEvent (list music))  0/1 at  0/1 '() )
        (list musicIN)
        (mbCut0 (mbNextEvent (list music)) at 99/1  0/1 '() )
      )
   )
)

mbReplace = #(define-music-function (parser location music at musicIN)
                                    (ly:music? number? ly:music?)
   "Insert the second music into the first at the given position,
    replacing the notes.
    (Partial inclusion of duration values currently not supported!)"
   (let*((insDura  (mbAddDurations (list musicIN)) )
         (XX (display insDura))
        )
        (make-music 'SequentialMusic 'elements
          (append
           (mbCut0 (mbNextEvent (list music)) 0/1 at  0/1 '() )
           (list musicIN)
           (mbCut0 (mbNextEvent (list music)) (+ at insDura) 99/1   0/1 '() )
          ))
   )
)


%  Horizontal iterator steps through deep nestings of 
%  C++ objects of some "music container classes" 
%  and delivers "events" and "chord-events".
%  Argument must be a list of C++ music objects. As long as such a container is
%  at first position, it is replaced by its contents.

#(define (mbNextEvent iter)
         (if (null? iter) 
             iter
             (let* ((first (car iter))
                    (rest (cdr iter))
                    (types (ly:music-property first 'types)))
                   (cond ((memq 'music-wrapper-music types)
                          (mbNextEvent (append(list(ly:music-property first 'element))
                                               rest)))
                         ((or (memq 'music-sequential-music types)
                              (memq 'sequential-music types))
                          (mbNextEvent (append(ly:music-property first 'elements) rest)))
	                 (else iter)
                    )))
 )

#(define (mbAddDurations iter)
         (mbAddDurations0 (mbNextEvent iter) 0/1)
 )

#(define (mbAddDurations0 iter res)
         (if (null? iter) 
             res
             (let*( (dura (ly:moment-main(ly:music-duration-length(car iter))) ) )
                  (mbAddDurations0 (mbNextEvent (cdr iter)) (+ res dura))
             ))
 )

#(define (test iter)
         (let*((XX0 (display "=========== INCOMING VALUE : ============= \n\n"))
               (XX1  (display iter))
               (XX2 (display "\n-----------\n"))
               (XX3 (display "\n-----------\n"))
               (iter2 (mbNextEvent iter))
               (XX3 (display "\n-----------  AFTER SPLICE  : \n"))
               (XX31 (if (null? iter2) #t (display  iter2)))
               (XX4 (display "\n-----------\n"))
              )
              (if (null? iter2) #t (test (cdr iter2)) )
          )
)

% ----------------------------------------------------------------
% TEST SECTION
%  call  lilypond temaTransform
% ----------------------------------------------------------------


tema = \relative d' {d2 a'  | f d | cis d4 e | f2~ f8 g f e} 

\score {
  <<
  \new Staff {

%%% #( test (list tema))

    \tema | 
    \mbRemove \tema #3/2 #6/2  | 
  }

  \new Staff {
    R1 | R1 | e'2 \mbExtract \tema #1/2 #99
    \mbReplace \tema #2/2 {fis'2 }
  }

  \new Staff {
    \mbInsert \tema #3/2 {g8 a h c'}
  }
  >>
}


%eof

%eof