Imported sources

[lilypond.git] / scm / output-tex.scm

diff --git a/scm/output-tex.scm b/scm/output-tex.scm
index afd15e374f541935fe05f01dd7dfae2ac032f9ca..2128cec4fe592babcd9fbc6840e75d1d96689624 100644 (file)
--- a/scm/output-tex.scm
+++ b/scm/output-tex.scm
@@ -1,14 +1,13 @@
-
 ;;; tex.scm -- implement Scheme output routines for TeX
 ;;;
 ;;;  source file of the GNU LilyPond music typesetter
 ;;; 
-;;; (c)  1998--2003 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; (c)  1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 
 (define-module (scm output-tex) )
-(debug-enable 'backtrace)
+; (debug-enable 'backtrace)
 (use-modules (scm output-ps)
             (ice-9 regex)
             (ice-9 string-fun)
@@ -28,6 +27,7 @@
 (define (tex-encoded-fontswitch name-mag)
   (let* ((iname-mag (car name-mag))
         (ename-mag (cdr name-mag)))
+
     (cons iname-mag
          (cons ename-mag
                (string-append  "magfont"
@@ -35,7 +35,7 @@
                           (hashq (car ename-mag) 1000000))
                          "m"
                          (string-encode-integer
-                          (inexact->exact (* 1000 (cdr ename-mag)))))))))
+                          (inexact->exact (round (* 1000 (cdr ename-mag))))))))))
 
 (define (define-fonts internal-external-name-mag-pairs)
   (set! font-name-alist (map tex-encoded-fontswitch
@@ -66,20 +66,24 @@
 
     (if (eq? c #f)
        (begin
-         (display "FAILED\n")
-         (display (object-type (car name-mag-pair)))
-         (display (object-type (caaar font-name-alist)))
-
          (ly:warn (string-append
                    "Programming error: No such font known "
                    (car name-mag-pair) " "
-                   (ly:number->string (cdr name-mag-pair))
-                   ))
-         "") ; issue no command
-       (string-append "\\" (cddr c)))
-    
-    
-    ))
+                   (ly:number->string (cdr name-mag-pair))))
+         
+         (display "FAILED\n" (current-error-port))
+         (if #f ;(pair? name-mag-pair))
+             (display (object-type (car name-mag-pair)) (current-error-port))
+             (write name-mag-pair (current-error-port)))
+         (if #f ;  (pair? font-name-alist)
+             (display
+              (object-type (caaar font-name-alist)) (current-error-port))
+             (write font-name-alist (current-error-port)))
+
+         ;; (format #f "\n%FAILED: (select-font ~S)\n" name-mag-pair))
+         "")
+       
+       (string-append "\\" (cddr c)))))
 
 (define (blank)
   "")
@@ -87,8 +91,8 @@
 (define (dot x y radius)
   (embedded-ps (list 'dot x y radius)))
 
-(define (beam width slope thick)
-  (embedded-ps (list 'beam  width slope thick)))
+(define (beam width slope thick blot)
+  (embedded-ps (list 'beam  width slope thick blot)))
 
 (define (bracket arch_angle arch_width arch_height height arch_thick thick)
   (embedded-ps (list 'bracket  arch_angle arch_width arch_height height arch_thick thick)))
@@ -113,7 +117,7 @@
    "\\font\\" command "="
    (car name-mag)
    " scaled "
-   (ly:number->string (inexact->exact (* 1000  (cdr name-mag))))
+   (ly:number->string (inexact->exact (round (* 1000  (cdr name-mag)))))
    "\n"))
 
 (define (ez-ball c l b)
@@ -138,20 +142,12 @@
   ""
   )
 
-(if (or (equal? (minor-version) "4.1")
-       (equal? (minor-version) "4")
-       (equal? (minor-version) "3.4"))
-    (define (embedded-ps expr)
-      (let ((ps-string
-            (with-output-to-string
-              (lambda () (ps-output-expression expr (current-output-port))))))
-       (string-append "\\embeddedps{" ps-string "}")))
-    (define (embedded-ps expr)
-      (let
-         ((os (open-output-string)))
-       (ps-output-expression expr os)
-       (string-append "\\embeddedps{" (get-output-string os) "}"))))
-
+(define (embedded-ps expr)
+  (let ((ps-string
+        (with-output-to-string
+          (lambda () (ps-output-expression expr (current-output-port))))))
+    (string-append "\\embeddedps{" ps-string "}")))
+  
 (define (comment s)
   (string-append "% " s "\n"))
 
@@ -187,7 +183,7 @@
    "\\lilypondspecial\n"
    "\\lilypondpostscript\n"))
 
-;; Note: this string must match the string in ly2dvi.py!!!
+;; Note: this string must match the string in lilypond.py!!!
 (define (header creator generate) 
   (string-append
    "% Generated automatically by: " creator generate "\n"))
@@ -225,9 +221,6 @@
                 (ly:number->string x) "}{"
                 s "}%\n"))
 
-(define (bezier-bow l thick)
-  (embedded-ps (list 'bezier-bow  `(quote ,l) thick)))
-
 (define (bezier-sandwich l thick)
   (embedded-ps (list 'bezier-sandwich  `(quote ,l) thick)))
 
@@ -246,6 +239,9 @@
 (define (stop-last-system)
   "}%\n")
 
+(define (horizontal-line x1 x2 th)
+  (filledbox (- x1)  (- x2 x1) (* .5 th)  (* .5 th )))
+
 (define (filledbox breapth width depth height)
   (if (and #f (defined? 'ps-testing))
       (embedded-ps
@@ -257,8 +253,8 @@
                     (ly:number->string depth) "}{"
                     (ly:number->string height) "}")))
 
-(define (roundfilledbox x y width height blotdiam)
-  (embedded-ps (list 'roundfilledbox  x y width height blotdiam)))
+(define (round-filled-box x y width height blotdiam)
+  (embedded-ps (list 'round-filled-box  x y width height blotdiam)))
 
 (define (text s)
   (string-append "\\hbox{" (output-tex-string s) "}"))
@@ -272,6 +268,7 @@
 (define (draw-line thick fx fy tx ty)
   (embedded-ps (list 'draw-line thick fx fy tx ty)))
 
+;; TODO: this should be a default, which is overriden in PS
 (define (between-system-string string)
   string
   )
@@ -287,7 +284,6 @@
 (define (no-origin) "")
 
 (define-public (tex-output-expression expr port)
-  (display (eval expr this-module) port )
-  )
+  (display (eval expr this-module) port ))