Jazzakkorde auflisten
Zur Navigation springen
Zur Suche springen
Jazzakkorde als Sheet ausgeben
Die nachfolgende Funktion gibt ein Sheet mit den wichtigsten Jazzakkorden aus. Als Parameter wird der Grundton, auf dem die Akkorde aufgebaut werden sollen, angegeben. Ziel wäre es, die Abfolge mehrere Grundtöne zu automatisieren.
Jeder Akkord wird zusätzlich auf einer Tastatur veranschaulicht, wofür dieser[1] bzw. dieser Lilypond-Code[2] verwendet wurde.
Eine Liste der Akkorde auf allen im Quintenzirkel angeordneten Grundtönen gibt es hier[3].
\version "2.19.83"
\language "deutsch"
#(ly:load "x11-color.scm")
\include "exceptions.ily"
\include "drawchords.ily"
\include "titel.ily"
\paper {
markup-markup-spacing.padding = #5
top-margin = #20
oddHeaderMarkup = ##f
evenHeaderMarkup = #oddHeaderMarkup
oddFooterMarkup = ##f %\markup \fill-line { \null "Jazz-Akkorde" \null }
evenFooterMarkup = #oddHeaderMarkup
ragged-right = ##t
ragged-last = ##t
ragged-bottom = ##t
ragged-last-bottom = ##t
annotate-spacing = ##f
}
\layout {
\context {
\Staff
\remove "Time_signature_engraver"
\override InstrumentName.padding = #0.5
\override InstrumentName.self-alignment-X = #1
\override TextScript.padding = #2
}
\context {
\PianoStaff
\override SystemStartBrace.collapse-height = #1
}
\context {
\Score
\override KeyCancellation.break-visibility = #all-invisible
}
\context {
\ChordNames
\alias ChordNames
\override ChordName.self-alignment-X = #LEFT
chordNameLowercaseMinor = ##f
\override Rest.stencil = ##f
chordNoteNamer = #(chord-name->german-markup #f)
chordChanges = ##f
chordNameLowercaseMinor = ##f
chordNameExceptions = #chExceptions
chordRootNamer = #germanChords
majorSevenSymbol = \markup { maj7 }
\override ChordName.font-name = #"Arial Narrow"
\override ChordName.font-shape = #'bold
\override ChordName.extra-spacing-width = #'(+inf.0 . -inf.0)
\override ChordName.font-size = #4
noChordSymbol = ##f
\override VerticalAxisGroup.staff-affinity = #UP
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.padding = #1
}
}
#(define-markup-command (my-chord-symbol layout props mus)
(ly:music?)
(interpret-markup layout props
#{
\markup \score {
\new Staff
\with {
instrumentName = \markup \score {
\new ChordNames $mus
}
}
{
\textLengthOff
\override Staff.BarLine.stencil = ##f
\ChordKeyboard c' c' #0.05 $mus \noBreak
\override Staff.Clef.font-size = #2 \bar "||"
}
\layout {
line-width = #70
}
}
#}))
myflat = \markup \fontsize #-1 \flat
mysharp = \markup \fontsize #-2 \sharp
chExceptionMusic = {
<c e g h>1-\markup { \fontsize #-6 " " "j" }
<c e g h d'>1-\markup { \fontsize #-6 " " "j" \super 9 }
<c e g h dis'>1-\markup { \fontsize #-6 " " "j" \super \vcenter { "7(" \mysharp "9)" } }
<c e g h d' a'>1-\markup { \fontsize #-6 " " "j" \super 13 }
<c e g b d' a'>1-\markup { \super 13 }
<c e g a d'>-\markup {
\super {
"6/9"
}
}
<c es g a d'>-\markup {
m \super 6/9
}
<c es ges heses>-\markup {
\fontsize #-6 " " dim \super 7
}
<c es ges b des'>-\markup \line {
m \super 7
\translate #'(-0.5 . 1) \vcenter
{
"(" \override #'(baseline-skip . 1)
\center-column
\fontsize #-4 { \concat { \myflat "5" } \concat { \myflat "9" } } ")"
}
}
<c es ges h>-\markup {
\fontsize #-6 " " dim \super maj7
}
<c es ges heses des'>-\markup {
\fontsize #-6 " " "dim" \super \concat { \myflat "9" }
}
<c es g b f'>-\markup {
m \super 7(add11)
}
<c es gis>-\markup {
m
\normal-size-super "+"
}
<c f g b>-\markup \super {
7
\normal-size-sub sus
}
<c f g b d'>-\markup \super {
9
\normal-size-sub sus
}
<c f g b d' a'>-\markup \super {
13
\normal-size-sub sus
}
<c e ges b>-\markup \super {
7 "(" \myflat "5)"
}
<c e ges b d'>-\markup \super {
9 "(" \myflat "5)"
}
<c e gis b>-\markup {
+ \super 7
}
<c e gis b d'>-\markup {
+ \super 9
}
<c e g b des'>-\markup \super {
7 "(" \myflat "9)"
}
<c e g b dis'>-\markup \super {
\vcenter { "7(" \mysharp "9)" }
}
<c e ges b des'>-\markup \line {
\super 7
\translate #'(-0.5 . 1) \vcenter
{
"(" \override #'(baseline-skip . 1)
\center-column
\fontsize #-4 { \concat { \myflat "9" } \concat { \myflat "5" } } ")"
}
}
<c e gis b dis'>-\markup {
+ \super \vcenter { "7(" \mysharp "9)" }
}
<c e gis b des'>-\markup {
+ \super \vcenter { "7(" \myflat "9)" }
}
<c e gis h >-\markup {
+ \super 7
}
<c e gis h d'>-\markup {
+ \super 9
}
<c e g b fis'>-\markup
\super \vcenter { "7(" \mysharp "11)" }
<c e g b d' fis'>-\markup
\super \vcenter { "9(" \mysharp "11)" }
<c e g b des' fis'>-\markup \line {
\super 7
\translate #'(-0.5 . 1) \vcenter
{
"(" \override #'(baseline-skip . 1)
\center-column
\fontsize #-4 { \concat { \mysharp "11" } \concat { \myflat "9" } } ")"
}
}
<c e ges b d' a'>-\markup
\super \vcenter { "13(" \myflat "5)" }
<c e g b d' fis' a'>-\markup
\super \vcenter { "13(" \mysharp "11)" }
}
chExceptions =
#(append
(sequential-music-to-chord-exceptions chExceptionMusic #t)
ignatzekExceptions)
myBlue = #(rgb-color (/ 22 255) (/ 22 255) (/ 92 255))
#(define ((chord-name->german-markup-text-alteration B-instead-of-Bb) pitch lowercase?)
(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -1)))
(cons 7 (+ (if B-instead-of-Bb 1 1) 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?))
(let ((alteration (/ (cdr n-a) 2)))
(cond
((and (equal? lowercase? #f) (= alteration FLAT) (= (car n-a) 7)) (make-simple-markup ""))
((and (= alteration FLAT) (or (= (car n-a) 5) (= (car n-a) 2) )) (make-simple-markup "s"))
((= alteration FLAT) (make-simple-markup "es"))
((and (= alteration DOUBLE-FLAT) (or (= (car n-a) 5)(= (car n-a) 2) )) (make-simple-markup "ses"))
((= alteration DOUBLE-FLAT) (make-simple-markup "eses"))
((= alteration SHARP) (make-simple-markup "is"))
((= alteration DOUBLE-SHARP) (make-simple-markup "isis"))
(else empty-markup)))))))
#(define germanChords (chord-name->german-markup-text-alteration #t))
#(define (naturalize-pitch p)
;; reduces alteration greater than a half tone step
;; #(display (naturalize-pitch #{ fes #}))
;; #<Pitch e >
(let ((o (ly:pitch-octave p))
(a (* 4 (ly:pitch-alteration p)))
;; alteration, a, in quarter tone steps,
;; for historical reasons
(n (ly:pitch-notename p)))
(cond
((and (> a 1)
(or (eq? n 6)
(eq? n 2)))
(set! a (- a 2))
(set! n (+ n 1)))
((and (< a -1)
(or (eq? n 0) (eq? n 3)))
(set! a (+ a 2))
(set! n (- n 1))))
(cond
((> a 2) (set! a (- a 4)) (set! n (+ n 1)))
((< a -2) (set! a (+ a 4)) (set! n (- n 1))))
(ly:make-pitch o n (/ a 4))))
#(define (all-pitches-from-music music)
"Return a list of all pitches from @var{music}."
;; Opencoded for efficiency.
(reverse!
(let loop ((music music) (pitches '()))
(let ((p (ly:music-property music 'pitch)))
(if (ly:pitch? p)
(cons (naturalize-pitch p) pitches)
(let ((elt (ly:music-property music 'element)))
(fold loop
(if (ly:music? elt)
(loop elt pitches)
pitches)
(ly:music-property music 'elements))))))))
#(define (low-pitch music)
;; returns the lowest pitch from music
(car (sort (all-pitches-from-music music) ly:pitch<?)))
%%
#(define (high-pitch music)
;; returns the highest pitch from music
(car (reverse (sort (all-pitches-from-music music) ly:pitch<?))))
#(define (pitch-between? p p1 p2)
(and (not (ly:pitch<? p p1)) (not (ly:pitch<? p2 p))))
#(define (pitch-equals? p1 p2)
;(write-me "pitch-equals? ----------------------------> " (list p1 p2))
(and
(= (ly:pitch-alteration p1) (ly:pitch-alteration p2))
(= (ly:pitch-notename p1) (ly:pitch-notename p2))))
#(define (standardize-pitch p)
;; make pitches with SHARPs or no alteration
;; standardize-pitch c ==> c
;; standardize-pitch cis ==> cis
;; standardize-pitch des ==> cis
(let* ((p1 (naturalize-pitch p))
(a (ly:pitch-alteration p1))
(n (ly:pitch-notename p1))
(o (ly:pitch-octave p1))
(a1 (- a 0.5))
(n1 (inexact->exact (+ n a1))))
;procedure body
(if (= a 0)
p1
(ly:make-pitch o n1 SHARP))))
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% pitchlist functions and creating a complete pitchlist for keyboard
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% definitions for the measures of the keyboard keys
#(define white-key-width 23.5) %% the width of a white piano key
%%#(define white-key-height 150) %% the height of a white piano key
%%#(define black-key-width 15) %% the width of a black piano key
%%#(define black-key-height 95) %% the height of a black piano key
#(define white-key-height (* (/ white-key-width 23.5) 150))
#(define black-key-width (/ white-key-height 10)) %% the width of a black piano key
#(define black-key-height (* (/ white-key-width 23.5) 95)) %% the height of a black piano key
#(define black-key-y-start (- white-key-height black-key-height)) %% the y-coordinate of black keys
%% left coordinate of black keys cis/des fis/ges
%% n=0 oder n=3 (index number of global default scale)
#(define black-key-cis-start (* (/ white-key-width 23.5) 13))
%% left coordinate of centered black keys gis/as
%% n=4 (index number of global default scale)
#(define black-key-gis-start (* (/ white-key-width 23.5) 16))
%% left coordinate of right black keys dis/es ais/b
%% n=1 oder n=5 (index number of global default scale)
#(define black-key-dis-start (* (/ white-key-width 23.5) 19))
#(define octav-distance (* 7 white-key-width))
%% define circle diameter for the dots
%% just try what looks fine
#(define kreis-dm (* black-key-width 0.5)) %% circle diameter
%% create complete pitchlist for a specific octave
#(define (pitch-list o)
;(display o)(newline)
(list
(ly:make-pitch o 0 0) ; c
(ly:make-pitch o 0 SHARP) ; cis
;(ly:make-pitch o 1 FLAT) ; des
(ly:make-pitch o 1 0) ; d
(ly:make-pitch o 1 SHARP) ; dis
;(ly:make-pitch o 2 FLAT) ; es
(ly:make-pitch o 2 0) ; e
(ly:make-pitch o 3 0) ; f
(ly:make-pitch o 3 SHARP) ; fis
;(ly:make-pitch o 4 FLAT) ; ges
(ly:make-pitch o 4 0) ; g
(ly:make-pitch o 4 SHARP) ; gis
;(ly:make-pitch o 5 FLAT) ; as
(ly:make-pitch o 5 0) ; a
(ly:make-pitch o 5 SHARP) ; ais
;(ly:make-pitch o 6 FLAT) ; b
(ly:make-pitch o 6 0) ; h
))
%% all pitches that occor on a keyboard as a list
#(define all-pitches
(append-map (lambda (o) (pitch-list o))
(iota 8 -4)))
%% add all octaves to one pitch
#(define (all-octaves p)
;(display "all-octaves p: ") (display p)(newline)
(map (lambda (o) (ly:make-pitch o (ly:pitch-notename p) (ly:pitch-alteration p)))
(iota 8 -4)))
#(define (white-key? p)
(let
((a (ly:pitch-alteration (naturalize-pitch p))))
(if (= a 0)
#t
#f)))
#(define (black-key? p)
(not (white-key? p)))
%% removes all pitches without alteration, leaves only black keys
#(define (bl-filter p-list)
(remove white-key? p-list))
#(define (pitches-in-interval p1 p2)
;; returns a pitchlist of all pitches
;; between p1 and p2
(filter
(lambda (p) (pitch-between? p p1 p2))
all-pitches))
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% stencil functions
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%calculation the starting point of a key
#(define (start-point-key p)
;; calculation the starting point of a key
;; depending on the pitch p
;; result is a pair of coordinates (x . y)
(let*
((m (naturalize-pitch p))
(o (ly:pitch-octave m))
(a (ly:pitch-alteration m))
;; we must naturalize pitch otherwise wrong result for eis e.g.
;; we subtract the alteration from the notename and add a half
;; so we end up at the same note despite flat oder sharp
;; cis is drawn the same as des e.g.
(n (ly:pitch-notename m))
(n1 (+ n a -0.5))
(x-shift (* o 7 white-key-width))
)
(cond
((eq? a 0)
;; alteration eq 0
;; no alteration ==> white key
(cons (+ (* n white-key-width) x-shift) 0 ))
((or (= n1 0) (= n1 3))
;; "left" black keys cis/des and fis/ges
;; notename=0 or 3 and alteration
;; n=0 oder n=3
(cons (+ (* n1 white-key-width) black-key-cis-start x-shift ) black-key-y-start ))
((or (= n1 1) (= n1 5))
;; "right" black keys dis/es and ais/b
;; notename=0 or 3 and alteration
;, n=1 oder n=5
(cons (+ (* n1 white-key-width) black-key-dis-start x-shift ) black-key-y-start ))
(else
;; only one left, the centered black key gis/as
(cons (+ (* n1 white-key-width) black-key-gis-start x-shift) black-key-y-start )))))
%% alist for key coordinates of all pitches
%% the key is the pitch
#(define coord-pitches
(map (lambda (x) (cons x (start-point-key x))) all-pitches))
#(define (x-koord p)
;; retrieving x-coordinate of pitch p
(car (assoc-get (standardize-pitch p) coord-pitches)))
#(define (y-koord p)
;; retrieving y-coordinate of pitch p
(cdr (assoc-get (standardize-pitch p) coord-pitches)))
#(define (draw-key p xshift w-color b-bolor)
;; draws either a white key or a black key
;; the distance from origin depends on the pitch
;; you may shift the key
;; w-color: Farbe der weißen Tasten
;; b-color: Farbe der schwarzen Tasten
(let*
((p1 (naturalize-pitch p))
(wh-key (ly:stencil-add
(ly:stencil-in-color
(make-connected-path-stencil
;; wir zeichnen einfach ein Quadrat
;; das mit Höhe und Breite verformt wird
'((0 0) (1 0) (1 1) (0 1))
0.1 ;; thickness
white-key-width
white-key-height
#t ;; close path
#t ;; fill path
)
(first w-color) (second w-color) (third w-color))
(make-connected-path-stencil
;; die Umrahmung zeichnen
'((0 0) (1 0) (1 1) (0 1))
0.1 ;; thickness
white-key-width
white-key-height
#t ;; close path
#f ;; do not fill path
)))
(bl-key (ly:stencil-in-color
(make-connected-path-stencil
'((0 0) (1 0) (1 1) (0 1) )
0.5
black-key-width black-key-height
#t ;; close path
#t ;; fill path
)
(first b-bolor) (second b-bolor) (third b-bolor) ))
(x-start (- (x-koord p1) xshift)))
(if (white-key? p)
(begin
(ly:stencil-translate-axis wh-key x-start X)
;(write-me "wh-key------------------------------- " wh-key)
;(write-me "x-start------------------------------- " x-start)
;(write-me "X------------------------------- " X)
)
(ly:stencil-translate bl-key (cons x-start (y-koord p1)))
)))
%% einen Punkt erzeugen
%% w-color wird auf die weißen Tasten gezeichnet
%% es empfiehlt sich, eine Kontrastfarbe zu wählen
#(define (draw-dot p xshift w-color b-color)
(let ((x-start (- (x-koord p) xshift))
(y-start (y-koord p)))
(if (white-key? p) ;; Punkt für eine weiße Taste erzeugen
(ly:stencil-in-color
(ly:stencil-translate
(make-circle-stencil kreis-dm 0 #t)
(cons
(+ x-start (/ white-key-width 2))
(+ y-start (/ (- white-key-height black-key-height) 1.5))))
(first w-color) (second w-color) (third w-color))
(ly:stencil-in-color ;; Punkt für eine schwarze Taste erzeugen
(ly:stencil-translate
(make-circle-stencil kreis-dm 0 #t)
(cons
(+ x-start (/ black-key-width 2 ))
(+ y-start (/ black-key-height 5))))
(first b-color) (second b-color) (third b-color))
)))
#(define (draw-keyboard p1 p2 music w-color b-color w-mus-color b-mus-color)
;; wir zeichnen eine Tastatur von p1-p2
;; die Tasten, die in music enthalten sind, werden in den Farben w-mus-color b-mus-color gefärbt
;; es wird außerdem überprüft, ob die Musik komplett innerhalb des Bereiches liegt
;, wenn nicht, wird das Zeichenintervall ausgedehnt
;; zeichnet die Tastatur von p1 nach p2
;; music sollte Musik enthalten
;; zunächst wird die Grundlage gezeichnet
;; die weißen und die schwarzen Tasten
;; Farbe w-key-color und
(let*
((l-p (low-pitch music)) ;; lowest pitch of music
(u-p (high-pitch music)) ;; highest pitch of music
(lowp (if (ly:pitch<? l-p p1) l-p p1)) ;; leftmost key of keyboard
(upp (if (ly:pitch<? p2 u-p) u-p p2)) ;; rightmost key of keyboard
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
(mu-pi (all-pitches-from-music music)) ;; pitchlist from music
(mu-pi-single (sort (delete-duplicates mu-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(display "music list: ")(display mu-pi) (newline)
;(write-me "start-low-x------------------------------- " start-low-x)
(ly:stencil-add
;; drawing all keys in the range pi-int
;; zuerst alle Tasten der Grundlage zeichnen
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; die weißen Tasten der überlagerten Musik zeichnen
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
( remove black-key? mu-pi-single)))
;; nochmals die schwazren Tasten über alles zeichnen
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; zum Schluss die schwarzen Tasten der Überlagerten Musik
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
(bl-filter mu-pi-single))))))
#(define (expand-music music)
;; expand music to all pitches between p1 and p2
;; we remove all duplicates and sort the output
(sort
(delete-duplicates
(append-map
(lambda (o) (all-octaves (standardize-pitch o)))
(all-pitches-from-music music))) ly:pitch<?))
#(define (expand-music-between music p1 p2)
;; expand music to all pitches between p1 and p2
;; we remove all duplicates and sort the output
(let ((mypitches (expand-music music)))
(filter (lambda (o) (pitch-between? o p1 p2))
mypitches)))
#(define (draw-dotted-keyboard p1 p2 music the-chord w-color b-color w-mus-color b-mus-color)
;; damit kann man z.B. leitereigene Dreiklänge illustrieren
;; Grenzenüberprüfung wie in der vorigen Prozedur
(let*
((l-p (low-pitch music)) ;; lowest pitch of music
(u-p (high-pitch music)) ;; highest pitch of music
(u-c (high-pitch the-chord)) ;; highest pitch of chord
(l-c (low-pitch the-chord)) ;;lowest pitch of chord
(pu (if (ly:pitch<? u-p u-c) u-c u-p)) ;; highest pitch of chord/music
(pl (if (ly:pitch<? l-p l-c) l-p l-c)) ;; highest pitch of chord/music
(lowp (if (ly:pitch<? l-c p1) l-c p1)) ;; leftmost key of keyboard
(upp1 (if (ly:pitch<? p2 u-c) u-c p2)) ;; rightmost key of keyboard
(upp (if (and (= (ly:pitch-notename upp1) 0) (<= (ly:pitch-alteration upp1) 0))
upp1
(ly:make-pitch (+ (ly:pitch-octave upp1) 1) 0 0)))
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
(mu-pi (expand-music-between music lowp upp)) ;; pitchlist from music
(chord-pi (all-pitches-from-music the-chord)) ;; all pitches from the chord
(chord-pi-single (sort (delete-duplicates chord-pi) ly:pitch<?)) ;; sorted without doubles
(mu-pi-single (sort (delete-duplicates mu-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(write-me "high pitch------------------------------- " upp)
;(write-me "high pitch chord ----------------------- " u-c)
(ly:stencil-add
;; drawing all keys in the range pi-int
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; drawing colored keys of music
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
mu-pi-single))
;; drawing black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; drawing colored black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
(bl-filter mu-pi-single)))
;; drawing the dots at last
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-dot p start-low-x b-color w-color))
chord-pi-single))
)))
#(define (music-elts x)
(if (not (ly:music? x))
'()
(ly:music-property x 'elements)))
#(define (music-name x)
(if (not (ly:music? x))
#f
(ly:music-property x 'name)))
#(define (list-all-chords-from-music music)
;; each element of the list is ly:music
(reverse!
(let loop ((music music) (pitches '()))
(let ((p (music-name music)))
(if (eq? p 'EventChord)
(cons music pitches)
(let ((elt (ly:music-property music 'element)))
(fold loop
(if (ly:music? elt)
(loop elt pitches)
pitches)
(music-elts music))))))))
#(define (draw-dotted-chords p1 p2 the-chord w-color b-color w-c-color b-c-color)
;; chose the interval the keyboard should span
;; at least music must be contained
;; das Keyboard muss wenigstens die angegebenen Akkordnoten fassen
;; unabhängig von den eingegebenen Grenzen
;; wir starten eine unabhängige Vergleichskette
;; der tiefste Ton des Akkords wird mit dem angegebenen Grenzwert
;; verglichen und ersetzt ihn ggfs
;, grundsätzbrauchen wird die Grenzangaben nicht
;; wegen vermehrter Flexibilität
(let*
(
(u-c (high-pitch the-chord)) ;; highest pitch of chord
(l-c (low-pitch the-chord)) ;;lowest pitch of chord
(pu (if (ly:pitch<? p2 u-c) u-c p2)) ;; highest pitch of chord/music
(pl (if (ly:pitch<? p1 l-c) p1 l-c)) ;; highest pitch of chord/music
(lowp (if (ly:pitch<? l-c p1) l-c p1)) ;; leftmost key of keyboard
(upp1 (if (ly:pitch<? p2 u-c) u-c p2)) ;; rightmost key of keyboard
(upp (if (and (= (ly:pitch-notename upp1) 0) (<= (ly:pitch-alteration upp1) 0))
upp1
(ly:make-pitch (+ (ly:pitch-octave upp1) 1) 0 0)))
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
;(mu-pi (expand-music-between music lowp upp)) ;; pitchlist from music
(chord-pi (all-pitches-from-music the-chord)) ;; all pitches from the chord
(chord-pi-single (sort (delete-duplicates chord-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(display "lowpitch ")(display lowp)(newline)
;(display "the chord ") (display the-chord) (newline)
;(display "hight pitch ")(display upp)(newline)
;(display "chord-pi ")(display chord-pi)(newline)
;(display "chord-pi-single ")(display chord-pi-single)(newline)
;(display "all pitches ")(display pi-int)(newline)
;(write-me "high pitch------------------------------- " upp)
;(write-me "high pitch chord ----------------------- " u-c)
(ly:stencil-add
;; drawing all keys in the range pi-int
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; drawing black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; drawing the dots at last
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-dot p start-low-x w-c-color b-c-color))
chord-pi-single))
)))
#(define (draw-dotted-chordx p1 p2 the-chord w-color b-color)
;; chose the interval the keyboard should span
;; at least music must be contained
;; das Keyboard muss wenigstens die angegebenen Akkordnoten fassen
;; unabhängig von den eingegebenen Grenzen
;; wir starten eine unabhängige Vergleichskette
;; der tiefste Ton des Akkords wird mit dem angegebenen Grenzwert
;; verglichen und ersetzt ihn ggfs
;, grundsätzbrauchen wird die Grenzangaben nicht
;; wegen vermehrter Flexibilität
(let*
(
(u-c (high-pitch the-chord)) ;; highest pitch of chord
(l-c (low-pitch the-chord)) ;;lowest pitch of chord
(pu (if (ly:pitch<? p2 u-c) u-c p2)) ;; highest pitch of chord/music
(pl (if (ly:pitch<? p1 l-c) p1 l-c)) ;; highest pitch of chord/music
(lowp (if (ly:pitch<? l-c p1) l-c p1)) ;; leftmost key of keyboard
(upp1 (if (ly:pitch<? p2 u-c) u-c p2)) ;; rightmost key of keyboard
(upp (if (and (= (ly:pitch-notename upp1) 0) (<= (ly:pitch-alteration upp1) 0))
upp1
(ly:make-pitch (+ (ly:pitch-octave upp1) 1) 0 0)))
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
;(mu-pi (expand-music-between music lowp upp)) ;; pitchlist from music
(chord-pi (all-pitches-from-music the-chord)) ;; all pitches from the chord
(chord-pi-single (sort (delete-duplicates chord-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(display "lowpitch ")(display lowp)(newline)
;(display "the chord ") (display the-chord) (newline)
;(display "hight pitch ")(display upp)(newline)
;(display "chord-pi ")(display chord-pi)(newline)
;(display "chord-pi-single ")(display chord-pi-single)(newline)
;(display "all pitches ")(display pi-int)(newline)
;(write-me "high pitch------------------------------- " upp)
;(write-me "high pitch chord ----------------------- " u-c)
(ly:stencil-add
;; drawing all keys in the range pi-int
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; drawing black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; drawing the dots at last
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-dot p start-low-x b-color w-color))
chord-pi-single))
)))
#(define-markup-command
(keyboard-with-chords layout props p1 p2 scale-factor the-chord)
(ly:pitch? ly:pitch? number? ly:music?)
(ly:stencil-scale
(draw-dotted-chords p1 p2 the-chord (x11-color 'ivory) (x11-color 'blue4) (x11-color 'blue4) (x11-color 'ivory))
scale-factor scale-factor))
#(define-markup-command
(keyboard-with-chordx layout props p1 p2 scale-factor the-chord)
(ly:pitch? ly:pitch? number? ly:music?)
(ly:stencil-scale
(draw-dotted-chordx p1 p2 the-chord (x11-color 'ivory) (x11-color 'blue4))
scale-factor scale-factor))
ChordKeyboard=
#(define-music-function
(the-low the-high the-factor the-chord)
(ly:pitch? ly:pitch? number? ly:music?)
#{ <>^\markup \keyboard-with-chordx
#the-low #the-high #the-factor #the-chord
$the-chord
#})
MapChords=
#(define-music-function
;; make-sequential-music macht aus Liste von Musikausdrücken
;; Musik
(the-low the-high the-factor the-chordlist)
(ly:pitch? ly:pitch? number? ly:music?)
;(display the-chordlist)
(make-sequential-music
(map
(lambda (m)
#{
\ChordKeyboard #the-low #the-high #the-factor $m
#})
(list-all-chords-from-music the-chordlist))))
#(define-markup-list-command (my-markuplist layout props args) (ly:music?)
(interpret-markup-list layout props
(map
(lambda (chord)
(make-my-chord-symbol-markup chord)
)
(extract-named-music args 'EventChord))))
#(define-markup-list-command (more-markuplist layout props mus p)
(ly:music? ly:pitch?)
(interpret-markup-list layout props
#{
\markuplist
\override #'(baseline-skip . 20)
\override #'(padding . 1.5)
\table
#'(1 1)
\my-markuplist ##{ \transpose c $p $mus #}
#}))
#(define (pitches->chord plist)
(make-music 'EventChord 'elements
(if (list? plist)
(map (lambda (p)
(make-music
'NoteEvent 'duration (ly:make-duration 0)
'pitch p))
plist)
(make-music
'NoteEvent 'duration (ly:make-duration 0)
'pitch plist)
)))
#(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
#(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
%% Notenname als Markup mit deutschen Notennamen
#(define (note-name->my-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
;(make-simple-markup
(list
(string-append
(conditional-string-downcase
(list-ref '("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?)
(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 (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
#(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
%% Notenname als Markup mit deutschen Notennamen
#(define (note-name->my-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
;(make-simple-markup
(list
(string-append
(conditional-string-downcase
(list-ref '("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?)
(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-markup-command (my-titel layout props p)
(ly:pitch?)
(interpret-markup layout props
#{
\markup
\fill-line {
\null
\center-column {
\abs-fontsize #144
\with-color #(x11-color 'LavenderBlush)
{ \musicglyph "clefs.GG" }
\vspace #-20
\with-color #(x11-color 'goldenrod)
\abs-fontsize #100 \bold \caps
{
"Jazz" " "
"Akkorde"
" " " "
"auf"
}
" "
\with-color #(x11-color 'firebrick)
\abs-fontsize #300
\override #'(font-name . "ArnoldBoeD") #(note-name->my-markup p #f)
}
\null
}
#}))
\version "2.22.0"
\language "deutsch"
#(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
#(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
%% Notenname als Markup mit deutschen Notennamen
#(define (note-name->my-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
;(make-simple-markup
(list
(string-append
(conditional-string-downcase
(list-ref '("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?)
(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 (naturalize-pitch p)
;; reduces alteration greater than a half tone step
;; #(display (naturalize-pitch #{ fes #}))
;; #<Pitch e >
(let ((o (ly:pitch-octave p))
(a (* 4 (ly:pitch-alteration p)))
;; alteration, a, in quarter tone steps,
;; for historical reasons
(n (ly:pitch-notename p)))
(cond
((and (> a 1)
(or (eq? n 6)
(eq? n 2)))
(set! a (- a 2))
(set! n (+ n 1)))
((and (< a -1)
(or (eq? n 0) (eq? n 3)))
(set! a (+ a 2))
(set! n (- n 1))))
(cond
((> a 2) (set! a (- a 4)) (set! n (+ n 1)))
((< a -2) (set! a (+ a 4)) (set! n (- n 1))))
(ly:make-pitch o n (/ a 4))))
#(define (all-pitches-from-music music)
"Return a list of all pitches from @var{music}."
;; Opencoded for efficiency.
(reverse!
(let loop ((music music) (pitches '()))
(let ((p (ly:music-property music 'pitch)))
(if (ly:pitch? p)
(cons (naturalize-pitch p) pitches)
(let ((elt (ly:music-property music 'element)))
(fold loop
(if (ly:music? elt)
(loop elt pitches)
pitches)
(ly:music-property music 'elements))))))))
#(define (low-pitch music)
;; returns the lowest pitch from music
(car (sort (all-pitches-from-music music) ly:pitch<?)))
%%
#(define (high-pitch music)
;; returns the highest pitch from music
(car (reverse (sort (all-pitches-from-music music) ly:pitch<?))))
#(define (pitch-between? p p1 p2)
(and (not (ly:pitch<? p p1)) (not (ly:pitch<? p2 p))))
#(define (pitch-equals? p1 p2)
;(write-me "pitch-equals? ----------------------------> " (list p1 p2))
(and
(= (ly:pitch-alteration p1) (ly:pitch-alteration p2))
(= (ly:pitch-notename p1) (ly:pitch-notename p2))))
#(define (standardize-pitch p)
;; make pitches with SHARPs or no alteration
;; standardize-pitch c ==> c
;; standardize-pitch cis ==> cis
;; standardize-pitch des ==> cis
(let* ((p1 (naturalize-pitch p))
(a (ly:pitch-alteration p1))
(n (ly:pitch-notename p1))
(o (ly:pitch-octave p1))
(a1 (- a 0.5))
(n1 (inexact->exact (+ n a1))))
;procedure body
(if (= a 0)
p1
(ly:make-pitch o n1 SHARP))))
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% pitchlist functions and creating a complete pitchlist for keyboard
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% definitions for the measures of the keyboard keys
#(define white-key-width 23.5) %% the width of a white piano key
%%#(define white-key-height 150) %% the height of a white piano key
%%#(define black-key-width 15) %% the width of a black piano key
%%#(define black-key-height 95) %% the height of a black piano key
#(define white-key-height (* (/ white-key-width 23.5) 150))
#(define black-key-width (/ white-key-height 10)) %% the width of a black piano key
#(define black-key-height (* (/ white-key-width 23.5) 95)) %% the height of a black piano key
#(define black-key-y-start (- white-key-height black-key-height)) %% the y-coordinate of black keys
%% left coordinate of black keys cis/des fis/ges
%% n=0 oder n=3 (index number of global default scale)
#(define black-key-cis-start (* (/ white-key-width 23.5) 13))
%% left coordinate of centered black keys gis/as
%% n=4 (index number of global default scale)
#(define black-key-gis-start (* (/ white-key-width 23.5) 16))
%% left coordinate of right black keys dis/es ais/b
%% n=1 oder n=5 (index number of global default scale)
#(define black-key-dis-start (* (/ white-key-width 23.5) 19))
#(define octav-distance (* 7 white-key-width))
%% define circle diameter for the dots
%% just try what looks fine
#(define kreis-dm (* black-key-width 0.5)) %% circle diameter
%% create complete pitchlist for a specific octave
#(define (pitch-list o)
;(display o)(newline)
(list
(ly:make-pitch o 0 0) ; c
(ly:make-pitch o 0 SHARP) ; cis
;(ly:make-pitch o 1 FLAT) ; des
(ly:make-pitch o 1 0) ; d
(ly:make-pitch o 1 SHARP) ; dis
;(ly:make-pitch o 2 FLAT) ; es
(ly:make-pitch o 2 0) ; e
(ly:make-pitch o 3 0) ; f
(ly:make-pitch o 3 SHARP) ; fis
;(ly:make-pitch o 4 FLAT) ; ges
(ly:make-pitch o 4 0) ; g
(ly:make-pitch o 4 SHARP) ; gis
;(ly:make-pitch o 5 FLAT) ; as
(ly:make-pitch o 5 0) ; a
(ly:make-pitch o 5 SHARP) ; ais
;(ly:make-pitch o 6 FLAT) ; b
(ly:make-pitch o 6 0) ; h
))
%% all pitches that occor on a keyboard as a list
#(define all-pitches
(append-map (lambda (o) (pitch-list o))
(iota 8 -4)))
%% add all octaves to one pitch
#(define (all-octaves p)
;(display "all-octaves p: ") (display p)(newline)
(map (lambda (o) (ly:make-pitch o (ly:pitch-notename p) (ly:pitch-alteration p)))
(iota 8 -4)))
#(define (white-key? p)
(let
((a (ly:pitch-alteration (naturalize-pitch p))))
(if (= a 0)
#t
#f)))
#(define (black-key? p)
(not (white-key? p)))
%% removes all pitches without alteration, leaves only black keys
#(define (bl-filter p-list)
(remove white-key? p-list))
#(define (pitches-in-interval p1 p2)
;; returns a pitchlist of all pitches
;; between p1 and p2
(filter
(lambda (p) (pitch-between? p p1 p2))
all-pitches))
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% stencil functions
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%calculation the starting point of a key
#(define (start-point-key p)
;; calculation the starting point of a key
;; depending on the pitch p
;; result is a pair of coordinates (x . y)
(let*
((m (naturalize-pitch p))
(o (ly:pitch-octave m))
(a (ly:pitch-alteration m))
;; we must naturalize pitch otherwise wrong result for eis e.g.
;; we subtract the alteration from the notename and add a half
;; so we end up at the same note despite flat oder sharp
;; cis is drawn the same as des e.g.
(n (ly:pitch-notename m))
(n1 (+ n a -0.5))
(x-shift (* o 7 white-key-width))
)
(cond
((eq? a 0)
;; alteration eq 0
;; no alteration ==> white key
(cons (+ (* n white-key-width) x-shift) 0 ))
((or (= n1 0) (= n1 3))
;; "left" black keys cis/des and fis/ges
;; notename=0 or 3 and alteration
;; n=0 oder n=3
(cons (+ (* n1 white-key-width) black-key-cis-start x-shift ) black-key-y-start ))
((or (= n1 1) (= n1 5))
;; "right" black keys dis/es and ais/b
;; notename=0 or 3 and alteration
;, n=1 oder n=5
(cons (+ (* n1 white-key-width) black-key-dis-start x-shift ) black-key-y-start ))
(else
;; only one left, the centered black key gis/as
(cons (+ (* n1 white-key-width) black-key-gis-start x-shift) black-key-y-start )))))
%% alist for key coordinates of all pitches
%% the key is the pitch
#(define coord-pitches
(map (lambda (x) (cons x (start-point-key x))) all-pitches))
#(define (x-koord p)
;; retrieving x-coordinate of pitch p
(car (assoc-get (standardize-pitch p) coord-pitches)))
#(define (y-koord p)
;; retrieving y-coordinate of pitch p
(cdr (assoc-get (standardize-pitch p) coord-pitches)))
#(define (draw-key p xshift w-color b-bolor)
;; draws either a white key or a black key
;; the distance from origin depends on the pitch
;; you may shift the key
;; w-color: Farbe der weißen Tasten
;; b-color: Farbe der schwarzen Tasten
(let*
((p1 (naturalize-pitch p))
(wh-key (ly:stencil-add
(ly:stencil-in-color
(make-connected-path-stencil
;; wir zeichnen einfach ein Quadrat
;; das mit Höhe und Breite verformt wird
'((0 0) (1 0) (1 1) (0 1))
0.1 ;; thickness
white-key-width
white-key-height
#t ;; close path
#t ;; fill path
)
(first w-color) (second w-color) (third w-color))
(make-connected-path-stencil
;; die Umrahmung zeichnen
'((0 0) (1 0) (1 1) (0 1))
0.1 ;; thickness
white-key-width
white-key-height
#t ;; close path
#f ;; do not fill path
)))
(bl-key (ly:stencil-in-color
(make-connected-path-stencil
'((0 0) (1 0) (1 1) (0 1) )
0.5
black-key-width black-key-height
#t ;; close path
#t ;; fill path
)
(first b-bolor) (second b-bolor) (third b-bolor) ))
(x-start (- (x-koord p1) xshift)))
(if (white-key? p)
(begin
(ly:stencil-translate-axis wh-key x-start X)
;(write-me "wh-key------------------------------- " wh-key)
;(write-me "x-start------------------------------- " x-start)
;(write-me "X------------------------------- " X)
)
(ly:stencil-translate bl-key (cons x-start (y-koord p1)))
)))
%% einen Punkt erzeugen
%% w-color wird auf die weißen Tasten gezeichnet
%% es empfiehlt sich, eine Kontrastfarbe zu wählen
#(define (draw-dot p xshift w-color b-color)
(let ((x-start (- (x-koord p) xshift))
(y-start (y-koord p)))
(if (white-key? p) ;; Punkt für eine weiße Taste erzeugen
(ly:stencil-in-color
(ly:stencil-translate
(make-circle-stencil kreis-dm 0 #t)
(cons
(+ x-start (/ white-key-width 2))
(+ y-start (/ (- white-key-height black-key-height) 1.5))))
(first w-color) (second w-color) (third w-color))
(ly:stencil-in-color ;; Punkt für eine schwarze Taste erzeugen
(ly:stencil-translate
(make-circle-stencil kreis-dm 0 #t)
(cons
(+ x-start (/ black-key-width 2 ))
(+ y-start (/ black-key-height 5))))
(first b-color) (second b-color) (third b-color))
)))
#(define (draw-keyboard p1 p2 music w-color b-color w-mus-color b-mus-color)
;; wir zeichnen eine Tastatur von p1-p2
;; die Tasten, die in music enthalten sind, werden in den Farben w-mus-color b-mus-color gefärbt
;; es wird außerdem überprüft, ob die Musik komplett innerhalb des Bereiches liegt
;, wenn nicht, wird das Zeichenintervall ausgedehnt
;; zeichnet die Tastatur von p1 nach p2
;; music sollte Musik enthalten
;; zunächst wird die Grundlage gezeichnet
;; die weißen und die schwarzen Tasten
;; Farbe w-key-color und
(let*
((l-p (low-pitch music)) ;; lowest pitch of music
(u-p (high-pitch music)) ;; highest pitch of music
(lowp (if (ly:pitch<? l-p p1) l-p p1)) ;; leftmost key of keyboard
(upp (if (ly:pitch<? p2 u-p) u-p p2)) ;; rightmost key of keyboard
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
(mu-pi (all-pitches-from-music music)) ;; pitchlist from music
(mu-pi-single (sort (delete-duplicates mu-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(display "music list: ")(display mu-pi) (newline)
;(write-me "start-low-x------------------------------- " start-low-x)
(ly:stencil-add
;; drawing all keys in the range pi-int
;; zuerst alle Tasten der Grundlage zeichnen
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; die weißen Tasten der überlagerten Musik zeichnen
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
( remove black-key? mu-pi-single)))
;; nochmals die schwazren Tasten über alles zeichnen
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; zum Schluss die schwarzen Tasten der Überlagerten Musik
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
(bl-filter mu-pi-single))))))
#(define (expand-music music)
;; expand music to all pitches between p1 and p2
;; we remove all duplicates and sort the output
(sort
(delete-duplicates
(append-map
(lambda (o) (all-octaves (standardize-pitch o)))
(all-pitches-from-music music))) ly:pitch<?))
#(define (expand-music-between music p1 p2)
;; expand music to all pitches between p1 and p2
;; we remove all duplicates and sort the output
(let ((mypitches (expand-music music)))
(filter (lambda (o) (pitch-between? o p1 p2))
mypitches)))
#(define (draw-dotted-keyboard p1 p2 music the-chord w-color b-color w-mus-color b-mus-color)
;; damit kann man z.B. leitereigene Dreiklänge illustrieren
;; Grenzenüberprüfung wie in der vorigen Prozedur
(let*
((l-p (low-pitch music)) ;; lowest pitch of music
(u-p (high-pitch music)) ;; highest pitch of music
(u-c (high-pitch the-chord)) ;; highest pitch of chord
(l-c (low-pitch the-chord)) ;;lowest pitch of chord
(pu (if (ly:pitch<? u-p u-c) u-c u-p)) ;; highest pitch of chord/music
(pl (if (ly:pitch<? l-p l-c) l-p l-c)) ;; highest pitch of chord/music
(lowp (if (ly:pitch<? l-c p1) l-c p1)) ;; leftmost key of keyboard
(upp1 (if (ly:pitch<? p2 u-c) u-c p2)) ;; rightmost key of keyboard
(upp (if (and (= (ly:pitch-notename upp1) 0) (<= (ly:pitch-alteration upp1) 0))
upp1
(ly:make-pitch (+ (ly:pitch-octave upp1) 1) 0 0)))
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
(mu-pi (expand-music-between music lowp upp)) ;; pitchlist from music
(chord-pi (all-pitches-from-music the-chord)) ;; all pitches from the chord
(chord-pi-single (sort (delete-duplicates chord-pi) ly:pitch<?)) ;; sorted without doubles
(mu-pi-single (sort (delete-duplicates mu-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(write-me "high pitch------------------------------- " upp)
;(write-me "high pitch chord ----------------------- " u-c)
(ly:stencil-add
;; drawing all keys in the range pi-int
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; drawing colored keys of music
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
mu-pi-single))
;; drawing black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; drawing colored black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-mus-color b-mus-color))
(bl-filter mu-pi-single)))
;; drawing the dots at last
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-dot p start-low-x b-color w-color))
chord-pi-single))
)))
#(define (music-elts x)
(if (not (ly:music? x))
'()
(ly:music-property x 'elements)))
#(define (music-name x)
(if (not (ly:music? x))
#f
(ly:music-property x 'name)))
#(define (list-all-chords-from-music music)
;; each element of the list is ly:music
(reverse!
(let loop ((music music) (pitches '()))
(let ((p (music-name music)))
(if (eq? p 'EventChord)
(cons music pitches)
(let ((elt (ly:music-property music 'element)))
(fold loop
(if (ly:music? elt)
(loop elt pitches)
pitches)
(music-elts music))))))))
#(define (draw-dotted-chords p1 p2 the-chord w-color b-color w-c-color b-c-color)
;; chose the interval the keyboard should span
;; at least music must be contained
;; das Keyboard muss wenigstens die angegebenen Akkordnoten fassen
;; unabhängig von den eingegebenen Grenzen
;; wir starten eine unabhängige Vergleichskette
;; der tiefste Ton des Akkords wird mit dem angegebenen Grenzwert
;; verglichen und ersetzt ihn ggfs
;, grundsätzbrauchen wird die Grenzangaben nicht
;; wegen vermehrter Flexibilität
(let*
(
(u-c (high-pitch the-chord)) ;; highest pitch of chord
(l-c (low-pitch the-chord)) ;;lowest pitch of chord
(pu (if (ly:pitch<? p2 u-c) u-c p2)) ;; highest pitch of chord/music
(pl (if (ly:pitch<? p1 l-c) p1 l-c)) ;; highest pitch of chord/music
(lowp (if (ly:pitch<? l-c p1) l-c p1)) ;; leftmost key of keyboard
(upp1 (if (ly:pitch<? p2 u-c) u-c p2)) ;; rightmost key of keyboard
(upp (if (and (= (ly:pitch-notename upp1) 0) (<= (ly:pitch-alteration upp1) 0))
upp1
(ly:make-pitch (+ (ly:pitch-octave upp1) 1) 0 0)))
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
;(mu-pi (expand-music-between music lowp upp)) ;; pitchlist from music
(chord-pi (all-pitches-from-music the-chord)) ;; all pitches from the chord
(chord-pi-single (sort (delete-duplicates chord-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(display "lowpitch ")(display lowp)(newline)
;(display "the chord ") (display the-chord) (newline)
;(display "hight pitch ")(display upp)(newline)
;(display "chord-pi ")(display chord-pi)(newline)
;(display "chord-pi-single ")(display chord-pi-single)(newline)
;(display "all pitches ")(display pi-int)(newline)
;(write-me "high pitch------------------------------- " upp)
;(write-me "high pitch chord ----------------------- " u-c)
(ly:stencil-add
;; drawing all keys in the range pi-int
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; drawing black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; drawing the dots at last
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-dot p start-low-x w-c-color b-c-color))
chord-pi-single))
)))
#(define (draw-dotted-chordx p1 p2 the-chord w-color b-color)
;; chose the interval the keyboard should span
;; at least music must be contained
;; das Keyboard muss wenigstens die angegebenen Akkordnoten fassen
;; unabhängig von den eingegebenen Grenzen
;; wir starten eine unabhängige Vergleichskette
;; der tiefste Ton des Akkords wird mit dem angegebenen Grenzwert
;; verglichen und ersetzt ihn ggfs
;, grundsätzbrauchen wird die Grenzangaben nicht
;; wegen vermehrter Flexibilität
(let*
(
(u-c (high-pitch the-chord)) ;; highest pitch of chord
(l-c (low-pitch the-chord)) ;;lowest pitch of chord
(pu (if (ly:pitch<? p2 u-c) u-c p2)) ;; highest pitch of chord/music
(pl (if (ly:pitch<? p1 l-c) p1 l-c)) ;; highest pitch of chord/music
(lowp (if (ly:pitch<? l-c p1) l-c p1)) ;; leftmost key of keyboard
(upp1 (if (ly:pitch<? p2 u-c) u-c p2)) ;; rightmost key of keyboard
(upp (if (and (= (ly:pitch-notename upp1) 0) (<= (ly:pitch-alteration upp1) 0))
upp1
(ly:make-pitch (+ (ly:pitch-octave upp1) 1) 0 0)))
(start-low-x (x-koord lowp)) ;; we shift the whole stencil
(pi-int (pitches-in-interval lowp upp)) ;; interval of pitches of the keyboard
;(mu-pi (expand-music-between music lowp upp)) ;; pitchlist from music
(chord-pi (all-pitches-from-music the-chord)) ;; all pitches from the chord
(chord-pi-single (sort (delete-duplicates chord-pi) ly:pitch<?)) ;; sorted without doubles
)
;; procedure body
;(display "lowpitch ")(display lowp)(newline)
;(display "the chord ") (display the-chord) (newline)
;(display "hight pitch ")(display upp)(newline)
;(display "chord-pi ")(display chord-pi)(newline)
;(display "chord-pi-single ")(display chord-pi-single)(newline)
;(display "all pitches ")(display pi-int)(newline)
;(write-me "high pitch------------------------------- " upp)
;(write-me "high pitch chord ----------------------- " u-c)
(ly:stencil-add
;; drawing all keys in the range pi-int
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
pi-int))
;; drawing black keys again
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-key p start-low-x w-color b-color))
(bl-filter pi-int)))
;; drawing the dots at last
(apply ly:stencil-add
empty-stencil
(map (lambda (p) (draw-dot p start-low-x b-color w-color))
chord-pi-single))
)))
#(define-markup-command
(keyboard-with-chords layout props p1 p2 scale-factor the-chord)
(ly:pitch? ly:pitch? number? ly:music?)
(ly:stencil-scale
(draw-dotted-chords p1 p2 the-chord (x11-color 'ivory) (x11-color 'blue4) (x11-color 'blue4) (x11-color 'ivory))
scale-factor scale-factor))
#(define-markup-command
(keyboard-with-chordx layout props p1 p2 scale-factor the-chord)
(ly:pitch? ly:pitch? number? ly:music?)
(ly:stencil-scale
(draw-dotted-chordx p1 p2 the-chord (x11-color 'ivory) (x11-color 'blue4))
scale-factor scale-factor))
ChordKeyboard=
#(define-music-function
(the-low the-high the-factor the-chord)
(ly:pitch? ly:pitch? number? ly:music?)
#{ <>^\markup \keyboard-with-chordx
#the-low #the-high #the-factor #the-chord
$the-chord
#})
MapChords=
#(define-music-function
;; make-sequential-music macht aus Liste von Musikausdrücken
;; Musik
(the-low the-high the-factor the-chordlist)
(ly:pitch? ly:pitch? number? ly:music?)
;(display the-chordlist)
(make-sequential-music
(map
(lambda (m)
#{
\ChordKeyboard #the-low #the-high #the-factor $m
#})
(list-all-chords-from-music the-chordlist))))
#(define-markup-list-command (my-markuplist layout props args) (ly:music?)
(interpret-markup-list layout props
(map
(lambda (chord)
(make-my-chord-symbol-markup chord)
)
(extract-named-music args 'EventChord))))
#(define-markup-list-command (more-markuplist layout props mus p)
(ly:music? ly:pitch?)
(interpret-markup-list layout props
#{
\markuplist
\override #'(baseline-skip . 20)
\override #'(padding . 1.5)
\table
#'(1 1)
\my-markuplist ##{ \transpose c $p $mus #}
#}))
#(define (pitches->chord plist)
(make-music 'EventChord 'elements
(if (list? plist)
(map (lambda (p)
(make-music
'NoteEvent 'duration (ly:make-duration 0)
'pitch p))
plist)
(make-music
'NoteEvent 'duration (ly:make-duration 0)
'pitch plist)
)))
#(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
#(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
%% Notenname als Markup mit deutschen Notennamen
#(define (note-name->my-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
;(make-simple-markup
(list
(string-append
(conditional-string-downcase
(list-ref '("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?)
(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-markup-command (my-chord-symbol layout props mus)
(ly:music?)
(interpret-markup layout props
#{
\markup \score {
\new Staff
\with {
instrumentName = \markup \score {
\new ChordNames $mus
}
}
{
\textLengthOff
\override Staff.BarLine.stencil = ##f
\ChordKeyboard c' c' #0.05 $mus \noBreak
\override Staff.Clef.font-size = #2 \bar "||"
}
\layout {
line-width = #70
}
}
#}))
\paper {
markup-markup-spacing.padding = #5
top-margin = #20
oddHeaderMarkup = ##f
evenHeaderMarkup = #oddHeaderMarkup
oddFooterMarkup = ##f %\markup \fill-line { \null "Jazz-Akkorde" \null }
evenFooterMarkup = #oddHeaderMarkup
ragged-right = ##t
ragged-last = ##t
ragged-bottom = ##t
ragged-last-bottom = ##t
annotate-spacing = ##f
}
myflat = \markup \fontsize #-1 \flat
mysharp = \markup \fontsize #-2 \sharp
chExceptionMusic = {
<c e g h>1-\markup { \fontsize #-6 " " "j" }
<c e g h d'>1-\markup { \fontsize #-6 " " "j" \super 9 }
<c e g h dis'>1-\markup { \fontsize #-6 " " "j" \super \vcenter { "7(" \mysharp "9)" } }
<c e g h d' a'>1-\markup { \fontsize #-6 " " "j" \super 13 }
<c e g b d' a'>1-\markup { \super 13 }
<c e g a d'>-\markup {
\super {
"6/9"
}
}
<c es g a d'>-\markup {
m \super 6/9
}
<c es ges heses>-\markup {
\fontsize #-6 " " dim \super 7
}
<c es ges b des'>-\markup \line {
m \super 7
\translate #'(-0.5 . 1) \vcenter
{
"(" \override #'(baseline-skip . 1)
\center-column
\fontsize #-4 { \concat { \myflat "5" } \concat { \myflat "9" } } ")"
}
}
<c es ges h>-\markup {
\fontsize #-6 " " dim \super maj7
}
<c es ges heses des'>-\markup {
\fontsize #-6 " " "dim" \super \concat { \myflat "9" }
}
<c es g b f'>-\markup {
m \super 7(add11)
}
<c es gis>-\markup {
m
\normal-size-super "+"
}
<c f g b>-\markup \super {
7
\normal-size-sub sus
}
<c f g b d'>-\markup \super {
9
\normal-size-sub sus
}
<c f g b d' a'>-\markup \super {
13
\normal-size-sub sus
}
<c e ges b>-\markup \super {
7 "(" \myflat "5)"
}
<c e ges b d'>-\markup \super {
9 "(" \myflat "5)"
}
<c e gis b>-\markup {
+ \super 7
}
<c e gis b d'>-\markup {
+ \super 9
}
<c e g b des'>-\markup \super {
7 "(" \myflat "9)"
}
<c e g b dis'>-\markup \super {
\vcenter { "7(" \mysharp "9)" }
}
<c e ges b des'>-\markup \line {
\super 7
\translate #'(-0.5 . 1) \vcenter
{
"(" \override #'(baseline-skip . 1)
\center-column
\fontsize #-4 { \concat { \myflat "9" } \concat { \myflat "5" } } ")"
}
}
<c e gis b dis'>-\markup {
+ \super \vcenter { "7(" \mysharp "9)" }
}
<c e gis b des'>-\markup {
+ \super \vcenter { "7(" \myflat "9)" }
}
<c e gis h >-\markup {
+ \super 7
}
<c e gis h d'>-\markup {
+ \super 9
}
<c e g b fis'>-\markup
\super \vcenter { "7(" \mysharp "11)" }
<c e g b d' fis'>-\markup
\super \vcenter { "9(" \mysharp "11)" }
<c e g b des' fis'>-\markup \line {
\super 7
\translate #'(-0.5 . 1) \vcenter
{
"(" \override #'(baseline-skip . 1)
\center-column
\fontsize #-4 { \concat { \mysharp "11" } \concat { \myflat "9" } } ")"
}
}
<c e ges b d' a'>-\markup
\super \vcenter { "13(" \myflat "5)" }
<c e g b d' fis' a'>-\markup
\super \vcenter { "13(" \mysharp "11)" }
}
chExceptions =
#(append
(sequential-music-to-chord-exceptions chExceptionMusic #t)
ignatzekExceptions)
myBlue = #(rgb-color (/ 22 255) (/ 22 255) (/ 92 255))
#(define ((chord-name->german-markup-text-alteration B-instead-of-Bb) pitch lowercase?)
(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define (conditional-string-downcase str condition)
(if condition
(string-downcase str)
str))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -1)))
(cons 7 (+ (if B-instead-of-Bb 1 1) 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?))
(let ((alteration (/ (cdr n-a) 2)))
(cond
((and (equal? lowercase? #f) (= alteration FLAT) (= (car n-a) 7)) (make-simple-markup ""))
((and (= alteration FLAT) (or (= (car n-a) 5) (= (car n-a) 2) )) (make-simple-markup "s"))
((= alteration FLAT) (make-simple-markup "es"))
((and (= alteration DOUBLE-FLAT) (or (= (car n-a) 5)(= (car n-a) 2) )) (make-simple-markup "ses"))
((= alteration DOUBLE-FLAT) (make-simple-markup "eses"))
((= alteration SHARP) (make-simple-markup "is"))
((= alteration DOUBLE-SHARP) (make-simple-markup "isis"))
(else empty-markup)))))))
#(define germanChords (chord-name->german-markup-text-alteration #t))
\layout {
\context {
\Staff
\remove "Time_signature_engraver"
\override InstrumentName.padding = #0.5
\override InstrumentName.self-alignment-X = #1
\override TextScript.padding = #2
}
\context {
\PianoStaff
\override SystemStartBrace.collapse-height = #1
}
\context {
\Score
\override KeyCancellation.break-visibility = #all-invisible
}
\context {
\ChordNames
\alias ChordNames
\override ChordName.self-alignment-X = #LEFT
chordNameLowercaseMinor = ##f
\override Rest.stencil = ##f
chordNoteNamer = #(chord-name->german-markup #f)
chordChanges = ##f
chordNameLowercaseMinor = ##f
chordNameExceptions = #chExceptions
chordRootNamer = #germanChords
majorSevenSymbol = \markup { maj7 }
\override ChordName.font-name = #"Arial Narrow"
\override ChordName.font-shape = #'bold
\override ChordName.extra-spacing-width = #'(+inf.0 . -inf.0)
\override ChordName.font-size = #4
noChordSymbol = ##f
\override VerticalAxisGroup.staff-affinity = #UP
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.padding = #1
}
}
mychords = \chordmode
{
c1 c:m c:5+ c:dim c:7 c:maj7
}
\markuplist \more-markuplist ##{ \mychords #} ##{ fis #}