]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/output-tex.scm
*** empty log message ***
[lilypond.git] / scm / output-tex.scm
index 80b3bea144c0f8c671264dc5a48cd868c919e14c..f2d8da9456efea92f2bb8b489e3168e509ce379c 100644 (file)
@@ -20,6 +20,8 @@
 
 (define-module (scm output-tex)
   #:re-export (quote)
+
+  ;; JUNK this -- see lily.scm: ly:all-output-backend-commands
   #:export (unknown
             blank
             dot
             beam
             bracket
             dashed-slur
-            char
+            named-glyph
             dashed-line
             zigzag-line
-            symmetric-x-triangle
             ez-ball
             comment
             repeat-slash
             filledbox
             round-filled-box
             text
-            tuplet
+            white-text
             polygon
             draw-line
-            define-origin
             no-origin
             grob-cause
             ))
             (scm framework-tex)
             (lily))
 
+
+
 ;;;;;;;;
 ;;;;;;;; DOCUMENT ME!
 ;;;;;;;;
 
 
+(define (char font i)
+  (string-append "\\" (tex-font-command font)
+                "\\char" (ly:inexact->string i 10) " "))
 
 (define (unknown) 
   "%\n\\unknown\n")
 (define (dot x y radius)
   (embedded-ps (list 'dot x y radius)))
 
+
+(define (embedded-ps string)
+  (embedded-ps (list 'embedded-ps string)))
+
 (define (white-dot x y radius)
   (embedded-ps (list 'white-dot x y radius)))
 
 (define (dashed-slur thick dash l)
   (embedded-ps (list 'dashed-slur thick dash `(quote ,l))))
 
-(define (char font i)
-  (string-append "\\" (tex-font-command font)
-                "\\char" (ly:inexact->string i 10) " "))
+(define (named-glyph font name)
+  (let* ((info (ly:otf-font-glyph-info font name))
+        (subfont (assoc-get 'subfont info))
+        (subidx  (assoc-get 'subfont-index info)))
+    
+    ;;(stderr "INFO: ~S\n" info)
+    ;;(stderr "FONT: ~S\n" font)
+    (if (and subfont subidx)
+       (string-append "\\" (tex-font-command-raw
+                            subfont
+                            (ly:font-magnification font))
+                      "\\char" (number->string subidx))
+
+       (begin
+         (ly:warn "Can't find ~a in ~a" name font)
+         ""))
+       ))
 
 (define (dashed-line thick on off dx dy)
   (embedded-ps (list 'dashed-line  thick on off dx dy)))
 (define (zigzag-line centre? zzw zzh thick dx dy)
   (embedded-ps (list 'zigzag-line centre? zzw zzh thick dx dy)))
 
-(define (symmetric-x-triangle t w h)
-  (embedded-ps (list 'symmetric-x-triangle t w h)))
-
-
 (define (ez-ball c l b)
-  (embedded-ps (list 'ez-ball  c  l b)))
-
-
+  (embedded-ps (list 'ez-ball c l b)))
 
 (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 (repeat-slash w a t)
   (embedded-ps (list 'repeat-slash  w a t)))
 
-
-
 (define (number->dim x)
   (string-append
    ;;ugh ly:* in backend needs compatibility func for standalone output
                        s))
                   "}")))
 
-
-(define (tuplet ht gapx dx dy thick dir)
-  (embedded-ps (list 'tuplet  ht gapx dx dy thick dir)))
-
+(define (white-text scale s)
+   (embedded-ps (list 'white-text scale s)))
+   
 (define (polygon points blotdiameter)
   (embedded-ps (list 'polygon `(quote ,points) blotdiameter)))
 
 (define (draw-line thick fx fy tx ty)
   (embedded-ps (list 'draw-line thick fx fy tx ty)))
 
-(define (define-origin file line col)
-  "")
-
 ;; no-origin not yet supported by Xdvi
 (define (no-origin) "")
 
 (define (grob-cause grob)
   (if (procedure? point-and-click)
-  
-  (let*
-      ((cause (ly:grob-property grob 'cause))
-       (music-origin (if (ly:music? cause)
-                        (ly:music-property cause 'origin)
-                         #f))
-       (location (if (ly:input-location? music-origin)
-                    (ly:input-location music-origin)
-                    #f)))
-
-    (if (pair? location)
-       (string-append "\\special{src:" ;;; \\string ? 
-                      (apply point-and-click location) "}")
-       ""))
-  ""))
+      (let* ((cause (ly:grob-property grob 'cause))
+            (music-origin (if (ly:music? cause)
+                              (ly:music-property cause 'origin)))
+            (location (if (ly:input-location? music-origin)
+                          (ly:input-location music-origin))))
+       (if (pair? location)
+            ;;; \\string ? 
+           (string-append "\\special{src:"
+                          (apply point-and-click location) "}")
+           ""))
+      ""))