\version "2.22.1"

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

#(set-object-property! 'chord-name-fractions 'backend-type? list?)

#(define (define-grob! grob-name grob-entry)
   (set! all-grob-descriptions
         (cons ((@@ (lily) completize-grob-entry)
                (cons grob-name grob-entry))
               all-grob-descriptions)))

#(define (chord-square::print grob)
   (let* ((left (ly:spanner-bound grob LEFT))
          (right (ly:spanner-bound grob RIGHT))
          (left-pos (car (ly:paper-column::break-align-width left 'staff-bar)))
          (right-pos (car (ly:paper-column::break-align-width right 'staff-bar)))
          (sys (ly:grob-system grob))
          (my-X (ly:grob-relative-coordinate grob sys X))
          (relative-left (- left-pos my-X))
          (relative-right (- right-pos my-X))
          (height (ly:grob-property grob 'height))
          (top (* 1/2 height))
          (bottom (* -1/2 height))
          (thickness (* (ly:grob-property grob 'thickness)
                        (ly:staff-symbol-line-thickness grob)))
          (chord-names (ly:grob-array->list (ly:grob-object grob 'elements)))
          (chord-name-fractions (ly:grob-property grob 'chord-name-fractions)))
     (receive (printed-lines positions)
       (match chord-name-fractions
         ((1)
          (values '(#f #f #f #f) '((0.0 . 0.0))))
         ((1/2 1/2)
          (values '(#t #f #t #f) '((-0.5 . 0.3) (0.5 . -0.3))))
         ((1/2 1/4 1/4)
          (values '(#t #f #t #t) '((-0.5 . 0.3) (0 . -0.55) (0.65 . 0.0))))
         ((1/4 1/4 1/2)
          (values '(#t #t #t #f) '((-0.65 . 0.0) (0.0 . 0.55) (0.5 . -0.3))))
         ((1/4 1/4 1/4 1/4)
          (values '(#t #t #t #t) '((-0.5 . 0.0) (0.0 . 0.55) (0.0 . -0.55) (0.5 . 0.0))))
         ((1/4 3/4)
          (values '(#t #t #f #f) '((-0.65 . 0.0) (0.4 . 0.0))))
         ((3/4 1/4)
          (values '(#f #f #t #t) '((-0.4 . 0.0) (0.65 . 0.0))))
         (else
          (ly:event-warning (event-cause grob)
                            "unsupported measure pattern: ~a"
                            chord-name-fractions)
          (values '(#f #f #f #f) (make-list (length chord-names)
                                            '(0 . 0)))))
       (let* ((line-endings `((,relative-left ,bottom)
                              (,relative-left ,top)
                              (,relative-right ,top)
                              (,relative-right ,bottom)))
              (x-interval (cons relative-left relative-right))
              (y-interval (cons bottom top))
              (x-center (interval-center x-interval))
              (x-absolute-interval (cons left-pos right-pos))
              (lines-stil
               (apply ly:stencil-add
                      (filter-map
                       (lambda (ending should-print)
                         (and should-print
                              (apply make-line-stencil thickness x-center 0 ending)))
                       line-endings
                       printed-lines))))
         (for-each
          (match-lambda*
           ((chord-name (x . y))
            (let ((rel-x (- (interval-index x-absolute-interval x)
                            (interval-center (ly:grob-extent chord-name sys X))))
                  (rel-y (- (interval-index y-interval y)
                            (interval-center (ly:grob-extent chord-name chord-name Y)))))
              (ly:grob-translate-axis! chord-name rel-x X)
              (ly:grob-translate-axis! chord-name rel-y Y))))
          chord-names
          positions)
         lines-stil))))

#(define (chord-square::height grob)
   (let ((height (ly:grob-property grob 'height)))
     (cons (* -1/2 height)
           (* 1/2 height))))

#(define-grob!
  'ChordSquare
  `((axes . (,Y))
    (height . 6)
    (no-alignment . #t)
    (thickness . 1)
    (stencil . ,chord-square::print)
    (vertical-skylines . ,(ly:make-unpure-pure-container
                           ly:grob::simple-vertical-skylines-from-extents
                           ly:grob::pure-simple-vertical-skylines-from-extents))
    (X-extent . ,ly:grob::stencil-width)
    (Y-extent . ,(ly:make-unpure-pure-container chord-square::height))
    (meta . ((class . Spanner)
             (interfaces . (axis-group-interface))))))

#(define (Chord_square_engraver context)
   (let ((chord-names #f)
         (square #f)
         (moms '()))
     (make-engraver
      ((process-music engraver)
       (if (and square
                (string? (ly:context-property context 'whichBar))
                (equal? ZERO-MOMENT (ly:context-property context 'measurePosition)))
           (begin
             (let ((col (ly:context-property context 'currentCommandColumn)))
               (ly:spanner-set-bound! square RIGHT col))
             (let* ((now-mom (ly:context-current-moment context))
                    (extended-moms (cons now-mom moms))
                    (mom-deltas (let loop ((remaining extended-moms)
                                           (acc '()))
                                  (match remaining
                                    ((one) acc)
                                    ((one two . rest) (loop (cons two rest)
                                                            (cons (ly:moment-sub one two)
                                                                  acc))))))
                    (total-span (ly:moment-sub now-mom (last moms)))
                    (fracs (map (lambda (delta)
                                  (ly:moment-main (ly:moment-div delta total-span)))
                                mom-deltas)))
               (ly:grob-set-property! square 'chord-name-fractions fracs))
             (set! square #f)
             (set! moms '()))))
      (acknowledgers
       ((chord-name-interface engraver grob source-engraver)
          (if (not square)
              (let ((col (ly:context-property context 'currentCommandColumn)))
                (set! square (ly:engraver-make-grob engraver 'ChordSquare grob))
                (ly:spanner-set-bound! square LEFT col)))
          (ly:axis-group-interface::add-element square grob)
          (let ((mom (ly:context-current-moment context)))
            (set! moms (cons mom moms))))))))

\layout {
  \context {
    \Global
    \grobdescriptions #all-grob-descriptions
  }
  \context {
    \Score
    proportionalNotationDuration = #(ly:make-moment 1/4)
    \remove Bar_number_engraver
    \remove System_start_delimiter_engraver
  }
  \context {
    \ChordNames
    \name ChordGrid
    \consists #Chord_square_engraver
    \consists Bar_engraver
    \override BarLine.bar-extent = #'(-3 . 3)
    \consists System_start_delimiter_engraver
    systemStartDelimiter = #'SystemStartBar
    \override SystemStartBar.collapse-height = 0
    \consists Staff_symbol_engraver
    \override StaffSymbol.line-positions = #'(-6 6)
    
  }
  \inherit-acceptability ChordGrid ChordNames
}

%% Repris de https://lists.gnu.org/archive/html/lilypond-user-fr/2022-02/msg00033.html
%% (et légèrement arrangé).

#(define (Recurring_break_engraver context)
   (let ((break-allowed #f)
         (bar 0)
         (was-start-partial #f))
     (define (start-partial?)
       (or (and (equal? ZERO-MOMENT (ly:context-current-moment context))
                (ly:moment<? (ly:context-property context 'measurePosition)
                             ZERO-MOMENT))
           (ly:context-property context 'partialBusy #f)))
     (make-engraver
       (acknowledgers
         ((bar-line-interface engraver grob source-engraver)
            (if (and (not was-start-partial)
                     (not (equal? ZERO-MOMENT (ly:context-current-moment context))))
                (begin
                  (set! break-allowed #t)
                  (set! bar (1+ bar))))))
       ((stop-translation-timestep translator)
          (if break-allowed
              (let* ((column (ly:context-property context 'currentCommandColumn))
                     (layout (ly:grob-layout column))
                     (bars-per-line (ly:output-def-lookup layout 'bars-per-line)))
                (if (index? bars-per-line)
                    (ly:grob-set-property!
                     column
                     'line-break-permission
                     (if (zero? (modulo bar bars-per-line))
                         'force
                         '())))))
          (set! break-allowed #f)
          (set! was-start-partial (start-partial?))))))

\layout {
  \context {
    \Score
    \consists #Recurring_break_engraver
  }
  bars-per-line = 4
}

\paper {
  indent = 0
}


%%%%%%%%%%%%%%%%%%

mus = \chordmode {
  c1
  d2 e2
  s1
  c2 d4 e4
  f4 g4 a2
  \repeat volta 2 {
    f4 g4 a4 b4
    d4 e2.
  }
  b2. c4
}


\new ChordGrid \mus
\new Staff \mus
\new TabStaff \mus
\new FretBoards \mus

\new ChordGrid \chordmode { 
  \bar "[|:" % barre de mesure début de répétition
  a2:m a:m7+ % une mesure à 2 accords commence par \/
  a2:m7 a:m6
  f1:7 % une mesure à 1 accord
  f2:7 e:m7  \break
  d1:m7
  d2:m7 b:m5-7
  \set Score.repeatCommands = #'((volta "1")) % 1ère alternative
  b1:m7/e  
  e:7  
  \set Score.repeatCommands = #'((volta #f)) 
  \bar ":|]" \break % barre de mesure fin de répétition
  \stopStaff s % 
  \once \override Score.RehearsalMark.transparent = ##t
  \mark \markup \pad-around #3 "X" % réglage de l'espacement entre les lignes
  \bar "" s \startStaff
  \set Score.repeatCommands = #'((volta "2")) % 2ème alternative
  \repeat percent 2 { a1:7+ }  \bar "||"
  \set Score.repeatCommands = #'((volta #f)) \break
  b2:m5-7 e:7
  a1:7+
  b2:m5-7 e:7
  a1:7+ \break
  as2:m7 des:9-
  ges1:7+
  g2:m7 c:9-
  f1:7+ \bar ":|]" \break % barre de mesure fin de répétition
  \stopStaff s 
  \once \override Score.RehearsalMark.transparent = ##t
  \mark \markup \pad-around #3 "X" % réglage de l'espacement entre les lignes
  \bar "" s \startStaff
  \set Score.repeatCommands = #'((volta "3")) % 3ème alternative
  b1:m7/e  
  e:7   \bar "||"
  \set Score.repeatCommands = #'((volta #f)) \break
  f1:6
  d2:m e:7
  f1:7+
  f:5-7 \break
  \once \override Score.RehearsalMark.break-visibility = #end-of-line-visible
  \once \override Score.RehearsalMark.transparent = ##t
  \mark \markup \pad-around #1 "X" % réglage de l'espacement entre les lignes
  a1:m/e
  b2:m7 e:7
  a1:m
  b2:m5-7 e:9- 
  \bar ".." % barre de fin
}