;;;;
;;;; 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))
(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)
(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))))
'grob-property gprop))
(define direction-polyphonic-grobs
- '(Stem Tie Rest Slur PhrasingSlur Script TextScript Dots DotColumn Fingering))
+ '(DotColumn
+ Dots
+ Fingering
+ LaissezVibrerTie
+ PhrasingSlur
+ RepeatTie
+ Rest
+ Script
+ Slur
+ Stem
+ TextScript
+ Tie))
(define-safe-public (make-voice-props-set n)
(make-sequential-music
(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 . "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)))))
+ (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."
(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.
'(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))