X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=ded3b1ff301edabb4406e3e07b041b2dd2581ab9;hb=4b54303fe9248242e8e74804c394e45570df23db;hp=b345d1562dc78e8fa766584178e1e4eb33c9b904;hpb=23d508c591303b53df9c6e4c6394e741c50c1630;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index b345d1562d..ded3b1ff30 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -7,7 +7,7 @@ ; ; 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. ; @@ -19,10 +19,12 @@ ;; 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 #t) ;;(define use-regex #f) -;;(define use-regex -;; (not (equal? "Windows" (substring (vector-ref (uname) 0) 0 7)))) + +(define use-regex + (let ((os (string-downcase (vector-ref (uname) 0)))) + (not (equal? "cygwin" (substring os 0 (min 6 (string-length os))))))) ;; do nothing in .scm output (define (comment s) "") @@ -83,18 +85,12 @@ (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))) -;; 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 Base_span_bar_engraver-visibility begin-of-line-invisible) (define mark-visibility end-of-line-invisible) -(define Span_score_bar_engraver-visibility begin-of-line-visible) -(define Piano_bar_engraver-visibility begin-of-line-visible) -(define Staff_group_bar_engraver-visibility begin-of-line-visible) ;; Spacing constants for prefatory matter. ;; @@ -105,45 +101,51 @@ ;; (Measured in staff space) (define space-alist '( - (("" "Left_edge_item") . (extra-space -15.0)) - (("" "Clef_item") . (minimum-space 1.0)) - (("" "Staff_bar") . (minimum-space 0.0)) - (("" "Clef_item") . (minimum-space 1.0)) - (("" "Key_item") . (minimum-space 0.5)) - (("" "Span_bar") . (extra-space 0.0)) - (("" "Time_signature") . (extra-space 0.0)) - (("" "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)) - (("Span_bar" "Clef_item") . (extra-space 1.0)) - (("Clef_item" "Span_bar") . (minimum-space 3.7)) - (("Time_signature" "Span_bar") . (minimum-space 2.0)) - (("Key_item" "Span_bar") . (minimum-space 2.5)) - (("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)) - (("" "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)) + ((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)) ) ) - -(define (break-align-spacer this next) - (let ((entry (assoc `(,this ,next) space-alist))) - (if entry - (cdr entry) - (begin (ly-warn (string-append "Unknown spacing pair `" this "', `" next "'")) - '(minimum-space 0.0))))) - + +(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) (symbol->string style))))) ;;;;;;;; TeX @@ -158,14 +160,16 @@ ("feta" . "feta") ("feta-1" . "feta") ("feta-2" . "feta") - ("finger" . "feta-nummer") ("typewriter" . "cmtt") ("italic" . "cmti") + ("msam" . "msam") ("roman" . "cmr") ("script" . "cmr") ("large" . "cmbx") ("Large" . "cmbx") ("mark" . "feta-nummer") + ("finger" . "feta-nummer") + ("timesig" . "feta-nummer") ("number" . "feta-nummer") ("volta" . "feta-nummer")) ) @@ -197,17 +201,6 @@ ) (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) @@ -298,7 +291,11 @@ (string-append "% " s)) (define (end-output) - "\n\\EndLilyPondOutput") + (begin + (display (gc-stats)) + (string-append "\n\\EndLilyPondOutput" + ; Put GC stats here. + ))) (define (experimental-on) "") @@ -905,7 +902,7 @@ 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") @@ -924,31 +921,7 @@ (define (scm-as-output) (eval (as-scm 'all-definitions))) - -; Russ McManus, -; -; 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) @@ -964,6 +937,7 @@ ("|s" . (nil . "|")) ("|:" . ("|" . "|:")) ("|." . ("|." . nil)) + (".|" . (nil . ".|")) (":|" . (":|" . nil)) ("||" . ("||" . nil)) (".|." . (".|." . nil)) @@ -980,13 +954,14 @@ ) -(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) + ) + )