Index: buffer.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/buffer.lisp,v
retrieving revision 1.2
diff -u -r1.2 buffer.lisp
--- buffer.lisp	16 Feb 2004 16:08:00 -0000	1.2
+++ buffer.lisp	22 Mar 2004 16:57:06 -0000
@@ -129,13 +129,14 @@
    (staff :initarg :staff :reader staff)
    (head :initarg :head :reader head)
    (accidentals :initarg :accidentals :reader accidentals)
-   (dots :initarg :dots :reader dots)))
+   (dots :initarg :dots :reader dots)
+   (ties :initarg :ties :reader ties)))
 
 (defmethod print-object ((n note) stream)
-  (with-slots (pitch staff head accidentals dots) n
+  (with-slots (pitch staff head accidentals dots ties) n
     (format stream
-	    "[N :pitch ~W :staff ~W :head ~W :accidentals ~W :dots ~W ] "
-	    pitch staff head accidentals dots)))
+	    "[N :pitch ~W :staff ~W :head ~W :accidentals ~W :dots ~W :ties ~W] "
+	    pitch staff head accidentals dots ties)))
 
 ;;; Make a note with the pitch and staff given.  
 ;;; 
@@ -167,7 +168,9 @@
 	   (type (or integer null) dots))
     (make-instance 'note
       :pitch pitch :staff staff
-      :head head :accidentals accidentals :dots dots))
+      :head head :accidentals accidentals :dots dots
+      ;; FIXME
+      :ties nil))
 		 
 (defun read-note-v2 (stream char n)
   (declare (ignore char n))
@@ -191,6 +194,24 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; Tie
+(defclass tie ()
+  ((notes :initarg :notes :reader notes)))
+
+(defmethod print-object ((tie tie) stream)
+  (with-slots (notes) tie
+    (format stream "[~~ :notes ~W ] " notes)))
+
+(defun read-tie-v3 (stream char n)
+  (declare (ignore char n))
+  (apply #'make-instance 'tie (read-delimited-list #\] stream t)))
+
+(set-dispatch-macro-character #\[ #\~
+  #'read-tie-v3
+  *gsharp-readtable-v3*)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; Element
 
 ;;; Return the bar to which the element belongs, or nil of the element
Index: cursor.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/cursor.lisp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 cursor.lisp
--- cursor.lisp	16 Feb 2004 15:46:11 -0000	1.1.1.1
+++ cursor.lisp	22 Mar 2004 16:57:06 -0000
@@ -206,11 +206,11 @@
 
 (defgeneric backward-slice (cursor))
 
-(defgeneric head-slisce (cursor))
+(defgeneric head-slice (cursor))
 
-(defgeneric body-slisce (cursor))
+(defgeneric body-slice (cursor))
 
-(defgeneric tail-slisce (cursor))
+(defgeneric tail-slice (cursor))
 
 (defgeneric insert-bar-before (bar cursor))
 
Index: drawing.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/drawing.lisp,v
retrieving revision 1.4
diff -u -r1.4 drawing.lisp
--- drawing.lisp	20 Feb 2004 08:39:03 -0000	1.4
+++ drawing.lisp	22 Mar 2004 16:57:06 -0000
@@ -402,6 +402,19 @@
 (defun draw-note (pane note notehead nb-dots x pos)
   (with-vertical-score-position (pane (staff-yoffset (staff note)))
     (draw-notehead pane notehead x pos)
+    ;; FIXME: this might be better as its own DRAW-TIES function 
+    (dolist (tie (ties note))
+      (when (eq note (cdr (notes tie)))
+	(let ((ox (final-xposition (car (notes tie)))))
+	  (if (eq (final-stem-direction (cluster note)) :up)
+	      ;; FIXME: POS is clearly not the right thing to get at
+	      ;; the notehead position.  What is?
+	      (progn
+		(draw-line* pane x (staff-step (1- pos)) (/ (+ x ox) 2) (staff-step (- pos 2)) :line-thickness 2)
+		(draw-line* pane (/ (+ x ox) 2) (staff-step (- pos 2)) ox (staff-step (1- pos)) :line-thickness 2))
+	      (progn
+		(draw-line* pane x (staff-step (1+ pos)) (/ (+ x ox) 2) (staff-step (+ pos 2)) :line-thickness 2)
+		(draw-line* pane (/ (+ x ox) 2) (staff-step (+ pos 2)) ox (staff-step (1+ pos)) :line-thickness 2))))))
     (when (final-accidental note)
       (draw-accidental pane (final-accidental note) (accidental-position note) pos))
     (draw-dots pane nb-dots x pos)))
Index: gui.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/gui.lisp,v
retrieving revision 1.8
diff -u -r1.8 gui.lisp
--- gui.lisp	27 Feb 2004 09:34:30 -0000	1.8
+++ gui.lisp	22 Mar 2004 16:57:07 -0000
@@ -35,6 +40,7 @@
 (add-command '(#\a) 'com-insert-note-a *global-command-table*)
 (add-command '(#\b) 'com-insert-note-b *global-command-table*)
 (add-command '(#\,) 'com-insert-rest *global-command-table*)
+(add-command '(#\t) 'com-toggle-tie-backwards *global-command-table*)
 (add-command '(#\Space) 'com-insert-empty-cluster *global-command-table*)
 (add-command '(#\C :shift) 'com-add-note-c *global-command-table*)
 (add-command '(#\D :shift) 'com-add-note-d *global-command-table*)
@@ -541,18 +579,24 @@
 
 (defun events-from-element (element time channel)
   (when (typep element 'cluster)
-    (append (mapcar (lambda (note)
-		      (make-instance 'note-on-message
-				     :time time
-				     :status (+ #x90 channel)
-				     :key (midi-pitch note) :velocity 100))
+    (append (mapcan (lambda (note)
+		      ;; FIND ... = NOTE-ENDS-TIE-P
+		      (unless (find note (ties note) :test #'eq :key (lambda (x) (cdr (notes x))))
+			(list
+			 (make-instance 'note-on-message
+					:time time
+					:status (+ #x90 channel)
+					:key (midi-pitch note) :velocity 100))))
 		    (notes element))
-	    (mapcar (lambda (note)
-		      (make-instance 'note-off-message
-				     :time (+ time (* 128 (element-duration element)))
-				     :status (+ #x80 channel)
-				     :key (midi-pitch note) :velocity 100))
-		    (notes element)))))
+	    (mapcan (lambda (note)
+		      ;; NOTE-STARTS-TIE-P
+		      (unless (find note (ties note) :test #'eq :key (lambda (x) (car (notes x))))
+			(list
+			 (make-instance 'note-off-message
+					:time (+ time (* 128 (element-duration element)))
+					:status (+ #x80 channel)
+					:key (midi-pitch note) :velocity 100))))
+			(notes element)))))
 
 (defun events-from-bar (bar time channel)
   (mapcan (lambda (element)
@@ -697,6 +741,88 @@
 
 (define-gsharp-command com-insert-empty-cluster ()
   (insert-cluster))  
+
+(defun find-cluster-with-note-backwards (pitch)
+  (let ((cursor (make-cursor (bar (cursor *gsharp-frame*)) (gsharp-cursor::pos (cursor *gsharp-frame*)))))
+    (do ()
+	((progn (backward-element cursor)
+		(handler-case
+		    (and (typep (current-element cursor) 'cluster)
+			 (find-note (current-element cursor) (make-note pitch)))
+		  (not-on-an-element () nil)))
+	 (prog1 (current-element cursor)
+	   (gsharp-cursor::unset-cursor cursor))))))
+
+(define-gsharp-command com-toggle-tie-backwards ()
+  (let ((this (cur-note)))
+    (let ((tie (find this (ties this) :test #'eq
+		     :key (lambda (x) (cdr (notes x))))))
+      (if tie
+	  (let* ((other (car (notes tie)))
+		 (ocluster (cluster other)))
+	    (let ((new-this (make-note (pitch this)
+				       (staff this)
+				       (head this)
+				       (accidentals this)
+				       (dots this)))
+		  (new-other (make-note (pitch other)
+					(staff other)
+					(head other)
+					(accidentals other)
+					(dots other))))
+	      (setf (slot-value new-this 'ties)
+		    (mapcar (lambda (tie)
+			      (if (eq this (car (notes tie)))
+				  (setf (car (notes tie)) new-this)
+				  (setf (cdr (notes tie)) new-this))
+			      tie)
+			    (remove tie (slot-value this 'ties) :test #'eq)))
+	      (setf (slot-value new-other 'ties)
+		    (mapcar (lambda (tie)
+			      (if (eq other (car (notes tie)))
+				  (setf (car (notes tie)) new-other)
+				  (setf (cdr (notes tie)) new-other))
+			      tie)
+			    (remove tie (slot-value other 'ties) :test #'eq)))
+	      (remove-note this)
+	      (remove-note other)
+	      (add-note (cur-cluster) new-this)
+	      (add-note ocluster new-other)))
+	  (let* ((ocluster (find-cluster-with-note-backwards (pitch this)))
+		 (other (find-note ocluster this)))
+	    (let ((new-this (make-note (pitch this)
+				       (staff this)
+				       (head this)
+				       (accidentals this)
+				       (dots this)))
+		  (new-other (make-note (pitch other)
+					(staff other)
+					(head other)
+					(accidentals other)
+					(dots other))))
+	      (let ((tie (make-instance 'tie :notes (cons new-other new-this))))
+		(setf (slot-value new-this 'ties)
+		      (cons tie
+			    (mapcar (lambda (tie)
+				      (if (eq this (car (notes tie)))
+					  ;; FIXME: ASSERT stuff here
+					  (setf (car (notes tie)) new-this)
+					  (setf (cdr (notes tie)) new-this))
+				      tie)
+				    (slot-value this 'ties))))
+		(setf (slot-value new-other 'ties)
+		      (cons tie
+			    (mapcar (lambda (tie)
+				      (if (eq other (car (notes tie)))
+					  ;; see above
+					  (setf (car (notes tie)) new-other)
+					  (setf (cdr (notes tie)) new-other))
+				      tie)
+				    (slot-value other 'ties))))
+		(remove-note this)
+		(remove-note other)
+		(add-note (cur-cluster) new-this)
+		(add-note ocluster new-other))))))))
 
 (defun cur-cluster ()
   (current-cluster (cursor *gsharp-frame*)))
Index: packages.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/packages.lisp,v
retrieving revision 1.2
diff -u -r1.2 packages.lisp
--- packages.lisp	16 Feb 2004 16:08:00 -0000	1.2
+++ packages.lisp	22 Mar 2004 16:57:07 -0000
@@ -34,11 +34,11 @@
 
 (defpackage :gsharp-buffer
   (:use :common-lisp :gsharp-utilities)
-  (:export #:clef #:make-clef #:name #:lineno
+  (:export #:tie #:ties #:clef #:make-clef #:name #:lineno
 	   #:staff #:make-staff #:gsharp-condition
 	   #:pitch #:accidentals #:dots #:cluster #:note
 	   #:make-note #:note-less #:note-equal #:bar
-	   #:notehead #:rbeams #:lbeams #:dots #:element #:notes
+	   #:notehead #:rbeams #:lbeams #:dots #:element #:notes #:lyrics
 	   #:add-note #:find-note #:remove-note #:cluster #:make-cluster
 	   #:rest #:make-rest #:slice #:elements
 	   #:nb-elements #:elementno #:add-element
