;
; This file contains various routines in Scheme that are easier to
-; do here than in C++. At present it is a unorganised mess. Sorry.
+; do here than in C++. At present it is an unorganised mess. Sorry.
;
(define (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
-;; Score_span_bars are only visible at start of line
-;; i.e. if break_dir == RIGHT == 1
-(define Span_bar_engraver-visibility begin-of-line-invisible)
(define mark-visibility end-of-line-invisible)
;; Spacing constants for prefatory matter.
((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))
+ ((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))
)
)
-;; (define (ly-warn s) (error s))
-(define (break-align-spacer this next)
- (let ((entry (assoc (list this next) space-alist)))
- (if entry
- (cdr entry)
- (begin (ly-warn (string-append "Unknown spacing pair `" this "', `" next "'"))
- '(minimum-space 0.0)))))
-
-
-(define (noteheadsymbol duration style)
- (cond
- ((equal? style "cross") "2cross")
- ((equal? style "harmonic") "0mensural")
- ((equal? style "baroque")
+;; silly, use alist?
+(define (find-notehead-symbol duration style)
+ (case style
+ ((cross) "2cross")
+ ((harmonic) "0mensural")
+ ((baroque)
(string-append (number->string duration)
(if (< duration 0) "mensural" "")))
+ ((default) (number->string duration))
(else
- (string-append (number->string duration) style))))
+ (string-append (number->string duration) (symbol->string style)))))
;;;;;;;; TeX
("feta-2" . "feta")
("typewriter" . "cmtt")
("italic" . "cmti")
+ ("msam" . "msam")
("roman" . "cmr")
("script" . "cmr")
("large" . "cmbx")
)
(define script-alist '())
-(define (articulation-to-scriptdef a)
- (assoc a script-alist)
- )
-
-;; Map style names to TeX font names. Return false if
-;; no font name found.
-(define (style-to-cmr s)
- (assoc s cmr-alist )
- )
-
-
(define font-name-alist '())
(define (font-command name-mag)
(string-append "% " s))
(define (end-output)
- "\n\\EndLilyPondOutput")
+ (begin
+; uncomment for some stats about lily memory
+; (display (gc-stats))
+ (string-append "\n\\EndLilyPondOutput"
+ ; Put GC stats here.
+ )))
(define (experimental-on)
"")
content))
;; urg: Use when standalone, do:
-;; (define (ly-gulp-file name) (scm-gulp-file name))
+;; (define ly-gulp-file scm-gulp-file)
(define (scm-gulp-file name)
(set! %load-path
(cons (string-append (getenv 'LILYPONDPREFIX) "/ly")
(define (scm-as-output)
(eval (as-scm 'all-definitions)))
-
-; Russ McManus, <mcmanus@IDT.NET>
-;
-; I use the following, which should definitely be provided somewhere
-; in guile, but isn't, AFAIK:
-;
-;
-
-(define (hash-table-for-each fn ht)
- (do ((i 0 (+ 1 i)))
- ((= i (vector-length ht)))
- (do ((alist (vector-ref ht i) (cdr alist)))
- ((null? alist) #t)
- (fn (car (car alist)) (cdr (car alist))))))
-
-(define (hash-table-map fn ht)
- (do ((i 0 (+ 1 i))
- (ret-ls '()))
- ((= i (vector-length ht)) (reverse ret-ls))
- (do ((alist (vector-ref ht i) (cdr alist)))
- ((null? alist) #t)
- (set! ret-ls (cons (fn (car (car alist)) (cdr (car alist))) ret-ls)))))
-
-
-
+
(define (index-cell cell dir)
(if (equal? dir 1)
(cdr cell)
("|s" . (nil . "|"))
("|:" . ("|" . "|:"))
("|." . ("|." . nil))
+ (".|" . (nil . ".|"))
(":|" . (":|" . nil))
("||" . ("||" . nil))
(".|." . (".|." . nil))
)
-(define (slur-ugly ind ht)
- (if (and
-; (< ht 4.0)
- (< ht (* 4 ind))
- (> ht (* 0.4 ind))
- (> ht (+ (* 2 ind) -4))
- (< ht (+ (* -2 ind) 8)))
- #f
- (cons ind ht)
- ))
+(define major-scale
+ '(
+ (0 . 0)
+ (1 . 0)
+ (2 . 0)
+ (3 . 0)
+ (4 . 0)
+ (5 . 0)
+ (6 . 0)
+ )
+ )
projects / lilypond.git / blobdiff