scm/paper-system.scm

   1 ;;
   2 ;; paper-system.scm -- implement paper-system objects.
   3 ;;
   4 ;; source file of the GNU LilyPond music typesetter
   5 ;;
   6 ;; (c) 2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 ;;
   8
   9 (define-module (scm paper-system))
  10
  11 (use-modules (lily))
  12
  13 (define-public (paper-system-title? system)
  14   (equal? #t (ly:prob-property system 'is-title)
  15           ))
  16
  17 (define-public (paper-system-stencil system)
  18   (ly:prob-property system 'stencil))
  19
  20 (define-public (paper-system-extent system axis)
  21   (ly:stencil-extent (paper-system-stencil system) axis))
  22
  23 (define-public (paper-system-staff-extents ps)
  24   (ly:prob-property ps 'refpoint-Y-extent '(0 . 0)))
  25
  26 (define-public (paper-system-annotate-last system layout)
  27   (let*
  28       ((bottomspace (ly:prob-property system 'bottom-space))
  29        (y-extent (paper-system-extent system Y))
  30        (x-extent (paper-system-extent system X))
  31        (stencil (ly:prob-property system 'stencil))
  32
  33        (arrow (if (number? bottomspace)
  34                (annotate-y-interval layout
  35                                     "bottom-space"
  36                                     (cons (- (car y-extent) bottomspace)
  37                                           (car y-extent))
  38                                     #t)
  39                #f)))
  40
  41     (if arrow
  42         (set! stencil
  43               (ly:stencil-add stencil arrow)))
  44
  45     (set! (ly:prob-property system 'stencil)
  46           stencil)
  47   ))
  48
  49 (define-public (paper-system-annotate system layout)
  50   "Add arrows and texts to indicate which lengths are set."
  51   (let*
  52       ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
  53        (append-stencil
  54         (lambda (a b)
  55           (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
  56
  57        (annotate-property
  58         (lambda (name extent is-length?)
  59           (set! annotations
  60                 (append-stencil annotations
  61                                 (annotate-y-interval layout
  62                                                      name extent is-length?)))))
  63
  64        (bbox-extent (paper-system-extent system Y))
  65        (refp-extent (ly:prob-property system 'refpoint-Y-extent))
  66        (next-space (ly:prob-property system 'next-space
  67                                              (ly:output-def-lookup layout 'betweensystemspace)
  68                                              ))
  69        (next-padding (ly:prob-property system 'next-padding
  70                                                (ly:output-def-lookup layout 'betweensystempadding)
  71                                                ))
  72
  73        )
  74
  75     (if (number-pair? bbox-extent)
  76         (begin
  77           (annotate-property  "Y-extent"
  78                                bbox-extent #f)
  79           (annotate-property  "next-padding"
  80                              (interval-translate (cons (- next-padding) 0) (car bbox-extent))
  81                              #t)))
  82
  83     ;; titles don't have a refpoint-Y-extent.
  84     (if (number-pair? refp-extent)
  85         (begin
  86           (annotate-property "refpoint-Y-extent"
  87                              refp-extent #f)
  88
  89           (annotate-property "next-space"
  90                              (interval-translate (cons (- next-space) 0) (car refp-extent))
  91                        #t)))
  92
  93
  94
  95     (set! (ly:prob-property system 'stencil)
  96           (ly:stencil-add
  97            (ly:prob-property system 'stencil)
  98            (ly:make-stencil
  99             (ly:stencil-expr annotations)
 100             (ly:stencil-extent empty-stencil X)
 101             (ly:stencil-extent empty-stencil Y)
 102             )))
 103
 104     ))