scm/framework-eps.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2004--2015 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 (ly:output-formats)
  87                       basename
  88                       (format #f "~a.eps" basename)
  89                       #t)
  90
  91   ;; individual staves (*-1.eps etc.); only print if more than one stencil
  92   ;; Otherwise the .eps and the -1.eps file will be identical and waste space
  93   ;; Also always create if aux-files=##t
  94   (if (or create-aux-files (< 1 (length stencils)))
  95       (let* ((widened-stencils (widen-left-stencil-edges stencils))
  96              (counted-systems  (count-list widened-stencils))
  97              (eps-files (map dump-counted-stencil counted-systems)))
  98         (if do-pdf
  99             ;; par-for-each: a bit faster ...
 100             (for-each (lambda (y) (postscript->pdf 0 0
 101                                                    (dir-basename y ".eps")
 102                                                    y #t))
 103                       eps-files))))
 104
 105   ;; Now, write some aux files if requested: .texi, .tex and .count
 106   ;; for direct inclusion into latex and texinfo
 107   (if create-aux-files
 108       (let* ((write-file (lambda (str-port ext)
 109                            (if create-aux-files
 110                                (let* ((name (format #f "~a-systems.~a" basename ext))
 111                                       (port (open-output-file name)))
 112                                  (ly:message (_ "Writing ~a...") name)
 113                                  (display (get-output-string str-port) port)
 114                                  (close-output-port port)))))
 115              (tex-system-port (open-output-string))
 116              (texi-system-port (open-output-string))
 117              (count-system-port (open-output-string)))
 118         (for-each (lambda (c)
 119                     (if (< 0 c)
 120                         (format tex-system-port
 121                                 "\\ifx\\betweenLilyPondSystem \\undefined
 122   \\linebreak
 123 \\else
 124   \\expandafter\\betweenLilyPondSystem{~a}%
 125 \\fi
 126 " c))
 127                     (format tex-system-port "\\includegraphics{~a-~a}%\n"
 128                             basename (1+ c))
 129                     (format texi-system-port "@image{~a-~a}\n"
 130                             basename (1+ c)))
 131                   (iota (length stencils)))
 132         (display "@c eof\n" texi-system-port)
 133         (display "% eof\n" tex-system-port)
 134         (format count-system-port "~a" (length stencils))
 135         (write-file texi-system-port "texi")
 136         (write-file tex-system-port "tex")
 137         ;; do this as the last action so we know the rest is complete if
 138         ;; this file is present.
 139         (write-file count-system-port "count"))))
 140
 141 (define-public (output-classic-framework basename book scopes fields)
 142   (output-scopes scopes fields basename)
 143   (if (ly:get-option 'dump-signatures)
 144       (write-system-signatures basename (ly:paper-book-systems book) 1))
 145   (dump-stencils-as-EPSes (map paper-system-stencil
 146                                (ly:paper-book-systems book))
 147                           book
 148                           basename))
 149
 150 (define-public (output-framework basename book scopes fields)
 151   (output-scopes scopes fields basename)
 152   (if (ly:get-option 'clip-systems)
 153       (clip-system-EPSes basename book))
 154   (dump-stencils-as-EPSes (map page-stencil
 155                                (ly:paper-book-pages book))
 156                           book
 157                           basename))
 158
 159 ;; redefine to imports from framework-ps
 160 (define convert-to-pdf
 161   convert-to-pdf)
 162
 163 (define convert-to-ps
 164   convert-to-ps)
 165
 166 (define convert-to-png
 167   convert-to-png)