;;;
;;;
;;;
-;;; (c) 2005 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2011 Nicolas Sceaux <nicolas.sceaux@free.fr>
;;;
;;; - This file defines the procedures used to define display methods for each
;;; Display methods are stored in the `display-methods' property of each music
;;; type.
;;;
-;;; - `display-lily-music' can be called to display a music expression using
-;;; LilyPond notation. `music->lily-string' return a string describing a music
-;;; expression using LilyPond notation.
+;;; - `music->lily-string' return a string describing a music expression using
+;;; LilyPond notation. The special variables *indent*, *previous-duration*,
+;;; and *force-duration* influence the indentation level and the display of
+;;; music durations.
;;;
;;; - `with-music-match' can be used to destructure a music expression, extracting
;;; some interesting music properties.
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-39)
- #:use-module (lily)
- #:use-syntax (srfi srfi-39)
- #:use-syntax (ice-9 optargs))
+ #:use-module (lily))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(define-macro (define-display-method music-type vars . body)
"Define a display method for a music type and store it in the
`display-methods' property of the music type entry found in the
-`music-name-to-property-table' hash table. Print methods previously
+`music-name-to-property-table' hash table. Print methods previously
defined for that music type are lost.
-Syntax: (define-display-method MusicType (expression)
+Syntax: (define-display-method MusicType (expression parser)
...body...))"
`(let ((type-props (hashq-ref music-name-to-property-table
',music-type '()))
method))
(define-macro (define-extra-display-method music-type vars . body)
- "Add a display method for a music type. A primary display method
+ "Add a display method for a music type. A primary display method
is supposed to have been previously defined with `define-display-method'.
-This new method should return a string or #f. If #f is returned, the next
+This new method should return a string or #f. If #f is returned, the next
display method will be called."
`(let* ((type-props (hashq-ref music-name-to-property-table
',music-type '()))
(define* (tag->lily-string expr #:optional (post-event? #f))
(format #f "~{~a ~}"
- (map (lambda (tag)
- (format #f "~a\\tag #'~a" (if post-event? "-" "") tag))
- (ly:music-property expr 'tags))))
+ (map (lambda (tag)
+ (format #f "~a\\tag #'~a" (if post-event? "-" "") tag))
+ (ly:music-property expr 'tags))))
-(define-public (music->lily-string expr)
- "Print expr, a music expression, in LilyPond syntax"
+(define* (tweaks->lily-string expr #:optional (post-event? #f))
+ (format #f "~{~a ~}"
+ (map (lambda (tweak)
+ (format #f "~a\\tweak #'~a #~a"
+ (if post-event? "-" "")
+ (car tweak)
+ (scheme-expr->lily-string (cdr tweak))))
+ (ly:music-property expr 'tweaks))))
+
+(define-public (music->lily-string expr parser)
+ "Print @var{expr}, a music expression, in LilyPond syntax."
(if (ly:music? expr)
(let* ((music-type (ly:music-property expr 'name))
(procs (assoc-ref (hashq-ref music-name-to-property-table
music-type '())
'display-methods))
(result-string (and procs (any (lambda (proc)
- (proc expr))
+ (proc expr parser))
procs))))
(if result-string
- (format #f "~a~a"
- (tag->lily-string expr (post-event? expr))
+ (format #f "~a~a~a"
+ (tag->lily-string expr (post-event? expr))
+ (tweaks->lily-string expr (post-event? expr))
result-string)
(format #f "%{ Print method not implemented for music type ~a %}"
music-type)))
(format #f "%{ expecting a music expression: ~a %}" expr)))
-(define*-public (display-lily-music expr #:key force-duration)
- (parameterize ((*indent* 0)
- (*previous-duration* (ly:make-duration 2))
- (*force-duration* force-duration))
- (display (music->lily-string expr))
- (newline)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Music pattern matching
(define (gen-condition expr pattern)
"Helper function for `with-music-match'.
Generate an form that checks if the properties of `expr'
-match thoses desscribed in `pattern'."
+match thoses described in `pattern'."
(let* (;; all (property . value) found at the first depth in pattern,
;; including a (name . <Musictype>) pair.
(pat-all-props (cons (cons 'name (second pattern))
elements-list))))
(define-macro (with-music-match music-expr+pattern . body)
- "If `music-expr' matches `pattern', call `body'. `pattern' should look like:
+ "If `music-expr' matches `pattern', call `body'. `pattern' should look like:
'(music <MusicType>
property value
property ?var1
keyword), then all music expression found in its properties (such as 'element
or 'elements).
When ?var is found instead of a property value, ?var is bound that property value,
-as read inside `music-expr'. ?var may also be used to refere to a whole music
-expression inside an elements list for instance. These bindings are accessible
+as read inside `music-expr'. ?var may also be used to refere to a whole music
+expression inside an elements list for instance. These bindings are accessible
inside body."
(let ((music-expr (first music-expr+pattern))
(pattern (second music-expr+pattern))
;;;
;;; indentation
-(define *indent* (make-parameter 0))
+(define-public *indent* (make-parameter 0))
;;; set to #t to force duration printing
-(define *force-duration* (make-parameter #f))
+(define-public *force-duration* (make-parameter #f))
;;; last duration found
-(define *previous-duration* (make-parameter (ly:make-duration 2)))
+(define-public *previous-duration* (make-parameter (ly:make-duration 2)))
;;; Set to #t to force a line break with some kinds of expressions (eg sequential music)
(define *force-line-break* (make-parameter #t))
(define *time-factor-denominator* (make-parameter #f))
(define *time-factor-numerator* (make-parameter #f))
-(define *parser* (make-parameter #f))
-
(define *current-context* (make-parameter 'Bottom))
(define *explicit-mode* (make-parameter #t))
;;;
(define (make-music-type-predicate . music-types)
- (define ((make-music-type-predicate-aux mtypes) expr)
- (if (null? mtypes)
- #f
- (or (eqv? (car mtypes) (ly:music-property expr 'name))
- ((make-music-type-predicate-aux (cdr mtypes)) expr))))
- (make-music-type-predicate-aux music-types))
-
-(load "define-music-display-methods.scm")
\ No newline at end of file
+ (define make-music-type-predicate-aux
+ (lambda (mtypes)
+ (lambda (expr)
+ (if (null? mtypes)
+ #f
+ (or (eqv? (car mtypes) (ly:music-property expr 'name))
+ ((make-music-type-predicate-aux (cdr mtypes)) expr))))))
+ (make-music-type-predicate-aux music-types))
+
+(ly:load "define-music-display-methods.scm")
+
projects / lilypond.git / blobdiff