X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=413d99b540e62dc0ba800b1b66d074423a52e947;hb=272196a953f0b39de8da914f47e9daa8e93925b0;hp=7eeefa3bad4adf6a2cb56f898d32d08e0e6e3141;hpb=1f6390c76c5bbe70c51789785d4e04ee236340bc;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 7eeefa3bad..413d99b540 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -3,10 +3,44 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2006 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Han-Wen Nienhuys + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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))) @@ -17,19 +51,7 @@ (else #f)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; note heads - -(define-public (note-head::calc-duration-log grob) - (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))) - -;; The TabNoteHead stem attachment function. -(define (note-head::calc-tablature-stem-attachment grob) - (cons 0.0 1.35)) +;; tablature ;; The TabNoteHead tablatureFormat callback. ;; Compute the text grob-property @@ -74,33 +96,21 @@ (define-public (four-string-banjo tuning) (reverse (cdr (reverse tuning)))) -;;; end of tablature functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; note heads -(define-public (make-stencil-boxer thickness padding callback) +(define-public (note-head::calc-duration-log grob) + (ly:duration-log + (ly:event-property (event-cause grob) 'duration))) - "Return function that adds a box around the grob passed as argument." - (lambda (grob) - - (box-stencil (callback grob) thickness padding))) +(define-public (dots::calc-dot-count grob) + (ly:duration-dot-count + (ly:event-property (event-cause grob) 'duration))) -(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 (note-head::calc-tablature-stem-attachment grob) + (cons 0.0 1.35)) -(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)) ;; silly, use alist? (define-public (note-head::calc-glyph-name grob) @@ -109,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) @@ -127,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) @@ -151,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))) @@ -169,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 @@ -240,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* - ((ev (ly:grob-property grob 'cause))) - - (number->string (ly:event-property ev 'denominator)))) - + (number->string (ly:event-property (event-cause grob) 'denominator))) (define-public (tuplet-number::calc-fraction-text grob) (let* - ((ev (ly:grob-property grob 'cause))) + ((ev (event-cause grob))) + (format "~a:~a" - (ly:event-property ev 'denominator) - (ly:event-property ev 'numerator)))) + (ly:event-property ev 'denominator) + (ly:event-property ev 'numerator)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Color @@ -402,11 +401,11 @@ centered, X==1 is at the right, X == -1 is at the left." (define-public (fingering::calc-text grob) (let* - ((event (ly:grob-property grob 'cause)) + ((event (event-cause grob)) (digit (ly:event-property event 'digit))) (if (> digit 5) - (ly:input-message (ly:music-property event 'origin) + (ly:input-message (ly:event-property event 'origin) "Music for the martians")) (number->string digit 10) @@ -414,8 +413,42 @@ centered, X==1 is at the right, X == -1 is at the left." (define-public (string-number::calc-text grob) (let* - ((event (ly:grob-property grob 'cause)) - (digit (ly:event-property event 'string-number))) + ((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))