comparison implementations/gsharp/gsharp-import.lisp @ 197:22ac5ec1733c

Basic key and time signature support

 (in-package "AMUSE-GSHARP")
+
+(defun make-gsharp-composition (events buffer timepoint interval &key tempi key-signatures time-signatures)
+  (let ((comp (make-instance 'gsharp-composition :buffer buffer :time timepoint :interval interval
+                             :tempi tempi :key-signatures key-signatures :time-signatures time-signatures)))
+    (sequence:adjust-sequence comp (length events) :initial-contents events)))
 
 (defun last-bar-p (bar)
   ;; I know most of this file is cut-and-pasted, but this is a
   ;; particularly horrible example.
   (eq bar (car (last (gsharp-buffer:bars (gsharp-buffer:slice bar))))))

   (loop for n = note then (find-next-note n)
 	while n
 	sum (gsharp-buffer:duration (gsharp-buffer:cluster n))))
 
 (defun events-from-element (element index time)
-  (when (typep element 'gsharp-buffer:cluster)
-    (mapcar (lambda (note)
-	      (make-instance 'gsharp-pitched-event
-			     :note note
-                 :slice-index index
-			     :number (gsharp-play::midi-pitch note)
-			     :time time
-			     :interval (* 4 (compute-duration note))))
-	    (remove-if #'gsharp-buffer:tie-left (gsharp-buffer:notes element)))))
+  (typecase element
+    (gsharp-buffer:cluster
+     (mapcar (lambda (note)
+               (make-instance 'gsharp-pitched-event
+                              :note note
+                              :slice-index index
+                              :number (gsharp-play::midi-pitch note)
+                              :time time
+                              :interval (* 4 (compute-duration note))))
+             (remove-if #'gsharp-buffer:tie-left (gsharp-buffer:notes element))))
+    (gsharp-buffer:key-signature
+     (list (make-gsharp-key-signature-period element time nil)))
+    (gsharp-buffer::time-signature
+     (list (make-gsharp-time-signature-period element time nil)))))
 
 (defun events-from-bar (bar index time)
   (mapcan (lambda (element)
 	    (prog1 (events-from-element element index time)
 	      (incf time (* 4 (gsharp-buffer:duration element)))))

 		(incf time (* 4 duration))))
 	    (gsharp-buffer:bars slice) durations)))
 
 (defun segment-composition (segment)
   (let* ((slices (mapcar #'gsharp-buffer:body (gsharp-buffer::layers segment)))
-	 (durations (gsharp-play::measure-durations slices))
+         (durations (gsharp-play::measure-durations slices))
          (gsharp-play::*tuning* (gsharp-buffer:tuning segment))
-	 (events (loop for slice in slices
-		       for i from 0
-		       for events = (events-from-slice slice i durations)
-		       then (merge 'list events (events-from-slice slice i durations) 'time<)
-		       finally (return events))))
-    (let* ((duration (* 4 (reduce #'+ durations)))
-	   (result (make-instance 'gsharp-composition 
-				  :buffer (gsharp-buffer:buffer segment)
-				  ;; FIXME: this will break as soon as
-				  ;; gsharp is made to have a sane
-				  ;; divisions value in play.lisp
-				  ;; instead of 25
-				  :tempi (list (make-standard-tempo-period (* 128 (/ (* 4 25) (gsharp-buffer:tempo segment))) 0 duration))
-				  :time 0
-				  :interval duration)))
-      (sequence:adjust-sequence result (length events)
-				:initial-contents events))))
+         (key-signatures (get-initial-keysigs segment)) 
+         (time-signatures)
+         (events (loop for slice in slices
+                    for i from 0
+                    for events = (events-from-slice slice i durations)
+                    then (merge 'list events (events-from-slice slice i durations) 'time<)
+                    finally (return events)))
+         (duration (* 4 (reduce #'+ durations))))
+    (multiple-value-setq (events key-signatures time-signatures)
+      (filter-event-list-for-signatures events key-signatures duration))
+
+    ;; FIXME: TEMPI here will break as soon as gsharp is made to have
+    ;; a sane divisions value in play.lisp instead of 25
+    (make-gsharp-composition events (gsharp::buffer segment) 0 duration
+                             :tempi (list (make-standard-tempo-period (* 128 (/ (* 4 25) (gsharp-buffer:tempo segment))) 
+                                                                      0 duration))
+                             :key-signatures key-signatures
+                             :time-signatures time-signatures)))
+
+(defun filter-event-list-for-signatures (events key-signatures duration)
+  "key-signatures here are initial `staff-level' signatures (what
+  MusicXML calls attributes). MusicXML also has time sigs in the
+  attributes, but GSharp converts them to normal elements."
+  (let ((filtered-events) (time-signatures)
+        (staves-data (mapcar #'(lambda (k)
+                                 (list (gsharp::staff (gsh-source k)) k nil)) 
+                             key-signatures)))
+    (dolist (event events)
+      (typecase event
+        (gsharp-pitched-event (push event filtered-events))
+        (gsharp-key-signature-period 
+         (if (assoc (gsharp::staff (gsh-source event)) staves-data)
+             (let ((data (assoc (gsharp::staff (gsh-source event)) staves-data)))
+               (if (second data)
+                   (setf (duration (second data)) (- (timepoint event) (timepoint (second data)))
+                         (second data) event)
+                   (setf (second data) event)))
+             (acons (gsharp::staff (gsh-source event)) (list event nil) staves-data))
+         (push event key-signatures))
+        (gsharp-time-signature-period 
+         (if (assoc (gsharp::staff (gsh-source event)) staves-data)
+             (let ((data (assoc (gsharp::staff (gsh-source event)) staves-data)))
+               (if (third data)
+                   (setf (duration (third data)) (- (timepoint event) (timepoint (third data)))
+                         (third data) event)
+                   (setf (third data) event)))
+             (acons (gsharp::staff (gsh-source event)) (list nil event) staves-data))
+         (push event time-signatures))))
+    (loop for item in staves-data
+       when (second item)
+       do (setf (duration (second item)) duration)
+       when (third item)
+       do (setf (duration (third item)) duration))
+    (values (reverse filtered-events) (reverse key-signatures) (reverse time-signatures))))
+
+(defun get-initial-keysigs (segment)
+  (let ((staves (remove-duplicates
+                 (loop for layer in (gsharp::layers segment)
+                    nconc (gsharp::staves layer)))))
+    (loop for staff in staves
+       collect (make-gsharp-key-signature-period (gsharp::keysig staff) 0 nil))))
 
 #|
 
 (in-package :clim-user)