* GNUmakefile.in: remove no kpathsea hack.

[lilypond.git] / scm / new-markup.scm

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index dea79e240459afa3c498192c9dead10a8332b8eb..f9587aa8a2adeabf74479484d708893216ef6fd6 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -49,6 +49,7 @@ for the reader.
   (Text_item::text_to_molecule grob props (car rest))
   )
 
+
 (define-public (stack-molecule-line space molecules)
   (if (pair? molecules)
       (if (pair? (cdr molecules))
@@ -72,18 +73,12 @@ for the reader.
    (map (lambda (x) (interpret-markup grob props x)) (car rest)))
   )
 
-(define (combine-molecule-list lst)
-  (if (null? (cdr lst)) (car lst)
-      (ly:molecule-add (car lst) (combine-molecule-list (cdr lst)))
-      ))
 
 (define-public (combine-markup grob props . rest)
   (ly:molecule-add
    (interpret-markup grob props (car rest))
    (interpret-markup grob props (cadr rest))))
   
-;   (combine-molecule-list (map (lambda (x) (interpret-markup grob props x)) (car rest))))
-
 (define (font-markup qualifier value)
   (lambda (grob props . rest)
     (interpret-markup grob (cons (cons `(,qualifier . ,value) (car props)) (cdr props)) (car rest))
@@ -142,6 +137,18 @@ for the reader.
    (map (lambda (x) (interpret-markup grob props x)) (car rest)))
   )
 
+(define-public (dir-column-markup grob props . rest)
+  "Make a column of args, going up or down, depending on DIRECTION."
+  (let*
+      (
+       (dir (cdr (chain-assoc 'direction props)))
+       )
+    (stack-lines
+     (if (number? dir) dir -1)
+     0.0 (cdr (chain-assoc 'baseline-skip props))
+     (map (lambda (x) (interpret-markup grob props x)) (car rest)))
+    ))
+
 (define-public (center-markup grob props . rest)
   (let*
     (
@@ -160,6 +167,7 @@ for the reader.
    (car rest))
   )
 
+
 (define-public (lookup-markup grob props . rest)
   "Lookup a glyph by name."
   (ly:find-glyph-by-name
@@ -181,6 +189,81 @@ for the reader.
                              (car rest) Y)
   )
 
+
+(define-public (note-markup grob props . rest)
+  "Syntax: \\note #LOG #DOTS #DIR. "
+  (let*
+      (
+       (log (car rest))
+       (dot-count (cadr rest))
+       (dir (caddr rest))
+       (font (ly:get-font grob (cons '((font-family .  music)) props)))
+       (stemlen (max 3 (- log 1)))
+       (headgl
+       (ly:find-glyph-by-name font (string-append "noteheads-" (number->string (min log 2)))))
+
+       (stemth 0.13)
+       (stemy (* dir stemlen))
+       (attachx (if (> dir 0) (- (cdr (ly:molecule-get-extent headgl X)) stemth)
+                   0))
+       (attachy (* dir 0.28))
+       (stemgl (if (> log 0)
+                  (ly:round-filled-box (cons
+                                    (cons attachx (+ attachx  stemth))
+                                    (cons (min stemy attachy)
+                                          (max stemy attachy)))
+                                   (/ stemth 3)
+                                   ) #f))
+       (dot (ly:find-glyph-by-name font "dots-dot"))
+       (dotwid  (interval-length (ly:molecule-get-extent dot X)))
+       (dots (if (> dot-count 0)
+                (apply ly:molecule-add
+                 (map (lambda (x)
+                        (ly:molecule-translate-axis
+                         dot  (* (+ 1 (* 2 x)) dotwid) X) )
+                      (iota dot-count 1)))
+                #f))
+       
+       (flaggl (if (> log 2)
+                  (ly:molecule-translate
+                   (ly:find-glyph-by-name
+                    font
+                    (string-append "flags-"
+                                   (if (> dir 0) "u" "d")
+                                   (number->string log)
+                                   ))
+                   (cons (+ attachx (/ stemth 2)) stemy))
+
+                   #f)))
+    
+    (if flaggl
+       (set! stemgl (ly:molecule-add flaggl stemgl)))
+
+    (if (ly:molecule? stemgl)
+       (set! stemgl (ly:molecule-add stemgl headgl))
+        (set! stemgl headgl)
+       )
+    
+    (if (ly:molecule? dots)
+       (set! stemgl
+             (ly:molecule-add
+              (ly:molecule-translate-axis
+               dots
+               (+
+                (if (and (> dir 0) (> log 2))
+                    (* 1.5 dotwid) 0)
+                ;; huh ? why not necessary?
+               ;(cdr (ly:molecule-get-extent headgl X))
+                     dotwid
+                )
+               X)
+              stemgl 
+              )
+             ))
+
+    stemgl
+    ))
+
 (define-public (normal-size-super-markup grob props . rest)
   (ly:molecule-translate-axis (interpret-markup
                               grob
@@ -223,6 +306,25 @@ for the reader.
                              Y)
   )
 
+(define-public (hbracket-markup grob props . rest)
+  (let*
+      (
+       (th 0.1) ;; todo: take from GROB.
+       (m (interpret-markup grob props (car rest)))
+       )
+
+    (bracketify-molecule m X th (* 2.5 th) th)  
+))
+
+(define-public (bracket-markup grob props . rest)
+  (let*
+      (
+       (th 0.1) ;; todo: take from GROB.
+       (m (interpret-markup grob props (car rest)))
+       )
+
+    (bracketify-molecule m Y th (* 2.5 th) th)  
+))
 
 ;; todo: fix negative space
 (define (hspace-markup grob props . rest)
@@ -251,11 +353,10 @@ for the reader.
        (fs (cdr (chain-assoc 'font-relative-size props)))
        (entry (cons 'font-relative-size (- fs 1)))
        )
-  (interpret-markup
-   grob (cons (list entry) props)
-   (car rest))
-
-  ))
+    (interpret-markup
+     grob (cons (list entry) props)
+     (car rest))
+    ))
 
 (define-public (bigger-markup  grob props . rest)
   "Syntax: \\bigger MARKUP"
@@ -269,6 +370,17 @@ for the reader.
    (car rest))
   ))
 
+(define-public (box-markup grob props . rest)
+  "Syntax: \\box MARKUP"
+  (let*
+      (
+       (th 0.1)
+       (pad 0.2)
+       (m (interpret-markup grob props (car rest)))
+       )
+    (box-molecule m th pad)
+  ))
+
 (define (markup-signature-to-keyword sig)
   " (A B C) -> a0-b1-c2 "
   
@@ -377,7 +489,7 @@ for the reader.
 ;; 
 (define markup?  cheap-markup?)
 
-(define markup-function-list
+(define markup-functions-and-signatures
   (list
 
    ;; abs size
@@ -392,7 +504,8 @@ for the reader.
    ;; size
    (cons smaller-markup (list markup?))
    (cons bigger-markup (list markup?))
-
+;   (cons char-number-markup (list string?))
+   
    ;; 
    (cons sub-markup (list markup?))
    (cons normal-size-sub-markup (list markup?))
@@ -405,9 +518,12 @@ for the reader.
    (cons italic-markup (list markup?))
    (cons roman-markup (list markup?))
    (cons number-markup (list markup?))
-   
+   (cons hbracket-markup  (list markup?))
+   (cons bracket-markup  (list markup?))
+   (cons note-markup (list integer? integer? ly:dir?))
    
    (cons column-markup (list markup-list?))
+   (cons dir-column-markup (list markup-list?))
    (cons center-markup (list markup-list?))
    (cons line-markup  (list markup-list?))
 
@@ -424,6 +540,8 @@ for the reader.
    (cons raise-markup (list number? markup?))
    (cons magnify-markup (list number? markup?))
    (cons fontsize-markup (list number? markup?))
+
+   (cons box-markup  (list markup?))
    )
   )
 
@@ -434,7 +552,9 @@ for the reader.
        (set-object-property! (car x) 'markup-signature (cdr x))
        (set-object-property! (car x) 'markup-keyword (markup-signature-to-keyword (cdr x)))
        )
-     markup-function-list)
+     markup-functions-and-signatures)
+
+(define-public markup-function-list (map car markup-functions-and-signatures))
 
 
 ;; construct a
@@ -524,7 +644,7 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
   )
 
 (eval
- (cons 'begin (map make-markup-maker markup-function-list))
+ (cons 'begin (map make-markup-maker markup-functions-and-signatures))
  markup-module
  )
 
@@ -542,19 +662,16 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
 
 (define-public (brew-new-markup-molecule grob)
   (let*
-      ((t     (ly:get-grob-property grob 'text))
-       )
-    (if (null? t)
-       '()
-       (interpret-markup grob
-                         (Font_interface::get_property_alist_chain grob)
-                         t
-                         ))
-  ))
+      ((t (ly:get-grob-property grob 'text))
+       (chain (Font_interface::get_property_alist_chain grob)))
+    (if (markup? t)
+       (interpret-markup grob  chain t)
+       (Text_item::text_to_molecule grob t chain)
+       )))
 
-(define-public empty-markup `(,simple-markup ""))
+(define-public empty-markup (make-simple-markup ""))
 
-(define (interpret-markup  grob props markup)
+(define-public (interpret-markup grob props markup)
   (if (string? markup)
       (simple-markup grob props markup)
       (let*