X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=82703e14ac1f0bc9ae336ce5f227aa274edcae41;hb=04a1f20da162cd0fec86bddbd14f167a695da480;hp=292755e27e21a0ab7a76a8a008ce682164b9817e;hpb=9551796a06445e9570d5481a73aff11f1d259568;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 292755e27e..82703e14ac 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -26,16 +26,18 @@ (define-public (grob::is-live? grob) (pair? (ly:grob-basic-properties grob))) -(define-public (make-stencil-boxer thickness padding callback) +(define-public (grob::x-parent-width grob) + (ly:grob-property (ly:grob-parent grob X) 'X-extent)) +(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))) + (lambda (grob) + (circle-stencil (callback grob) thickness padding))) (define-public (print-circled-text-callback grob) (grob-interpret-markup grob (make-circle-markup @@ -57,6 +59,57 @@ (ly:text-interface::interpret-markup layout props text))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; beam slope + +;; calculates each slope of a broken beam individually +(define-public (beam::place-broken-parts-individually grob) + (ly:beam::quanting grob '(+inf.0 . -inf.0) #f)) + +;; calculates the slope of a beam as a single unit, +;; even if it is broken. this assures that the beam +;; will pick up where it left off after a line break +(define-public (beam::align-with-broken-parts grob) + (ly:beam::quanting grob '(+inf.0 . -inf.0) #t)) + +;; uses the broken beam style from edition peters combines the +;; values of place-broken-parts-individually and align-with-broken-parts above, +;; favoring place-broken-parts-individually when the beam naturally has a steeper +;; incline and align-with-broken-parts when the beam is flat +(define-public (beam::slope-like-broken-parts grob) + (define (slope y x) + (/ (- (cdr y) (car y)) (- (cdr x) (car x)))) + (let* ((quant1 (ly:beam::quanting grob '(+inf.0 . -inf.0) #t)) + (original (ly:grob-original grob)) + (siblings (if (ly:grob? original) + (ly:spanner-broken-into original) + '()))) + (if (null? siblings) + quant1 + (let* ((quant2 (ly:beam::quanting grob '(+inf.0 . -inf.0) #f)) + (x-span (ly:grob-property grob 'X-positions)) + (slope1 (slope quant1 x-span)) + (slope2 (slope quant2 x-span)) + (quant2 (if (not (= (sign slope1) (sign slope2))) + '(0 . 0) + quant2)) + (factor (/ (atan (abs slope1)) PI-OVER-TWO)) + (base (cons-map + (lambda (x) + (+ (* (x quant1) (- 1 factor)) + (* (x quant2) factor))) + (cons car cdr)))) + (ly:beam::quanting grob base #f))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; cross-staff stuff + +(define-public (script-or-side-position-cross-staff g) + (or + (ly:script-interface::calc-cross-staff g) + (ly:side-position-interface::calc-cross-staff g))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; note heads @@ -64,6 +117,22 @@ (ly:duration-log (ly:event-property (event-cause grob) 'duration))) +(define-public (stem::length grob) + (let* ((ss (ly:staff-symbol-staff-space grob)) + (beg (ly:grob-property grob 'stem-begin-position)) + (beam (ly:grob-object grob 'beam))) + (if (null? beam) + (abs (- (ly:stem::calc-stem-end-position grob) beg)) + (begin + (ly:programming-error + "stem::length called but will not be used for beamed stem.") + 0.0)))) + +(define-public (stem::pure-length grob beg end) + (let* ((ss (ly:staff-symbol-staff-space grob)) + (beg (ly:grob-pure-property grob 'stem-begin-position 0 1000))) + (abs (- (ly:stem::pure-calc-stem-end-position grob 0 2147483646) beg)))) + (define-public (note-head::calc-duration-log grob) (min 2 (ly:duration-log @@ -121,6 +190,14 @@ and duration-log @var{log}." (if (< log 0) (string-append (number->string log) "mensural") (string-append (number->string log) (symbol->string style)))) + ((blackpetrucci) + (if (< log 0) + (string-append (number->string log) "blackmensural") + (string-append (number->string log) (symbol->string style)))) + ((semipetrucci) + (if (< log 0) + (string-append (number->string log) "semimensural") + (string-append (number->string log) "petrucci"))) ((neomensural) (string-append (number->string log) (symbol->string style))) (else @@ -237,6 +314,9 @@ and duration-log @var{log}." (define-public (inherit-x-parent-visibility grob) (let ((parent (ly:grob-parent grob X))) (ly:grob-property parent 'break-visibility all-invisible))) +(define-public (inherit-y-parent-visibility grob) + (let ((parent (ly:grob-parent grob X))) + (ly:grob-property parent 'break-visibility))) (define-public spanbar-begin-of-line-invisible #(#t #f #f)) @@ -310,17 +390,23 @@ and duration-log @var{log}." (equal? (ly:item-break-dir g) RIGHT)) (ly:grob-translate-axis! g 3.5 X))) +(define-public (span-bar-stub::height grob) + (ly:grob-property grob 'elements-filtered) + (ly:axis-group-interface::height grob)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tuplets +(define-public (tuplet-number::calc-direction grob) + (ly:tuplet-bracket::calc-direction (ly:grob-object grob 'bracket))) + (define-public (tuplet-number::calc-denominator-text grob) (number->string (ly:event-property (event-cause grob) 'denominator))) (define-public (tuplet-number::calc-fraction-text grob) (let ((ev (event-cause grob))) - (format "~a:~a" + (format #f "~a:~a" (ly:event-property ev 'denominator) (ly:event-property ev 'numerator)))) @@ -350,7 +436,7 @@ and duration-log @var{log}." (den (if denominator denominator (ly:event-property ev 'denominator))) (num (if numerator numerator (ly:event-property ev 'numerator)))) - (format "~a:~a" den num))) + (format #f "~a:~a" den num))) ;; Print a tuplet fraction with note durations appended to the numerator and the ;; denominator @@ -372,10 +458,10 @@ and duration-log @var{log}." (num (if numerator numerator (ly:event-property ev 'numerator)))) (make-concat-markup (list - (make-simple-markup (format "~a" den)) + (make-simple-markup (format #f "~a" den)) (markup #:fontsize -5 #:note denominatornote UP) (make-simple-markup " : ") - (make-simple-markup (format "~a" num)) + (make-simple-markup (format #f "~a" num)) (markup #:fontsize -5 #:note numeratornote UP))))) @@ -454,6 +540,25 @@ and duration-log @var{log}." (+ c0 p)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; annotations + +(define-public (numbered-footnotes int) + (markup #:tiny (number->string (+ 1 int)))) + +(define-public (symbol-footnotes int) + (define (helper symbols out idx n) + (if (< n 1) + out + (helper symbols + (string-append out (list-ref symbols idx)) + idx + (- n 1)))) + (markup #:tiny (helper '("*" "†" "‡" "§" "¶") + "" + (remainder int 5) + (+ 1 (quotient int 5))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; accidentals @@ -579,7 +684,7 @@ and duration-log @var{log}." (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X)))) -(define (parentheses-item::print me) +(define-public (parentheses-item::print me) (let* ((elts (ly:grob-object me 'elements)) (y-ref (ly:grob-common-refpoint-of-array me elts Y)) (x-ref (ly:grob-common-refpoint-of-array me elts X))