scm/clip-region.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2006--2015 Han-Wen Nienhuys <hanwen@lilypond.org>
   4 ;;;;
   5 ;;;; LilyPond is free software: you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation, either version 3 of the License, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; LilyPond is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 (define-module (scm clip-region))
  19
  20 (use-modules (lily))
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;; The procedures shown in this list have been moved to
  25 ;; scm/output-lib.scm
  26 ;;
  27 ;;
  28 ;;      (define-public (make-rhythmic-location bar-num num den)
  29 ;;      (define-public (rhythmic-location? a)
  30 ;;      (define-public (make-graceless-rhythmic-location loc)
  31 ;;      (define-public rhythmic-location-measure-position cdr)
  32 ;;      (define-public rhythmic-location-bar-number car)
  33 ;;      (define-public (rhythmic-location<? a b)
  34 ;;      (define-public (rhythmic-location<=? a b)
  35 ;;      (define-public (rhythmic-location>=? a b)
  36 ;;      (define-public (rhythmic-location>? a b)
  37 ;;      (define-public (rhythmic-location=? a b)
  38 ;;      (define-public (rhythmic-location->file-string a)
  39 ;;      (define-public (rhythmic-location->string a)
  40
  41
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 ;;  Actual clipping logic.
  44
  45 ;;
  46 ;; the total of this will be
  47 ;; O(#systems * #regions)
  48 ;;
  49 ;; we can actually do better by sorting the regions as well,
  50 ;; but let's leave that for future extensions.
  51 ;;
  52 (define-public (system-clipped-x-extent system-grob clip-region)
  53   "Return the X-extent of @var{system-grob} when clipped with
  54 @var{clip-region}.  Return @code{#f} if not appropriate."
  55
  56   (let*
  57       ((region-start (car clip-region))
  58        (columns (ly:grob-object system-grob 'columns))
  59        (region-end (cdr clip-region))
  60        (found-grace-end  #f)
  61        (candidate-columns
  62         (filter
  63          (lambda (j)
  64            (let*
  65                ((column (ly:grob-array-ref columns j))
  66                 (loc (ly:grob-property column 'rhythmic-location))
  67                 (grace-less (make-graceless-rhythmic-location loc))
  68                 )
  69
  70              (and (rhythmic-location? loc)
  71                   (rhythmic-location<=? region-start loc)
  72                   (or (rhythmic-location<? grace-less region-end)
  73                       (and (rhythmic-location=? grace-less region-end)
  74                            (eq? #t (ly:grob-property column 'non-musical))
  75
  76                            )))
  77
  78              ))
  79
  80          (iota (ly:grob-array-length columns))))
  81
  82        (column-range
  83         (if (>= 1 (length candidate-columns))
  84             #f
  85             (cons (car candidate-columns)
  86                   (car (last-pair candidate-columns)))))
  87
  88        (clipped-x-interval
  89         (if column-range
  90             (cons
  91
  92              (interval-start
  93               (ly:grob-robust-relative-extent
  94                (if (= 0 (car column-range))
  95                    system-grob
  96                    (ly:grob-array-ref columns (car column-range)))
  97                system-grob X))
  98
  99              (interval-end
 100               (ly:grob-robust-relative-extent
 101                (if (= (1- (ly:grob-array-length columns)) (cdr column-range))
 102                    system-grob
 103                    (ly:grob-array-ref columns (cdr column-range)))
 104                system-grob X)))
 105
 106
 107             #f
 108             )))
 109
 110     clipped-x-interval))