scm/framework-ps.scm

   1 ;;;; framework-ps.scm -- structure for PostScript output
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
   6
   7 (define-module (scm framework-ps))
   8
   9 ;;; this is still too big a mess.
  10
  11 (use-modules (ice-9 string-fun)
  12              (guile)
  13              (scm page)
  14              (scm paper-system)
  15              (srfi srfi-1)
  16              (srfi srfi-13)
  17              (scm clip-region)
  18              (lily))
  19
  20 (define (format dest . rest)
  21   (if (string? dest)
  22       (apply simple-format (cons #f (cons dest rest)))
  23       (apply simple-format (cons dest rest))))
  24
  25 (define framework-ps-module (current-module))
  26
  27 ;;(define pdebug stderr)
  28 (define (pdebug . rest) #f)
  29
  30 (define-public (ps-font-command font)
  31   (let* ((name (ly:font-file-name font))
  32          (magnify (ly:font-magnification font)))
  33
  34     (string-append
  35      "magfont"
  36      (ly:string-substitute
  37       " " "_"
  38       (ly:string-substitute
  39        "/" "_"
  40        (ly:string-substitute
  41         "%" "_" name)))
  42      "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
  43
  44 (define (tex-font? fontname)
  45   (or
  46    (equal? (substring fontname 0 2) "cm")
  47    (equal? (substring fontname 0 2) "ec")))
  48
  49 (define (define-fonts paper)
  50   (define font-list (ly:paper-fonts paper))
  51   (define (define-font command fontname scaling)
  52     (string-append
  53       "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n"))
  54
  55   (define (standard-tex-font? x)
  56     (or (equal? (substring x 0 2) "ms")
  57         (equal? (substring x 0 2) "cm")))
  58
  59   (define (font-load-command font)
  60     (let* ((specced-font-name (ly:font-name font))
  61            (fontname (if specced-font-name
  62                           specced-font-name
  63                          (ly:font-file-name font)))
  64            (command (ps-font-command font))
  65
  66            ;; FIXME -- see (ps-font-command )
  67            (plain (ps-font-command font))
  68            (designsize (ly:font-design-size font))
  69            (magnification (* (ly:font-magnification font)))
  70            (ops (ly:output-def-lookup paper 'output-scale))
  71            (scaling (* ops magnification designsize)))
  72
  73       ;; Bluesky pfbs have UPCASE names (sigh.)
  74       ;; FIXME - don't support Bluesky?
  75       (if (standard-tex-font? fontname)
  76           (set! fontname (string-upcase fontname)))
  77       (if (equal? fontname "unknown")
  78           (display (list font fontname)))
  79       (define-font plain fontname scaling)))
  80
  81   (apply string-append
  82          (map (lambda (x) (font-load-command x))
  83               (filter (lambda (x) (not (ly:pango-font? x)))
  84                       font-list))))
  85
  86 ;; FIXME: duplicated in other output backends
  87 ;; FIXME: silly interface name
  88 (define (output-variables layout)
  89   ;; FIXME: duplicates output-layout's scope-entry->string, mostly
  90   (define (value->string val)
  91     (cond
  92      ((string? val) (string-append "(" val ")"))
  93      ((symbol? val) (symbol->string val))
  94      ((number? val) (number->string val))
  95      (else "")))
  96
  97   (define (output-entry ps-key ly-key)
  98     (string-append
  99      "/" ps-key " "
 100      (value->string (ly:output-def-lookup layout ly-key)) " def\n"))
 101
 102   (string-append
 103    "/lily-output-units "
 104      (number->string (/ (ly:bp 1)))
 105      " def %% millimeter\n"
 106    (output-entry "staff-line-thickness" 'line-thickness)
 107    (output-entry "line-width" 'line-width)
 108    (output-entry "paper-size" 'papersizename)
 109    (output-entry "staff-height" 'staff-height)  ;junkme.
 110    "/output-scale "
 111      (number->string (ly:output-def-lookup layout 'output-scale))
 112      " def\n"
 113    (output-entry "page-height" 'paper-height)
 114    (output-entry "page-width" 'paper-width)))
 115
 116 (define (dump-page outputter page page-number page-count landscape?)
 117   (ly:outputter-dump-string
 118    outputter
 119    (string-append
 120     (format "%%Page: ~a ~a\n" page-number page-number)
 121     "%%BeginPageSetup\n"
 122     (if landscape?
 123         "page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n"
 124         "")
 125     "%%EndPageSetup\n"
 126
 127     "true setstrokeadjust\n"
 128     "gsave 0 paper-height translate "
 129     "set-ps-scale-to-lily-scale "
 130     "\n"))
 131   (ly:outputter-dump-stencil outputter page)
 132   (ly:outputter-dump-string outputter "stroke grestore \nshowpage\n"))
 133
 134 (define (supplies-or-needs paper load-fonts?)
 135   (define (extract-names font)
 136     (if (ly:pango-font? font)
 137         (map car (ly:pango-font-physical-fonts font))
 138         (list  (ly:font-name font))))
 139
 140   (let* ((fonts (ly:paper-fonts paper))
 141          (names (apply append (map extract-names fonts))))
 142
 143     (apply string-append
 144            (map (lambda (f)
 145                   (format
 146                    (if load-fonts?
 147                     "%%DocumentSuppliedResources: font ~a\n"
 148                     "%%DocumentNeededResources: font ~a\n")
 149                    f))
 150                 (uniq-list (sort names string<?))))))
 151
 152 (define (eps-header paper bbox load-fonts?)
 153   (string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
 154                  "%%Creator: LilyPond "
 155                  (lilypond-version)
 156                  "\n"
 157                  "%%BoundingBox: "
 158                  (string-join (map ly:number->string bbox) " ") "\n"
 159                  "%%Orientation: "
 160                  (if (eq? (ly:output-def-lookup paper 'landscape) #t)
 161                      "Landscape\n"
 162                      "Portrait\n")
 163                  (supplies-or-needs paper load-fonts?)
 164                  "%%EndComments\n"))
 165
 166 (define (ps-document-media paper)
 167  (let* ((w (/ (*
 168                (ly:output-def-lookup paper 'output-scale)
 169                (ly:output-def-lookup paper 'paper-width)) (ly:bp 1)))
 170         (h (/ (*
 171                (ly:output-def-lookup paper 'paper-height)
 172                (ly:output-def-lookup paper 'output-scale))
 173             (ly:bp 1)))
 174         (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
 175   (format "%%DocumentMedia: ~a ~a ~a ~a ~a ~a\n"
 176    (ly:output-def-lookup paper 'papersizename)
 177    (round2 (if landscape? h w))
 178    (round2 (if landscape? w h))
 179    80  ;; weight
 180    "()" ;; color
 181    "()"  ;; type
 182   )))
 183
 184
 185 (define (file-header paper page-count load-fonts?)
 186   (string-append "%!PS-Adobe-3.0\n"
 187                  "%%Creator: LilyPond "
 188                  (lilypond-version)
 189                  "\n"
 190
 191                  "%%Pages: " (number->string page-count) "\n"
 192                  "%%PageOrder: Ascend\n"
 193                  "%%Orientation: "
 194                  (if (eq? (ly:output-def-lookup paper 'landscape) #t)
 195                      "Landscape\n"
 196                      "Portrait\n")
 197                  (ps-document-media paper)
 198                  (supplies-or-needs paper load-fonts?)
 199                  "%%EndComments\n"))
 200
 201 (define (procset file-name)
 202   (format
 203     "%%BeginResource: procset (~a) 1 0
 204 ~a
 205 %%EndResource
 206 "
 207     file-name (cached-file-contents file-name)))
 208
 209 (define (embed-document file-name)
 210   (format "%%BeginDocument: ~a
 211 ~a
 212 %%EndDocument
 213 "
 214     file-name (cached-file-contents file-name)))
 215
 216 (define (setup-variables paper)
 217   (string-append
 218    "\n"
 219    (define-fonts paper)
 220    (output-variables paper)
 221    ))
 222
 223 (define (cff-font? font)
 224   (let*
 225       ((cff-string (ly:otf-font-table-data font "CFF ")))
 226     (> (string-length cff-string) 0)))
 227
 228 (define-public (ps-embed-cff body font-set-name version)
 229   (let* ((binary-data
 230           (string-append
 231            (format "/~a ~s StartData " font-set-name (string-length body))
 232            body))
 233
 234          (header
 235           (format
 236            "%%BeginResource: font ~a
 237 %!PS-Adobe-3.0 Resource-FontSet
 238 %%DocumentNeededResources: ProcSet (FontSetInit)
 239 %%Title: (FontSet/~a)
 240 %%Version: ~s
 241 %%EndComments
 242 %%IncludeResource: ProcSet (FontSetInit)
 243 %%BeginResource: FontSet (~a)
 244 /FontSetInit /ProcSet findresource begin
 245 %%BeginData: ~s Binary Bytes
 246 "
 247            font-set-name font-set-name version font-set-name
 248            (string-length binary-data)))
 249          (footer "\n%%EndData
 250 %%EndResource
 251 %%EndResource\n"))
 252
 253     (string-append
 254      header
 255      binary-data
 256      footer)))
 257
 258
 259 (define (write-preamble paper load-fonts? port)
 260
 261   (define (load-font-via-GS font-name-filename)
 262     (define (ps-load-file name)
 263       (format
 264        (if (string? name)
 265            "(~a) (r) file .loadfont\n"
 266            "% cannot find font file: ~a\n")
 267        name))
 268
 269     (let* ((font (car font-name-filename))
 270            (name (cadr font-name-filename))
 271            (file-name (caddr font-name-filename))
 272            (bare-file-name (ly:find-file file-name)))
 273
 274       (cons
 275        name
 276
 277        (if (mac-font? bare-file-name)
 278            (handle-mac-font name bare-file-name)
 279            (cond
 280             ((or (string-startswith file-name "Emmentaler")
 281                  (string-startswith file-name "emmentaler")
 282                  (string-startswith file-name "aybabtu")
 283                  (string-startswith file-name "Aybabtu"))
 284              (ps-load-file (ly:find-file
 285                             (format "~a.otf"  file-name))))
 286             ((string? bare-file-name)
 287              (ps-load-file file-name))
 288             (else
 289              (ly:warning (_ "cannot embed ~S=~S") name file-name)
 290              "")))
 291
 292           )))
 293
 294   (define (dir-join a b)
 295     (if (equal? a "")
 296         b
 297         (string-append a "/" b)))
 298
 299   (define (dir-listing dir-name)
 300     (define (dir-helper dir lst)
 301       (let ((e (readdir dir)))
 302         (if (eof-object? e) lst (dir-helper dir (cons e lst)))))
 303     (reverse (dir-helper (opendir dir-name) '())))
 304
 305   (define (handle-mac-font name filename)
 306     (let*
 307         ((dir-name  (tmpnam))
 308          (files '())
 309          (status 0)
 310          (embed #f))
 311
 312       (mkdir dir-name #o700)
 313       (set! status (ly:system
 314                     (format "cd ~a && fondu -force '~a'" dir-name filename)))
 315
 316       (set! files (dir-listing dir-name))
 317
 318       (for-each
 319        (lambda (f)
 320          (let*
 321              ((full-name  (dir-join dir-name f)))
 322
 323            (if (and (not embed)
 324                     (equal? 'regular (stat:type (stat full-name)))
 325                     (equal? name (ly:ttf-ps-name full-name)))
 326
 327                (set! embed
 328                      (font-file-as-ps-string name full-name)))
 329
 330            (if (or (equal? "." f)
 331                    (equal? ".." f))
 332                #t
 333                (delete-file full-name))))
 334
 335
 336        files)
 337       (rmdir dir-name)
 338
 339       (if (not embed)
 340           (begin
 341             (set! embed "% failed \n")
 342             (ly:warning (_ "cannot extract file matching ~a from ~a") name filename)))
 343       embed))
 344
 345     (define (font-file-as-ps-string name file-name)
 346       (let*
 347           ((downcase-file-name (string-downcase file-name)))
 348
 349       (cond
 350        ((and file-name (string-endswith downcase-file-name ".pfa"))
 351         (embed-document file-name))
 352        ((and file-name (string-endswith downcase-file-name ".pfb"))
 353         (ly:pfb->pfa file-name))
 354        ((and file-name (string-endswith downcase-file-name ".ttf"))
 355         (ly:ttf->pfa file-name))
 356        ((and file-name (string-endswith downcase-file-name ".otf"))
 357         (ps-embed-cff (ly:otf->cff file-name) name 0))
 358        (else
 359         (ly:warning (_ "do not know how to embed ~S=~S") name file-name)
 360         ""))))
 361
 362     (define (mac-font? bare-file-name)
 363       (and
 364        (eq? PLATFORM 'darwin)
 365        bare-file-name
 366        (or
 367         (string-endswith  bare-file-name ".dfont")
 368         (= (stat:size (stat bare-file-name)) 0))))
 369
 370   (define (load-font font-name-filename)
 371     (let* ((font (car font-name-filename))
 372            (name (cadr font-name-filename))
 373            (file-name (caddr font-name-filename))
 374            (bare-file-name (ly:find-file file-name)))
 375
 376       (cons
 377        name
 378        (cond
 379
 380         ((mac-font? bare-file-name)
 381          (handle-mac-font name bare-file-name))
 382
 383         ((and font (cff-font? font))
 384          (ps-embed-cff (ly:otf-font-table-data font "CFF ")
 385                        name
 386                        0))
 387
 388         (bare-file-name (font-file-as-ps-string name bare-file-name))
 389         (else
 390          (ly:warning (_ "do not know how to embed font ~s ~s ~s")
 391                      name file-name font))))))
 392
 393
 394   (define (load-fonts paper)
 395     (let* ((fonts (ly:paper-fonts paper))
 396            (all-font-names
 397             (map
 398              (lambda (font)
 399                (cond
 400                 ((string? (ly:font-file-name font))
 401                  (list (list
 402                         font
 403                         (ly:font-name font)
 404                         (ly:font-file-name font))))
 405                 ((ly:pango-font? font)
 406                  (map
 407                   (lambda (name-psname-pair)
 408                     (list #f
 409                           (car name-psname-pair)
 410                           (cdr name-psname-pair)))
 411                   (ly:pango-font-physical-fonts font)))
 412
 413                 (else
 414                  (ly:font-sub-fonts font))))
 415
 416              fonts))
 417            (font-names
 418             (uniq-list
 419              (sort (apply append all-font-names)
 420                    (lambda (x y) (string<? (cadr x) (cadr y))))))
 421
 422            (font-loader (if (ly:get-option 'gs-load-fonts)
 423                             load-font-via-GS
 424                             load-font))
 425
 426            (pfas (map font-loader font-names)))
 427       pfas))
 428
 429   (display "%%BeginProlog\n" port)
 430   (if load-fonts?
 431       (for-each
 432        (lambda (f)
 433          (format port "\n%%BeginFont: ~a\n" (car f))
 434          (display (cdr f) port)
 435          (display "\n%%EndFont\n" port))
 436        (load-fonts paper)))
 437
 438   (display (setup-variables paper) port)
 439
 440   ;; adobe note 5002: should initialize variables before loading routines.
 441   (display (procset "music-drawing-routines.ps") port)
 442   (display (procset "lilyponddefs.ps") port)
 443
 444   (if (not (ly:get-option 'point-and-click))
 445       (display "/mark_URI { pop pop pop pop pop } bind def\n" port))
 446
 447   (display "%%EndProlog\n" port)
 448
 449   (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port))
 450
 451 (define-public (output-framework basename book scopes fields)
 452   (let* ((filename (format "~a.ps" basename))
 453          (outputter (ly:make-paper-outputter
 454                      ;; FIXME: better wrap open/open-file,
 455                      ;; content-mangling is always bad.
 456                      ;; MINGW hack: need to have "b"inary for embedding CFFs
 457                      (open-file filename "wb")
 458                      "ps"))
 459          (paper (ly:paper-book-paper book))
 460          (systems (ly:paper-book-systems book))
 461          (page-stencils (map page-stencil (ly:paper-book-pages book)))
 462
 463          (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
 464          (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
 465          (page-count (length page-stencils))
 466          (port (ly:outputter-port outputter)))
 467
 468
 469     (if (ly:get-option 'clip-systems)
 470         (clip-system-EPSes basename book))
 471
 472     (if (ly:get-option 'dump-signatures)
 473         (write-system-signatures basename (ly:paper-book-systems book) 1))
 474
 475     (output-scopes scopes fields basename)
 476     (display (file-header paper page-count #t) port)
 477
 478     ;; don't do BeginDefaults PageMedia: A4
 479     ;; not necessary and wrong
 480
 481     (write-preamble paper #t port)
 482
 483     (for-each
 484      (lambda (page)
 485        (set! page-number (1+ page-number))
 486        (dump-page outputter page page-number page-count landscape?))
 487      page-stencils)
 488
 489     (display "%%Trailer\n%%EOF\n" port)
 490     (ly:outputter-close outputter)
 491     (postprocess-output book framework-ps-module filename
 492                          (ly:output-formats))))
 493
 494 (define-public (dump-stencil-as-EPS paper dump-me filename
 495                                     load-fonts)
 496
 497   (let*
 498       ((xext (ly:stencil-extent dump-me X))
 499        (yext (ly:stencil-extent dump-me Y))
 500        (padding (ly:get-option 'eps-box-padding))
 501        (left-overshoot (if (number? padding)
 502                            (* -1 padding (ly:output-def-lookup paper 'mm))
 503                            #f))
 504        (bbox
 505         (map
 506          (lambda (x)
 507            (if (or (nan? x) (inf? x)
 508                      ;; FIXME: huh?
 509                    (equal? (format #f "~S" x) "+#.#")
 510                    (equal? (format #f "~S" x) "-#.#"))
 511                0.0 x))
 512
 513            ;; the left-overshoot is to make sure that
 514            ;; bar numbers  stick out of margin uniformly.
 515            ;;
 516            (list
 517
 518             (if (number? left-overshoot)
 519                 (min left-overshoot (car xext))
 520                 (car xext))
 521             (car yext) (cdr xext) (cdr yext)))))
 522
 523        (dump-stencil-as-EPS-with-bbox paper dump-me filename load-fonts bbox)
 524        ))
 525
 526
 527 (define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename
 528                                               load-fonts
 529                                               bbox)
 530   (define (to-bp-box mmbox)
 531     (let* ((scale (ly:output-def-lookup paper 'output-scale))
 532            (box (map
 533                  (lambda (x)
 534                    (if (or (nan? x) (inf? x))
 535                        0
 536                        (inexact->exact
 537                         (round (/ (* x scale) (ly:bp 1)))))) mmbox)))
 538
 539     (list (car box)
 540           (cadr box)
 541           (max (1+ (car box)) (caddr box))
 542           (max (1+ (cadr box)) (cadddr box))
 543           )))
 544
 545   (let* ((outputter (ly:make-paper-outputter
 546                      ;; FIXME: better wrap open/open-file,
 547                      ;; content-mangling is always bad.
 548                      ;; MINGW hack: need to have "b"inary for embedding CFFs
 549                      (open-file (format "~a.eps" filename) "wb")
 550                      "ps"))
 551
 552          (port (ly:outputter-port outputter))
 553          (rounded-bbox (to-bp-box bbox))
 554          (port (ly:outputter-port outputter))
 555          (header (eps-header paper rounded-bbox load-fonts)))
 556
 557     (display header port)
 558     (write-preamble paper load-fonts port)
 559     (display "gsave set-ps-scale-to-lily-scale \n" port)
 560     (ly:outputter-dump-stencil outputter dump-me)
 561     (display "stroke grestore\n%%Trailer\n%%EOF\n" port)
 562     (ly:outputter-close outputter)))
 563
 564
 565
 566 (define (clip-systems-to-region
 567          basename paper systems region
 568          do-pdf)
 569
 570   (let*
 571       ((extents-system-pairs
 572         (filtered-map
 573          (lambda (paper-system)
 574            (let*
 575                ((x-ext (system-clipped-x-extent
 576                         (paper-system-system-grob paper-system)
 577                         region)))
 578
 579              (if x-ext
 580                  (cons x-ext paper-system)
 581                  #f)))
 582
 583          systems))
 584        (count 0))
 585
 586     (for-each
 587      (lambda (ext-system-pair)
 588        (let*
 589            ((xext (car ext-system-pair))
 590             (paper-system (cdr ext-system-pair))
 591             (yext (paper-system-extent paper-system Y))
 592             (bbox (list (car  xext) (car yext)
 593                         (cdr xext) (cdr yext)))
 594             (filename (if (< 0 count)
 595                           (format "~a-~a" basename count)
 596                           basename)))
 597
 598          (set! count (1+ count))
 599          (dump-stencil-as-EPS-with-bbox
 600           paper
 601           (paper-system-stencil paper-system)
 602           filename
 603           (ly:get-option 'include-eps-fonts)
 604           bbox)
 605
 606          (if do-pdf
 607              (postscript->pdf  0 0  (format "~a.eps" filename)))
 608          ))
 609
 610      extents-system-pairs)
 611     ))
 612
 613
 614 (define (clip-system-EPSes basename paper-book)
 615   (define do-pdf (member  "pdf" (ly:output-formats)))
 616
 617   (define (clip-score-systems basename systems)
 618     (let*
 619         ((layout (ly:grob-layout (paper-system-system-grob (car systems))))
 620          (regions (ly:output-def-lookup layout 'clip-regions)))
 621
 622       (for-each
 623        (lambda (region)
 624          (clip-systems-to-region
 625           (format "~a-from-~a-to-~a-clip"
 626                   basename
 627                   (rhythmic-location->file-string (car region))
 628                   (rhythmic-location->file-string (cdr region)))
 629           layout systems region
 630           do-pdf))
 631
 632        regions)))
 633
 634
 635   ;; partition in system lists sharing their layout blocks
 636   (let*
 637       ((systems (ly:paper-book-systems paper-book))
 638        (count 0)
 639        (score-system-list '()))
 640
 641     (fold
 642      (lambda (system last-system)
 643
 644
 645        (if (not (and last-system
 646                      (equal? (paper-system-layout last-system)
 647                              (paper-system-layout system))))
 648            (set! score-system-list (cons '() score-system-list)))
 649
 650        (if (paper-system-layout system)
 651            (set-car! score-system-list (cons system (car score-system-list))))
 652
 653        ;; pass value.
 654        system)
 655
 656      #f
 657      systems)
 658
 659     (for-each
 660      (lambda (system-list)
 661        (clip-score-systems
 662         (if (> count 0)
 663             (format "~a-~a" basename count)
 664             basename)
 665         system-list))
 666
 667      score-system-list)))
 668
 669
 670 (define-public (output-preview-framework basename book scopes fields)
 671   (let* ((paper (ly:paper-book-paper book))
 672          (systems (ly:paper-book-systems book))
 673          (scale (ly:output-def-lookup paper 'output-scale))
 674          (to-dump-systems '()))
 675
 676     ;; skip booktitles.
 677     (if (and
 678          (not (ly:get-option 'include-book-title-preview))
 679          (pair? systems)
 680          (ly:prob-property (car systems) 'is-book-title #f))
 681
 682         (set! systems (cdr systems)))
 683
 684     (for-each
 685      (lambda (sys)
 686        (if (or
 687             (paper-system-title? sys)
 688             (not (pair? to-dump-systems))
 689             (paper-system-title? (car to-dump-systems)))
 690            (set! to-dump-systems (cons sys to-dump-systems))))
 691      systems)
 692
 693     (dump-stencil-as-EPS
 694      paper
 695      (stack-stencils Y DOWN 0.0
 696                      (map paper-system-stencil (reverse to-dump-systems)))
 697      (format "~a.preview" basename)
 698      #t)
 699
 700     (postprocess-output book framework-ps-module
 701                         (format "~a.preview.eps" basename)
 702                         (cons "png" (ly:output-formats)))))
 703
 704 (if #f
 705     (define-public (output-preview-framework basename book scopes fields)
 706
 707       (let* ((paper (ly:paper-book-paper book))
 708              (systems (ly:paper-book-systems book))
 709              (scale (ly:output-def-lookup paper 'output-scale))
 710              (titles (take-while paper-system-title? systems))
 711              (non-title (find (lambda (x)
 712                                 (not (paper-system-title? x))) systems))
 713              (dump-me
 714               (stack-stencils Y DOWN 0.0
 715                               (map paper-system-stencil
 716                                    (append titles (list non-title))))))
 717         (output-scopes scopes fields basename)
 718         (dump-stencil-as-EPS paper dump-me
 719                              (format "~a.preview" basename)
 720                              #t)
 721
 722         (postprocess-output book framework-ps-module
 723                             (format "~a.preview.eps" basename)
 724                              (ly:output-formats)))))
 725
 726 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 727
 728 (define-public (convert-to-pdf book name)
 729   (let* ((defs (ly:paper-book-paper book))
 730          (landscape (ly:output-def-lookup defs 'landscape))
 731          (output-scale (ly:output-def-lookup defs 'output-scale))
 732          (convert (lambda (x) (* x output-scale (/ (ly:bp 1)))))
 733
 734          (paper-width (convert (ly:output-def-lookup defs 'paper-width)))
 735          (paper-height (convert (ly:output-def-lookup defs 'paper-height)))
 736
 737          (w (if landscape paper-height paper-width))
 738          (h (if landscape paper-width paper-height))
 739          )
 740
 741     (if (equal? (basename name ".ps") "-")
 742         (ly:warning (_ "cannot convert <stdout> to ~S" "PDF"))
 743         (postscript->pdf w h name))))
 744
 745 (define-public (convert-to-png book name)
 746   (let* ((defs (ly:paper-book-paper book))
 747          (defs-resolution (ly:output-def-lookup defs 'pngresolution))
 748          (resolution (if (number? defs-resolution)
 749                          defs-resolution
 750                          (ly:get-option 'resolution)))
 751          (paper-width (ly:output-def-lookup defs 'paper-width))
 752          (paper-height (ly:output-def-lookup defs 'paper-height))
 753          (output-scale (ly:output-def-lookup defs 'output-scale)))
 754
 755     (postscript->png resolution
 756                      (* paper-width output-scale (/ (ly:bp 1)))
 757                      (* paper-height output-scale (/ (ly:bp 1)))
 758                      name)))
 759
 760 (define-public (convert-to-dvi book name)
 761   (ly:warning (_ "cannot generate ~S using the postscript back-end") "DVI"))
 762
 763 (define-public (convert-to-tex book name)
 764   (ly:warning (_ "cannot generate ~S using the postscript back-end") "TeX"))
 765
 766 (define-public (convert-to-ps book name)
 767   #t)
 768
 769 (define-public (output-classic-framework basename book scopes fields)
 770
 771   (ly:error (_ "\nThe PostScript backend does not support the system-by-system
 772 output. For that, use the EPS backend instead,
 773
 774   lilypond -b eps <file>
 775
 776 If have cut & pasted a lilypond fragment from a webpage, be sure
 777 to only remove anything before
 778
 779   %% ****************************************************************
 780   %% Start cut-&-pastable-section
 781   %% ****************************************************************
 782
 783 ")))