;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;; (use-modules (ice-9 optargs))
(make-procedure-with-setter ly:music-property
ly:music-set-property!))
+(define-safe-public (music-is-of-type? mus type)
+ "Does @code{mus} belong to the music class @code{type}?"
+ (memq type (ly:music-property mus 'types)))
;; TODO move this
(define-public ly:grob-property
(make-procedure-with-setter ly:grob-property
ly:grob-set-property!))
-(define-public ly:paper-system-property
- (make-procedure-with-setter ly:paper-system-property
- ly:paper-system-set-property!))
+(define-public ly:prob-property
+ (make-procedure-with-setter ly:prob-property
+ ly:prob-set-property!))
(define-public (music-map function music)
"Apply @var{function} to @var{music} and all of the music it contains.
(define-public (display-music music)
"Display music, not done with music-map for clarity of presentation."
+
(display music)
(display ": { ")
(let ((es (ly:music-property music 'elements))
(else ;; scheme arg
arg)))
(define (inner-markup->make-markup mrkup)
- (let ((cmd (proc->command-keyword (car mrkup)))
- (args (map transform-arg (cdr mrkup))))
- `(,cmd ,@args)))
+ (if (string? mrkup)
+ `(#:simple ,mrkup)
+ (let ((cmd (proc->command-keyword (car mrkup)))
+ (args (map transform-arg (cdr mrkup))))
+ `(,cmd ,@args))))
;; body:
(if (string? markup-expression)
markup-expression
',(ly:music-property obj 'name)
,@(apply append (map (lambda (prop)
`(',(car prop)
- ,(if (and (not (markup? (cdr prop)))
- (list? (cdr prop))
- (pair? (cdr prop))) ;; property is a non-empty list
- `(list ,@(map music->make-music (cdr prop)))
- (music->make-music (cdr prop)))))
+ ,(music->make-music (cdr prop))))
(remove (lambda (prop)
(eqv? (car prop) 'origin))
(ly:music-mutable-properties obj))))))
(;; an empty list (avoid having an unquoted empty list)
(null? obj)
`'())
+ (;; a proper list
+ (list? obj)
+ `(list ,@(map music->make-music obj)))
+ (;; a pair
+ (pair? obj)
+ `(cons ,(music->make-music (car obj))
+ ,(music->make-music (cdr obj))))
(else
obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (shift-one-duration-log music shift dot)
- " add SHIFT to ly:duration-log and optionally
+(define-public (shift-one-duration-log music shift dot)
+ " add SHIFT to duration-log of 'duration in music and optionally
a dot to any note encountered. This scales the music up by a factor
2^shift * (2 - (1/2)^dot)"
(let ((d (ly:music-property music 'duration)))
(set! (ly:music-property music 'duration) nd)))
music))
-
-
(define-public (shift-duration-log music shift dot)
(music-map (lambda (x) (shift-one-duration-log x shift dot))
music))
+(define-public (make-repeat name times main alts)
+ "create a repeat music expression, with all properties initialized properly"
+ (let ((talts (if (< times (length alts))
+ (begin
+ (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
+ (take alts times))
+ alts))
+ (r (make-repeated-music name)))
+ (set! (ly:music-property r 'element) main)
+ (set! (ly:music-property r 'repeat-count) (max times 1))
+ (set! (ly:music-property r 'elements) talts)
+ (if (equal? name "tremolo")
+ (let* ((dot? (zero? (modulo times 3)))
+ (dots (if dot? 1 0))
+ (mult (if dot?
+ (quotient (* times 2) 3)
+ times))
+ (shift (- (ly:intlog2 mult))))
+
+ (if (memq 'sequential-music (ly:music-property main 'types))
+ ;; \repeat "tremolo" { c4 d4 }
+ (let ((children (length (ly:music-property main 'elements))))
+ (if (not (= children 2))
+ (ly:warning (_ "expecting 2 elements for chord tremolo, found ~a") children))
+ (ly:music-compress r (ly:make-moment 1 children))
+ (shift-duration-log r (1- shift) dots))
+ ;; \repeat "tremolo" c4
+ (shift-duration-log r shift dots)))
+ r)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; clusters.
'grob-property gprop))
(define direction-polyphonic-grobs
- '(Stem Tie Rest Slur Script TextScript Dots DotColumn Fingering))
+ '(Stem Tie Rest Slur PhrasingSlur Script TextScript Dots DotColumn Fingering))
(define-safe-public (make-voice-props-set n)
(make-sequential-music
;; mmrest
(define-public (make-multi-measure-rest duration location)
- (make-music 'MultiMeasureRestMusicGroup
+ (make-music 'MultiMeasureRestMusic
'origin location
- 'elements (list (make-music 'BarCheck
- 'origin location)
- (make-event-chord (list (make-music 'MultiMeasureRestEvent
- 'origin location
- 'duration duration)))
- (make-music 'BarCheck
- 'origin location))))
-
-(define-public (glue-mm-rest-texts music)
- "Check if we have R1*4-\\markup { .. }, and if applicable convert to
-a property set for MultiMeasureRestNumber."
- (define (script-to-mmrest-text script-music)
- "Extract 'direction and 'text from SCRIPT-MUSIC, and transform into property sets."
- (let ((dir (ly:music-property script-music 'direction))
- (p (make-music 'MultiMeasureTextEvent
- 'text (ly:music-property script-music 'text))))
- (if (ly:dir? dir)
- (set! (ly:music-property p 'direction) dir))
- p))
- (if (eq? (ly:music-property music 'name) 'MultiMeasureRestMusicGroup)
- (let* ((text? (lambda (x) (memq 'script-event (ly:music-property x 'types))))
- (es (ly:music-property music 'elements))
- (texts (map script-to-mmrest-text (filter text? es)))
- (others (remove text? es)))
- (if (pair? texts)
- (set! (ly:music-property music 'elements)
- (cons (make-event-chord texts) others)))))
- music)
-
+ 'duration duration))
(define-public (make-property-set sym val)
(make-music 'PropertySet
'symbol sym
'value val))
+(define-public (make-property-unset sym)
+ (make-music 'PropertyUnset
+ 'symbol sym))
+
(define-public (make-ottava-set octavation)
(let ((m (make-music 'ApplyContext)))
(define (ottava-modify context)
(string (cdr (assoc octavation '((2 . "15ma")
(1 . "8va")
(0 . #f)
- (-1 . "8va bassa")
- (-2 . "15ma bassa"))))))
+ (-1 . "8vb")
+ (-2 . "15mb"))))))
(ly:context-set-property! context 'middleCPosition new-c0)
(ly:context-set-property! context 'originalCentralCPosition c0)
(ly:context-set-property! context 'ottavation string)))))
(define-public (make-time-signature-set num den . rest)
"Set properties for time signature NUM/DEN. Rest can contain a list
of beat groupings "
+
+ (define (standard-beat-grouping num den)
+
+ "Some standard subdivisions for time signatures."
+ (let*
+ ((key (cons num den))
+ (entry (assoc key '(((6 . 8) . (3 3))
+ ((5 . 8) . (3 2))
+ ((9 . 8) . (3 3 3))
+ ((12 . 8) . (3 3 3 3))
+ ((8 . 8) . (3 3 2))
+ ))))
+
+ (if entry
+ (cdr entry)
+ '())))
+
(let* ((set1 (make-property-set 'timeSignatureFraction (cons num den)))
(beat (ly:make-moment 1 den))
(len (ly:make-moment num den))
(set3 (make-property-set 'measureLength len))
(set4 (make-property-set 'beatGrouping (if (pair? rest)
(car rest)
- '())))
+ (standard-beat-grouping num den))))
(basic (list set1 set2 set3 set4)))
(descend-to-context
(context-spec-music (make-sequential-music basic) 'Timing) 'Score)))
(define-public (set-time-signature num den . rest)
(ly:export (apply make-time-signature-set `(,num ,den . ,rest))))
-(define-safe-public (make-penalty-music pen page-pen)
- (make-music 'BreakEvent
- 'penalty pen
- 'page-penalty page-pen))
-
(define-safe-public (make-articulation name)
(make-music 'ArticulationEvent
'articulation-type name))
"Split the parts of a chord into different Voices using separator"
(let ((es (ly:music-property ch 'elements)))
(set! (ly:music-property ch 'elements)
- (voicify-list (split-list es music-separator?) 0))
+ (voicify-list (split-list-by-separator es music-separator?) 0))
ch))
(define-public (voicify-music m)
(set! (ly:music-property m 'procedure) checker)
m))
+
+(define-public (skip->rest mus)
+
+ "Replace MUS by RestEvent of the same duration if it is a
+SkipEvent. Useful for extracting parts from crowded scores"
+
+ (if (equal? (ly:music-property mus 'name) 'SkipEvent)
+ (make-music 'RestEvent 'duration (ly:music-property mus 'duration))
+ mus))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warn for bare chords at start.
(equal? (ly:music-property x 'name) 'RequestChord))
elts)))
-(define (ly:music-message music msg)
+(define-public (ly:music-message music msg)
(let ((ip (ly:music-property music 'origin)))
(if (ly:input-location? ip)
(ly:input-message ip msg)
(defmacro-public def-grace-function (start stop)
- `(def-music-function (parser location music) (ly:music?)
+ `(define-music-function (parser location music) (ly:music?)
(make-music 'GraceMusic
'origin location
'element (make-music 'SequentialMusic
music
(ly:music-deep-copy ,stop))))))
-(defmacro-public def-music-function (args signature . body)
+(defmacro-public define-music-function (args signature . body)
"Helper macro for `ly:make-music-function'.
Syntax:
- (def-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+ (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
...function body...)
"
`(ly:make-music-function (list ,@signature)
(cue-voice (if (eq? 1 dir) 0 1))
(main-music (ly:music-property quote-music 'element))
(return-value quote-music))
-
+
(if (or (eq? 1 dir) (eq? -1 dir))
;; if we have stem dirs, change both quoted and main music
(quoted-vector (if (string? quoted-name)
(hash-ref quote-tab quoted-name #f)
#f)))
+
(if (string? quoted-name)
- (if (vector? quoted-vector)
- (set! (ly:music-property music 'quoted-events) quoted-vector)
- (ly:warning (_ "can't find quoted music `~S'" quoted-name))))
+ (if (vector? quoted-vector)
+ (begin
+ (set! (ly:music-property music 'quoted-events) quoted-vector)
+ (set! (ly:music-property music 'iterator-ctor)
+ ly:quote-iterator::constructor))
+ (ly:warning (_ "can't find quoted music `~S'" quoted-name))))
music))
(list
(make-sequential-music
(list
- (context-spec-music (make-property-set 'skipTypesetting #t) 'Score)
+ (context-spec-music (make-property-set 'skipTypesetting #t)
+ 'Score)
(make-music 'SkipMusic 'duration
- (ly:make-duration 0 0
- (ly:moment-main-numerator skip-length)
- (ly:moment-main-denominator skip-length)))
- (context-spec-music (make-property-set 'skipTypesetting #f) 'Score)))
+ (ly:make-duration
+ 0 0
+ (ly:moment-main-numerator skip-length)
+ (ly:moment-main-denominator skip-length)))
+ (context-spec-music (make-property-set 'skipTypesetting #f)
+ 'Score)))
music)))
music)))
(define-public toplevel-music-functions
(list
(lambda (music parser) (voicify-music music))
- (lambda (x parser) (music-map glue-mm-rest-texts x))
(lambda (x parser) (music-map music-check-error x))
(lambda (x parser) (music-map precompute-music-length x))
(lambda (music parser)
(skip-to-last x parser)
)))
+
;;;;;;;;;;;;;;;;;
;; lyrics
(music-map apply-duration lyric-music))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-(define-public ((add-balloon-text object-name text off) grob orig-context cur-context)
- "Usage: see input/regression/balloon.ly "
- (let* ((meta (ly:grob-property grob 'meta))
- (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant"))
- (cb (ly:grob-property grob 'print-function)))
- (if (equal? nm object-name)
- (begin
- (set! (ly:grob-property grob 'print-function) Balloon_interface::print)
- (set! (ly:grob-property grob 'balloon-original-callback) cb)
- (set! (ly:grob-property grob 'balloon-text) text)
- (set! (ly:grob-property grob 'balloon-text-offset) off)
- (set! (ly:grob-property grob 'balloon-text-props) '((font-family . roman)))))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accidentals
(ly:make-duration 0 0) '())))
(ly:music-compress skip (ly:music-length mus))
skip))
+
+(define-public (pitch-of-note event-chord)
+
+ (let*
+ ((evs (filter (lambda (x) (memq 'note-event (ly:music-property x 'types)))
+ (ly:music-property event-chord 'elements))))
+
+ (if (pair? evs)
+ (ly:music-property (car evs) 'pitch)
+ #f)))
+
projects / lilypond.git / blobdiff