1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
;;;; stream-event-classes.scm -- define the tree of stream-event classes.
;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
(use-modules (srfi srfi-1))
;; Event class hierarchy. Each line is on the form ((List of children) . Parent)
(define event-classes
'(((StreamEvent) . '())
((RemoveContext ChangeParent Override Revert UnsetProperty
SetProperty MusicEvent OldMusicEvent CreateContext Prepare
OneTimeStep Finish) . StreamEvent)
((arpeggio-event
beam-event note-event absolute-dynamic-event
key-change-event lyric-event pedal-event slur-event tie-event
metronome-change-event span-dynamic-event)
. MusicEvent)
((decrescendo-event crescendo-event) . span-dynamic-event)
((sostenuto-event sustain-event una-corda-event) . pedal-event)
((Announcement) . '())
((AnnounceNewContext) . Announcement)
))
;; Maps event-class to a list of ancestors (inclusive)
;; TODO: use resizable hash
(define ancestor-lookup (make-hash-table 1))
;; Each class will be defined as
;; (class parent grandparent .. )
;; so that (eq? (cdr class) parent) holds.
(for-each
(lambda (rel)
(for-each
(lambda (type)
(hashq-set! ancestor-lookup type (cons type (hashq-ref ancestor-lookup (cdr rel) '())))) ;; `(define ,type (cons ',type ,(cdr rel)))))
(car rel)))
event-classes)
;; TODO: Allow entering more complex classes, by taking unions.
(define-public (ly:make-event-class leaf)
(hashq-ref ancestor-lookup leaf))
;; (primitive-eval leaf))
(defmacro-public make-stream-event (expr)
(Stream_event::undump (primitive-eval (list 'quasiquote expr))))
(define* (simplify e)
(cond
;; Special case for lists reduces stack consumption.
((list? e) (map simplify e))
((pair? e) (cons (simplify (car e))
(simplify (cdr e))))
((ly:stream-event? e)
(list 'unquote `(make-stream-event ,(simplify (Stream_event::dump e)))))
((ly:music? e)
(list 'unquote (music->make-music e)))
((ly:moment? e)
(list 'unquote `(ly:make-moment
,(ly:moment-main-numerator e)
,(ly:moment-main-denominator e)
. ,(if (eq? 0 (ly:moment-grace-numerator e))
'()
(list (ly:moment-grace-numerator e)
(ly:moment-grace-denominator e))))))
((ly:duration? e)
(list 'unquote `(ly:make-duration
,(ly:duration-log e)
,(ly:duration-dot-count e)
,(car (ly:duration-factor e))
,(cdr (ly:duration-factor e)))))
((ly:pitch? e)
(list 'unquote `(ly:make-pitch
,(ly:pitch-octave e)
,(ly:pitch-notename e)
,(ly:pitch-alteration e))))
((ly:input-location? e)
(list 'unquote '(ly:dummy-input-location)))
(#t e)))
(define-public (ly:simplify-scheme e)
(list 'quasiquote (simplify e))
)
; used by lily/dispatcher.cc
(define-public (car< a b) (< (car a) (car b)))
|
