]> git.donarmstrong.com Git - lilypond.git/blob - scm/framework-eps.scm
MIDI: midiChannelMapping = #'staff mode creates only one Track per staff.
[lilypond.git] / scm / framework-eps.scm
1 ;;;; This file is part of LilyPond, the GNU music typesetter.
2 ;;;;
3 ;;;; Copyright (C) 2004--2011 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 "~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 "~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 "~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                       (display (format
117                                 "\\ifx\\betweenLilyPondSystem \\undefined
118   \\linebreak
119 \\else
120   \\expandafter\\betweenLilyPondSystem{~a}%
121 \\fi
122 " c)
123                                tex-system-port))
124                   (display (format "\\includegraphics{~a-~a}%\n"
125                                    basename (1+ c)) tex-system-port)
126                   (display (format "@image{~a-~a}\n"
127                                    basename (1+ c)) texi-system-port))
128                 (iota (length stencils)))
129       (display "@c eof\n" texi-system-port)
130       (display "% eof\n" tex-system-port)
131       (display (format "~a" (length stencils)) count-system-port)
132       (write-file texi-system-port "texi")
133       (write-file tex-system-port "tex")
134       ;; do this as the last action so we know the rest is complete if
135       ;; this file is present.
136       (write-file count-system-port "count"))))
137
138 (define-public (output-classic-framework basename book scopes fields)
139   (output-scopes scopes fields basename)
140   (if (ly:get-option 'dump-signatures)
141       (write-system-signatures basename (ly:paper-book-systems book) 1))
142   (dump-stencils-as-EPSes (map paper-system-stencil
143                                (ly:paper-book-systems book))
144                           book
145                           basename))
146
147 (define-public (output-framework basename book scopes fields)
148   (output-scopes scopes fields basename)
149   (if (ly:get-option 'clip-systems)
150       (clip-system-EPSes basename book))
151   (dump-stencils-as-EPSes (map page-stencil
152                                (ly:paper-book-pages book))
153                           book
154                           basename))
155
156 ; redefine to imports from framework-ps
157 (define convert-to-pdf
158   convert-to-pdf)
159
160 (define convert-to-ps
161   convert-to-ps)
162
163 (define convert-to-png
164   convert-to-png)