changeset 61:c911d65ae94d

pointy-clicky misspelling correction

darcs-hash:20070627102839-dc3a5-16cb5156dafee4b4a1aa3442274fab6c7260ed9c.gz

--- a/implementations/gsharp/classes.lisp	Sat Jun 23 09:52:34 2007 +0100
+++ b/implementations/gsharp/classes.lisp	Wed Jun 27 11:28:39 2007 +0100
@@ -5,4 +5,5 @@
    (tempi :initarg :tempi :reader tempi)))
 
 (defclass gsharp-pitched-event (chromatic-pitched-event)
-  ((note :initarg :note :reader note)))
+  ((note :initarg :note :reader note)
+   (slice-index :initarg :slice-index)))

--- a/implementations/gsharp/gsharp-import.lisp	Sat Jun 23 09:52:34 2007 +0100
+++ b/implementations/gsharp/gsharp-import.lisp	Wed Jun 27 11:28:39 2007 +0100
@@ -35,26 +35,27 @@
 	while n
 	sum (gsharp-buffer:duration (gsharp-buffer:cluster n))))
 
-(defun events-from-element (element time channel)
+(defun events-from-element (element index time)
   (when (typep element 'gsharp-buffer:cluster)
     (mapcar (lambda (note)
 	      (make-instance 'gsharp-pitched-event
 			     :note note
+                             :slice-index index
 			     :number (gsharp-play::midi-pitch note)
 			     :time time
 			     :interval (* 4 (compute-duration note))))
 	    (remove-if #'gsharp-buffer:tie-left (gsharp-buffer:notes element)))))
 
-(defun events-from-bar (bar time channel)
+(defun events-from-bar (bar index time)
   (mapcan (lambda (element)
-	    (prog1 (events-from-element element time channel)
+	    (prog1 (events-from-element element index time)
 	      (incf time (* 4 (gsharp-buffer:duration element)))))
 	  (gsharp-buffer:elements bar)))
 
-(defun events-from-slice (slice channel durations)
+(defun events-from-slice (slice index durations)
   (let ((time 0))
     (mapcan (lambda (bar duration)
-	      (prog1 (events-from-bar bar time channel)
+	      (prog1 (events-from-bar bar index time)
 		(incf time (* 4 duration))))
 	    (gsharp-buffer:bars slice) durations)))
 
@@ -110,11 +111,14 @@
 ;;; patch DRAW-NOTE
 (defun draw-note (pane note notehead nb-dots x pos dot-xoffset dot-pos)
   (score-pane:with-vertical-score-position (pane (staff-yoffset (staff note)))
-    (score-pane:draw-notehead pane notehead x pos)
-    (when (gsharp-measure::misspeltp note)
-      (let ((ypos (score-pane:staff-step (- pos))))
-        (draw-line* pane (- x 5) (+ ypos 3) (+ x 5) (+ ypos 3)
-                    :line-thickness 3 :ink (make-rgb-color 0.8 0.1 0.1))))
+    (cond
+      ((gsharp-measure::misspeltp note)
+       (with-output-as-presentation (pane note 'note)
+         (score-pane:draw-notehead pane notehead x pos))
+       (let ((ypos (score-pane:staff-step (- pos))))
+         (draw-line* pane (- x 5) (+ ypos 3) (+ x 5) (+ ypos 3)
+                     :line-thickness 3 :ink (make-rgb-color 0.8 0.1 0.1))))
+      (t (score-pane:draw-notehead pane notehead x pos)))
     (when (final-accidental note)
       (score-pane:draw-accidental pane (final-accidental note) (final-absolute-accidental-xoffset note) pos))
     (draw-dots pane nb-dots x dot-xoffset dot-pos)))
@@ -144,10 +148,12 @@
          ((null list))
       (let* ((event (caar list))
              (note (amuse-gsharp:note event))
-             (accidental (elt (second (car spellings)) 1)))
-        (unless (eq (gsharp-buffer:accidentals note)
-                    (cdr (assoc accidental accidental-conversions :test #'string=)))
-          (setf (gsharp-measure::misspeltp note) t))))))
+             (accidental (elt (second (car spellings)) 1))
+             (converted (cdr (assoc accidental accidental-conversions :test #'string=))))
+        (unless (eq (gsharp-buffer:accidentals note) converted)
+          ;; this pun is not to be preserved once we get into real
+          ;; code.
+          (setf (gsharp-measure::misspeltp note) (second (car spellings))))))))
 
 (define-command (com-spellcheck :name t :command-table gsharp::global-gsharp-table)
     ()
@@ -156,6 +162,32 @@
     (annotate-misspellings composition)
     #+nil
     (esa:display-message "~A" (first (ocp-list composition)))))
-         
+
+(let ((accidental-conversions
+       '(("ss" . :double-sharp) ("s" . :sharp) ("n" . :natural)
+         ("f" . :flat) ("ff" . :double-flat))))
+  (define-command (com-correct-misspelt-note :name t :command-table gsharp::global-gsharp-table)
+      ((note 'gsharp::note))
+    (let ((spelling (gsharp-measure::misspeltp note))
+          (element (gsharp-buffer::cluster note))
+          (staff (gsharp-buffer::staff note))
+          (head (gsharp-buffer::head note))
+          (dots (gsharp-buffer::dots note)))
+      (let ((pitch (+ (mod (- (digit-char-p (char (elt spelling 0) 0) 17) 12) 7)
+                      (* (parse-integer (elt spelling 2)) 7)))
+            (accidentals (cdr (assoc (elt spelling 1) accidental-conversions :test #'string=))))
+        (let ((new-note (gsharp-buffer::make-note pitch staff 
+                                                  :head head
+                                                  :dots dots
+                                                  :accidentals accidentals)))
+          (gsharp-buffer::remove-note note)
+          (gsharp-buffer::add-note element new-note))))))
+
+(define-presentation-to-command-translator correct-misspelt-note-translator
+    (gsharp::note com-correct-misspelt-note gsharp::global-gsharp-table
+          :gesture :select
+          :tester ((object) (gsharp-measure::misspeltp object)))
+  (object)
+  (list object))
 
 |#
\ No newline at end of file