Store old maketitle macro in editionkainhofer.sty

[orchestrallily.git] / orchestrallily.ily

\version "2.11.41"

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% OrchestralLily
% ==============
% Desciption:  Lilypond package to make writing large orchestral scores easier.
% Documentation: http://wiki.kainhofer.com/lilypond/orchestrallily
% Version: 0.02, 2008-03-06
% Author: Reinhold Kainhofer, reinhold@kainhofer.com
% Copyright: (C) 2008 by Reinhold Kainhofer
% License: GPL v3.0, http://www.gnu.org/licenses/gpl.html
%
% Version History:
% 0.01 (2008-03-02): Initial Version
% 0.02 (2008-03-06): Added basic MIDI support (*MidiInstrument and \setCreateMIDI)
% 0.03 (2008-07-xx): General staff/voice types, title pages, etc.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(use-modules (ice-9 match))


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   SCORE STRUCTURE AND AUTOMATIC GENERATION
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Helper functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Helper function to filter all non-null entries
#(define (not-null? x) (not (null? x)))

% Helper function to extract a given variable, built from [Piece][Instrument]Identifier
#(define (namedPieceInstrObject piece instr name)
  (let* (
         (fullname  (string->symbol (string-append piece instr name)))
         (instrname (string->symbol (string-append instr name)))
         (piecename (string->symbol (string-append piece name)))
        )
    (cond
      ((defined? fullname) (primitive-eval fullname))
      ((defined? instrname) (primitive-eval instrname))
      ((defined? piecename) (primitive-eval piecename))
      (else '())
    )
  )
)

%% Print text as a justified paragraph, taken from the lilypond Notation Reference
#(define-markup-list-command (paragraph layout props args) (markup-list?)
   (let ((indent (chain-assoc-get 'par-indent props 2)))
     (interpret-markup-list layout props
       (make-justified-lines-markup-list (cons (make-hspace-markup indent)
                                               args)))))

conditionalBreak = #(define-music-function (parser location) ()
   #{ \tag #'instrumental-score \pageBreak #}
)

#(define (oly:piece-title-markup title) (markup #:column (#:line (#:fontsize #'3 #:bold title))) )

#(define-markup-command (piece-title layout props title) (markup?)
     (interpret-markup layout props (oly:piece-title-markup title))
)

#(define (oly:generate_object_name piece instr obj )
  (if (and (string? piece) (string? instr) (string? obj))
    (string-append piece instr obj)
    #f
  )
)
#(define (oly:generate_staff_name piece instr) (oly:generate_object_name piece instr "St"))

#(define (set-context-property context property value)
  (set! (ly:music-property context property) value)
)


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Score structure and voice types
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define oly:LiedScoreStructure '(
  ("SoloScore" "SimultaneousMusic" ("Singstimme"))
  ("Pfe" "PianoStaff" ("PfeI" "PfeII"))
  ;("PfeI" "ParallelVoicesStaff" ("OIa" "OIb"))
  ;("PfeII" "ParallelVoicesStaff" ("OIIa" "OIIb"))
  ("FullScore" "SimultaneousMusic" ("Singstimme" "Pfe"))
  ("VocalScore" "SimultaneousMusic" ("Singstimme" "Pfe"))
))

#(define oly:fullOrchestraScoreStructure '(
; Part-combined staves for full score
  ("Fl" "PartCombinedStaff" ("FlI" "FlII"))
  ("Ob" "PartCombinedStaff" ("ObI" "ObII"))
  ("Cl" "PartCombinedStaff" ("ClI" "ClII"))
  ("Fag" "PartCombinedStaff" ("FagI" "FagII"))
  ("Wd" "StaffGroup" ("Fl" "Ob" "Cl" "Fag" "CFag"))

  ("Cor" "PartCombinedStaff" ("CorI" "CorII"))
  ("Trb" "PartCombinedStaff" ("TrbI" "TrbII"))
  ("Tbe" "PartCombinedStaff" ("TbeI" "TbeII"))
  ("Br" "StaffGroup" ("Cor" "Trb" "Tbe" "Tba"))

; long score; no part-combined staves, but GrandStaves instead
  ("FlLong" "GrandStaff" ("FlI" "FlII"))
  ("ObLong" "GrandStaff" ("ObI" "ObII"))
  ("ClLong" "GrandStaff" ("ClI" "ClII"))
  ("FagLong" "GrandStaff" ("FagI" "FagII"))
  ("WdLong" "StaffGroup" ("FlLong" "ObLong" "ClLong" "FagLong" "CFag"))

  ("CorLong" "GrandStaff" ("CorI" "CorII"))
  ("TrbLong" "GrandStaff" ("TrbI" "TrbII"))
  ("TbeLong" "GrandStaff" ("TbeI" "TbeII" "TbeIII"))
  ("BrLong" "StaffGroup" ("CorLong" "TrbLong" "TbeLong" "Tba"))

; Percussion
  ("Perc" "StaffGroup" ("Tim"))

; Strings, they are the same in long and short full score  
  ("V" "GrandStaff" ("VI" "VII"))
  ("Str" "StaffGroup" ("V" "Va"))
  ("VceB" "StaffGroup" ("Vc" "Cb" "VcB"))
  ("FullStr" "StaffGroup" ("V" "Va" "Vc" "Cb" "VcB"))

; Choral score
  ("Solo" "SimultaneousMusic" ("SSolo" "ASolo" "TSolo" "BSolo"))
  ("Ch" "ChoirStaff" ("S" "A" "T" "B"))
  ("ChoralScore" "SimultaneousMusic" ("Ch"))
  ("SoloScore" "SimultaneousMusic" ("Solo"))
  ("SoloChoirScore" "SimultaneousMusic" ("Solo" "Ch"))

; Organ score (inkl. Figured bass)
  ("BCFb" "FiguredBass" ())
  ("FiguredBass" "FiguredBass" ())
  ;("Organ" "SimultaneousMusic" ("BCFb" "O"))
  ("Organ" "ParallelVoicesStaff" ("BCFb" "BC" "FiguredBass"))
  ("Continuo" "ParallelVoicesStaff" ("BCFb" "BC" "FiguredBass"))
  
  ("O" "PianoStaff" ("OI" "OII"))
  ("OI" "ParallelVoicesStaff" ("OIa" "OIb"))
  ("OII" "ParallelVoicesStaff" ("OIIa" "OIIb"))
  ;("BassGroup" "ParallelVoicesStaff" ("Organ" "O" "BC" "VceB"))
  ("BassGroup" "StaffGroup" ("O" "Continuo"))

; Full Scores
  ("FullScore" "SimultaneousMusic" ("Wd" "Br" "Perc" "Str" "SoloChoirScore" "BassGroup"))
  ("LongScore" "SimultaneousMusic" ("WdLong" "BrLong" "Perc" "Str" "SoloChoirScore" "BassGroup"))

; Piano reduction
  ;("Piano" "SimultaneousMusic" ("Organ"))
  ("OrganScore" "SimultaneousMusic" ("ChoralScore" "O"))
  ("VocalScore" "SimultaneousMusic" ("ChoralScore" "Piano"))
  ("Particell"  "SimultaneousMusic" ("ChoralScore" "Continuo"))

; Full scores: Orchestral score and long score including organ
  ("ChStrQ" "SimultaneousMusic" ("Str" "Ch" "VceB"))
))
#(define oly:orchestral_score_structure oly:fullOrchestraScoreStructure)

#(define (oly:set_score_structure struct)
  (if (list? struct)
    (set! oly:orchestral_score_structure struct)
    (ly:warning (_ "oly:set_score_structure needs an association list as argument!"))
  )
)

#(define (oly:modify_score_structure entry)
  (if (list? entry)
    (set! oly:orchestral_score_structure (assoc-set! oly:orchestral_score_structure  (car entry) (cdr entry)))
    (ly:warning (_ "oly:modify_score_structure expects a list (\"key\" \"type\" '(children)) as argument!"))))

#(define (oly:remove_from_score_structure entry)
  (if (list? entry)
    (map oly:remove_from_score_structure entry)
    (set! oly:orchestral_score_structure (assoc-remove! oly:orchestral_score_structure  entry))))

orchestralScoreStructure = #(define-music-function (parser location structure) (list?) 
  (oly:set_score_structure structure)
  (make-music 'Music 'void #t)
)

#(define oly:voice_types '())

#(define (oly:set_voice_types types)
  (if (list? types)
    (set! oly:voice_types types)
    (ly:warning (_ "oly:set_voice_types needs an association list as argument!"))
  )
)

orchestralVoiceTypes = #(define-music-function (parser location types) (list?)
  (oly:set_voice_types types)
  (make-music 'Music 'void #t)
)


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Automatic staff and group generation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Retrieve all music definitions for the given 
#(define (oly:get_music_object piece instrument)
  (namedPieceInstrObject piece instrument "Music")
)
#(define (oly:get_music_objects piece instruments)
  (filter not-null? (map (lambda (i) (oly:get_music_object piece i)) instruments))
)

% Given a property name and the extensions, either generate the pair to set 
% the property or an empty list, if no pre-defined variable could be found
#(define (oly:generate_property_pair prop piece instr type)
  (let* ((val (namedPieceInstrObject piece instr type)))
    (if (not-null? val) (list 'assign prop val) '() )
  )
)
  
#(define (oly:staff_type type)
  (cond 
    ((string? type) (string->symbol type))
    ((symbol? type) type)
    (else 'Staff)
  )
)

#(define (oly:extractPitch music)
  (let* (
         (elems  (if (ly:music? music) (ly:music-property music 'elements)))
         (note   (if (pair? elems) (car elems)))
         (pitch  (if (ly:music? note) (ly:music-property note 'pitch)))
        )
    (if (and (not-null? music) (not (ly:pitch? pitch))) 
      (ly:warning "Unable to interpret as a pitch!")
    )
    pitch
  )

)
#(define (oly:extractTranspositionPitch piece name)
  (let* (
         (trpFromPitch (oly:extractPitch (namedPieceInstrObject piece name "TransposeFrom")))
         (trpToPitch   (oly:extractPitch (namedPieceInstrObject piece name "TransposeTo")))
        )
    (if (ly:pitch? trpFromPitch)
      (if (ly:pitch? trpToPitch)
        ; Both pitches
        (ly:pitch-diff trpFromPitch trpToPitch)
        (ly:pitch-diff trpFromPitch (ly:make-pitch 0 0 0))
      )
      (if (ly:pitch? trpToPitch)
        (ly:pitch-diff (ly:make-pitch 0 0 0) trpToPitch)
        #f
      )
    )
  )
)

#(define (oly:musiccontent_for_voice parser piece name music additional)
  (let* ((musiccontent additional))
    
    ; Append the settings, key and clef (if defined)
    (map 
      (lambda (type) 
        (let* ((object (namedPieceInstrObject piece name type)))
          (if (ly:music? object)
            (set! musiccontent (append musiccontent (list (ly:music-deep-copy object))))
            (if (not-null? object) (ly:warning (_ "Wrong type (no ly:music) for ~S for instrument ~S in piece ~S") type name piece))
          )
        )
      )
      ; TODO: Does the "Tempo" work here???
      '("Settings" "Key" "Clef" "TimeSignature" ;"Tempo"
      )
    )

    (if (ly:music? music)
      (begin
        (set! musiccontent (make-simultaneous-music (append musiccontent (list music))))
        ;(ly:message "Generating staff for ~a" name)
        (let* ((trpPitch (oly:extractTranspositionPitch piece name)))
          (if (ly:pitch? trpPitch) 
            (set! musiccontent (ly:music-transpose musiccontent trpPitch))
          )
        )
        musiccontent
      )
      ; For empty music, return empty 
      '()
    )
  )
)

#(define (oly:lyrics_create_single_context parser piece name voicename lyricsid)
  ; If we have lyrics, create a lyrics context containing LyricCombineMusic 
  ; and add that as second element to the staff's elements list...
  (let* ((id (string-append "Lyrics" lyricsid))
         (lyrics (namedPieceInstrObject piece name id)))
    (if (ly:music? lyrics)
      (context-spec-music (make-music 'LyricCombineMusic 
                                      'element lyrics 
                                      'associated-context voicename) 
                          'Lyrics (oly:generate_object_name piece name id))
      '())
  )
)

#(define (oly:lyrics_create_contexts parser piece name voicename)
  (filter not-null? 
    (map (lambda (str) 
                 (oly:lyrics_create_single_context parser piece name voicename str))
         (list "" "I" "II" "III"  "IV" "V" "VI"))))

#(define (oly:voice_handler_internal parser piece name type music)
  (if (ly:music? music)
    (let* (
           (voicename    (oly:generate_object_name piece name "Voice" ))
           (lyrics       (oly:lyrics_create_contexts parser piece name voicename))
           (additional   (if (not-null? lyrics) (list dynamicUp) '()))
           (musiccontent (oly:musiccontent_for_voice parser piece name music additional))
           (voicetype    (oly:staff_type type))
           (voice        (context-spec-music musiccontent voicetype voicename))
          )
      (cons voice lyrics)
    )
    ; For empty music, return empty 
    '()
  )
)

#(define (oly:voice_handler parser piece name type)
  (oly:voice_handler_internal parser piece name type (oly:get_music_object piece name)))


#(define (oly:staff_handler_internal parser piece name type voices)
  (if (not-null? voices)
    (let* (
           (staffname  (oly:generate_staff_name piece name))
           (stafftype  (oly:staff_type type))
           (staff      (make-simultaneous-music voices))
           (propops    (oly:staff_handler_properties piece name))
          )
      (case stafftype
        ((SimultaneousMusic ParallelMusic) #f)
        (else (set! staff (context-spec-music staff stafftype staffname)))
      )
      (if (not-null? propops)
        (set! (ly:music-property staff 'property-operations) propops)
      )
      staff
    )
    ; For empty music, return empty 
    '()
  )
)

#(define (oly:staff_handler parser piece name type children)
  (let* ((c (if (not-null? children) children (list name)))
         (voices (apply append (map (lambda (v) (oly:create_voice parser piece v)) c)) ) 
        )
    (if (not-null? voices)
      (oly:staff_handler_internal parser piece name type voices)
      '()
    )
  )
)

#(define (oly:devnull_handler parser piece name type children)
  (oly:voice_handler parser piece name type)
)
  
#(define (oly:parallel_voices_staff_handler parser piece name type children) 
  (let* (
         (voices (map (lambda (i) (oly:create_voice parser piece i)) children))
         ; get the list of non-empty voices and flatten it!
         (nonemptyvoices (apply append (filter not-null? voices)))
        )
    (if (not-null? nonemptyvoices)
      (oly:staff_handler_internal parser piece name "Staff" nonemptyvoices)
      '()
    )
  )
)

#(define (oly:part_combined_staff_handler parser piece name type children) 
  (let* ((rawmusic (map (lambda (c) (oly:musiccontent_for_voice parser piece name (oly:get_music_object piece c) '())) children))
         (music (filter not-null? rawmusic)))
  (cond
      ((and (pair? music) (ly:music? (car music)) (not-null? (cdr music)) (ly:music? (cadr music)))
          ;(ly:message "Part-combine with two music expressions")
          (oly:staff_handler_internal parser piece name "Staff" (list (make-part-combine-music parser music))))
      ((null? music) 
          (ly:warning "Part-combine without any music expressions")
          '())
      ; exactly one is a music expression, simply use that by joining 
      ((list? music) 
          (ly:message "Part-combine with only one music expressions")
          (oly:staff_handler_internal parser piece name "Staff" (list (apply append music))))
      (else 
          ;(ly:message "make_part_combined_staff: ~S ~S ~a" piece instr instruments) 
          '() )
    )
  )
)

% Generate the properties for the staff for piece and instr. Typically, these
% are the instrument name and the short instrument name (if defined).
% return a (possibly empty) list of all assignments.
#(define (oly:staff_handler_properties piece instr)
  (let* (
         (mapping '( 
              (instrumentName . "InstrumentName") 
              (shortInstrumentName . "ShortInstrumentName")
              (midiInstrument . "MidiInstrument")
            ))
         (assignments (map 
             (lambda (pr) 
                 (oly:generate_property_pair (car pr) piece instr (cdr pr))
             )
             mapping))
         (props (filter not-null? assignments))
        )
    props
  )
)
  
% Figured bass is a special case, as it can be voice- or staff-type. When
% given as a staff type, simply call the voice handler, instead

#(define (oly:figured_bass_staff_handler parser piece name type children)
  (let* ((c (if (not-null? children) children (list name)))
         (voice  (oly:voice_handler parser piece (car c) type)))
    (if (pair? voice) (car voice) ())
  )
)
  
#(define (flatten lst)
  (define (f remaining result)
    (cond
      ((null? remaining) result)
      ((pair? (car remaining)) (f (cdr remaining) (f (car remaining) result)))
      (else (f (cdr remaining) (cons (car remaining) result)))))
  (reverse! (f lst '())))

#(define (oly:staff_group_handler parser piece name type children)
  (let* (
         (staves (flatten (map (lambda (i) (oly:create_staff_or_group parser piece i)) children)))
         (nonemptystaves (filter not-null? staves))
        )
    (if (not-null? nonemptystaves)
      (let* (
             (musicexpr (if (= 1 (length nonemptystaves)) 
                          (car nonemptystaves) 
                          (make-simultaneous-music nonemptystaves)))
             (groupname (oly:generate_staff_name piece name))
             (grouptype (oly:staff_type type))
             (group     musicexpr)
             (propops   (oly:staff_handler_properties piece name))
            )
        (case grouptype
          ((SimultaneousMusic ParallelMusic) #f)
          (else (set! group (context-spec-music group grouptype groupname)))
        )
        (if (pair? propops)
          (set! (ly:music-property group 'property-operations) propops))
        group
      )
      ; Return empty list if no staves are generated
      '()
    )
  )
)

#(define (oly:create_voice parser piece name)
  (let* ( (voice (namedPieceInstrObject piece name "Voice"))
          (type (assoc-ref oly:voice_types name)) )
    (if (not-null? voice)
      ; Explicit voice variable, use that
      voice
      
      (if (not type)
        ; No entry in structure found => simple voice
        (oly:voice_handler parser piece name "Voice")
        ; Entry found in structure => use the handler for the given type
        (let* (
               (voicetype (car type))
               (handler (assoc-ref oly:voice_handlers voicetype))
              )
          (if handler
            ((primitive-eval handler) parser piece name voicetype)
            (begin
              (ly:warning "No handler found for voice type ~a, using default voice handler" voicetype)
              (oly:voice_handler parser piece name voicetype)
            )
          )
        )
      )
    )
  )
)

#(define (oly:create_staff_or_group parser piece name)
  (let* ( (staff (namedPieceInstrObject piece name "Staff"))
          (type_from_structure (assoc-ref oly:orchestral_score_structure name)) )
    ;(if (not-null? staff)
    ;  (ly:message "Found staff variable for instrument ~a in piece ~a"  instr piece)
    ;  (ly:message "Staff variable for instrument ~a in piece ~a NOT FOUND"  instr piece)
    ;)
    (if (not-null? staff)
      ; Explicit staff variable, use that
      staff
      
      (if (not (list? type_from_structure)) 
        ; No entry in structure found => simple staff
        (oly:staff_handler parser piece name "Staff" '())
        
        ; Entry found in structure => use the handler for the given type
        (let* ((type (car type_from_structure))
               (handler (assoc-ref oly:staff_handlers type))
               (children (cadr type_from_structure))
              )
          (if handler
            ((primitive-eval handler) parser piece name type children)
            (begin
              (ly:warning "No handler found for staff type ~a, using default staff handler" type)
              (oly:staff_handler parser piece name type children)
            )
          )
        )
      )
    )
  )
)

#(define oly:staff_handlers
  (list
    ; staff group types
    '("GrandStaff" . oly:staff_group_handler )
    '("PianoStaff" . oly:staff_group_handler )
    '("ChoirStaff" . oly:staff_group_handler )
    '("StaffGroup" . oly:staff_group_handler )
    '("InnerChoirStaff" . oly:staff_group_handler )
    '("InnerStaffGroup" . oly:staff_group_handler )
    '("ParallelMusic" . oly:staff_group_handler )
    '("SimultaneousMusic" . oly:staff_group_handler )
    ; staff types
    '("Staff" . oly:staff_handler )
    '("DrumStaff" . oly:staff_handler )
    '("RhythmicStaff" . oly:staff_handler )
    '("TabStaff" . oly:staff_handler )
    '("GregorianTranscriptionStaff" . oly:staff_handler )
    '("MensuralStaff" . oly:staff_handler )
    '("VaticanaStaff" . oly:staff_handler )
    ; staves with multiple voices
    '("PartCombinedStaff" . oly:part_combined_staff_handler )
    '("ParallelVoicesStaff" . oly:parallel_voices_staff_handler )
    ; special cases: Figured bass can be staff or voice type!
    '("FiguredBass" . oly:figured_bass_staff_handler )
    ; Devnull is like a staff, only that it doesn't craete output
    '("Devnull" . oly:devnull_handler )
  )
)

#(define oly:voice_handlers
  (list
    ; voice types
    '("Voice" . oly:voice_handler )
    '("CueVoice" . oly:voice_handler )
    '("DrumVoice" . oly:voice_handler )
    '("FiguredBass" . oly:voice_handler )
    '("GregorianTranscriptionVoice" . oly:voice_handler )
    '("NoteNames" . oly:voice_handler )
    '("TabVoice" . oly:voice_handler )
    '("VaticanaVoice" . oly:voice_handler )
    ;'("Dynamics" . oly:dynamics_handler )
  )
)


#(define (oly:register_staff_type_handler type func)
;  (ly:message "Registering staff handler ~a for type ~a" func type)
  (set! oly:staff_handlers (assoc-set! oly:staff_handlers type func))
)

#(define (oly:register_voice_type_handler type func)
;  (ly:message "Registering voice type handler ~a for type ~a" func type)
  (set! oly:voice_handlers (assoc-set! oly:voice_handlers type func))
)

% handlers for deprecated API
#(oly:register_staff_type_handler 'StaffGroup 'oly:staff_group_handler)
#(oly:register_staff_type_handler 'GrandStaff 'oly:staff_group_handler)
#(oly:register_staff_type_handler 'PianoStaff 'oly:staff_group_handler)
#(oly:register_staff_type_handler 'ChoirStaff 'oly:staff_group_handler)
#(oly:register_staff_type_handler 'Staff 'oly:staff_handler )
#(oly:register_staff_type_handler 'ParallelMusic 'oly:staff_group_handler)
#(oly:register_staff_type_handler 'SimultaneousMusic 'oly:staff_group_handler)
#(oly:register_staff_type_handler #t 'oly:part_combined_staff_handler )
#(oly:register_staff_type_handler #f 'oly:parallel_voices_staff_handler )

    

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Automatic score generation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% \setUseBook ##t/##f sets a flag to determine whether the calls to createScore
% are from within a book block or not
% #(define oly:score_handler collect-scores-for-book)
% #(define oly:score_handler toplevel-score-handler)
% #(define oly:music_handler toplevel-music-handler)
% #(define oly:text_handler toplevel-text-handler)

% ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#(define-public (add-score parser score)
   (ly:parser-define! parser 'toplevel-scores
                      (cons score (ly:parser-lookup parser 'toplevel-scores))))

#(define-public (add-text parser text)
  (add-score parser (list text)))

#(define-public (add-music parser music)
  (collect-music-aux (lambda (score)
                       (add-score parser score))
                     parser
                     music))

#(define-public (toplevel-book-handler parser book)
   (map (lambda (score)
          (ly:book-add-score! book score))
        (reverse! (ly:parser-lookup parser 'toplevel-scores)))
   (ly:parser-define! parser 'toplevel-scores (list))
   (print-book-with-defaults parser book))

#(define-public (book-score-handler book score)
   (add-score parser score))

#(define-public (book-text-handler book text)
   (add-text parser text))

#(define-public (book-music-handler parser book music)
   (add-music parser music))

#(define oly:score_handler add-score)
#(define oly:music_handler add-music)
#(define oly:text_handler add-text)
% ~~~~~~~~~~~~~~~~~~

% TODO: deprecate
setUseBook = #(define-music-function (parser location usebook) (boolean?) 
  (ly:warning "\\setUseBook has been deprecated! Books are now automatically handled without any hacks")
  (make-music 'Music 'void #t)
)


% Two functions to handle midi-blocks: Either don't set one, or set an empty 
% one so that MIDI is generated
#(define (oly:set_no_midi_block score) '())
#(define (oly:set_midi_block score) 
  (let* ((midiblock (if (defined? '$defaultmidi) 
                        (ly:output-def-clone $defaultmidi) 
                        (ly:make-output-def))))
    (ly:output-def-set-variable! midiblock 'is-midi #t)
    (ly:score-add-output-def! score midiblock)
  )
)

% \setCreateMidi ##t/##f sets a flag to determine wheter MIDI output should
% be generated
#(define oly:apply_score_midi oly:set_no_midi_block)
setCreateMIDI = #(define-music-function (parser location createmidi) (boolean?)
  (if createmidi
    (set! oly:apply_score_midi oly:set_midi_block)
    (set! oly:apply_score_midi oly:set_no_midi_block)
  )
  (make-music 'Music 'void #t)
)


% Two functions to handle layout-blocks: Either don't set one, or set an empty 
% one so that a PDF is generated
#(define (oly:set_no_layout_block score) '())
#(define (oly:set_layout_block score) 
  (let* ((layoutblock (if (defined? '$defaultlayout) 
                        (ly:output-def-clone $defaultlayout) 
                        (ly:make-output-def))))
    (ly:output-def-set-variable! layoutblock 'is-layout #t)
    (ly:score-add-output-def! score layoutblock)
  )
)

% \setCreatePDF ##t/##f sets a flag to determine wheter PDF output should
% be generated
#(define oly:apply_score_layout oly:set_no_layout_block)
setCreatePDF = #(define-music-function (parser location createlayout) (boolean?)
  (if createlayout
    (set! oly:apply_score_layout oly:set_layout_block)
    (set! oly:apply_score_layout oly:set_no_layout_block)
  )
  (make-music 'Music 'void #t)
)


% Set the piece title in a new header block.
#(define (oly:set_piece_header score piecename)
  (if (not-null? piecename)
    (let* ((header (make-module)))
      (module-define! header 'piece piecename)
      (ly:score-set-header! score header)
    )
  )
)


% post-filter functions. By default, no filtering is done. However,
% for the *NoCues* function, the cue notes should be killed
identity = #(define-music-function (parser location music) (ly:music?) music)
cuefilter = #(define-music-function (parser location music) (ly:music?)
  ((ly:music-function-extract removeWithTag) parser location 'cued ((ly:music-function-extract killCues) parser location music))
)


#(define (oly:create-toc-file layout pages)
  (let* ((label-table (ly:output-def-lookup layout 'label-page-table)))
    (if (not (null? label-table))
      (let* ((format-line (lambda (toc-item)
             (let* ((label (car toc-item))
                    (text  (caddr toc-item))
                    (label-page (and (list? label-table) 
                                     (assoc label label-table)))
                    (page (and label-page (cdr label-page))))
               (format #f "~a, section, 1, {~a}, ~a" page text label))))
             (formatted-toc-items (map format-line (toc-items)))
             (whole-string (string-join formatted-toc-items ",\n"))
             (output-name (ly:parser-output-name parser))
             (outfilename (format "~a.toc" output-name))
             (outfile (open-output-file outfilename)))
        (if (output-port? outfile)
            (display whole-string outfile)
            (ly:warning (_ "Unable to open output file ~a for the TOC information") outfilename))
        (close-output-port outfile)))))


#(define-public (oly:add-toc-item parser markup-symbol text)
  (oly:music_handler parser (add-toc-item! markup-symbol text)))


#(define (oly:add-score parser score piecename)
  (if (not-null? piecename)
    (oly:add-toc-item parser 'tocItemMarkup piecename))
  (oly:score_handler parser score)
)
% The helper function to build a score.
#(define (oly:createScoreHelper parser location piece children func)
  (let* (
         (staves    (oly:staff_group_handler parser piece "" "SimultaneousMusic" children))
         (music     (if (not-null? staves)
                        ((ly:music-function-extract func) parser location staves)
                        '()
                    ))
         (score     '())
         (piecename (namedPieceInstrObject piece (car children) "PieceName"))
         (piecenametacet (namedPieceInstrObject piece (car children) "PieceNameTacet"))
         (header    '())
        )
    (if (null? music)
      ; No staves, print tacet
      (begin 
        (if (not-null? piecenametacet) (set! piecename piecenametacet))
        (if (not-null? piecename)
          (oly:add-score parser (list (oly:piece-title-markup piecename)) piecename)
          (ly:warning (_ "No music and no score title found for part ~a and instrument ~a") piece children)
        )
      )
      ; we have staves, apply the piecename to the score and add layout/midi blocks if needed
      (begin
        (set! score (scorify-music music parser))
        (oly:set_piece_header score piecename)
        (oly:apply_score_midi score)
        (oly:apply_score_layout score)
        ; Schedule the score for typesetting
        (oly:add-score parser score piecename)
      )
    )
  )
  ; This is a void function, the score has been schedulled for typesetting already
  (make-music 'Music 'void #t)
)

createScore = #(define-music-function (parser location piece children) (string? list?)
  (oly:createScoreHelper parser location piece children identity)
)
createNoCuesScore = #(define-music-function (parser location piece children) (string? list?)
  (oly:createScoreHelper parser location piece children cuefilter)
)

createHeadline = #(define-music-function (parser location headline) (string?)
  (oly:add-toc-item parser 'tocItemMarkup headline)
  (oly:score_handler parser (list (oly:piece-title-markup headline)))
  (make-music 'Music 'void #t)
)



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   CUE NOTES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

newInstrument = #(define-music-function (parser location instr) (string?)
#{
  \set Voice.instrumentCueName = #$(string-join (list "+" instr))
#}
)
cueText = #(define-music-function (parser location instr) (string?)
#{
  \set Voice.instrumentCueName = $instr
#}
)

% generate a cue music section with instrument names
% Parameters: \namedCueDuring NameOfQuote CueDirection CueInstrument OriginalInstrument music
%                 -) NameOfQuote CueDirection music are the parameters for \cueDuring
%                 -) CueInstrument and OriginalInstrument are the displayed instrument names
% typical call:
% \namedCueDuring #"vIQuote" #UP #"V.I" #"Sop." { R1*3 }
%      This adds the notes from vIQuote (defined via \addQuote) to three measures, prints "V.I" at
%      the beginning of the cue notes and "Sop." at the end
namedCueDuring = #(define-music-function (parser location cuevoice direction instrcue instr cuemusic) (string? number? string? string? ly:music?)
   #{
     \cueDuring #$cuevoice #$direction { \tag #'cued \cueText #$instrcue $cuemusic \tag #'cued \cueText #$instr }
%      \tag #'uncued $cuemusic
   #}
)
namedTransposedCueDuring = #(define-music-function (parser location cuevoice direction instrcue instr trans cuemusic) (string? number? string? string? ly:music? ly:music?)
   #{
     \transposedCueDuring #$cuevoice #$direction $trans { \tag #'cued \cueText #$instrcue $cuemusic \tag #'cued \cueText #$instr }
%      \tag #'uncued $cuemusic
   #}
)

% set the cue instrument name and clef
setClefCue = #(define-music-function (parser location instr clef) 
                                                     (string? ly:music?)
   #{
     \once \override Staff.Clef #'font-size = #-3 $clef
     \set Voice.instrumentCueName = $instr
   #} )

% generate a cue music section with instrument names and clef changes
% Parameters: \cleffedCueDuring NameOfQuote CueDirection CueInstrument CueClef OriginalInstrument OriginalClef music
%                 -) NameOfQuote CueDirection music are the parameters for \cueDuring
%                 -) CueInstrument and OriginalInstrument are the displayed instrument names
%                 -) CueClef and OriginalClef are the clefs for the the cue notes and the clef of the containing voice
% typical call:
% \cleffedCueDuring #"vIQuote" #UP #"V.I" #"treble" #"Basso" #"bass" { R1*3 }
%      This adds the notes from vIQuote (defined via \addQuote) to three measures, prints "V.I" at
%      the beginning of the cue notes and "Basso" at the end. The clef is changed to treble at the 
%      beginning of the cue notes and reset to bass at the end
cleffedCueDuring = #(define-music-function (parser location cuevoice direction instrcue clefcue instr clefinstr cuemusic) 
                                                        (string? number? string? ly:music? string? ly:music? ly:music?)
   #{
     \cueDuring #$cuevoice #$direction { \tag #'cued \setClefCue #$instrcue $clefcue $cuemusic \tag #'cued \setClefCue #$instr $clefinstr }
%      \tag #'uncued $cuemusic
   #}
)




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   DYNAMICS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


dynamicsX = #(define-music-function (parser location offset) (number?)
#{
    \once \override DynamicText #'X-offset = $offset
    \once \override DynamicLineSpanner #'Y-offset = #0
#})

% Move the dynamic sign inside the staff to a fixed staff-relative position 
% posY (where 0 means vertically starts at the middle staff line)
dynamicsAllInside = #(define-music-function (parser location offsetX posY)
(number? number?)
#{
  % Invalid y-extent -> hidden from skyline calculation and collisions
  \once \override DynamicLineSpanner #'Y-extent = #(cons +0 -0.01)
  % move by X offset and to fixed Y-position (use Y-offset of parent!)
  \once \override DynamicText #'X-offset = $offsetX
  \once \override DynamicText #'Y-offset =
    $(lambda (grob)
       (let* ((head (ly:grob-parent grob Y))
              (offset (ly:grob-property head 'Y-offset)))
         (- posY  offset (- 0.6))))
  \once \override DynamicLineSpanner #'Y-offset = $posY
#})

dynamicsUpInside = #(define-music-function (parser location offsetX) (number?)
  ((ly:music-function-extract dynamicsAllInside) parser location offsetX 1.5)
)

dynamicsDownInside = #(define-music-function (parser location offsetX) (number?)
  ((ly:music-function-extract dynamicsAllInside) parser location offsetX -3.5)
)

hairpinOffset = #(define-music-function (parser location posY) (number?)
#{
  \once \override DynamicLineSpanner #'Y-offset = $posY
  \once \override DynamicLineSpanner #'Y-extent = #(cons +0 -0.01)
#})

#(define ((line-break-offset before after) grob)
  (let* ((orig (ly:grob-original grob))
         ; All siblings if line-broken:
         (siblings (if (ly:grob? orig) (ly:spanner-broken-into orig) '() )))
    (if (>= (length siblings) 2)
      ; We have been line-broken
      (if (eq? (car (last-pair siblings)) grob)
        ; Last sibling:
        (ly:grob-set-property! grob 'Y-offset after)
        ; Others get the before value:
        (ly:grob-set-property! grob 'Y-offset before)
      )
    )
  )
)

ffz = #(make-dynamic-script "ffz")
pf = #(make-dynamic-script "pf")
sempp = #(make-dynamic-script (markup #:line( #:with-dimensions '(0 . 0) 
'(0 . 0) #:right-align #:normal-text #:italic "sempre" #:dynamic "pp")))
parenf = #(make-dynamic-script (markup #:line(#:normal-text #:italic #:fontsize 2 "(" #:dynamic "f" #:normal-text #:italic #:fontsize 2 ")" )))
parenp = #(make-dynamic-script (markup #:line(#:normal-text #:italic #:fontsize 2 "(" #:dynamic "p" #:normal-text #:italic #:fontsize 2 ")" )))
pdolce = #(make-dynamic-script (markup #:line(#:dynamic "p" #:with-dimensions '(0 . 0) '(0 . 0) #:normal-text #:italic "dolce"  )))
sfpdolce = #(make-dynamic-script (markup #:line(#:dynamic "sfp" #:with-dimensions '(0 . 0) '(0 . 0) #:normal-text #:italic "dolce"  )))
bracketf = #(make-dynamic-script (markup #:line(#:concat(#:normal-text "[" #:dynamic "f" #:normal-text "]"))))
bracketp = #(make-dynamic-script (markup #:line(#:concat(#:normal-text "[" #:dynamic "p" #:normal-text "]"))))



% cresc = #(make-music 'CrescendoEvent 'span-direction START 'crescendoSpanner 'text 'crescendoText "cresc.")
% endcresc =  #(make-span-event 'CrescendoEvent STOP)
% dim = #(make-music 'DecrescendoEvent 'span-direction START 'decrescendoSpanner 'text 'decrescendoText "dim.")
% enddim =  #(make-span-event 'DecrescendoEvent STOP)
% decresc = #(make-music 'DecrescendoEvent 'span-direction START 'decrescendoSpanner 'text 'decrescendoText "decresc.")
% enddecresc =  #(make-span-event 'DecrescendoEvent STOP)

% setCresc = {}
% setDecresc = {}
% setDim = {}
cresc = #(make-music 'CrescendoEvent 'span-direction START
                     'span-type 'text 'span-text "cresc.")
dim = #(make-music 'DecrescendoEvent 'span-direction START
                   'span-type 'text 'span-text "dim.")
decresc = #(make-music 'DecrescendoEvent 'span-direction START
                       'span-type 'text 'span-text "decresc.")

newOrOldClef = #(define-music-function (parser location new old ) (string? string?)
    (if (ly:get-option 'old-clefs) #{ \clef $old #} #{ \clef $new #}) 
)



%%% Thanks to "Gilles THIBAULT" <gilles.thibault@free.fr>, there is a way
%   to remove also the fermata from R1-\fermataMarkup: By filtering the music
%   and removing the corresponding events.
%   Documented as an LSR snippet: http://lsr.dsi.unimi.it/LSR/Item?id=372
#(define (filterOneEventsMarkup event)
( let ( (eventname (ly:music-property  event 'name)) )
 (not
  (or     ;; add here event name you do NOT want
   (eq? eventname 'MultiMeasureTextEvent)
   (eq? eventname 'AbsoluteDynamicEvent)
   (eq? eventname 'TextScriptEvent)
   (eq? eventname 'ArticulationEvent)
   (eq? eventname 'CrescendoEvent)
   (eq? eventname 'DecrescendoEvent)
  )
 )
))

filterArticulations = #(define-music-function (parser location music) (ly:music?)
   (music-filter filterOneEventsMarkup music)
)





%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   Tempo markings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



rit = \markup {\italic "rit."}
pocorit = \markup {\italic "poco rit."}
ppmosso = \markup {\italic "poco più mosso"}
dolce = \markup {\italic "dolce."}
pizz = \markup {\italic "pizz."}
arco = \markup {\italic "arco"}
perd = \markup {\italic "perdend."}




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   REST COMBINATION
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



%% REST COMBINING, TAKEN FROM http://lsr.dsi.unimi.it/LSR/Item?id=336
%%
%% Usage:
%%   \new Staff \with {
%%     \override RestCollision #'positioning-done = #merge-rests-on-positioning
%%   } << \somevoice \\ \othervoice >>
%% or (globally):
%%   \layout {
%%     \context {
%%       \Staff
%%       \override RestCollision #'positioning-done = #merge-rests-on-positioning
%%     }
%%   } 
%%
%% Limitations:
%% - only handles two voices
%% - does not handle multi-measure/whole-measure rests

#(define (rest-score r)
  (let ((score 0)
  (yoff (ly:grob-property-data r 'Y-offset))
  (sp (ly:grob-property-data r 'staff-position)))
    (if (number? yoff)
  (set! score (+ score 2))
  (if (eq? yoff 'calculation-in-progress)
      (set! score (- score 3))))
    (and (number? sp)
   (<= 0 2 sp)
   (set! score (+ score 2))
   (set! score (- score (abs (- 1 sp)))))
    score))

#(define (merge-rests-on-positioning grob)
  (let* ((can-merge #f)
   (elts (ly:grob-object grob 'elements))
   (num-elts (and (ly:grob-array? elts)
      (ly:grob-array-length elts)))
   (two-voice? (= num-elts 2)))
    (if two-voice?
  (let* ((v1-grob (ly:grob-array-ref elts 0))
         (v2-grob (ly:grob-array-ref elts 1))
         (v1-rest (ly:grob-object v1-grob 'rest))
         (v2-rest (ly:grob-object v2-grob 'rest)))
    (and
     (ly:grob? v1-rest)
     (ly:grob? v2-rest)          
     (let* ((v1-duration-log (ly:grob-property v1-rest 'duration-log))
      (v2-duration-log (ly:grob-property v2-rest 'duration-log))
      (v1-dot (ly:grob-object v1-rest 'dot))
      (v2-dot (ly:grob-object v2-rest 'dot))
      (v1-dot-count (and (ly:grob? v1-dot)
             (ly:grob-property v1-dot 'dot-count -1)))
      (v2-dot-count (and (ly:grob? v2-dot)
             (ly:grob-property v2-dot 'dot-count -1))))
       (set! can-merge
       (and 
        (number? v1-duration-log)
        (number? v2-duration-log)
        (= v1-duration-log v2-duration-log)
        (eq? v1-dot-count v2-dot-count)))
       (if can-merge
     ;; keep the rest that looks best:
     (let* ((keep-v1? (>= (rest-score v1-rest)
              (rest-score v2-rest)))
      (rest-to-keep (if keep-v1? v1-rest v2-rest))
      (dot-to-kill (if keep-v1? v2-dot v1-dot)))
       ;; uncomment if you're curious of which rest was chosen:
       ;;(ly:grob-set-property! v1-rest 'color green)
       ;;(ly:grob-set-property! v2-rest 'color blue)
       (ly:grob-suicide! (if keep-v1? v2-rest v1-rest))
       (if (ly:grob? dot-to-kill)
           (ly:grob-suicide! dot-to-kill))
       (ly:grob-set-property! rest-to-keep 'direction 0)
       (ly:rest::y-offset-callback rest-to-keep)))))))
    (if can-merge
  #t
  (ly:rest-collision::calc-positioning-done grob))))





%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   TABLE OF CONTENTS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


contentsTitle = "Inhalt / Contents"

\paper {
  tocTitleMarkup = \markup \fill-line{ 
    \null 
    \column {
      \override #(cons 'line-width (* 7 cm)) 
      \line{ \fill-line {\piece-title {\contentsTitle} \null }}
      \hspace #1
    }
    \null 
  }
  tocItemMarkup = \markup \fill-line { 
    \null 
    \column {
      \override #(cons 'line-width (* 7 cm )) 
      \line { \fill-line{\fromproperty #'toc:text \fromproperty #'toc:page }}
    }
    \null
  }
}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   TITLE PAGE / HEADER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define-markup-command (when-property layout props symbol markp) (symbol? markup?)
  (if (chain-assoc-get symbol props)
      (interpret-markup layout props markp)
      (ly:make-stencil '()  '(1 . -1) '(1 . -1))))

#(define-markup-command (vspace layout props amount) (number?)
  "This produces a invisible object taking vertical space."
  (let ((amount (* amount 3.0)))
    (if (> amount 0)
        (ly:make-stencil "" (cons -1 1) (cons 0 amount))
        (ly:make-stencil "" (cons -1 1) (cons amount amount)))))



titlePageMarkup = \markup \abs-fontsize #10 \when-property #'header:title \column {
    \vspace #4
    \fill-line { \fontsize #8 \fromproperty #'header:composer }
    \vspace #1
    \fill-line { \fontsize #8 \fromproperty #'header:poet }
    \vspace #4
    \fill-line { \fontsize #10 \bold \fromproperty #'header:titlepagetitle }
    \vspace #1
    \fontsize #2 \when-property #'header:titlepagesubtitle { 
      \fill-line { \fromproperty #'header:titlepagesubtitle }
      \vspace #1
    }
    \fill-line { \postscript #"-20 0 moveto 40 0 rlineto stroke" }
    \vspace #8
    \fill-line { \fontsize #5 \fromproperty #'header:ensemble }
    \vspace #0.02
    \fill-line { \fontsize #2 \fromproperty #'header:instruments }
    \vspace #9
    \fill-line { \fontsize #5 \fromproperty #'header:date }
    \vspace #1
    \fill-line { \fontsize #5 \fromproperty #'header:scoretype }
    \vspace #8
    \fontsize #2 \when-property #'header:enteredby { 
      \fill-line { "Herausgegeben von: / Edited by:"}
      \vspace #0.
      \fill-line { \fromproperty #'header:enteredby }
    }
    \fill-line {
      \when-property #'header:arrangement \column {
        \vspace #8
        \fill-line { \fontsize #3 \fromproperty #'header:arrangement }
      }
    }
}

titleHeaderMarkup = \markup {
  \override #'(baseline-skip . 3.5)
  \column {
    \override #'(baseline-skip . 3.5)
    \column {
      \huge \larger \bold
      \fill-line {
        \larger \fromproperty #'header:title
      }
      \fill-line {
        \large \smaller \bold
        \larger \fromproperty #'header:subtitle
      }
      \fill-line {
        \smaller \bold
        \fromproperty #'header:subsubtitle
      }
      \fill-line {
        { \large \bold \fromproperty #'header:instrument }
      }
      \fill-line {
        \fromproperty #'header:poet
        \fromproperty #'header:composer
      }
      \fill-line {
        \fromproperty #'header:meter
        \fromproperty #'header:arranger
      }
    }
  }
}

titleScoreMarkup = \markup \piece-title \fromproperty #'header:piece

\paper {
  scoreTitleMarkup = \titleScoreMarkup
  bookTitleMarkup = \titleHeaderMarkup
}



%%%%%%%%%%%%%% headers and footers %%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (first-score-page layout props arg)
  (let* ((label 'first-score-page)
         (table (ly:output-def-lookup layout 'label-page-table))
         (label-page (and (list? table) (assoc label table)))
         (page-number (and label-page (cdr label-page)))
        )
    (if (eq? (chain-assoc-get 'page:page-number props -1) page-number)
      (interpret-markup layout props arg)
      empty-stencil)))

#(define no-header-table '())
thisPageNoHeader = #(define-music-function (parser location) ()
  (let* ((label (gensym "header")))
    (set! no-header-table (cons label no-header-table))
    (make-music 'Music 
      'page-marker #t
      'page-label label)))


% TODO: Use the no-header-table!
#(define (is-header-page layout props arg)
  (let* ((page-number (chain-assoc-get 'page:page-number props -1))
        )
    ;(if (and (> page-number 2) (!= page-number 7))
    (if (> page-number 1)
      (interpret-markup layout props arg)
      empty-stencil)))

#(define no-footer-table '())
thisPageNoFooter = #(define-music-function (parser location) ()
  (let* ((label (gensym "footer")))
    (set! no-footer-table (cons label no-footer-table))
    (make-music 'Music 
      'page-marker #t
      'page-label label)))

% TODO: Use the no-footer-table!
#(define (is-footer-page layout props arg)
  (let* ((page-number (chain-assoc-get 'page:page-number props -1))
         (label 'first-score-page)
         (table (ly:output-def-lookup layout 'label-page-table))
         (label-page (and (list? table) (assoc label table)))
         ;(page-number (and label-page (cdr label-page)))
        )
    (if (and (> page-number 1))
      (interpret-markup layout props arg)
      empty-stencil)))


#(define copyright-footer-table '())
thisPageCopyrightFooter = #(define-music-function (parser location) ()
  (let* ((label (gensym "copyrightfooter")))
    (set! copyright-footer-table (cons label copyright-footer-table))
    (make-music 'Music 
      'page-marker #t
      'page-label label)))

#(define copyright-pg 1)
#(define (set-copyright-page page)
  (set! copyright-pg page)
)

% TODO: Use the copyright-footer-table!
#(define (copyright-page layout props arg)
    (if (= (chain-assoc-get 'page:page-number props -1) copyright-pg)
      (interpret-markup layout props arg)
      empty-stencil))


\paper {
  oddHeaderMarkup = \markup \fill-line {
    %% force the header to take some space, otherwise the
    %% page layout becomes a complete mess.
    " "
    \on-the-fly #is-header-page \fromproperty #'header:title
    \on-the-fly #is-header-page \fromproperty #'page:page-number-string
  }
  evenHeaderMarkup = \markup \fill-line {
    \on-the-fly #is-header-page \fromproperty #'page:page-number-string
    \on-the-fly #is-header-page \fromproperty #'header:composer
    " "
  }

  oddFooterMarkup = \markup {
    \column {
      \fill-line {
        %% publisher header field only on title page.
        \on-the-fly #first-page \fromproperty #'header:publisher
      }
      \fill-line {
        %% copyright on the first real score page
        \on-the-fly #copyright-page \fromproperty #'header:copyright
        \on-the-fly #copyright-page \null
      }
      \fill-line {
        %% All other pages get the number of the edition centered
        \on-the-fly #is-footer-page \fromproperty #'header:scorenumber
      }
    }
  }

}











% Interpret the given markup with the header fields added to the props. 
% This way, one can re-use the same functions (using fromproperty 
% #'header:field) in the header block and as top-level markup.
%
% This function is originally copied from mark-up-title (file scm/titling.scm), 
% which is lilypond's internal function to handle the title markups. I needed 
% to replace the scopes and manually add the $defaultheader (which is internally 
% done in paper-book.cc before calling mark-up-title. Also, I don't extract the 
% markup from the header block, but use the given markup.
%
% I'm not sure if I really need the page properties in props, too... But I 
% suppose it does not hurt, either.
#(define-markup-command (markupWithHeader layout props markup) (markup?)
  "Interpret the given markup with the header fields added to the props. 
   This way, one can re-use the same functions (using fromproperty 
   #'header:field) in the header block and as top-level markup."
  (let* (
      ; TODO: If we are inside a score, add the score's local header block, too!
      ; Currently, I only use the global header block, stored in $defaultheader
      (scopes (list $defaultheader))
      (alists (map ly:module->alist scopes))
  
      (prefixed-alist
        (map (lambda (alist)
          (map (lambda (entry)
            (cons
              (string->symbol (string-append "header:" (symbol->string (car entry))))
              (cdr entry)))
            alist))
          alists))
      (props (append prefixed-alist
              props
              (layout-extract-page-properties layout)))
    )
    (interpret-markup layout props markup)
  )
)






%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   Equally spacing multiple columns (e.g. for translations)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Credits: Nicolas Sceaux on the lilypond-user mailinglist
#(define-markup-command (columns layout props args) (markup-list?)
   (let ((line-width (/ (chain-assoc-get 'line-width props
                         (ly:output-def-lookup layout 'line-width))
                        (max (length args) 1))))
     (interpret-markup layout props
       (make-line-markup (map (lambda (line)
                                (markup #:pad-to-box `(0 . ,line-width) '(0 . 0)
                                  #:override `(line-width . ,line-width)
                                  line))
                               args)))))



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   SCORE (HEADER / LAYOUT) SETTINGS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


startSlashedGraceMusic =  {
  \override Stem  #'stroke-style = #"grace"
}

stopSlashedGraceMusic =  {
  \revert Stem #'stroke-style
}

slashedGrace =
#(def-grace-function startSlashedGraceMusic stopSlashedGraceMusic
   (_i "Create slashed graces (slashes through stems, but no slur)from the following music expression"))


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%   SCORE (HEADER / LAYOUT) SETTINGS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\paper {
  left-margin = 2\cm
  right-margin = 1.5\cm
  line-width = 17.5\cm
%   bottom-margin = 1.5\cm
%   top-margin = 1.5\cm
%   after-title-space = 0.5\cm
  ragged-right = ##f
  ragged-last = ##f
  ragged-bottom = ##f
  ragged-last-bottom = ##f
}
\layout {
  \context {
    \ChoirStaff 
    % If only one non-empty staff in a system exists, still print the backet
    \override SystemStartBracket #'collapse-height = #1
    \consists "Instrument_name_engraver"
  }
  \context {
    \StaffGroup
    % If only one non-empty staff in a system exists, still print the backet
    \override SystemStartBracket #'collapse-height = #1
    \consists "Instrument_name_engraver"
  }
  \context {
    \GrandStaff
    \override SystemStartBracket #'collapse-height = #1
    \consists "Instrument_name_engraver"
  }
  \context {
    \PianoStaff
%     \override VerticalAxisGroup #'keep-fixed-while-stretching = ##t
  }
  \context {
    \FiguredBass
%     \override VerticalAxisGroup #'keep-fixed-while-stretching = ##t
    \override VerticalAxisGroup #'minimum-Y-extent  = #'(0 . 1)
    \override VerticalAxisGroup #'padding = #0
  }
  \context {
    \Score
    % Force multi-measure rests to be written as one span
    \override MultiMeasureRest #'expand-limit = #3
    skipBars = ##t
    autoBeaming = ##f
%     hairpinToBarline = ##f
    \override BarNumber #'break-visibility = #end-of-line-invisible
    \override BarNumber #'self-alignment-X = #0
    \override CombineTextScript #'avoid-slur = #'outside
    barNumberVisibility = #(every-nth-bar-number-visible 5)
    \override DynamicTextSpanner #'dash-period = #-1.0
    \override InstrumentSwitch #'font-size = #-1

    % Rest collision
    \override RestCollision #'positioning-done = #merge-rests-on-positioning
    % Auto-Accidentals: Use modern-cautionary style...
    extraNatural = ##f
    autoAccidentals = #`(Staff  ,(make-accidental-rule 'same-octave 0)
                                ,(make-accidental-rule 'any-octave 0)
                                ,(make-accidental-rule 'same-octave 1))
%     autoCautionaries = #`(Staff ,(make-accidental-rule 'any-octave 0)
%                                 ,(make-accidental-rule 'same-octave 1))
    printKeyCancellation = ##t
  }
  \context {
    \RemoveEmptyStaffContext 
  }
  \context {
    \Lyrics
    \override VerticalAxisGroup #'minimum-Y-extent = #'(0.5 . 0.5)
  }
  \context {
    \Staff
    \override VerticalAxisGroup #'minimum-Y-extent = #'(-1. . 3)
    quotedEventTypes = #'(StreamEvent)
    ignoreFiguredBassRest = ##f
    implicitBassFigures = #'(0 100)
  }
}



\layout {
  \context {
    \type "Engraver_group"
    \name Dynamics
    % So that \cresc works, for example.
    \alias Voice
    \consists "Output_property_engraver"
    
    \override VerticalAxisGroup #'minimum-Y-extent = #'(-1 . 1)
    pedalSustainStrings = #'("Ped." "*Ped." "*")
    pedalUnaCordaStrings = #'("una corda" "" "tre corde")
    
    \consists "Piano_pedal_engraver"
    \consists "Script_engraver"
    \consists "Dynamic_engraver"
    \consists "Text_engraver"
    
    \override TextScript #'font-size = #2
    \override TextScript #'font-shape = #'italic
    \override DynamicText #'extra-offset = #'(0 . 2.5)
    \override Hairpin #'extra-offset = #'(0 . 2.5)
    
    \consists "Skip_event_swallow_translator"
    
    \consists "Axis_group_engraver"
  }
  \context {
    \PianoStaff
    \accepts Dynamics
%     \override VerticalAlignment #'forced-distance = #7
  }
}


bracketts = ^\markup{"[Solo]"}
brackettt = ^\markup{"[Tutti]"}
ts = ^\markup{"t.s."}
tt = ^\markup{"Tutti"}
solo = ^\markup{"Solo"}
tutti = ^\markup{"Tutti"}

dashedSlur = -\tweak #'dash-definition #'((0 1 0.4 0.75))(
dashedTie = -\tweak #'dash-definition #'((0 1 0.4 0.75))~

divisi = #(define-music-function (parser location vc1 vc2) (ly:music? ly:music?)
#{
  << { \voiceOne $vc1 \oneVoice} \new Voice = "divisi2" { \voiceTwo $vc2 } >>
#}
)

#(define-public (bracket-stencils grob)
  (let ((lp (grob-interpret-markup grob (markup #:fontsize 3.5 #:translate (cons -0.3 -0.5) "[")))
        (rp (grob-interpret-markup grob (markup #:fontsize 3.5 #:translate (cons -0.3 -0.5) "]"))))
    (list lp rp)))

bracketify = #(define-music-function (parser loc arg) (ly:music?)
   (_i "Tag @var{arg} to be parenthesized.")
#{
  \once \override ParenthesesItem #'stencils = #bracket-stencils
  \parenthesize $arg
#})



#(define-markup-command (hat layout props arg) (markup?)
  "Draw a hat above the given string @var{arg}."
  (interpret-markup layout props (markup #:combine #:raise 1.5 "^" arg)))