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@cs.uu.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 paper (ly:paper-book-paper book))
  49   (define (dump-infinite-stack-EPS stencils)
  50     (let* ((dump-me (stack-stencils Y DOWN 2.0 stencils)))
  51       (dump-stencil-as-EPS paper dump-me basename #t)))
  52
  53   (define (dump-stencils-as-separate-EPS stencils count)
  54     (if (pair? stencils)
  55         (let* ((line (car stencils))
  56                (rest (cdr stencils)))
  57
  58           (dump-stencil-as-EPS
  59            paper line (format "~a-~a" basename count)
  60            (ly:get-option 'eps-font-include))
  61
  62           (dump-stencils-as-separate-EPS rest (1+ count)))))
  63
  64
  65   ;; main body
  66   (let* ((tex-system-name (format "~a-systems.tex" basename))
  67          (texi-system-name (format "~a-systems.texi" basename))
  68          (tex-system-port (open-output-file tex-system-name))
  69          (texi-system-port (open-output-file texi-system-name)))
  70
  71     (ly:message (_ "Writing ~a...") tex-system-name)
  72     (ly:message (_ "Writing ~a...") texi-system-name)
  73
  74     (set! stencils (widen-left-stencil-edges stencils))
  75
  76     (dump-stencils-as-separate-EPS stencils 1)
  77     (for-each (lambda (c)
  78                 (if (< 0 c)
  79                     (display (format "\\ifx\\betweenLilyPondSystem \\undefined
  80   \\linebreak
  81 \\else
  82   \\betweenLilyPondSystem{~a}
  83 \\fi
  84 " c) tex-system-port))
  85                 (display (format "\\includegraphics{~a-~a.eps}\n"
  86                                  basename (1+ c)) tex-system-port)
  87                 (display (format "@image{~a-~a}\n"
  88                                  basename (1+ c)) texi-system-port))
  89               (iota (length stencils)))
  90
  91     (display "@c eof - 'eof' is a Makefile marker; do not remove. " texi-system-port)
  92     (display "% eof - 'eof' is Makefile marker; do not remove. " tex-system-port)
  93
  94     (dump-infinite-stack-EPS stencils))
  95     (postprocess-output book framework-eps-module
  96                         (format "~a.eps" basename) (ly:output-formats)))
  97
  98
  99 (define (write-system-signatures basename paper-systems count)
 100   (if (pair? paper-systems)
 101       (begin
 102         (let*
 103             ((outname (format "~a-~a.signature" basename count)) )
 104
 105           (ly:message "writing ~a" outname)
 106           (write-system-signature outname (car paper-systems))
 107           (write-system-signatures basename (cdr paper-systems) (1+ count))))))
 108
 109
 110 (define-public (output-classic-framework basename book scopes fields)
 111   (output-scopes scopes fields basename)
 112
 113   (if (ly:get-option 'dump-signatures)
 114       (write-system-signatures basename (ly:paper-book-systems book) 0))
 115
 116   (dump-stencils-as-EPSes
 117    (map paper-system-stencil (ly:paper-book-systems book))
 118    book
 119    basename))
 120
 121 (define-public (output-framework basename book scopes fields)
 122   (output-scopes scopes fields basename)
 123   (dump-stencils-as-EPSes
 124    (map page-stencil (ly:paper-book-pages book)) book basename))
 125
 126
 127 ; redefine to imports from framework-ps
 128 (define convert-to-pdf convert-to-pdf)
 129 (define convert-to-ps convert-to-ps)
 130 (define convert-to-png convert-to-png)
 131 (define convert-to-tex convert-to-tex)
 132 (define convert-to-dvi convert-to-dvi)
 133