\version "2.19.37"
\language "deutsch"
\paper {
#(set! paper-alist (cons '("mein Format" . (cons (* 35 in) (* 5 in))) paper-alist))
#(set-paper-size "mein Format")
left-margin = #20
}
#(define (music-name x)
(if (not (ly:music? x))
#f
(ly:music-property x 'name)))
#(define (naturalize-pitch p)
(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)))
(display p)(newline)
(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))))
(if (< n 0) (begin (set! o (- o 1)) (set! n (+ n 7))))
(if (> n 6) (begin (set! o (+ o 1)) (set! n (- n 7))))
#!#
(write (format "\nnaturalize-pitch pitch: ~a " p) )
(write (format "\nOktave: ~a " o) )
(write (format "\nNote: ~a " n) )
(write (format "\nAlteration: ~a\n " (/ a 4)) )
#!#
(ly:make-pitch o n (/ a 4))))
#(define white-key-width 23.5) %% wie breit ist eine weiße Taste
#(define white-key-height 150) %% wie hoch bzw. lang ist eine weiße Taste
#(define black-key-width 15)
#(define black-key-height 95) %% wie hoch (bzw. lang) ist eine schwarze Taste
#(define black-key-y-start (- white-key-height black-key-height))
%% Startpunkt für die links verschobenen Tasten cis/des fis/ges
%% n=0 oder n=3
#(define black-key-x1-start 13)
%% Startpunkt für die rechts verschobenen Tasten cis/des fis/ges
%% n=4
#(define black-key-x2-start 16)
%% Startpunkt für die mittigen schwarzen Tasten gis/as
%% n=1 oder n=5
#(define black-key-x3-start 19)
%#(display black-key-height)
%#(newline)
#(define (start-point-key p)
;; wir berechnen den Startpunkt der Taste
;; abhängig vom Pitch
(let*
((o (ly:pitch-octave p))
(a (ly:pitch-alteration p))
;; wir subtrahieren die Erhöhung vom Notennamen und addieren 1/2
;; das hat den Sinn, dass ich immer auf die gleiche Note komme
;; des z.B. n=1, a=-1/2 (des) ==> n=0
(n (ly:pitch-notename p))
(n1 (+ n a -0.5))
(x-shift (* o 7 white-key-width))
)
;(write (format "\nstart-point-key pitch: ~a" p))
;(write (format "\nnotename: ~a" n))
(write (format "\nnotename1: ~a" n1))
;(write (format "\nalteration: ~a\n" a))
(cond
;; alteration eq 0
;; kein Vorzeichen ==> weiße Taste
((eq? a 0)
(cons (+ (* n white-key-width) x-shift) 0 ))
;; links angeordnete Tasten
;; cis/des und fis/ges
;; n=0 oder n=3
((or (= n1 0) (= n1 3))
(write (format "\n((or (eq? n1 0) (eq? n1 3)): ~a" n1))
(cons (+ (* n1 white-key-width) black-key-x1-start x-shift ) black-key-y-start ))
;; rechts angeordnete Tasten
;; dis/es und ais/b
;, n=1 oder n=5
((or (= n1 1) (= n1 5))
(write (format "\n ((or (eq? n1 1) (eq? n1 5)): ~a" n1))
(cons (+ (* n1 white-key-width) black-key-x3-start x-shift ) black-key-y-start ))
;; jetzt bleibt nur noch gis/as übrig
;; die einzige mittig angeordnete schwarze Taste
(else
(write (format "\n else: ~a" n1))
(cons (+ (* n1 white-key-width) black-key-x2-start x-shift) black-key-y-start )))))
%#(display (start-point-key #{ fis' #} ))
%{
#(define-markup-command (make-key layout props zahl keylist ) ( number? list?)
(ly:stencil-scale
(ly:stencil-add
(map
(lambda (p)
(make-filled-box-stencil
(start-point-key (naturalize-pitch p)) (cons black-key-y-start white-key-height))
)
keylist )
zahl zahl)
))
%}
% New command to add a three sided box, with sides north, west and south
% Based on the box-stencil command defined in scm/stencil.scm
% Note that ";;" is used to comment a line in Scheme
#(define-public (NWS-box-stencil stencil thickness padding)
"Add a box around STENCIL, producing a new stencil."
(let* ((x-ext (interval-widen (ly:stencil-extent stencil X) padding))
(y-ext (interval-widen (ly:stencil-extent stencil Y) padding))
(y-rule (make-filled-box-stencil (cons 0 thickness) y-ext))
(x-rule (make-filled-box-stencil
(interval-widen x-ext thickness) (cons 0 thickness))))
;; (set! stencil (ly:stencil-combine-at-edge stencil X 1 y-rule padding))
(set! stencil (ly:stencil-combine-at-edge stencil X LEFT y-rule padding))
(set! stencil (ly:stencil-combine-at-edge stencil Y UP x-rule 0.0))
(set! stencil (ly:stencil-combine-at-edge stencil Y DOWN x-rule 0.0))
stencil))
#(define (make-box-stencil stencil thickness padding)
"Add a square box around @var{stencil}, producing a new stencil."
(let* ((x-ext (ly:stencil-extent stencil X))
(y-ext (ly:stencil-extent stencil Y))
(x-length (interval-length x-ext))
(y-length (interval-length y-ext))
(new-x-ext (interval-widen x-ext padding))
(new-y-ext (interval-widen y-ext padding))
(y-rule (make-filled-box-stencil (cons 0 thickness) new-y-ext))
(x-rule (make-filled-box-stencil
(interval-widen new-x-ext thickness) (cons 0 thickness))))
(set! stencil (ly:stencil-combine-at-edge stencil X 1 y-rule padding))
(set! stencil (ly:stencil-combine-at-edge stencil X -1 y-rule padding))
(set! stencil (ly:stencil-combine-at-edge stencil Y 1 x-rule 0.0))
(set! stencil (ly:stencil-combine-at-edge stencil Y -1 x-rule 0.0))
;; Uncomment to print x- and y-length
;; (newline)(write (interval-length (ly:stencil-extent stencil X)))
;; (newline)(write (interval-length (ly:stencil-extent stencil Y)))
stencil))
#(define (make-key filled p)
(let*
((a (ly:pitch-alteration p))
(n (ly:pitch-notename p))
(q (naturalize-pitch p))
(key-point (start-point-key q))
)
; (write (format "\nmake-key pitch: ~a" p))
; (write (format "\nalteration: ~a" a))
; (write (format "\nstart point car: ~a" (car key-point)))
; (write (format "\nstart point cdr: ~a\n" (cdr key-point)))
(cond
;; alteration eq 0
;; kein Vorzeichen ==> weiße Taste
((eq? a 0)
;; (write (format "\nwhite-key-width: ~a" white-key-width))
;; (write (format "\nwhite-key-height: ~a" white-key-height))
;(make-filled-box-stencil '(0 . 1) '(1 . 15))
(if filled
(make-box-stencil
(ly:stencil-in-color
(make-filled-box-stencil
;; erstes Pair: x-start x-end
;; zweites Pair: y-start y-end
;(cons (* n white-key-width) (* (+ n 1) white-key-width))
(cons
(car key-point)
(+ (car key-point) white-key-width)
)
(cons 0 white-key-height)
)
1 1 1)
0.5 0)
(ly:stencil-in-color
(make-filled-box-stencil
;; erstes Pair: x-start x-end
;; zweites Pair: y-start y-end
;(cons (* n white-key-width) (* (+ n 1) white-key-width))
(cons
(car key-point)
(+ (car key-point) white-key-width)
)
(cons 0 white-key-height)
)
0.9 1 0.9)
)
)
(else
(make-filled-box-stencil
(cons (car key-point) (+ (car key-point) black-key-width))
(cons black-key-y-start (+ black-key-height black-key-y-start 0.5))
)
))))
#(define (make-key-list filled l1)
(if (null? l1)
empty-stencil
(ly:stencil-add
(make-key filled (car l1))
(make-key-list filled (cdr l1)))))
#(define-markup-command (make-keys layout props zahl arg1 arg2 arg3 arg4)
(number? list? list? list? list?)
;; diese Funktion zeichnet eine in der Größe skalierbare Tonleiter
;; die unterste Schicht enthält alle Tasten in Hellgrau
;; die darüber liegende Schicht enthält die Tasten einer Tonleiter
;; in Hellblau (oder sonst einer wählbaren Farbe
;; die oberste Schicht enthält die Musiknoten in schwarz
;; arg1: weiße Tasten der Tonleiter
;; arg2: schwarze Tasten der Tonleiter
;; arg3: weiße Tasten der Noten
;; arg4: schwarze Tasten der Noten
(ly:stencil-scale
(ly:stencil-add
;; zunächst weißen Hintergrundtasten in Hellgrau
(ly:stencil-in-color
(make-key-list #t (event-chord-pitches
#{ < c, d, e, f, g, a, h, c d e f g a h c' d' e' f' g' a' h' c''
> #}
) )
0.9 0.9 0.9)
;; die weißen Tonleitertasten in Blau
(ly:stencil-in-color (make-key-list #t arg1 ) 0 0 1)
;; die weißen Musiktasten in schwarz
(ly:stencil-in-color (make-key-list #f arg3 ) 0 0 0)
;; die schwarzen Hintergrundtasten in Hellgrau
(ly:stencil-in-color
(make-key-list #f (event-chord-pitches
#{ < cis, es, fis, as, b,
cis dis fis as b cis' es' fis' as' b'
> #}
) )
0.9 0.9 0.9)
;(ly:stencil-in-color (make-key-list arg2 ) 0 0 1)
(ly:stencil-in-color (make-key-list #f arg4 ) 0 0 0)
) zahl zahl
))
meinTest=\markup \make-keys #0.1 #(event-chord-pitches #{ < c d e a h c' > #})
#(event-chord-pitches #{ < fis > #}) #(event-chord-pitches #{ < g h d' > #})
#(event-chord-pitches #{ < gis > #})
\relative c' {
c^\meinTest
}
#(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))))))))
meinTest=\markup \make-keys #0.1 #(all-pitches-from-music #{ { c d e a h c' } #})
#(event-chord-pitches #{ < fis > #}) #(event-chord-pitches #{ < g h d' > #})
#(event-chord-pitches #{ < gis > #})
\relative c' {
c^\meinTest
}
Tonleiter= { g a h c d e fis g }
meinAkkord= \chordmode { g:sus4 }
\relative c' {
\meinAkkord^\markup \make-keys #0.5 \Tonleiter \meinAkkord
}ZitatSry für das etwas längere Posting.die Länge ist nicht unbedigt ein Problem, jedoch all das überflüssige Zeug!
Zitat;; diese Funktion zeichnet eine in der Größe skalierbare Tonleiterist natürlich Unsinn.
ZitatMir ist tatsächlich nach wie vor unklar wozu das gis gut sein soll. Bei dem fis habe ich auch eher geraten.
meinTest=\markup \make-keys #0.1 #(all-pitches-from-music #{ { c d e a h c' } #})
#(event-chord-pitches #{ < fis > #}) #(event-chord-pitches #{ < g h d' > #})
#(event-chord-pitches #{ < gis > #})
\version "2.19.36"
\language "deutsch"
#(define (naturalize-pitch p)
(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))))
(if (< n 0) (begin (set! o (- o 1)) (set! n (+ n 7))))
(if (> n 6) (begin (set! o (+ o 1)) (set! n (- n 7))))
(ly:make-pitch o n (/ a 4))))
#(define white-key-width 23.5) %% wie breit ist eine weiße Taste
#(define white-key-height 150) %% wie hoch bzw. lang ist eine weiße Taste
#(define black-key-width 15)
#(define black-key-height 95) %% wie hoch (bzw. lang) ist eine schwarze Taste
#(define black-key-y-start (- white-key-height black-key-height))
%% Startpunkt für die links verschobenen Tasten cis/des fis/ges
%% n=0 oder n=3
#(define black-key-x1-start 13)
%% Startpunkt für die rechts verschobenen Tasten cis/des fis/ges
%% n=4
#(define black-key-x2-start 16)
%% Startpunkt für die mittigen schwarzen Tasten gis/as
%% n=1 oder n=5
#(define black-key-x3-start 19)
%#(display black-key-height)
%#(newline)
#(define (start-point-key p)
;; wir berechnen den Startpunkt der Taste
;; abhängig vom Pitch
(let* ((o (ly:pitch-octave p))
(a (ly:pitch-alteration p))
;; wir subtrahieren die Erhöhung vom Notennamen und addieren 1/2
;; das hat den Sinn, dass ich immer auf die gleiche Note komme
;; des z.B. n=1, a=-1/2 (des) ==> n=0
(n (ly:pitch-notename p))
(n1 (+ n a -0.5))
(x-shift (* o 7 white-key-width)))
(cond
;; alteration eq 0
;; kein Vorzeichen ==> weiße Taste
((eq? a 0)
(cons (+ (* n white-key-width) x-shift) 0))
;; links angeordnete Tasten
;; cis/des und fis/ges
;; n=0 oder n=3
((or (= n1 0) (= n1 3))
(cons (+ (* n1 white-key-width) black-key-x1-start x-shift)
black-key-y-start))
;; rechts angeordnete Tasten
;; dis/es und ais/b
;, n=1 oder n=5
((or (= n1 1) (= n1 5))
;(write (format "\n ((or (eq? n1 1) (eq? n1 5)): ~a" n1))
(cons (+ (* n1 white-key-width) black-key-x3-start x-shift)
black-key-y-start))
;; jetzt bleibt nur noch gis/as übrig
;; die einzige mittig angeordnete schwarze Taste
(else
(cons (+ (* n1 white-key-width) black-key-x2-start x-shift)
black-key-y-start)))))
#(define-public (make-transparent-stencil stencil)
"Make a transparent stencil."
(let ((x-ext (ly:stencil-extent stencil X))
(y-ext (ly:stencil-extent stencil Y)))
(ly:make-stencil
(list 'transparent-stencil
(ly:stencil-expr stencil))
x-ext y-ext)))
#(define* (make-key outlined? transparent? p #:optional (thickness 1.5))
(let* ((a (ly:pitch-alteration p))
(n (ly:pitch-notename p))
(q (naturalize-pitch p))
(key-point (start-point-key q))
(black-key-stil
(lambda (thick)
(make-filled-box-stencil
(interval-widen
(cons (car key-point) (+ (car key-point) black-key-width))
thick)
(interval-widen
(cons
black-key-y-start
(+ black-key-height black-key-y-start 0.5))
thick))))
(white-key-stil
(lambda (thick corr)
(make-filled-box-stencil
(interval-widen
(cons (car key-point) (+ (car key-point) white-key-width))
thick)
(interval-widen
(cons (- corr) (+ white-key-height corr))
thick)))))
(cond
;;;; alteration 0
;; for default white keys
;; and scale white keys
((and (= a 0) outlined?)
(box-stencil
(make-transparent-stencil
(white-key-stil (- thickness) 0))
thickness 0))
;; for chord-white-keys
((and (= a 0) (not outlined?))
(ly:stencil-in-color (white-key-stil -0.25 -0.25) 1 0 0))
;;;; alteration not 0
;; not outlined and not transparent
((and (not (= a 0)) (not outlined?) (not transparent?))
(black-key-stil (- 1)))
;; colored outlined and transparent
((and (not (= a 0)) outlined? transparent?)
(box-stencil
(make-transparent-stencil (black-key-stil -2))
thickness 0))
(else
;; outlined and colored
(ly:stencil-add
(black-key-stil (- 1))
(stencil-with-color
(box-stencil
(make-transparent-stencil (black-key-stil (- 1)))
thickness 0)
'(0.1 0.1 0.1)))))))
#(define* (make-key-list filled val l1 #:optional (thickness 1.5))
(apply
ly:stencil-add
(map (lambda (e) (make-key filled val e thickness)) l1)))
#(define white-keys
(ly:stencil-in-color
(make-key-list
#t
#f ;; val
(event-chord-pitches
#{
<c, d, e, f, g, a, h, c d e f g a h c' d' e' f' g' a' h' c''>
#})
0.5)
0.1 0.1 0.1))
#(define black-keys
(stencil-with-color
(make-key-list
#t
#f
(event-chord-pitches
#{
<cis, dis, fis, gis, ais, cis dis fis gis ais cis' dis' fis' gis' ais'>
#})
0.5)
'(0.9 0.9 0.9)))
#(define (sort-white-black-key-pitches pitch-list)
(call-with-values
(lambda ()
(partition
(lambda (p) (= 0 (ly:pitch-alteration p)))
pitch-list))
(lambda (a b) (list a b))))
#(define-markup-command
(make-keys layout props scale-factor the-scale the-chord)
(number? ly:music? ly:music?)
(let* ((scale
(map
(lambda (m) (ly:music-property m 'pitch))
(extract-named-music the-scale 'NoteEvent)))
(sorted-scale-pitches
(sort-white-black-key-pitches scale))
(chord
(map
(lambda (m) (ly:music-property m 'pitch))
(extract-named-music the-chord 'NoteEvent)))
(sorted-chord-pitches
(sort-white-black-key-pitches (map naturalize-pitch chord))))
(ly:stencil-scale
(ly:stencil-add
;;;; white-keys-stuff
;; default white keys
white-keys
;; chord-pitches at white keys
(ly:stencil-in-color
(make-key-list #f #t (car sorted-chord-pitches))
1 0 0)
;; scale-pitches at white keys
(ly:stencil-in-color
(make-key-list #t #f (car sorted-scale-pitches))
0 0 1)
;;;; black-keys-stuff
;; default black keys
black-keys
;; chord-pitches at black keys
(ly:stencil-in-color
(make-key-list #f #f (cadr sorted-chord-pitches))
1 0 0)
;; scale-pitches at black keys
(ly:stencil-in-color
(make-key-list #t #t (cadr sorted-scale-pitches))
0 0 1))
scale-factor
scale-factor)))
scale = { g, a, h, c d e fis g }
chrd = < cis eis gis >
%chrd = <g, c d>
tst = \markup \make-keys #0.1 #scale #chrd
\relative c'' { <>^\tst \chrd }
\pageBreak
Tonleiter = { g a h c d e fis g }
meinAkkord = \chordmode { g,:sus4 }
meinTest = \markup \make-keys #0.1 #Tonleiter #meinAkkord
\relative c' { <>^\meinTest \meinAkkord }