scm/framework-eps.scm

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