comparison implementations/midi-db/db-select-functions.lisp @ 236:a5d065905f6d

Add midi-db.

Ignore-this: c6f4fc32efa4453ddbdc478793eedd52

A basic implementation for working with MIDI files stored in the database.

It is a test case for `versioned' data, but only partially implemented at the moment.

darcs-hash:20100223152703-16a00-4388d2720907d777a1c6c6b3a010885ce0fe06a7.gz

committer: Jamie Forth <[e-mail]>

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