X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdisplay-lily.scm;h=16f809fc8bca2306e6c71d57cc5722bdfdc009fc;hb=c6911c343c9eb17831220c416b5f100670af96e7;hp=b7e253566aa54414529d9b099bacf6da21be42e9;hpb=086cfb9aebcd5a68cc5186a0103aa270037f0570;p=lilypond.git diff --git a/scm/display-lily.scm b/scm/display-lily.scm index b7e253566a..16f809fc8b 100644 --- a/scm/display-lily.scm +++ b/scm/display-lily.scm @@ -2,7 +2,7 @@ ;;; ;;; ;;; -;;; (c) 2005--2006 Nicolas Sceaux +;;; Copyright (C) 2005--2012 Nicolas Sceaux ;;; ;;; - This file defines the procedures used to define display methods for each @@ -28,9 +28,7 @@ #: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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -41,7 +39,7 @@ (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 parser) ...body...))" @@ -57,9 +55,9 @@ Syntax: (define-display-method MusicType (expression parser) 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 '())) @@ -81,8 +79,20 @@ display method will be called." (format #f "~a\\tag #'~a" (if post-event? "-" "") tag)) (ly:music-property expr 'tags)))) +(define* (tweaks->lily-string expr #:optional (post-event? #f)) + (format #f "~{~a ~}" + (map (lambda (tweak) + (format #f "~a\\tweak ~a #~a" + (if post-event? "-" "") + (if (pair? (car tweak)) + (format #f "~a #'~a" + (caar tweak) (cdar tweak)) + (format #f "#'~a" (car tweak))) + (scheme-expr->lily-string (cdr tweak)))) + (ly:music-property expr 'tweaks)))) + (define-public (music->lily-string expr parser) - "Print expr, a music expression, in LilyPond syntax" + "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 @@ -92,8 +102,9 @@ display method will be called." (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))) @@ -132,7 +143,7 @@ display method will be called." (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 . ) pair. (pat-all-props (cons (cons 'name (second pattern)) @@ -230,7 +241,7 @@ Generate binding forms by looking for ?var symbol in 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 property value property ?var1 @@ -243,8 +254,8 @@ pattern (the name property being the symbol after the `music' 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)) @@ -274,8 +285,7 @@ inside body." (define *max-element-number-before-break* (make-parameter 6)) ;; \times factor (used in durations) -(define *time-factor-denominator* (make-parameter #f)) -(define *time-factor-numerator* (make-parameter #f)) +(define *time-scale* (make-parameter 1)) (define *current-context* (make-parameter 'Bottom)) @@ -289,11 +299,14 @@ inside body." ;;; (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") +