annotate 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)))