bin/markup-commands.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- markup-commands.scm                                ;
   3 ;                                                                  ;
   4 ; (c) 2008-2010 Valentin Villenave <valentin@villenave.net>        ;
   5 ;                                                                  ;
   6 ;     opus_libre is a free framework for GNU LilyPond: you may     ;
   7 ; redistribute it and/or modify it under the terms of the GNU      ;
   8 ; General Public License, version 3 or later: gnu.org/licenses     ;
   9 ;                                                                  ;
  10 ;------------------------------------------------------------------;
  11
  12 ; Markup commands.
  13
  14 (define-markup-command (smallCaps layout props text) (markup?)
  15   ;; Thanks to Nicolas Sceaux! See libtext.scm.
  16   #:category font
  17   "Print @var{arg} as small caps.
  18 This version of the @code{\\smallCaps} command adds basic support
  19 for accented characters."
  20   (interpret-markup layout props
  21                     (if (string? text)
  22                         (make-small-caps (string->list text) (list) #f (list))
  23                         text)))
  24
  25
  26 (define-markup-command (dynamic-string layout props str) (string?)
  27   #:category font
  28   "
  29 @cindex dynamics, composite
  30 @cindex dynamics, mixed with text
  31
  32 Print a string using the dynamic font only when appropriate.
  33 Words may be separated with @code{_}; dynamic-style characters
  34 will only be used in words that contain no other letter than
  35 @b{f}, @b{m}, @b{p}, @b{r}, @b{s} and @b{z}, and punctuation
  36 marks.  Regular spaces are allowed inside words.
  37
  38 @lilypond[verbatim,quote]
  39 \\markup {
  40   \\dynamic-string #\"mp,_quasi_mf_ma più dolce.\"
  41 }
  42 @end lilypond"
  43   (let ((composite-chars (char-set-union
  44                           char-set:dynamics
  45                           char-set:whitespace
  46                           char-set:punctuation))
  47         (split (lambda (s) (string-index s #\_ )))
  48         (str-list '())
  49         (style-markup (lambda (s)
  50                         (make-normal-text-markup
  51                          (make-italic-markup s)))))
  52     (do ((current-str (string-append str "_")))
  53         ((not (split current-str)))
  54       (begin
  55         (set! str-list
  56               (append str-list (list
  57                                 (string-take current-str (split current-str)))))
  58         (set! current-str
  59               (string-drop current-str (+ (split current-str) 1)))))
  60     (interpret-markup layout props
  61                       (make-line-markup
  62                        (map (lambda (word)
  63                               (if (string-every composite-chars word)
  64                                   (if (string-every char-set:dynamics word)
  65                                       (make-dynamic-markup word)
  66                                       (let ((word-lst (string->list word)))
  67                                         (make-concat-markup
  68                                          (map (lambda (ch)
  69                                                 (let ((print-ch (string ch)))
  70                                                   (if (char-punctuation? ch)
  71                                                       (style-markup print-ch)
  72                                                       (make-dynamic-markup print-ch))))
  73                                               word-lst))))
  74                                   (style-markup word)))
  75                             str-list)))))
  76
  77 ;; Probably stolen from Nicolas' code -- is this really useful here?
  78 (define-markup-command (line-width-ratio layout props width-ratio arg) (number? markup?)
  79   (interpret-markup layout props
  80                     (markup #:override (cons 'line-width (* width-ratio (chain-assoc-get 'line-width props)))
  81                             arg)))
  82
  83 ;; TODO: to be theme-ized.
  84 (define-markup-command (indic layout props arg) (markup?)
  85   (interpret-markup layout props
  86                     (markup #:whiteout #:small #:italic arg)))