scm/new-markup.scm

   1
   2
   3
   4 (define-public (simple-markup grob props . rest)
   5   (Text_item::text_to_molecule grob props (car rest))
   6   )
   7
   8 (define-public (line-markup grob props . rest)
   9   (stack-molecules
  10    X 1 1.0
  11    (map (lambda (x) (interpret-markup grob props x)) (car rest)))
  12   )
  13
  14 (define (combine-molecule-list lst)
  15   (if (null? (cdr lst)) (car lst)
  16       (ly:add-molecule (car lst) (combine-molecule-list (cdr lst)))
  17       ))
  18
  19 (define-public (combine-markup grob props . rest)
  20    (combine-molecule-list (map (lambda (x) (interpret-markup grob props x)) (car rest))))
  21
  22 (define-public (bold-markup grob props . rest)
  23    (interpret-markup grob (cons (cons '(font-series . bold) (car props)) (cdr props)) (car rest))
  24   )
  25
  26 (define-public (column-markup grob props . rest)
  27   (stack-molecules
  28    Y -1 0.0
  29    (map (lambda (x) (interpret-markup grob props x)) (car rest)))
  30   )
  31
  32 (define-public (music-markup grob props . rest)
  33   (ly:find-glyph-by-name
  34    (ly:get-font grob (cons '((font-family . music)) props))
  35    (car rest))
  36   )
  37
  38 (define-public (lookup-markup grob props . rest)
  39   "Lookup a glyph by name."
  40   (ly:find-glyph-by-name
  41    (ly:get-font grob props)
  42    (car rest))
  43   )
  44
  45 (define-public (override-markup grob props . rest)
  46   "Tack the 1st args in REST onto PROPS."
  47   (interpret-markup grob (cons (list (car rest)) props)
  48                     (cadr rest)))
  49
  50 (map (lambda (x)
  51        (set-object-property! (car x) 'markup-signature (cdr x))
  52        )
  53      (list (cons bold-markup 'markup0)
  54            (cons column-markup 'markup-list0)
  55            (cons line-markup  'markup-list0)
  56            (cons combine-markup 'markup0-markup1)
  57            (cons simple-markup 'markup0)
  58            (cons music-markup 'scm0)
  59            (cons override-markup 'scm0-markup1)
  60            (cons lookup-markup 'scm0)
  61            ))
  62
  63 (define markup-module (current-module))
  64
  65 (define-public (lookup-markup-command code)
  66   (let*
  67       ( (sym (string->symbol (string-append code "-markup")))
  68         (var (module-local-variable markup-module sym))
  69         )
  70     (if (eq? var #f)
  71         #f
  72         (cons (variable-ref var) (object-property  (variable-ref var) 'markup-signature))
  73     )
  74   ))
  75
  76
  77 (define-public (brew-new-markup-molecule grob)
  78   (interpret-markup grob
  79                     (Font_interface::get_property_alist_chain grob)
  80                     (ly:get-grob-property grob 'text)
  81                     )
  82   )
  83
  84 (define (interpret-markup  grob props markup)
  85   (let*
  86       (
  87        (func (car markup))
  88        (args (cdr markup))
  89        )
  90
  91     (apply func (cons grob (cons props args)) )
  92     ))
  93
  94
  95 (define (new-markup? x)
  96         (markup-function? (car x))
  97 )
  98
  99 (define (markup-function? x)
 100         (object-property 'markup-signature? x))