diff base/charm/example/eg-constituent-constructors.lisp @ 253:b5ffec94ae6d

some very sketchy Charm constituent code

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/base/charm/example/eg-constituent-constructors.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,128 @@
+(cl:in-package #:amuse-geerdes)
+
+;;; The idea of Charm constituents here is closely tied up with the
+;;; database. The basic constructors below will work without a working
+;;; database, but obviously not the store and get stuff.
+
+(asdf:oos 'asdf:load-op 'amuse-geerdes)
+(asdf:oos 'asdf:load-op 'geerdes-tools)
+(asdf:oos 'asdf:load-op 'amuse-charm)
+(use-package 'amuse-charm)
+
+(defparameter *charm-database* ; just for testing
+  (connect-to-database :database-name "amuse_charm"
+		       :username "jamie"
+		       :make-default nil))
+(disconnect-from-database *charm-database*)
+
+(connect-to-database) ; default amuse connection for getting geerdes data
+(disconnect-from-database)
+
+;(create-charm-db-tables *charm-database*)
+;(drop-charm-db-tables *charm-database*)
+
+(defparameter *composition*
+  (get-composition (g-id-file-id 1)))
+
+(defparameter *charm-constituent-composition*
+  (composition->charm-constituent *composition*
+				   (make-charm-property-list
+				    'composition)
+				   (make-charm-property-list
+				    'polyphonic)))
+
+(defparameter *charm-constituent-composition-identifier*
+  (store-charm-constituent *charm-constituent-composition*
+			   *charm-database*))
+
+(defparameter *charm-constituent-composition-db*
+  (get-charm-constituent *charm-constituent-composition-identifier*
+			 *charm-database*))
+
+
+;;; Slice composition into segments
+
+(defparameter *onset-segments-constituent*
+  (make-onset-segment-constituent *composition*))
+
+(defparameter *onset-segment-constituent-identifier*
+  (store-charm-constituent *onset-segments-constituent*
+			   *charm-database*))
+
+(defparameter *charm-constituent-composition-db*
+  (get-charm-constituent *onset-segment-constituent-identifier* ;1922
+			 *charm-database*))
+
+;;; Bar segments
+
+(defparameter *bar-segments-constituent*
+  (segment-at-bar *composition*))
+
+
+;;; Part-like constituents.
+
+(defparameter *lead-vocals*
+  (geerdes-tools:vocal-part *composition*))
+
+(defparameter *charm-vocals*
+  (composition->charm-constituent *lead-vocals*
+				  (make-charm-property-list 'voice
+							    'monophonic)
+				  (make-charm-property-list 'song)))
+
+(defparameter *charm-vocals-identifier*
+  (store-charm-constituent *charm-vocals* *charm-database*))
+
+(defparameter *charm-vocals-db*
+  (get-charm-constituent *charm-vocals-identifier*
+			 *charm-database*))
+
+(defparameter *bass-guitar*
+  (geerdes-tools:bass-part *composition*))
+
+(defparameter *charm-bass*
+  (composition->charm-constituent *bass-guitar*
+				  (make-charm-property-list 'guitar
+							    'polyphonic)
+				  (make-charm-property-list 'song)))
+
+(defparameter *charm-bass-identifier*
+  (store-charm-constituent *charm-bass* *charm-database*))
+
+(defparameter *charm-bass-db*
+  (get-charm-constituent *charm-bass-identifier* *charm-database*))
+
+
+;;; Combine above as events.
+
+(defparameter *bass+vocals-constituent1*
+  (make-standard-charm-constituent
+   (append (%list-slot-sequence-data *charm-bass*)
+	   (%list-slot-sequence-data *charm-vocals*)) *composition*
+	   (make-charm-property-list 'vocal 'bass-guitar 'polyphonic)
+	   (make-charm-property-list 'song)))
+
+(defparameter *bass+vocals-constituent1-identifier*
+  (store-charm-constituent *bass+vocals-constituent1* *charm-database*))
+
+(defparameter *bass+vocals-constituent1-db*
+  (get-charm-constituent *bass+vocals-constituent1-identifier*
+			 *charm-database*))
+
+
+;;; Combine above as constituents
+
+(defparameter *bass+vocals-constituent2*
+  (make-standard-charm-constituent
+   (list *charm-bass* *charm-vocals*)
+   *composition*
+   (make-charm-property-list 'vocal 'bass-guitar 'polyphonic)
+   (make-charm-property-list 'song)))
+				   
+(defparameter *bass+vocals-constituent2-identifier*
+  (store-charm-constituent *bass+vocals-constituent2*
+			   *charm-database*))
+
+(defparameter *bass+vocals-constituent2-db*
+  (get-charm-constituent *bass+vocals-constituent2-identifier*
+			 *charm-database*))