[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Jul 19 06:23:53 UTC 2004
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv3761
Modified Files:
buffer.lisp gui.lisp packages.lisp
Log Message:
Staff types, staves, and clef types are now presentation types.
Add staff commands prompt for existing staff and name, type, clef
types, etc. for staff to insert. We still do not verify that staff
name is unique. We also need to add completion for staff names.
Updated documentation and release notes to reflect changes.
Date: Sun Jul 18 23:23:53 2004
Author: rstrandh
Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.3 gsharp/buffer.lisp:1.4
--- gsharp/buffer.lisp:1.3 Wed Jul 14 11:07:33 2004
+++ gsharp/buffer.lisp Sun Jul 18 23:23:53 2004
@@ -64,38 +64,40 @@
;;;
;;; Staff
-(defgeneric clef (staff))
-
(defclass staff ()
- ((name :accessor name :initarg :name :initform "default")
- (clef :accessor clef :initarg :clef :initform nil)
+ ((name :accessor name :initarg :name :initform "default")))
+
+(defgeneric clef (fiveline-staff))
+
+(defclass fiveline-staff (staff)
+ ((clef :accessor clef :initarg :clef :initform nil)
(keysig :accessor keysig :initarg :keysig
:initform (make-array 7 :initial-element :natural))))
-(defmethod print-object ((s staff) stream)
+(defmethod print-object ((s fiveline-staff) stream)
(with-slots (name clef keysig) s
(format stream "[= :name ~W :clef ~W :keysig ~W ] " name clef keysig)))
-(defun make-staff (&optional (clef (make-clef :treble)))
- (make-instance 'staff :clef clef))
+(defun make-fiveline-staff (name &optional (clef (make-clef :treble)))
+ (make-instance 'fiveline-staff :name name :clef clef))
-(defun read-staff-v2 (stream char n)
+(defun read-fiveline-staff-v2 (stream char n)
(declare (ignore char n))
(let ((clef (read stream nil nil t))
(keysig (read stream nil nil t)))
(skip-until-close-bracket stream)
- (make-instance 'staff :clef clef :keysig keysig)))
+ (make-instance 'fiveline-staff :clef clef :keysig keysig)))
(set-dispatch-macro-character #\[ #\=
- #'read-staff-v2
+ #'read-fiveline-staff-v2
*gsharp-readtable-v2*)
-(defun read-staff-v3 (stream char n)
+(defun read-fiveline-staff-v3 (stream char n)
(declare (ignore char n))
- (apply #'make-instance 'staff (read-delimited-list #\] stream t)))
+ (apply #'make-instance 'fiveline-staff (read-delimited-list #\] stream t)))
(set-dispatch-macro-character #\[ #\=
- #'read-staff-v3
+ #'read-fiveline-staff-v3
*gsharp-readtable-v3*)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -830,7 +832,7 @@
(defclass buffer ()
((segments :initform '() :initarg :segments :accessor segments)
- (staves :initform (list (make-staff)) :initarg :staves :accessor staves)
+ (staves :initform (list (make-fiveline-staff "default")) :initarg :staves :accessor staves)
(min-width :initform *default-min-width* :initarg :min-width :accessor min-width)
(spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style)
(right-edge :initform *default-right-edge* :initarg :right-edge :accessor right-edge)
@@ -930,13 +932,25 @@
(when errorp (assert staff () 'staff-not-in-buffer))
staff))
-(defmethod add-new-staff-to-buffer (staff-name (buffer buffer))
- (assert (not (find-staff staff-name buffer nil)) () 'staff-already-in-buffer)
+(defun add-staff-before (newstaff staff staves)
+ (assert (not (null staves)))
+ (if (eq staff (car staves))
+ (cons newstaff staves)
+ (cons (car staves) (add-staff-before newstaff staff (cdr staves)))))
+
+(defmethod add-staff-before-staff (staff newstaff (buffer buffer))
(setf (staves buffer)
- (append (staves buffer) (list (make-instance 'staff
- :clef (make-clef :treble)
- :name staff-name)))))
+ (add-staff-before newstaff staff (staves buffer))))
+
+(defun add-staff-after (newstaff staff staves)
+ (assert (not (null staves)))
+ (if (eq staff (car staves))
+ (push newstaff (cdr staves))
+ (add-staff-after newstaff staff (cdr staves))))
+(defmethod add-staff-after-staff (staff newstaff (buffer buffer))
+ (add-staff-after newstaff staff (staves buffer)))
+
(defmethod rename-staff (staff-name (staff staff) (buffer buffer))
(assert (not (find-staff staff-name buffer nil)) () 'staff-already-in-buffer)
(setf (name staff) staff-name))
@@ -947,16 +961,15 @@
(declare (ignore condition))
(format stream "Staff in use"))))
-(defmethod remove-staff-from-buffer (staff-name (buffer buffer))
- (let ((staff (find-staff staff-name buffer)))
- (assert (notany (lambda (segment)
- (some (lambda (layer)
- (member staff (staves layer)))
- (layers segment)))
- (segments buffer))
- () 'staff-in-use)
- (setf (staves buffer)
- (delete staff (staves buffer) :test #'eq))))
+(defmethod remove-staff-from-buffer (staff (buffer buffer))
+ (assert (notany (lambda (segment)
+ (some (lambda (layer)
+ (member staff (staves layer)))
+ (layers segment)))
+ (segments buffer))
+ () 'staff-in-use)
+ (setf (staves buffer)
+ (delete staff (staves buffer) :test #'eq)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.11 gsharp/gui.lisp:1.12
--- gsharp/gui.lisp:1.11 Sat Jul 17 01:21:13 2004
+++ gsharp/gui.lisp Sun Jul 18 23:23:53 2004
@@ -998,11 +998,88 @@
;;;
;;; Adding, deleting, and modifying staves
-(define-gsharp-command (com-add-staff :name t) ((name 'string))
- (add-new-staff-to-buffer name (buffer *gsharp-frame*)))
+(define-presentation-method accept
+ ((type fiveline-staff) stream (view textual-view) &key)
+ (multiple-value-bind (staff success string)
+ (complete-input stream
+ (lambda (so-far mode)
+ (complete-from-possibilities
+ so-far
+ (staves (buffer *gsharp-frame*))
+ '()
+ :action mode
+ :predicate (lambda (obj) (typep obj 'fiveline-staff))
+ :name-key #'name
+ :value-key #'identity)))
+ (declare (ignore string))
+ (if success
+ staff
+ (error "no such staff name")))) ; FIXME add a gsharp error here.
-(define-gsharp-command (com-delete-staff :name t) ((name 'string))
- (remove-staff-from-buffer name (buffer *gsharp-frame*)))
+(defun symbol-name-lowcase (symbol)
+ (string-downcase (symbol-name symbol)))
+
+(define-presentation-type staff-type ())
+
+(define-presentation-method accept
+ ((type staff-type) stream (view textual-view) &key)
+ (multiple-value-bind (type success string)
+ (complete-input stream
+ (lambda (so-far mode)
+ (complete-from-possibilities
+ so-far
+ '(:fiveline)
+ '()
+ :action mode
+ :predicate (lambda (obj) (declare (ignore obj)) t)
+ :name-key #'symbol-name-lowcase
+ :value-key #'identity)))
+ (declare (ignore string))
+ (if success
+ type
+ (error "no such staff type"))))
+
+(define-presentation-type clef-type ())
+
+(define-presentation-method accept
+ ((type clef-type) stream (view textual-view) &key)
+ (multiple-value-bind (type success string)
+ (complete-input stream
+ (lambda (so-far mode)
+ (complete-from-possibilities
+ so-far
+ '(:treble :bass :c :percussion)
+ '()
+ :action mode
+ :predicate (lambda (obj) (declare (ignore obj)) t)
+ :name-key #'symbol-name-lowcase
+ :value-key #'identity)))
+ (declare (ignore string))
+ (if success
+ type
+ (error "no such staff type"))))
+
+(defun acquire-new-staff ()
+ (let ((name (accept 'string :prompt "Staff name"))
+ (type (accept 'staff-type :prompt "Type")))
+ (ecase type
+ (:fiveline (let ((clef (accept 'clef-type :prompt "Clef"))
+ (line (accept 'integer :prompt "Line")))
+ (make-fiveline-staff name (make-clef clef line)))))))
+
+(define-gsharp-command (com-add-staff-before :name t) ()
+ (add-staff-before-staff (accept 'staff :prompt "Before staff")
+ (acquire-new-staff)
+ (buffer *gsharp-frame*)))
+
+(define-gsharp-command (com-add-staff-after :name t) ()
+ (add-staff-after-staff (accept 'staff :prompt "After staff")
+ (acquire-new-staff)
+ (buffer *gsharp-frame*)))
+
+(define-gsharp-command (com-delete-staff :name t) ()
+ (remove-staff-from-buffer (accept 'staff :prompt "Staff")
+ (buffer *gsharp-frame*)))
(define-gsharp-command (com-rename-staff :name t) ((name 'string))
(let ((buffer (buffer *gsharp-frame*))
Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.4 gsharp/packages.lisp:1.5
--- gsharp/packages.lisp:1.4 Fri Jul 16 06:19:25 2004
+++ gsharp/packages.lisp Sun Jul 18 23:23:53 2004
@@ -36,7 +36,7 @@
(:use :common-lisp :gsharp-utilities)
(:shadow #:rest)
(:export #:clef #:make-clef #:name #:lineno
- #:staff #:make-staff #:gsharp-condition
+ #:staff #:fiveline-staff #:make-fiveline-staff #:gsharp-condition
#:pitch #:accidentals #:dots #:cluster #:note
#:make-note #:note-less #:note-equal #:bar
#:notehead #:rbeams #:lbeams #:dots #:element #:notes
@@ -54,7 +54,7 @@
#:make-empty-segment #:make-initialized-segment
#:segments #:nb-segments #:segmentno #:staves
#:find-staff #:add-segment #:remove-segment
- #:add-new-staff-to-buffer
+ #:add-staff-before-staff #:add-staff-after-staff
#:remove-staff-from-buffer
#:rename-staff
#:add-staff-to-layer
More information about the Gsharp-cvs
mailing list