[gsharp-cvs] CVS gsharp

rstrandh rstrandh at common-lisp.net
Mon Feb 13 23:51:34 UTC 2006


Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp:/tmp/cvs-serv26626

Modified Files:
	buffer.lisp gui.lisp modes.lisp packages.lisp 
Log Message:
Reorganized the command tables so that there are command tables
that are specific to element types.

Implemented find-applicable-gsharp-command-table that determines
a command table based on the layer the cursor is in and (if any) the
current element.

Added `tie-left' and `tie-right' accessors to notes and lyrics
elements and commands for modifying the ties.  Ties are not rendered
yet.



--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2006/02/09 03:17:25	1.32
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2006/02/13 23:51:34	1.33
@@ -183,7 +183,9 @@
 		:type (member :natural :flat :double-flat
 			      :sharp :double-sharp))
    (dots :initform nil :initarg :dots :reader dots
-	 :type (or (integer 0 3) null))))
+	 :type (or (integer 0 3) null))
+   (%tie-right :initform nil :initarg :tie-right :accessor tie-right)
+   (%tie-left :initform nil :initarg :tie-left :accessor tie-left)))
 
 (defun make-note (pitch staff &rest args &key head (accidentals :natural) dots)
   (declare (type (integer 0 127) pitch)
@@ -515,7 +517,9 @@
    (staff :initarg :staff :reader staff)
    (text :initarg :text
 	 :initform (make-array 5 :adjustable t :element-type 'fixnum :fill-pointer 0)
-	 :reader text)))
+	 :reader text)
+   (%tie-right :initform nil :initarg :tie-right :accessor tie-right)
+   (%tie-left :initform nil :initarg :tie-left :accessor tie-left)))
 
 (defmethod initialize-instance :after ((elem lyrics-element) &rest args)
   (declare (ignore args))
--- /project/gsharp/cvsroot/gsharp/gui.lisp	2006/02/09 03:17:25	1.52
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2006/02/13 23:51:34	1.53
@@ -14,6 +14,8 @@
 
 (define-command-table total-melody-table
     :inherit-from (melody-table global-gsharp-table gsharp))
+(define-command-table total-cluster-table
+    :inherit-from (cluster-table melody-table global-gsharp-table gsharp))
 (define-command-table total-lyrics-table
     :inherit-from (lyrics-table global-gsharp-table gsharp))
 
@@ -410,12 +412,24 @@
     (declare (ignore string))
     (if success layer (error 'no-such-layer))))
 
+(defgeneric find-applicable-gsharp-command-table (layer element))
+
+(defmethod find-applicable-gsharp-command-table ((layer melody-layer) element)
+  (declare (ignore element))
+  (find-command-table 'total-melody-table))
+
+(defmethod find-applicable-gsharp-command-table ((layer melody-layer) (element cluster))
+  (find-command-table 'total-cluster-table))
+
+(defmethod find-applicable-gsharp-command-table ((layer lyrics-layer) element)
+  (declare (ignore element))
+  (find-command-table 'total-lyrics-table))
+
 (defmethod find-applicable-command-table ((frame gsharp))
-  (let* ((layer (layer (current-cursor))))
-    ;; F-A-C-T-WITH-LAYER?
-    (typecase layer
-      (lyrics-layer (find-command-table 'total-lyrics-table))
-      (melody-layer (find-command-table 'total-melody-table)))))
+  (let* ((cursor (current-cursor))
+	 (layer (layer cursor))
+	 (element (if (beginning-of-bar-p cursor) nil (current-element cursor))))
+    (find-applicable-gsharp-command-table layer element)))
 
 (define-gsharp-command (com-select-layer :name t) ()
   (let ((selected-layer (accept 'layer :prompt "Select layer")))
@@ -825,6 +839,26 @@
       (unless *current-note*
         (com-erase-element)))))
 
+(define-gsharp-command com-tie-note-left ()
+  (let ((note (cur-note)))
+    (when note
+      (setf (tie-left note) t))))
+
+(define-gsharp-command com-untie-note-left ()
+  (let ((note (cur-note)))
+    (when note
+      (setf (tie-left note) nil))))
+
+(define-gsharp-command com-tie-note-right ()
+  (let ((note (cur-note)))
+    (when note
+      (setf (tie-right note) t))))
+
+(define-gsharp-command com-untie-note-right ()
+  (let ((note (cur-note)))
+    (when note
+      (setf (tie-right note) nil))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; motion by element
--- /project/gsharp/cvsroot/gsharp/modes.lisp	2005/10/28 17:20:30	1.7
+++ /project/gsharp/cvsroot/gsharp/modes.lisp	2006/02/13 23:51:34	1.8
@@ -14,8 +14,17 @@
 (set-key 'com-right 'global-gsharp-table '((#\r :meta)))
 (set-key 'com-rotate-notehead 'global-gsharp-table '((#\r :control)))
 (set-key 'com-load-file 'global-gsharp-table '((#\x :control) (#\f :control)))
+(set-key 'com-istate-more-dots 'global-gsharp-table '((#\i) (#\.)))
+(set-key 'com-istate-more-lbeams 'global-gsharp-table '((#\i) (#\[)))
+(set-key 'com-istate-more-rbeams 'global-gsharp-table '((#\i) (#\])))
+(set-key 'com-istate-rotate-notehead 'global-gsharp-table '((#\i) (#\h)))
+(set-key 'com-istate-rotate-stem-direction 'global-gsharp-table '((#\i) (#\s)))
+(set-key 'com-istate-fewer-dots 'global-gsharp-table '((#\i) (#\x) (#\.)))
+(set-key 'com-istate-fewer-lbeams 'global-gsharp-table '((#\i) (#\x) (#\[)))
+(set-key 'com-istate-fewer-rbeams 'global-gsharp-table '((#\i) (#\x) (#\])))
 
-;;; melody table
+;;; the melody table contains commands that are specific to the 
+;;; melody layer
 
 (define-command-table melody-table)
 
@@ -30,36 +39,38 @@
 (set-key 'com-insert-note-g 'melody-table '(#\g))
 (set-key 'com-insert-rest 'melody-table '((#\,)))
 (set-key 'com-insert-empty-cluster 'melody-table '((#\Space)))
-(set-key 'com-add-note-c 'melody-table '(#\C))
-(set-key 'com-add-note-d 'melody-table '(#\D))
-(set-key 'com-add-note-e 'melody-table '(#\E))
-(set-key 'com-add-note-f 'melody-table '(#\F))
-(set-key 'com-add-note-g 'melody-table '(#\G))
-(set-key 'com-add-note-a 'melody-table '(#\A))
-(set-key 'com-add-note-b 'melody-table '(#\B))
 (set-key 'com-current-increment 'melody-table '((#\p)))
 (set-key 'com-current-decrement 'melody-table '((#\n)))
-(set-key 'com-istate-more-dots 'melody-table '((#\i) (#\.)))
-(set-key 'com-istate-more-lbeams 'melody-table '((#\i) (#\[)))
-(set-key 'com-istate-more-rbeams 'melody-table '((#\i) (#\])))
-(set-key 'com-istate-rotate-notehead 'melody-table '((#\i) (#\h)))
-(set-key 'com-istate-rotate-stem-direction 'melody-table '((#\i) (#\s)))
-(set-key 'com-istate-fewer-dots 'melody-table '((#\i) (#\x) (#\.)))
-(set-key 'com-istate-fewer-lbeams 'melody-table '((#\i) (#\x) (#\[)))
-(set-key 'com-istate-fewer-rbeams 'melody-table '((#\i) (#\x) (#\])))
 (set-key 'com-fewer-dots 'melody-table '((#\x) (#\.)))
 (set-key 'com-fewer-lbeams 'melody-table '((#\x) (#\[)))
 (set-key 'com-fewer-rbeams 'melody-table '((#\x) (#\])))
 (set-key 'com-erase-element 'melody-table '((#\h :control)))
 (set-key 'com-rotate-notehead 'melody-table '((#\h :meta)))
 (set-key 'com-rotate-stem-direction 'melody-table '((#\s :meta)))
-(set-key 'com-sharper 'melody-table '((#\#)))
-(set-key 'com-flatter 'melody-table '(#\@))
 (set-key 'com-more-sharps 'melody-table '((#\# :meta)))
 (set-key 'com-more-sharps 'melody-table '((#\# :meta :shift)))
 (set-key 'com-more-flats 'melody-table '((#\@ :meta :shift)))
-(set-key 'com-up 'melody-table '((#\u :meta)))
-(set-key 'com-down 'melody-table '((#\d :meta)))
+
+;;; the cluster table contains commands that are specific to 
+;;; clusters
+
+(define-command-table cluster-table)
+
+(set-key 'com-sharper 'cluster-table '((#\#)))
+(set-key 'com-flatter 'cluster-table '(#\@))
+(set-key 'com-add-note-c 'cluster-table '(#\C))
+(set-key 'com-add-note-d 'cluster-table '(#\D))
+(set-key 'com-add-note-e 'cluster-table '(#\E))
+(set-key 'com-add-note-f 'cluster-table '(#\F))
+(set-key 'com-add-note-g 'cluster-table '(#\G))
+(set-key 'com-add-note-a 'cluster-table '(#\A))
+(set-key 'com-add-note-b 'cluster-table '(#\B))
+(set-key 'com-up 'cluster-table '((#\u :meta)))
+(set-key 'com-down 'cluster-table '((#\d :meta)))
+(set-key 'com-tie-note-left 'cluster-table '((#\{)))
+(set-key 'com-tie-note-right 'cluster-table '((#\})))
+(set-key 'com-untie-note-left 'cluster-table '((#\x) (#\{)))
+(set-key 'com-untie-note-right 'cluster-table '((#\x) (#\})))
 
 ;;; lyrics mode table
 
--- /project/gsharp/cvsroot/gsharp/packages.lisp	2006/02/09 03:17:25	1.42
+++ /project/gsharp/cvsroot/gsharp/packages.lisp	2006/02/13 23:51:34	1.43
@@ -103,6 +103,7 @@
 	   #:key-signature #:alterations #:more-sharps #:more-flats
 	   #:line-width #:min-width #:spacing-style #:right-edge #:left-offset
 	   #:left-margin #:text #:append-char #:erase-char
+	   #:tie-right #:tie-left
 	   ))
 
 (defpackage :gsharp-numbering




More information about the Gsharp-cvs mailing list