changeset 60:8cc40d2b12fd

ps13/gsharp integration

darcs-hash:20070623085234-dc3a5-aede858c11bb5e5b8c73a0ec4319d3b54163beff.gz

--- a/implementations/gsharp/gsharp-import.lisp	Fri Jun 22 07:25:20 2007 +0100
+++ b/implementations/gsharp/gsharp-import.lisp	Sat Jun 23 09:52:34 2007 +0100
@@ -84,13 +84,13 @@
 
 (in-package :clim-user)
 
-(define-command (amuse-play :name t :command-table gsharp::global-gsharp-table)
+(define-command (com-amuse-play :name t :command-table gsharp::global-gsharp-table)
     ()
   (let* ((segment (gsharp-cursor::segment (gsharp::current-cursor)))
 	 (composition (amuse-gsharp::segment-composition segment)))
     (amuse-utils::play composition)))
     
-(define-command (infer-key :name t :command-table gsharp::global-gsharp-table)
+(define-command (com-infer-key :name t :command-table gsharp::global-gsharp-table)
     ()
   (let* ((segment (gsharp-cursor::segment (gsharp::current-cursor)))
 	 (composition (amuse-gsharp::segment-composition segment))
@@ -100,4 +100,62 @@
     (esa:display-message string))
     
 
+(in-package :gsharp-measure)
+
+(define-added-mixin snote () note
+  ((misspeltp :initform nil :accessor misspeltp)))
+
+(in-package :gsharp-drawing)
+
+;;; 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))))
+    (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)))
+
+(in-package :clim-user)
+
+(defun ocp-list (composition)
+  (flet ((sorter (x y)
+           (or (amuse:time< x y)
+               (and (amuse:time= x y)
+                    (amuse:pitch< x y)))))
+    (loop for e being each element of composition
+          if (typep e 'amuse:pitched-event)
+          collect (cons e (make-array 2 :initial-contents 
+                                      (list (slot-value e 'amuse::time)
+                                            (- (slot-value e 'amuse::number) 21)))) into result
+          finally (return (sort result #'sorter :key #'car)))))
+
+(let ((accidental-conversions
+       '(("ss" . :double-sharp) ("s" . :sharp) ("n" . :natural)
+         ("f" . :flat) ("ff" . :double-flat))))
+  (defun annotate-misspellings (composition)
+    (do* ((ocp-list (ocp-list composition))
+          (note-sequence (ps13:ps13-new-imp (map 'list #'cdr ocp-list) 10 42))
+          (list ocp-list (cdr list))
+          (spellings note-sequence (cdr spellings)))
+         ((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))))))
+
+(define-command (com-spellcheck :name t :command-table gsharp::global-gsharp-table)
+    ()
+  (let* ((segment (gsharp-cursor::segment (gsharp::current-cursor)))
+	 (composition (amuse-gsharp::segment-composition segment)))
+    (annotate-misspellings composition)
+    #+nil
+    (esa:display-message "~A" (first (ocp-list composition)))))
+         
+
 |#
\ No newline at end of file