X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Foutput-lib.scm;h=a38a49da49880e5fb7306cb2aa082c25afab0be2;hb=1dea8bf1d7182f3d1a1c70bb2010f4585f56b3e6;hp=0b453a3838a1c537ab6f21c0f45201f7c5a6cff9;hpb=28d8d9ac38857927790af5759c393adeff1ceb82;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 0b453a3838..a38a49da49 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--2011 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -26,6 +26,9 @@ (define-public (grob::is-live? grob) (pair? (ly:grob-basic-properties grob))) +(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) @@ -55,6 +58,56 @@ (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 @@ -63,6 +116,49 @@ (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 (stem-stub::do-calculations grob) + (and (ly:grob-property (ly:grob-parent grob X) 'cross-staff) + (not (ly:grob-property (ly:grob-parent grob X) 'transparent)))) + +(define-public (stem-stub::pure-height grob beg end) + (if (stem-stub::do-calculations grob) + '(0 . 0) + '(+inf.0 . -inf.0))) + +(define-public (stem-stub::width grob) + (if (stem-stub::do-calculations grob) + (grob::x-parent-width grob) + '(+inf.0 . -inf.0))) + +(define-public (stem-stub::extra-spacing-height grob) + (if (stem-stub::do-calculations grob) + (let* ((dad (ly:grob-parent grob X)) + (refp (ly:grob-common-refpoint grob dad Y)) + (stem_ph (ly:grob-pure-height dad refp 0 1000000)) + (my_ph (ly:grob-pure-height grob refp 0 1000000)) + ;; only account for distance if stem is on different staff than stub + (dist (if (grob::has-interface refp 'hara-kiri-group-spanner-interface) + 0 + (- (car my_ph) (car stem_ph))))) + (if (interval-empty? (interval-intersection stem_ph my_ph)) #f (coord-translate stem_ph dist))) + #f)) + (define-public (note-head::calc-duration-log grob) (min 2 (ly:duration-log @@ -320,6 +416,41 @@ and duration-log @var{log}." (equal? (ly:item-break-dir g) RIGHT)) (ly:grob-translate-axis! g 3.5 X))) +(define-public (pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line grob) + (if (= 1 (ly:item-break-dir grob)) + (pure-from-neighbor-interface::extra-spacing-height grob) + (cons -0.1 0.1))) + +(define-public (pure-from-neighbor-interface::extra-spacing-height grob) + (let* ((height (ly:grob::stencil-height grob)) + (from-neighbors (interval-union + height + (ly:axis-group-interface::pure-height + grob + 0 + 10000000)))) + (coord-operation - from-neighbors height))) + +(define-public (pure-from-neighbor-interface::account-for-span-bar grob) + (let* ((esh (pure-from-neighbor-interface::extra-spacing-height grob)) + (hsb (ly:grob-property grob 'has-span-bar)) + (ii (interval-intersection esh (cons -1.01 1.01)))) + (if (pair? hsb) + (cons (car (if (and (car hsb) + (ly:grob-property grob 'allow-span-bar)) + esh ii)) + (cdr (if (cdr hsb) esh ii))) + ii))) + +(define-public (pure-from-neighbor-interface::extra-spacing-height-including-staff grob) + (let ((esh (pure-from-neighbor-interface::extra-spacing-height grob)) + (to-staff (coord-operation - + (interval-widen + '(0 . 0) + (ly:staff-symbol-staff-radius grob)) + (ly:grob::stencil-height grob)))) + (interval-union esh to-staff))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tuplets @@ -968,17 +1099,3 @@ between the two text elements." (define-public (laissez-vibrer::print grob) (ly:tie::print grob)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; text replacements - -(define-public default-string-replacement-alist - '(; Whitespaces - ("\t" . " ") - ("\n" . " ") - ("\v" . " "))) - -(define-public (internal-add-text-replacements props alist) - (let* ((dummy-replacements (chain-assoc-get 'replacement-alist props '())) - (new-replacements - (append dummy-replacements alist))) - (prepend-alist-chain 'replacement-alist new-replacements props)))