X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdisplay-lily.scm;h=16f809fc8bca2306e6c71d57cc5722bdfdc009fc;hb=9cba6d0b05bd28e2fc73f091b09ace570c976182;hp=a19a3f7974e2bc8398a01510b549ba02e8950da3;hpb=14dfbf5b4561d3de6574a27b74f859f7235c6375;p=lilypond.git diff --git a/scm/display-lily.scm b/scm/display-lily.scm index a19a3f7974..16f809fc8b 100644 --- a/scm/display-lily.scm +++ b/scm/display-lily.scm @@ -2,7 +2,7 @@ ;;; ;;; ;;; -;;; (c) 2005 Nicolas Sceaux +;;; Copyright (C) 2005--2012 Nicolas Sceaux ;;; ;;; - This file defines the procedures used to define display methods for each @@ -11,9 +11,10 @@ ;;; 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. @@ -27,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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -40,9 +39,9 @@ (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 '())) @@ -56,9 +55,9 @@ Syntax: (define-display-method MusicType (expression) 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 '())) @@ -75,39 +74,42 @@ display method will be called." new-method)) (define* (tag->lily-string expr #:optional (post-event? #f)) - (let ((tags (ly:music-property expr 'tags))) - (cond ((null? tags) - "") - ((null? (cdr tags)) - (format #f "~a\\tag #'~a " (if post-event? "-" "") (car tags))) - (else - (format #f "~a\\tag #'(~a~{ ~a~}) " (if post-event? "-" "") (car tags) (cdr tags)))))) - -(define-public (music->lily-string expr) - "Print expr, a music expression, in LilyPond syntax" + (format #f "~{~a ~}" + (map (lambda (tag) + (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 @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 @@ -141,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)) @@ -239,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 @@ -252,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)) @@ -270,23 +272,20 @@ inside body." ;;; ;;; 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 *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 *parser* (make-parameter #f)) +(define *time-scale* (make-parameter 1)) (define *current-context* (make-parameter 'Bottom)) @@ -300,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") +