2015-04-12 20:40 GMT+02:00 Eljakim Schrijvers <eschrijv...@eljakim.nl>:
> Super, that is great to see! Thank you so much.
>
> I prefer this over Python (which I normally program in) since this can
> easily be posted in lilybin.com.
>
> Thanks again,
>
> Eljakim
Hi,
sorry for dropping in that late.
Here my own highly automate approach.
\version "2.19.17"
%% LIMITATION:
%% can't distuingish between minor- and aeolian-scale, major- and ionian-scale
%% TODO
%% define and use an alist for the following lists
scales =
#(list major minor ionian locrian aeolian mixolydian lydian phrygian dorian)
scales-names =
#'(major minor ionian locrian aeolian mixolydian lydian phrygian dorian)
german-scale-names =
#'(Dur Moll Ionisch Lokrisch Äolisch Mixolydisch Lydisch Phrygisch Dorisch)
french-scale-names =
#'(majeur mineur ionien locrien éolien mixolydien lydien phrygien dorien)
%% procedures returning strings/markups for accidental and note-name
#(define (alteration->text-accidental-markup alteration)
(make-smaller-markup
(make-raise-markup
(if (= alteration FLAT)
0.3
0.6)
(make-musicglyph-markup
(assoc-get alteration standard-alteration-glyph-name-alist "")))))
#(define (accidental->markup alteration)
"Return accidental markup for @var{alteration}."
(if (= alteration 0)
(make-line-markup (list empty-markup))
(make-line-markup
(list
(alteration->text-accidental-markup alteration)
(make-hspace-markup 0.1)))))
#(define (note-name->markup pitch)
"Return pitch-markup for @var{pitch}."
(make-concat-markup
(list
(make-simple-markup
(vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename pitch)))
(accidental->markup (ly:pitch-alteration pitch)))))
#(define (note-name->german-string pitch)
"Return string for @var{pitch}, using german note names."
(define (pitch-alteration-semitones pitch)
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (equal? (cons name alt-semitones) '(6 . -1))
(cons 7 alt-semitones)
(cons name alt-semitones))))
(string-append
(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
(let ((alteration (/ (cdr n-a) 2)))
(cond
((and (= alteration FLAT) (= (car n-a) 7))
"")
((and (= alteration FLAT) (or (= (car n-a) 5) (= (car n-a) 2) ))
"s")
((= alteration FLAT) "es")
((and (= alteration DOUBLE-FLAT) (or (= (car n-a) 5)(= (car n-a) 2)))
"ses")
((= alteration DOUBLE-FLAT)
"eses")
((= alteration SHARP)
"is")
((= alteration DOUBLE-SHARP)
"isis")
(else ""))))))
#(define (note-name->french-string pitch)
"Return string for @var{pitch}, using french note names."
(let* ((name (ly:pitch-notename pitch))
(alteration (ly:pitch-alteration pitch)))
(string-append
(vector-ref #("Do" "Ré" "Mi" "Fa" "Sol" "La" "Si") name)
(cond
((= alteration FLAT) "-bémol")
((= alteration DOUBLE-FLAT) "-double bémol")
((= alteration SHARP) "-diése")
((= alteration DOUBLE-SHARP) "-double diése")
(else "")))))
%% engraver setting instrumentName to a markup for the used KeySignature
annotate-key-engraver =
#(lambda (context)
(let ((tonic '())
(scale-name '())
(german-scale-name '())
(french-scale-name '())
(annotate-key-tweak? #f))
`((listeners
(key-change-event
.
,(lambda (engraver event)
(let* ((context (ly:translator-context engraver))
(pitch-alist (ly:event-property event 'pitch-alist))
(tonic-pitch (ly:context-property context 'tonic))
(c0-pitch-list
(ly:transpose-key-alist pitch-alist
(ly:pitch-diff (ly:make-pitch 0 0 0) tonic-pitch)))
(pos-scales-from-right (length (member c0-pitch-list scales)))
(scale
(car (take-right scales-names pos-scales-from-right)))
(german-scale
(car (take-right german-scale-names pos-scales-from-right)))
(french-scale
(car (take-right french-scale-names pos-scales-from-right))))
;; clear the following variables before proceeding
(set! tonic '())
(set! scale-name '())
(set! german-scale-name '())
(set! french-scale-name '())
;; newly assign them
(set! tonic (cons tonic-pitch tonic))
(set! scale-name scale)
(set! german-scale-name german-scale)
(set! french-scale-name french-scale)))))
(acknowledgers
(system-start-text-interface
. ,(lambda (engraver grob source-engraver)
(let* ((german-root-name
(note-name->german-string (car tonic)))
(french-root-name
(note-name->french-string (car tonic)))
(english-root-name
(note-name->markup (car tonic))))
(set! (ly:grob-property grob 'long-text)
(format-key-info-markup
german-root-name german-scale-name
french-root-name french-scale-name
english-root-name scale-name)))))))))
%% the file-name
my-name =
#(ly:parser-output-name parser)
%% procedure to set score-headers
%% taken from
%% http://lists.gnu.org/archive/html/lilypond-user/2012-03/msg00097.html
#(define-public (set-score-headers! score header)
(let ((scorehead (ly:score-header score)))
; if score has no header, create one
(if (list? scorehead)
(let ((mod (make-module)))
(set! scorehead mod)
(ly:score-set-header! score scorehead)))
(for-each
(lambda (p)
(if (pair? p)
(let ((key (car p))
(val (cdr p)))
(module-define! scorehead key val)))) header)))
%% the printing function
%% outputting scores derived from `music' transpose by the pitches from `m'
%% score-header can be specified by setting appropriate `header-props' or an
%% empty list
write-scores =
#(define-void-function (parser location m header-props music)
(ly:music? list? ly:music?)
(let ((score-list
(reverse
(map
(lambda (pitch) #{ \transpose c $pitch $music #})
(event-chord-pitches m)))))
(ly:book-process
(ly:make-book-part
(map
(lambda (score)
(let ((new-score (ly:make-score score)))
(set-score-headers! new-score header-props)
new-score))
score-list))
$defaultpaper
$defaultlayout
my-name)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% a procedure to format the markup used for InstrumentName
#(define format-key-info-markup
(lambda (root-1 scale-1 root-2 scale-2 root-3 scale-3)
(markup
#:column (
#:bold
#:concat (
root-3
" "
(symbol->string scale-3))
#:italic
(format #f "~a ~a"
root-2
(symbol->string scale-2))
#:italic
(let ((german-strg
(format #f "~a-~a"
root-1
(symbol->string scale-1))))
(if (eq? scale-1 'Moll)
(string-downcase german-strg)
german-strg))))))
\paper {
print-all-headers = ##t
indent = 3.5 \cm
}
\layout {
\context {
%% the "Instrument_name_engraver" has to be inserted ofc
\GregorianTranscriptionStaff
\consists "Instrument_name_engraver"
instrumentName = ""
\consists #annotate-key-engraver
}
}
%% definig the music
exercise = {
\clef treble
\key c \major
\omit Staff.TimeSignature
\relative c'
{
c8[ d] e[ f]
}
\bar ""
\pageBreak
}
\write-scores
%% pitches to transpose:
{ c cis d }
%% score-header-settings:
#'(
(title . "TITLE")
(subtitle . "SUBTITLE")
(composer . "COMPOSER")
(piece . "PIECE")
;; etc
)
%% the music
\new GregorianTranscriptionStaff \exercise
Though, I've no clue how to automagically read out the used
KeySignature _and_ put the result in a header.
Nevertheless,
HTH,
Harm
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
