X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fclip-region.scm;h=277bbe1c7940ed1d9d0d38a9786d7460ddc32ba6;hb=HEAD;hp=10dab46f7b21ae9b39ba80864f46926f6cf7bb7f;hpb=55ac733b69643a6bc6a83b706c65cb56efd388ef;p=lilypond.git diff --git a/scm/clip-region.scm b/scm/clip-region.scm index 10dab46f7b..277bbe1c79 100644 --- a/scm/clip-region.scm +++ b/scm/clip-region.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2006--2011 Han-Wen Nienhuys +;;;; Copyright (C) 2006--2015 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -25,18 +25,18 @@ ;; scm/output-lib.scm ;; ;; -;; (define-public (make-rhythmic-location bar-num num den) -;: (define-public (rhythmic-location? a) -;; (define-public (make-graceless-rhythmic-location loc) -;; (define-public rhythmic-location-measure-position cdr) -;; (define-public rhythmic-location-bar-number car) -;; (define-public (rhythmic-location=? a b) -;; (define-public (rhythmic-location>? a b) -;: (define-public (rhythmic-location=? a b) -;; (define-public (rhythmic-location->file-string a) -;; (define-public (rhythmic-location->string a) +;; (define-public (make-rhythmic-location bar-num num den) +;; (define-public (rhythmic-location? a) +;; (define-public (make-graceless-rhythmic-location loc) +;; (define-public rhythmic-location-measure-position cdr) +;; (define-public rhythmic-location-bar-number car) +;; (define-public (rhythmic-location=? a b) +;; (define-public (rhythmic-location>? a b) +;; (define-public (rhythmic-location=? a b) +;; (define-public (rhythmic-location->file-string a) +;; (define-public (rhythmic-location->string a) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -45,66 +45,66 @@ ;; ;; the total of this will be ;; O(#systems * #regions) -;; +;; ;; we can actually do better by sorting the regions as well, ;; but let's leave that for future extensions. ;; (define-public (system-clipped-x-extent system-grob clip-region) - "Return the X-extent of the SYSTEM-GROB when clipped with -CLIP-REGION. Return #f if not appropriate." - + "Return the X-extent of @var{system-grob} when clipped with +@var{clip-region}. Return @code{#f} if not appropriate." + (let* ((region-start (car clip-region)) (columns (ly:grob-object system-grob 'columns)) (region-end (cdr clip-region)) (found-grace-end #f) - (candidate-columns - (filter - (lambda (j) - (let* - ((column (ly:grob-array-ref columns j)) - (loc (ly:grob-property column 'rhythmic-location)) - (grace-less (make-graceless-rhythmic-location loc)) - ) - - (and (rhythmic-location? loc) - (rhythmic-location<=? region-start loc) - (or (rhythmic-location= 1 (length candidate-columns)) - #f - (cons (car candidate-columns) - (car (last-pair candidate-columns))))) + (if (>= 1 (length candidate-columns)) + #f + (cons (car candidate-columns) + (car (last-pair candidate-columns))))) (clipped-x-interval - (if column-range - (cons - - (interval-start - (ly:grob-robust-relative-extent - (if (= 0 (car column-range)) - system-grob - (ly:grob-array-ref columns (car column-range))) - system-grob X)) - - (interval-end - (ly:grob-robust-relative-extent - (if (= (1- (ly:grob-array-length columns)) (cdr column-range)) - system-grob - (ly:grob-array-ref columns (cdr column-range))) - system-grob X))) - - - #f - ))) - + (if column-range + (cons + + (interval-start + (ly:grob-robust-relative-extent + (if (= 0 (car column-range)) + system-grob + (ly:grob-array-ref columns (car column-range))) + system-grob X)) + + (interval-end + (ly:grob-robust-relative-extent + (if (= (1- (ly:grob-array-length columns)) (cdr column-range)) + system-grob + (ly:grob-array-ref columns (cdr column-range))) + system-grob X))) + + + #f + ))) + clipped-x-interval))