;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;; (use-modules (ice-9 optargs))
(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
(newline)
obj)
+;;;
+;;; Scheme music expression --> Lily-syntax-using string translator
+;;;
+(use-modules (srfi srfi-39)
+ (scm display-lily))
+
+(define*-public (display-lily-music expr parser #: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)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (shift-one-duration-log music shift dot)
"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"))
+ (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
(take alts times))
alts))
(r (make-repeated-music name)))
(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))))
-
+ (let* ((dots (1- (logcount times)))
+ (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots))))
+ (shift (- (ly:intlog2 (floor mult)))))
+ (if (not (integer? mult))
+ (ly:warning (_ "invalid tremolo repeat count: ~a") times))
(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))
+
+ ;; fixme: should be more generic.
+ (if (and (not (= children 2))
+ (not (= children 1)))
(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))
+ (shift-duration-log r
+ (if (= children 2) (1- shift) shift)
+ dots))
;; \repeat "tremolo" c4
(shift-duration-log r shift dots)))
r)))
(if (odd? n) -1 1)))
direction-polyphonic-grobs)
(list
+ (make-property-set 'graceSettings
+ ;; TODO: take this from voicedGraceSettings or similar.
+ '((Voice Stem font-size -3)
+ (Voice NoteHead font-size -3)
+ (Voice Dots font-size -3)
+ (Voice Stem length-fraction 0.8)
+ (Voice Stem no-stem-extend #t)
+ (Voice Beam thickness 0.384)
+ (Voice Beam length-fraction 0.8)
+ (Voice Accidental font-size -4)))
+
(make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
(make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
(append
(map (lambda (x) (make-grob-property-revert x 'direction))
direction-polyphonic-grobs)
- (list (make-grob-property-revert 'NoteColumn 'horizontal-shift))
- (list (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
+ (list (make-property-unset 'graceSettings)
+ (make-grob-property-revert 'NoteColumn 'horizontal-shift)
+ (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
(define-safe-public (context-spec-music m context #:optional id)
"Either reset middleCPosition to the stored original, or remember
old middleCPosition, add OCTAVATION to middleCPosition, and set
OTTAVATION to `8va', or whatever appropriate."
- (if (number? (ly:context-property context 'middleCPosition))
- (if (= octavation 0)
- (let ((where (ly:context-property-where-defined context 'middleCPosition))
- (oc0 (ly:context-property context 'originalCentralCPosition)))
- (ly:context-set-property! context 'middleCPosition oc0)
- (ly:context-unset-property where 'originalCentralCPosition)
- (ly:context-unset-property where 'ottavation))
- (let* ((where (ly:context-property-where-defined context 'middleCPosition))
- (c0 (ly:context-property context 'middleCPosition))
- (new-c0 (+ c0 (* -7 octavation)))
- (string (cdr (assoc octavation '((2 . "15ma")
- (1 . "8va")
- (0 . #f)
- (-1 . "8va bassa")
- (-2 . "15ma bassa"))))))
- (ly:context-set-property! context 'middleCPosition new-c0)
- (ly:context-set-property! context 'originalCentralCPosition c0)
- (ly:context-set-property! context 'ottavation string)))))
+ (if (number? (ly:context-property context 'middleCOffset))
+ (let ((where (ly:context-property-where-defined context 'middleCOffset)))
+ (ly:context-unset-property where 'middleCOffset)
+ (ly:context-unset-property where 'ottavation)))
+
+ (let* ((offset (* -7 octavation))
+ (string (cdr (assoc octavation '((2 . "15ma")
+ (1 . "8va")
+ (0 . #f)
+ (-1 . "8vb")
+ (-2 . "15mb"))))))
+ (ly:context-set-property! context 'middleCOffset offset)
+ (ly:context-set-property! context 'ottavation string)
+ (ly:set-middle-C! context)))
(set! (ly:music-property m 'procedure) ottava-modify)
(context-spec-music m 'Staff)))
'duration duration
'text string))
-(define-safe-public (make-span-event type spandir)
+(define-safe-public (make-span-event type span-dir)
(make-music type
- 'span-direction spandir))
+ 'span-direction span-dir))
(define-public (set-mus-properties! m alist)
"Set all of ALIST as properties of M."
"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)
(define-public (empty-music)
(ly:export (make-music 'Music)))
-;;;
- ; Make a function that checks score element for being of a specific type.
+;; Make a function that checks score element for being of a specific type.
(define-public (make-type-checker symbol)
(lambda (elt)
;;(display symbol)
"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)
+ (if (memq (ly:music-property mus 'name) '(SkipEvent SkipMusic))
(make-music 'RestEvent 'duration (ly:music-property mus 'duration))
mus))
+(define-public (music-has-type music type)
+ (memq type (ly:music-property music 'types)))
+
+(define-public (music-clone music)
+ (define (alist->args alist acc)
+ (if (null? alist)
+ acc
+ (alist->args (cdr alist)
+ (cons (caar alist) (cons (cdar alist) acc)))))
+
+ (apply
+ make-music
+ (ly:music-property music 'name)
+ (alist->args (ly:music-mutable-properties music) '())))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warn for bare chords at start.
-(define (has-request-chord elts)
- (reduce (lambda (x y) (or x y)) #f
- (map (lambda (x)
- (equal? (ly:music-property x 'name) 'RequestChord))
- elts)))
(define-public (ly:music-message music msg)
(let ((ip (ly:music-property music 'origin)))
(ly:input-message ip msg)
(ly:warning msg))))
-(define (check-start-chords music)
- "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords),
-without context specification. Called from parser."
- (let ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element))
- (name (ly:music-property music 'name)))
- (cond ((equal? name "Context_specced_music") #t)
- ((equal? name "Simultaneous_music")
- (if (has-request-chord es)
- (ly:music-message music "Starting score with a chord.\nInsert an explicit \\context before chord")
- (map check-start-chords es)))
- ((equal? name "SequentialMusic")
- (if (pair? es)
- (check-start-chords (car es))))
- (else (if (ly:music? e) (check-start-chords e)))))
- music)
-
-
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; setting stuff for grace context.
(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))))
+ (ly:warning (_ "cannot 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)))
(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))
- (cb (ly:grob-property-data grob 'stencil))
- (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant")))
- (if (and (equal? nm object-name)
- (procedure? cb))
- (begin
- (ly:grob-set-property! grob 'stencil ly:balloon-interface::print)
- (set! (ly:grob-property grob 'original-stencil) 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
'(Staff (any-octave . 0) (same-octave . 1)
GrandStaff (any-octave . 0) (same-octave . 1))
pcontext))
+
;; do not set localKeySignature when a note alterated differently from
;; localKeySignature is found.
;; Causes accidentals to be printed at every note instead of
;; remembered for the duration of a measure.
- ;; accidentals not being remembered, causing accidentals always to be typeset relative to the time signature
+ ;; accidentals not being remembered, causing accidentals always to
+ ;; be typeset relative to the time signature
+
((equal? style 'forget)
(set-accidentals-properties '()
'(Staff (same-octave . -1))
projects / lilypond.git / blobdiff