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