X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=95fefbdb3a856eba58842d315401551f1d6ab77f;hb=eb800248588b0ebabc8a90f34e17559be170f0b2;hp=5f257844542297c5924a0f8e12804310c3a6756f;hpb=b9a18c38bf25fe66b0ecea5e83d7beaf69ffa6c0;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 5f25784454..95fefbdb3a 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,47 @@ (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 @@ -72,21 +116,59 @@ (ly:duration-log (ly:event-property (event-cause grob) 'duration))) -(define-public (stem::length val) - (lambda (grob) - (let* ((d (ly:grob-property grob 'direction)) - (ss (ly:staff-symbol-staff-space grob)) - (beg (ly:stem::calc-stem-begin-position grob)) - (y1 (* beg (* 0.5 ss))) - (y2 (* ((if (eqv? d DOWN) - +) beg val) (* 0.5 ss)))) - (if (eqv? d DOWN) - (cons y2 y1) - (cons y1 y2))))) - +(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)) + +;; FIXME: NEED TO FIND A BETTER WAY TO HANDLE KIEVAN NOTATION (define-public (note-head::calc-duration-log grob) - (min 2 - (ly:duration-log - (ly:event-property (event-cause grob) 'duration)))) + (let ((style (ly:grob-property grob 'style))) + (if (and (symbol? style) (string-match "kievan*" (symbol->string style))) + (min 3 + (ly:duration-log + (ly:event-property (event-cause grob) 'duration))) + (min 2 + (ly:duration-log + (ly:event-property (event-cause grob) 'duration)))))) (define-public (dots::calc-dot-count grob) (ly:duration-dot-count @@ -150,6 +232,8 @@ and duration-log @var{log}." (string-append (number->string log) "petrucci"))) ((neomensural) (string-append (number->string log) (symbol->string style))) + ((kievan) + (string-append (number->string log) "kievan")) (else (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style)) (symbol->string style) @@ -157,9 +241,10 @@ and duration-log @var{log}." (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)))) - + (let* ((style (ly:grob-property grob 'style)) + (log (if (string-match "kievan*" (symbol->string style)) + (min 3 (ly:grob-property grob 'duration-log)) + (min 2 (ly:grob-property grob 'duration-log))))) (select-head-glyph style log))) (define-public (note-head::brew-ez-stencil grob) @@ -312,7 +397,10 @@ and duration-log @var{log}." ("S|:" . ("S" . "|:")) (".S|:" . ("|" . "S|:")) (":|S|:" . (":|" . "S|:")) - (":|S.|:" . (":|S" . "|:")))) + (":|S.|:" . (":|S" . "|:")) + + ;; ancient bar lines + ("kievan" . ("kievan" . "")))) (define-public (bar-line::calc-glyph-name grob) (let* ((glyph (ly:grob-property grob 'glyph)) @@ -340,6 +428,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-pure-height grob grob 0 10000000)) + (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 @@ -567,6 +690,9 @@ and duration-log @var{log}." (0 . "accidentals.vaticana0") (1/2 . "accidentals.mensural1"))) +(define-public alteration-kievan-glyph-name-alist + '((-1/2 . "accidentals.kievanM1") + (1/2 . "accidentals.kievan1"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; * Pitch Trill Heads @@ -753,11 +879,6 @@ and duration-log @var{log}." (let* ((event (event-cause grob)) (digit (ly:event-property event 'digit))) - (if (> digit 5) - (ly:input-message (ly:event-property event 'origin) - "Warning: Fingering notation for finger number ~a" - digit)) - (number->string digit 10))) (define-public (string-number::calc-text grob) @@ -779,7 +900,7 @@ and duration-log @var{log}." ;; dynamics (define-public (hairpin::calc-grow-direction grob) - (if (eq? (ly:event-property (event-cause grob) 'class) 'decrescendo-event) + (if (ly:in-event-class? (event-cause grob) 'decrescendo-event) START STOP))