[gsharp-cvs] CVS gsharp
crhodes
crhodes at common-lisp.net
Fri Sep 14 15:48:06 UTC 2007
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
More information about the Gsharp-cvs
mailing list