\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
}