scm/paper-system.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2006--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
   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 paper-system))
  19
  20 (use-modules (lily))
  21
  22 (define-public (paper-system-title? system)
  23   (equal? #t (ly:prob-property system 'is-title)
  24           ))
  25
  26 (define-public (paper-system-stencil system)
  27   (ly:prob-property system 'stencil))
  28
  29 (define-public (paper-system-layout system)
  30   (let*
  31       ((g (paper-system-system-grob system)))
  32
  33     (if (ly:grob? g)
  34         (ly:grob-layout  g)
  35         #f)))
  36
  37 (define-public (paper-system-system-grob paper-system)
  38   (ly:prob-property paper-system 'system-grob))
  39
  40 (define-public (paper-system-extent system axis)
  41   (ly:stencil-extent (paper-system-stencil system) axis))
  42
  43 (define-public (paper-system-staff-extents ps)
  44   (ly:prob-property ps 'staff-refpoint-extent '(0 . 0)))
  45
  46 (define-public (paper-system-annotate-last system layout)
  47   (let*
  48       ((bottomspace (ly:prob-property system 'bottom-space))
  49        (y-extent (paper-system-extent system Y))
  50        (x-extent (paper-system-extent system X))
  51        (stencil (ly:prob-property system 'stencil))
  52
  53        (arrow (if (number? bottomspace)
  54                (annotate-y-interval layout
  55                                     "bottom-space"
  56                                     (cons (- (car y-extent) bottomspace)
  57                                           (car y-extent))
  58                                     #t)
  59                #f)))
  60
  61     (if arrow
  62         (set! stencil
  63               (ly:stencil-add stencil arrow)))
  64
  65     (set! (ly:prob-property system 'stencil)
  66           stencil)
  67   ))
  68
  69 ; TODO: annotate the spacing for every spaceable staff within the system.
  70 (define-public (paper-system-annotate system next-system layout)
  71   "Add arrows and texts to indicate which lengths are set."
  72   (let* ((annotations (list))
  73          (grob (ly:prob-property system 'system-grob))
  74          (estimate-extent (if (ly:grob? grob)
  75                               (annotate-y-interval layout
  76                                                    "extent-estimate"
  77                                                    (ly:grob-property grob 'pure-Y-extent)
  78                                                    #f)
  79                               #f)))
  80     (let* ((spacing-spec (cond ((and next-system
  81                                      (paper-system-title? system)
  82                                      (paper-system-title? next-system))
  83                                 (ly:output-def-lookup layout 'markup-markup-spacing))
  84                                ((paper-system-title? system)
  85                                 (ly:output-def-lookup layout 'markup-system-spacing))
  86                                ((and next-system
  87                                      (paper-system-title? next-system))
  88                                 (ly:output-def-lookup layout 'score-markup-spacing))
  89                                ((not next-system)
  90                                 (ly:output-def-lookup layout 'last-bottom-spacing))
  91                                (else
  92                                 (ly:output-def-lookup layout 'system-system-spacing))))
  93            (last-staff-Y (car (paper-system-staff-extents system))))
  94
  95       (set! annotations
  96             (annotate-spacing-spec layout spacing-spec last-staff-Y (car (paper-system-extent system Y)))))
  97     (if estimate-extent
  98         (set! annotations
  99               (stack-stencils X RIGHT 0.5
 100                               (list annotations
 101                                     estimate-extent))))
 102
 103     (if (not (null? annotations))
 104         (set! (ly:prob-property system 'stencil)
 105               (ly:stencil-add
 106                (ly:prob-property system 'stencil)
 107                (ly:make-stencil
 108                 (ly:stencil-expr annotations)
 109                 (ly:stencil-extent empty-stencil X)
 110                 (ly:stencil-extent empty-stencil Y)))))
 111     (ly:prob-property system 'stencil)))