scm/framework-tex.scm

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