[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