;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; 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)))
(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)))
;; mmrest
(define-public (make-multi-measure-rest duration location)
- (make-music 'MultiMeasureRest
+ (make-music 'MultiMeasureRestMusic
'origin location
'duration duration))
'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)
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)))))
+ (begin
+ (if (number? (ly:context-property context 'originalMiddleCPosition))
+ (let ((where (ly:context-property-where-defined context 'middleCPosition)))
+
+ (ly:context-set-property! context 'middleCPosition
+ (ly:context-property context 'originalMiddleCPosition))
+ (ly:context-unset-property where 'originalMiddleCPosition)
+ (ly:context-unset-property where 'ottavation)))
+ot
+ (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 . "8vb")
+ (-2 . "15mb"))))))
+ (ly:context-set-property! context 'middleCPosition new-c0)
+ (ly:context-set-property! context 'originalMiddleCPosition c0)
+ (ly:context-set-property! context 'ottavation string)))))
(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)
"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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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