%{
stradella-toolbox 1.2
%}
\version "2.18.0"

%§ Workaround - tweaks are transfered to the grobs only _after_ my engravers were running since 2.18.0

%{
#(define (wa:GtwE-propertyID id grob symbol)
  (let ((propty (ly:grob-property grob symbol)))
   (if (null? propty) (begin
     (for-each display (list "\n " id " " symbol " (ly:stream-event? (event-cause grob)) = " (ly:stream-event? (event-cause grob)) "\n"))
     (let ((ev (event-cause grob)))
      (if (ly:stream-event? ev)
       (let ((x
          (ly:assoc-get symbol (ly:event-property ev 'tweaks) #f)
        ))
        (if (not (null? x))
         (for-each display (list "\n " id " grob symbol '" (symbol->string symbol)
          "' only found in cause as " x " "))
        )
        x
       )
       propty
      )
     )
    )
    propty)))
%}

#(define (wa:GtwE-property grob symbol)
  (let ((propty (ly:grob-property grob symbol)))
   (if (null? propty)
    (let ((ev (event-cause grob)))
     (if (ly:stream-event? ev)
      (ly:assoc-get symbol (ly:event-property ev 'tweaks) '())
      '()))
    propty)))

%{
#(define (wa:GtwEb-property grob symbol def)
  (let ((propty (ly:grob-property grob symbol def)))
   (if (null? propty)
    (let ((x
     (ly:assoc-get symbol (ly:event-property (event-cause grob) 'tweaks) def)
     ))
     (if x
      (for-each display (list "\n grob symbol '" (symbol->string symbol)
       "' only defined in cause as ##t "))
     )
     x
    )
    propty)))
%}

%§ Message Translation

#(define locale-lang-translate (list
  '("english" . "en")
  '("german"  . "de")
  '("french"  . "fr")
  '("italian" . "it")))

#(define locale-country-translate (list
  '("germany" . "de")
  '("austria" . "at")
  '("france"  . "fr")
  '("italy"   . "it")))

% Select the string from an alist, where the key is your LANG defintion.
% If no entry is found, take the first element (which should be 'en = english).
#(define (locale-string-select langlist)
  (let ((lang-def (getenv "LANG")))
   (if (eq? lang-def #f) (set! lang-def (setlocale LC_COLLATE "")))
   (if (string? lang-def)
    (let*
     ((pos1 (string-index lang-def #\.))
      (short-lang-def (string-downcase (if (eq? pos1 #f) lang-def (substring lang-def 0 pos1))))
      (pos2 (string-index short-lang-def #\_))
      (part-one (if (eq? pos2 #f) short-lang-def (substring short-lang-def 0 pos2)))
      (part-two (if (eq? pos2 #f) "" (substring short-lang-def (+ 1 pos2))))
      (rep-one (assoc-ref locale-lang-translate part-one))
      (rep-two (assoc-ref locale-country-translate part-two))
      (key-one (if (string? rep-one ) rep-one part-one))
      (key-part-two (if (string? rep-two ) rep-two part-two))
      (key-two (string-append key-one "_" key-part-two))
      (trans-two (assoc-ref langlist (string->symbol key-two))))
     (if (string? trans-two)
      trans-two
      (let ((trans-one (assoc-ref langlist (string->symbol key-one))))
       (if (string? trans-one) trans-one (cdar langlist)))))
    (cdar langlist))))

%§ Properties extension
% Not nessessarily the best solution, but I put my options and flags into the tweaks,
% thus I'll have them automatically available in the notehead grobs.
% Perhaps it would be better to put all these options into one alist called 'stradella'

#(if (not (defined? 'all-user-grob-custom-properties)) ;;;all-user-grob-custom-properties
  (define-public all-user-grob-custom-properties '()))

#(define (add-user-grob-custom-property symbol type? description)
  (if (not (equal? (object-property symbol 'backend-doc) #f))
   (ly:error (_ "symbol ~S redefined") symbol))
  (set-object-property! symbol 'backend-type? type?)
  (set-object-property! symbol 'backend-doc description)
  (set! all-user-grob-custom-properties (cons symbol all-user-grob-custom-properties))
  (set! all-backend-properties (append all-backend-properties (cons symbol '()))))

#(add-user-grob-custom-property
  'stradella-note-event           ly:music? "A backward link to the causing notehead")
#(add-user-grob-custom-property
  'stradella-shows-pitch          boolean?  "Does this stradella text markup contain the pitch")
#(add-user-grob-custom-property
  'stradella-fixed-string         boolean?  "Does this stradella text markup contain a (user defined) fixed string")
#(add-user-grob-custom-property
  'stradella-staff-id             symbol?   "Staff context sequence number in grobs")
#(add-user-grob-custom-property
  'stradella-id                   string?   "content indicator for cleanup")
#(add-user-grob-custom-property
  'stradella-class                symbol?   "'bass or 'chord - type classification for cleanup")
#(add-user-grob-custom-property
  'stradella-type                 symbol?   "Which stradella function does a notehead represent: 'bass, 'alt-bass, 'major, 'minor, 'seveth, 'diminished, or even 'additional or 'additional-sound")
#(add-user-grob-custom-property
  'stradella-show                 scheme?   "boolean to hide or prevent from cleanup, or string to show (and prevent from cleanup)")
#(add-user-grob-custom-property
  'stradella-shift                rational? "shift up or down the bending range octave where to show the noteheads, count in octaves")
#(add-user-grob-custom-property
  'stradella-padding              number?   "an extra padding for the stradella text markups")
#(add-user-grob-custom-property
  'stradella-parenthesize-altbass boolean?  "put the 'alternate bass indicator' (underscore) into braces")
#(add-user-grob-custom-property
  'stradella-new-section          boolean?  "Mark this note event to be an additional start trigger for the cleanup")
#(add-user-grob-custom-property
  'stradella-cleanup-coloration   boolean?  "Used in StaffSymbol to indicate the stradella text scripts selected to be removed with a color")

%§ some utilities

copyMusic =
#(define-music-function (parser location m) (ly:music?)
  (ly:music-deep-copy m))

copyEvent =
#(define-music-function (parser location m) (ly:music?)
  (ly:event-deep-copy m))

% \tag for a tweak? 
tweakOpt =
#(define-music-function (parser location name tag value music)
  (symbol? symbol? scheme? ly:music?)
  (let ((new-sym (symbol-append name '-- tag)))
   (set! (ly:music-property music 'tweaks)
    (acons new-sym value (ly:music-property music 'tweaks)))
   music))

#(define (activate-tweaks tag name-list m)
  (for-each
   (lambda (x)
    (let*
     ((full-name-symb (symbol-append x '-- tag))
      (tw (ly:music-property m 'tweaks))
      (val (ly:assoc-get full-name-symb tw '())))
     (if (not (null? val))
      (set! (ly:music-property m 'tweaks)
       (acons x val (ly:music-property m 'tweaks)))))
   ) name-list)
  m)

%§ something like tags for tweaks
activateTweaks =
#(define-music-function (parser location tag name-list music)
  (symbol? list? ly:music?)
  (music-map (lambda (x) (activate-tweaks tag name-list x))
   (ly:music-deep-copy music)))


%§ short forms of option tweaks for the stradella bass
% they will be defined if you call the following function

enableStradellaTweakShortnames =
#(define-void-function (parser location) ()
  (begin
   ; Stradella bass: forced hide
   (ly:parser-define! parser (string->symbol "SH")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-show #f
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: forced show
   (ly:parser-define! parser (string->symbol "SS")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-show #t
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: forced dash to show
   (ly:parser-define! parser (string->symbol "SD")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-show "-"
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: set alt-bass to be optional (parenthesisze the underline)
   (ly:parser-define! parser (string->symbol "SP")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-parenthesize-altbass #t
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: add extra offset into the placement (fractional number, 1 = 7/7 = 12/12 = octave)
   (ly:parser-define! parser (string->symbol "SShift")
    (define-music-function (parser location offset music) (rational? ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-shift offset
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: padding for text object
   (ly:parser-define! parser (string->symbol "SPad")
    (define-music-function (parser location padding music) (number? ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-padding padding
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: new section marker for pre-display cleanup
   (ly:parser-define! parser (string->symbol "SN")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-new-section #t
       (ly:music-property music 'tweaks)))
     music))
 ))

%§ Helper functions ...

#(define (restore-octave-in-transposed-pitch pitch-dist-back p)
  (let
   ((o (ly:pitch-octave (ly:pitch-transpose p pitch-dist-back)))
    (n (ly:pitch-notename p))
    (a (ly:pitch-alteration p)))
   (ly:make-pitch o n a)))

#(define (restore-octave-in-transpose pitch-dist-back music)
  (let
   ((es (ly:music-property music 'elements))
    (ar (ly:music-property music 'articulations))
    (e (ly:music-property music 'element))
    (p (ly:music-property music 'pitch)))
   (if (pair? ar)
    (ly:music-set-property!
     music 'articulations
     (map (lambda (x) (restore-octave-in-transpose pitch-dist-back x)) ar)))
   (if (pair? es)
    (ly:music-set-property!
     music 'elements
     (map (lambda (x) (restore-octave-in-transpose pitch-dist-back x)) es)))
   (if (ly:music? e)
    (ly:music-set-property!
     music 'element
     (restore-octave-in-transpose pitch-dist-back e)))
   (if (ly:pitch? p)
    (begin
     (set! p (restore-octave-in-transposed-pitch pitch-dist-back p))
     (ly:music-set-property! music 'pitch p)))
   music))

#(define (keep-octave-transpose from-pitch to-pitch music)
  (let ((pitch-dist-back (ly:pitch-diff from-pitch to-pitch)))
   (restore-octave-in-transpose pitch-dist-back
    (ly:music-transpose music (ly:pitch-diff to-pitch from-pitch)))))

%§ transpose, but keep them in the same octave 
keepOctaveTranspose =
#(define-music-function (parser location from-pitch to-pitch m) (ly:pitch? ly:pitch? ly:music?)
  (keep-octave-transpose from-pitch to-pitch m))




#(define (stradella-x-type-info-notehead-markup notehead-grob grey-tone text-string)
  (let*
   ((sz (ly:grob-property notehead-grob 'font-size 0.0))
    (dl (ly:grob-property notehead-grob 'duration-log 2))
    (mult (magstep sz)))
   (markup #:line (#:with-dimensions
     (cons (* -0.9 mult) (* 0.9 mult))
     (cons (* -0.5 mult) (* 0.5 mult))
     (#:postscript (string-concatenate (list
        " " (number->string mult) " dup scale \n"
        " newpath 0.2 setlinewidth 1 setlinejoin 1 setlinecap \n"
        " -0.8 -0.15 moveto \n"
        " -0.4 -0.4 lineto 0.4 -0.4 lineto 0.8 0.15 lineto \n"
        " 0.4 0.4 lineto -0.4 0.4 lineto -0.8 -0.15 lineto \n"
        (if grey-tone " 0.5 setgray" " ")
        " gsave" (if (>= dl 2) " " " 1.0 setgray ") "fill grestore stroke \n"
        " 0 -0.25 moveto \n"
        (if (>= dl 2)
          " /Helvetica-Bold findfont 0.7 scalefont setfont 1.0 setgray \n"
          " /Helvetica findfont 0.7 scalefont setfont 0.0 setgray \n")
        " (" text-string ") \n"
        " dup stringwidth pop -0.5 mul 0 rmoveto \n"
        " show \n")))))))

#(define (stradella-altbass-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "A"))
#(define (stradella-bass-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "B"))
#(define (stradella-minor-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "m"))
#(define (stradella-major-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "M"))
#(define (stradella-seventh-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "7"))
#(define (stradella-diminished-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "d"))
#(define (stradella-additional-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #t "+"))
#(define (stradella-additionalsound-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #t "s"))

%§ use with \musicMap to visualize the stradella information
#(define-public (stradella-type-to-notehead e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'NoteEvent)
    (let ((t (ly:music-property e 'tweaks)))
     (if (not (null? t))
      (let ((st (assq 'stradella-type t)))
       (if (pair? st)
        (let ((sn (symbol->string (cdr st))))
         (if (equal? sn "alt-bass")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-altbass-type-info-notehead-markup t))))
         (if (equal? sn "bass")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-bass-type-info-notehead-markup t))))
         (if (equal? sn "major")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-major-type-info-notehead-markup t))))
         (if (equal? sn "minor")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-minor-type-info-notehead-markup t))))
         (if (equal? sn "seventh")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-seventh-type-info-notehead-markup t))))
         (if (equal? sn "diminished")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-diminished-type-info-notehead-markup t))))
         (if (equal? sn "additional")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-additional-type-info-notehead-markup t))))
         (if (equal? sn "additional-sound")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-additionalsound-type-info-notehead-markup t))))))))))
   e))

#(define-public (add-stradella-info e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'NoteEvent)
    (let*
     ((p (ly:music-property e 'pitch))
      (o (ly:pitch-octave p))
      (n (ly:pitch-notename p))
      (a (ly:pitch-alteration p))
      (t (ly:music-property e 'tweaks))
      (allready-defined (if (null? t) #f
        (if (pair? (assq 'stradella-type t)) #t #f))))
     (if (not allready-defined)
      (case o
       ((-3) ;(display " alt-bass...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'alt-bass t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -2 n a)))
       ((-2) ;(display " bass...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'bass t)))
       ((-1) ;(display " major-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'major t)))
       ((0) ;(display " minor-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'minor t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -1 n a)))
       ((1) ;(display " seventh-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'seventh t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -1 n a)))
       ((2) ;(display " diminished-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'diminished t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -1 n a)))
       (else (ly:warning (locale-string-select '(
           (en . "~a is NOT in a supported stradella proxy octave")
           (de . "~a beschreibt keine der unterstützten Stradella-Stellvertreter-Oktaven"))) p))))))
      ; if 'stradella-type' is allready defined, no octave alteration in the pitch will be done here
   e))

%§ convert the weak octave information into the more stable stradella attributes
stradellaMode =
#(define-music-function (parser location m) (ly:music?)
  (music-map add-stradella-info m))


#(define (stradella-text-recuction e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'NoteEvent)
    (let*
     ((a (ly:music-property e 'articulations '()))
      (d (ly:music-property e 'duration))
      (l (ly:duration-log d)))
     (if (> l 2)
      (ly:music-set-property! e 'articulations
       (cons (make-music 'BeamForbidEvent) '()))
      (if (not (null? a))
       (ly:music-set-property! e 'articulations '()))))
    (if (eq? eventtype 'EventChord)
     (let*
      ((es (ly:music-property e 'elements))
       (new-es (filter (lambda (x)
          (let ((en (ly:music-property x 'name)))
           (or (eq? en 'NoteEvent) (eq? en 'EventChord)))) es))
       (dllist (cons 0 (map (lambda (x)
           (let ((dur (ly:music-property x 'duration '())))
            (if (ly:duration? dur)
             (ly:duration-log dur) 0))) new-es)))
       (dlmax (apply max dllist)))
      (if (> dlmax 2)
       (set! new-es (append new-es
         (cons (make-music 'BeamForbidEvent) '()))))
      (ly:music-set-property! e 'elements new-es))))
  e))
stradellaReduceForTextOnly =
#(define-music-function (parser location m) (ly:music?)
  (music-map stradella-text-recuction m))


%§ post processing marks for the extended parallelMusic
pmpStartRepeat = #(define-music-function (parser location) () (make-music 'MarkEvent
 'label "<parallel-music-results-postprocess:start repeat volta 2>"))
pmpStartRepeatEx = #(define-music-function (parser location count) (integer?) (make-music 'MarkEvent
 'label (string-append "<parallel-music-results-postprocess:start repeat volta " (number->string count) ">")))
pmpEndRepeat = #(define-music-function (parser location) () (make-music 'MarkEvent
 'label "<parallel-music-results-postprocess:end repeat>"))
pmpStartAlternative = #(define-music-function (parser location) () (make-music 'MarkEvent
 'label "<parallel-music-results-postprocess:start alternative>"))

#(define (pmpMark mus)
  (if (ly:music? mus)
   (let
    ((eventtype (ly:music-property mus 'name))
     (labeltext (ly:music-property mus 'label))
    )
    (if (and (eq? eventtype 'MarkEvent) (string? labeltext))
     (let*
      ((head "<parallel-music-results-postprocess:")
       (headlen (string-length head))
       (labellen (string-length labeltext)))
      (if (<= labellen headlen) 0
       (let*
        ((labelhead (string-copy labeltext 0 headlen))
         (labelpost (string-copy labeltext headlen))
         (postlen (string-length labelpost))
         (labelshortpost (string-copy labelpost 0 (min postlen 19)))
        )
        (if (string=? labelhead head)
         (if (string=? labelshortpost "start repeat volta ") 1
          (if (string=? labelpost "end repeat>") 2
           (if (string=? labelpost "start alternative>") 3
            0)))
         0))))
     0))
   0))

#(define (pmpMarkRepeatCount mus)
  (if (ly:music? mus)
   (let
    ((eventtype (ly:music-property mus 'name))
     (labeltext (ly:music-property mus 'label)))
    (if (and (eq? eventtype 'MarkEvent) (string? labeltext))
     (let*
      ((head "<parallel-music-results-postprocess:")
       (headlen (+ (string-length head) 19))
       (labellen (string-length labeltext)))
      (if (<= labellen headlen) 2
       (let*
        ((labelhead (string-copy labeltext 0 headlen))
         (labelpost (string-copy labeltext headlen (- labellen 1)))
         (labelterm (string-copy labeltext (- labellen 1))))
        (if (string=? labelterm ">") (string->number labelpost)
         2))))
     2))
   2))

#(define (parallel-music-results-postprocess mus)
  (let ((eventtype (ly:music-property mus 'name)))
   (if (eq? eventtype 'SequentialMusic)
    (let
     ((es (ly:music-property mus 'elements))
      (new-es '())
      (active-dest 0)
      (rep-collect '())
      (alt-collect '())
      (alt-list-collect '())
      (rep-count 2)
     )
     (for-each (lambda (ese)
       (let ((etype (pmpMark ese)))
        (if (eq? etype 2) ;; end repeat ;;
         (begin
          (if (eq? active-dest 3)
           (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '()))))
          (set! new-es (append new-es (cons
           (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
            'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '())))
          (set! active-dest 0)
          (set! rep-collect '())
          (set! alt-collect '())
          (set! alt-list-collect '())))
        (if (eq? etype 1) ;; start repeat ;;
         (begin
          (if (eq? active-dest 3)
           (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '()))))
          (if (>= active-dest 1) ;; terminate existing repeat and start new repeat block
           (set! new-es (append new-es (cons
            (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
             'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '()))))
          (set! active-dest 1)
          (set! rep-collect '())
          (set! alt-collect '())
          (set! alt-list-collect '())))
        (if (and (eq? etype 3) (>= active-dest 1)) ;; start alternative (only when repeat allready started) ;;
         (if (eq? active-dest 3) ;; next alternative ;;
          (begin
           (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '())))
           (set! alt-collect '()))
          (set! active-dest 3)))
        (if (eq? etype 0)
         (begin
          (if (eq? active-dest 0)
           (set! new-es (append new-es (cons ese '()))))
          (if (eq? active-dest 1)
           (set! rep-collect (append rep-collect (cons ese '()))))
          (if (eq? active-dest 3)
           (set! alt-collect (append alt-collect (cons ese '())))))))) 
      es)
     (if (eq? active-dest 1) ;; start repeat is open ;;
      (set! new-es (append new-es (cons
       (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
        'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '()))))
     (if (eq? active-dest 3) ;; start alternative is open ;;
      (begin
       (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '())))
       (set! new-es (append new-es (cons
        (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
         'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '())))))
     (ly:music-set-property! mus 'elements new-es)
     mus)
    mus)))

#(define (sequential-music-without-tags m)
  (let ((eventtype (ly:music-property m 'name)))
   (if (eq? eventtype 'SequentialMusic)
    (let ((taglist (ly:music-property m 'tags)))
     (if (null? taglist) #t
      (if (<= (length taglist) 0) #t #f)))
    #f)))

#(define (unnest-sequential-music mus)
  (let ((eventtype (ly:music-property mus 'name)))
   (if (eq? eventtype 'SequentialMusic)
    (let
     ((es (ly:music-property mus 'elements))
      (immigrate-count 0))
     (for-each (lambda (ese) (if (sequential-music-without-tags ese)
        (set! immigrate-count (+ 1 immigrate-count))))
      es)
     (if (> immigrate-count 0)
      (let ((new-es '()))
       (for-each (lambda (ese)
         (if (sequential-music-without-tags ese)
          (let ((inner-es (ly:music-property ese 'elements)))
           (for-each (lambda (esi)
             (set! new-es (append new-es (cons esi '()))))
            inner-es))
          (set! new-es (append new-es (cons ese '())))))
        es)
       (ly:music-set-property! mus 'elements new-es)))
     (if (and (defined? 'pmp-get-rid-of-last-barcheck)
              (boolean? pmp-get-rid-of-last-barcheck)
              pmp-get-rid-of-last-barcheck)
      (let* ((final-es (ly:music-property mus 'elements))
             (es-len (length final-es))
             (last-e (if (> es-len 1) (list-ref final-es (- es-len 1)) '()))
             (last-type (if (ly:music? last-e) (ly:music-property last-e 'name) 'something-else)))
       (if (eq? last-type 'BarCheck)
        (ly:music-set-property! mus 'elements
         (list-head final-es (- es-len 1))))))))
   mus))

%#(define (display-music-tree indent mus)
%  (if (ly:music? mus)
%   (let
%    ((eventtype (ly:music-property mus 'name))
%     (es (ly:music-property mus 'elements)))
%    (display "\n")
%    (do ((i 1 (1+ i))) ((> i indent)) (display "   "))
%    (display eventtype)
%    (if (or (sequential-music-without-tags mus) (not (eq? eventtype 'SequentialMusic)))
%     (display " ") 
%     (display " (tagged) "))
%    (if (eq? eventtype 'MarkEvent)
%     (let ((mark-text (ly:music-property mus 'label)))
%      (display " \"") (display mark-text) (display "\" ")))
%    (if (not (null? es))
%     (for-each (lambda (ese) (display-music-tree (+ indent 1) ese)) es)))))
%
%§ reduced \displayMusic, just show the structure without content
%displayMusicTree =
%#(define-void-function (parser location m) (ly:music?)
%  (display-music-tree 0 m))


%§ \paralleMusic with \stradellaMode applied to the last voice
% and another postprocessor applied to all voices
parallelMusicWithStradella =
#(define-void-function (parser location voice-ids music) (list? ly:music?)
  (let ((parmus (ly:parser-lookup parser 'parallelMusic)))
   (if (null? parmus)
    (ly:warning (locale-string-select '(
       (en . "\\parallelMusic not found in parser!")
       (de . "\\parallelMusic konnte im Parser nicht gefunden werden!"))))
    (if (not (ly:music-function? parmus))
     (ly:warning  (locale-string-select '(
        (en . "\\parallelMusic is not a music function!")
        (de . "\\parallelMusic ist keine Musikfunktion!"))))
     (let ((parex (ly:music-function-extract parmus)))
      (parex parser location voice-ids music)     
      ;; also works: (apply parex parser location voice-ids music '())
      (let ((counter 0))
       (for-each (lambda (voice-id)
         (let ((pme (ly:parser-lookup parser voice-id)))
          (if (null? pme)
           (ly:warning (locale-string-select '(
              (en . "parallel music sequence not created: ~a")
              (de . "Parallel-Musik-Sequenz wurde nicht erzeugt: ~a"))) voice-id)
           (if (eq? counter 0)
            (ly:parser-define! parser voice-id
             (parallel-music-results-postprocess
              (music-map add-stradella-info
               (unnest-sequential-music pme))))
            (ly:parser-define! parser voice-id
             (parallel-music-results-postprocess
              (unnest-sequential-music pme)))
         )))
         (set! counter (+ 1 counter)))
        (reverse voice-ids))))))))


%§ just a wrapper, a new name for an existing function
stradellaChordify =
#(define-music-function (parser location m) (ly:music?)
  (event-chord-wrap! m parser))

#(define (stradella-chordpitch-bend p c pit)
  (let ((e-correction 0))
   (if c
    ; chromatic pitch
    (let*
     ((e-cp (ly:pitch-semitones pit))
      (r-cp (ly:pitch-semitones p))
      (d-cp (- e-cp r-cp)))
     (if (or (>= d-cp 12) (< d-cp 0))
      (set! e-correction (- (floor (/ d-cp 12))))))
    ; diatonic pitch
    (let*
     ((e-dp (ly:pitch-steps pit))
      (r-dp (ly:pitch-steps p))
      (d-dp (- e-dp r-dp)))
     (if (or (>= d-dp 7) (< d-dp 0))
      (set! e-correction (- (floor (/ d-dp 7)))))))
   (if (not (eq? e-correction 0))
    (let
     ((o (ly:pitch-octave pit))
      (a (ly:pitch-alteration pit))
      (n (ly:pitch-notename pit)))
     (ly:make-pitch (+ o e-correction) n a))
    pit)))

#(define (stradella-append-chord-note es transpose-pitch p c e snd)
  (let*
   ((transposed (stradella-chordpitch-bend p c (ly:pitch-transpose (ly:music-property e 'pitch) transpose-pitch)))
    (transposed-chromatic (ly:pitch-semitones transposed))
    (allready-in #f))
   (for-each (lambda (x)
     (if (ly:music? x) (if (eq? (ly:music-property x 'name) 'NoteEvent)
       (if (eq? (ly:pitch-semitones (ly:music-property x 'pitch)) transposed-chromatic)
        (set! allready-in #t))))
    ) es)
   (if (not allready-in)
    (let
     ((durat (ly:music-property e 'duration))
      (orign (ly:music-property e 'origin))
      (twkes (acons 'stradella-type (if snd 'additional-sound 'additional)
        (assoc-remove! (alist-copy (ly:music-property e 'tweaks)) 'stradella-type))))
     ; (display "Ton ") (display transposed) (display " mit ") (display twkes) (display " wird eingefuegt.")
     (append! es (list (make-music 'NoteEvent
        'pitch transposed  'duration durat  'tweaks twkes  'origin orign)))))))

#(define-public (stradella-type-number tweaks show-additional)
  (if (null? tweaks) 0
   (let ((stype (assq 'stradella-type tweaks)))
    (if (pair? stype)
     (let ((sn (symbol->string (cdr stype))))
      (if (equal? sn "alt-bass") -2
       (if (equal? sn "bass") -1
        (if (equal? sn "major") 1
         (if (equal? sn "minor") 2
          (if (equal? sn "seventh") 3
           (if (equal? sn "diminished") 4
            (if (and (equal? sn "additional") show-additional) 99
             0)
     )))))))
     0))))

#(define-public (stradella-spread p c bass-shift add-chord add-opts m)
  (let ((eventtype (ly:music-property m 'name)))
   (if (eq? eventtype 'EventChord)
    (let ((es (ly:music-property m 'elements)))
     (do
      ((pass 1 (1+ pass)))
      ((> pass (if add-chord 2 1)))
      (for-each (lambda (e)
        (if (ly:music? e)
         (let*
          ((e-name (ly:music-property e 'name))
           (e-tweaks (ly:music-property e 'tweaks))
           (e-st (stradella-type-number e-tweaks #t)))
          (if (eq? e-name 'NoteEvent)
           (if (eq? pass 1) ; execute pitch-bend
            (if (not (eq? e-st 0))
             (let*
              ((e-pitch (ly:music-property e 'pitch))
               (e-tweaks (ly:music-property e 'tweaks))
               (e-shift-tag (ly:assoc-get 'stradella-shift e-tweaks '()))
               (e-shift-off (ly:assoc-get 'disable-shift add-opts #f))
               (e-shift (if (or e-shift-off (null? e-shift-tag)) 0 e-shift-tag))
               (e-bass-shift (if e-shift-off 0
                              (if (null? e-shift-tag) bass-shift e-shift-tag)))
               (e-correction 0))
              (if c
               ; chromatic pitch
               (let*
                ((e-cp (ly:pitch-semitones e-pitch))
                 (r-shift (floor (+ 1/2 (* 12 (if (> e-st 0) e-shift e-bass-shift)))))
                 (r-cp (+ (ly:pitch-semitones p) r-shift))
                 (d-cp (- e-cp r-cp)))
                (if (> e-st 0) ; chord pitch
                 (if (or (>= d-cp 12) (< d-cp 0))
                  (set! e-correction (- (floor (/ d-cp 12))))))
                (if (< e-st 0) ; bass pitch
                 (if (or (>= d-cp 0) (< d-cp -12))
                  (set! e-correction (- (floor (/ (+ d-cp 12) 12)))))))
               ; diatonic pitch
               (let*
                ((e-dp (ly:pitch-steps e-pitch))
                 (r-shift (floor (+ 1/2 (* 7 (if (> e-st 0) e-shift e-bass-shift)))))
                 (r-dp (+ (ly:pitch-steps p) r-shift))
                 (d-dp (- e-dp r-dp)))
                (if (> e-st 0) ; chord pitch
                 (if (or (>= d-dp 7) (< d-dp 0))
                  (set! e-correction (- (floor (/ d-dp 7))))))
                (if (< e-st 0) ; bass pitch
                 (if (or (>= d-dp 0) (< d-dp -7))
                  (set! e-correction (- (floor (/ (+ d-dp 7) 7))))))))
              (if (not (eq? e-correction 0))
               (let
                ((o (ly:pitch-octave e-pitch))
                 (a (ly:pitch-alteration e-pitch))
                 (n (ly:pitch-notename e-pitch)))
                (ly:music-set-property! e 'pitch (ly:make-pitch (+ o e-correction) n a))
            )))) ; end of (if 'pass 1' action
            (if (eq? pass 2) ; execute chord-build
             (if (> e-st 0)
              (let*
               ((chord-dup-count (ly:assoc-get 'duplicate-chords add-opts #f))
                (dup-chords (if (integer? chord-dup-count) #t #f)))
               ;(display "\nPass 2, add-chord, e-st > 0\n")
               (case e-st
                ((1) ;(display "\n1. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2 0) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 4 0) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 4 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t))))
                ((2) ;(display "\n2. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2 -1/2) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 4    0) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 4    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t))))
                ((3) ;(display "\n3. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2    0) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 6 -1/2) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 6 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                 (if (or (ly:assoc-get 'enable-full-chords add-opts #f)
                         (ly:assoc-get 'enable-full-seventh-chords add-opts #f))
                  (begin
                   (stradella-append-chord-note es (ly:make-pitch 0 4 0) p c e #f)
                   (if dup-chords
                    (do
                     ((oct 1 (1+ oct)))
                     ((> oct chord-dup-count))
                     (stradella-append-chord-note es (ly:make-pitch oct 4 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                )))
                ((4) ;(display "\n4. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2 -1/2) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 5    0) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 5    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                 (if (or (ly:assoc-get 'enable-full-chords add-opts #f)
                         (ly:assoc-get 'enable-full-diminished-chords add-opts #f))
                  (begin
                   (stradella-append-chord-note es (ly:make-pitch 0 4 -1/2) p c e #f)
                   (if dup-chords
                    (do
                     ((oct 1 (1+ oct)))
                     ((> oct chord-dup-count))
                     (stradella-append-chord-note es (ly:make-pitch oct 4 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                )))
                ; ((99) (display "\n additional stradella pitch needs no action "))
             )) ; end of (if 'add-chord for chord tones' action
              (if (< e-st 0)
               (let*
                ((bass-dup-up-count (ly:assoc-get 'duplicate-bass-up add-opts #f))
                 (dup-bass-up (if (integer? bass-dup-up-count) #t #f))
                 (bass-dup-down-count (ly:assoc-get 'duplicate-bass-down add-opts #f))
                 (dup-bass-down (if (integer? bass-dup-down-count) #t #f))
                )
                (if dup-bass-up
                 (do
                  ((oct 1 (1+ oct)))
                  ((> oct bass-dup-up-count))
                  (stradella-append-chord-note es (ly:make-pitch 0 0 0) (ly:pitch-transpose p (ly:make-pitch (- oct 1) 0 0)) c e #t)
                ))
                (if dup-bass-down
                 (do
                  ((oct 1 (1+ oct)))
                  ((> oct bass-dup-down-count))
                  (stradella-append-chord-note es (ly:make-pitch 0 0 0) (ly:pitch-transpose p (ly:make-pitch (- -1 oct) 0 0)) c e #t)
           )))))))
       )))) ; end of lambda in (for-each ... es)
       es)) ; end of '(do ... )
     m)
    m)))

%§ Place the noteEvent into the desired octave range and so on
stradellaSpread =
#(define-music-function (parser location chords-base-pitch chromatic-mode bass-shift add-chord add-opts m)
                                        (ly:pitch?         boolean?       rational?  boolean?  list?    ly:music?)
  ; (display "\nc = ") (display chromatic-mode) (display "\n")
  (music-map (lambda (x) (stradella-spread chords-base-pitch
                                           chromatic-mode bass-shift add-chord add-opts x)) m))

#(define-markup-command (stradella-underline layout props parentesize arg)
  (boolean? markup?)
  #:category font
  #:properties ((font-size 0) (thickness 2.5) (offset 3.5))
  (let*
   ((thick (* (magstep font-size) (ly:output-def-lookup layout 'line-thickness)))
    (underline-thick (* thickness thick))
    (markup (interpret-markup layout props arg))
    (x1 (car (ly:stencil-extent markup X)))
    (x2 (cdr (ly:stencil-extent markup X)))
    (y (* thick (- offset)))
    (line (make-line-stencil underline-thick x1 y x2 y)))
   (if parentesize
    (let*
     ((p-thick (* underline-thick 0.5))
      (xd1 0.9)   (xd2 1.6)
      (yd1 0.9)   (yd2 1.6)
      (y11 (+ y (* underline-thick yd1)))
      (y12 (+ y (* underline-thick yd2)))
      (y21 (- y (* underline-thick yd1)))
      (y22 (- y (* underline-thick yd2)))
      (x11 (- x1 (* underline-thick xd2)))
      (x12 (- x1 (* underline-thick xd1)))
      (x21 (+ x2 (* underline-thick xd2)))
      (x22 (+ x2 (* underline-thick xd1)))
      (pla (make-line-stencil p-thick x11 y11 x12 y12))
      (plb (make-line-stencil p-thick x11 y11 x11 y21))
      (plc (make-line-stencil p-thick x12 y22 x11 y21))
      (pra (make-line-stencil p-thick x21 y11 x22 y12))
      (prb (make-line-stencil p-thick x21 y11 x21 y21))
      (prc (make-line-stencil p-thick x22 y22 x21 y21)))
     (ly:stencil-add markup line pla plb plc pra prb prc))
    (ly:stencil-add markup line))))

#(define-markup-command (raise-scaled layout props amount arg)
  (number? markup?)
  #:category align
  #:properties ((font-size 0))
  (let ((s-amount (* (magstep font-size) amount)))
   (ly:stencil-translate-axis (interpret-markup layout props arg) s-amount Y)))


#(define (stradella-textify-static chords-or-bass up-down give-prio text-style e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'EventChord)
    (let
     ((es (ly:music-property e 'elements))
      (t-aaa (if (equal? text-style "AAA") #t #f))
      (text-added #f)
     )
     (for-each (lambda (n)
       (let ((neventtype (ly:music-property n 'name)))
        (if (eq? neventtype 'NoteEvent)
         (let*
          ((e-tweaks (ly:music-property n 'tweaks))
           (e-st (stradella-type-number e-tweaks #f))
           (e-padding (ly:assoc-get 'stradella-padding e-tweaks '()))
           (e-parentaltbass (ly:assoc-get 'stradella-parenthesize-altbass e-tweaks #f))
           (e-show (ly:assoc-get 'stradella-show e-tweaks '()))
           (e-trigger (ly:assoc-get 'stradella-new-section e-tweaks #f))
           (e-show-opt (if (null? e-show) '() (acons 'stradella-show e-show '())))
           (e-fixed (string? e-show))
           (e-skip (and (boolean? e-show) (eq? e-show #f)))
          )
          (if (and (not e-skip)
                   (or (and (> e-st 0) (>= chords-or-bass 0))
                       (and (< e-st 0) (<= chords-or-bass 0)))
                   (or (not (and t-aaa (eq? e-st -1)))
                       e-fixed
                       e-trigger))
           (let*
            ((t-nat-on-b (if (equal? text-style "semiDefault") #t #f))
             (t-flat-on-b (if (equal? text-style "german") #f #t))
             (t-use-b (if (or (equal? text-style "default") (equal? text-style "semiDefault")) #t #f))
             (e-pitch (ly:music-property n 'pitch))
             (e-notename (ly:pitch-notename e-pitch))
             (e-altera (ly:pitch-alteration e-pitch))
             (e-class (if (< e-st 0) 'bass (if (> e-st 0) 'chord #f)))
             (e-opt0 (if (equal? give-prio 0) e-show-opt (acons 'outside-staff-priority give-prio e-show-opt)))
             (e-opt00 (if e-trigger (acons 'stradella-new-section #t e-opt0) e-opt0))
             (e-opt1 (acons 'extra-spacing-width (cons 0  0)
                      (acons 'extra-spacing-height (cons -inf.0 +inf.0)
                       (acons 'stradella-note-event n
                        (acons 'stradella-shows-pitch (not t-aaa)
                         (acons 'stradella-class e-class
                          (acons 'stradella-fixed-string e-fixed
                           (if (null? e-padding)
                            (acons 'padding 0.65 e-opt00)
                            (acons 'padding e-padding e-opt00)
                           ))))))))
            )
            (if t-aaa
             (let*
              ((id (string-concatenate (list "[" (number->string e-st)
                                             (if (and (eq? e-st -1) e-parentaltbass) "p" "")
                                             "]")))
               (e-sign (case e-st
                 ((-2) " ")
                 ((-1) "")
                 ((1) "M")
                 ((2) "m")
                 ((3) "7")
                 ((4) "d")
                 (else "?")))
               (e-text
                (if e-fixed
                 (markup #:line (#:roman (#:center-align (#:simple e-show))))
                 (if (eq? e-st -2)
                  (markup #:line (#:roman (#:center-align (#:stradella-underline e-parentaltbass
                       (#:simple e-sign)))))
                  (if (eq? e-st -1)
                   ; need no text, but a trigger for a new section
                   (markup #:line #:null)
                   (markup #:line (#:roman (#:center-align (#:simple e-sign)))))
               )))
               (e-object (make-music 'TextScriptEvent
                 'direction up-down
                 'text e-text
                 'tweaks (acons 'stradella-id id e-opt1)
               ))
              )
              (append! es (list e-object))
              (set! text-added #t)
             )
             (let*
              ((id (string-concatenate (list "[" (number->string e-notename)
                                             "|" (number->string (* e-altera 200))
                                             "|" (number->string e-st)
                                             (if (and (eq? e-st -1) e-parentaltbass) "p" "")
                                             "]")))
               (e-post (case e-st
                 ((-2) "")
                 ((-1) "")
                 ((1) "")
                 ((2) "m")
                 ((3) "⁷")
                 ((4) "v")
                 (else "")))
               (e-mid (case e-altera
                 ((-1)   (markup (#:doubleflat)))
                 ((-1/2) (if (or t-flat-on-b (not (eq? e-notename 6))) (markup (#:flat)) (markup (#:null)))) 
                 ((0)    (if (and t-nat-on-b (eq? e-notename 6)) (markup (#:natural)) (markup (#:null))))
                 ((1/2)  (markup (#:sharp)))
                 ((1)    (markup (#:doublesharp)))
                 (else (#:simple "?"))))
               (e-pre (case e-notename
                 ((0) (if (<= e-st 0) "C" "c"))
                 ((1) (if (<= e-st 0) "D" "d"))
                 ((2) (if (<= e-st 0) "E" "e"))
                 ((3) (if (<= e-st 0) "F" "f "))
                 ((4) (if (<= e-st 0) "G" "g"))
                 ((5) (if (<= e-st 0) "A" "a"))
                 ((6) (if (or (equal? e-altera -1/2) t-use-b) (if (<= e-st 0) "B" "b") (if (<= e-st 0) "H" "h")))
                 (else "?")))
               (e-text
                (if e-fixed
                 (markup #:line (#:roman (#:center-align (#:simple e-show))))
                 (if (eq? e-st -2)
                  (markup #:line (#:roman (#:center-align (#:stradella-underline e-parentaltbass
                       (#:concat (#:simple e-pre #:fontsize -3 (#:raise-scaled 1.25 e-mid) e-post))))))
                  (markup #:line (#:roman (#:center-align
                     (#:concat (#:simple e-pre #:fontsize -3 (#:raise-scaled 1.25 e-mid) e-post)))))
               )))
               (e-object (make-music 'TextScriptEvent
                 'direction up-down
                 'text e-text
                 'tweaks (acons 'stradella-id id e-opt1)
               ))
              )
              (append! es (list e-object))
              (set! text-added #t)
        ))))))
       )
      )
      es
     )
     (if text-added
      (ly:music-set-property! e 'elements es)
   )))
   e))


%§ create the text elements to the stradella music
stradellaStaticTextify =
#(define-music-function (parser location chords-or-bass up-down give-priority text-style m)
                                        (integer?      integer? integer?     string?    ly:music?)
  (music-map (lambda (x) (stradella-textify-static chords-or-bass up-down give-priority text-style x)) m))

#(define (Stradella_staffid_engraver ctx)  
  (let ((id (gensym "_StaffNoSymb")))
     ; This is to be expected unique, even if somme time in the future
     ; the engravers may be started in separate threads.

    `((acknowledgers

       (staff-symbol-interface . ,(lambda (engr grob source-engr)
         (ly:grob-set-property! grob 'stradella-staff-id id)))

       (text-script-interface . ,(lambda (engr grob source-engr)
         ;; whenever a TextScript is acknowledged,
         ;; add it to `scripts´ list,
         ;; but only if it's a stradella text object.
         ;; last but not least, adjust some properties
         ; (display " text-script")
         (let ((stra-class (wa:GtwE-property grob 'stradella-class)))
          ; (display " class = ") (display stra-class)
          (if (not (null? stra-class))
           (ly:grob-set-property! grob 'stradella-staff-id id)))
      )))
 )))

#(define (Stradella_textshift_engraver ctx)  
  (let ((scripts '())
        (note-column #f))

    `((acknowledgers
       (note-column-interface . ,(lambda (engr grob source-engr)
         ;; cache NoteColumn in this (Voice) context
         ; (display " note-column")
         (set! note-column grob)))

       (text-script-interface . ,(lambda (engr grob source-engr)
         ;; whenever a TextScript is acknowledged,
         ;; add it to `scripts´ list,
         ;; but only if it's a stradella text object.
         ;; last but not least, adjust some properties
         ;; (display "\n text-script")
         (let ((stra-class (wa:GtwE-property grob 'stradella-class)))
          ;; (for-each display (list "\n class = " stra-class " "))
          (if (not (null? stra-class))
           (begin
            (set! scripts (cons grob scripts))
            (ly:grob-set-property! grob 'X-offset ly:self-alignment-interface::aligned-on-x-parent)
            (ly:grob-set-property! grob 'self-alignment-X CENTER)
            (ly:grob-set-property! grob 'avoid-slur 'around)
            ; (ly:grob-set-property! grob 'extra-spacing-height (cons +inf.0 -inf.0))
         )))
      )))

      ;(start-translation-timestep . ,(lambda (engr)
      ;  (display "\nEngraver:")
      ;))

      (stop-translation-timestep . ,(lambda (engr)
        ;; if any TextScript grobs exist,
        ;; set NoteColumn as X-parent
        ;(display "; ")
        (and (pair? scripts)
         (for-each (lambda (script)
           (set! (ly:grob-parent script X) note-column))
          scripts))
        ;; clear scripts ready for next timestep
        (set! scripts '()))))))


\layout {
  \context {
    \Voice
    \consists #Stradella_textshift_engraver
  }
  \context {
    \Staff
    \consists #Stradella_staffid_engraver
  }
}

#(define stradella-pre-purge-friends '(AbsoluteDynamicEvent
                                       ApplyContext
                                       ArticulationEvent
                                       BeamEvent
                                       BeamForbidEvent
                                       BreathingEvent
                                       EventChord
                                       GraceMusic
                                       KeyChangeEvent
                                       LineBreakEvent
                                       MarkEvent
                                       MultiMeasureRestMusic
                                       NoteEvent
                                       OverrideProperty
                                       PartialSet
                                       PropertySet
                                       RestEvent
                                       SkipEvent
                                       SlurEvent
                                       SpacingSectionEvent
                                       TieEvent
                                       TimeScaledMusic
                                       TimeSignatureMusic
                                       TextScriptEvent))
#(define stradella-pre-purge-triggers '(BarCheck
                                        ContextSpeccedMusic
                                        SequentialMusic
                                        SimultaneousMusic        ; nicht immer!
                                        VoiceSeparator           ; ???
                                        VoltaRepeatedMusic))

#(define (stradella-pre-purge-contains-trigger-mark e)
  (let ((e-name (ly:music-property e 'name)))
   (if (eq? e-name 'EventChord)
    (let* ((es (ly:music-property e 'elements))
           (twk (ly:music-property e 'tweaks))
           (ns (ly:assoc-get 'stradella-new-section twk #f)))
     (if (and (boolean? ns) (eq? ns #t))
      #t
      (let ((erg #f))
       (for-each (lambda (ese) (let*
          ((etwk (ly:music-property ese 'tweaks))
           (sns (ly:assoc-get 'stradella-new-section etwk #f)))
          (if (and (boolean? sns) (eq? sns #t)) (set! erg #t))
        )) es)
       erg)))
    #f)))

#(define (stradella-pre-purge-is-trigger e)
  (let ((e-name (ly:music-property e 'name)))
   (if (pair? (memq e-name stradella-pre-purge-triggers))
    #t
    (if (stradella-pre-purge-contains-trigger-mark e) #t #f))))

#(define (stradella-pre-purge-is-removable-textobject side e)
  (let ((nm (ly:music-property e 'name)))
   (if (eq? nm 'TextScriptEvent)
    (let* ((e-tweaks (ly:music-property e 'tweaks))
           (e-class (ly:assoc-get 'stradella-class e-tweaks 'undef))
           (e-show (ly:assoc-get 'stradella-show e-tweaks #f)))
     (if (eq? e-class 'chord)
      (if (and (>= side 0) (eq? e-show #f)) #t #f)
      (if (eq? e-class 'bass)
       (if (and (<= side 0) (eq? e-show #f)) #t #f)
       #f)))
    #f)))

#(define (stradella-pre-purge-colorize-textobjects side e)
  (let ((es (ly:music-property e 'elements)))
   (for-each (lambda (ese)
     (if (stradella-pre-purge-is-removable-textobject side ese)
      (let ((e-tweaks (ly:music-property ese 'tweaks)))
       (ly:music-set-property! ese 'tweaks
        (acons 'color (list 1.0 0.0 0.0) e-tweaks)))
    )) es)))

#(define (stradella-pre-purge-textobjects side e)
  (let*
   ((es (ly:music-property e 'elements))
    (new-es (filter (lambda (x)
              (not (stradella-pre-purge-is-removable-textobject side x)))
             es)))
   (if (> (length new-es) 0)
    (ly:music-set-property! e 'elements new-es))))

#(define (stradella-pre-purge-get-ids side e)
  (let ((collector '())
        (es (ly:music-property e 'elements)))
   (for-each (lambda (ese) (let
      ((nm (ly:music-property ese 'name)))
      (if (eq? nm 'TextScriptEvent)
       (let* ((e-tweaks (ly:music-property ese 'tweaks))
              (e-class (ly:assoc-get 'stradella-class e-tweaks 'undef)))
        (if (and (>= side 0) (eq? e-class 'chord))
         (let ((id (ly:assoc-get 'stradella-id e-tweaks "")))
          (set! collector (cons id collector))))
        (if (and (<= side 0) (eq? e-class 'bass))
         (let ((id (ly:assoc-get 'stradella-id e-tweaks "")))
          (set! collector (cons id collector))))))
    )) es)
   (if (> (length collector) 0)
    (string-concatenate (sort-list collector string<?))
    "")))

#(define (stradella-pre-purge-sequential-sections side e)
  (let ((eventtype (ly:music-property e 'name))
        (color-removables (if (defined? 'stradella-pre-purge-coloration)
                           (eq? stradella-pre-purge-coloration #t)
                           #f))
   )
   (if (not (pair? (memq eventtype stradella-pre-purge-friends)))
    (if (not (pair? (memq eventtype stradella-pre-purge-triggers)))
     (ly:warning (locale-string-select '(
        (en . "Eventtype still not classified for use in \\stradellaPrePurge: ~a")
        (de . "Ereignistyp ist für \\stradellaPrePurge nicht klassifiziert: ~a")))
      eventtype)))
   (if (eq? eventtype 'SequentialMusic)
    (begin
     ;; (display "\nprepurging SequentialMusic: ")
     (let
      ((es (ly:music-property e 'elements))
       (last-chord-id "")
       (last-bass-id "")
      )
      (for-each (lambda (x)
        (let ((nm (ly:music-property x 'name)))
         ;; (display "\n   ") (display nm)
         (if (stradella-pre-purge-is-trigger x)
          (begin ;; (display " triggers")
           (if (>= side 0) (set! last-chord-id ""))
           (if (<= side 0) (set! last-bass-id ""))))
         (if (eq? nm 'EventChord)
          (begin
           (if (>= side 0)
            (let ((new-chord-id (stradella-pre-purge-get-ids UP x)))
             (if (> (string-length new-chord-id) 0)
              (if (string=? new-chord-id last-chord-id)
               (if color-removables                           ;; chord should be purged
                (stradella-pre-purge-colorize-textobjects UP x) 
                (stradella-pre-purge-textobjects UP x))
               (set! last-chord-id new-chord-id)))))
           (if (<= side 0)
            (let ((new-bass-id (stradella-pre-purge-get-ids DOWN x)))
             (if (> (string-length new-bass-id) 0)
              (if (string=? new-bass-id last-bass-id)
               (if color-removables                           ;; bass should be purged
                (stradella-pre-purge-colorize-textobjects DOWN x)
                (stradella-pre-purge-textobjects DOWN x))
               (set! last-bass-id new-bass-id)))))))
       )) es))))
   e))

%§ reduce the ocurrences of the stradella text elements based on the bar checks
stradellaPrePurge =
#(define-music-function (parser location side     music)
                                        (integer? ly:music?)
  (music-map (lambda (m) (stradella-pre-purge-sequential-sections side m)) music))

#(define (sort-by-X-coord sys grob-lst) 
"Arranges a list of grobs in ascending order by their X-coordinates" ;©harm6
  (let*
   ((X-coord (lambda (x) (ly:grob-relative-coordinate x sys X))) 
    (comparator (lambda (p q) (< (X-coord p) (X-coord q))))) 
   (sort grob-lst comparator))) 
      
#(define (grob-meta-name grob)
  (let ((meta (ly:grob-property grob 'meta)))
   (ly:assoc-get 'name meta)))

#(define (stradella-group-grob-sequence grob-seq sys staff-id delta)
  (let
   ((erg '())
    (last-X #f)
    (sublist '()))
   (for-each (lambda (grob)
     (let
      ((grob-name (grob-meta-name grob))
       (grob-X (ly:grob-relative-coordinate grob sys X))
       (need-grob #f)
       (new-group #f))
      (if (equal? grob-name 'BarLine)
       (let ((glyph (ly:grob-property grob 'glyph)))
        (if (> (string-count glyph (string->char-set ":S")) 0)
         (set! need-grob #t))))
      (if (equal? grob-name 'VoltaBracket)
       (let ((text (ly:grob-property grob 'text)))
        (if (not (string=? text "1."))
         (set! need-grob #t))))
      (if (equal? grob-name 'TextScript)
       (let
        ((st (ly:grob-property grob 'stradella-class #f))
         (staff-no (ly:grob-property grob 'stradella-staff-id #f)))
        (if (and (not (eq? st #f)) (eq? staff-id staff-no))
         (set! need-grob #t))))
      (if need-grob (begin
        (if (eq? last-X #f)
         (set! new-group #t)
         (if (> (- grob-X last-X) delta)
          (set! new-group #t)
          (set! new-group #f)))
        (if new-group (begin
          (if (not (null? sublist))
           (set! erg (append erg (cons sublist '()))))
          (set! sublist '())))
        (set! sublist (cons grob sublist))
        (set! last-X grob-X))))) 
    grob-seq)
   (if (not (null? sublist))
    (set! erg (append erg (cons sublist '()))))
   erg))

%§ after-line-breaking callback function to remove the repeated stradella texts
#(define ((stradella-cleanup side) base-grob)
  (let*
   ((sys (ly:grob-system base-grob))
    ;;; all grobs on the whole system line
    (elements-lst (ly:grob-array->list (ly:grob-object sys 'all-elements)))
    ;;; stradella-staff-id is put into the 'stradella TextScript grobs' and the 'StaffSymbol grobs'
    ;;;   by the 'Stradella_staffid_engraver' engraver
    (staff-id (ly:grob-property base-grob 'stradella-staff-id))
    ; (count-list '()) ;;; for analysis only
    (staff-only-color-removables (ly:grob-property base-grob 'stradella-cleanup-coloration))
    (color-removables (if (boolean? staff-only-color-removables)
                       staff-only-color-removables
                       (if (defined? 'stradella-cleanup-coloration)
                        (eq? stradella-cleanup-coloration #t)
                        #f)))
   )
   (let
    ((grob-sequence (sort-by-X-coord sys (filter (lambda (grob)
         (let ((grob-name (grob-meta-name grob)))
          (pair? (member grob-name (list 'TextScript 'BarLine 'VoltaBracket))) ;; auch 'LeftEdge 'VoltaBracketSpanner ?
         )) elements-lst))))
    ;;; filter out the 'TextScript grobs from other staffs, the 'non stradella TextScript grobs'
    ;;;   and rearrange them into a (sorted) list containing lists for each X-position (in the specified tolerance)
    (let ((grob-listsequence (stradella-group-grob-sequence grob-sequence sys staff-id 0.05)))
     ;;; go on, analize with grobs are redundant, then remove them
     (let
      ((last-chord-id "")
       (last-bass-id ""))
      (for-each (lambda (tick)
        (let
         ((chord-array '())
          (bass-array '())
          (trigger #f))
         (for-each (lambda (grob)
           (let ((gn (grob-meta-name grob)))
            (if (eq? gn 'TextScript)
             (let
              ((scl (ly:grob-property grob 'stradella-class))
               (sid (ly:grob-property grob 'stradella-id))
               (sns (ly:grob-property grob 'stradella-new-section #f)))
              (if (eq? sns #t) (set! trigger #t))
              (if (string? sid)
               (if (eq? scl 'chord)
                (set! chord-array (cons sid chord-array))
                (if (eq? scl 'bass)
                 (set! bass-array (cons sid bass-array))))))
             (set! trigger #t)))
          ) tick)
         (if trigger (begin
           (set! last-chord-id "")
           (set! last-bass-id "")))
         (if (and (> (length chord-array) 0) (>= side 0))
          (let ((new-id (string-concatenate (sort-list chord-array string<?))))
           (if (equal? new-id last-chord-id)
            (for-each (lambda (grob)
              (if (eq? (grob-meta-name grob) 'TextScript)
               (if (eq? (ly:grob-property grob 'stradella-class) 'chord)
                (if (eq? (ly:grob-property grob 'stradella-show #f) #f)
                 (if color-removables
                  (ly:grob-set-property! grob 'color (list 1.0 0.0 1.0))
                  (ly:grob-suicide! grob)))))
             ) tick)
            (set! last-chord-id new-id))))
         (if (and (> (length bass-array) 0) (<= side 0))
          (let ((new-id (string-concatenate (sort-list bass-array string<?))))
           (if (equal? new-id last-bass-id)
            (for-each (lambda (grob)
              (if (eq? (grob-meta-name grob) 'TextScript)
               (if (eq? (ly:grob-property grob 'stradella-class) 'bass)
                (if (eq? (ly:grob-property grob 'stradella-show #f) #f)
                 (if color-removables
                  (ly:grob-set-property! grob 'color (list 1.0 0.0 1.0))
                  (ly:grob-suicide! grob)))))
             ) tick)
            (set! last-bass-id new-id)))))
       ) grob-listsequence))))))