layout props (make-circle-markup text))))
circle))
+(define-public (music-cause grob)
+ (let*
+ ((event (event-cause grob)))
+
+ (if (ly:stream-event? event)
+ (ly:event-property event 'music-cause)
+ #f)))
(define-public (event-cause grob)
(let*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; note heads
-(define-public (note-head::calc-duration-log grob)
+
+(define-public (stem::calc-duration-log grob)
(ly:duration-log
(ly:event-property (event-cause grob) 'duration)))
+(define-public (note-head::calc-duration-log grob)
+ (min 2
+ (ly:duration-log
+ (ly:event-property (event-cause grob) 'duration))))
+
(define-public (dots::calc-dot-count grob)
(ly:duration-dot-count
(ly:event-property (event-cause grob) 'duration)))
(log (min 2 (ly:grob-property grob 'duration-log))))
(case style
+ ;; "default" style is directly handled in note-head.cc as a
+ ;; special case (HW says, mainly for performance reasons).
+ ;; Therefore, style "default" does not appear in this case
+ ;; statement. -- jr
((xcircle) "2xcircle")
((harmonic) "0harmonic")
((baroque)
(string-append (number->string log) (symbol->string style))))
((neomensural)
(string-append (number->string log) (symbol->string style)))
- ((default)
- ;; The default font in mf/feta-bolletjes.mf defines a brevis, but
- ;; neither a longa nor a maxima. Hence let us, for the moment,
- ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes
- ;; should define at least a longa for the default font. The longa
- ;; should look exactly like the brevis of the default font, but
- ;; with a stem exactly like that of the quarter note. -- jr
- (if (< log -1)
- (string-append (number->string log) "neomensural")
- (number->string log)))
(else
(if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
(symbol->string style)
(ly:grob-relative-coordinate me y-ref Y))))
))
-
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(padding (ly:grob-property spanner 'padding 0.5))
(common (ly:grob-common-refpoint right-span
(ly:grob-common-refpoint spanner
- left-span X)
+ left-span X)
X))
- (left-x (+ padding (interval-end (ly:grob-robust-relative-extent left-span common X))))
- (right-x (- (interval-start (ly:grob-robust-relative-extent right-span common X)) padding))
+ (left-x (+ padding
+ (interval-end (ly:grob-robust-relative-extent
+ left-span common X))))
+ (right-x (- (interval-start
+ (ly:grob-robust-relative-extent right-span common X))
+ padding))
(self-x (ly:grob-relative-coordinate spanner common X))
(dx (- right-x left-x))
(exp (list 'path thickness
((cols (ly:grob-object grob 'columns))
(get-difference
(lambda (idx)
- (ly:moment-sub (ly:grob-property (ly:grob-array-ref cols (1+ idx)) 'when)
- (ly:grob-property (ly:grob-array-ref cols idx) 'when))))
+ (ly:moment-sub (ly:grob-property
+ (ly:grob-array-ref cols (1+ idx)) 'when)
+ (ly:grob-property
+ (ly:grob-array-ref cols idx) 'when))))
(moment-min (lambda (x y)
(cond
(digit (ly:event-property event 'digit)))
(if (> digit 5)
- (ly:input-message (ly:music-property event 'origin)
- "Music for the martians"))
+ (ly:input-message (ly:event-property event 'origin)
+ "Warning: Fingering notation for finger number ~a" digit))
(number->string digit 10)
))
(number->string digit 10)
))
+
+
+(define-public (stroke-finger::calc-text grob)
+ (let*
+ ((digit (ly:event-property (event-cause grob) 'digit))
+ (text (ly:event-property (event-cause grob) 'text)))
+
+ (if (string? text)
+ text
+ (vector-ref (ly:grob-property grob 'digit-names) (1- (max (min 5 digit) 1))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; dynamics
+(define-public (hairpin::calc-grow-direction grob)
+ (if (eq? (ly:event-property (event-cause grob) 'class) 'decrescendo-event)
+ START
+ STOP
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; lyrics
+
+(define-public (lyric-text::print grob)
+ "Allow interpretation of tildes as lyric tieing marks."
+
+ (let*
+ ((text (ly:grob-property grob 'text))
+ (layout (ly:grob-layout grob))
+ (defs (ly:output-def-lookup layout 'text-font-defaults))
+ (props (ly:grob-alist-chain grob defs)))
+
+ (ly:text-interface::interpret-markup layout
+ props
+ (if (string? text)
+ (make-tied-lyric-markup text)
+ text))))
+
+(define-public ((grob::calc-property-by-copy prop) grob)
+ (ly:event-property (event-cause grob) prop))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fret boards
+
+(define (string-frets->description string-frets string-count)
+ (let*
+ ((desc (list->vector
+ (map (lambda (x) (list 'mute (1+ x)))
+ (iota string-count)))))
+
+ (for-each (lambda (sf)
+ (let*
+ ((string (car sf))
+ (fret (cadr sf))
+ (finger (caddr sf)))
+
+
+ (vector-set! desc (1- string)
+ (if (= 0 fret)
+ (list 'open string)
+ (if finger
+ (list 'place-fret string fret finger)
+ (list 'place-fret string fret))
+
+
+ ))
+ ))
+ string-frets)
+
+ (vector->list desc)))
+
+(define-public (fret-board::calc-stencil grob)
+ (let* ((string-frets (ly:grob-property grob 'string-fret-finger-combinations))
+ (string-count (ly:grob-property grob 'string-count))
+ (layout (ly:grob-layout grob))
+ (defs (ly:output-def-lookup layout 'text-font-defaults))
+ (props (ly:grob-alist-chain grob defs)))
+
+ (make-fret-diagram layout props
+ (string-frets->description string-frets 6))))
projects / lilypond.git / blobdiff