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