(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)