X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=60896a930467eafbf88c6dec2a14325056cc2918;hb=b3228e0ff6565087e73518acf379f5e9f14b05fa;hp=5ef27d02c2c450985e659ee3e432798ad221fc0e;hpb=36f6cd546770e38c6e2314404e21f1c89504eb7d;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 5ef27d02c2..60896a9304 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -9,8 +9,8 @@ ;;; Tablature functions, by Jiba (jiba@tuxfamily.org) ;; The TabNoteHead stem attachment function. -(define (tablature-stem-attachment-function style duration) - (cons 0.0 0.5)) +(define (note-head::calc-tablature-stem-attachment grob) + (cons 0.0 1.35)) ;; The TabNoteHead tablatureFormat callback. ;; Compute the text grob-property @@ -38,44 +38,6 @@ (+ fret 5)) (else fret))))))) -(define-public (hammer-print-function grob) - (let* ((note-collums (ly:grob-property grob 'note-columns)) - (note-column1 (cadr note-collums)) - (note-column2 (car note-collums)) - (note1 (car (ly:grob-property note-column1 'note-heads))) - (note2 (car (ly:grob-property note-column2 'note-heads))) - (text1 (ly:grob-property note1 'text)) - (text2 (ly:grob-property note2 'text)) - (fret1 (if (string? text1) (string->number text1) 0)) - (fret2 (if (string? text2) (string->number text2) 0)) - (letter (cond - ((< fret1 fret2) "H") - ((> fret1 fret2) "P") - (else "")))) - (let* ((slur - ;; (Slur::print grob) - - ;; - ;; FIXME: a hammer is not a slur. - ;; - (ly:make-stencil '() '(0 . 0) '(0 . 0))) - (layout (ly:grob-layout grob)) - (text (interpret-markup - layout - (ly:grob-alist-chain grob (ly:output-def-lookup layout 'text-font-defaults)) - letter))) - - (let ((x (/ (- (cdr (ly:stencil-extent slur 0)) - (/ (cdr (ly:stencil-extent text 0)) 2.0)) - -2.0))) - - (set! text - (ly:make-stencil (ly:stencil-expr text) - (cons x x) - (ly:stencil-extent text Y))) - - (ly:stencil-aligned-to text X RIGHT))))) - (define-public guitar-tuning '(4 -1 -5 -10 -15 -20)) (define-public bass-tuning '(-17 -22 -27 -32)) @@ -97,8 +59,11 @@ ;;; 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." @@ -148,41 +113,45 @@ ;; 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) @@ -208,19 +177,22 @@ centered, X==1 is at the right, X == -1 is at the left." (let* ((bn (ly:context-property tr 'currentBarNumber))) (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n))))) -(define-public (default-bar-number-visibility barnum) (> barnum 1)) +(define-public (first-bar-number-invisible barnum) (> barnum 1)) ;; See documentation of Item::visibility_lambda_ -(define-safe-public (begin-of-line-visible d) (if (= d 1) '(#f . #f) '(#t . #t))) -(define-safe-public (end-of-line-visible d) (if (= d -1) '(#f . #f) '(#t . #t))) -(define-safe-public (spanbar-begin-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f))) - -(define-safe-public (all-visible d) '(#f . #f)) -(define-safe-public (all-invisible d) '(#t . #t)) -(define-safe-public (begin-of-line-invisible d) (if (= d 1) '(#t . #t) '(#f . #f))) -(define-safe-public (center-invisible d) (if (= d 0) '(#t . #t) '(#f . #f))) -(define-safe-public (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f))) - +(define-public begin-of-line-visible + #(#f #f #t)) +(define-public end-of-line-visible + #(#t #f #f)) +(define-public end-of-line-invisible + #(#f #t #t)) +(define-public spanbar-begin-of-line-invisible + #(#t #f #f)) +(define-public all-visible #(#t #t #t)) +(define-public all-invisible #(#f #f #f)) +(define-public begin-of-line-invisible + #(#t #t #f)) +(define-public center-invisible #(#t #f #t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Bar lines. @@ -229,8 +201,11 @@ centered, X==1 is at the right, X == -1 is at the left." ;; 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 '((":|:" . (":|" . "|:")) ("||:" . ("||" . "|:")) ("|" . ("|" . ())) @@ -248,15 +223,23 @@ centered, X==1 is at the right, X == -1 is at the left." (":" . (":" . "")) ("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 glyph-name + (set! (ly:grob-property grob 'glyph-name) glyph-name) + (ly:grob-suicide! grob)))) - (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))) @@ -288,7 +271,7 @@ centered, X==1 is at the right, X == -1 is at the left." (define (parenthesize-elements grob) (let* - ((elts (ly:grob-property grob 'elements)) + ((elts (ly:grob-object grob 'elements)) (x-ext (ly:relative-group-extent elts grob X)) (font (ly:grob-default-font grob)) (lp (ly:font-get-glyph font "accidentals.leftparen")) @@ -299,3 +282,14 @@ centered, X==1 is at the right, X == -1 is at the left." (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)