release: 1.3.28

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index c3a9ac8ea46b82c6e6060484dbc56d56836490a3..582c55e24be4b06338f12212a772ebdde8450925 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -93,7 +93,7 @@
 ;;
 ;;
 
-;; (Measured in interlines? -- jcn)
+;; (Measured in staff space)
 (define space-alist
  '(
    (("" "Clef_item") . (minimum-space 1.0))
@@ -143,6 +143,7 @@
 (define cmr-alist 
   '(("bold" . "cmbx") 
     ("brace" . "feta-braces")
+    ("default" . "cmr10")
     ("dynamic" . "feta-din") 
     ("feta" . "feta") 
     ("feta-1" . "feta") 
@@ -214,8 +215,36 @@
         (map (lambda (x)
                (font-load-command (car x) (cdr x))) font-name-alist)
   ))
-  
 
+(define (fontify name exp)
+  (string-append (select-font name)
+                exp)
+  )
+
+;;;;;;;;;;;;;;;;;;;;
+
+
+; Make a function that checks score element for being of a specific type. 
+(define (make-type-checker name)
+  (lambda (elt)
+    (not (not (memq name (ly-get-elt-property elt 'interfaces))))))
+
+       
+
+
+
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;; generic output
+
+(define (translate-atom offset exp)
+  exp)
+
+
+;;;;;;;;;;;;;;;;;;; TeX output
 (define (tex-scm action-name)
   (define (unknown) 
     "%\n\\unknown%\n")
@@ -664,6 +693,10 @@
              (map (lambda (x) (string-append " " (arg->string x))) args)))
    ")\n"))
 
+(define (sign x)
+  (if (= x 0)
+      1
+      (inexact->exact (/ x (abs x)))))
 
 ;;;; AsciiScript as
 (define (as-scm action-name)
@@ -674,6 +707,29 @@
           (func "rline-to" width (* width slope))
           ))
 
+  ; simple flat slurs
+  (define (bezier-sandwich l thick)
+         (let (
+               (c0 (cadddr l))
+               (c1 (cadr l))
+               (c3 (caddr l)))
+              (let* ((x (car c0))
+                     (dx (- (car c3) x))
+                     (dy (- (cdr c3) (cdr c0)))
+                     (rc (/ dy dx))
+                     (c1-dx (- (car c1) x))
+                     (c1-line-y (+ (cdr c0) (* c1-dx rc)))
+                     (dir (if (< c1-line-y (cdr c1)) 1 -1))
+                     (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3)))))))
+                    (string-append
+                     (func "rmove-to" x y)
+                     (func "put" (if (< 0 dir) "/" "\\\\"))
+                     (func "rmove-to" 1 (if (< 0 dir) 1 0))
+                     (func "set-line-char" "_")
+                     (func "h-line" (- dx 1))
+                     (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
+                     (func "put" (if (< 0 dir) "\\\\" "/"))))))
+
   (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
          (string-append
           (func "rmove-to" (+ width 1) (- (/ height -2) 1))
@@ -718,12 +774,25 @@
   (define (header-end) 
     (func "header-end"))
 
-  (define (lily-def key val)
+  ;; urg: this is good for half of as2text's execution time
+  (define (xlily-def key val)
          (string-append "(define " key " " (arg->string val) ")\n"))
 
-  (define (placebox x y s) 
-    (string-append (func "move-to" x y) s))
+  (define (lily-def key val)
+         (if 
+          (or (equal? key "mudelapaperlinewidth")
+              (equal? key "mudelapaperstaffheight"))
+          (string-append "(define " key " " (arg->string val) ")\n")
+          ""))
 
+  (define (placebox x y s) 
+    (let ((ey (inexact->exact y)))
+         (string-append "(move-to " (number->string (inexact->exact x)) " "
+                        (if (= 0.5 (- (abs y) (abs ey)))
+                            (number->string y)
+                            (number->string ey))
+                        ")\n" s)))
+                      
   (define (select-font font-name-symbol)
     (let* ((c (assoc font-name-symbol font-name-alist)))
       (if (eq? c #f)
@@ -744,22 +813,24 @@
   (define (text s)
          (func "text" s))
 
-;  (define (volta h w thick vert_start vert_end)
-;     (func "draw-volta" h w thick vert_start vert_end))
-
   (define (volta h w thick vert-start vert-end)
+         ;; urg
          (string-append
-          (if #t  ;(= 0 vert-start)
-              ""
-             (func "v-line" h))
-          ""
-          ;(func "rmove-to" 0 h)
-          ;(func "h-line" w)
-          (if #t ;(= 0 vert-end)
-              ""
+          (func "set-line-char" "|")
+          (func "rmove-to" 0 -4)
+          ;; definition strange-way around
+          (if (= 0 vert-start)
+             (func "v-line" h)
+              "")
+          (func "rmove-to" 1 h)
+          (func "set-line-char" "_")
+          (func "h-line" (- w 1))
+          (func "set-line-char" "|")
+          (if (= 0 vert-end)
               (string-append
-               (func "rmove-to" w 0)
-               (func "v-line" (* -1 h))))))
+               (func "rmove-to" (- w 1) (* -1 h))
+               (func "v-line" (* -1 h)))
+              "")))
 
   (cond ((eq? action-name 'all-definitions)
         `(begin
@@ -767,7 +838,7 @@
            (define bracket ,bracket)
            (define char ,char)
            ;;(define crescendo ,crescendo)
-           ;(define bezier-sandwich ,bezier-sandwich)
+           (define bezier-sandwich ,bezier-sandwich)
            ;;(define dashed-slur ,dashed-slur) 
            ;;(define decrescendo ,decrescendo) 
            (define end-output ,end-output)