Hi,
ly:parse-string is definitely a wonderful feature. Here is a cleaner
version of a #{ ... #} lilypond syntax inside scheme.
%%%%%%%%%%% scm/lily-in-scm.scm %%%%%%%%%%%%%%
(define-module (scm lily-in-scm))
(use-modules (ice-9 format) (lily))
(define (gen-lily-sym) '())
(let ((var-idx -1))
(set! gen-lily-sym
(lambda ()
(set! var-idx (1+ var-idx))
(string->symbol (format #f "lilyvartmp~a"
(list->string (map (lambda (char)
(case char
((#\0) #\a)
((#\1) #\b)
((#\2) #\c)
((#\3) #\d)
((#\4) #\e)
((#\5) #\f)
((#\6) #\g)
((#\7) #\h)
((#\8) #\i)
((#\9) #\j)))
(string->list (number->string
var-idx)))))))))
(define-public lily-modules '())
(define-public (add-lily-current-module)
(set! lily-modules (cons (module-name (current-module)) lily-modules)))
(defmacro-public use-lily-modules ()
`(use-modules ,@lily-modules))
(define-public (ly:parse-notes-expression str)
(let ((music-ident (gen-lily-sym)))
(ly:parse-string
(format #f "\\include \"declarations-init.ly\"
%% do nothing special with toplevel music
#(define (toplevel-music-handler x y) (display \"hi\") (newline))
~a = \\notes { ~a }
#(use-modules (scm lily-in-scm))
#(add-lily-current-module)
#(export ~a)
#(define-module ~a)
#(use-lily-modules)
"
music-ident str music-ident (module-name (current-module))))
(eval `,music-ident (current-module))))
(define-public (read-lily-expression chr port)
(let* ((format-args '())
(lily-string (with-output-to-string
(lambda ()
(do ((c (read-char port) (read-char port)))
((and (char=? c #\#)
(char=? (peek-char port) #\}))
(read-char port))
(cond ((and (char=? c #\$)
(not (char=? (peek-char port) #\$)))
;; a $variable
(display "~a")
(set! format-args (cons (read port) format-args)))
((and (char=? c #\$)
(char=? (peek-char port) #\$))
;; just a $ character
(display (read-char port)))
(else
;; other caracters
(display c))))))))
`(ly:parse-notes-expression (format #f ,lily-string ,@(reverse! format-args)))))
(read-hash-extend #\{ read-lily-expression)
%%%%%%%%%%% scm/lily-in-scm.scm %%%%%%%%%%%%%%
In the following example, this #{...#} syntax is used to build music
expressions within scheme functions:
%%%%%%%%%%% with-props.ly %%%%%%%%%%%%%%
#(use-modules (scm lily-in-scm)
(srfi srfi-1))
#(define (override->revert override-expr)
"Return a \\revert music expression for `override-expr', or
#f if it's not an override music expression."
(if (ly:music? override-expr)
(let* ((override (ly:music-property override-expr 'element))
(context (ly:music-property override-expr 'context-type))
(property (ly:music-property override 'grob-property))
(layout (ly:music-property override 'symbol)))
(if (and (ly:music? override) context property layout)
#{ \revert $context . $layout #'$property #}
#f))
#f))
#(define (overrides->reverts music)
"Return a sequential music expression with reverts for
each override found in music, which is supposed to be a music
expression"
(make-music 'SequentialMusic
'elements (filter-map override->revert (ly:music-property music 'elements))))
#(define (with-props props)
(lambda (music)
(set! (ly:music-property music 'elements)
(append (ly:music-property props 'elements)
(ly:music-property music 'elements)
(ly:music-property (overrides->reverts props) 'elements)))
music))
foo = \notes { c'8( d') e'( f') g'4( a') }
\score {
\notes {
\foo
\apply #(with-props #{
\override Stem #'thickness = #4
\override Slur #'transparent = ##t #}) { \foo }
\foo
}
}
%%%%%%%%%%% with-props.ly %%%%%%%%%%%%%%
nicolas
_______________________________________________
Lilypond-devel mailing list
[EMAIL PROTECTED]
http://mail.gnu.org/mailman/listinfo/lilypond-devel
