jiba tab

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

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 941eb94ee7cf86d94508ad49af9749642c8d4471..d4374a5974d3a802a2c765cf62588d8313299b26 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -5,6 +5,36 @@
 ;;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
+; Tablature functions, by Jiba (jiba@tuxfamily.org)
+
+; The TabNoteHead stem attachment function.
+(define (tablature-stem-attachment-function style)
+  (cons 0.0 1.0)
+)
+
+; The TabNoteHead molecule callback.
+; Create a text molecule
+(define (tablature-molecule-callback grob)
+  (let ((molecule (fontify-text
+                   (ly-get-default-font grob)
+                   (string-append
+                    (number->string
+                     (- (pitch-semitones (ly-get-mus-property (ly-get-grob-property grob 'cause) 'pitch))
+                        (list-ref
+                         (ly-get-grob-property grob 'string-tunings)
+                         (- (ly-get-grob-property grob 'tab-string)
+                            1 ; remove 1 because list index starts at 0 and guitar string at 1.
+                            ))
+                        )
+                     )
+                    )
+                   )))
+    molecule ; return the molecule.
+    )
+  )
+
+; end of tablature functions
+
 
 (define (arg->string arg)
   (cond ((number? arg) (inexact->string arg 10))
@@ -64,15 +94,38 @@
 (define (find-notehead-symbol duration style)
   (case style
    ((xcircle) "2xcircle")
-   ((harmonic) "0mensural")
+   ((harmonic) "0neo_mensural")
    ((baroque) 
     (string-append (number->string duration)
-                  (if (< duration 0) "mensural" "")))
+                  (if (< duration 0) "neo_mensural" "")))
+   ((mensural) (string-append (number->string duration) (symbol->string style)))
+   ((neo_mensural) (string-append (number->string duration) (symbol->string style)))
    ((default) (number->string duration))
    (else
-    (string-append (number->string duration) (symbol->string style)))))
+    (string-append (number->string (max 0 duration)) (symbol->string style)))))
+
 
+(define (note-head-style->attachment-coordinates style)
+  "Return pair (X . Y), containing multipliers for the note head
+bounding box, where to attach the stem. e.g.: X==0 means horizontally
+centered, X==1 is at the right, X == -1 is at the left."
 
+  (case style
+    ((default) '(1.0 . 0.5))
+    ((cross) '(1.0 . 0.75))
+    ((mensural) '(0.0 . 0.6))
+    ((neo_mensural) '(0.0 . 0.6))
+    ((diamond) '(1.0 . 0.8))
+    ((transparent) '(1.0 . 1.0))
+    ((slash) '(1.0 . 1.0))
+    ((harmonic) '(1.0 0.0))
+    ((triangle) '(0.75 . 0.15))
+    (else
+
+     ;; this also works for easy notation.
+     '(1.0 . 0.0)
+     )))
+                    
 (define (string-encode-integer i)
   (cond
    ((= i  0) "o")
@@ -82,27 +135,6 @@
          (string-encode-integer (quotient i 26))))))
 
 
-(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"
-                         (string-encode-integer
-                          (hashq (car ename-mag) 1000000))
-                         "m"
-                         (string-encode-integer
-                          (inexact->exact (* 1000 (cdr ename-mag)))))))))
-
-(define (define-fonts internal-external-name-mag-pairs)
-  (set! font-name-alist (map tex-encoded-fontswitch
-                            internal-external-name-mag-pairs))
-  (apply string-append
-        (map (lambda (x)
-               (font-load-command (car x) (cdr x)))
-             (map cdr font-name-alist))))
-
-(define (fontify name-mag-pair exp)
-  (string-append (select-font name-mag-pair)
-                exp))
+
+