Mercurial > hg > amuse

changeset 132:bfe5afcad183

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix to monodiser darcs-hash:20070820144432-f76cc-29675eafe225b078be656eef11a6bff9dba70b81.gz
author David Lewis <d.lewis@gold.ac.uk>
date Mon, 20 Aug 2007 15:44:32 +0100
parents 995819f3a1d0
children d041118612d4
files implementations/geerdes/classes.lisp utils/utils.lisp
diffstat 2 files changed, 8 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/implementations/geerdes/classes.lisp	Mon Aug 20 15:43:56 2007 +0100
+++ b/implementations/geerdes/classes.lisp	Mon Aug 20 15:44:32 2007 +0100
@@ -1,7 +1,9 @@
 (cl:in-package #:amuse-geerdes)
 
 (defclass property-list-mixin ()
-  ((properties :initarg :properties :accessor properties :initform nil)))
+  ((properties :initarg :properties
+	       :accessor properties
+	       :initform 'nil)))
 
 (defclass geerdes-object (property-list-mixin) ())
 
--- a/utils/utils.lisp	Mon Aug 20 15:43:56 2007 +0100
+++ b/utils/utils.lisp	Mon Aug 20 15:44:32 2007 +0100
@@ -238,6 +238,8 @@
 	    ;; only look at pairings for the shorter note. This can
 	    ;; have odd side effects, but means we never
 	    ;; under-represent an overlap (I think)
+	    (when (>= overlap 3/4)
+	      (return-from check-events-bag-for-polyphony T))
 	    (when (or (not (aref overlaps shorter))
 		      (>= overlap (aref overlaps shorter)))
 	      (setf (aref overlaps shorter) overlap)
@@ -249,13 +251,13 @@
       (loop for i from 0 to (1- (length events-bag))
 	 do (when (aref overlaps i)
 	      (incf total)
-	      (when (>= (aref overlaps i) 3/4)
+	      (when (>= (aref overlaps i) 1/2)
 		(incf overs))))
       (if (and (> total 0)
 	       (>= (/ overs total)
 		   1/4))
-	  'T
-	  'nil))))
+	  T
+	  nil))))
 
 (defgeneric inter-onset-intervals (composition &key rounding-divisor))
 (defmethod inter-onset-intervals ((composition composition) &key (rounding-divisor 1/4))