scm/stencil.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2003--2009 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-public (stack-stencils axis dir padding stils)
  19   "Stack stencils STILS in direction AXIS, DIR, using PADDING."
  20   (cond
  21    ((null? stils) empty-stencil)
  22    ((null? (cdr stils)) (car stils))
  23    (else (ly:stencil-combine-at-edge
  24           (car stils) axis dir (stack-stencils axis dir padding (cdr stils))
  25           padding))))
  26
  27 (define-public (stack-stencils-padding-list axis dir padding stils)
  28   "Stack stencils STILS in direction AXIS, DIR, using a list of PADDING."
  29   (cond
  30    ((null? stils) empty-stencil)
  31    ((null? (cdr stils)) (car stils))
  32    (else (ly:stencil-combine-at-edge
  33           (car stils)
  34           axis dir
  35           (stack-stencils-padding-list axis dir (cdr padding) (cdr stils))
  36           (car padding)))))
  37
  38 (define-public (centered-stencil stencil)
  39   "Center stencil @var{stencil} in both the X and Y directions"
  40   (ly:stencil-aligned-to (ly:stencil-aligned-to stencil X CENTER) Y CENTER))
  41
  42 (define-public (stack-lines dir padding baseline stils)
  43   "Stack vertically with a baseline-skip."
  44   (define result empty-stencil)
  45   (define last-y #f)
  46   (do
  47       ((last-stencil #f (car p))
  48        (p stils (cdr p)))
  49
  50       ((null? p))
  51
  52     (if (number? last-y)
  53         (begin
  54           (let* ((dy (max (+ (* dir (interval-bound (ly:stencil-extent last-stencil Y) dir))
  55                              padding
  56                              (* (- dir) (interval-bound (ly:stencil-extent (car p) Y) (- dir))))
  57                           baseline))
  58                  (y (+ last-y  (* dir dy))))
  59
  60
  61
  62             (set! result
  63                   (ly:stencil-add result (ly:stencil-translate-axis (car p) y Y)))
  64             (set! last-y y)))
  65         (begin
  66           (set! last-y 0)
  67           (set! result (car p)))))
  68
  69   result)
  70
  71
  72 (define-public (bracketify-stencil stil axis thick protrusion padding)
  73   "Add brackets around STIL, producing a new stencil."
  74
  75   (let* ((ext (ly:stencil-extent stil axis))
  76          (lb (ly:bracket axis ext thick protrusion))
  77          (rb (ly:bracket axis ext thick (- protrusion))))
  78     (set! stil
  79           (ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding))
  80     (set! stil
  81           (ly:stencil-combine-at-edge lb (other-axis axis) 1 stil padding))
  82     stil))
  83
  84 (define-public (make-line-stencil width startx starty endx endy)
  85   "Make a line stencil of given linewidth and set its extents accordingly"
  86   (let ((xext (cons (min startx endx) (max startx endx)))
  87         (yext (cons (min starty endy) (max starty endy))))
  88     (ly:make-stencil
  89       (list 'draw-line width startx starty endx endy)
  90       ; Since the line has rounded edges, we have to / can safely add half the
  91       ; width to all coordinates!
  92       (interval-widen xext (/ width 2))
  93       (interval-widen yext (/ width 2)))))
  94
  95
  96 (define-public (make-filled-box-stencil xext yext)
  97   "Make a filled box."
  98
  99   (ly:make-stencil
 100       (list 'round-filled-box (- (car xext)) (cdr xext)
 101                        (- (car yext)) (cdr yext) 0.0)
 102       xext yext))
 103
 104 (define-public (make-circle-stencil radius thickness fill)
 105   "Make a circle of radius @var{radius} and thickness @var{thickness}"
 106   (let*
 107       ((out-radius (+ radius (/ thickness 2.0))))
 108
 109   (ly:make-stencil
 110    (list 'circle radius thickness fill)
 111    (cons (- out-radius) out-radius)
 112    (cons (- out-radius) out-radius))))
 113
 114 (define-public (make-oval-stencil x-radius y-radius thickness fill)
 115   "Make an oval from two Bezier curves, of x radius @var{x-radius},
 116     y radius @code{y-radius},
 117     and thickness @var{thickness} with fill defined by @code{fill}."
 118   (let*
 119       ((x-out-radius (+ x-radius (/ thickness 2.0)))
 120        (y-out-radius (+ y-radius (/ thickness 2.0))) )
 121
 122   (ly:make-stencil
 123    (list 'oval x-radius y-radius thickness fill)
 124    (cons (- x-out-radius) x-out-radius)
 125    (cons (- y-out-radius) y-out-radius))))
 126
 127 (define-public (make-ellipse-stencil x-radius y-radius thickness fill)
 128   "Make an ellipse of x radius @var{x-radius}, y radius @code{y-radius},
 129     and thickness @var{thickness} with fill defined by @code{fill}."
 130   (let*
 131       ((x-out-radius (+ x-radius (/ thickness 2.0)))
 132        (y-out-radius (+ y-radius (/ thickness 2.0))) )
 133
 134   (ly:make-stencil
 135    (list 'ellipse x-radius y-radius thickness fill)
 136    (cons (- x-out-radius) x-out-radius)
 137    (cons (- y-out-radius) y-out-radius))))
 138
 139 (define-public (box-grob-stencil grob)
 140   "Make a box of exactly the extents of the grob.  The box precisely
 141 encloses the contents.
 142 "
 143   (let* ((xext (ly:grob-extent grob grob 0))
 144          (yext (ly:grob-extent grob grob 1))
 145          (thick 0.01))
 146
 147     (ly:stencil-add
 148      (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext)))
 149      (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick)))
 150      (make-filled-box-stencil (cons (cdr xext) (+ (cdr xext) thick)) yext)
 151      (make-filled-box-stencil (cons (- (car xext) thick) (car xext)) yext))))
 152
 153 ;; TODO merge this and prev function.
 154 (define-public (box-stencil stencil thickness padding)
 155   "Add a box around STENCIL, producing a new stencil."
 156   (let* ((x-ext (interval-widen (ly:stencil-extent stencil 0) padding))
 157          (y-ext (interval-widen (ly:stencil-extent stencil 1) padding))
 158          (y-rule (make-filled-box-stencil (cons 0 thickness) y-ext))
 159          (x-rule (make-filled-box-stencil
 160                   (interval-widen x-ext thickness) (cons 0 thickness))))
 161     (set! stencil (ly:stencil-combine-at-edge stencil X 1 y-rule padding))
 162     (set! stencil (ly:stencil-combine-at-edge stencil X -1 y-rule padding))
 163     (set! stencil (ly:stencil-combine-at-edge stencil Y 1 x-rule 0.0))
 164     (set! stencil (ly:stencil-combine-at-edge stencil Y -1 x-rule 0.0))
 165     stencil))
 166
 167 (define-public (circle-stencil stencil thickness padding)
 168   "Add a circle around STENCIL, producing a new stencil."
 169   (let* ((x-ext (ly:stencil-extent stencil X))
 170          (y-ext (ly:stencil-extent stencil Y))
 171          (diameter (max (interval-length x-ext)
 172                         (interval-length y-ext)))
 173          (radius (+ (/ diameter 2) padding thickness))
 174          (circle (make-circle-stencil radius thickness #f)))
 175
 176     (ly:stencil-add
 177      stencil
 178      (ly:stencil-translate circle
 179                            (cons
 180                             (interval-center x-ext)
 181                             (interval-center y-ext))))))
 182
 183 (define-public (oval-stencil stencil thickness x-padding y-padding)
 184   "Add an oval around @code{stencil}, padded by the padding pair,
 185    producing a new stencil."
 186   (let* ((x-ext (ly:stencil-extent stencil X))
 187          (y-ext (ly:stencil-extent stencil Y))
 188          (x-length (+ (interval-length x-ext) x-padding thickness))
 189          (y-length (+ (interval-length y-ext) y-padding thickness))
 190          (x-radius (* 0.707 x-length) )
 191          (y-radius (* 0.707 y-length) )
 192          (oval (make-oval-stencil x-radius y-radius thickness #f)))
 193
 194     (ly:stencil-add
 195      stencil
 196      (ly:stencil-translate oval
 197                            (cons
 198                             (interval-center x-ext)
 199                             (interval-center y-ext))))))
 200
 201 (define-public (ellipse-stencil stencil thickness x-padding y-padding)
 202   "Add an ellipse around STENCIL, padded by the padding pair,
 203    producing a new stencil."
 204   (let* ((x-ext (ly:stencil-extent stencil X))
 205          (y-ext (ly:stencil-extent stencil Y))
 206          (x-length (+ (interval-length x-ext) x-padding thickness))
 207          (y-length (+ (interval-length y-ext) y-padding thickness))
 208          ;(aspect-ratio (/ x-length y-length))
 209          (x-radius (* 0.707 x-length) )
 210          (y-radius (* 0.707 y-length) )
 211          ;(diameter (max (- (cdr x-ext) (car x-ext))
 212          ;              (- (cdr y-ext) (car y-ext))))
 213          ;(radius (+ (/ diameter 2) padding thickness))
 214          (ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
 215
 216     (ly:stencil-add
 217      stencil
 218      (ly:stencil-translate ellipse
 219                            (cons
 220                             (interval-center x-ext)
 221                             (interval-center y-ext))))))
 222
 223 (define-public (rounded-box-stencil stencil thickness padding blot)
 224    "Add a rounded box around STENCIL, producing a new stencil."
 225
 226   (let* ((xext (interval-widen (ly:stencil-extent stencil 0) padding))
 227          (yext (interval-widen (ly:stencil-extent stencil 1) padding))
 228    (min-ext (min (-(cdr xext) (car xext)) (-(cdr yext) (car yext))))
 229    (ideal-blot (min blot (/ min-ext 2)))
 230    (ideal-thickness (min thickness (/ min-ext 2)))
 231          (outer (ly:round-filled-box
 232             (interval-widen xext ideal-thickness)
 233             (interval-widen yext ideal-thickness)
 234                ideal-blot))
 235          (inner (ly:make-stencil (list 'color (x11-color 'white)
 236             (ly:stencil-expr (ly:round-filled-box
 237                xext yext (- ideal-blot ideal-thickness)))))))
 238     (set! stencil (ly:stencil-add outer inner))
 239     stencil))
 240
 241
 242 (define-public (fontify-text font-metric text)
 243   "Set TEXT with font FONT-METRIC, returning a stencil."
 244   (let* ((b (ly:text-dimension font-metric text)))
 245     (ly:make-stencil
 246      `(text ,font-metric ,text) (car b) (cdr b))))
 247
 248 (define-public (fontify-text-white scale font-metric text)
 249   "Set TEXT with scale factor SCALE"
 250   (let* ((b (ly:text-dimension font-metric text))
 251          ;;urg -- workaround for using ps font
 252          (c `(white-text ,(* 2 scale) ,text)))
 253     ;;urg -- extent is not from ps font, but we hope it's close
 254     (ly:make-stencil c (car b) (cdr b))))
 255
 256 (define-public (stencil-with-color stencil color)
 257   (ly:make-stencil
 258    (list 'color color (ly:stencil-expr stencil))
 259    (ly:stencil-extent stencil X)
 260    (ly:stencil-extent stencil Y)))
 261
 262 (define-public (stencil-whiteout stencil)
 263   (let*
 264       ((x-ext (ly:stencil-extent stencil X))
 265        (y-ext (ly:stencil-extent stencil Y))
 266
 267        )
 268
 269     (ly:stencil-add
 270      (stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
 271                          white)
 272      stencil)
 273     ))
 274
 275 (define-public (dimension-arrows destination max-size)
 276   "Draw twosided arrow from here to @var{destination}"
 277
 278   (let*
 279       ((e_x 1+0i)
 280        (e_y 0+1i)
 281        (distance (sqrt (+ (* (car destination) (car destination))
 282                           (* (cdr destination) (cdr destination)))))
 283        (size (min max-size (/ distance 3)))
 284        (rotate (lambda (z ang)
 285                  (* (make-polar 1 ang)
 286                     z)))
 287        (complex-to-offset (lambda (z)
 288                             (list (real-part z) (imag-part z))))
 289
 290        (z-dest (+ (* e_x (car destination)) (* e_y (cdr destination))))
 291        (e_z (/ z-dest (magnitude z-dest)))
 292        (triangle-points (list
 293                          (* size -1+0.25i)
 294                          0
 295                          (* size -1-0.25i)))
 296        (p1s (map (lambda (z)
 297                    (+ z-dest (rotate z (angle z-dest))))
 298                  triangle-points))
 299        (p2s (map (lambda (z)
 300                    (rotate z (angle (- z-dest))))
 301                    triangle-points))
 302        (null (cons 0 0))
 303        (arrow-1
 304         (ly:make-stencil
 305          `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
 306                    0.0
 307                    #t) null null))
 308        (arrow-2
 309         (ly:make-stencil
 310          `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
 311                    0.0
 312                    #t) null null ) )
 313        (thickness (min (/ distance 12) 0.1))
 314        (shorten-line (min (/ distance 3) 0.5))
 315        (start (complex-to-offset (/ (* e_z shorten-line) 2)))
 316        (end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2))))
 317
 318        (line (ly:make-stencil
 319               `(draw-line ,thickness
 320                           ,(car start) ,(cadr start)
 321                           ,(car end) ,(cadr end)
 322                           )
 323               (cons (min 0 (car destination))
 324                     (min 0 (cdr destination)))
 325               (cons (max 0 (car destination))
 326                     (max 0 (cdr destination)))))
 327
 328        (result (ly:stencil-add arrow-2 arrow-1 line)))
 329
 330
 331     result))
 332
 333 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 334 ;; ANNOTATIONS
 335 ;;
 336 ;; annotations are arrows indicating the numerical value of
 337 ;; spacing variables
 338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 339
 340 (define*-public (annotate-y-interval layout name extent is-length
 341                                      #:key (color darkblue))
 342   (let ((text-props (cons '((font-size . -3)
 343                             (font-family . typewriter))
 344                           (layout-extract-page-properties layout)))
 345         (annotation #f))
 346     (define (center-stencil-on-extent stil)
 347       (ly:stencil-translate (ly:stencil-aligned-to stil Y CENTER)
 348                             (cons 0 (interval-center extent))))
 349     ;; do something sensible for 0,0 intervals.
 350     (set! extent (interval-widen extent 0.001))
 351     (if (not (interval-sane? extent))
 352         (set! annotation (interpret-markup
 353                           layout text-props
 354                           (make-simple-markup (simple-format #f "~a: NaN/inf" name))))
 355         (let ((text-stencil (interpret-markup
 356                              layout text-props
 357                              (markup #:whiteout #:simple name)))
 358               (dim-stencil (interpret-markup
 359                             layout text-props
 360                             (markup #:whiteout
 361                                     #:simple (cond
 362                                               ((interval-empty? extent)
 363                                                (format "empty"))
 364                                               (is-length
 365                                                (ly:format "~$" (interval-length extent)))
 366                                               (else
 367                                                (ly:format "(~$,~$)"
 368                                                        (car extent) (cdr extent)))))))
 369               (arrows (ly:stencil-translate-axis
 370                        (dimension-arrows (cons 0 (interval-length extent)) 1.0)
 371                        (interval-start extent) Y)))
 372           (set! annotation
 373                 (center-stencil-on-extent text-stencil))
 374           (set! annotation
 375                 (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5))
 376           (set! annotation
 377                 (ly:stencil-combine-at-edge annotation X LEFT
 378                                             (center-stencil-on-extent dim-stencil)
 379                                             0.5))
 380           (set! annotation
 381                 (ly:make-stencil (list 'color color (ly:stencil-expr annotation))
 382                                  (ly:stencil-extent annotation X)
 383                                  (cons 10000 -10000)))))
 384     annotation))
 385
 386
 387 (define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end
 388                                       #:key (base-color blue))
 389   (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
 390          (space (get-spacing-var 'space))
 391          (padding (get-spacing-var 'padding))
 392          (min-dist (get-spacing-var 'minimum-distance))
 393          (contrast-color (append (cdr base-color) (list (car base-color)))))
 394     (stack-stencils X RIGHT 0.0
 395                     (list
 396                      (annotate-y-interval layout
 397                                           "space"
 398                                           (cons (- start-Y-offset space) start-Y-offset)
 399                                           #t
 400                                           #:color (map (lambda (x) (* x 0.25)) base-color))
 401                      (annotate-y-interval layout
 402                                           "min-dist"
 403                                           (cons (- start-Y-offset min-dist) start-Y-offset)
 404                                           #t
 405                                           #:color (map (lambda (x) (* x 0.5)) base-color))
 406                      (ly:stencil-add
 407                       (annotate-y-interval layout
 408                                            "bottom-of-extent"
 409                                            (cons prev-system-end start-Y-offset)
 410                                            #t
 411                                            #:color base-color)
 412                       (annotate-y-interval layout
 413                                            "padding"
 414                                            (cons (- prev-system-end padding) prev-system-end)
 415                                            #t
 416                                            #:color contrast-color))))))
 417
 418
 419 (define-public (eps-file->stencil axis size file-name)
 420   (let*
 421       ((contents (ly:gulp-file file-name))
 422        (bbox (get-postscript-bbox (car (string-split contents #\nul))))
 423        (bbox-size (if (= axis X)
 424                       (- (list-ref bbox 2) (list-ref bbox 0))
 425                       (- (list-ref bbox 3) (list-ref bbox 1))
 426                       ))
 427        (factor (if (< 0 bbox-size)
 428                    (exact->inexact (/ size bbox-size))
 429                    0))
 430        (scaled-bbox
 431         (map (lambda (x) (* factor x)) bbox))
 432        ; We need to shift the whole eps to (0,0), otherwise it will appear
 433        ; displaced in lilypond (displacement will depend on the scaling!)
 434        (translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
 435        (clip-rect-string (ly:format
 436                           "~a ~a ~a ~a rectclip"
 437                           (list-ref bbox 0)
 438                           (list-ref bbox 1)
 439                           (- (list-ref bbox 2) (list-ref bbox 0))
 440                           (- (list-ref bbox 3) (list-ref bbox 1)))))
 441
 442
 443     (if bbox
 444         (ly:make-stencil
 445          (list
 446           'embedded-ps
 447           (string-append
 448            (ly:format
 449            "
 450 gsave
 451 currentpoint translate
 452 BeginEPSF
 453 ~a dup scale
 454 ~a
 455 ~a
 456 %%BeginDocument: ~a
 457 "         factor translate-string  clip-rect-string
 458
 459            file-name
 460            )
 461            contents
 462            "%%EndDocument
 463 EndEPSF
 464 grestore
 465 "))
 466          ; Stencil starts at (0,0), since we have shifted the eps, and its
 467          ; size is exactly the size of the scaled bounding box
 468          (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0)))
 469          (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1))))
 470
 471         (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 472     ))
 473
 474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 475 ;; output signatures.
 476
 477 (define-public (write-system-signatures basename paper-systems count)
 478   (if (pair? paper-systems)
 479       (begin
 480         (let*
 481             ((outname (simple-format #f "~a-~a.signature" basename count)) )
 482
 483           (ly:message "Writing ~a" outname)
 484           (write-system-signature outname (car paper-systems))
 485           (write-system-signatures basename (cdr paper-systems) (1+ count))))))
 486
 487 (use-modules (scm paper-system))
 488 (define-public (write-system-signature filename paper-system)
 489   (define (float? x)
 490     (and (number? x) (inexact? x)))
 491
 492   (define system-grob
 493     (paper-system-system-grob paper-system))
 494
 495   (define output (open-output-file filename))
 496
 497   ;; todo: optionally use a command line flag? Or just junk this?
 498   (define compare-expressions #f)
 499   (define (strip-floats expr)
 500     "Replace floats by #f"
 501     (cond
 502      ((float? expr) #f)
 503      ((ly:font-metric? expr) (ly:font-name expr))
 504      ((pair? expr) (cons (strip-floats (car expr))
 505                          (strip-floats (cdr expr))))
 506      (else expr)))
 507
 508   (define (fold-false-pairs expr)
 509     "Try to remove lists of #f as much as possible."
 510     (if (pair? expr)
 511         (let*
 512             ((first (car expr))
 513              (rest (fold-false-pairs (cdr expr))))
 514
 515           (if first
 516               (cons (fold-false-pairs first) rest)
 517               rest))
 518         expr))
 519
 520   (define (raw-string expr)
 521     "escape quotes and slashes for python consumption"
 522     (regexp-substitute/global #f "[@\n]" (simple-format #f "~a" expr) 'pre " " 'post))
 523
 524   (define (raw-pair expr)
 525     (simple-format #f "~a ~a"
 526             (car expr) (cdr expr)))
 527
 528   (define (found-grob expr)
 529     (let*
 530         ((grob (car expr))
 531          (rest (cdr expr))
 532          (collected '())
 533          (cause (event-cause grob))
 534          (input (if (ly:stream-event? cause) (ly:event-property cause 'origin) #f))
 535          (location (if (ly:input-location? input) (ly:input-file-line-char-column input) '()))
 536
 537          ;; todo: use stencil extent if available.
 538          (x-ext (ly:grob-extent grob system-grob X))
 539          (y-ext (ly:grob-extent grob system-grob Y))
 540          (expression-skeleton
 541           (if compare-expressions
 542               (interpret-for-signature
 543                #f (lambda (e)
 544                     (set! collected (cons e collected)))
 545                rest)
 546              "")))
 547
 548       (simple-format output
 549               "~a@~a@~a@~a@~a\n"
 550               (cdr (assq 'name (ly:grob-property grob 'meta) ))
 551               (raw-string location)
 552               (raw-pair (if (interval-empty? x-ext) '(1 . -1) x-ext))
 553               (raw-pair (if (interval-empty? y-ext) '(1 . -1) y-ext))
 554               (raw-string collected))
 555       ))
 556
 557   (define (interpret-for-signature escape collect expr)
 558     (define (interpret expr)
 559       (let*
 560           ((head (if (pair? expr)
 561                      (car expr)
 562                      #f)))
 563
 564         (cond
 565          ((eq? head 'grob-cause) (escape (cdr expr)))
 566          ((eq? head 'color) (interpret (caddr expr)))
 567          ((eq? head 'rotate-stencil) (interpret (caddr expr)))
 568          ((eq? head 'translate-stencil) (interpret (caddr expr)))
 569          ((eq? head 'combine-stencil)
 570           (for-each (lambda (e) (interpret e))  (cdr expr)))
 571          (else
 572           (collect (fold-false-pairs (strip-floats expr))))
 573
 574          )))
 575
 576     (interpret expr))
 577
 578   (if (ly:grob? system-grob)
 579       (begin
 580         (display (simple-format #f "# Output signature\n# Generated by LilyPond ~a\n" (lilypond-version))
 581                  output)
 582         (interpret-for-signature found-grob (lambda (x) #f)
 583                                  (ly:stencil-expr
 584                                   (paper-system-stencil paper-system)))))
 585
 586   ;; should be superfluous, but leaking "too many open files"?
 587   (close-port output))
 588