[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp

[Robert Strandh]

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv3313

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Patch to allow the current note to be deleted.
(thanks to Robert J. Macomber)

Date: Sun Nov 20 20:17:22 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.26 gsharp/buffer.lisp:1.27
--- gsharp/buffer.lisp:1.26	Wed Nov 16 02:27:34 2005
+++ gsharp/buffer.lisp	Sun Nov 20 20:17:22 2005
@@ -352,6 +352,24 @@
       (setf notes (delete note notes :test #'eq)))
     (setf cluster nil)))
 
+(defun lower-bound (bound list &key (test #'<))
+  "Return the `largest' element in the sorted list LIST such that
+\(TEST element BOUND) is true."
+  (let ((last nil))
+    (dolist (item list)
+      (unless (funcall test item bound)
+        (return-from lower-bound last))
+      (setf last item))
+    last))
+
+(defmethod cluster-lower-bound ((cluster cluster) (bound note))
+  (with-slots (notes) cluster
+    (lower-bound bound notes :test #'note-less)))
+
+(defmethod cluster-upper-bound ((cluster cluster) (bound note))
+  (with-slots (notes) cluster
+    (lower-bound bound (reverse notes) :test (complement #'note-less))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Rest


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.43 gsharp/gui.lisp:1.44
--- gsharp/gui.lisp:1.43	Mon Nov 14 21:26:14 2005
+++ gsharp/gui.lisp	Sun Nov 20 20:17:22 2005
@@ -812,6 +812,19 @@
     (add-note cluster new-note)
     (setf *current-note* new-note)))
 
+(define-gsharp-command com-remove-current-note ()
+  (let ((cluster (cur-cluster))
+        (note (cur-note)))
+    (when note
+      (remove-note note)
+      ;; try to set current-note to the highest note lower than the
+      ;; removed note.  If that fails, to the lowest note higher than
+      ;; it.
+      (setf *current-note* (or (cluster-lower-bound cluster note)
+                               (cluster-upper-bound cluster note)))
+      (unless *current-note*
+        (com-erase-element)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; motion by element


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.28 gsharp/packages.lisp:1.29
--- gsharp/packages.lisp:1.28	Sat Nov 19 06:16:28 2005
+++ gsharp/packages.lisp	Sun Nov 20 20:17:22 2005
@@ -45,6 +45,7 @@
 	   #:notehead #:rbeams #:lbeams #:dots #:element
 	   #:melody-element #:notes
 	   #:add-note #:find-note #:remove-note
+           #:cluster-upper-bound #:cluster-lower-bound
 	   #:cluster #:make-cluster
 	   #:rest #:make-rest
 	   #:lyrics-element #:make-lyrics-element