[gsharp-cvs] CVS gsharp
rstrandh
rstrandh at common-lisp.net
Thu Feb 9 03:17:25 UTC 2006
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp:/tmp/cvs-serv22139
Modified Files:
buffer.lisp drawing.lisp gui.lisp measure.lisp packages.lisp
Log Message:
The default key signature of a staff is now represented by an instance
of the new class `key-signature', rather than by just a vector. The
commands `com-more-sharps' and `com-more-flats' now call new protocol
generic functions on the key signature.
I used the suggestion from the patch by Christophe Rhodes to introduce
a new class `rhythmic-element' below `element' and move slots that
have to do with duration to that new class (rbeams, lbeams, dots).
The `key-signature' class does not inherit from `rhythmic-element',
but instead directly from `element'.
In order to avoid having to alter the external format yet again, the
reader tests whether a vector was read as the key signature, and if
so, replaces it by an instance of the new class.
As a nice side effect, I was able to remove the symbol
`invalidate-everything-using-staff' from the list of exported symbols
of `measure.lisp', because it is now used by the :after methods on
`more-sharps' and `more-flats', defined in the same package.
What I haven't done (I'll let Christophe do it, unless he takes too
long) is to incorporate the parts from Christophe's patch that make it
possible to insert key signatures as elements into layers.
--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/08 18:36:28 1.31
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/09 03:17:25 1.32
@@ -86,9 +86,16 @@
(defclass fiveline-staff (staff)
((print-character :allocation :class :initform #\=)
(clef :accessor clef :initarg :clef :initform (make-clef :treble))
- (keysig :accessor keysig :initarg :keysig
- :initform (make-array 7 :initial-element :natural))))
+ (%keysig :accessor keysig :initarg :keysig
+ :initform (make-array 7 :initial-element :natural))))
+(defmethod initialize-instance :after ((obj fiveline-staff) &rest args)
+ (declare (ignore args))
+ (with-slots (%keysig) obj
+ (when (vectorp %keysig)
+ (setf %keysig
+ (make-instance 'key-signature :staff obj :alterations %keysig)))))
+
(defun make-fiveline-staff (&rest args &key name clef keysig)
(declare (ignore name clef keysig))
(apply #'make-instance 'fiveline-staff args))
@@ -219,48 +226,63 @@
;;; currently does not belong to any bar.
(defgeneric bar (element))
+(defclass element (gsharp-object)
+ ((bar :initform nil :initarg :bar :accessor bar)
+ (xoffset :initform 0 :initarg :xoffset :accessor xoffset)))
+
+(defmethod print-gsharp-object :after ((e element) stream)
+ (with-slots (notehead rbeams lbeams dots xoffset) e
+ (format stream
+ "~_:xoffset ~W " xoffset)))
+
+(defmethod duration ((element element)) 0)
+(defmethod rbeams ((element element)) 0)
+(defmethod lbeams ((element element)) 0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Rhythmic element
+
;;; Return the notehead of the element. With setf, set the notehead
;;; of the element.
-(defgeneric notehead (element))
-(defgeneric (setf notehead) (notehead element))
+(defgeneric notehead (rhythmic-element))
+(defgeneric (setf notehead) (notehead rhythmic-element))
;;; Return the number of right beams of the element. With setf, set
;;; the number of right beams of the element.
-(defgeneric rbeams (element))
-(defgeneric (setf rbeams) (rbeams element))
+(defgeneric rbeams (rhythmic-element))
+(defgeneric (setf rbeams) (rbeams rhythmic-element))
;;; Return the number of left beams of the element. With setf, set
;;; the number of left beams of the element.
-(defgeneric lbeams (element))
-(defgeneric (setf lbeams) (lbeams element))
+(defgeneric lbeams (rhythmic-element))
+(defgeneric (setf lbeams) (lbeams rhythmic-element))
;;; Return the number of dots of the element. With setf, set the
;;; number of dots of the element.
-(defgeneric dots (element))
-(defgeneric (setf dots) (dots element))
+(defgeneric dots (rhythmic-element))
+(defgeneric (setf dots) (dots rhythmic-element))
-(defclass element (gsharp-object)
- ((bar :initform nil :initarg :bar :accessor bar)
- (notehead :initform :whole :initarg :notehead :accessor notehead)
+(defclass rhythmic-element (element)
+ ((notehead :initform :whole :initarg :notehead :accessor notehead)
(rbeams :initform 0 :initarg :rbeams :accessor rbeams)
(lbeams :initform 0 :initarg :lbeams :accessor lbeams)
- (dots :initform 0 :initarg :dots :accessor dots)
- (xoffset :initform 0 :initarg :xoffset :accessor xoffset)))
+ (dots :initform 0 :initarg :dots :accessor dots)))
-(defmethod print-gsharp-object :after ((e element) stream)
- (with-slots (notehead rbeams lbeams dots xoffset) e
+(defmethod print-gsharp-object :after ((e rhythmic-element) stream)
+ (with-slots (notehead rbeams lbeams dots) e
(format stream
- "~_:notehead ~W ~_:rbeams ~W ~_:lbeams ~W ~_:dots ~W ~_:xoffset ~W "
- notehead rbeams lbeams dots xoffset)))
+ "~_:notehead ~W ~_:rbeams ~W ~_:lbeams ~W ~_:dots ~W "
+ notehead rbeams lbeams dots)))
-(defmethod undotted-duration ((element element))
+(defmethod undotted-duration ((element rhythmic-element))
(ecase (notehead element)
(:whole 1)
(:half 1/2)
(:filled (/ (expt 2 (+ 2 (max (rbeams element)
(lbeams element))))))))
-(defmethod duration ((element element))
+(defmethod duration ((element rhythmic-element))
(let ((duration (undotted-duration element)))
(do ((dot-duration (/ duration 2) (/ dot-duration 2))
(nb-dots (dots element) (1- nb-dots)))
@@ -272,7 +294,7 @@
;;;
;;; Melody element
-(defclass melody-element (element) ())
+(defclass melody-element (rhythmic-element) ())
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -292,11 +314,21 @@
(:documentation "make the key signature N alterations
flatter by removing some sharps and/or adding some flats"))
-(defclass key-signature (melody-element)
+(defclass key-signature (element)
((%staff :initarg :staff :reader staff)
(%alterations :initform (make-array 7 :initial-element :natural)
:initarg :alterations :reader alterations)))
+(defun make-key-signature (staff &rest args &key alterations)
+ (declare (type (or null (simple-vector 7)) alterations)
+ (ignore alterations))
+ (apply #'make-instance 'key-signature :staff staff args))
+
+(defmethod print-gsharp-object :after ((k key-signature) stream)
+ (with-slots (%staff %alterations) k
+ (format stream
+ "~_:staff ~W ~_:alterations ~W " %staff %alterations)))
+
(defmethod more-sharps ((sig key-signature) &optional (n 1))
(let ((alt (alterations sig)))
(loop repeat n
@@ -478,7 +510,7 @@
;;;
;;; Lyrics element
-(defclass lyrics-element (element)
+(defclass lyrics-element (rhythmic-element)
((print-character :allocation :class :initform #\A)
(staff :initarg :staff :reader staff)
(text :initarg :text
--- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/02/07 04:52:06 1.60
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/02/09 03:17:25 1.61
@@ -47,7 +47,7 @@
(loop for pitch in '(6 2 5 1 4 0 3)
for line in '(0 3 -1 2 -2 1 -3)
for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2)
- while (eq (aref (keysig staff) pitch) :flat)
+ while (eq (aref (alterations (keysig staff)) pitch) :flat)
do (score-pane:draw-accidental pane :flat x (+ line yoffset))))
(let ((yoffset (ecase (name (clef staff))
(:bass (lineno (clef staff)))
@@ -56,7 +56,7 @@
(loop for pitch in '(3 0 4 1 5 2 6)
for line in '(0 -3 1 -2 -5 -1 -4)
for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5)
- while (eq (aref (keysig staff) pitch) :sharp)
+ while (eq (aref (alterations (keysig staff)) pitch) :sharp)
do (score-pane:draw-accidental pane :sharp x (+ line yoffset)))))
(present staff
`((score-pane:fiveline-staff)
@@ -332,13 +332,13 @@
(loop for staff in staves
maximize
(if (typep staff 'fiveline-staff)
- (count :flat (keysig staff))
+ (count :flat (alterations (keysig staff)))
0)))
(* (score-pane:staff-step 2.5)
(loop for staff in staves
maximize
(if (typep staff 'fiveline-staff)
- (count :sharp (keysig staff))
+ (count :sharp (alterations (keysig staff)))
0)))))
(method (let ((old-method (buffer-cost-method buffer)))
(make-measure-cost-method (min-width old-method)
--- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/01/05 19:14:45 1.51
+++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/09 03:17:25 1.52
@@ -580,7 +580,7 @@
(staff (car (staves (layer (slice (bar cluster))))))
(note (make-note pitch staff
:head (notehead state)
- :accidentals (aref (keysig staff) (mod pitch 7))
+ :accidentals (aref (alterations (keysig staff)) (mod pitch 7))
:dots (dots state))))
(setf *current-cluster* cluster
*current-note* note)
@@ -1091,42 +1091,10 @@
(remove-staff-from-layer staff layer)))
(define-gsharp-command com-more-sharps ()
- (let ((staff (car (staves (layer (current-cursor))))))
- (invalidate-everything-using-staff (current-buffer) staff)
- (let ((keysig (keysig staff)))
- (cond ((eq (aref keysig 3) :flat) (setf (aref keysig 3) :natural))
- ((eq (aref keysig 0) :flat) (setf (aref keysig 0) :natural))
- ((eq (aref keysig 4) :flat) (setf (aref keysig 4) :natural))
- ((eq (aref keysig 1) :flat) (setf (aref keysig 1) :natural))
- ((eq (aref keysig 5) :flat) (setf (aref keysig 5) :natural))
- ((eq (aref keysig 2) :flat) (setf (aref keysig 2) :natural))
- ((eq (aref keysig 6) :flat) (setf (aref keysig 6) :natural))
- ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :sharp))
- ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :sharp))
- ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :sharp))
- ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :sharp))
- ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :sharp))
- ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :sharp))
- ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :sharp))))))
+ (more-sharps (keysig (car (staves (layer (current-cursor)))))))
(define-gsharp-command com-more-flats ()
- (let ((staff (car (staves (layer (current-cursor))))))
- (invalidate-everything-using-staff (current-buffer) staff)
- (let ((keysig (keysig staff)))
- (cond ((eq (aref keysig 6) :sharp) (setf (aref keysig 6) :natural))
- ((eq (aref keysig 2) :sharp) (setf (aref keysig 2) :natural))
- ((eq (aref keysig 5) :sharp) (setf (aref keysig 5) :natural))
- ((eq (aref keysig 1) :sharp) (setf (aref keysig 1) :natural))
- ((eq (aref keysig 4) :sharp) (setf (aref keysig 4) :natural))
- ((eq (aref keysig 0) :sharp) (setf (aref keysig 0) :natural))
- ((eq (aref keysig 3) :sharp) (setf (aref keysig 3) :natural))
- ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :flat))
- ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :flat))
- ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :flat))
- ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :flat))
- ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat))
- ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat))
- ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat))))))
+ (more-flats (keysig (car (staves (layer (current-cursor)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
--- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/01/25 00:50:56 1.25
+++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/02/09 03:17:25 1.26
@@ -8,6 +8,20 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
+;;; Key signature
+
+(defmethod more-sharps :after ((sig key-signature) &optional n)
+ (declare (ignore n))
+ (let ((staff (staff sig)))
+ (invalidate-everything-using-staff (buffer staff) staff)))
+
+(defmethod more-flats :after ((sig key-signature) &optional n)
+ (declare (ignore n))
+ (let ((staff (staff sig)))
+ (invalidate-everything-using-staff (buffer staff) staff)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
;;; Staff
(define-added-mixin rstaff () staff
@@ -207,7 +221,7 @@
(loop for note in group do
(setf (final-accidental note)
(if (eq (accidentals note)
- (aref (keysig (staff note)) (mod (pitch note) 7)))
+ (aref (alterations (keysig (staff note))) (mod (pitch note) 7)))
nil
(accidentals note)))))
--- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/01/22 20:38:52 1.41
+++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/02/09 03:17:25 1.42
@@ -100,6 +100,7 @@
#:remove-staff-from-layer
#:stem-direction #:undotted-duration #:duration
#:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream
+ #:key-signature #:alterations #:more-sharps #:more-flats
#:line-width #:min-width #:spacing-style #:right-edge #:left-offset
#:left-margin #:text #:append-char #:erase-char
))
@@ -137,8 +138,7 @@
#:group-notes-by-staff #:final-relative-note-xoffset
#:final-accidental #:final-relative-accidental-xoffset
#:timeline #:timelines #:elasticity
- #:smallest-gap #:elasticity-function
- #:invalidate-everything-using-staff))
+ #:smallest-gap #:elasticity-function))
(defpackage :gsharp-postscript
(:use :clim :clim-lisp)
More information about the Gsharp-cvs
mailing list