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