Lib Lists wrote:
Replying to myself, as it might help someone else to give me some hints. I made some progresses following the LSR example here: https://lsr.di.unimi.it/LSR/Item?id=1057.
. . .
Here a MWE: \version "2.25.5" \chords { aes2 cis } Specifically, I'd like to have all the flats smaller, and the sharps smaller and horizontally center-aligned with the root note name.
You got no hints from me because your MWE uses chordmode entry. Now with LSR1057 you are abandoning chordmode entry. Your chords will not be transposable. Ten years ago I tried to squash up chordmode output horizontally. The attached shows what I had to do using version 2.16. I abandoned that attempt, but kept the example. You can convert the code to 2.24, but the spacing isn't conserved. I'm not the only one who has tried this sort of customisation. Cheers, Robin
\version "2.16.0"
% \include "cin.ily" inlined
% out of chord-Ignatzek-names.scm, chord-name.scm and other stuff as needed
% - toplevel ;; comment removed
% - prefixed toplevel (defines with #
% - renamed all define-safe-public to define-public
% modified renamed i-c-n for nestling: base-stuff aligned after: -super +root
% modified alteration->text-accidental-markup for accidentals smaller and higher
%
% N.B. redefine slashChordSeparator, chordNoteNamer etc. for nestling below root and super
%schemeIndentOn
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% from markup.scm
#(define (markup-join markups sep)
"Return line-markup of MARKUPS, joining them with markup SEP"
(if (pair? markups)
(make-line-markup (list-insert-separator markups sep))
empty-markup))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% from lily-library.scm
#(define (split-at-predicate pred lst)
"Split LST into two lists at the first element that returns #f for
(PRED previous_element element). Return the two parts as a pair.
Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
(if (null? lst)
(list lst)
(let ((i (list-index (lambda (x y) (not (pred x y)))
lst
(cdr lst))))
(if i
(cons (take lst (1+ i)) (drop lst (1+ i)))
(list lst)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% from chord-generic-names.scm
#(define (conditional-kern-before markup bool amount)
"Add AMOUNT of space before MARKUP if BOOL is true."
(if bool
(make-line-markup
(list (make-hspace-markup amount)
markup))
markup))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% from chord-name.scm
#(define (natural-chord-alteration p)
"Return the natural alteration for step P."
(if (= (ly:pitch-steps p) 6)
FLAT
0))
#(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
#(define-public (alteration->text-accidental-markup alteration)
(make-fontsize-markup (if (= alteration SHARP) -3 -1.5)
(make-raise-markup
(if (= alteration FLAT)
0.9
1.5)
(make-musicglyph-markup
(assoc-get alteration standard-alteration-glyph-name-alist "")))))
#(define (accidental->markup alteration)
"Return accidental markup for ALTERATION."
(if (= alteration 0)
(make-line-markup (list empty-markup))
(conditional-kern-before
(alteration->text-accidental-markup alteration)
(= alteration FLAT) 0.2)))
#(define (accidental->markup-italian alteration)
"Return accidental markup for ALTERATION, for use after an italian chord root name."
(if (= alteration 0)
(make-hspace-markup 0.2)
(make-line-markup
(list
(make-hspace-markup (if (= alteration FLAT) 0.7 0.5))
(make-raise-markup 0.7 (alteration->text-accidental-markup alteration))
(make-hspace-markup (if (= alteration SHARP) 0.2 0.1))
))))
#(define-public (note-name->markup pitch lowercase?)
"Return pitch markup for @var{pitch}."
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename pitch))
lowercase?))
(accidental->markup (ly:pitch-alteration pitch)))))
#(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
#(define-public ((chord-name->german-markup B-instead-of-Bb)
pitch lowercase?)
"Return pitch markup for PITCH, using german note names.
If B-instead-of-Bb is set to #t real german names are returned.
Otherwise semi-german names (with Bb and below keeping the british names)
"
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
(cons 7 (+ (if B-instead-of-Bb 1 0) alt-semitones))
(cons name alt-semitones))))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?))
(make-normal-size-super-markup
(accidental->markup (/ (cdr n-a) 2)))))))
#(define-public (note-name->german-markup pitch lowercase?)
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
(cons 7 (+ 1 alt-semitones))
(cons name alt-semitones))))
(make-line-markup
(list
(string-append
(list-ref '("c" "d" "e" "f" "g" "a" "h" "b") (car n-a))
(if (or (equal? (car n-a) 2) (equal? (car n-a) 5))
(list-ref '( "ses" "s" "" "is" "isis") (+ 2 (cdr n-a)))
(list-ref '("eses" "es" "" "is" "isis") (+ 2 (cdr n-a)))))))))
#(define-public ((chord-name->italian-markup re-with-eacute) pitch lowercase?)
"Return pitch markup for @var{pitch}, using Italian/@/French note names.
If @var{re-with-eacute} is set to @code{#t}, french `ré' is returned for
pitch@tie{}D instead of `re'."
(let* ((name (ly:pitch-notename pitch))
(alt (ly:pitch-alteration pitch)))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref
(if re-with-eacute
#("Do" "Ré" "Mi" "Fa" "Sol" "La" "Si")
#("Do" "Re" "Mi" "Fa" "Sol" "La" "Si"))
name)
lowercase?))
(accidental->markup-italian alt)
))))
#(define-public (sequential-music-to-chord-exceptions seq . rest)
"Transform sequential music SEQ of type <<c d e>>-\\markup{ foobar }
to (cons CDE-PITCHES FOOBAR-MARKUP), or to (cons DE-PITCHES
FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
"
(define (chord-to-exception-entry m)
(let* ((elts (ly:music-property m 'elements))
(omit-root (and (pair? rest) (car rest)))
(pitches (map (lambda (x) (ly:music-property x 'pitch))
(filter
(lambda (y) (memq 'note-event
(ly:music-property y 'types)))
elts)))
(sorted (sort pitches ly:pitch<?))
(root (car sorted))
;; ugh?
;;(diff (ly:pitch-diff root (ly:make-pitch -1 0 0)))
;; FIXME. This results in #<Pitch c> ...,
;; but that is what we need because default octave for
;; \chords has changed to c' too?
(diff (ly:pitch-diff root (ly:make-pitch 0 0 0)))
(normalized (map (lambda (x) (ly:pitch-diff x diff)) sorted))
(texts (map (lambda (x) (ly:music-property x 'text))
(filter
(lambda (y) (memq 'text-script-event
(ly:music-property y 'types)))
elts)))
(text (if (null? texts) #f (if omit-root (car texts) texts))))
(cons (if omit-root (cdr normalized) normalized) text)))
(define (is-event-chord? m)
(and
(memq 'event-chord (ly:music-property m 'types))
(not (equal? ZERO-MOMENT (ly:music-length m)))))
(let* ((elts (filter is-event-chord? (ly:music-property seq 'elements)))
(alist (map chord-to-exception-entry elts)))
(filter (lambda (x) (cdr x)) alist)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% from chord-Ignatzek-names.scm
#(define (pitch-step p)
"Musicological notation for an interval. Eg. C to D is 2."
(+ 1 (ly:pitch-steps p)))
#(define (get-step x ps)
"Does PS have the X step? Return that step if it does."
(if (null? ps)
#f
(if (= (- x 1) (ly:pitch-steps (car ps)))
(car ps)
(get-step x (cdr ps)))))
#(define (replace-step p ps)
"Copy PS, but replace the step of P in PS."
(if (null? ps)
'()
(let* ((t (replace-step p (cdr ps))))
(if (= (ly:pitch-steps p) (ly:pitch-steps (car ps)))
(cons p t)
(cons (car ps) t)))))
#(define (remove-step x ps)
"Copy PS, but leave out the Xth step."
(if (null? ps)
'()
(let* ((t (remove-step x (cdr ps))))
(if (= (- x 1) (ly:pitch-steps (car ps)))
t
(cons (car ps) t)))))
#(define-public (i-c-n
in-pitches bass inversion
context)
(define (remove-uptil-step x ps)
"Copy PS, but leave out everything below the Xth step."
(if (null? ps)
'()
(if (< (ly:pitch-steps (car ps)) (- x 1))
(remove-uptil-step x (cdr ps))
ps)))
(define name-root (ly:context-property context 'chordRootNamer))
(define name-note
(let ((nn (ly:context-property context 'chordNoteNamer)))
(if (eq? nn '())
;; replacing the next line with name-root gives guile-error...? -rz
;; apparently sequence of defines is equivalent to let, not let* ? -hwn
(ly:context-property context 'chordRootNamer)
;; name-root
nn)))
(define (is-natural-alteration? p)
(= (natural-chord-alteration p) (ly:pitch-alteration p)))
(define (ignatzek-format-chord-name
root
prefix-modifiers
main-name
alteration-pitches
addition-pitches
suffix-modifiers
bass-pitch
lowercase-root?)
"Format for the given (lists of) pitches. This is actually more
work than classifying the pitches."
(define (filter-main-name p)
"The main name: don't print anything for natural 5 or 3."
(if
(or (not (ly:pitch? p))
(and (is-natural-alteration? p)
(or (= (pitch-step p) 5)
(= (pitch-step p) 3))))
'()
(list (name-step p))))
(define (glue-word-to-step word x)
(make-line-markup
(list
(make-simple-markup word)
(name-step x))))
(define (suffix-modifier->markup mod)
(if (or (= 4 (pitch-step mod))
(= 2 (pitch-step mod)))
(glue-word-to-step "sus" mod)
(glue-word-to-step "huh" mod)))
(define (prefix-modifier->markup mod)
(if (and (= 3 (pitch-step mod))
(= FLAT (ly:pitch-alteration mod)))
(if lowercase-root?
empty-markup
(ly:context-property context 'minorChordModifier))
(make-simple-markup "huh")))
(define (filter-alterations alters)
"Filter out uninteresting (natural) pitches from ALTERS."
(define (altered? p)
(not (is-natural-alteration? p)))
(if
(null? alters)
'()
(let* ((lst (filter altered? alters))
(lp (last-pair alters)))
;; we want the highest also if unaltered
(if (and (not (altered? (car lp)))
(> (pitch-step (car lp)) 5))
(append lst (last-pair alters))
lst))))
(define (name-step pitch)
(define (step-alteration pitch)
(- (ly:pitch-alteration pitch)
(natural-chord-alteration pitch)))
(let* ((num-markup (make-simple-markup
(number->string (pitch-step pitch))))
(args (list num-markup))
(total (if (= (ly:pitch-alteration pitch) 0)
(if (= (pitch-step pitch) 7)
(list (ly:context-property context 'majorSevenSymbol))
args)
(cons (accidental->markup (step-alteration pitch)) args))))
(make-line-markup total)))
(let* ((sep (ly:context-property context 'chordNameSeparator))
(slashsep (ly:context-property context 'slashChordSeparator))
(root-markup (name-root root lowercase-root?))
(add-pitch-prefix (ly:context-property context 'additionalPitchPrefix))
(add-markups (map (lambda (x) (glue-word-to-step add-pitch-prefix x))
addition-pitches))
(filtered-alterations (filter-alterations alteration-pitches))
(alterations (map name-step filtered-alterations))
(suffixes (map suffix-modifier->markup suffix-modifiers))
(prefixes (map prefix-modifier->markup prefix-modifiers))
(main-markups (filter-main-name main-name))
(to-be-raised-stuff (markup-join
(append
main-markups
alterations
suffixes
add-markups) sep))
(root-unaltered (ly:make-pitch 0 (ly:pitch-notename root) 0))
(root-unaltered-markup (name-root root-unaltered lowercase-root?))
(base-stuff (if (ly:pitch? bass-pitch)
(list root-unaltered-markup slashsep (name-note bass-pitch #f))
'()))
(caboodle (list root-markup
(conditional-kern-before (markup-join prefixes sep)
(and (not (null? prefixes))
(= (ly:pitch-alteration root) NATURAL))
(ly:context-property context 'chordPrefixSpacer))
(make-super-markup to-be-raised-stuff)
))
)
(make-combine-markup (make-line-markup caboodle) (make-line-markup base-stuff))))
(define (ignatzek-format-exception
root
exception-markup
bass-pitch
lowercase-root?)
(make-line-markup
`(
,(name-root root lowercase-root?)
,exception-markup
.
,(if (ly:pitch? bass-pitch)
(list (ly:context-property context 'slashChordSeparator)
(name-note bass-pitch #f))
'()))))
(let* ((root (car in-pitches))
(pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches)))
(lowercase-root?
(and (ly:context-property context 'chordNameLowercaseMinor)
(let ((third (get-step 3 pitches)))
(and third (= (ly:pitch-alteration third) FLAT)))))
(exceptions (ly:context-property context 'chordNameExceptions))
(exception (assoc-get pitches exceptions))
(prefixes '())
(suffixes '())
(add-steps '())
(main-name #f)
(bass-note
(if (ly:pitch? inversion)
inversion
bass))
(alterations '()))
(if exception
(ignatzek-format-exception root exception bass-note lowercase-root?)
(begin
;; no exception.
;; handle sus4 and sus2 suffix: if there is a 3 together with
;; sus2 or sus4, then we explicitly say add3.
(map
(lambda (j)
(if (get-step j pitches)
(begin
(if (get-step 3 pitches)
(begin
(set! add-steps (cons (get-step 3 pitches) add-steps))
(set! pitches (remove-step 3 pitches))))
(set! suffixes (cons (get-step j pitches) suffixes)))))
'(2 4))
;; do minor-3rd modifier.
(if (and (get-step 3 pitches)
(= (ly:pitch-alteration (get-step 3 pitches)) FLAT))
(set! prefixes (cons (get-step 3 pitches) prefixes)))
;; lazy bum. Should write loop.
(cond
((get-step 7 pitches) (set! main-name (get-step 7 pitches)))
((get-step 6 pitches) (set! main-name (get-step 6 pitches)))
((get-step 5 pitches) (set! main-name (get-step 5 pitches)))
((get-step 4 pitches) (set! main-name (get-step 4 pitches)))
((get-step 3 pitches) (set! main-name (get-step 3 pitches))))
(let* ((3-diff? (lambda (x y)
(= (- (pitch-step y) (pitch-step x)) 2)))
(split (split-at-predicate
3-diff? (remove-uptil-step 5 pitches))))
(set! alterations (append alterations (car split)))
(set! add-steps (append add-steps (cdr split)))
(set! alterations (delq main-name alterations))
(set! add-steps (delq main-name add-steps))
;; chords with natural (5 7 9 11 13) or leading subsequence.
;; etc. are named by the top pitch, without any further
;; alterations.
(if (and
(ly:pitch? main-name)
(= 7 (pitch-step main-name))
(is-natural-alteration? main-name)
(pair? (remove-uptil-step 7 alterations))
(reduce (lambda (x y) (and x y)) #t
(map is-natural-alteration? alterations)))
(begin
(set! main-name (last alterations))
(set! alterations '())))
(ignatzek-format-chord-name
root prefixes main-name alterations add-steps suffixes bass-note
lowercase-root?))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%schemeIndentOff
%end of include cin.ily
\paper{
top-margin = 10\mm
system-system-spacing #'minimum-distance = 18\mm
last-bottom-spacing #'minimum-distance = 10\mm
bottom-margin = 5\mm % leaving tagline just visible on oki
% allow 15mm margin for punch holes:
line-width = 180\mm % leaving 15mm for other margin
left-margin = 15\mm
% annotate-spacing = ##t % for dimensions overlay
% ragged-last-bottom = ##f
system-system-spacing #'minimum-distance = #140/8 % for gap at bottom
page-count = 1
}
#(set-global-staff-size 19) % for 8 lines
\header {
title = \markup \center-column {"Mercy Mercy Mercy"}
%subtitle = ""
%composer = ""
meter = "Gospel/Funk"
tagline = "test_RCB130701"
}
%schemeIndentOn
besideCN = #(define-music-function (parser location where what) (integer? string?)
#{\once \override ChordNames.ChordName #'stencil = #(lambda (grob)
(let* (
(whatlen (string-length what))
(clamped (lambda (index) (cond ((< index 0) 0)
((> index whatlen) whatlen) (else index))))
(split (clamped (cond
((negative? where) (+ where whatlen 1))
((positive? where) (- where 1))
(else (quotient whatlen 2)))))
(insert (lambda (i-side i-text) ; (integer? string?)
(if (> (string-length i-text) 0)
(ly:grob-set-property! grob 'text
(markup #:put-adjacent 0 i-side
(ly:grob-property grob 'text) i-text))))))
(if (and (= where CENTER) (odd? whatlen))
(insert -1 (substring what split (+ split 1))))
(insert -1 (substring what 0 split ))
(insert 1 (substring what split whatlen )))
(ly:text-interface::print grob))
#})
%
%schemeIndentOff
flatadj = \markup { \translate #'(0.2 . 0.2) \fontsize #-1 \flat }
chExceptionMusic =
{
<c ees ges bes>1-\markup
{ "m" \super \concat {"7" \hspace #0.3 \flatadj "5"} }% half-diminished
}
%schemeIndentOn
chExceptions = #( append
( sequential-music-to-chord-exceptions chExceptionMusic #t)
ignatzekExceptions)
%
%schemeIndentOff
global = {
\key bes \major
\override Staff.TimeSignature #'style = #'()
\time 4/4
\set Score.markFormatter = #format-mark-box-letters
}
sopaltoAux = {
\oneVoice
\mark \default s1 |
s1 |
s1 |
s1 | \break
s1 |
s1 |
s1 |
s1 | \break
\mark \default s1 |
s1 |
s1 |
s1 | \break
s1 |
s1 |
s1 |
s1 | \break
\mark \default s1 |
s1 |
s1 |
s1 | \bar "|."
}
sopMusic = \transpose bes bes' {
\oneVoice
r4 g8[ f8] ~ f4 d8[ bes,] |
c8[ bes,8 bes,8 g,8] bes,4 c4 |
r4 g8[ f8] ~ f4 d8[ bes,] |
c8[ bes,8 bes,8 g,8] bes,4 c4 |
r4 g8[ f8] ~ f4 d8[ bes,] |
c8[ bes,8 bes,8 g,8] bes,4 c4 |
r4 g8[ f8] ~ f4 d8[ bes,] |
c8[ bes,8 bes,8 g,8] bes,4 c4 |
f4 f4 g8 g4 aes8 ~ |
aes4 aes4 g8 g4 f8 ~ |
f4 f4 g8 g4 aes8 ~ |
aes4 aes4 g8 g4 f8 ~ |
f4 bes,8[ bes,8] d8[ d8 ees8 ees8] |
f8 r8 bes4 bes8[ bes8 bes8 bes8] |
r4 bes,8[ bes,8] d8[ d8 ees8 ees8] |
f8 r8 r4 r8 f,8 g,8[ bes,8] |
c4. c8 r4 r8 bes,8 |
d4. d8 r8 c8 d8[ f8] |
g4. f8 g4. f8 |
g4 r4 r2|
}
harmonies = \transpose bes bes {\chordmode {
\set chordNameExceptions = #chExceptions
bes2 bes2:7/d ees2 ees2:/f
bes2 bes2:7/d ees2 ees2:/f
bes2 bes2:7/d ees2 ees2:/f
bes2 bes2:7/d ees2 ees2:/f
bes2 ees4.:/bes bes8*5:7 ees4.:/bes bes8 ~
bes2 ees4.:/bes bes8*5:7 ees4.:/bes bes8 ~
bes2 bes4:/d ees4 f4 ees8*5:/f bes8 ~
bes2 bes4:/d ees4 f1
c1:m7 d1:m7
g4.:m7 f8 g4.:m7 f8 g1:m7
}}
sopaltoAuxSolos = {
\oneVoice \mark "Solos"
s1 |
s1 | \bar ":|"
\stopStaff
s1 |
s1 |
s1 |
s1 |
s1 |
s1 |
}
% Macro to print single slash
rs = {
\once \override Rest #'stencil = #ly:percent-repeat-item-interface::beat-slash
\once \override Rest #'thickness = #0.48
\once \override Rest #'slope = #1.7
r4
}
sopMusicSolos = \transpose bes bes' {
\oneVoice
s2 \rs s4 |
s2 \rs s4 |
}
harmoniesSolos = \transpose bes bes {\chordmode {
bes1:7 ees1:7 |
}}
% MIDI Output
\score {
\unfoldRepeats { % otherwise you don't get repeats in the MIDI
<<
\new Staff = "one" { \global <<\sopMusic >>} \set Staff.midiInstrument = "violin"
\new Staff = "two" \harmonies % \set Staff.midiMaximumVolume = #0.1 \set Staff.midiInstrument = "choir aahs"
>>
}
\midi {
\tempo 4. = 80
}
}
% Paper Output
\markup \vspace #1.5
\score {
<<
\context ChordNames {
\set chordChanges = ##t
\harmonies
}
\new Staff = "one" { \global <<\sopMusic \\ \sopaltoAux>>}
>>
\layout{ indent = 0.0\cm
\context { \ChordNames
chordNameSeparator = #(make-hspace-markup 0.3)
minorChordModifier =
#(make-with-dimensions-markup (cons 0 0.5) (cons 0 0) ;;% displace supers slightly but definitely, exposing the "-"
(make-translate-markup (cons 0.2 0.2) ;;% x: away from accidental y: clear of bass slash
(make-fontsize-markup 0 "-"))) % compacter than "m"; easy to fit vertically between bass and super
% for bass slash nestling:
chordRootNamer = #note-name->markup % same ref but sees local version
chordNameFunction = #i-c-n % cf cin.ily (inlined above)
slashChordSeparator =
#(make-with-dimensions-markup (cons 0 0) (cons 0 0) ;;% is only a dividing line; displaces nothing
(make-translate-markup (cons -0 -1) ;;% just clear of root-stuff base
(make-rotate-markup -45 "/"))) % roughly perp to bearing of bass letter to root letter
chordNoteNamer = #(lambda (p l?)
(make-lower-markup 2.5 ;;% not too cramped but still belonging graphically
(make-smaller-markup ;;% as qualifier is subordinate to root name
(note-name->markup p l?))))
}
}
}
\markup \vspace #6
\score {
<<
\context ChordNames {
\set chordChanges = ##t
\harmoniesSolos
}
\new Staff = "one" { \global <<\sopMusicSolos \\ \sopaltoAuxSolos>>}
>>
\layout{ indent = 0.0\cm
ragged-last = ##f
}
}
compacterCN.pdf
Description: Adobe PDF document
