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