#(define mkvid_out (open-output-file "videohelper.notes"))

#(format mkvid_out "~a~a~a" "LILYSOURCE=" (ly:parser-output-name) ".ly\n")

pdfforvideo       = #(define-void-function () () (format mkvid_out "~a~a~a" "VIDEOSOURCE=" current-outfile-name ".pdf\n"))
midiforvideo      = #(define-void-function () () (format mkvid_out "~a~a~a" "MIDISOURCE=" current-outfile-name ".midi\n"))
videoResolution   = #(define-void-function (parser location x y) (number? number?) (format mkvid_out "VIDEORESOLUTION=~ax~a\n" x y))
videoPreset       = #(define-void-function (parser location p) (string?) (format mkvid_out "PRESET=~a\n" p))
audioBitRate      = #(define-void-function (parser location p) (string?) (format mkvid_out "AUDIOBITRATE=~a\n" p))

#(define pagerepetitions? #t)
#(define colorflags? #t)
#(define colorstems? #t)
#(define colordots? #t)
#(define colorheads? #t)

noPageRepetitions = #(define-void-function () () (list (set! pagerepetitions? #f) (format mkvid_out "NOPAGEREPETITIONS\n")))
noColorFlags      = #(define-void-function () () (set! colorflags? #f))
noColorStems      = #(define-void-function () () (set! colorstems? #f))
noColorDots       = #(define-void-function () () (set! colordots?  #f))
noColorHeads      = #(define-void-function () () (set! colorheads? #f))

#(define (format-moment moment)
   (exact->inexact
    (/ (ly:moment-main-numerator moment)
       (ly:moment-main-denominator moment))))

#(define tempolist '())

#(define (format-tempo engraver event)
    (let* (
        (metrocount (ly:event-property event 'metronome-count))
        (tempounit  (ly:event-property event 'tempo-unit))
        (seconds    (/ 60 (* metrocount (format-moment (ly:duration-length tempounit)))))
        (time       (ly:context-current-moment (ly:translator-context engraver)))
        (moment     (+ 0.0 (ly:moment-main time) (* (ly:moment-grace time) (/ 9 40)))))
   (if metrocount
       (format mkvid_out "~a tempo ~f\n" moment seconds))))

#(define (format-time engraver event)
    (let* (
        (numerator   (ly:event-property event 'numerator))
        (denominator (ly:event-property event 'denominator))
        (time        (ly:context-current-moment (ly:translator-context engraver)))
        (moment      (+ 0.0 (ly:moment-main time) (* (ly:moment-grace time) (/ 9 40)))))
    (format mkvid_out "~a time ~a ~a\n" moment numerator denominator)))

\layout { 
    \context { \Staff 
        \consists #(make-engraver (listeners (time-signature-event . format-time))) }
    \context { \Voice 
        \consists #(make-engraver (listeners (tempo-change-event . format-tempo))) }
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Color notes and rests
%

#(define (grob-get-ancestor-with-interface grob interface axis)
    (let ((parent (ly:grob-parent grob axis)))
    (if (null? parent)
        #f
        (if (grob::has-interface parent interface)
            parent
            (grob-get-ancestor-with-interface parent interface axis)))))

#(define (grob-get-paper-column grob)
    (grob-get-ancestor-with-interface grob 'paper-column-interface X))

#(define (pitch-to-string p)
    (let* (
        (nn          (ly:pitch-notename p))
        (nn-string   (list-ref '("c" "d" "e" "f" "g" "a" "h") nn))
        (alt         (ly:pitch-alteration p))
        (alt-num     (+ 2 (* 2 alt)))
        (alt-string  (list-ref '("eses" "es" "" "is" "isis") alt-num))
        (oct         (ly:pitch-octave p))
        (oct-num     (+ 5 oct))
        (oct-string  (list-ref '(",,,," ",,," ",," "," "" "'" "''" "'''" "''''" "'''''" "''''''") oct-num))
        (na          (cons nn alt))
        (test        (lambda (n a) (equal? na (cons n a))))
        (na-string (cond
             ((test 2 -1) "eses")
             ((test 2 -1/2) "es")
             ((test 5 -1) "asas")
             ((test 5 -1/2) "as")
             ((test 6 -1/2) "b")
             (else (string-append nn-string alt-string)))))
    (string-append na-string oct-string)))


#(define maxstop 0.0)               % maximum Moment
#(define startlist '())             % Liste aller Startmomente von Noten oder Pausen
#(define firstmomentlist '())       % Liste aller ersten Momente jeder Seite

#(define (mkvideo-dump grob)
    (let* (
        (pap          (ly:parser-lookup '$defaultpaper))
        (paper-column (grob-get-paper-column grob))
        (cause        (ly:grob-property grob 'cause))
        (pitch        (if (ly:prob? cause) (ly:event-property cause 'pitch)))
        (lilypitch    (if (ly:pitch? pitch) (pitch-to-string pitch) "NaP"))
        (type         (if (ly:pitch? pitch) "note" "rest"))
        (time         (ly:grob-property paper-column 'when 0))
        (start        (+ 0.0 (ly:moment-main time) (* (ly:moment-grace time) (/ 9 40))))
        (duration     (if (ly:prob? cause) (format-moment (ly:duration-length (ly:event-property cause 'duration))) 0.0))
        (stop         (+ start duration))
        (nstart       (- 0 start))
        (nstop        (- 0 stop))
        (stem         (ly:grob-object grob 'stem))
        (flag         (ly:grob-object grob 'flag))
        (dot          (ly:grob-object grob 'dot))
        (R            (if pagerepetitions? 2.0    0.6))
        (G            (if pagerepetitions? nstart 0.0))
        (B            (if pagerepetitions? nstop  1.0)))
    (if (not (equal? (ly:grob-property grob 'transparent) #t))
        (format mkvid_out "~f ~a ~f ~a\n" start type stop lilypitch))
    (if (equal? (member nstart startlist) #f)
        ( list
          (set! startlist (append startlist (list nstart)))
          (set! startlist (sort-list startlist >=))))
    (if (> maxstop nstop)
        (set! maxstop nstop))
    (list
        (if colorheads?
            (ly:grob-set-property! grob 'color (rgb-color R G B)))
        (if (and (not (null? stem)) colorstems?)
            (ly:grob-set-property! stem 'color (rgb-color R G B)))
        (if (and (not (null? flag)) colorflags?)
            (ly:grob-set-property! flag 'color (rgb-color R G B)))
        (if (and (not (null? dot)) colordots?)
            (ly:grob-set-property! dot 'color (rgb-color R G B))))))

\layout {
    \context { \Voice
        \override NoteHead #'after-line-breaking = #mkvideo-dump
        \override Rest #'after-line-breaking = #mkvideo-dump
        \override MultiMeasureRest #'after-line-breaking = #mkvideo-dump
        \override NoteHead.layer = 3
    }
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Here we do some post-processing and build the alist for the page dumper
% (key is the page number, value is the list of moments on the page)
%

#(define dumpedstartlist? #f)

#(define (dumpstartlist)
    (list
        (do ((i 0 (1+ i)))
            ((>= i (length startlist)))
            ( format mkvid_out "~a page\n" (- 0 (list-ref startlist i))))
        (format mkvid_out "LASTMOMENT=~a\n"  (- 0 maxstop))
        (set! dumpedstartlist? #t)))
    
    
#(define (after-pb-processing layout pages)
  (let* (
    (lines        (map
                    (lambda (page)
                      (ly:prob-property page 'lines))
                  pages))
    (systems      (map
                    (lambda (line)
                      (append-map
                        (lambda (l)
                          (let (
                            (system-grob (ly:prob-property l 'system-grob)))
                        (if (not (null? system-grob)) 
                          (list system-grob) system-grob)))
                      line))
                  lines))
    (firstmoments (append
                    (map 
                      (lambda (m) 
                        (if (and (not (null? m)) (ly:grob? (car m)))
                          (- 0 (format-moment (grob::when (car m))))
                          #f))
                    systems)
                  (list maxstop)))
    (moments      (append startlist (list maxstop))))
  (if (and (not (null? firstmoments)) pagerepetitions?)
    (map 
      (lambda (page m) 
        (if m
          (set! videopagelist (acons page (cdr (member (list-ref firstmoments page) (reverse (member m moments)))) videopagelist))
          (list
            (if (not dumpedstartlist?)
              (dumpstartlist))
            (set! videopagelist (acons page '() videopagelist ))
            (format mkvid_out "page ~a contains no music\n" page)
          )
        )
      )
    (iota (length pages) 1 1) 
    firstmoments))))

\paper {
        #(define (page-post-process layout pages) (after-pb-processing layout pages))
}