;;; Tablature functions, by Jiba (jiba@tuxfamily.org)
;; The TabNoteHead stem attachment function.
-(define (tablature-stem-attachment-function style duration)
+(define (note-head::calc-tablature-stem-attachment grob)
(cons 0.0 1.35))
;; The TabNoteHead tablatureFormat callback.
;;; end of tablature functions
(define-public (make-stencil-boxer thickness padding callback)
+
"Return function that adds a box around the grob passed as argument."
- (lambda (grob) (box-stencil (callback grob) thickness padding)))
+ (lambda (grob)
+
+ (box-stencil (callback grob) thickness padding)))
(define-public (make-stencil-circler thickness padding callback)
"Return function that adds a circle around the grob passed as argument."
(define-public (print-circled-text-callback grob)
(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))
(circle (Text_interface::interpret_markup
- layout props (make-draw-circle-markup 0.8 0.1 #f)))
- (text-stencil (Text_interface::interpret_markup layout props text)))
-
- (ly:stencil-add (centered-stencil text-stencil) circle)))
+ layout props (make-circle-markup text))))
+ circle))
;;(define (mm-to-pt x)
;; silly, use alist?
-(define-public (find-notehead-symbol duration style)
- (case style
- ((xcircle) "2xcircle")
- ((harmonic) "0harmonic")
- ((baroque)
- ;; Oops, I actually would not call this "baroque", but, for
- ;; backwards compatibility to 1.4, this is supposed to take
- ;; brevis, longa and maxima from the neo-mensural font and all
- ;; other note heads from the default font. -- jr
- (if (< duration 0)
- (string-append (number->string duration) "neomensural")
- (number->string duration)))
- ((mensural)
- (string-append (number->string duration) (symbol->string style)))
- ((petrucci)
- (if (< duration 0)
- (string-append (number->string duration) "mensural")
- (string-append (number->string duration) (symbol->string style))))
- ((neomensural)
- (string-append (number->string duration) (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 (< duration -1)
- (string-append (number->string duration) "neomensural")
- (number->string duration)))
- (else
- (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
- (symbol->string style)
- (string-append (number->string (max 0 duration))
- (symbol->string style))))))
+(define-public (note-head::calc-glyph-name grob)
+ (let*
+ ((style (ly:grob-property grob 'style))
+ (log (min 2 (ly:grob-property grob 'duration-log))))
+
+ (case style
+ ((xcircle) "2xcircle")
+ ((harmonic) "0harmonic")
+ ((baroque)
+ ;; Oops, I actually would not call this "baroque", but, for
+ ;; backwards compatibility to 1.4, this is supposed to take
+ ;; brevis, longa and maxima from the neo-mensural font and all
+ ;; other note heads from the default font. -- jr
+ (if (< log 0)
+ (string-append (number->string log) "neomensural")
+ (number->string log)))
+ ((mensural)
+ (string-append (number->string log) (symbol->string style)))
+ ((petrucci)
+ (if (< log 0)
+ (string-append (number->string log) "mensural")
+ (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)
+ (string-append (number->string (max 0 log))
+ (symbol->string style)))))))
;; TODO junk completely?
(define (note-head-style->attachment-coordinates grob axis)
;; How should a bar line behave at a break?
;;
;; Why prepend `default-' to every scm identifier?
-(define-public (default-break-barline glyph dir)
- (let ((result (assoc glyph
+(define-public (bar-line::calc-glyph-name grob)
+ (let* (
+ (glyph (ly:grob-property grob 'glyph))
+ (dir (ly:item-break-dir grob))
+ (result (assoc glyph
'((":|:" . (":|" . "|:"))
("||:" . ("||" . "|:"))
("|" . ("|" . ()))
(".|." . (".|." . ()))
("" . ("" . ""))
(":" . (":" . ""))
+ ("." . ("." . ()))
("empty" . (() . ()))
("brace" . (() . "brace"))
- ("bracket" . (() . "bracket")) ))))
+ ("bracket" . (() . "bracket")) )))
+ (glyph-name (if (= dir CENTER)
+ glyph
+ (if (and result (string? (index-cell (cdr result) dir)))
+ (index-cell (cdr result) dir)
+ #f)))
+ )
+
+ (if (not glyph-name)
+ (ly:grob-suicide! grob))
+
+ glyph-name))
- (if (equal? result #f)
- (ly:warning (_ "unknown bar glyph: `~S'" glyph))
- (index-cell (cdr result) dir))))
(define-public (shift-right-at-line-begin g)
"Shift an item to the right, but only at the start of the line."
- (if (and (ly:item? g) (equal? (ly:item-break-dir g) RIGHT))
+ (if (and (ly:item? g)
+ (equal? (ly:item-break-dir g) RIGHT))
(ly:grob-translate-axis! g 3.5 X)))
(ly:stencil-translate-axis lp (- (car x-ext) padding) X)
(ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X))
))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+
+(define-public (chain-grob-member-functions grob value . funcs)
+ (for-each
+ (lambda (func)
+ (set! value (func grob value)))
+ funcs)
+
+ value)
projects / lilypond.git / blobdiff