j@310: (cl:in-package #:amuse-midi-db)
j@310: 
j@310: (defmethod get-composition ((identifier midi-db-composition-identifier))
j@310:   (let ((database *amuse-database*)) ; Shaddow this to use a different
j@310: 				     ; database (for debugging).
j@310:     (destructuring-bind (collection-id filename timebase start
j@310: 				       duration owner version
j@310: 				       creation-timestamp
j@310: 				       deletion-timestamp)
j@310: 	(%get-midi-db-composition-header identifier database)
j@310:       (let* ((collection-identifier (make-midi-db-collection-identifier
j@310: 				     collection-id))
j@310: 	     (events (%get-midi-db-events identifier
j@310: 					  collection-identifier
j@310: 					  version timebase database))
j@310: 	     (tempi (%get-midi-db-tempi identifier
j@310: 					collection-identifier version
j@310: 					timebase database))
j@310: 	     (timesigs (%get-midi-db-timesigs identifier
j@310: 					      collection-identifier
j@310: 					      version timebase database))
j@310: 	     (keysigs (%get-midi-db-keysigs identifier
j@310: 					    collection-identifier
j@310: 					    version timebase database)))
j@310: 	(make-midi-db-composition events
j@310: 				  (/ start timebase)
j@310: 				  (/ duration timebase)
j@310: 				  tempi
j@310: 				  timesigs
j@310: 				  keysigs
j@310: 				  identifier
j@310: 				  collection-identifier
j@310: 				  timebase
j@310: 				  filename
j@310: 				  owner
j@310: 				  version
j@310: 				  creation-timestamp
j@310: 				  deletion-timestamp)))))
j@310: 				  
j@310: 
j@310: (defun %get-all-collection-headers ()
j@310:   #.(clsql:locally-enable-sql-reader-syntax)
j@310:   (let ((collection-rows (clsql:select [collection-id]
j@310: 				       [collection-name] [description]
j@310: 				       :from "midi_db_collections"
j@310: 				       :flatp t
j@310: 				       :database *amuse-database*)))
j@310:     #.(clsql:locally-disable-sql-reader-syntax) collection-rows))
j@310: 
j@310: (defun %get-midi-db-composition-header (identifier database)
j@310:   "Basic low-level retrieval of constituents. Just takes an identifier
j@310: and returns a header without any checking of version or deletion
j@310: fields."
j@310:   #.(clsql:locally-enable-sql-reader-syntax)
j@310:   (let ((header-row (car (clsql:select
j@310: 			  [collection-id]
j@310: 			  [filename]
j@310: 			  [timebase]
j@310: 			  [start]
j@310: 			  [duration]
j@310: 			  [owner]
j@310: 			  [version]
j@310: 			  [creation-timestamp]
j@310: 			  [deletion-timestamp]
j@310: 			  :from "midi_db_compositions"
j@310: 			  :where [= [composition-id]
j@310: 			  (composition-id identifier)]
j@310: 			  :flatp t
j@310: 			  :database database))))
j@310:     #.(clsql:locally-disable-sql-reader-syntax)
j@310:     header-row))
j@310: 
j@310: (defun %get-all-collection-composition-headers (collection-identifier)
j@310:   #.(clsql:locally-enable-sql-reader-syntax)
j@310:   (let ((header-rows (clsql:select
j@310: 		      [collection-id]
j@315: 		      [composition-id]
j@310: 		      [filename]
j@310: 		      [timebase]
j@310: 		      [start]
j@310: 		      [duration]
j@310: 		      [owner]
j@310: 		      [version]
j@310: 		      [creation-timestamp]
j@310: 		      [deletion-timestamp]
j@310: 		      :from "midi_db_compositions"
j@310: 		      :where [= [collection-id] (collection-id
j@310: 						 collection-identifier)]
j@310: 		      :flatp t
j@310: 		      :database *amuse-database*)))
j@310:     #.(clsql:locally-disable-sql-reader-syntax)
j@310:     header-rows))
j@310: 
j@310: (defun %get-all-composition-headers ()
j@310:   #.(clsql:locally-enable-sql-reader-syntax)
j@310:   (let ((header-rows (clsql:select
j@310: 		      [collection-id]
j@315: 		      [composition-id]
j@310: 		      [filename]
j@310: 		      [timebase]
j@310: 		      [start]
j@310: 		      [duration]
j@310: 		      [owner]
j@310: 		      [version]
j@310: 		      [creation-timestamp]
j@310: 		      [deletion-timestamp]
j@310: 		      :from "midi_db_compositions"
j@310: 		      :flatp t
j@310: 		      :database *amuse-database*)))
j@310:     #.(clsql:locally-disable-sql-reader-syntax)
j@310:     header-rows))
j@310: 
j@310: (defun %get-midi-db-events (identifier collection-identifier version
j@310: 			    timebase database)
j@310:   (let ((event-rows (clsql:query (concatenate 'string "
j@310: SELECT event_id, track, channel, patch, pitch, velocity, start, duration,
j@310: version
j@310: FROM midi_db_events
j@310: WHERE collection_id = " (princ-to-string (collection-id collection-identifier)) "
j@310: AND composition_id= " (princ-to-string (composition-id identifier)) "
j@310: AND version = " (princ-to-string version))
j@310: 				 :flatp t
j@310: 				 :database database)))
j@310:   (%init-events identifier collection-identifier event-rows timebase)))
j@310: 
j@310: (defun %init-events (identifier collection-identifier event-rows timebase)
j@310:   (loop for event-row in event-rows
j@310:      collecting (init-midi-db-event identifier collection-identifier event-row timebase)
j@310:      into events
j@310:      finally (return events)))
j@310: 
j@310: (defun init-midi-db-event (identifier collection-identifier event-row timebase)
j@310:   (destructuring-bind (event-id track channel patch pitch velocity
j@310: 				start duration version)
j@310:       event-row
j@310:     (if (= channel 10)
j@310: 	(make-midi-db-percussive-event (collection-id collection-identifier)
j@310: 				       (composition-id identifier)
j@310: 				       event-id track channel patch
j@310: 				       pitch velocity
j@310: 				       (/ start timebase)
j@310: 				       (/ duration timebase) version)
j@310: 	(make-midi-db-pitched-event (collection-id collection-identifier)
j@310: 				    (composition-id identifier)
j@310: 				    event-id track channel patch pitch
j@310: 				    velocity (/ start timebase)
j@310: 				    (/ duration timebase) version))))
j@310: 
j@310: (defun %get-midi-db-tempi (identifier collection-identifier version
j@310: 			   timebase database)
j@310:   (declare (ignore version))
j@310:   (let ((tempo-rows (clsql:query (concatenate 'string "
j@310: SELECT start, duration, microsecs_per_crotchet, version
j@310: FROM midi_db_tempi
j@310: WHERE collection_id = " (princ-to-string (collection-id collection-identifier)) "
j@310: AND composition_id = " (princ-to-string (composition-id identifier)))
j@310: ;AND version = " (princ-to-string version))
j@310: 				 :flatp t
j@310: 				 :database database)))
j@310:   (%init-midi-db-tempi tempo-rows timebase)))
j@310: 
j@310: (defun %init-midi-db-tempi (tempo-rows timebase)
j@310:   (loop for tempo-row in tempo-rows
j@310:      collecting (init-midi-db-tempo tempo-row timebase)
j@310:      into tempi
j@310:      finally (return tempi)))
j@310: 
j@310: (defun init-midi-db-tempo (tempo-row timebase)
j@310:   (destructuring-bind (start duration microsecs-per-crotchet version)
j@310:       tempo-row
j@310:     (make-midi-db-tempo (/ start timebase) (/ duration timebase)
j@310: 			microsecs-per-crotchet version)))
j@310: 
j@310: (defun %get-midi-db-timesigs (identifier collection-identifier version
j@310: 			      timebase database)
j@310:   (declare (ignore version))
j@310:   (let ((timesig-rows (clsql:query (concatenate 'string "
j@310: SELECT start, duration, numerator, denominator, version
j@310: FROM midi_db_timesigs
j@310: WHERE collection_id = " (princ-to-string (collection-id collection-identifier)) "
j@310: AND composition_id = " (princ-to-string (composition-id identifier)))
j@310: ;AND version = " (princ-to-string version))
j@310: 				 :flatp t
j@310: 				 :database database)))
j@310:   (%init-midi-db-timesigs timesig-rows timebase)))
j@310: 
j@310: (defun %init-midi-db-timesigs (timesig-rows timebase)
j@310:   (loop for timesig-row in timesig-rows
j@310:      collecting (init-midi-db-timesig timesig-row timebase)
j@310:      into timesigs
j@310:      finally (return timesigs)))
j@310: 
j@310: (defun init-midi-db-timesig (timesig-row timebase)
j@310:   (destructuring-bind (start duration numerator denominator version)
j@310:       timesig-row
j@310:     (make-midi-db-timesig (/ start timebase) (/ duration timebase)
j@310: 			  numerator denominator version)))
j@310: 
j@310: (defun %get-midi-db-keysigs (identifier collection-identifier version
j@310: 			     timebase database)
j@310:   (declare (ignore version))
j@310:   (let ((keysig-rows (clsql:query (concatenate 'string "
j@310: SELECT start, duration, mode, sharp_count, version
j@310: FROM midi_db_keysigs
j@310: WHERE collection_id = " (princ-to-string (collection-id collection-identifier)) "
j@310: AND composition_id = " (princ-to-string (composition-id identifier)))
j@310: ;AND version = " (princ-to-string version))
j@310: 				 :flatp t
j@310: 				 :database database)))
j@310:   (%init-midi-db-keysigs keysig-rows timebase)))
j@310: 
j@310: (defun %init-midi-db-keysigs (keysig-rows timebase)
j@310:   (loop for keysig-row in keysig-rows
j@310:      collecting (init-midi-db-keysig keysig-row timebase)
j@310:      into keysigs
j@310:      finally (return keysigs)))
j@310: 
j@310: (defun init-midi-db-keysig (keysig-row timebase)
j@310:   (destructuring-bind (start duration mode sharp-count version)
j@310:       keysig-row
j@310:     (make-midi-db-keysig (/ start timebase) (/ duration timebase)
j@310: 			  mode sharp-count version)))