2002-09-21 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+ * scm/lily.scm: reorganisation, cleanups.
+
* lily/main.cc: small cleanups.
2002-09-20 Han-Wen Nienhuys <hanwen@cs.uu.nl>
SCM ly_module_symbols (SCM mod);
void ly_reexport_module (SCM mod);
inline bool ly_module_p (SCM x) { return SCM_MODULEP(x); }
+void ly_clear_anonymous_modules ();
#endif /* LY_MODULES_HH */
{\
scm_c_define_gsubr (FUNCNAME, 1, 0, 0, (Scheme_function_unknown) CL::smob_p);\
ly_add_function_documentation (FUNCNAME, "(SCM x)", "Check if @var{x} is a " #CL " object");\
+ scm_c_export (FUNCNAME, NULL);\
}\
ADD_SCM_INIT_FUNC (init_type_ ## CL, init_type_ ## CL)
header_ = SCM_EOL;
global_input_file =0;
+
+ ly_clear_anonymous_modules();
}
+
Input_file_results* global_input_file;
Input_file_results::Input_file_results (String init_string, String file_string)
#include "string.hh"
#include "lily-guile.hh"
#include "ly-modules.hh"
+#include "protected-scm.hh"
+
#define FUNC_NAME __FUNCTION__
static int module_count;
scm_c_use_module ("lily");
}
+Protected_scm anon_modules;
+
SCM
ly_make_anonymous_module ()
{
String s = "*anonymous-ly-" + to_string (module_count++) + "*";
SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
+
+ anon_modules = scm_cons (mod, anon_modules);
return mod;
}
+void
+ly_clear_anonymous_modules ()
+{
+ SCM s = anon_modules;
+ anon_modules = SCM_EOL;
+
+ for (; gh_pair_p (s) ; s = gh_cdr (s))
+ {
+ scm_vector_fill_x (SCM_MODULE_OBARRAY(gh_car(s)), SCM_EOL);
+ }
+}
+
+#define FUNC_NAME __FUNCTION__
+
void
ly_copy_module_variables (SCM dest, SCM src)
{
- #define FUNC_NAME __FUNCTION__
SCM_VALIDATE_MODULE (1, src);
SCM obarr= SCM_MODULE_OBARRAY(src);
scaled_fonts_ = scm_list_copy (s.scaled_fonts_);
scope_= ly_make_anonymous_module ();
- ly_copy_module_variables (scope_, s.scope_);
+ if (ly_module_p (s.scope_))
+ ly_copy_module_variables (scope_, s.scope_);
}
IMPLEMENT_SMOBS (Music_output_def);
-
IMPLEMENT_DEFAULT_EQUAL_P (Music_output_def);
SCM
scopes_ = SCM_EOL;
add_scope(ly_make_anonymous_module());
+ errorlevel_ =0;
main_input_b_ = false;
}
ADD_INTERFACE (Note_head,"note-head-interface",
"Note head",
- "accidental-grob style stem-attachment-function");
+ "glyph-name-procedure accidental-grob style stem-attachment-function");
for (int i=0; i < s.defs_.size (); i++)
defs_.push (s.defs_[i]->clone ());
errorlevel_ = s.errorlevel_;
+
header_ = ly_make_anonymous_module ();
- ly_copy_module_variables (header_, s.header_);
+ if (ly_module_p (s.header_))
+ ly_copy_module_variables (header_, s.header_);
}
Score::~Score ()
((end 1 16 12 8) . ,(make-moment 3 8))
((end 1 32 12 8) . ,(make-moment 1 8))
))
-
-;;; Users may override in most cases, simply by issuing
-;;;
-;;; % from here on consider ending beam every 1 4 note
-;;; \property Voice.autoBeamSettings \override #'(end * * * *) = #(make-moment 1 4)
-;;;
-;;; % no autobeaming
-;;; \property Voice.beamAuto = ##f
-;;;
-;;; or, more globally, by doing:
-;;;
-;;; \paper{
-;;; \translator{
-;;; \VoiceContext
-;;; % consider ending beam at every 1 2 note
-;;; autoBeamSettings \override #'(end * * * *) = #(make-moment 1 2)
-;;; }
-;;; }
-;;;
-;;; see also input test auto-beam-override.ly
-
; Definition of backend properties (aka. element properties).
-;; See documentation of Item::visibility_lambda_
-(define-public (begin-of-line-visible d) (if (= d 1) '(#f . #f) '(#t . #t)))
-(define-public (end-of-line-visible d) (if (= d -1) '(#f . #f) '(#t . #t)))
-(define-public (spanbar-begin-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
-
-(define-public (all-visible d) '(#f . #f))
-(define-public (all-invisible d) '(#t . #t))
-(define-public (begin-of-line-invisible d) (if (= d 1) '(#t . #t) '(#f . #f)))
-(define-public (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; Bar lines.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;
-; How should a bar line behave at a break?
-;
-;; Why prepend `default-' to every scm identifier?
-(define-public (default-break-barline glyph dir)
- (let ((result (assoc glyph
- '((":|:" . (":|" . "|:"))
- ("||:" . ("||" . "|:"))
- ("|" . ("|" . ()))
- ("||:" . ("||" . "|:"))
- ("|s" . (() . "|"))
- ("|:" . ("|" . "|:"))
- ("|." . ("|." . ()))
-
- ;; hmm... should we end with a barline here?
- (".|" . ("|" . ".|"))
- (":|" . (":|" . ()))
- ("||" . ("||" . ()))
- (".|." . (".|." . ()))
- ("" . ("" . ""))
- ("empty" . (() . ()))
- ("brace" . (() . "brace"))
- ("bracket" . (() . "bracket"))
- )
- )))
-
- (if (equal? result #f)
- (ly-warn (string-append "Unknown bar glyph: `" glyph "'"))
- (index-cell (cdr result) dir))
- )
- )
-
)
mol))
-
-
-
(define (brew-bass-figure grob)
"Make a molecule for a Figured Bass grob"
(let* (
)
)
-
-
(define (brew-complete-figure grob figs mol)
"recursive function: take some stuff from FIGS, and add it to MOL."
(define (end-bracket? fig)
;;
;; width in staff space.
;;
-(define (default-beam-flag-width-function type)
+(define (beam-flag-width-function type)
(cond
((eq? type 1) 1.98)
((eq? type 1) 1.65) ;; FIXME: check what this should be and why
;;; Note: this file can't be used without LilyPond executable
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; type predicates.
(define-public (number-pair? x)
(and (pair? x)
(number? (car x)) (number? (cdr x))))
(define-public (scheme? x) #t)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
(define type-p-name-alist
`(
(,dir? . "direction")
))
+
(define (match-predicate obj alist)
(if (null? alist)
"Unknown type"
)
))
-(define (object-type obj)
+(define-public (object-type obj)
(match-predicate obj type-p-name-alist))
-(define (type-name predicate)
+(define-public (type-name predicate)
(let ((entry (assoc predicate type-p-name-alist)))
(if (pair? entry) (cdr entry)
"unknown"
)))
-
-(define (uniqued-alist alist acc)
- (if (null? alist) acc
- (if (assoc (caar alist) acc)
- (uniqued-alist (cdr alist) acc)
- (uniqued-alist (cdr alist) (cons (car alist) acc)))))
-
-
-;; used in denneboom.ly
-(define (cons-map f x)
- (cons (f (car x)) (f (cdr x))))
-
-;; used where?
-(define (reduce operator list)
- "reduce OP [A, B, C, D, ... ] =
- A op (B op (C ... ))
-"
- (if (null? (cdr list)) (car list)
- (operator (car list) (reduce operator (cdr list)))))
-
-
-
-(define (take-from-list-until todo gathered crit?)
- "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
-is the first to satisfy CRIT "
- (if (null? todo)
- (cons gathered todo)
- (if (crit? (car todo))
- (cons (cons (car todo) gathered) (cdr todo))
- (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
- )
- ))
-; test:
-; (take-from-list-until '(1 2 3 4 5) '() (lambda (x) (eq? x 3)))
-; ((3 2 1) 4 5)
-
-
-
-; Make a function that checks score element for being of a specific type.
-(define-public (make-type-checker symbol)
- (lambda (elt)
- ;;(display symbol)
- ;;(eq? #t (ly-get-grob-property elt symbol))
- (not (eq? #f (memq symbol (ly-get-grob-property elt 'interfaces))))))
-
-
-(define (index-cell cell dir)
- (if (equal? dir 1)
- (cdr cell)
- (car cell)))
-
-(define-public (repeat-name-to-ctor name)
- (let*
- ((supported-reps
- `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor)
- (start-moment-function . ,Repeated_music::first_start)
- (length . ,Repeated_music::volta_music_length)))
-
- ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor)
- (start-moment-function . ,Repeated_music::first_start)
- (length . ,Repeated_music::unfolded_music_length)))
- ("fold" . ((iterator-ctor . ,Folded_repeat_iterator::constructor)
- (start-moment-function . ,Repeated_music::minimum_start)
- (length . ,Repeated_music::folded_music_length)))
- ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor)
- (start-moment-function . ,Repeated_music::first_start)
- (length . ,Repeated_music::unfolded_music_length)))
- ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor)
- (start-moment-function . ,Repeated_music::first_start)
-
- ;; the length of the repeat is handled by shifting the note logs
- (length . ,Repeated_music::folded_music_length)))))
-
- (handle (assoc name supported-reps)))
-
- (if (pair? handle)
- (cdr handle)
- (begin
- (ly-warn
- (string-append "Unknown repeat type `" name "'\nSee scm/c++.scm for supported repeats"))
- '(type . 'repeated-music)))))
;; TODO
+
+;; Ugh : naming chord::... ; this is scheme not C++
;;
;; * easier tweakability:
;; - split chord::names-alists up into logical bits,
;;
;; * doc strings
-(define chord::names-alist-banter '())
+(define-public chord::names-alist-banter '())
(set! chord::names-alist-banter
(append
'(
(+ (* (car pitch) 7) (cadr pitch)))
(define (chord::text? text)
- (not (or (not text) (empty? text) (unspecified? text))))
+ (not (or (not text) (null? text) (unspecified? text))))
;; FIXME: remove need for me, use text-append throughout
(define (chord::text-cleanup dirty)
l
(if (not (chord::text? l))
r
- (if (empty? (cdr r))
+ (if (null? (cdr r))
(list 'columns l (car r))
(text-append (list 'columns l (car r)) (cdr r))))))
(!= 0 a)))))
steps))
(highest (let ((h (car (last-pair steps))))
- (if (and (not (empty? h))
+ (if (and (not (null? h))
(or (> 4 (cadr h))
(!= 0 (caddr h))))
(list (list h))
(list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
#f))
-(define (chord::name-banter tonic exception-part unmatched-steps
+(define-public (chord::name-banter tonic exception-part unmatched-steps
bass-and-inversion steps)
(let ((additions (chord::additions unmatched-steps))
(subtractions (chord::subtractions unmatched-steps)))
* list all steps that are below an chromatically altered step
"
(text-append
- (if (not (empty? subtractions)) "add" '())
+ (if (not (null? subtractions)) "add" '())
(let ((radds (reverse additions)))
(reverse (chord::additions>5->text-jazz-helper
radds
subtractions
- (if (or (empty? subtractions) (empty? radds))
+ (if (or (null? subtractions) (null? radds))
#f (car radds)))))))
(define (chord::additions>5->text-jazz-helper additions subtractions list-step)
(define (chord::get-create-step steps n)
(let* ((i (if (< n 0) (+ n 7) n))
(found (filter-list (lambda (x) (= i (cadr x))) steps)))
- (if (empty? found)
+ (if (null? found)
(if (!= i 6)
(list 0 i 0)
(list 0 6 -1))
;; todo: move this to engraver-init.ly
-(define context-description-alist
+(define-public context-description-alist
'(
(Grace . "
DEPRECATED; this is a 1.4 construct.
;;;; changed eval to primitive-eval for guile 1.4/1.4.1 compatibility --jcn
-(define drum-pitch-names `(
+;; ugh. Should make separate module?
+(define-public drum-pitch-names `(
(acousticbassdrum bda ,(make-pitch -3 6 0 ))
(bassdrum bd ,(make-pitch -2 0 0 ))
(hisidestick ssh ,(make-pitch -3 6 2))
(fivedown de ,(make-pitch -1 2 0))
))
-(define drums `(
+(define-public drums `(
(acousticbassdrum default #f ,(make-pitch -1 4 0))
(bassdrum default #f ,(make-pitch -1 4 0))
(sidestick cross #f ,(make-pitch 0 1 0))
(ridecymbalb cross #f ,(make-pitch 0 5 0))
))
-(define timbales `(
+(define-public timbales `(
(losidestick cross #f ,(make-pitch -1 6 0))
(lotimbale default #f ,(make-pitch -1 6 0))
(cowbell triangle #f ,(make-pitch 0 2 0))
(hitimbale default #f ,(make-pitch 0 1 0))
))
-(define congas `(
+(define-public congas `(
(losidestick cross #f ,(make-pitch -1 6 0))
(loconga default #f ,(make-pitch -1 6 0))
(openloconga default "open" ,(make-pitch -1 6 0))
))
-(define bongos `(
+(define-public bongos `(
(losidestick cross #f ,(make-pitch -1 6 0))
(lobongo default #f ,(make-pitch -1 6 0))
(openlobongo default "open" ,(make-pitch -1 6 0))
))
-(define percussion `(
+(define-public percussion `(
(opentriangle cross "open" ,(make-pitch 0 0 0))
(mutetriangle cross "stopped" ,(make-pitch 0 0 0))
(triangle cross #f ,(make-pitch 0 0 0))
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;
+;;
(define (make-articulation-script x)
(let* ( (m (ly-make-music "Articulation_req"))
(define (make-head-type-elem t)
(let* ( (m (ly-make-music "Music"))
)
- (ly-set-mus-property! m 'iterator-ctor Push_property_iterator::constructor)
- (ly-set-mus-property! m 'symbol 'NoteHead)
- (ly-set-mus-property! m 'grob-property 'style)
- (ly-set-mus-property! m 'grob-value t)
- (ly-set-mus-property! m 'pop-first #t)
- m
+ (set-mus-properties!
+ m
+ `((iterator-ctor . ,Push_property_iterator::constructor)
+ (symbol . NoteHead)
+ (grob-property . style)
+ (grob-value . ,t)
+ (pop-first . #t)))
+ m
)
)
(define (make-head-type t)
- (let* ( (m (ly-make-music "Context_specced_music"))
- (e (make-head-type-elem t))
- )
- (ly-set-mus-property! m 'element e)
- (ly-set-mus-property! m 'context-type "Thread")
- m
- )
- )
+ (context-spec-music (make-head-type-elem t) "Thread"))
(define (make-thread-context thread-name element)
- (let* ( (m (ly-make-music "Context_specced_music")))
- (ly-set-mus-property! m 'element element)
- (ly-set-mus-property! m 'context-type "Thread")
- (ly-set-mus-property! m 'context-id (symbol->string thread-name))
- m
- )
- )
+ (context-spec-music element "Thread" thread-name))
;; makes a sequential-music of thread-context, head-change and note
(define (make-drum-head kit req-ch )
;; converts a midi-pitched (ly/drumpitch.ly) file to paper output.
-(define ((drums->paper kit) music)
+(define-public ((drums->paper kit) music)
(begin
(if (equal? (ly-music-name music) "Request_chord")
(set! music (make-drum-head kit music))
;;
;; (font-relative-size font-series font-shape font-family
;; font-design-size)
+
(define paper20-style-sheet-alist
'(
;; why are font file names strings, not symbols?
(outer-stem-length-limit . 0.2)
(slope-limit . 0.2)
- (flag-width-function . ,default-beam-flag-width-function)
+ (flag-width-function . ,beam-flag-width-function)
(damping . 1)
(auto-knee-gap . 5.5)
(font-name . "cmr10")
-(define all-backend-properties '())
+(define-public all-backend-properties '())
(define (grob-property-description symbol type? description)
(if (not (equal? (object-property symbol 'backend-doc) #f))
;;; Library functions
-; (top-repl)
-
(use-modules (ice-9 regex))
-; (use-modules (lily))
-
-;;(display "hallo\n")
-;;(display (make-duration 1 2))
-;;(write standalone (current-error-port))
-
;;; General settings
;; debugging evaluator is slower.
(read-enable 'positions)
-(define-public security-paranoia #f)
(define-public (line-column-location line col file)
"Print an input location, including column number ."
;; cpp hack to get useful error message
(define ifdef "First run this through cpp.")
(define ifndef "First run this through cpp.")
-
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define X 0)
+(define Y 1)
+(define LEFT -1)
+(define RIGHT 1)
+(define UP 1)
+(define DOWN -1)
+(define CENTER 0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; lily specific variables.
(define-public default-script-alist '())
+(define-public security-paranoia #f)
(if (not (defined? 'standalone))
- (define standalone (not (defined? 'ly-gulp-file))))
+ (define-public standalone (not (defined? 'ly-gulp-file))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Unassorted utility functions.
+
+(define (uniqued-alist alist acc)
+ (if (null? alist) acc
+ (if (assoc (caar alist) acc)
+ (uniqued-alist (cdr alist) acc)
+ (uniqued-alist (cdr alist) (cons (car alist) acc)))))
+
+(define (other-axis a)
+ (remainder (+ a 1) 2))
+
+
+(define-public (widen-interval iv amount)
+ (cons (- (car iv) amount)
+ (+ (cdr iv) amount))
+)
-;; The regex module may not be available, or may be broken.
-(define-public use-regex
- (let ((os (string-downcase (vector-ref (uname) 0))))
- (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
+(define (index-cell cell dir)
+ (if (equal? dir 1)
+ (cdr cell)
+ (car cell)))
-;;; Un-assorted stuff
+(define (cons-map f x)
+ "map F to contents of X"
+ (cons (f (car x)) (f (cdr x))))
-;; URG guile-1.4/1.4.x compatibility
-(if (not (defined? 'primitive-eval))
- (define (primitive-eval form)
- (eval2 form #f)))
+;; used where?
+(define (reduce operator list)
+ "reduce OP [A, B, C, D, ... ] =
+ A op (B op (C ... ))
+"
+ (if (null? (cdr list)) (car list)
+ (operator (car list) (reduce operator (cdr list)))))
+
+(define (take-from-list-until todo gathered crit?)
+ "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
+is the first to satisfy CRIT
+
+ (take-from-list-until '(1 2 3 4 5) '() (lambda (x) (eq? x 3)))
+=>
+ ((3 2 1) 4 5)
+
+"
+ (if (null? todo)
+ (cons gathered todo)
+ (if (crit? (car todo))
+ (cons (cons (car todo) gathered) (cdr todo))
+ (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
+ )
+ ))
(define (sign x)
(if (= x 0)
(newline)
x)
-(define (empty? x)
- (equal? x '()))
-
(define (!= l r)
(not (= l r)))
(uniqued-alist (cdr alist) acc)
(uniqued-alist (cdr alist) (cons (car alist) acc)))))
-(define (uniq-list list)
+(define-public (uniq-list list)
(if (null? list) '()
(if (null? (cdr list))
list
(uniq-list (cdr list))
(cons (car list) (uniq-list (cdr list)))))))
-(define (alist<? x y)
+(define-public (alist<? x y)
(string<? (symbol->string (car x))
(symbol->string (car y))))
+(define-public (pad-string-to str wid)
+ (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
+ )
+
(define (ly-load x)
(let* ((fn (%search-load-path x)))
(if (ly-verbose)
(primitive-load fn)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; output
(use-modules (scm tex)
(scm ps)
(scm pysk)
("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
))
-(define (pad-string-to str wid)
- (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
- )
(define (document-format-dumpers)
(map
(scm-error "Could not find dumper for format ~s" format))
))
-(define X 0)
-(define Y 1)
-(define LEFT -1)
-(define RIGHT 1)
-(define UP 1)
-(define DOWN -1)
-(define CENTER 0)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; other files.
(if (not standalone)
(map ly-load
-(define (stack-molecules axis dir padding mols)
+(define-public (stack-molecules axis dir padding mols)
"Stack molecules MOLS in direction AXIS,DIR, using PADDING."
(if (null? mols)
'()
-(define (fontify-text font-metric text)
+(define-public (fontify-text font-metric text)
"Set TEXT with font FONT-METRIC, returning a molecule."
(let* ((b (ly-text-dimension font-metric text)))
(ly-make-molecule
(ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b))
))
-(define (other-axis a)
- (remainder (+ a 1) 2))
-
-(define (bracketify-molecule mol axis thick protusion padding)
+(define-public (bracketify-molecule mol axis thick protusion padding)
"Add brackets around MOL, producing a new molecule."
(let* (
-(define (box-molecule xext yext)
+(define-public (box-molecule xext yext)
"Make a filled box."
(ly-make-molecule
xext yext)
)
-(define (widen-interval iv amount)
- (cons (- (car iv) amount)
- (+ (cdr iv) amount))
-)
-
-
-(define (box-grob-molecule grob)
+(define-public (box-grob-molecule grob)
"Make a box of exactly the extents of the grob. The box precisely
encloses the contents.
"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; tuplets.
(define-public (denominator-tuplet-formatter mus)
(number->string (ly-get-mus-property mus 'denominator)))
":"
(number->string (ly-get-mus-property mus 'denominator))
))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; repeats.
+
+(define-public (repeat-name-to-ctor name)
+ (let*
+ ((supported-reps
+ `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor)
+ (start-moment-function . ,Repeated_music::first_start)
+ (length . ,Repeated_music::volta_music_length)))
+
+ ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor)
+ (start-moment-function . ,Repeated_music::first_start)
+ (length . ,Repeated_music::unfolded_music_length)))
+ ("fold" . ((iterator-ctor . ,Folded_repeat_iterator::constructor)
+ (start-moment-function . ,Repeated_music::minimum_start)
+ (length . ,Repeated_music::folded_music_length)))
+ ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor)
+ (start-moment-function . ,Repeated_music::first_start)
+ (length . ,Repeated_music::unfolded_music_length)))
+ ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor)
+ (start-moment-function . ,Repeated_music::first_start)
+
+ ;; the length of the repeat is handled by shifting the note logs
+ (length . ,Repeated_music::folded_music_length)))))
+
+ (handle (assoc name supported-reps)))
+
+ (if (pair? handle)
+ (cdr handle)
+ (begin
+ (ly-warn
+ (string-append "Unknown repeat type `" name "'\nSee scm/c++.scm for supported repeats"))
+ '(type . 'repeated-music)))))
+
(define-public (unfold-repeats music)
"
This function replaces all repeats with unfold repeats. It was
music))
-;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;
-
-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; property setting music objs.
(define-public (make-grob-property-set grob gprop val)
"Make a M-exp that sets GPROP to VAL in GROBS. Does a pop first, i.e.
this is not an override
m
))
+(define-public (set-mus-properties! m alist)
+ (if (pair? alist)
+ (begin
+ (ly-set-mus-property! m (caar alist) (cdar alist))
+ (set-mus-properties! m (cdr alist)))
+ ))
+
(define-public (music-separator? m)
"Is M a separator."
(let* ((n (ly-get-mus-property m 'name )))
))
(define (split-list l sep?)
+ "
+
+(display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
+=>
+ ...
+
+"
(if (null? l)
'()
(let* ((c (split-one sep? l '())))
)
)
-;; test code
-; (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
-
-
;;; splitting chords into voices.
(define (voicify-list lst number)
;;;
-;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;
+; Make a function that checks score element for being of a specific type.
+(define-public (make-type-checker symbol)
+ (lambda (elt)
+ ;;(display symbol)
+ ;;(eq? #t (ly-get-grob-property elt symbol))
+ (not (eq? #f (memq symbol (ly-get-grob-property elt 'interfaces))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; warn for bare chords at start.
(define (has-request-chord elts)
(reduce (lambda (x y) (or x y)) (map (lambda (x) (equal? (ly-music-name x)
)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; switch it on here, so parsing and init isn't checked (too slow!)
+;; automatic music transformations.
+
(define (switch-on-debugging m)
(set-debug-cell-accesses! 15000)
m
; switch-on-debugging
))
+
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
-(define all-music-properties '())
+(define-public all-music-properties '())
(define (music-property-description symbol type? description)
(if (not (equal? #f (object-property symbol 'music-doc)))
(define ((every-nth-bar-number-visible n) barnum) (= 0 (modulo barnum n)))
(define-public (default-bar-number-visibility barnum) (> barnum 1))
+
+;; See documentation of Item::visibility_lambda_
+(define-public (begin-of-line-visible d) (if (= d 1) '(#f . #f) '(#t . #t)))
+(define-public (end-of-line-visible d) (if (= d -1) '(#f . #f) '(#t . #t)))
+(define-public (spanbar-begin-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
+
+(define-public (all-visible d) '(#f . #f))
+(define-public (all-invisible d) '(#t . #t))
+(define-public (begin-of-line-invisible d) (if (= d 1) '(#t . #t) '(#f . #f)))
+(define-public (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Bar lines.
+
+;
+; How should a bar line behave at a break?
+;
+;; Why prepend `default-' to every scm identifier?
+(define-public (default-break-barline glyph dir)
+ (let ((result (assoc glyph
+ '((":|:" . (":|" . "|:"))
+ ("||:" . ("||" . "|:"))
+ ("|" . ("|" . ()))
+ ("||:" . ("||" . "|:"))
+ ("|s" . (() . "|"))
+ ("|:" . ("|" . "|:"))
+ ("|." . ("|." . ()))
+
+ ;; hmm... should we end with a barline here?
+ (".|" . ("|" . ".|"))
+ (":|" . (":|" . ()))
+ ("||" . ("||" . ()))
+ (".|." . (".|." . ()))
+ ("" . ("" . ""))
+ ("empty" . (() . ()))
+ ("brace" . (() . "brace"))
+ ("bracket" . (() . "bracket"))
+ )
+ )))
+
+ (if (equal? result #f)
+ (ly-warn (string-append "Unknown bar glyph: `" glyph "'"))
+ (index-cell (cdr result) dir))
+ )
+ )
+
(ice-9 regex)
(ice-9 string-fun)
)
-
-
(define font-name-alist '())
(define this-module (current-module))
;;
(define (output-tex-string s)
(if security-paranoia
- (if use-regex
- (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
- (begin (display "warning: not paranoid") (newline) s))
+ (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
s))
(define (lily-def key val)
(let ((tex-key
- (if use-regex
- (regexp-substitute/global
- #f "_" (output-tex-string key) 'pre "X" 'post)
- (output-tex-string key)))
+ (regexp-substitute/global
+ #f "_" (output-tex-string key) 'pre "X" 'post)
+
+ ))
(tex-val (output-tex-string val)))
(if (equal? (sans-surrounding-whitespace tex-val) "")
(string-append "\\let\\" tex-key "\\undefined\n")
- (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
+ (string-append "\\def\\" tex-key "{" tex-val "}\n")))
(define (number->dim x)
(string-append
"\\special{\\string! "
;; URG: ly-gulp-file: now we can't use scm output without Lily
- (if use-regex
- ;; fixed in 1.3.4 for powerpc -- broken on Windows
- (regexp-substitute/global #f "\n"
+ (regexp-substitute/global #f "\n"
(ly-gulp-file "music-drawing-routines.ps") 'pre " %\n" 'post)
- (ly-gulp-file "music-drawing-routines.ps"))
-; (if (defined? 'ps-testing) "/testing true def%\n" "")
"}"
"\\input lilyponddefs \\outputscale=\\lilypondpaperoutputscale \\lilypondpaperunit"
"\\turnOnPostScript"))
;;
(define-public (output-tex-string s)
(if security-paranoia
- (if use-regex
- (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
- (begin (display "warning: not paranoid") (newline) s))
+ (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
s))
(define (lily-def key val)
(let ((tex-key
- (if use-regex
- ;; fixed in 1.3.4 for powerpc -- broken on Windows
- (regexp-substitute/global
- #f "_" (output-tex-string key) 'pre "X" 'post)
- (output-tex-string key)))
+ (regexp-substitute/global
+ #f "_" (output-tex-string key) 'pre "X" 'post))
+
(tex-val (output-tex-string val)))
(if (equal? (sans-surrounding-whitespace tex-val) "")
(string-append "\\let\\" tex-key "\\undefined\n")
- (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
+ (string-append "\\def\\" tex-key "{" tex-val "}\n"))
+ )
+ )
+
(define (number->dim x)
(string-append
-(define all-translation-properties '())
+(define-public all-translation-properties '())
(define (translator-property-description symbol type? description)
(if (not (equal? #f (object-property symbol 'translation-doc)))
projects / lilypond.git / commitdiff