;;; define-music-display-methods.scm -- data for displaying music
;;; expressions using LilyPond notation.
;;;
-;;; Copyright (C) 2005--2012 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2015 Nicolas Sceaux <nicolas.sceaux@free.fr>
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; durations
;;;
-(define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
- (force-duration (*force-duration*))
- (time-scale (*time-scale*))
- remember)
- (if remember (*previous-duration* ly-duration))
+(define*-public (duration->lily-string ly-duration #:key
+ (force-duration #f)
+ (time-scale (*time-scale*)))
(let ((log2 (ly:duration-log ly-duration))
(dots (ly:duration-dot-count ly-duration))
(scale (ly:duration-scale ly-duration)))
- (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
+ (if (or force-duration (not (*omit-duration*)))
(string-append (case log2
((-1) "\\breve")
((-2) "\\longa")
(define-display-method TremoloEvent (event parser)
- (let ((tremolo-type (ly:music-property event 'tremolo-type)))
- (format #f ":~a" (if (= 0 tremolo-type)
- ""
- tremolo-type))))
+ (let ((tremolo-type (ly:music-property event 'tremolo-type 8)))
+ (format #f ":~a" tremolo-type)))
(define-display-method ArticulationEvent (event parser) #t
(let* ((articulation (ly:music-property event 'articulation-type))
;; '<' (notepitch | drumpitch)* '>" duration post_events
(let ((duration (duration->lily-string (ly:music-property
(car chord-elements)
- 'duration)
- #:remember #t)))
+ 'duration))))
;; Format duration first so that it does not appear on
;; chord elements
(format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}"
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- chord-elements)
+ (parameterize ((*omit-duration* #t))
+ (map-in-order
+ (lambda (music)
+ (music->lily-string music parser))
+ chord-elements))
duration
(map-in-order (lambda (music)
(list
(music->lily-string music parser)))
other-elements))))
((ly:duration? chord-repeat)
- (let ((duration (duration->lily-string chord-repeat
- #:remember #t)))
+ (let ((duration (duration->lily-string chord-repeat)))
(format #f "q~a~:{~:[-~;~]~a~^ ~}"
duration
(map-in-order (lambda (music)
(define-display-method MultiMeasureRestMusic (mmrest parser)
(format #f "R~a~{~a~^ ~}"
- (duration->lily-string (ly:music-property mmrest 'duration)
- #:remember #t)
+ (duration->lily-string (ly:music-property mmrest 'duration))
(map-in-order (lambda (music)
(music->lily-string music parser))
(ly:music-property mmrest 'articulations))))
(make-string (1- (* -1 octave-check)) #\,))
(else "")))
""))
- (duration->lily-string (ly:music-property event 'duration)
- #:remember #t)
+ (duration->lily-string (ly:music-property event 'duration))
(if ((make-music-type-predicate 'RestEvent) event)
"\\rest" "")
(map-in-order (lambda (event)
(simple-note->lily-string note parser))
((not (null? (ly:music-property note 'drum-type))) ;; drum
(format #f "~a~a~{~a~}" (ly:music-property note 'drum-type)
- (duration->lily-string (ly:music-property note 'duration)
- #:remember #t)
+ (duration->lily-string (ly:music-property note 'duration))
(map-in-order (lambda (event)
(music->lily-string event parser))
(ly:music-property note 'articulations))))
- (else ;; unknown?
- "")))
+ (else
+ ;; pure duration
+ (format #f "~a~{~a~}"
+ (duration->lily-string (ly:music-property note 'duration)
+ #:force-duration #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property note 'articulations))))))
(define-display-method ClusterNoteEvent (note parser)
(simple-note->lily-string note parser))
(if (not (null? (ly:music-property rest 'pitch)))
(simple-note->lily-string rest parser)
(format #f "r~a~{~a~}"
- (duration->lily-string (ly:music-property rest 'duration)
- #:remember #t)
+ (duration->lily-string (ly:music-property rest 'duration))
(map-in-order (lambda (event)
(music->lily-string event parser))
(ly:music-property rest 'articulations)))))
(define-display-method MultiMeasureRestEvent (rest parser)
- (string-append "R" (duration->lily-string (ly:music-property rest 'duration)
- #:remember #t)))
+ (string-append "R" (duration->lily-string (ly:music-property rest 'duration))))
(define-display-method SkipEvent (rest parser)
(format #f "s~a~{~a~}"
- (duration->lily-string (ly:music-property rest 'duration)
- #:remember #t)
+ (duration->lily-string (ly:music-property rest 'duration))
(map-in-order (lambda (event)
(music->lily-string event parser))
(ly:music-property rest 'articulations))))
(if (null? bracket-stop) "" "]"))))
(define-display-method LyricEvent (lyric parser)
- (format "~a~{~a~^ ~}"
+ (format #f "~a~{~a~^ ~}"
(let ((text (ly:music-property lyric 'text)))
(if (or (string? text)
(eqv? (first text) simple-markup))
(and span (duration->lily-string span #:force-duration #t)))
(scale (/ num den))
(time-scale (*time-scale*)))
- (*previous-duration* #f)
(let ((result
(parameterize ((*force-line-break* #f)
(*time-scale* (* time-scale scale)))
num
formatted-span
(music->lily-string (ly:music-property times 'element) parser)))))
- (*previous-duration* #f)
result)))
(define-display-method RelativeOctaveMusic (m parser)
(repeat->lily-string expr "percent" parser))
(define-display-method TremoloRepeatedMusic (expr parser)
- (let* ((main (ly:music-property expr 'element))
- (children (if (music-is-of-type? main 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music main '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- (times (ly:music-property expr 'repeat-count))
-
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
- ;; times * children
- (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult)))))
- (set! main (ly:music-deep-copy main))
- ;; Adjust the time of the notes
- (ly:music-compress main (ly:make-moment children 1))
- ;; Adjust the displayed note durations
- (shift-duration-log main (- shift) (- dots))
- (format #f "\\repeat tremolo ~a ~a"
- times
- (music->lily-string main parser))))
+ (repeat->lily-string expr "tremolo" parser))
;;;
;;; Contexts
(music->lily-string element parser))
#f)))
-(define (property-value->lily-string arg parser)
+(define-public (value->lily-string arg parser)
(cond ((ly:music? arg)
(music->lily-string arg parser))
((string? arg)
(format #f "#~s" arg))
((markup? arg)
(markup->lily-string arg))
+ ((ly:duration? arg)
+ (format #f "##{ ~a #}" (duration->lily-string arg #:force-duration #t)))
+ ((ly:pitch? arg)
+ (format #f "~a~a"
+ (note-name->lily-string arg parser)
+ (octave->lily-string arg)))
(else
(format #f "#~a" (scheme-expr->lily-string arg)))))
""
(format #f "~a . " (*current-context*)))
property
- (property-value->lily-string value parser)
+ (value->lily-string value parser)
(new-line->lily-string))))
(define-display-method PropertyUnset (expr parser)
(if (eqv? (*current-context*) 'Bottom)
(cons symbol properties)
(cons* (*current-context*) symbol properties))
- (property-value->lily-string value parser)
+ (value->lily-string value parser)
(new-line->lily-string))))
(define-display-method RevertProperty (expr parser)
(music 'PropertySet
value ?clef-transposition
symbol 'clefTransposition)
+ (music 'PropertySet
+ value ?clef-transposition-style
+ symbol 'clefTranspositionStyle)
(music 'ApplyContext
procedure ly:set-middle-C!)))))
(let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
clef-name-alist)))
- (if clef-name
- (format #f "\\clef \"~a~{~a~a~}\"~a"
- clef-name
- (cond ((= 0 ?clef-transposition)
- (list "" ""))
- ((> ?clef-transposition 0)
- (list "^" (1+ ?clef-transposition)))
- (else
- (list "_" (- 1 ?clef-transposition))))
- (new-line->lily-string))
- #f))))
+ (and clef-name
+ (format #f "\\clef \"~a~?\"~a"
+ clef-name
+ (case ?clef-transposition-style
+ ((parenthesized) "~a(~a)")
+ ((bracketed) "~a[~a]")
+ (else "~a~a"))
+ (cond ((zero? ?clef-transposition)
+ (list "" ""))
+ ((positive? ?clef-transposition)
+ (list "^" (1+ ?clef-transposition)))
+ (else (list "_" (- 1 ?clef-transposition))))
+ (new-line->lily-string))))))
;;; \bar
(define-extra-display-method ContextSpeccedMusic (expr parser)
quoted-voice-direction ?quoted-voice-direction
quoted-music-name ?quoted-music-name
quoted-context-id "cue"
- quoted-context-type 'Voice
+ quoted-context-type 'CueVoice
element ?music))
(format #f "\\cueDuring #~s #~a ~a"
?quoted-music-name
(define-display-method LyricCombineMusic (expr parser)
(format #f "\\lyricsto ~s ~a"
(ly:music-property expr 'associated-context)
- (parameterize ((*explicit-mode* #f))
+ (parameterize ((*explicit-mode* #f)
+ (*omit-duration* #t))
(music->lily-string (ly:music-property expr 'element) parser))))
;; \addlyrics
(format #f "~a~a \\addlyrics ~a"
(music->lily-string ?note-sequence parser)
(new-line->lily-string)
- (parameterize ((*explicit-mode* #f))
+ (parameterize ((*explicit-mode* #f)
+ (*omit-duration* #t))
(music->lily-string ?lyric-sequence parser)))
#f)))