[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