scm/framework-eps.scm

   1 ;;;; framework-ps.scm --
   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-eps))
   8
   9 ;;; this is still too big a mess.
  10
  11 (use-modules (ice-9 regex)
  12              (ice-9 string-fun)
  13              (guile)
  14              (scm framework-ps)
  15              (scm paper-system)
  16              (scm page)
  17              (scm output-ps)
  18              (srfi srfi-1)
  19              (srfi srfi-13)
  20              (lily))
  21
  22 (define framework-eps-module (current-module))
  23
  24
  25 (define (widen-left-stencil-edges stencils)
  26   "Change STENCILS to use the union for the left extents in every
  27 stencil, so LaTeX includegraphics doesn't fuck up the alignment."
  28
  29   (define left
  30     (if (pair? stencils)
  31
  32         (apply min
  33                (map (lambda (stc)
  34                       (interval-start (ly:stencil-extent stc X)))
  35                     stencils))
  36         0.0))
  37
  38   (map (lambda (stil)
  39
  40          (ly:make-stencil
  41           (ly:stencil-expr stil)
  42           (cons
  43            left
  44            (cdr (ly:stencil-extent stil X)))
  45           (ly:stencil-extent stil Y)
  46           ))
  47        stencils))
  48
  49 (define (dump-stencils-as-EPSes stencils book basename)
  50   (define do-pdf (member  "pdf" (ly:output-formats)))
  51   (define paper (ly:paper-book-paper book))
  52   (define (dump-infinite-stack-EPS stencils)
  53     (let* ((dump-me (stack-stencils Y DOWN 2.0 stencils)))
  54       (dump-stencil-as-EPS paper dump-me basename #t)))
  55
  56   (define (dump-counted-stencil stencil-count-pair)
  57     "Return EPS filename"
  58     (let*
  59         ((stencil (car stencil-count-pair))
  60          (number (cdr stencil-count-pair))
  61          (name (format "~a-~a" basename number)))
  62
  63       (dump-stencil-as-EPS
  64        paper stencil name
  65        (ly:get-option 'include-eps-fonts))
  66
  67       (string-append name ".eps")))
  68
  69   (define (dump-stencils-as-separate-EPS stencils count)
  70     (if (pair? stencils)
  71         (let* ((line (car stencils))
  72                (rest (cdr stencils))
  73                (system-base-name (format "~a-~a" basename count))
  74                )
  75
  76           (dump-stencil-as-EPS
  77            paper line system-base-name)
  78
  79           (if do-pdf
  80               (postscript->pdf  0 0  (string-append system-base-name ".eps")))
  81           (dump-stencils-as-separate-EPS rest (1+ count)))))
  82
  83   ;; main body
  84   (let* ((write-file (lambda (str-port ext)
  85                        (let*
  86                            ((name (format "~a-systems.~a" basename ext))
  87                             (port (open-output-file name)))
  88                          (ly:message (_ "Writing ~a...") name)
  89                          (display (get-output-string str-port) port)
  90                          (close-output-port port)
  91                          )))
  92
  93          (tex-system-port (open-output-string))
  94          (texi-system-port (open-output-string))
  95          (widened-stencils (widen-left-stencil-edges stencils))
  96          (counted-systems  (count-list widened-stencils))
  97          (eps-files (map dump-counted-stencil  counted-systems))
  98          )
  99
 100     (if do-pdf
 101
 102         ;; par-for-each: a bit faster ...
 103         (for-each
 104          (lambda (y)
 105            (postscript->pdf 0 0 y))
 106          eps-files))
 107
 108     (for-each (lambda (c)
 109                 (if (< 0 c)
 110                     (display (format "\\ifx\\betweenLilyPondSystem \\undefined
 111   \\linebreak
 112 \\else
 113   \\betweenLilyPondSystem{~a}
 114 \\fi
 115 " c) tex-system-port))
 116                 (display (format "\\includegraphics{~a-~a}\n"
 117                                  basename (1+ c)) tex-system-port)
 118                 (display (format "@image{~a-~a}\n"
 119                                  basename (1+ c)) texi-system-port))
 120               (iota (length stencils)))
 121
 122     (display "@c eof." texi-system-port)
 123     (display "% eof. " tex-system-port)
 124
 125     (dump-infinite-stack-EPS stencils)
 126     (postprocess-output book framework-eps-module
 127                         (format "~a.eps" basename) (ly:output-formats))
 128
 129     (write-file texi-system-port "texi")
 130     (write-file tex-system-port "tex")
 131     ))
 132
 133
 134
 135 (define-public (output-classic-framework basename book scopes fields)
 136   (output-scopes scopes fields basename)
 137
 138   (if (ly:get-option 'dump-signatures)
 139       (write-system-signatures basename (ly:paper-book-systems book) 1))
 140
 141   (dump-stencils-as-EPSes
 142    (map paper-system-stencil (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
 151   (dump-stencils-as-EPSes
 152    (map page-stencil (ly:paper-book-pages book)) book basename))
 153
 154
 155 ; redefine to imports from framework-ps
 156 (define convert-to-pdf convert-to-pdf)
 157 (define convert-to-ps convert-to-ps)
 158 (define convert-to-png convert-to-png)
 159 (define convert-to-tex convert-to-tex)
 160 (define convert-to-dvi convert-to-dvi)
 161
 162