From crhodes at common-lisp.net Fri Sep 14 15:48:06 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 14 Sep 2007 11:48:06 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070914154806.EED04310D3@common-lisp.net> 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 From crhodes at common-lisp.net Fri Sep 14 15:52:57 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 14 Sep 2007 11:52:57 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070914155257.52D5F49091@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv14666 Modified Files: gui.lisp Log Message: Reverse the notehead rotation order for C-r. I apologise if this destroys someone's finger macros, but the current order is too illogical in the default state. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/14 15:48:05 1.84 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/14 15:52:57 1.85 @@ -754,10 +754,10 @@ (define-duration-altering-command com-rotate-notehead () (setf (notehead element) (ecase (notehead element) - (:breve :whole) - (:whole :half) - (:half :filled) - (:filled :breve))))) + (:whole :breve) + (:half :whole) + (:filled :half) + (:breve :filled))))) (define-gsharp-command com-rotate-stem-direction () (setf (stem-direction (cur-cluster)) @@ -1302,10 +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 :breve)))) + (:whole :breve) + (:half :whole) + (:filled :half) + (:breve :filled)))) (define-gsharp-command com-istate-rotate-stem-direction () (setf (stem-direction (input-state *application-frame*)) From crhodes at common-lisp.net Fri Sep 14 15:57:21 2007 From: crhodes at common-lisp.net (crhodes) Date: Fri, 14 Sep 2007 11:57:21 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070914155721.AF168650D3@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv14769 Modified Files: buffer.lisp Log Message: Allow clefs to be put on lines 0 and 8 of a staff. (Necessary for the Soprano C clef, found in early music). Note that key signature display code will probably have to be reworked to cater for such outlandish clefs. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/09/14 15:48:05 1.51 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/09/14 15:57:21 1.52 @@ -59,11 +59,11 @@ (defclass clef (gsharp-object name-mixin) ((print-character :allocation :class :initform #\K) (lineno :reader lineno :initarg :lineno - :type (or (integer 2 6) null)))) + :type (or (integer 0 8) null)))) (defun make-clef (name &key lineno) (declare (type (member :treble :treble8 :bass :c :percussion) name) - (type (or (integer 2 6) null) lineno)) + (type (or (integer 0 8) null) lineno)) (when (null lineno) (setf lineno (ecase name From crhodes at common-lisp.net Mon Sep 17 20:30:59 2007 From: crhodes at common-lisp.net (crhodes) Date: Mon, 17 Sep 2007 16:30:59 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070917203059.2C0101D133@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv21920 Modified Files: gui.lisp Log Message: More likely space requirements handling. (More likely to actually work, that is. Thanks to Athas and hefner for the ideas and the debugging patience.) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/14 15:52:57 1.85 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/17 20:30:59 1.86 @@ -203,9 +203,9 @@ (draw-the-cursor pane (current-cursor) (cursor-element (current-cursor)) (last-note (input-state *application-frame*))) (multiple-value-bind (minx miny maxx maxy) - (bounding-rectangle* pane) + (bounding-rectangle* (stream-output-history pane)) (declare (ignore minx maxx)) - (change-space-requirements pane :height (- maxy miny)))))) + (change-space-requirements pane :height (+ maxy miny)))))) (defmethod window-clear ((pane score-pane:score-pane)) (let ((output-history (stream-output-history pane))) From crhodes at common-lisp.net Tue Sep 18 21:19:04 2007 From: crhodes at common-lisp.net (crhodes) Date: Tue, 18 Sep 2007 17:19:04 -0400 (EDT) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20070918211904.1EEFD1B01C@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv16629 Modified Files: buffer.lisp drawing.lisp gui.lisp score-pane.lisp sdl.lisp Log Message: Support long ("lunga") notes and rests. It's a bit weird, because the lunga has the same notehead as a breve, but also has a stem; so having a NOTEHEAD of :long is a bit of a misnomer. Hey ho. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/09/14 15:57:21 1.52 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/09/18 21:19:03 1.53 @@ -195,9 +195,9 @@ ;;; ;;; The staff is a staff object. ;;; -;;; 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. +;;; Head can be :long, :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 :breve :whole :half :filled) null)) + :type (or (member :long :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 :breve :whole :half :filled) null) head) + (type (or (member :long :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) + (:long 4) (:breve 2) (:whole 1) (:half 1/2) @@ -540,7 +541,7 @@ (defun make-cluster (&rest args &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0) notes (stem-direction :auto)) - (declare (type (member :breve :whole :half :filled) notehead) + (declare (type (member :long :breve :whole :half :filled) notehead) (type (integer 0 5) lbeams) (type (integer 0 5) rbeams) (type (integer 0 3) dots) @@ -627,7 +628,7 @@ (dots 0) (xoffset 0)) (declare (type staff staff) (type integer staff-pos) - (type (member :breve :whole :half :filled) notehead) + (type (member :long :breve :whole :half :filled) notehead) (type (integer 0 5) lbeams) (type (integer 0 5) rbeams) (type (integer 0 3) dots) @@ -673,7 +674,7 @@ &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0)) (declare (type staff staff) - (type (member :breve :whole :half :filled) notehead) + (type (member :long :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/09/14 15:48:05 1.83 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/09/18 21:19:03 1.84 @@ -325,7 +325,7 @@ (elements (elements bar))) (and (null (cdr elements)) (typep element 'rest) - (member (notehead element) '(:breve :whole))))) + (member (notehead element) '(:long :breve :whole))))) (defun compute-measure-coordinates (measure x y force) (loop with timelines = (timelines measure) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/17 20:30:59 1.86 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/18 21:19:03 1.87 @@ -754,10 +754,11 @@ (define-duration-altering-command com-rotate-notehead () (setf (notehead element) (ecase (notehead element) + (:breve :long) (:whole :breve) (:half :whole) (:filled :half) - (:breve :filled))))) + (:long :filled))))) (define-gsharp-command com-rotate-stem-direction () (setf (stem-direction (cur-cluster)) @@ -1302,10 +1303,11 @@ (define-gsharp-command com-istate-rotate-notehead () (setf (notehead (input-state *application-frame*)) (ecase (notehead (input-state *application-frame*)) + (:breve :long) (:whole :breve) (:half :whole) (:filled :half) - (:breve :filled)))) + (:long :filled)))) (define-gsharp-command com-istate-rotate-stem-direction () (setf (stem-direction (input-state *application-frame*)) --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/09/14 15:48:05 1.38 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/09/18 21:19:03 1.39 @@ -132,7 +132,7 @@ (defun draw-notehead (stream name x staff-step) (sdl::draw-shape stream *font* (ecase name - (:breve :breve-notehead) + ((:breve :long) :breve-notehead) (:whole :whole-notehead) (:half :half-notehead) (:filled :filled-notehead)) @@ -175,6 +175,7 @@ (defun draw-rest (stream duration x staff-step) (sdl::draw-shape stream *font* (ecase duration + (4 :long-rest) (2 :breve-rest) (1 :whole-rest) (1/2 :half-rest) --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/09/14 15:48:05 1.36 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/09/18 21:19:03 1.37 @@ -1352,6 +1352,12 @@ ;;; ;;; Rests +(defmethod compute-design ((font font) (shape (eql :long-rest))) + (with-slots ((sld staff-line-distance) (slt staff-line-thickness) + notehead-width xoffset yoffset) font + (translate (xyscale +unit-square+ (/ notehead-width 2) (* 2 sld)) + (complex xoffset (+ yoffset (- (* 0.5 slt))))))) + (defmethod compute-design ((font font) (shape (eql :breve-rest))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness) notehead-width xoffset yoffset) font