\paper {
score-markup-spacing.padding = #2
markup-system-spacing.padding = #3
tagline = ##f
ragged-last = ##t
ragged-bottom = ##t
indent = #0
line-width = #160
page-breaking = #ly:one-page-breaking
}
\layout {
\context {
\Staff
\remove Time_signature_engraver
}
\context {
\Score
\remove Bar_number_engraver
\override BarLine.stencil = ##f
\override SpanBar.stencil = ##f
}
}
pitchlist = { c g f }
myChords = \chordmode
{
c1 c:m c:5+ c:dim c:7 c:maj7
}
mutra = \multipleTransposes \pitchlist \myChords
myScale = \relative c' { c1 d e f g a h }
mymus = \ChordsInScale \mutra \myScale
myscor = \markup \score {
\new Staff \with { \magnifyStaff #5/7 } \myScale
\layout {
%#(layout-set-staff-size 14)
\context {
\Staff
\remove Time_signature_engraver
}
\context {
\Score
\override SpacingSpanner.base-shortest-duration = #(ly:make-moment 1)
\override SpacingSpanner.uniform-stretching = ##t
\remove Bar_number_engraver
automaticBars = ##f
}
indent = #2
}
}
notenzahl = #(count-notes! myScale)
\new StaffGroup
<<
\new ChordNames { \myChords }
\new Staff
{
\override Score.RehearsalMark.self-alignment-X = #-1
\textLengthOn
\mark "Akkorde"
\MapChords c' c'' #0.08 { \myChords }
}
\new ChordNames { \myChords }
\new Staff {
\clef bass \transpose c c, {
\myChords
}
}
>>
\new PianoStaff
<<
\new Staff
{
\override Score.RehearsalMark.self-alignment-X = #-1
\mark "Tonleiter"
\myScale
}
\new Staff {
\clef bass \transpose c c, \myScale
}
>>
\new Staff {
\override Score.RehearsalMark.self-alignment-X = #-1
\mark "Pitchliste"
\transpose c c' \pitchlist
}
\markup "Akkorde anhand der Pitchliste transponiert"
<<
\new ChordNames \mutra
\new Staff \mutra
>>
\new PianoStaff
<<
\new ChordNames \mymus
\new Staff
{
\override Score.RehearsalMark.self-alignment-X = #-1
\textLengthOn
\MapChords c' c'' #0.08 { \mymus }
}
\new ChordNames \mymus
\new Staff {
\clef bass \transpose c c, {
\mark \markup \vcenter { "Akkorde in der Tonleiter" \myscor }
\mymus
}
}
>>
Akkorde analysieren
Zur Navigation springen
Zur Suche springen
Eine Akkkordliste wird anhand einer Tonleiter mittels eines Scheme-Programms[1] „gesiebt“, d.h. es werden jene Akkorde ausgewählt, die sich vollständig aus Tönen der vorgegebenen Tonleiter bilden lassen. Es wird dabei auf die Oktavierung und enharmonische Verwechslungen keine Rücksicht genommen, des wird beispielsweise cis gleichgesetzt.
Die Tonleiter wird nicht mehr extra eingefärbt wie in diesem Code[2] dargestellt. } Lilypond führt alle Schritte automatisiert durch, ich gebe die Akkordliste und die Tonleiter vor. In der Grafik wird die Akkordliste aus Gründen der Übersichtlichkeit nur teilweise angezeigt.
Anwendung
\paper {
score-markup-spacing.padding = #2
markup-system-spacing.padding = #3
tagline = ##f
ragged-last = ##t
ragged-bottom = ##t
indent = #0
line-width = #160
page-breaking = #ly:one-page-breaking
}
\layout {
\context {
\Staff
\remove Time_signature_engraver
}
\context {
\Score
\remove Bar_number_engraver
\override BarLine.stencil = ##f
\override SpanBar.stencil = ##f
}
}
pitchlist = { c g f }
myChords = \chordmode
{
c1 c:m c:5+ c:dim c:7 c:maj7
}
mutra = \multipleTransposes \pitchlist \myChords
myScale = \relative c' { c1 d e f g a h }
mymus = \ChordsInScale \mutra \myScale
myscor = \markup \score {
\new Staff \with { \magnifyStaff #5/7 } \myScale
\layout {
%#(layout-set-staff-size 14)
\context {
\Staff
\remove Time_signature_engraver
}
\context {
\Score
\override SpacingSpanner.base-shortest-duration = #(ly:make-moment 1)
\override SpacingSpanner.uniform-stretching = ##t
\remove Bar_number_engraver
automaticBars = ##f
}
indent = #2
}
}
notenzahl = #(count-notes! myScale)
\new StaffGroup
<<
\new ChordNames { \myChords }
\new Staff
{
\override Score.RehearsalMark.self-alignment-X = #-1
\textLengthOn
\mark "Akkorde"
\MapChords c' c'' #0.08 { \myChords }
}
\new ChordNames { \myChords }
\new Staff {
\clef bass \transpose c c, {
\myChords
}
}
>>
\new PianoStaff
<<
\new Staff
{
\override Score.RehearsalMark.self-alignment-X = #-1
\mark "Tonleiter"
\myScale
}
\new Staff {
\clef bass \transpose c c, \myScale
}
>>
\new Staff {
\override Score.RehearsalMark.self-alignment-X = #-1
\mark "Pitchliste"
\transpose c c' \pitchlist
}
\markup "Akkorde anhand der Pitchliste transponiert"
<<
\new ChordNames \mutra
\new Staff \mutra
>>
\new PianoStaff
<<
\new ChordNames \mymus
\new Staff
{
\override Score.RehearsalMark.self-alignment-X = #-1
\textLengthOn
\MapChords c' c'' #0.08 { \mymus }
}
\new ChordNames \mymus
\new Staff {
\clef bass \transpose c c, {
\mark \markup \vcenter { "Akkorde in der Tonleiter" \myscor }
\mymus
}
}
>>
Graphische Ausgabe
Scheme-Code
Tastatur zeichnen + Akkord Analyse
#(define (naturalize-pitch p)
;; reduces alteration greater than a half tone step
;; #(display (naturalize-pitch #{ fes #}))ChordsInScale
;; #<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 (transpose-all pili music)
;; transposes music through all pitches in pili
;; creates a list of music expressions
;; that can converted by make-sequential-music to Lily music
(map
(lambda (p)
;(write-me "lambda (p)------------------------------- " p)
#{ { \transpose c $p $music } #})
(all-pitches-orig-music pili)))
#(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 (ist-in? the-chord the-scale)
(let* ((chordpitches (all-pitches-from-music the-chord))
(scalepitches (all-pitches-from-music the-scale)))
;(write-me "chordpitches ------------------> " chordpitches)
;(write-me "scalepitches ------------------> " scalepitches)
(every (lambda (x)
(let
((istdrin (->bool
(member x scalepitches pitch-equals?))))
;(write-me "ist-in? (x) ---------------------> " istdrin)
istdrin))
chordpitches)))
#(define (chords-contained chord-music the-scale)
(let* ((chord-list (extract-named-music chord-music 'EventChord))) ;(extract-named-music args 'EventChord)
; (write-me "chord-list ------------------> " chord-list)
; (write-me "ly:music-property event-chord-------> "
; (ly:music-property chord-music 'elements))
; (write-me "is list? chord-list -------------> " (list? chord-list))
; (write-me "length chord-list ---------------> " (length chord-list))
;(map (lambda (x) (write-me "ly:music elements of chord-list ---------------> " (ly:music? x))) chord-list)
(filter (lambda (x) (ist-in? x the-scale)) chord-list)))
ChordsInScale=
#(define-music-function (chordlist the-scale)
(ly:music? ly:music?)
(make-sequential-music (chords-contained chordlist the-scale)))
%%
%% Akkorde auf Tastatur zeichnen
%%
#(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 (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)))
#(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 b-color w-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 (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)
#!
;; 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ätzlich brauchen wir die Grenzangaben nicht
;; wegen vermehrter Flexibilität, damit wir auch Tasten außerhalb
;; des Akkords zeichnen können
!#
(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-color b-color))
chord-pi-single))
)))
%% Noten zählen
%% alist for pitch count of music
#(define count-pitches
(map (lambda (x) (cons x 0)) all-pitches))
#(define (pitch-count p)
(assoc-get p count-pitches))
#(define (increase! p)
;; adding one to the entry in count list
(assoc-set! count-pitches p (+ 1 (pitch-count p))))
#(define (count-notes! music)
;; counts all Notes in Music music
;; updates the assoclist count-pitches
;; and returns the number of notes contained in music
(let* ((allep (all-pitches-from-music music))
(zzz (map (lambda (p) (increase! (standardize-pitch p))) allep))
; (newline) (display "gezählt: ") (display count-pitches)(newline)
;; beware of using all pitches of music for adding the numbers of notes
;; because you get the squares when you do so!
(notenzahl (apply +
0
(map (lambda (p) (pitch-count p)) all-pitches)))
)
;procedure body
;; we change the color in the assoc-list immediately after counting the notes
(inexact->exact notenzahl)))
%% ein Musikausdruck wird mehrfach transponiert
%% der erste Parameter enthält eine Liste von Pitches, die abgearbeitet werden
%% der zweite Parameter ist die Musik, die transponiert werden soll
multipleTransposes =
#(define-music-function (m music)
(ly:music? ly:music?)
(music-clone m 'elements
(map
(lambda (pitch)
(ly:music-property #{ \transpose c $pitch $music #} 'element))
(event-chord-pitches m))))
#(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))
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-chords
#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
#})
(extract-named-music the-chordlist 'EventChord))))
#(define (naturalize-pitch p)
;; reduces alteration greater than a half tone step
;; #(display (naturalize-pitch #{ fes #}))ChordsInScale
;; #<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 (transpose-all pili music)
;; transposes music through all pitches in pili
;; creates a list of music expressions
;; that can converted by make-sequential-music to Lily music
(map
(lambda (p)
;(write-me "lambda (p)------------------------------- " p)
#{ { \transpose c $p $music } #})
(all-pitches-orig-music pili)))
#(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 (ist-in? the-chord the-scale)
(let* ((chordpitches (all-pitches-from-music the-chord))
(scalepitches (all-pitches-from-music the-scale)))
;(write-me "chordpitches ------------------> " chordpitches)
;(write-me "scalepitches ------------------> " scalepitches)
(every (lambda (x)
(let
((istdrin (->bool
(member x scalepitches pitch-equals?))))
;(write-me "ist-in? (x) ---------------------> " istdrin)
istdrin))
chordpitches)))
#(define (chords-contained chord-music the-scale)
(let* ((chord-list (extract-named-music chord-music 'EventChord))) ;(extract-named-music args 'EventChord)
; (write-me "chord-list ------------------> " chord-list)
; (write-me "ly:music-property event-chord-------> "
; (ly:music-property chord-music 'elements))
; (write-me "is list? chord-list -------------> " (list? chord-list))
; (write-me "length chord-list ---------------> " (length chord-list))
;(map (lambda (x) (write-me "ly:music elements of chord-list ---------------> " (ly:music? x))) chord-list)
(filter (lambda (x) (ist-in? x the-scale)) chord-list)))
ChordsInScale=
#(define-music-function (chordlist the-scale)
(ly:music? ly:music?)
(make-sequential-music (chords-contained chordlist the-scale)))
%%
%% Akkorde auf Tastatur zeichnen
%%
#(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 (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)))
#(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 b-color w-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 (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)
#!
;; 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ätzlich brauchen wir die Grenzangaben nicht
;; wegen vermehrter Flexibilität, damit wir auch Tasten außerhalb
;; des Akkords zeichnen können
!#
(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-color b-color))
chord-pi-single))
)))
%% Noten zählen
%% alist for pitch count of music
#(define count-pitches
(map (lambda (x) (cons x 0)) all-pitches))
#(define (pitch-count p)
(assoc-get p count-pitches))
#(define (increase! p)
;; adding one to the entry in count list
(assoc-set! count-pitches p (+ 1 (pitch-count p))))
#(define (count-notes! music)
;; counts all Notes in Music music
;; updates the assoclist count-pitches
;; and returns the number of notes contained in music
(let* ((allep (all-pitches-from-music music))
(zzz (map (lambda (p) (increase! (standardize-pitch p))) allep))
; (newline) (display "gezählt: ") (display count-pitches)(newline)
;; beware of using all pitches of music for adding the numbers of notes
;; because you get the squares when you do so!
(notenzahl (apply +
0
(map (lambda (p) (pitch-count p)) all-pitches)))
)
;procedure body
;; we change the color in the assoc-list immediately after counting the notes
(inexact->exact notenzahl)))
%% ein Musikausdruck wird mehrfach transponiert
%% der erste Parameter enthält eine Liste von Pitches, die abgearbeitet werden
%% der zweite Parameter ist die Musik, die transponiert werden soll
multipleTransposes =
#(define-music-function (m music)
(ly:music? ly:music?)
(music-clone m 'elements
(map
(lambda (pitch)
(ly:music-property #{ \transpose c $pitch $music #} 'element))
(event-chord-pitches m))))
#(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))
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-chords
#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
#})
(extract-named-music the-chordlist 'EventChord))))