Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv13687

Modified Files: buffer.lisp drawing.lisp gui.lisp score-pane.lisp sdl.lisp Log Message: Support for breves and breve rests.

--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/07/12 16:04:49 1.50 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/09/14 15:48:05 1.51 @@ -195,9 +195,9 @@ ;;; ;;; The staff is a staff object. ;;; -;;; Head can be :whole, :half, :filled, or nil. A value of nil means -;;; that the notehead is determined by that of the cluster to which the -;;; note belongs. +;;; Head can be :breve, :whole, :half, :filled, or nil. A value of +;;; nil means that the notehead is determined by that of the cluster +;;; to which the note belongs. ;;; ;;; Accidentals can be :natural :flat :double-flat :sharp or :double-sharp. ;;; The default is :natural. Whether a note is actually displayed @@ -217,7 +217,7 @@ (pitch :initarg :pitch :reader pitch :type (integer 0 127)) (staff :initarg :staff :reader staff :type staff) (head :initform nil :initarg :head :reader head - :type (or (member :whole :half :filled) null)) + :type (or (member :breve :whole :half :filled) null)) (accidentals :initform :natural :initarg :accidentals :reader accidentals ;; FIXME: we want :TYPE ACCIDENTAL here but need to ;; sort out order of definition for that to be useful. @@ -231,7 +231,7 @@ (defun make-note (pitch staff &rest args &key head (accidentals :natural) dots) (declare (type (integer 0 127) pitch) (type staff staff) - (type (or (member :whole :half :filled) null) head) + (type (or (member :breve :whole :half :filled) null) head) ;; FIXME: :TYPE ACCIDENTAL #+nil #+nil (type (member :natural :flat :double-flat :sharp :double-sharp) @@ -418,6 +418,7 @@

(defmethod undotted-duration ((element rhythmic-element)) (ecase (notehead element) + (:breve 2) (:whole 1) (:half 1/2) (:filled (/ (expt 2 (+ 2 (max (rbeams element) @@ -539,7 +540,7 @@ (defun make-cluster (&rest args &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0) notes (stem-direction :auto)) - (declare (type (member :whole :half :filled) notehead) + (declare (type (member :breve :whole :half :filled) notehead) (type (integer 0 5) lbeams) (type (integer 0 5) rbeams) (type (integer 0 3) dots) @@ -626,7 +627,7 @@ (dots 0) (xoffset 0)) (declare (type staff staff) (type integer staff-pos) - (type (member :whole :half :filled) notehead) + (type (member :breve :whole :half :filled) notehead) (type (integer 0 5) lbeams) (type (integer 0 5) rbeams) (type (integer 0 3) dots) @@ -672,7 +673,7 @@ &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0)) (declare (type staff staff) - (type (member :whole :half :filled) notehead) + (type (member :breve :whole :half :filled) notehead) (type (integer 0 5) lbeams) (type (integer 0 5) rbeams) (type (integer 0 3) dots) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/08/07 11:06:09 1.82 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/09/14 15:48:05 1.83 @@ -325,7 +325,7 @@ (elements (elements bar))) (and (null (cdr elements)) (typep element 'rest) - (eq (notehead element) :whole)))) + (member (notehead element) '(:breve :whole)))))

(defun compute-measure-coordinates (measure x y force) (loop with timelines = (timelines measure) @@ -984,7 +984,7 @@ (loop for group in groups do (draw-notes pane group (dots element) (notehead element) dot-xoffset) (draw-ledger-lines pane x group)) - (unless (eq (notehead element) :whole) + (unless (member (notehead element) '(:whole :breve)) (if (eq direction :up) (score-pane:draw-right-stem pane x --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/08/07 14:00:09 1.83 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/14 15:48:05 1.84 @@ -139,7 +139,7 @@ (score-pane:with-vertical-score-position (pane 100) (let ((xpos 30)) (score-pane:draw-notehead pane (notehead state) xpos 4) - (when (not (eq (notehead state) :whole)) + (when (not (member (notehead state) '(:whole :breve))) (when (or (eq (stem-direction state) :auto) (eq (stem-direction state) :down)) (when (eq (notehead state) :filled) @@ -753,10 +753,11 @@ (setf (rbeams element) (max (1- (rbeams element)) 0))) (define-duration-altering-command com-rotate-notehead () (setf (notehead element) - (ecase (notehead element) - (:whole :half) - (:half :filled) - (:filled :whole))))) + (ecase (notehead element) + (:breve :whole) + (:whole :half) + (:half :filled) + (:filled :breve)))))

(define-gsharp-command com-rotate-stem-direction () (setf (stem-direction (cur-cluster)) @@ -1301,9 +1302,10 @@ (define-gsharp-command com-istate-rotate-notehead () (setf (notehead (input-state *application-frame*)) (ecase (notehead (input-state *application-frame*)) + (:breve :whole) (:whole :half) (:half :filled) - (:filled :whole)))) + (:filled :breve))))

(define-gsharp-command com-istate-rotate-stem-direction () (setf (stem-direction (input-state *application-frame*)) --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/07/27 22:34:31 1.37 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/09/14 15:48:05 1.38 @@ -132,6 +132,7 @@ (defun draw-notehead (stream name x staff-step) (sdl::draw-shape stream *font* (ecase name + (:breve :breve-notehead) (:whole :whole-notehead) (:half :half-notehead) (:filled :filled-notehead)) @@ -174,6 +175,7 @@ (defun draw-rest (stream duration x staff-step) (sdl::draw-shape stream *font* (ecase duration + (2 :breve-rest) (1 :whole-rest) (1/2 :half-rest) (1/4 :quarter-rest) --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/08/20 07:14:35 1.35 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/09/14 15:48:05 1.36 @@ -662,6 +662,23 @@ (translate (scale *filled-path* staff-line-distance) (complex xoffset yoffset))))

+(defmethod compute-design ((font font) (shape (eql :breve-notehead))) + (with-slots (xoffset yoffset (sld staff-line-distance) stem-thickness) font + (let ((top (translate (xyscale (translate +unit-square+ #c(0 0.5)) + (* sld 1.5) (* sld (- 0.53 0.25))) + (* sld #c(0 0.25)))) + (bot (translate (xyscale (translate +unit-square+ #c(0 -0.5)) + (* sld 1.5) (* sld (- 0.53 0.25))) + (* sld #c(0 -0.25)))) + (left (translate (xyscale +unit-square+ stem-thickness (* 1.3 sld)) + (+ (* sld #c(-0.75 0)) (/ stem-thickness 2)))) + (right (translate (xyscale +unit-square+ stem-thickness (* 1.3 sld)) + (- (* sld #c(0.75 0)) (/ stem-thickness 2))))) + (translate + (reduce #'clim:region-union + (list top bot left right)) + (complex xoffset yoffset))))) + (defmethod compute-design ((font font) (shape (eql :whole-notehead))) (with-slots (xoffset yoffset (sld staff-line-distance)) font (let ((op (scale (superellipse #c(0.75 0.0) #c(0.0 0.53) @@ -1335,6 +1352,12 @@ ;;; ;;; Rests

+(defmethod compute-design ((font font) (shape (eql :breve-rest))) + (with-slots ((sld staff-line-distance) (slt staff-line-thickness) + notehead-width xoffset yoffset) font + (translate (xyscale +unit-square+ (/ notehead-width 2) sld) + (complex xoffset (+ yoffset (+ (* 0.5 sld)) (- (* 0.5 slt))))))) + (defmethod compute-design ((font font) (shape (eql :whole-rest))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness) notehead-width xoffset yoffset) font