X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-tex.scm;h=5a602e4e489ec4f2d914b5ba5282f4f01d1e7f90;hb=05ea596de0b94fdcc64fa6bafccf4078ccfd53cf;hp=20a04f5a1611eeed6f8d83feb639b74a6cf86b2a;hpb=cc135005739b4a1537bbdfd776633ff4dbd6d065;p=lilypond.git

diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm
index 20a04f5a16..5a602e4e48 100644
--- a/scm/framework-tex.scm
+++ b/scm/framework-tex.scm
@@ -1,8 +1,8 @@
-;;;; 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	
@@ -10,107 +10,123 @@
 
 (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 )
+       (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 (font-load-command paper font)
-  (let* ((coding-alist (ly:font-encoding-alist font))
-	 (font-encoding (assoc-get 'output-name coding-alist)))
+(define-public (tex-font-command font)
+  (tex-font-command-raw
+   (ly:font-file-name font) (ly:font-magnification font)))
+
+(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:paper-outputscale paper)))))
-     "\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")))
+				   (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
+   (tex-number-def "lilypondpaper" 'output-scale
 		   (number->string (exact->inexact
-				    (ly:paper-outputscale paper))))
+				    (ly:paper-output-scale paper))))
    (tex-string-def "lilypondpaper" 'papersize
 		   (eval 'papersizename (ly:output-def-scope paper)))
    ;; paper/layout?
-   (tex-string-def "lilypondpaper" 'inputencoding
-		   (eval 'inputencoding (ly:output-def-scope paper)))
+   (tex-string-def "lilypondpaper" 'input-encoding
+		   (eval 'input-encoding (ly:output-def-scope paper)))
 
    (apply string-append
 	  (map (lambda (x) (font-load-command paper x))
 	       (ly:paper-fonts paper)))))
 
-(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)))
-
 (define (tex-string-def prefix key str)
   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
@@ -118,7 +134,7 @@
 		     "{" (sanitize-tex-string str) "}%\n")))
 
 (define (header paper page-count classic?)
-  (let ((scale (ly:output-def-lookup paper 'outputscale))
+  (let ((scale (ly:output-def-lookup paper 'output-scale))
 	(texpaper (string-append
 		   (ly:output-def-lookup paper 'papersizename)
 		   "paper"))
@@ -136,24 +152,18 @@
 	 "")
 
      (tex-string-def
-      "lilypondpaper" 'linewidth
-      (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
+      "lilypondpaper" 'line-width
+      (ly:number->string (* scale (ly:output-def-lookup paper 'line-width))))
      "\\def\\lilyponddocumentclassoptions{"
-     texpaper
+     (sanitize-tex-string texpaper)
      (if landscape? ",landscape" "")
      "}%\n"
-     (tex-string-def
-      "lilypondpaper" 'interscoreline
-      (ly:number->string
-       (* scale (ly:output-def-lookup paper 'interscoreline)))))))
+     )))
 
 (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"
@@ -179,9 +189,11 @@
        "}%\n\\vfill\n"
        "}%\n\\vfill\n\\lilypondpagebreak\n")))
 
-(define-public (output-framework outputter book scopes fields basename )
-  (let* ((paper (ly:paper-book-paper book))
-	 (pages (ly:paper-book-pages book))
+(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 paper 'dump-extents))))
@@ -189,26 +201,29 @@
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
-      (header paper (length pages) #f)
+      (header paper (length page-stencils) #f)
       (define-fonts paper)
       (header-end)))
     (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")))
+     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
    (format "\\lybox{~a}{~a}{%\n"
 	   (ly:number->string
-	    (max 0 (interval-end (ly:paper-system-extent line X))))
+	    (max 0 (interval-end (paper-system-extent line X))))
 	   (ly:number->string
-	    (interval-length (ly:paper-system-extent line Y)))))
+	    (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?
@@ -216,8 +231,11 @@
        "}\\interscoreline\n")))
 
 (define-public (output-classic-framework
-		outputter book scopes fields basename)
-  (let* ((paper (ly:paper-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
@@ -233,16 +251,28 @@
 
     (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* ((paper (ly:paper-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 paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
@@ -250,85 +280,101 @@
       (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-paper book))
-	 (papersizename (ly:output-def-lookup defs 'papersizename)))
-    (postscript->pdf (if (string? papersizename) papersizename "a4")
-		     (string-append
-		      (basename name ".tex")
-		      ".ps"))))
+	 (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-paper book))
-	 (resolution (ly:output-def-lookup defs 'pngresolution)))
+	 (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
 	 (ly:get-option 'resolution))
-     (string-append (basename name ".tex") ".ps"))))
+
+     (* 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-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 (basename name ".tex"))
-	 (cmd (string-append "dvips "
+	 (base (dir-basename name ".tex"))
+	 (ps-name (format "~a.ps"  base ".ps"))
+	 (cmd (string-append "dvips"
 			     (if preview?
-				 " -E "
-				 (string-append " -t " papersizename))
-			     (if landscape?
-				 " -t landscape "
-				 " ")
-			     "  -u+ec-mftrace.map -u+lilypond.map -Ppdf "
-			     base
-
-			     (if (ly:get-option 'verbose)
-				 " "
-				 " 2>&1 1>& /dev/null ")
-			     )))
-
-    (if (ly:get-option 'verbose)
-	(begin 
-	  (newline (current-error-port))
-
-	  (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
-	  (newline (current-error-port)))
-	(display (format #f "Converting to `~a.ps'...\n" base) (current-error-port))
-	)
-    (system cmd)))
+				 " -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)))
 
 (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")
+	    (ly:kpathsea-expand-variable "extra_mem_top")
 	    'pre "" 'post)))
-	 (base (basename name ".tex"))
-	 (cmd (string-append
-	       "latex \\\\nonstopmode \\\\input " name
-	       (if (ly:get-option 'verbose)
-		   " "
-		   " 2>&1 1>& /dev/null ")
-
-	       )))
+	 (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)))
-    (if (ly:get-option 'verbose)
-	(begin 
-	  (newline (current-error-port))
-	  (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
-	  (newline (current-error-port)))
-	(format (current-error-port) "Converting to `~a.dvi'...\n" base))
-
-    ;; fixme: set in environment?
+    (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)
+