scm/framework-eps.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2004--2014 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 framework-eps))
  19
  20 ;;; this is still too big a mess.
  21
  22 (use-modules (ice-9 regex)
  23              (ice-9 string-fun)
  24              (guile)
  25              (scm framework-ps)
  26              (scm paper-system)
  27              (scm page)
  28              (scm output-ps)
  29              (srfi srfi-1)
  30              (srfi srfi-13)
  31              (lily))
  32
  33 (define format
  34   ergonomic-simple-format)
  35
  36 (define framework-eps-module
  37   (current-module))
  38
  39 (define (widen-left-stencil-edges stencils)
  40   "Change STENCILS to use the union for the left extents in every
  41 stencil so that LaTeX's \\includegraphics command doesn't modify the
  42 alignment."
  43   (define left
  44     (if (pair? stencils)
  45         (apply min
  46                (map (lambda (stc)
  47                       (interval-start (ly:stencil-extent stc X)))
  48                     stencils))
  49         0.0))
  50
  51   (map (lambda (stil)
  52          (ly:make-stencil
  53           (ly:stencil-expr stil)
  54           (cons left
  55                 (cdr (ly:stencil-extent stil X)))
  56           (ly:stencil-extent stil Y)))
  57        stencils))
  58
  59 (define (dump-stencils-as-EPSes stencils book basename)
  60   (define do-pdf
  61     (member  "pdf" (ly:output-formats)))
  62
  63   (define paper
  64     (ly:paper-book-paper book))
  65
  66   (define create-aux-files
  67     (ly:get-option 'aux-files))
  68
  69   (define (dump-infinite-stack-EPS stencils)
  70     (let* ((dump-me (stack-stencils Y DOWN 2.0 stencils)))
  71       (dump-stencil-as-EPS paper dump-me basename #t)))
  72
  73   (define (dump-counted-stencil stencil-count-pair)
  74     "Return EPS filename."
  75     (let* ((stencil (car stencil-count-pair))
  76            (number (cdr stencil-count-pair))
  77            (name (format #f "~a-~a" basename number)))
  78       (dump-stencil-as-EPS paper stencil name
  79                            (ly:get-option 'include-eps-fonts))
  80       (string-append name ".eps")))
  81
  82   ;; main body
  83   ;; First, create the output, then if necessary, individual staves and
  84   ;; finally write some auxiliary files if desired
  85   (dump-infinite-stack-EPS stencils)
  86   (postprocess-output book framework-eps-module
  87                       (format #f "~a.eps" basename) (ly:output-formats))
  88
  89   ;; individual staves (*-1.eps etc.); only print if more than one stencil
  90   ;; Otherwise the .eps and the -1.eps file will be identical and waste space
  91   ;; Also always create if aux-files=##t
  92   (if (or create-aux-files (< 1 (length stencils)))
  93       (let* ((widened-stencils (widen-left-stencil-edges stencils))
  94              (counted-systems  (count-list widened-stencils))
  95              (eps-files (map dump-counted-stencil counted-systems)))
  96         (if do-pdf
  97             ;; par-for-each: a bit faster ...
  98             (for-each (lambda (y) (postscript->pdf 0 0 y))
  99                       eps-files))))
 100
 101   ;; Now, write some aux files if requested: .texi, .tex and .count
 102   ;; for direct inclusion into latex and texinfo
 103   (if create-aux-files
 104       (let* ((write-file (lambda (str-port ext)
 105                            (if create-aux-files
 106                                (let* ((name (format #f "~a-systems.~a" basename ext))
 107                                       (port (open-output-file name)))
 108                                  (ly:message (_ "Writing ~a...") name)
 109                                  (display (get-output-string str-port) port)
 110                                  (close-output-port port)))))
 111              (tex-system-port (open-output-string))
 112              (texi-system-port (open-output-string))
 113              (count-system-port (open-output-string)))
 114         (for-each (lambda (c)
 115                     (if (< 0 c)
 116                         (format tex-system-port
 117                                 "\\ifx\\betweenLilyPondSystem \\undefined
 118   \\linebreak
 119 \\else
 120   \\expandafter\\betweenLilyPondSystem{~a}%
 121 \\fi
 122 " c))
 123                     (format tex-system-port "\\includegraphics{~a-~a}%\n"
 124                             basename (1+ c))
 125                     (format texi-system-port "@image{~a-~a}\n"
 126                             basename (1+ c)))
 127                   (iota (length stencils)))
 128         (display "@c eof\n" texi-system-port)
 129         (display "% eof\n" tex-system-port)
 130         (format count-system-port "~a" (length stencils))
 131         (write-file texi-system-port "texi")
 132         (write-file tex-system-port "tex")
 133         ;; do this as the last action so we know the rest is complete if
 134         ;; this file is present.
 135         (write-file count-system-port "count"))))
 136
 137 (define-public (output-classic-framework basename book scopes fields)
 138   (output-scopes scopes fields basename)
 139   (if (ly:get-option 'dump-signatures)
 140       (write-system-signatures basename (ly:paper-book-systems book) 1))
 141   (dump-stencils-as-EPSes (map paper-system-stencil
 142                                (ly:paper-book-systems book))
 143                           book
 144                           basename))
 145
 146 (define-public (output-framework basename book scopes fields)
 147   (output-scopes scopes fields basename)
 148   (if (ly:get-option 'clip-systems)
 149       (clip-system-EPSes basename book))
 150   (dump-stencils-as-EPSes (map page-stencil
 151                                (ly:paper-book-pages book))
 152                           book
 153                           basename))
 154
 155 ;; redefine to imports from framework-ps
 156 (define convert-to-pdf
 157   convert-to-pdf)
 158
 159 (define convert-to-ps
 160   convert-to-ps)
 161
 162 (define convert-to-png
 163   convert-to-png)