X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=1b1d07c490fefefbcaeaadfff19f7eec604283fd;hb=706b1bf8f6eed212eb1314641148ecea950623e8;hp=bfec250992e5c9c7910e496a7f40823a48fadd6e;hpb=458fd4607f01a2ef304db3ba65921f488f4016e5;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index bfec250992..1b1d07c490 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -16,7 +16,10 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -;; (use-modules (ice-9 optargs)) +; for define-safe-public when byte-compiling using Guile V2 +(use-modules (scm safe-utility-defs)) + +(use-modules (ice-9 optargs)) ;;; ly:music-property with setter ;;; (ly:music-property my-music 'elements) @@ -79,9 +82,12 @@ First it recurses over the children, then the function is applied to (inner-music-filter pred? e) e)) (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es)))) - (set! (ly:music-property music 'element) filtered-e) - (set! (ly:music-property music 'elements) filtered-es) - (set! (ly:music-property music 'articulations) filtered-as) + (if (not (null? e)) + (set! (ly:music-property music 'element) filtered-e)) + (if (not (null? es)) + (set! (ly:music-property music 'elements) filtered-es)) + (if (not (null? as)) + (set! (ly:music-property music 'articulations) filtered-as)) ;; if filtering emptied the expression, we remove it completely. (if (or (not (pred? music)) (and (eq? filtered-es '()) (not (ly:music? e)) @@ -95,24 +101,23 @@ First it recurses over the children, then the function is applied to music (make-music 'Music))) ;must return music. -(define-public (display-music music) +(define*-public (display-music music #:optional (port (current-output-port))) "Display music, not done with @code{music-map} for clarity of presentation." - - (display music) - (display ": { ") + (display music port) + (display ": { " port) (let ((es (ly:music-property music 'elements)) (e (ly:music-property music 'element))) - (display (ly:music-mutable-properties music)) + (display (ly:music-mutable-properties music) port) (if (pair? es) - (begin (display "\nElements: {\n") - (map display-music es) - (display "}\n"))) + (begin (display "\nElements: {\n" port) + (for-each (lambda (m) (display-music m port)) es) + (display "}\n" port))) (if (ly:music? e) (begin - (display "\nChild:") - (display-music e)))) - (display " }\n") + (display "\nChild:" port) + (display-music e port)))) + (display " }\n" port) music) ;;; @@ -203,13 +208,9 @@ equivalent to @var{obj}, that is, for a music expression, a (use-modules (ice-9 pretty-print)) (define*-public (display-scheme-music obj #:optional (port (current-output-port))) "Displays `obj', typically a music expression, in a friendly fashion, -which often can be read back in order to generate an equivalent expression. - -Returns `obj'. -" +which often can be read back in order to generate an equivalent expression." (pretty-print (music->make-music obj) port) - (newline) - obj) + (newline port)) ;;; ;;; Scheme music expression --> Lily-syntax-using string translator @@ -217,28 +218,30 @@ Returns `obj'. (use-modules (srfi srfi-39) (scm display-lily)) -(define*-public (display-lily-music expr parser #:key force-duration) +(define*-public (display-lily-music expr parser #:optional (port (current-output-port)) + #:key force-duration) "Display the music expression using LilyPond syntax" (memoize-clef-names supported-clefs) (parameterize ((*indent* 0) (*previous-duration* (ly:make-duration 2)) (*force-duration* force-duration)) - (display (music->lily-string expr parser)) - (newline))) + (display (music->lily-string expr parser) port) + (newline port))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (shift-one-duration-log music shift dot) "Add @var{shift} to @code{duration-log} of @code{'duration} in -@var{music} and optionally @var{dot} to any note encountered. This -scales the music up by a factor `2^@var{shift} * (2 - (1/2)^@var{dot})'." +@var{music} and optionally @var{dot} to any note encountered. +The number of dots in the shifted music may not be less than zero." (let ((d (ly:music-property music 'duration))) (if (ly:duration? d) (let* ((cp (ly:duration-factor d)) - (nd (ly:make-duration (+ shift (ly:duration-log d)) - (+ dot (ly:duration-dot-count d)) - (car cp) - (cdr cp)))) + (nd (ly:make-duration + (+ shift (ly:duration-log d)) + (max 0 (+ dot (ly:duration-dot-count d))) + (car cp) + (cdr cp)))) (set! (ly:music-property music 'duration) nd))) music)) @@ -514,24 +517,6 @@ in @var{grob}." (make-music 'PropertyUnset 'symbol sym)) -;;; Need to keep this definition for \time calls from parser -(define-public (make-time-signature-set num den) - "Set properties for time signature @var{num}/@var{den}." - (make-music 'TimeSignatureMusic - 'numerator num - 'denominator den - 'beat-structure '())) - -;;; Used for calls that include beat-grouping setting -(define-public (set-time-signature num den . rest) - "Set properties for time signature @var{num}/@var{den}. -If @var{rest} is present, it is used to set @code{beatStructure}." - (ly:export - (make-music 'TimeSignatureMusic - 'numerator num - 'denominator den - 'beat-structure (if (null? rest) rest (car rest))))) - (define-safe-public (make-articulation name) (make-music 'ArticulationEvent 'articulation-type name)) @@ -634,7 +619,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. m)) (define-public (empty-music) - (ly:export (make-music 'Music))) + (make-music 'Music)) ;; Make a function that checks score element for being of a specific type. (define-public (make-type-checker symbol) @@ -727,7 +712,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (new-settings (append current (list (list context-name grob sym val))))) (ly:context-set-property! where 'graceSettings new-settings))) - (ly:export (context-spec-music (make-apply-context set-prop) 'Voice))) + (context-spec-music (make-apply-context set-prop) 'Voice)) (define-public (remove-grace-property context-name grob sym) "Remove all @var{sym} for @var{grob} in @var{context-name}." @@ -746,7 +731,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (set! new-settings (delete x new-settings))) prop-settings) (ly:context-set-property! where 'graceSettings new-settings))) - (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice))) + (context-spec-music (make-apply-context delete-prop) 'Voice)) @@ -856,7 +841,7 @@ void return value (i.e., what most Guile functions with `unspecified' value return). Use this when defining functions for executing actions rather than returning values, to keep Lilypond from trying to interpret the return value." - `(define-syntax-function void? ,@rest #f (begin))) + `(define-syntax-function (void? *unspecified*) ,@rest *unspecified*)) (defmacro-public define-event-function rest "Defining macro returning event functions. @@ -1316,8 +1301,7 @@ as a context." (car rest) 'Staff)) (pcontext (if (pair? rest) (car rest) 'GrandStaff))) - (ly:export - (cond + (cond ;; accidentals as they were common in the 18th century. ((equal? style 'default) (set-accidentals-properties #t @@ -1470,7 +1454,7 @@ as a context." context)) (else (ly:warning (_ "unknown accidental style: ~S") style) - (make-sequential-music '())))))) + (make-sequential-music '()))))) (define-public (invalidate-alterations context) "Invalidate alterations in @var{context}. @@ -1501,7 +1485,7 @@ Entries that conform with the current key signature are not invalidated." entry (cons (car entry) (cons 'clef (cddr entry)))))) (ly:context-property context 'localKeySignature))))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (skip-of-length mus)