Re: Repeating a section with different transpose

[Thomas Morley]

2015-04-12 20:40 GMT+02:00 Eljakim Schrijvers <address@hidden>:
> 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