changeset 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]>

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/amuse-midi-db.asd	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,21 @@
+(asdf:defsystem amuse-midi-db
+  :name "amuse-midi-db"
+  :description ""
+  :depends-on ("amuse" "amuse-database-admin" "amuse-midi")
+  :components
+  ((:module implementations
+            :components
+            ((:module midi-db
+		      :components
+		      ((:file "package")
+		       (:file "classes" :depends-on ("package"))
+		       (:file "db-insert-functions" :depends-on ("package"
+								 "classes"))
+		       (:file "db-select-functions" :depends-on ("package"
+								 "classes"))
+		       (:file "db-setup" :depends-on ("package"))
+		       (:file "batch-midifiles-db" :depends-on ("package"
+								 "db-insert-functions"
+								 "classes"))
+		       (:file "methods" :depends-on ("classes"))
+		       ))))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/batch-midifiles-db.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,19 @@
+(cl:in-package #:amuse-midi-db)
+
+(defun import-midifiles (path collection-identifier database)
+  "<Path> should be a string or pathname object, which designates a
+  directory containing midifiles to be imported,
+  e.g. '/home/foo/my-midi-files/' (note trailing slash)."
+  (let ((midifile-paths
+	 (append (directory (merge-pathnames path "*.mid*"))
+		 (directory (merge-pathnames path "*.MID*")))))
+    (unless midifile-paths
+      (warn "No midifiles in: ~A" path)
+      (return-from import-midifiles nil))
+    (loop for midifile-path in midifile-paths
+       for i from 1
+       do (import-composition
+	   (get-composition
+	    (make-midifile-identifier midifile-path))
+	   collection-identifier database)
+       finally (format t "~S midifiles added to database.~%" i))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/classes.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,177 @@
+(cl:in-package #:amuse-midi-db)
+
+(defclass midi-db-object (amuse-object) ())
+
+(defclass midi-db-identifier (identifier midi-db-object) ())
+
+(defclass midi-db-collection-identifier (midi-db-identifier)
+  ((collection-id :initarg :collection-id
+		  :accessor collection-id
+		  :initform nil))
+  (:documentation "Class to represent midi-db collection identifiers."))
+
+(defun make-midi-db-collection-identifier (collection-id)
+  (make-instance 'midi-db-collection-identifier
+		 :collection-id collection-id))
+
+(defclass midi-db-composition-identifier (composition-identifier
+					  midi-db-identifier)
+  ((composition-id :reader composition-id
+		   :initarg :composition-id))
+  (:documentation "Class to represent midi-db composition identifiers."))
+
+(defun make-midi-db-composition-identifier (composition-id)
+  (make-instance 'midi-db-composition-identifier
+		 :composition-id composition-id))
+
+(defclass midi-db-composition (midi-composition midi-db-object)
+  ((collection-identifier :initarg :collection-identifier
+			  :reader collection-identifier)
+   (filename :initarg :filename
+	     :reader filename)
+   (owner :initarg :owner
+	  :reader owner)
+   (version :initarg :version
+	    :reader version)
+   (creation-timestamp :initarg :creation-timestamp
+		       :reader creation-timestamp)
+   (deletion-timestamp :initarg :deletion-timestamp
+		       :reader deletion-timestamp))
+  (:documentation "Midi-db class with slots for additional database
+  fields. FIXME: This should perhaps be a subclass of 'versioned
+  constituents'?"))
+
+(defun make-midi-db-composition (events start duration tempi timesigs
+				 keysigs identifier
+				 collection-identifier timebase
+				 filename owner version
+				 creation-timestamp
+				 deletion-timestamp)
+  "Make a midi-db composition. This does not do the usual
+adjust-sequence initialisation (calling
+%recompute-standard-composition-period). FIXME: Is this bad?"
+  (make-instance 'midi-db-composition
+		 :%data events
+		 :time start
+		 :interval duration
+		 :time-signatures timesigs
+		 :tempi tempi
+		 :key-signatures keysigs
+		 :identifier identifier
+		 :collection-identifier collection-identifier
+		 :midi-timebase timebase
+		 :filename filename
+		 :owner owner
+		 :version version
+		 :creation-timestamp creation-timestamp
+		 :deletion-timestamp deletion-timestamp))
+
+(defmethod initialize-instance :after ((composition
+					midi-db-composition) &key)
+  "Initialize each event so that it knows what composition it belongs
+to."
+  (sequence:dosequence (e composition t)
+    (%set-composition composition e)))
+
+(defclass midi-db-event (midi-db-object linked-event)
+  ((collection-identifier :initarg :collection-identifier
+			  :reader collection-identifier)
+   (composition-identifier :initarg :composition-identifier
+			   :reader composition-identifier)
+   (identifier :initarg :identifier
+	       :reader identifier)
+   (version :initarg :version
+	    :reader version)))
+
+(defclass midi-db-pitched-event (midi-pitched-event midi-db-event)
+  ()
+  (:documentation "Midi-db class with slots for additional database
+  fields. FIXME: This should perhaps be a subclass of 'versioned
+  constituents'?"))
+
+(defclass midi-db-percussive-event (midi-percussive-event midi-db-event)
+  ()
+  (:documentation "Midi-db class with slots for additional database
+  fields. FIXME: This should perhaps be a subclass of 'versioned
+  constituents'?"))
+
+(defun make-midi-db-pitched-event (collection-identifier
+				   composition-identifier
+				   event-identifier track channel
+				   patch pitch velocity start duration
+				   version &optional composition)
+  (make-instance 'midi-db-pitched-event
+		 :collection-identifier collection-identifier
+		 :composition-identifier composition-identifier
+		 :identifier event-identifier
+		 :track track
+		 :channel channel
+		 :patch patch
+		 :number pitch
+		 :velocity velocity
+		 :time start
+		 :interval duration
+		 :version version
+		 :composition composition))
+
+(defun make-midi-db-percussive-event (collection-identifier
+				      composition-identifier
+				      event-identifier track channel
+				      patch drum-sound velocity start
+				      duration version &optional
+				      composition)
+  (make-instance 'midi-db-percussive-event
+		 :collection-identifier collection-identifier
+		 :composition-identifier composition-identifier
+		 :identifier event-identifier
+		 :track track
+		 :channel channel
+		 :patch patch
+		 :sound drum-sound
+		 :velocity velocity
+		 :time start
+		 :interval duration
+		 :version version
+		 :composition composition))
+
+(defclass midi-db-tempi (standard-tempo-period midi-db-object)
+  ((version :initarg :version
+	    :reader version))
+  (:documentation "FIXME: subclass versioned constituent"))
+
+(defun make-midi-db-tempo (start duration microsecs-per-crotchet version)
+  (make-instance 'midi-db-tempi
+		 :time start
+		 :interval duration
+		 :bpm (microsecond-per-crotchet-to-bpm
+		       microsecs-per-crotchet)
+		 :version version))
+
+(defclass midi-db-timesig (standard-time-signature-period
+			   midi-db-object)
+  ((version :initarg :version
+	    :reader version))
+  (:documentation "FIXME: subclass versioned constituent"))
+
+(defun make-midi-db-timesig (start duration numerator denominator
+			     version)
+  (make-instance 'midi-db-timesig
+		 :time start
+		 :interval duration
+		 :numerator numerator
+		 :denominator denominator
+		 :version version))
+
+(defclass midi-db-keysig (midi-key-signature-period
+			  midi-db-object)
+  ((version :initarg :version
+	    :reader version))
+  (:documentation "FIXME: subclass versioned constituent"))
+
+(defun make-midi-db-keysig (start duration mode sharp-count version)
+  (make-instance 'midi-db-keysig
+		 :time start
+		 :interval duration
+		 :mode mode
+		 :sharp-count sharp-count
+		 :version version))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/db-insert-functions.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,162 @@
+(cl:in-package #:amuse-midi-db)
+
+(defun register-new-collection (collection-name description database)
+  (clsql:with-transaction (:database database)
+    "Error checking needed for duplicates."
+    #.(clsql:locally-enable-sql-reader-syntax)
+    (clsql:insert-records
+     :into "midi_db_collections"
+     :attributes '([collection-name]
+		   [description])
+     :values (list collection-name description)
+     :database database)
+    #.(clsql:locally-disable-sql-reader-syntax)
+    (make-midi-db-collection-identifier ;return new collection identifier
+     (clsql-mysql::mysql-insert-id
+      (clsql-mysql::database-mysql-ptr
+       database)))))
+
+(defvar *import-file* (pathname "/tmp/midi-db.txt"))
+
+(defun import-composition (composition collection-identifier database)
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (let* ((collection-id (collection-id collection-identifier))
+	 (filename (file-namestring (midifile-identifier-pathname
+				     (identifier composition))))
+	 (timebase (midi-timebase composition))
+	 (start (* (timepoint composition) timebase))
+	 (duration (* (duration composition) timebase))
+	 (composition-id))
+    ;; add composition header
+    (clsql:with-transaction (:database database)
+      (clsql:insert-records :into "midi_db_compositions"
+			    :attributes '([collection-id] [filename]
+					  [timebase] [start] [duration])
+			    :values (list collection-id
+					  filename
+					  timebase
+					  start
+					  duration)
+			    :database database)
+      (setf composition-id (clsql-mysql::mysql-insert-id
+			    (clsql-mysql::database-mysql-ptr
+			     database)))
+      #.(clsql:locally-disable-sql-reader-syntax)
+      ;; add tempo, timesig and keysig constituents
+      (%add-tempo-constituents collection-id composition-id
+			       (tempi composition) timebase database)
+      (%add-timesig-constituents collection-id composition-id
+				 (time-signatures composition)
+				 timebase database)
+      (%add-keysig-constituents collection-id composition-id
+				(key-signatures composition) timebase
+				database)
+      (write-to-db-file collection-id composition-id composition)
+      (clsql:execute-command
+       (concatenate 'string
+		    "LOAD DATA LOCAL INFILE '"
+		    (namestring *import-file*)
+		    "' INTO TABLE "
+		    "midi_db_events")
+       :database database)
+      (delete-file *import-file*)
+      (format t "Composition added to db, id: ~A~%" composition-id))))
+
+
+;;;=====================================================================
+;;; All the below are just helper functions.
+;;;=====================================================================
+
+(defun write-to-db-file (collection-id composition-id composition)
+  (let ((timebase (midi-timebase composition)))
+    (with-open-file (stream *import-file*
+			    :direction :output
+			    :if-exists :supersede
+			    :external-format :latin1)
+      (sequence:dosequence (event composition)
+	(format stream
+		"~S	~S	\\N	~{~S	~}1~%" ; 1 is the
+						       ; version number
+		collection-id composition-id
+		(if (amuse-utils:pitchedp event)
+		    (list (midi-track event)
+			  (midi-channel event)
+			  (midi-patch event)
+			  (midi-pitch-number event)
+			  (midi-velocity event)
+			  (* (timepoint event) timebase)
+			  (* (duration event) timebase))
+		    (list (midi-track event)
+			  (midi-channel event)
+			  0 ;FIXME no patch for perc?
+			  (midi-drum-sound event)
+			  (midi-velocity event)
+			  (* (timepoint event) timebase)
+			  (* (duration event) timebase)))))))
+    t)
+
+;;; FIXME: use macros here.
+
+(defun %add-tempo-constituents (collection-id composition-id tempi timebase
+			       database)
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (loop ;with constituent-id
+     for tempo in tempi
+     do (clsql:insert-records :into "midi_db_tempi"
+			      :attributes '([collection-id]
+					    [composition-id]
+					    [start]
+					    [duration]
+					    [microsecs-per-crotchet])
+			      :values (list collection-id
+					    composition-id
+					    (* (timepoint tempo) timebase)
+					    (* (duration tempo) timebase)
+					    (microseconds-per-crotchet
+					     tempo))
+			      :database database))
+  #.(clsql:locally-disable-sql-reader-syntax))
+
+(defun %add-timesig-constituents (collection-id composition-id timesigs
+				  timebase database)
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (loop for timesig in timesigs
+     do (clsql:insert-records :into "midi_db_timesigs"
+			      :attributes '([collection-id]
+					    [composition-id]
+					    [start]
+					    [duration]
+					    [numerator]
+					    [denominator])
+			      :values (list collection-id
+					    composition-id
+					    (* (timepoint timesig) timebase)
+					    (* (duration timesig) timebase)
+					    (time-signature-numerator
+					     timesig)
+					    (time-signature-denominator
+					     timesig))
+			      :database database))
+  #.(clsql:locally-disable-sql-reader-syntax))
+
+(defun %add-keysig-constituents (collection-id composition-id keysigs
+				 timebase database)
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (loop for keysig in keysigs
+     do (clsql:insert-records :into "midi_db_keysigs"
+			      :attributes '([collection-id]
+					    [composition-id]
+					    [start]
+					    [duration]
+					    [mode]
+					    [sharp-count])
+			      :values (list collection-id
+					    composition-id
+					    (* (timepoint keysig) timebase)
+					    (* (duration keysig) timebase)
+					    (key-signature-mode
+					     keysig)
+					    (key-signature-sharps
+					     keysig))
+			      :database database))
+  #.(clsql:locally-disable-sql-reader-syntax))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/db-select-functions.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,220 @@
+(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)))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/db-setup.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,160 @@
+(cl:in-package #:amuse-midi-db)
+
+;; Creating tables
+
+(defun create-midi-db-tables (database)
+  (%create-midi-collections-table database)
+  (%create-midi-compositions-table database)
+  (%create-midi-events-table database)
+  (%create-midi-tempi-table database)
+  (%create-midi-timesigs-table database)
+  (%create-midi-keysigs-table database))
+   
+(defun %create-midi-collections-table (database)
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (clsql:create-table "midi_db_collections"
+		      '(([|collection-id|] clsql:smallint :unsigned
+			 :not-null :auto-increment :primary-key)
+			([|collection-name|] (clsql:varchar 255)
+			 :not-null)
+			([|description|] (clsql:varchar 255)
+			 :not-null))
+		      :database database
+		      :transactions t)
+  #.(clsql:locally-disable-sql-reader-syntax))
+
+(defun %create-midi-compositions-table (database)
+  (clsql:execute-command "
+CREATE TABLE midi_db_compositions (
+collection_id SMALLINT UNSIGNED NOT NULL,
+composition_id SMALLINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
+filename VARCHAR(255) NOT NULL,
+timebase SMALLINT UNSIGNED NOT NULL,
+start INT UNSIGNED NOT NULL,
+duration INT UNSIGNED NOT NULL,
+owner CHAR(16) NULL,
+version SMALLINT UNSIGNED NOT NULL DEFAULT 1,
+creation_timestamp TIMESTAMP NULL,
+deletion_timestamp TIMESTAMP NULL,
+INDEX midi_composition_index (
+collection_id, composition_id, version))
+engine = innodb;"
+			 :database database)
+  (%create-midi-composition-header-triggers database))
+
+(defun %create-midi-composition-header-triggers (database)
+  (clsql:execute-command "
+CREATE TRIGGER pre_insert_comp BEFORE INSERT ON midi_db_compositions
+FOR EACH ROW
+BEGIN
+SET NEW.owner = SUBSTRING_INDEX(USER(),'@',1);
+SET NEW.creation_timestamp = CURRENT_TIMESTAMP;
+END;"
+			 :database database))
+
+(defun %create-midi-events-table (database)
+  (clsql:execute-command "
+CREATE TABLE midi_db_events (
+collection_id SMALLINT UNSIGNED NOT NULL,
+composition_id SMALLINT UNSIGNED NOT NULL,
+event_id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
+track SMALLINT UNSIGNED NOT NULL,
+channel TINYINT UNSIGNED NOT NULL,
+patch TINYINT UNSIGNED NOT NULL,
+pitch TINYINT UNSIGNED NOT NULL,
+velocity TINYINT UNSIGNED NOT NULL,
+start INTEGER UNSIGNED NOT NULL,
+duration INTEGER UNSIGNED NOT NULL,
+version SMALLINT UNSIGNED NOT NULL DEFAULT 1,
+INDEX collection_composition (collection_id, composition_id))
+engine = innodb;"
+			 :database database))
+
+(defun %create-midi-tempi-table (database)
+  (clsql:execute-command "
+CREATE TABLE midi_db_tempi (
+collection_id SMALLINT UNSIGNED NOT NULL,
+composition_id SMALLINT UNSIGNED NOT NULL,
+constituent_id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
+start INT UNSIGNED NOT NULL,
+duration INT UNSIGNED NOT NULL,
+microsecs_per_crotchet INTEGER UNSIGNED NOT NULL,
+version SMALLINT UNSIGNED NOT NULL DEFAULT 1,
+INDEX collection_composition (collection_id, composition_id, constituent_id))
+engine = innodb;"
+			 :database database))
+
+(defun %create-midi-timesigs-table (database)
+  (clsql:execute-command "
+CREATE TABLE midi_db_timesigs (
+collection_id SMALLINT UNSIGNED NOT NULL,
+composition_id SMALLINT UNSIGNED NOT NULL,
+constituent_id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
+start INT UNSIGNED NOT NULL,
+duration INT UNSIGNED NOT NULL,
+numerator TINYINT UNSIGNED NOT NULL,
+denominator TINYINT UNSIGNED NOT NULL,
+version SMALLINT UNSIGNED NOT NULL DEFAULT 1,
+INDEX collection_composition (collection_id, composition_id, constituent_id))
+engine = innodb;"
+			 :database database))
+
+(defun %create-midi-keysigs-table (database)
+  (clsql:execute-command "
+CREATE TABLE midi_db_keysigs (
+collection_id SMALLINT UNSIGNED NOT NULL,
+composition_id SMALLINT UNSIGNED NOT NULL,
+constituent_id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
+start INT UNSIGNED NOT NULL,
+duration INT UNSIGNED NOT NULL,
+mode TINYINT UNSIGNED NOT NULL,
+sharp_count TINYINT UNSIGNED NOT NULL,
+version SMALLINT UNSIGNED NOT NULL DEFAULT 1,
+INDEX collection_composition (collection_id, composition_id, constituent_id))
+engine = innodb;"
+			 :database database))
+
+;; Deleting tables
+
+(defun drop-midi-db-tables (database)
+  (%drop-midi-collections-table database)
+  (%drop-midi-compositions-table database)
+  (%drop-midi-events-table database)
+  (%drop-midi-tempi-table database)
+  (%drop-midi-timesigs-table database)
+  (%drop-midi-keysigs-table database))
+
+(defun %drop-midi-collections-table (database)
+  (clsql:drop-table "midi_db_collections"
+		    :if-does-not-exist :ignore
+		    :database database))
+
+(defun %drop-midi-compositions-table (database)
+  (clsql:drop-table "midi_db_compositions"
+		    :if-does-not-exist :ignore
+		    :database database))
+
+(defun %drop-midi-events-table (database)
+  (clsql:drop-table "midi_db_events"
+		    :if-does-not-exist :ignore
+		    :database database))
+
+(defun %drop-midi-constituent-headers-table (database)
+  (clsql:drop-table "midi_db_constituent_headers"
+		    :if-does-not-exist :ignore
+		    :database database))
+
+(defun %drop-midi-tempi-table (database)
+  (clsql:drop-table "midi_db_tempi"
+		    :if-does-not-exist :ignore
+		    :database database))
+
+(defun %drop-midi-timesigs-table (database)
+  (clsql:drop-table "midi_db_timesigs"
+		    :if-does-not-exist :ignore
+		    :database database))
+
+(defun %drop-midi-keysigs-table (database)
+  (clsql:drop-table "midi_db_keysigs"
+		    :if-does-not-exist :ignore
+		    :database database))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/examples/example.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,15 @@
+(cl:in-package #:amuse-midi-db)
+
+(connect-to-database :database-name "amuse")
+
+(list-collections *package*)
+
+(list-compositions *package*) ; FIXME: is it a good idea for this to
+			      ; be general or not?
+
+(list-collections *package* :compositions t) ; list both collections
+					     ; and compositions
+
+(defparameter *composition*
+  (get-composition (make-midi-db-composition-identifier 1)))
+

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/examples/importing-midifiles.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,51 @@
+(cl:in-package #:amuse-midi-db)
+
+(connect-to-database :database-name "amuse"
+		     :username "jamief") ; needs to be adequate permissions
+
+(create-midi-db-tables *amuse-database*)
+
+;(drop-midi-db-tables *amuse-database*)
+
+(register-new-implementation *package*)
+
+
+;;;=====================================================================
+;;; Import collections of drum loops (from Marcus)
+;;;=====================================================================
+
+;;; Dangerous Drums
+(let ((collection-identifier
+       (register-new-collection "Dangerous Drums"
+				"Collection of drum loops. Each 'composition' is a collection of loops on separate tracks."
+				*amuse-database*)))
+
+  (import-midifiles
+   "/home/jamie/Music/MIDIFiles/MarcusMIDIFiles/DangerousDrums/"
+   collection-identifier
+   *amuse-database*))
+
+
+;;; LA Riot v1
+(let ((collection-identifier
+       (register-new-collection "LA Riot V1"
+				"Collection of drum loops. Each 'composition' is a collection of loops on separate tracks."
+				*amuse-database*)))
+
+  (import-midifiles
+   "/home/jamie/Music/MIDIFiles/MarcusMIDIFiles/LARiotv1/"
+   collection-identifier
+   *amuse-database*))
+
+;;; Midi breakbeats v8
+(let ((collection-identifier
+       (register-new-collection "MIDI Breakbeats V8"
+				"Collection of drum loops. Each 'composition' is a collection of loops on separate tracks."
+				*amuse-database*)))
+
+  (import-midifiles
+   "/home/jamie/Music/MIDIFiles/MarcusMIDIFiles/MIDIBreakbeatsv8/"
+   collection-identifier
+   *amuse-database*))
+
+(disconnect-from-database)

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/methods.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,38 @@
+(cl:in-package #:amuse-midi-db)
+
+(defmethod list-collections ((package (eql *package*)) &key
+			     compositions (stream *standard-output*))
+  "FIXME: better formatting."
+  (let ((collection-rows (%get-all-collection-headers)))
+    (flet ((print-separator (&optional (columns 77))
+	     (format stream "~% ~A"
+		     (make-sequence 'string columns :initial-element #\-))))
+      (loop for collection-row in collection-rows
+	 do (destructuring-bind (collection-id collection-name description)
+		collection-row
+	      (format stream "~%Collection-id: ~A~% Name: ~A~% Description: ~A~%"
+		      collection-id collection-name description)
+	      (when compositions
+		(list-compositions package
+				   :collection-identifier
+				   (make-midi-db-collection-identifier
+				    collection-id))))
+	 do (print-separator)))))
+
+(defmethod list-compositions ((package (eql *package*)) &key
+			      collection-identifier
+			      (stream *standard-output*))
+  (let ((composition-headers
+	 (if collection-identifier
+	     (%get-all-collection-composition-headers
+	      collection-identifier)
+	     (%get-all-composition-headers))))
+    (loop for composition-header in composition-headers
+       do (destructuring-bind (collection-id filename timebase start
+					      duration owner version
+					      creation-timestamp
+					      deletion-timestamp)
+	      composition-header
+	    (format stream "~%Collection-id: ~A filename: ~A timebase: ~A start: ~A duration: ~A owner: ~A version: ~A created: ~A deleted: ~A~%"
+		    collection-id filename timebase start duration owner
+		    version creation-timestamp deletion-timestamp)))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi-db/package.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,7 @@
+(cl:defpackage #:amuse-midi-db 
+  (:use #:common-lisp #:amuse #:amuse-utils #:amuse-tools
+	#:amuse-midi #:amuse-database-admin)
+  (:export #:midi-db-composition-identifier
+	   #:make-midi-db-composition-identifier
+	   #:composition-id
+	   ))