X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-tex.scm;h=5a602e4e489ec4f2d914b5ba5282f4f01d1e7f90;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=b7ec9a9093b11972fea32a2062946c01655c66eb;hpb=5dfec3f8bf3a865ac9f9feaf3abbce6235349804;p=lilypond.git

diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm
index b7ec9a9093..5a602e4e48 100644
--- a/scm/framework-tex.scm
+++ b/scm/framework-tex.scm
@@ -1,120 +1,131 @@
-;;;; framework-tex.scm --
+;;;; framework-tex.scm -- structure for TeX output
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
+;;;; source file of the GNU LilyPond music typesetter
 ;;;;
-;;;; (c)  2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2004--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 (define-module (scm framework-tex)
-  #:export (output-framework-tex	    
-	    output-classic-framework-tex
-))
+  #:export (output-framework-tex	
+	    output-classic-framework-tex))
 
 (use-modules (ice-9 regex)
 	     (ice-9 string-fun)
-	     (ice-9 format)
+	     (scm page)
+	     (scm paper-system)
 	     (guile)
+	     (srfi srfi-1)
 	     (srfi srfi-13)
+	     (srfi srfi-14)
+	     (scm kpathsea)
 	     (lily))
 
-;; FIXME: rename
-;; what is bla supposed to do?  It breaks the default output terribly:
+(define format ergonomic-simple-format)
 
-;; \def\lilypondpaperbla$\backslash${$\backslash$}{bla$\backslash${$\backslash$}}%
-;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
-;; --jcn
+(define (output-formats)
+  (define formats (ly:output-formats))
+  (set! formats (completize-formats formats))
+  (if (member "ps" formats)
+      (set! formats (cons "dvi" formats)))
+  (if (member "dvi" formats)
+      (set! formats (cons "tex" formats)))
+
+  (uniq-list formats))
+
+(define framework-tex-module (current-module))
 (define-public (sanitize-tex-string s)
-   (if (ly:get-option 'safe)
-      (regexp-substitute/global #f "\\\\"
-				(regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
-				'pre "$\\backslash$" 'post)
-      
+  (if (ly:get-option 'safe)
+      (regexp-substitute/global
+       #f "\\\\"
+       (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post)
+       'pre "$\\backslash$" 'post)
       s))
 
 (define (symbol->tex-key sym)
   (regexp-substitute/global
-   #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
+   #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
 
 (define (tex-number-def prefix key number)
   (string-append
    "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
 
-(define-public (tex-font-command font)
+(define-public (digits->letters str)
+  (regexp-substitute/global
+   #f "[-\\._]"
+   (regexp-substitute/global
+    #f "([0-9])" str
+    'pre
+    (lambda (match)
+      (make-string
+       1
+       (integer->char
+	(+ (char->integer #\A)
+	   (- (char->integer #\0))
+	   (char->integer (string-ref (match:substring match 1) 0)))
+	)))
+    'post)
+   'pre ""
+   'post))
+
+(define-public (tex-font-command-raw name magnification)
   (string-append
    "magfont"
-   (string-encode-integer
-    (hashq (ly:font-filename font) 1000000))
+   (digits->letters (format "~a" name))
    "m"
    (string-encode-integer
-    (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
+    (inexact->exact (round (* 1000 magnification))))))
+
+(define-public (tex-font-command font)
+  (tex-font-command-raw
+   (ly:font-file-name font) (ly:font-magnification font)))
 
-(define (font-load-command bookpaper font)
-  (let* ((coding-alist (ly:font-encoding-alist font))
-	 (font-encoding (assoc-get 'output-name coding-alist))
-	 )
+(define (otf-font-load-command paper font)
+  (let* ((sub-fonts (ly:font-sub-fonts font)))
     (string-append
-     "\\font\\lilypond" (tex-font-command font) "="
-     (ly:font-filename font)
-     " scaled "
-     (ly:number->string (inexact->exact
+     (apply string-append
+	    (map
+	     (lambda (sub-name)
+	       (format "\\font\\~a=~a scaled ~a%\n"
+		       (tex-font-command-raw
+			sub-name (ly:font-magnification font))
+		       sub-name
+		       (ly:number->string
+			(inexact->exact
 			 (round (* 1000
 				   (ly:font-magnification font)
-				   (ly:bookpaper-outputscale bookpaper)))))
-     "\n"
-     "\\def\\" (tex-font-command font) "{%\n"
-     ;; UGH.  Should be handled via alist.
-     (if (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
-	 "  \\lilypondfontencoding{T1}"
-	 "  ")
-     "\\lilypond" (tex-font-command font)
-     "}\n"
-     )))
-
-
-(define (define-fonts bookpaper)
+				   (ly:paper-output-scale paper)))))))
+	     sub-fonts)))))
+
+(define (simple-font-load-command paper font)
+   (format
+    "\\font\\~a=~a scaled ~a%\n"
+    (tex-font-command font)
+    (ly:font-file-name font)
+    (inexact->exact
+     (round (* 1000
+	       (ly:font-magnification font)
+	       (ly:paper-output-scale paper))))))
+
+(define (font-load-command paper font)
+  (if (pair? (ly:font-sub-fonts font))
+      (otf-font-load-command paper font)
+      (simple-font-load-command paper font)))
+
+(define (define-fonts paper)
   (string-append
-   ;; UGH. FIXME.   
-   "\\def\\lilypondpaperunit{mm}\n"
-   (tex-number-def "lilypondpaper" 'outputscale
+   ;; UGH. FIXME.
+   "\\def\\lilypondpaperunit{mm}%\n"
+   (tex-number-def "lilypondpaper" 'output-scale
 		   (number->string (exact->inexact
-				    (ly:bookpaper-outputscale bookpaper))))
+				    (ly:paper-output-scale paper))))
    (tex-string-def "lilypondpaper" 'papersize
-		   (eval 'papersize (ly:output-def-scope bookpaper)))
-   (tex-string-def "lilypondpaper" 'inputencoding
-		   (eval 'inputencoding (ly:output-def-scope bookpaper)))
+		   (eval 'papersizename (ly:output-def-scope paper)))
+   ;; paper/layout?
+   (tex-string-def "lilypondpaper" 'input-encoding
+		   (eval 'input-encoding (ly:output-def-scope paper)))
 
    (apply string-append
-	  (map (lambda (x) (font-load-command bookpaper x))
-	       (ly:bookpaper-fonts bookpaper)))))
-
-(define (header-to-file fn key val)
-  (set! key (symbol->string key))
-  (if (not (equal? "-" fn))
-      (set! fn (string-append fn "." key)))
-  (display
-   (format (_ "Writing header field `~a' to `~a'...")
-	   key
-	   (if (equal? "-" fn) "<stdout>" fn))
-   (current-error-port))
-  (if (equal? fn "-")
-      (display val)
-      (display val (open-file fn "w")))
-  (newline (current-error-port))
-  "")
-
-(define (output-scopes  scopes fields basename)
-  (define (output-scope scope)
-    (apply
-     string-append
-     (module-map
-      (lambda (sym var)
-	(let ((val (if (variable-bound? var) (variable-ref var) ""))
-	      )
-	  
-	  (if (and (memq sym fields) (string? val))
-	      (header-to-file basename sym val))
-	  ""))
-      scope)))
-  (apply string-append (map output-scope scopes)))
+	  (map (lambda (x) (font-load-command paper x))
+	       (ly:paper-fonts paper)))))
 
 (define (tex-string-def prefix key str)
   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
@@ -122,9 +133,12 @@
       (string-append "\\def\\" prefix (symbol->tex-key key)
 		     "{" (sanitize-tex-string str) "}%\n")))
 
-(define (header bookpaper page-count classic?)
-  (let ((scale (ly:output-def-lookup bookpaper 'outputscale)))
-
+(define (header paper page-count classic?)
+  (let ((scale (ly:output-def-lookup paper 'output-scale))
+	(texpaper (string-append
+		   (ly:output-def-lookup paper 'papersizename)
+		   "paper"))
+	(landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
     (string-append
      "% Generated by LilyPond "
      (lilypond-version) "\n"
@@ -138,26 +152,22 @@
 	 "")
 
      (tex-string-def
-      "lilypondpaper" 'linewidth
-      (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth))))
-
-     (tex-string-def
-      "lilypondpaper" 'interscoreline
-      (ly:number->string
-       (* scale (ly:output-def-lookup bookpaper 'interscoreline)))))))
+      "lilypondpaper" 'line-width
+      (ly:number->string (* scale (ly:output-def-lookup paper 'line-width))))
+     "\\def\\lilyponddocumentclassoptions{"
+     (sanitize-tex-string texpaper)
+     (if landscape? ",landscape" "")
+     "}%\n"
+     )))
 
 (define (header-end)
   (string-append
    "\\def\\scaletounit{ "
-   (number->string (cond
-		    ((equal? (ly:unit) "mm") (/ 72.0 25.4))
-		    ((equal? (ly:unit) "pt") (/ 72.0 72.27))
-		    (else (error "unknown unit" (ly:unit)))))
+   (number->string lily-unit->bigpoint-factor)
    " mul }%\n"
    "\\ifx\\lilypondstart\\undefined\n"
    "  \\input lilyponddefs\n"
    "\\fi\n"
-   "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
    "\\lilypondstart\n"
    "\\lilypondspecial\n"
    "\\lilypondpostscript\n"))
@@ -165,46 +175,55 @@
 (define (dump-page putter page last? with-extents?)
   (ly:outputter-dump-string
    putter
-   (format "\\vbox to ~a\\outputscale{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n"
+   (format "\\lybox{~a}{~a}{%\n"
+	   (if with-extents?
+	       (interval-start (ly:stencil-extent page X))
+	       0.0)
 	   (if with-extents?
 	       (- (interval-start (ly:stencil-extent page Y)))
-	       	       0.0
-	       )))
+	       0.0)))
   (ly:outputter-dump-stencil putter page)
   (ly:outputter-dump-string
    putter
    (if last?
-       "}\\vss\n}\n\\vfill\n"
-       "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
-
-(define-public (output-framework outputter book scopes fields basename )
-  (let* ((bookpaper (ly:paper-book-book-paper book))
-	 (pages (ly:paper-book-pages book))
+       "}%\n\\vfill\n"
+       "}%\n\\vfill\n\\lilypondpagebreak\n")))
+
+(define-public (output-framework basename book scopes fields)
+  (let* ((filename (format "~a.tex" basename))
+	 (outputter  (ly:make-paper-outputter (open-file filename "wb") 'tex))
+	 (paper (ly:paper-book-paper book))
+	 (page-stencils (map page-stencil (ly:paper-book-pages book)))
 	 (last-page (car (last-pair pages)))
 	 (with-extents
-	  (eq? #t (ly:output-def-lookup bookpaper 'dump-extents)))
-	 )
+	  (eq? #t (ly:output-def-lookup paper 'dump-extents))))
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
-      (header bookpaper (length pages) #f)
-      (define-fonts bookpaper)
+      (header paper (length page-stencils) #f)
+      (define-fonts paper)
       (header-end)))
-    (ly:outputter-dump-string outputter "\\lilypondnopagebreak")
+    (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
     (for-each
-     (lambda (page) (dump-page outputter page (eq? last-page page) with-extents))
-     pages)
-    (ly:outputter-dump-string outputter "\\lilypondend\n")))
+     (lambda (page)
+       (dump-page outputter page (eq? last-page page) with-extents))
+     page-stencils)
+    (ly:outputter-dump-string outputter "\\lilypondend\n")
+    (ly:outputter-close outputter)
+    (postprocess-output book framework-tex-module filename
+			(output-formats))))
 
 (define (dump-line putter line last?)
   (ly:outputter-dump-string
    putter
-   (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
-		  (ly:number->string (interval-length (ly:paper-system-extent line Y)))
-		  "}{"))
+   (format "\\lybox{~a}{~a}{%\n"
+	   (ly:number->string
+	    (max 0 (interval-end (paper-system-extent line X))))
+	   (ly:number->string
+	    (interval-length (paper-system-extent line Y)))))
 
-  (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
+  (ly:outputter-dump-stencil putter (paper-system-stencil line))
   (ly:outputter-dump-string
    putter
    (if last?
@@ -212,8 +231,11 @@
        "}\\interscoreline\n")))
 
 (define-public (output-classic-framework
-		outputter book scopes fields basename)
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+		basename book scopes fields)
+  (let* ((filename (format "~a.tex" basename))
+	 (outputter  (ly:make-paper-outputter
+		      (open-file filename "w") 'tex))
+	 (paper (ly:paper-book-paper book))
 	 (lines (ly:paper-book-systems book))
 	 (last-line (car (last-pair lines))))
     (for-each
@@ -221,79 +243,137 @@
        (ly:outputter-dump-string outputter x))
      (list
       ;;FIXME
-      (header bookpaper (length lines) #f)
+      (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
       (output-scopes scopes fields basename)
-      (define-fonts bookpaper)
+      (define-fonts paper)
       (header-end)))
 
     (for-each
      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
-    (ly:outputter-dump-string outputter "\\lilypondend\n")))
-
+    (ly:outputter-dump-string outputter "\\lilypondend\n")
+    (ly:outputter-close outputter)
+    (postprocess-output book framework-tex-module filename
+			(output-formats))
+    ))
 
 (define-public (output-preview-framework
-		outputter book scopes fields basename )
-  (let* ((bookpaper (ly:paper-book-book-paper book))
-	 (lines (ly:paper-book-systems book)))
+		basename book scopes fields)
+  (let* ((filename (format "~a.tex" basename))
+	 (outputter  (ly:make-paper-outputter (open-file filename "wb")
+					      'tex))
+	 (paper (ly:paper-book-paper book))
+	 (lines (ly:paper-book-systems book))
+	 (first-notes-index (list-index
+			     (lambda (s) (not (ly:paper-system-title? s)))
+			     lines)))
+
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
+      
       ;;FIXME
-      (header bookpaper (length lines) #f)
+      (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
       (output-scopes scopes fields basename)
-      (define-fonts bookpaper)
+      (define-fonts paper)
       (header-end)))
 
-    (dump-line outputter (car lines) #t)
-    (ly:outputter-dump-string outputter "\\lilypondend\n")))
-
+    (for-each
+     (lambda (lst)
+       (dump-line outputter lst (not (ly:paper-system-title? lst))))
+     (take lines (1+ first-notes-index)))
+    (ly:outputter-dump-string outputter "\\lilypondend\n")
+    (ly:outputter-close outputter)
+    (postprocess-output book framework-tex-module filename
+			(output-formats))))
 
 (define-public (convert-to-pdf book name)
-  (let*
-      ((defs (ly:paper-book-book-paper book))
-       (size (ly:output-def-lookup defs 'papersize)))
-
-    (postscript->pdf (if (string? size) size "a4")
-		     (string-append
-		      (basename name ".tex")
-		      ".ps")
-		     )))
+  (let* ((defs (ly:paper-book-paper book))
+	 (paper-width (ly:output-def-lookup defs 'paper-width))
+	 (paper-height (ly:output-def-lookup defs 'paper-height))
+	 (output-scale (ly:output-def-lookup defs 'output-scale)))
+    (postscript->pdf (* paper-width output-scale (/ (ly:bp 1)))
+		     (* paper-height output-scale (/ (ly:bp 1)))
+		     (string-append (dir-basename name ".tex") ".ps"))))
 
 (define-public (convert-to-png book name)
-  (let*
-      ((defs (ly:paper-book-book-paper book))
-       (resolution (ly:output-def-lookup defs 'pngresolution)))
-
+  (let* ((defs (ly:paper-book-paper book))
+	 (resolution (ly:output-def-lookup defs 'pngresolution))
+	 (paper-width (ly:output-def-lookup defs 'paper-width))
+	 (paper-height (ly:output-def-lookup defs 'paper-height))
+	 (output-scale (ly:output-def-lookup defs 'output-scale)))
     (postscript->png
-     (if (number? resolution) resolution 90)
-     (string-append (basename name ".tex") ".ps")
-     )))
-
-(define-public (convert-to-ps book name)
-  (let*
-      ((cmd (string-append "dvips -u+ec-mftrace.map -u+lilypond.map -Ppdf "
-			   (basename name ".tex"))))
+     (if (number? resolution)
+	 resolution
+	 (ly:get-option 'resolution))
 
-    (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
-    (newline (current-error-port))
-    (system cmd)))
+     (* paper-width output-scale (/ (ly:bp 1)))
+     (* paper-height output-scale (/ (ly:bp 1)))
 
-(define-public (convert-to-dvi book name)
-  (let*
-      ((cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
+     (string-append (dir-basename name ".tex") ".ps"))))
 
-    (newline (current-error-port))
-    (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
-    (newline (current-error-port))
+(define-public (convert-to-ps book name)
+  (let* ((paper (ly:paper-book-paper book))
+	 (preview? (string-contains name ".preview"))
+	 (papersizename (ly:output-def-lookup paper 'papersizename))
+	 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
+	 (base (dir-basename name ".tex"))
+	 (ps-name (format "~a.ps"  base ".ps"))
+	 (cmd (string-append "dvips"
+			     (if preview?
+				 " -E"
+				 (string-append
+				  " -t"
+				  ;; careful: papersizename is user-set.
+				  (sanitize-command-option papersizename)
+				  ""))
+			     (if landscape? " -tlandscape" "")
+			     (if (ly:kpathsea-find-file "lm.map")
+				 " -u+lm.map" "")
+			     (if (ly:kpathsea-find-file "ecrm10.pfa")
+				 " -u+ec-mftrace.map" "")
+			     " -u+lilypond.map -Ppdf" ""
+			     " -o" ps-name
+			     " " base)))
+    (if (access? ps-name W_OK)
+	(delete-file ps-name))
+    (if (not (ly:get-option 'verbose))
+	(begin
+	  (ly:message (_ "Converting to `~a'...") (string-append base ".ps"))
+	  (ly:progress "\n")))
+    (ly:system cmd)))
 
-    ;; fixme: set in environment?
+(define-public (convert-to-dvi book name)
+  (let* ((curr-extra-mem
+	  (string->number
+	   (regexp-substitute/global
+	    #f " *%.*\n?"
+	    (ly:kpathsea-expand-variable "extra_mem_top")
+	    'pre "" 'post)))
+	 (base (dir-basename name ".tex"))
+	 (cmd (format
+	       #f "latex \\\\nonstopmode \\\\input '~a'" name)))
+
+    ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not?
+    (if (string-index name (char-set #\space #\ht #\newline #\cr))
+	(ly:error (_"TeX file name must not contain whitespace: `~a'") name))
+
+    (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
+    (let ((dvi-name (string-append base ".dvi")))
+      (if (access? dvi-name W_OK)
+	  (delete-file dvi-name)))
+    (if (not (ly:get-option 'verbose))
+	(begin
+	  (ly:message (_ "Converting to `~a'...") (string-append base ".dvi"))
+	  (ly:progress "\n")))
+
+    ;; FIXME: set in environment?
     (if (ly:get-option 'safe)
 	(set! cmd (string-append "openout_any=p " cmd)))
-    
-    (system cmd)))
+
+    (ly:system cmd)))
 
 (define-public (convert-to-tex book name)
   #t)