scm/framework-tex.scm

   1 ;;;; framework-tex.scm -- structure for TeX output
   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-tex)
   8   #:export (output-framework-tex
   9             output-classic-framework-tex))
  10
  11 (use-modules (ice-9 regex)
  12              (ice-9 string-fun)
  13              (ice-9 format)
  14              (scm page)
  15              (scm paper-system)
  16              (guile)
  17              (srfi srfi-1)
  18              (srfi srfi-13)
  19              (srfi srfi-14)
  20              (scm kpathsea)
  21              (lily))
  22
  23 (define (output-formats)
  24   (define formats (ly:output-formats))
  25   (set! formats (completize-formats formats))
  26   (if (member "ps" formats)
  27       (set! formats (cons "dvi" formats)))
  28   (if (member "dvi" formats)
  29       (set! formats (cons "tex" formats)))
  30
  31   (uniq-list formats))
  32
  33 (define framework-tex-module (current-module))
  34 (define-public (sanitize-tex-string s)
  35   (if (ly:get-option 'safe)
  36       (regexp-substitute/global
  37        #f "\\\\"
  38        (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post)
  39        'pre "$\\backslash$" 'post)
  40       s))
  41
  42 (define (symbol->tex-key sym)
  43   (regexp-substitute/global
  44    #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
  45
  46 (define (tex-number-def prefix key number)
  47   (string-append
  48    "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
  49
  50 (define-public (digits->letters str)
  51   (regexp-substitute/global
  52    #f "[-\\._]"
  53    (regexp-substitute/global
  54     #f "([0-9])" str
  55     'pre
  56     (lambda (match)
  57       (make-string
  58        1
  59        (integer->char
  60         (+ (char->integer #\A)
  61            (- (char->integer #\0))
  62            (char->integer (string-ref (match:substring match 1) 0)))
  63         )))
  64     'post)
  65    'pre ""
  66    'post))
  67
  68 (define-public (tex-font-command-raw name magnification)
  69   (string-append
  70    "magfont"
  71    (digits->letters (format "~a" name))
  72    "m"
  73    (string-encode-integer
  74     (inexact->exact (round (* 1000 magnification))))))
  75
  76 (define-public (tex-font-command font)
  77   (tex-font-command-raw
  78    (ly:font-file-name font) (ly:font-magnification font)))
  79
  80 (define (otf-font-load-command paper font)
  81   (let* ((sub-fonts (ly:font-sub-fonts font)))
  82     (string-append
  83      (apply string-append
  84             (map
  85              (lambda (sub-name)
  86                (format #f "\\font\\~a=~a scaled ~a%\n"
  87                        (tex-font-command-raw
  88                         sub-name (ly:font-magnification font))
  89                        sub-name
  90                        (ly:number->string
  91                         (inexact->exact
  92                          (round (* 1000
  93                                    (ly:font-magnification font)
  94                                    (ly:paper-outputscale paper)))))))
  95              sub-fonts)))))
  96
  97 (define (simple-font-load-command paper font)
  98    (format
  99     "\\font\\~a=~a scaled ~a%\n"
 100     (tex-font-command font)
 101     (ly:font-file-name font)
 102     (inexact->exact
 103      (round (* 1000
 104                (ly:font-magnification font)
 105                (ly:paper-outputscale paper))))))
 106
 107 (define (font-load-command paper font)
 108   (if (pair? (ly:font-sub-fonts font))
 109       (otf-font-load-command paper font)
 110       (simple-font-load-command paper font)))
 111
 112 (define (define-fonts paper)
 113   (string-append
 114    ;; UGH. FIXME.
 115    "\\def\\lilypondpaperunit{mm}%\n"
 116    (tex-number-def "lilypondpaper" 'outputscale
 117                    (number->string (exact->inexact
 118                                     (ly:paper-outputscale paper))))
 119    (tex-string-def "lilypondpaper" 'papersize
 120                    (eval 'papersizename (ly:output-def-scope paper)))
 121    ;; paper/layout?
 122    (tex-string-def "lilypondpaper" 'inputencoding
 123                    (eval 'inputencoding (ly:output-def-scope paper)))
 124
 125    (apply string-append
 126           (map (lambda (x) (font-load-command paper x))
 127                (ly:paper-fonts paper)))))
 128
 129 (define (tex-string-def prefix key str)
 130   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
 131       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
 132       (string-append "\\def\\" prefix (symbol->tex-key key)
 133                      "{" (sanitize-tex-string str) "}%\n")))
 134
 135 (define (header paper page-count classic?)
 136   (let ((scale (ly:output-def-lookup paper 'outputscale))
 137         (texpaper (string-append
 138                    (ly:output-def-lookup paper 'papersizename)
 139                    "paper"))
 140         (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
 141     (string-append
 142      "% Generated by LilyPond "
 143      (lilypond-version) "\n"
 144      "% at " "time-stamp,FIXME" "\n"
 145      (if classic?
 146          (tex-string-def "lilypond" 'classic "1")
 147          "")
 148
 149      (if (ly:get-option 'safe)
 150          "\\nofiles\n"
 151          "")
 152
 153      (tex-string-def
 154       "lilypondpaper" 'linewidth
 155       (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
 156      "\\def\\lilyponddocumentclassoptions{"
 157      (sanitize-tex-string texpaper)
 158      (if landscape? ",landscape" "")
 159      "}%\n"
 160      )))
 161
 162 (define (header-end)
 163   (string-append
 164    "\\def\\scaletounit{ "
 165    (number->string lily-unit->bigpoint-factor)
 166    " mul }%\n"
 167    "\\ifx\\lilypondstart\\undefined\n"
 168    "  \\input lilyponddefs\n"
 169    "\\fi\n"
 170    "\\lilypondstart\n"
 171    "\\lilypondspecial\n"
 172    "\\lilypondpostscript\n"))
 173
 174 (define (dump-page putter page last? with-extents?)
 175   (ly:outputter-dump-string
 176    putter
 177    (format "\\lybox{~a}{~a}{%\n"
 178            (if with-extents?
 179                (interval-start (ly:stencil-extent page X))
 180                0.0)
 181            (if with-extents?
 182                (- (interval-start (ly:stencil-extent page Y)))
 183                0.0)))
 184   (ly:outputter-dump-stencil putter page)
 185   (ly:outputter-dump-string
 186    putter
 187    (if last?
 188        "}%\n\\vfill\n"
 189        "}%\n\\vfill\n\\lilypondpagebreak\n")))
 190
 191 (define-public (output-framework basename book scopes fields)
 192   (let* ((filename (format "~a.tex" basename))
 193          (outputter  (ly:make-paper-outputter (open-file filename "wb") "tex"))
 194          (paper (ly:paper-book-paper book))
 195          (page-stencils (map page-stencil (ly:paper-book-pages book)))
 196          (last-page (car (last-pair pages)))
 197          (with-extents
 198           (eq? #t (ly:output-def-lookup paper 'dump-extents))))
 199     (for-each
 200      (lambda (x)
 201        (ly:outputter-dump-string outputter x))
 202      (list
 203       (header paper (length page-stencils) #f)
 204       (define-fonts paper)
 205       (header-end)))
 206     (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
 207     (for-each
 208      (lambda (page)
 209        (dump-page outputter page (eq? last-page page) with-extents))
 210      page-stencils)
 211     (ly:outputter-dump-string outputter "\\lilypondend\n")
 212     (ly:outputter-close outputter)
 213     (postprocess-output book framework-tex-module filename
 214                         (output-formats))))
 215
 216 (define (dump-line putter line last?)
 217   (ly:outputter-dump-string
 218    putter
 219    (format "\\lybox{~a}{~a}{%\n"
 220            (ly:number->string
 221             (max 0 (interval-end (paper-system-extent line X))))
 222            (ly:number->string
 223             (interval-length (paper-system-extent line Y)))))
 224
 225   (ly:outputter-dump-stencil putter (paper-system-stencil line))
 226   (ly:outputter-dump-string
 227    putter
 228    (if last?
 229        "}%\n"
 230        "}\\interscoreline\n")))
 231
 232 (define-public (output-classic-framework
 233                 basename book scopes fields)
 234   (let* ((filename (format "~a.tex" basename))
 235          (outputter  (ly:make-paper-outputter
 236                       (open-file filename "w") "tex"))
 237          (paper (ly:paper-book-paper book))
 238          (lines (ly:paper-book-systems book))
 239          (last-line (car (last-pair lines))))
 240     (for-each
 241      (lambda (x)
 242        (ly:outputter-dump-string outputter x))
 243      (list
 244       ;;FIXME
 245       (header paper (length lines) #f)
 246       "\\def\\lilypondclassic{1}%\n"
 247       (output-scopes scopes fields basename)
 248       (define-fonts paper)
 249       (header-end)))
 250
 251     (for-each
 252      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
 253     (ly:outputter-dump-string outputter "\\lilypondend\n")
 254     (ly:outputter-close outputter)
 255     (postprocess-output book framework-tex-module filename
 256                         (output-formats))
 257     ))
 258
 259 (define-public (output-preview-framework
 260                 basename book scopes fields)
 261   (let* ((filename (format "~a.tex" basename))
 262          (outputter  (ly:make-paper-outputter (open-file filename "wb")
 263                                               "tex"))
 264          (paper (ly:paper-book-paper book))
 265          (lines (ly:paper-book-systems book))
 266          (first-notes-index (list-index
 267                              (lambda (s) (not (ly:paper-system-title? s)))
 268                              lines)))
 269
 270     (for-each
 271      (lambda (x)
 272        (ly:outputter-dump-string outputter x))
 273      (list
 274
 275       ;;FIXME
 276       (header paper (length lines) #f)
 277       "\\def\\lilypondclassic{1}%\n"
 278       (output-scopes scopes fields basename)
 279       (define-fonts paper)
 280       (header-end)))
 281
 282     (for-each
 283      (lambda (lst)
 284        (dump-line outputter lst (not (ly:paper-system-title? lst))))
 285      (take lines (1+ first-notes-index)))
 286     (ly:outputter-dump-string outputter "\\lilypondend\n")
 287     (ly:outputter-close outputter)
 288     (postprocess-output book framework-tex-module filename
 289                         (output-formats))))
 290
 291 (define-public (convert-to-pdf book name)
 292   (let* ((defs (ly:paper-book-paper book))
 293          (papersizename (ly:output-def-lookup defs 'papersizename)))
 294     (postscript->pdf (if (string? papersizename) papersizename "a4")
 295                      (string-append (basename name ".tex") ".ps"))))
 296
 297 (define-public (convert-to-png book name)
 298   (let* ((defs (ly:paper-book-paper book))
 299          (resolution (ly:output-def-lookup defs 'pngresolution))
 300          (papersizename (ly:output-def-lookup defs 'papersizename)))
 301     (postscript->png
 302      (if (number? resolution)
 303          resolution
 304          (ly:get-option 'resolution))
 305
 306      (if (string? papersizename)
 307          papersizename
 308          "a4")
 309
 310      (string-append (basename name ".tex") ".ps"))))
 311
 312 (define-public (convert-to-ps book name)
 313   (let* ((paper (ly:paper-book-paper book))
 314          (preview? (string-contains name ".preview"))
 315          (papersizename (ly:output-def-lookup paper 'papersizename))
 316          (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
 317          (base (basename name ".tex"))
 318          (ps-name (format "~a.ps"  base ".ps"))
 319          (cmd (string-append "dvips"
 320                              (if preview?
 321                                  " -E"
 322                                  (string-append
 323                                   " -t"
 324                                   ;; careful: papersizename is user-set.
 325                                   (sanitize-command-option papersizename)
 326                                   ""))
 327                              (if landscape? " -tlandscape" "")
 328                              (if (ly:kpathsea-find-file "lm.map")
 329                                  " -u+lm.map" "")
 330                              (if (ly:kpathsea-find-file "ecrm10.pfa")
 331                                  " -u+ec-mftrace.map" "")
 332                              " -u+lilypond.map -Ppdf" ""
 333                              " -o" ps-name
 334                              " " base)))
 335     (if (access? ps-name W_OK)
 336         (delete-file ps-name))
 337     (if (not (ly:get-option 'verbose))
 338         (begin
 339           (ly:message (_ "Converting to `~a'...") (string-append base ".ps"))
 340           (ly:progress "\n")))
 341     (ly:system cmd)))
 342
 343 (define-public (convert-to-dvi book name)
 344   (let* ((curr-extra-mem
 345           (string->number
 346            (regexp-substitute/global
 347             #f " *%.*\n?"
 348             (ly:kpathsea-expand-variable "extra_mem_top")
 349             'pre "" 'post)))
 350          (base (basename name ".tex"))
 351          (cmd (format
 352                #f "latex \\\\nonstopmode \\\\input '~a'" name)))
 353
 354     ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not?
 355     (if (string-index name (char-set #\space #\ht #\newline #\cr))
 356         (ly:error (_"TeX file name must not contain whitespace: `~a'") name))
 357
 358     (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
 359     (let ((dvi-name (string-append base ".dvi")))
 360       (if (access? dvi-name W_OK)
 361           (delete-file dvi-name)))
 362     (if (not (ly:get-option 'verbose))
 363         (begin
 364           (ly:message (_ "Converting to `~a'...") (string-append base ".dvi"))
 365           (ly:progress "\n")))
 366
 367     ;; FIXME: set in environment?
 368     (if (ly:get-option 'safe)
 369         (set! cmd (string-append "openout_any=p " cmd)))
 370
 371     (ly:system cmd)))
 372
 373 (define-public (convert-to-tex book name)
 374   #t)
 375