X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=413d99b540e62dc0ba800b1b66d074423a52e947;hb=272196a953f0b39de8da914f47e9daa8e93925b0;hp=e38d967e9573dc835417475cee90e7262b61b015;hpb=10ac84f21313e8cc86540d1c8137cb96020b98b3;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index e38d967e95..413d99b540 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -3,14 +3,55 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2006 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Han-Wen Nienhuys -;;; Tablature functions, by Jiba (jiba@tuxfamily.org) -;; The TabNoteHead stem attachment function. -(define (note-head::calc-tablature-stem-attachment grob) - (cons 0.0 1.35)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; general + +(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))) + +(define-public (make-stencil-circler thickness padding callback) + "Return function that adds a circle around the grob passed as argument." + + (lambda (grob) (circle-stencil (callback grob) thickness padding))) + +(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 (ly:text-interface::interpret-markup + 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* + ((cause (ly:grob-property grob 'cause))) + + (cond + ((ly:stream-event? cause) cause) + ((ly:grob? cause) (event-cause cause)) + (else #f)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; tablature ;; The TabNoteHead tablatureFormat callback. ;; Compute the text grob-property @@ -55,59 +96,20 @@ (define-public (four-string-banjo tuning) (reverse (cdr (reverse tuning)))) -;;; 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))) - -(define-public (make-stencil-circler thickness padding callback) - "Return function that adds a circle around the grob passed as argument." - (lambda (grob) (circle-stencil (callback grob) thickness padding))) - -(define-public (arg->string arg) - (cond ((number? arg) (ly:inexact->string arg 10)) - ((string? arg) (string-append "\"" arg "\"")) - ((symbol? arg) (string-append "\"" (symbol->string arg) "\"")))) - -(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 (ly:text-interface::interpret-markup - layout props (make-circle-markup text)))) - circle)) - - -;;(define (mm-to-pt x) -;; (* (/ 72.27 25.40) x)) - -;; do nothing in .scm output +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; note heads -(define-public (ly:numbers->string lst) - (string-join (map ly:number->string lst) " ")) +(define-public (note-head::calc-duration-log grob) + (ly:duration-log + (ly:event-property (event-cause grob) 'duration))) -(define (number->octal-string x) - (let* ((n (inexact->exact x)) - (n64 (quotient n 64)) - (n8 (quotient (- n (* n64 64)) 8))) - (string-append - (number->string n64) - (number->string n8) - (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8))))) +(define-public (dots::calc-dot-count grob) + (ly:duration-dot-count + (ly:event-property (event-cause grob) 'duration))) -(define-public (ly:inexact->string x radix) - (let ((n (inexact->exact x))) - (number->string n radix))) +(define (note-head::calc-tablature-stem-attachment grob) + (cons 0.0 1.35)) -(define-public (ly:number-pair->string c) - (string-append (ly:number->string (car c)) " " - (ly:number->string (cdr c)))) ;; silly, use alist? @@ -117,6 +119,10 @@ (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) @@ -135,16 +141,6 @@ (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) @@ -159,13 +155,9 @@ centered, X==1 is at the right, X == -1 is at the left." '(1.0 . 0.0)) -(define-public (string-encode-integer i) - (cond - ((= i 0) "o") - ((< i 0) (string-append "n" (string-encode-integer (- i)))) - (else (string-append - (make-string 1 (integer->char (+ 65 (modulo i 26)))) - (string-encode-integer (quotient i 26)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; bar numbers (define-public ((every-nth-bar-number-visible n) barnum) (= 0 (modulo barnum n))) @@ -177,7 +169,9 @@ centered, X==1 is at the right, X == -1 is at the left." (define-public (first-bar-number-invisible barnum) (> barnum 1)) -;; See documentation of ly:item::visibility-lambda- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; break visibility + (define-public begin-of-line-visible #(#f #f #t)) (define-public end-of-line-visible @@ -206,6 +200,7 @@ centered, X==1 is at the right, X == -1 is at the left." (result (assoc glyph '((":|:" . (":|" . "|:")) ("||:" . ("||" . "|:")) + ("dashed" . ("dashed" . '())) ("|" . ("|" . ())) ("||:" . ("||" . "|:")) ("|s" . (() . "|")) @@ -247,18 +242,15 @@ centered, X==1 is at the right, X == -1 is at the left." ;; Tuplets (define-public (tuplet-number::calc-denominator-text grob) - (let* - ((mus (ly:grob-property grob 'cause))) - - (number->string (ly:music-property mus 'denominator)))) - + (number->string (ly:event-property (event-cause grob) 'denominator))) (define-public (tuplet-number::calc-fraction-text grob) (let* - ((mus (ly:grob-property grob 'cause))) + ((ev (event-cause grob))) + (format "~a:~a" - (ly:music-property mus 'denominator) - (ly:music-property mus 'numerator)))) + (ly:event-property ev 'denominator) + (ly:event-property ev 'numerator)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Color @@ -289,8 +281,7 @@ centered, X==1 is at the right, X == -1 is at the left." (define (parenthesize-elements grob . rest) (let* - ( - (refp (if (null? rest) + ((refp (if (null? rest) grob (car rest))) (elts (ly:grob-object grob 'elements)) @@ -300,7 +291,7 @@ centered, X==1 is at the right, X == -1 is at the left." (lp (ly:font-get-glyph font "accidentals.leftparen")) (rp (ly:font-get-glyph font "accidentals.rightparen")) (padding (ly:grob-property grob 'padding 0.1))) - + (ly:stencil-add (ly:stencil-translate-axis lp (- (car x-ext) padding) X) (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X)) @@ -345,11 +336,12 @@ centered, X==1 is at the right, X == -1 is at the left." (define-public (fall::print spanner) (let* - ((delta (ly:grob-property spanner 'delta-position)) + ((delta-y (* 0.5 (ly:grob-property spanner 'delta-position))) (left-span (ly:spanner-bound spanner LEFT)) (right-span (ly:spanner-bound spanner RIGHT)) (thickness (* (ly:grob-property spanner 'thickness) - (ly:output-def-lookup (ly:grob-layout spanner) 'line-thickness))) + (ly:output-def-lookup (ly:grob-layout spanner) + 'line-thickness))) (padding (ly:grob-property spanner 'padding 0.5)) (common (ly:grob-common-refpoint right-span (ly:grob-common-refpoint spanner @@ -367,13 +359,96 @@ centered, X==1 is at the right, X == -1 is at the left." rcurveto ,(/ dx 3) 0 - ,dx ,(* 0.66 delta) - ,dx ,delta + ,dx ,(* 0.66 delta-y) + ,dx ,delta-y )))) ) (ly:make-stencil exp (cons 0 dx) - (cons (min 0 delta) - (max 0 delta))))) + (cons (min 0 delta-y) + (max 0 delta-y))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; grace spacing + + +(define-public (grace-spacing::calc-shortest-duration grob) + (let* + ((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)))) + + (moment-min (lambda (x y) + (cond + ((and x y) + (if (ly:moment digit 5) + (ly:input-message (ly:event-property event 'origin) + "Music for the martians")) + + (number->string digit 10) + )) + +(define-public (string-number::calc-text grob) + (let* + ((digit (ly:event-property (event-cause grob) 'string-number))) + + (number->string digit 10) + )) + +(define-public (string-finger::calc-text grob) + (let* + ((text (ly:event-property (event-cause grob) 'text))) + + text)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 (lyric-text::calc-text grob) + (ly:event-property (event-cause grob) 'text))