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-layout system)
  21   (let*
  22       ((g (paper-system-system-grob system)))
  23
  24     (if (ly:grob? g)
  25         (ly:grob-layout  g)
  26         #f)))
  27
  28 (define-public (paper-system-system-grob paper-system)
  29   (ly:prob-property paper-system 'system-grob))
  30
  31 (define-public (paper-system-extent system axis)
  32   (ly:stencil-extent (paper-system-stencil system) axis))
  33
  34 (define-public (paper-system-staff-extents ps)
  35   (ly:prob-property ps 'staff-refpoint-extent '(0 . 0)))
  36
  37 (define-public (paper-system-annotate-last system layout)
  38   (let*
  39       ((bottomspace (ly:prob-property system 'bottom-space))
  40        (y-extent (paper-system-extent system Y))
  41        (x-extent (paper-system-extent system X))
  42        (stencil (ly:prob-property system 'stencil))
  43
  44        (arrow (if (number? bottomspace)
  45                (annotate-y-interval layout
  46                                     "bottom-space"
  47                                     (cons (- (car y-extent) bottomspace)
  48                                           (car y-extent))
  49                                     #t)
  50                #f)))
  51
  52     (if arrow
  53         (set! stencil
  54               (ly:stencil-add stencil arrow)))
  55
  56     (set! (ly:prob-property system 'stencil)
  57           stencil)
  58   ))
  59
  60 ; TODO: annotate the spacing for every spaceable staff within the system.
  61 (define-public (paper-system-annotate system next-system layout)
  62   "Add arrows and texts to indicate which lengths are set."
  63   (let* ((annotations (list))
  64          (grob (ly:prob-property system 'system-grob))
  65          (estimate-extent (if (ly:grob? grob)
  66                               (annotate-y-interval layout
  67                                                    "extent-estimate"
  68                                                    (ly:grob-property grob 'pure-Y-extent)
  69                                                    #f)
  70                               #f)))
  71     (let* ((spacing-spec (cond ((and next-system
  72                                      (paper-system-title? system)
  73                                      (paper-system-title? next-system))
  74                                 (ly:output-def-lookup layout 'between-title-spacing))
  75                                ((paper-system-title? system)
  76                                 (ly:output-def-lookup layout 'after-title-spacing))
  77                                ((and next-system
  78                                      (paper-system-title? next-system))
  79                                 (ly:output-def-lookup layout 'before-title-spacing))
  80                                (else
  81                                 (ly:output-def-lookup layout 'between-system-spacing))))
  82            (last-staff-Y (car (paper-system-staff-extents system))))
  83
  84       (set! annotations
  85             (annotate-spacing-spec layout spacing-spec last-staff-Y (car (paper-system-extent system Y)))))
  86     (if estimate-extent
  87         (set! annotations
  88               (stack-stencils X RIGHT 0.5
  89                               (list annotations
  90                                     estimate-extent))))
  91
  92     (if (not (null? annotations))
  93         (set! (ly:prob-property system 'stencil)
  94               (ly:stencil-add
  95                (ly:prob-property system 'stencil)
  96                (ly:make-stencil
  97                 (ly:stencil-expr annotations)
  98                 (ly:stencil-extent empty-stencil X)
  99                 (ly:stencil-extent empty-stencil Y)))))
 100     (ly:prob-property system 'stencil)))