Klaviertasten zeichnen
Zur Navigation springen
Zur Suche springen
Die meisten Illustrationen von Klaviertasten zeichnen sich dadurch aus, dass die schwarzen Tasten genau in der Mitte zwischen den weißen Tasten sitzen. Schaut man ein Klavier genauer an, so merkt man, dass das nicht stimmt, weil der Abstand zwischen den schwarzen Tasten viel zu gering wäre, man würde mit den Fingern ständig dazwischen stecken bleiben.
Ich habe die Tasten meines Klavieres abgemessen und maßstabgerechte Tasten gezeichnet.
Inzwischen habe ich eine Klaviertastatur als Lilypond Pfad gezeichnet.
Anwendung
Die Grenzen der Tastatur werden so gewählt, dass die übergebene Musik vollständig dargestellt werden kann.
mus = \relative c' { c g' gis b }
#(define-markup-command
(draw-keyboard-with-music layout props p1 p2 scale-factor music)
(ly:pitch? ly:pitch? number? ly:music? )
(ly:stencil-scale
(draw-keyboard p1 p2 music (x11-color 'LightGray) (x11-color 'SlateGray) (x11-color 'ivory) (x11-color 'blue4))
scale-factor scale-factor))
\markup \draw-keyboard-with-music ##{ c'' #} ##{ c, #} #0.3 #mus
mus = \relative c' { c g' gis b }
#(define-markup-command
(draw-keyboard-with-music layout props p1 p2 scale-factor music)
(ly:pitch? ly:pitch? number? ly:music? )
(ly:stencil-scale
(draw-keyboard p1 p2 music (x11-color 'LightGray) (x11-color 'SlateGray) (x11-color 'ivory) (x11-color 'blue4))
scale-factor scale-factor))
\markup \draw-keyboard-with-music ##{ c'' #} ##{ c, #} #0.3 #mus
Mehr Tasten
\markup \draw-keyboard-with-music ##{ c'' #} ##{ c''' #} #0.3 #mus
\markup \draw-keyboard-with-music ##{ c'' #} ##{ c''' #} #0.3 #mus
Scheme-Code
#(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 (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))
)))