Re: Mettre un soufflet entre parenthèses

[Seventies]

Voilà, en cherchant sur la toile, la même fonction, mais qui, elle, travaille
correctement :

%{
*************************************************************************
* 18/11/12 - 31/12/13                                                   *
* Ver 1 : 31/12/13                                                      *
* Dvořák - Symphony nr 7                                                *
* encodage par J.F. Lucarelli                                           *
*                                                                       *
* Déclaration des fonctions diverses, polyphonie,                       *
* majuscules accentuées , ...                                           *
*                                                                       *
* à insérer en début des fichiers de parties ou de partitions globales  *
* pour les parties séparées                                             *
*                                                                       *
* Ne pas compiler                                                       *
*                                                                       *
*************************************************************************
%}

\include "common\Version.ly"

% Fonction poly : assure une polyphonie de type \voiceOne \new Voice
\voiceTwo \oneVoice
poly=
        #(define-music-function (parser location voixun voixdeux)
                (ly:music? ly:music?)
                #{
                        <<{
                          \voiceOne
                          $voixun
                        }
                        \new Voice
                        {
                          \voiceTwo
                          $voixdeux
                        }
                        >>
                        \oneVoice
                #}
        )

% Idem en inversant voix 1 et 2

polyInv=
        #(define-music-function (parser location voixun voixdeux)
                (ly:music? ly:music?)
                #{
                        <<{
                          \voiceTwo
                          $voixun
                        }
                        \new Voice
                        {
                          \voiceOne
                          $voixdeux
                        }
                        >>
                        \oneVoice
                #}
        )

% idem en laissant libre l'orientation des hampes et liaisons -
%       utile pour introduire une ligne indépendante de nuances

polyNeutral=
        #(define-music-function (parser location voixun voixdeux)
                (ly:music? ly:music?)
                #{
                        <<{
                          $voixun
                        }
                        \new Voice
                        {
                          $voixdeux
                        }
                        >>
                #}
        )

% Mettre un soufflet entre parenthèses (ou tout autre signe)

hairpinBetweenText =
#(define-music-function (parser location leftText rightText) (markup?
markup?)
   #{
     \once \override Hairpin #'stencil =
     #(lambda (grob)
       (let* ((orig (ly:grob-original grob))
              (siblings (if (ly:grob? orig)
                            (ly:spanner-broken-into orig)
                            '()))
              (hairpin-stencil (ly:stencil-aligned-to
(ly:hairpin::print grob) Y CENTER))
              (left-addition (ly:stencil-aligned-to
(grob-interpret-markup grob leftText) Y CENTER))
              (right-addition (ly:stencil-aligned-to
(grob-interpret-markup grob rightText) Y CENTER)))
         (if (or (null? siblings)
                 (eq? grob (car siblings)))
             (set! hairpin-stencil
                   (ly:stencil-combine-at-edge
                     left-addition
                     X RIGHT
                     hairpin-stencil
                     0)))
         (if (or (null? siblings)
                 (eq? grob (car (reverse siblings))))
             (set! hairpin-stencil
                   (ly:stencil-combine-at-edge
                     hairpin-stencil
                     X RIGHT
                     right-addition
                     0.6)))
         hairpin-stencil))
   #})

% utilisation :
% parenthesizedHairpin = \hairpinBetweenText \markup "(" \markup ")"
% \parenthesizedHairpin 
%    c16\< d e f g a b c d e f g a\!
% ne vaut que pour le soufflet suivant la note concernée

%indications de volume entre soufflet
parenthesizedHairpin = \hairpinBetweenText \markup "(" \markup ")"
% idem entre crochets
bracketedHairpin = \hairpinBetweenText \markup "[" \markup "]"



%%% Guile does not deal with accented letters

%%% Use as  \markup \smallCaps { Théâtre }

#(use-modules (ice-9 regex))
%%;; actually defined below, in a closure
#(define-public string-upper-case #f)
#(define accented-char-upper-case? #f)
#(define accented-char-lower-case? #f)

%%;; an accented character is seen as two characters by guile
#(let ((lower-case-accented-string "éèêëáàâäíìîïóòôöúùûüçœæ")
       (upper-case-accented-string "ÉÈÊËÁÀÂÄÍÌÎÏÓÒÔÖÚÙÛÜÇŒÆ"))
   (define (group-by-2 chars result)
      (if (or (null? chars) (null? (cdr chars)))
          (reverse! result)
          (group-by-2 (cddr chars)
                      (cons (string (car chars) (cadr chars))
                            result))))
   (let ((lower-case-accented-chars
          (group-by-2 (string->list lower-case-accented-string) (list)))
         (upper-case-accented-chars
          (group-by-2 (string->list upper-case-accented-string) (list))))
     (set! string-upper-case
           (lambda (str)
             (define (replace-chars str froms tos)
               (if (null? froms)
                   str
                   (replace-chars (regexp-substitute/global #f (car froms)
str
                                                            'pre (car tos)
'post)
                                  (cdr froms)
                                  (cdr tos))))
             (string-upcase (replace-chars str
                                           lower-case-accented-chars
                                           upper-case-accented-chars))))
     (set! accented-char-upper-case?
           (lambda (char1 char2)
             (member (string char1 char2) upper-case-accented-chars
string=?)))
     (set! accented-char-lower-case?
           (lambda (char1 char2)
             (member (string char1 char2) lower-case-accented-chars
string=?)))))

#(define-markup-command (smallCaps layout props text) (markup?)
  "Turn @code{text}, which should be a string, to small caps.
@example
\\markup \\small-caps \"Text between double quotes\"
@end example"
  (define (string-list->markup strings lower)
    (let ((final-string (string-upper-case
                         (apply string-append (reverse strings)))))
      (if lower
          (markup #:fontsize -2 final-string)
          final-string)))
  (define (make-small-caps rest-chars currents current-is-lower prev-result)
    (if (null? rest-chars)
        (make-concat-markup (reverse! (cons (string-list->markup
                                              currents current-is-lower)
                                            prev-result)))
        (let* ((ch1 (car rest-chars))
               (ch2 (and (not (null? (cdr rest-chars))) (cadr rest-chars)))
               (this-char-string (string ch1))
               (is-lower (char-lower-case? ch1))
               (next-rest-chars (cdr rest-chars)))
          (cond ((and ch2 (accented-char-lower-case? ch1 ch2))
                 (set! this-char-string (string ch1 ch2))
                 (set! is-lower #t)
                 (set! next-rest-chars (cddr rest-chars)))
                ((and ch2 (accented-char-upper-case? ch1 ch2))
                 (set! this-char-string (string ch1 ch2))
                 (set! is-lower #f)
                 (set! next-rest-chars (cddr rest-chars))))
          (if (or (and current-is-lower is-lower)
                  (and (not current-is-lower) (not is-lower)))
              (make-small-caps next-rest-chars
                               (cons this-char-string currents)
                               is-lower
                               prev-result)
              (make-small-caps next-rest-chars
                               (list this-char-string)
                               is-lower
                               (if (null? currents)
                                   prev-result
                                   (cons (string-list->markup
                                            currents current-is-lower)
                                         prev-result)))))))
  (interpret-markup layout props
    (if (string? text)
        (make-small-caps (string->list text) (list) #f (list))
        text)))

Ne comprenant pas grand-chose au Scheme, je ne peux expliquer la différence,
et pourquoi le snippet de http://lsr.dsi.unimi.it ne fonctionne pas.
Un problème de version, peut-être ?

Cordialement,

Jean-François




--
View this message in context: 
http://lilypond-french-users.1298960.n2.nabble.com/Mettre-un-soufflet-entre-parentheses-tp7578858p7578863.html
Sent from the LilyPond French Users mailing list archive at Nabble.com.