]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/lily.scm
patch::: 1.3.95.jcn1
[lilypond.git] / scm / lily.scm
index 80e3ffeb6ae74ac8903a06ce9146444c95a2ec4f..38e96e741ffe830ffbe7ac47dc6ee36825b7831e 100644 (file)
 (use-modules (ice-9 regex))
 
 ;; The regex module may not be available, or may be broken.
-;; If you have trouble with regex, define #f
-;;(define use-regex #t)
-;;(define use-regex #f)
-
 (define use-regex
   (let ((os (string-downcase (vector-ref (uname) 0))))
     (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
 
+;; If you have trouble with regex, define #f
+(define use-regex #t)
+;;(define use-regex #f)
+
 ;; do nothing in .scm output
 (define (comment s) "")
 
+;; URG guile-1.3/1.4 compatibility
+(define (ly-eval x) (eval2 x #f))
+
+(define (comment s) "")
+
 (define (mm-to-pt x)
   (* (/ 72.27 25.40) x)
   )
 (define security-paranoia #f)
 
 
-;; See documentation of Item::visibility_lambda_
-(define (begin-of-line-visible d) (if (= d 1) '(#f . #f) '(#t . #t)))
-(define (spanbar-begin-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
-(define (all-visible d) '(#f . #f))
-(define (all-invisible d) '(#t . #t))
-(define (begin-of-line-invisible d) (if (= d 1) '(#t . #t) '(#f . #f)))
-(define (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
-
-
-(define mark-visibility end-of-line-invisible)
-
-;; Spacing constants for prefatory matter.
-;;
-;; rules for this spacing are much more complicated than this. See [Wanske] page 126 -- 134, [Ross] pg 143 -- 147
-;;
-;;
-
-;; (Measured in staff space)
-(define space-alist
- '(
-   ((none Instrument_name) . (extra-space 1.0))
-   ((Instrument_name Left_edge_item) . (extra-space 1.0))
-   ((Left_edge_item Clef_item) . (extra-space 1.0))
-   ((Left_edge_item Key_item) . (extra-space 0.0))   
-   ((Left_edge_item begin-of-note) . (extra-space 1.0))
-   ((none Left_edge_item) . (extra-space 0.0))
-   ((Left_edge_item Staff_bar) . (extra-space 0.0))
-;   ((none Left_edge_item) . (extra-space -15.0))
-;   ((none Left_edge_item) . (extra-space -15.0))
-   ((none Clef_item) . (minimum-space 1.0))
-   ((none Staff_bar) . (minimum-space 0.0))
-   ((none Clef_item) . (minimum-space 1.0))
-   ((none Key_item) . (minimum-space 0.5))
-   ((none Time_signature) . (extra-space 0.0))
-   ((none begin-of-note) . (minimum-space 1.5))
-   ((Clef_item Key_item) . (minimum-space 4.0))
-   ((Key_item Time_signature) . (extra-space 1.0))
-   ((Clef_item  Time_signature) . (minimum-space 3.5))
-   ((Staff_bar Clef_item) .   (minimum-space 1.0))
-   ((Clef_item  Staff_bar) .  (minimum-space 3.7))
-   ((Time_signature Staff_bar) .  (minimum-space 2.0))
-   ((Key_item  Staff_bar) .  (extra-space 1.0))
-   ((Staff_bar Time_signature) . (minimum-space 1.5)) ;double check this.
-   ((Time_signature begin-of-note) . (extra-space 2.0)) ;double check this.
-   ((Key_item begin-of-note) . (extra-space 2.5))
-   ((Staff_bar begin-of-note) . (extra-space 1.0))
-   ((Clef_item begin-of-note) . (minimum-space 5.0))
-   ((none Breathing_sign) . (minimum-space 0.0))
-   ((Breathing_sign Key_item) . (minimum-space 1.5))
-   ((Breathing_sign begin-of-note) . (minimum-space 1.0))
-   ((Breathing_sign Staff_bar) . (minimum-space 1.5))
-   ((Breathing_sign Clef_item) . (minimum-space 2.0))
-   )
-)
-
 ;; silly, use alist? 
 (define (find-notehead-symbol duration style)
   (case style
        )
   )
             
-(define script-alist '())
+(define default-script-alist '())
 
 (define font-name-alist  '())
 (define (font-command name-mag)
 
 
 ; Make a function that checks score element for being of a specific type. 
-(define (make-type-checker name)
+(define (make-type-checker symbol)
   (lambda (elt)
-    (not (not (memq name (ly-get-elt-property elt 'interfaces))))))
+    ;;(display  symbol)
+    ;;(eq? #t (ly-get-elt-property elt symbol))
+    (not (eq? #f (memq symbol (ly-get-elt-property elt 'interfaces))))
+    ))
 
-       
 ;;;;;;;;;;;;;;;;;;; TeX output
 (define (tex-scm action-name)
   (define (unknown) 
   (define (char i)
     (string-append "\\char" (inexact->string i 10) " "))
   
-  (define (dashed-line thick dash w)
-    (embedded-ps ((ps-scm 'dashed-line) thick dash w)))
+  (define (dashed-line thick on off w)
+    (embedded-ps ((ps-scm 'dashed-line) thick on off w)))
 
   (define (decrescendo thick w h cont)
     (embedded-ps ((ps-scm 'decrescendo) thick w h cont)))
       (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
 
   (define (stop-line) 
-    "}\\vss}\\interscoreline")
+    "}\\vss}\\interscoreline\n")
   (define (stop-last-line)
     "}\\vss}")
   (define (filledbox breapth width depth height) 
   (define (volta h w thick vert_start vert_end)
     (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end)))
 
+  (define (define-origin file line col)
+    ; use this for column positions
+     (string-append "\\special{src:" (number->string line) ":"
+        (number->string col) " " file "}")
+
+     ; line numbers only:
+    ;(string-append "\\special{src:" (number->string line) " " file "}")
+)
+    ; no origin  info: return empty string
+    ; ""
+  ; no-origin not yet supported by Xdvi
+  (define (no-origin) "")
+  
   ;; TeX
   ;; The procedures listed below form the public interface of TeX-scm.
   ;; (should merge the 2 lists)
            (define text ,text)
            (define tuplet ,tuplet)
            (define volta ,volta)
+           (define define-origin ,define-origin)
+           (define no-origin ,no-origin)
            ))
 
        ((eq? action-name 'beam) beam)
      (number->string (* 10 thick))     ;UGH.  10 ?
      " ] 0 draw_dashed_slur"))
 
-  (define (dashed-line thick dash width)
+  (define (dashed-line thick on off width)
     (string-append 
      (number->string width) 
      " "
      (number->string thick) 
      " [ "
-     (number->string dash)
+     (number->string on)
      " "
-     (number->string dash)
+     (number->string off)
      " ] 0 draw_dashed_line"))
 
   (define (decrescendo thick w h cont)
     "\n unknown\n")
 
 
+  (define (define-origin a b c ) "")
+  (define (no-origin) "")
+  
   ;; PS
   (cond ((eq? action-name 'all-definitions)
         `(begin
            (define stop-line ,stop-line)
            (define stop-last-line ,stop-line)
            (define text ,text)
+           (define no-origin ,no-origin)
+           (define define-origin ,define-origin)
            ))
        ((eq? action-name 'tuplet) tuplet)
        ((eq? action-name 'beam) beam)
 (define (sign x)
   (if (= x 0)
       1
-      (inexact->exact (/ x (abs x)))))
+      (if (< x 0) -1 1)))
 
 ;;;; AsciiScript as
 (define (as-scm action-name)
   (define (char i)
     (func "char" i))
 
+  (define (define-origin a b c ) "")
+
   (define (end-output) 
     (func "end-output"))
   
           (string-append "(define " key " " (arg->string val) ")\n")
           ""))
 
+  (define (no-origin) "")
+  
   (define (placebox x y s) 
     (let ((ey (inexact->exact y)))
          (string-append "(move-to " (number->string (inexact->exact x)) " "
   (define (text s)
          (func "text" s))
 
+  (define (tuplet ht gap dx dy thick dir) "")
+
   (define (volta h w thick vert-start vert-end)
          ;; urg
          (string-append
            (define beam ,beam)
            (define bracket ,bracket)
            (define char ,char)
+           (define define-origin ,define-origin)
            ;;(define crescendo ,crescendo)
            (define bezier-sandwich ,bezier-sandwich)
            ;;(define dashed-slur ,dashed-slur) 
            (define lily-def ,lily-def)
            ;;(define invoke-char ,invoke-char) 
            ;;(define invoke-dim1 ,invoke-dim1)
+           (define no-origin ,no-origin)
            (define placebox ,placebox)
            (define select-font ,select-font)
            (define start-line ,start-line)
            (define stop-line ,stop-line)
            (define stop-last-line ,stop-line)
            (define text ,text)
-           ;;(define tuplet ,tuplet)
+           (define tuplet ,tuplet)
            (define volta ,volta)
            ))
-       ;;((eq? action-name 'tuplet) tuplet)
+       ((eq? action-name 'tuplet) tuplet)
        ;;((eq? action-name 'beam) beam)
        ;;((eq? action-name 'bezier-sandwich) bezier-sandwich)
        ;;((eq? action-name 'bracket) bracket)
           (gulp-file name))))
 
 (define (scm-tex-output)
-  (eval (tex-scm 'all-definitions)))
+  (ly-eval (tex-scm 'all-definitions)))
                                
 (define (scm-ps-output)
-  (eval (ps-scm 'all-definitions)))
+  (ly-eval (ps-scm 'all-definitions)))
 
 (define (scm-as-output)
-  (eval (as-scm 'all-definitions)))
+  (ly-eval (as-scm 'all-definitions)))
        
 (define (index-cell cell dir)
   (if (equal? dir 1)
       (cdr cell)
       (car cell)))
 
-;
-; How should a  bar line behave at a break? 
-;
-(define (break-barline glyph dir)
-   (let ((result (assoc glyph 
-                       '((":|:" . (":|" . "|:"))
-                         ("|" . ("|" . ""))
-                         ("|s" . (nil . "|"))
-                         ("|:" . ("|" . "|:"))
-                         ("|." . ("|." . nil))
-                         (".|" . (nil . ".|"))
-                         (":|" . (":|" . nil))
-                         ("||" . ("||" . nil))
-                         (".|." . (".|." . nil))
-                         ("scorebar" . (nil . "scorepostbreak"))
-                         ("brace" . (nil . "brace"))
-                         ("bracket" . (nil . "bracket"))  
-                         )
-                       )))
-
-     (if (equal? result #f)
-        (ly-warn (string-append "Unknown bar glyph: `" glyph "'"))
-        (index-cell (cdr result) dir))
-     )
-   )
-     
-
 (define major-scale
   '(
     (0 . 0)